Applying a function which takes in values and return the results from a data frame using Shiny

Question

I am trying to develop an app which asks the user for some values, passes these values to a function and outputs the results to a table in Shiny.

The R code I have is the following:

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"
)

cbind(C, P)

Which gives me:

              C    P
 [1,] -3.190686 4.00
 [2,] -3.379774 4.25
 [3,] -3.567795 4.50
 [4,] -3.754770 4.75
 [5,] -3.940723 5.00
 [6,] -4.125674 5.25
 [7,] -4.309646 5.50
 [8,] -4.492658 5.75
 [9,] -4.674731 6.00

I would like to output this as a table using Shiny. What I have currently is:

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),
        verbatimTextOutput("S_K_Output")
    )
)

#######################################################################

ui <- dashboardPage(header, sidebar, body)

#######################################################################

server <- function(input, output) {
    
    output$S_K_Output <- observeEvent(
        
        input$Seq <- seq(from = input$KInput - 1, to = input$KInput + 1, by = 0.25),    # create a sequence going from K-1 to K+1

        input$C <- someFunction(
            S = input$SInput,
            K = input$Seq,                                                    # Apply this sequence to the function
            type = "C"
        ),
        
        input$P <- someFunction(
            S = input$SInput,
            K = input$Seq,
            type = "P"
        ),
        
        cbind(input$C, input$P)                                               # Extract the results and put side-by-side 
    )
}

I get the following error:

Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

Which I believe is because I am trying to pass the data through observeEvent().

My question is, how can I allow the user to input values, apply a function and display the results in a table?

Answer 1

Several problems:

1. observeEvent works by side-effect (i.e., do not try to do something with any return value); what you need there is renderText.
2. The way you are calling observeEvent is one expression per argument, which is not how it works: the first argument is supposed to be an expression of reactive components to monitor/react-to, and the second is a single expression to be executed when something happens. When it is compound, then you must use {...} (in either or both). The way you are calling it is Seq <- ... is the first argument, C <- someFunction(...) is its second argument, etc. Put all of these within a {...} block and remove the interspersed commas you have in them.
3. You are attempting to define new input variables as you go, which cannot happen. If you need a temp variable, then define a temp variable without the input$. If you need this new temp variable to persist and be available in other reactive blocks, then you can use reactiveVal or reactiveValues. For now, remove input$ from input$Seq, input$C, and input$P.

This does not produce an error:

server <- function(input, output) {
    output$S_K_Output <- renderText({
        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"
        )
        cbind(C, P)                                               # Extract the results and put side-by-side 
    })
}

However, that's not a "table" in any sense, it's a long stream of characters.

There are three ways to address this:

1. (Brute force, not preferred/recommended.) Capture the tabular output (as in the R console) and paste it verbatim. (The paste portion is to get the literal newlines \n in the text.)

       output$S_K_Output <- renderText({
           # ... as above
           # cbind(C, P)
           paste(capture.output(cbind(C, P)), collapse="\n")
       })
   

   

2. Perhaps you want a "real" HTML table?

   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")
       )
   )
   server <- function(input, output) {
       output$S_K_Output <- renderTable({
         # ... as above
         cbind(C, P)
       })
   }
   

   

3. For "fancier" tables, consider the DT package.