This is a follow on post to one I made here . The original question required the user to input some values into some text boxes/numeric boxes compute some function and then display the result in a data frame. It can be computed using the following R code (which also includes the ggplot2
plot I would also like to add).
R Code:
someFunction <- function(S, K, type){
# call option
if(type=="C"){
d1 <- S/K
value <- S*pnorm(d1) - K*pnorm(d1)
return(value)}
# put option
if(type=="P"){
d1 <- S*K
value <- (K*pnorm(d1) - S*pnorm(d1))
return(value)}
}
SInput <- 20
KInput <- 25
Seq <- seq(from = KInput - 1, to = KInput + 1, by = 0.25)
C <- someFunction(
S = SInput,
K = Seq,
type = "C"
)
P <- someFunction(
S = SInput,
K = Seq,
type = "P"
)
df <- data.frame(C, P, Seq) # create the data frame for the ggplot and Shiny output
df %>% # plot that data frame
ggplot(aes(x = Seq)) +
geom_line(aes(y = C)) +
geom_line(aes(y = P))
I want to create the same ggplot
- reactive plot in Shiny. The Shiny code I have is the following.
library(shiny)
library(shinydashboard)
#######################################################################
############################### Functions #############################
someFunction <- function(S, K, type){
# call option
if(type=="C"){
d1 <- S/K
value <- S*pnorm(d1) - K*pnorm(d1)
return(value)}
# put option
if(type=="P"){
d1 <- S*K
value <- (K*pnorm(d1) - S*pnorm(d1))
return(value)}
}
############################### Header ###############################
header <- dashboardHeader()
#######################################################################
############################### Sidebar ###############################
sidebar <- dashboardSidebar()
#######################################################################
############################### Body ##################################
body <- dashboardBody(
fluidPage(
numericInput("SInput", "Input S:", 10, min = 1, max = 100),
numericInput("KInput", "Input K:", 10, min = 1, max = 100),
tableOutput("S_K_Output")
)
)
#######################################################################
ui <- dashboardPage(header, sidebar, body)
#######################################################################
server <- function(input, output) {
output$S_K_Output <- renderTable({
Seq <- seq(from = input$KInput - 1, to = input$KInput + 1, by = 0.25) # create a sequence going from K-1 to K+1
C <- someFunction(
S = input$SInput,
K = Seq, # Apply this sequence to the function
type = "C"
)
P <- someFunction(
S = input$SInput,
K = Seq,
type = "P"
)
data.frame(C, P, Seq) # Extract the results and put side-by-side
})
}
shinyApp(ui, server)
The above Shiny code works for producing the table but I also want to include the plot. I am finding it difficult since the above code outputs the results into a renderTable({})
function (ie returning a HTML table and simply adding the ggplot
code doesn't work.)
I have tried renderPlot
and pasting all the above code again from renderTable
into the same function but I don't want to repeat unnecessary calculations. So my question is how can I export the data.frame(C, P, Seq)
into a ggplot2
graphic from two different renderTable
and renderPlot
? I can add the tablePlot
just under the tableOutput
in the fluidPage
part of the code but I am not able to get results.
Start thinking about dependency and removing redundancy. That is, if you are creating data of some sort and you even think that it will be used by more than one "thing", then break it out into "reactive data", and then depend on it in multiple locations.
Oh, and if you want to show a plot, you need to use plotOutput
.
Changes from your previous code:
plotOutput
;renderTable
into a reactive
block that just calculates data , it does nothing to consider how to show or filter it;renderTable
to deal with the data as created in the previously-mentioned block;renderPlot
(paired with plotOutput
); and finallyreq(mydata())
to the plot output, so that if the data is empty or NULL
(for whatever reason), then the plotting code will not fire. See ?req
if you have questions about this, or its companion functions validate
and need
. Note that when using reactive data, you must call it like a function. So the mydata
reactive data block makes its data available to other reactive components when called as mydata()
. Do not try to "view" mydata
(without the parens), it does nothing for you.
library(shiny)
library(shinydashboard)
#######################################################################
############################### Functions #############################
someFunction <- function(S, K, type){
# call option
if(type=="C"){
d1 <- S/K
value <- S*pnorm(d1) - K*pnorm(d1)
return(value)}
# put option
if(type=="P"){
d1 <- S*K
value <- (K*pnorm(d1) - S*pnorm(d1))
return(value)}
}
############################### Header ###############################
header <- dashboardHeader()
#######################################################################
############################### Sidebar ###############################
sidebar <- dashboardSidebar()
#######################################################################
############################### Body ##################################
body <- dashboardBody(
fluidPage(
numericInput("SInput", "Input S:", 10, min = 1, max = 100),
numericInput("KInput", "Input K:", 10, min = 1, max = 100),
tableOutput("S_K_Output"),
plotOutput("Plot_Output")
)
)
#######################################################################
ui <- dashboardPage(header, sidebar, body)
#######################################################################
server <- function(input, output) {
mydata <- reactive({
Seq <- seq(from = input$KInput - 1, to = input$KInput + 1, by = 0.25) # create a sequence going from K-1 to K+1
C <- someFunction(
S = input$SInput,
K = Seq, # Apply this sequence to the function
type = "C"
)
P <- someFunction(
S = input$SInput,
K = Seq,
type = "P"
)
data.frame(C, P, Seq) # Extract the results and put side-by-side
})
output$S_K_Output <- renderTable({ mydata() })
output$Plot_Output <- renderPlot({
req(mydata())
# plot that data frame
ggplot(mydata(), aes(x = Seq)) +
geom_line(aes(y = C)) +
geom_line(aes(y = P))
})
}
shinyApp(ui, server)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.