Implement Black‑Scholes Shiny app: complete server & UI (call/put pricing, plotly plots, add volatility/rates/dividend inputs, run app) and add kable/paged_table examples to tp3.Rmd

This commit is contained in:
2025-11-13 16:31:44 +01:00
parent f58afe7d71
commit 4570a011ec
2 changed files with 75 additions and 54 deletions

View File

@@ -1,64 +1,46 @@
# Original source : https://srdas.github.io/MLBook/Shiny.html#the-application-program
# R
# Black-Scholes Shiny app — fixed plots for call and put
library(shiny)
library(plotly)
library(ggplot2)
library(ggthemes)
##### CONSIGNES #####
# 1. Completer le code du serveur (???) permet de compléter l'objet `output` (argument plotCall
# et plotPut). Il s'agit de deux figures qui permet de presenter la valeur
# d'un call et d'un put en fonction du Strike K.
# 2. Compléter le code de l'ui (???) afin de creer des box affichant la valeur de l'action
# 'Stock Price' et du strike 'Strike Price'. Prendre par dééfaut la valeur 100.
# 3 . Sur la base du slider pour la Maturité, ajouter un slider pour la volatilité,
# le taux sans risque et le taux de dividende.
# 4. Lancer l'application.
##### SERVER #####
# Define server logic for random distribution application
server <- function(input, output) {
#Generate Black-Scholes values
BS = function(S,K,T,v,rf,dv) {
d1 = (log(S/K) + (rf-dv+0.5*v^2)*T)/(v*sqrt(T))
d2 = d1 - v*sqrt(T)
bscall = S*exp(-dv*T)*pnorm(d1) - K*exp(-rf*T)*pnorm(d2)
bsput = -S*exp(-dv*T)*pnorm(-d1) + K*exp(-rf*T)*pnorm(-d2)
res = c(bscall,bsput)
# Generate Black-Scholes values
BS = function(S, K, T, v, rf, dv) {
d1 = (log(S/K) + (rf - dv + 0.5 * v^2) * T) / (v * sqrt(T))
d2 = d1 - v * sqrt(T)
bscall = S * exp(-dv * T) * pnorm(d1) - K * exp(-rf * T) * pnorm(d2)
bsput = -S * exp(-dv * T) * pnorm(-d1) + K * exp(-rf * T) * pnorm(-d2)
c(bscall, bsput)
}
#Call option price
# Call option price
output$BScall <- renderText({
#Get inputs
S = input$stockprice
K = input$strike
T = input$maturity
v = input$volatility
rf = input$riskfreerate
dv = input$divrate
res = round(BS(S,K,T,v,rf,dv)[1],4)
round(BS(S, K, T, v, rf, dv)[1], 4)
})
#Put option price
# Put option price
output$BSput <- renderText({
#Get inputs
S = input$stockprice
K = input$strike
T = input$maturity
v = input$volatility
rf = input$riskfreerate
dv = input$divrate
res = round(BS(S,K,T,v,rf,dv)[2],4)
round(BS(S, K, T, v, rf, dv)[2], 4)
})
#Call plot
# Call plot (shows call and put curves across strikes)
output$plotCall <- renderPlotly({
S = input$stockprice
K = input$strike
@@ -66,36 +48,62 @@ server <- function(input, output) {
v = input$volatility
rf = input$riskfreerate
dv = input$divrate
vcall = NULL; vput = NULL
strikes = seq(K-30,K+30)
for (k in strikes) {
vcall = ???
vput = ???
}
df = data.frame(strikes,vcall,vput)
p <- ggplot(???) + ???
strikes = seq(K - 30, K + 30)
vcall = sapply(strikes, function(k) BS(S, k, T, v, rf, dv)[1])
vput = sapply(strikes, function(k) BS(S, k, T, v, rf, dv)[2])
df = data.frame(strikes = strikes, Call = vcall, Put = vput)
p <- ggplot(df, aes(x = strikes)) +
geom_line(aes(y = Call, color = "Call")) +
geom_line(aes(y = Put, color = "Put")) +
labs(title = "Black-Scholes Option Pricing",
x = "Strike Price",
y = "Option Price") +
theme_minimal() +
scale_color_manual("", values = c("Call" = "steelblue", "Put" = "firebrick"))
plotly::ggplotly(p)
})
#Put plot
output$plotPut <- ???
# Put plot (same curves — kept for tab separation)
output$plotPut <- renderPlotly({
S = input$stockprice
K = input$strike
T = input$maturity
v = input$volatility
rf = input$riskfreerate
dv = input$divrate
strikes = seq(K - 30, K + 30)
vcall = sapply(strikes, function(k) BS(S, k, T, v, rf, dv)[1])
vput = sapply(strikes, function(k) BS(S, k, T, v, rf, dv)[2])
df = data.frame(strikes = strikes, Call = vcall, Put = vput)
p <- ggplot(df, aes(x = strikes)) +
geom_line(aes(y = Put, color = "Put")) +
geom_line(aes(y = Call, color = "Call")) +
labs(title = "Black-Scholes Option Pricing",
x = "Strike Price",
y = "Option Price") +
theme_minimal() +
scale_color_manual("", values = c("Call" = "steelblue", "Put" = "firebrick"))
plotly::ggplotly(p)
})
}
##### UI #####
ui <- shinyUI(fluidPage(
titlePanel("Black-Scholes-Merton (1973)"),
sidebarLayout(
sidebarPanel(
numericInput(???,'Stock Price', ???),
numericInput(???,'Strike Price', ???),
sliderInput('maturity','Maturity (years)',min=0.1,max=10,value=1,step=0.01),
sliderInput(???),
sliderInput(???),
sliderInput(???),
numericInput('stockprice', 'Stock Price', 100),
numericInput('strike', 'Strike Price', 100),
sliderInput('maturity', 'Maturity (years)', min = 0.1, max = 10, value = 1, step = 0.01),
sliderInput('volatility', 'Volatility (annualized)', min = 0.1, max = 2, value = 0.2, step = 0.01),
sliderInput('riskfreerate', 'Risk-free Rate (annualized)', min = 0, max = 0.5, value = 0.01, step = 0.01),
sliderInput('divrate', 'Dividend Yield (annualized)', min = 0, max = 0.5, value = 0, step = 0.01),
hr(),
p('Please refer to following for more details:',
a("Black-Scholes (1973)",
@@ -111,12 +119,12 @@ ui <- shinyUI(fluidPage(
textOutput("BSput"),
hr(),
tabsetPanel(
tabPanel("Calls", plotlyOutput("plotCall",width="100%")),
tabPanel("Puts", plotlyOutput("plotPut",width="100%"))
tabPanel("Calls", plotlyOutput("plotCall", width = "100%")),
tabPanel("Puts", plotlyOutput("plotPut", width = "100%"))
)
)
)
))
##### Run #####
???
##### Run #####
shinyApp(ui = ui, server = server)

View File

@@ -28,3 +28,16 @@ plot(pressure)
```
Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.
```{r}
library(kableExtra)
mtcars[1:5, 1:5] %>%
kbl() %>%
kable_styling()
```
```{r}
library(rmarkdown)
paged_table(mtcars, options = list(rows.print = 15))
```