在 Shiny 中具有反应性数据框的反应性 ggplot

Question

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.

Answer 1

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:

• if you want a plot, you need to add a plotOutput ;
• convert the code in your renderTable into a reactive block that just calculates data , it does nothing to consider how to show or filter it;
• re-add the renderTable to deal with the data as created in the previously-mentioned block;
• add renderPlot (paired with plotOutput ); and finally
• added req(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)