r - 应用一个函数，该函数接受值并使用 Shiny 从数据框中返回结果

Question

我正在尝试开发一个应用程序，它向用户询问一些值，将这些值传递给函数并将结果输出到 Shiny 中的表。

我拥有的 R 代码如下：

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)

这给了我：

              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

我想使用 Shiny 将其输出为表格。我目前拥有的是：

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

我收到以下错误：

.getReactiveEnvironment()$currentContext() 中的错误：如果没有活动的反应上下文，则不允许操作。（你试图做一些只能从反应式表达式或观察者内部完成的事情。）

我相信这是因为我试图通过observeEvent().

我的问题是，如何允许用户输入值、应用函数并将结果显示在表格中？

标签： rshiny

Answer 1

几个问题：

1. observeEvent按副作用工作（即，不要尝试使用任何返回值做某事）；你需要的是renderText。
2. 您调用的方式observeEvent是每个参数一个表达式，这不是它的工作方式：第一个参数应该是要监视/响应的反应组件的表达式，第二个是在发生某些事情时要执行的单个表达式. 如果它是复合的，那么你必须使用{...}（在一个或两个中）。您调用它的方式Seq <- ...是第一个参数，C <- someFunction(...)是它的第二个参数，等等。将所有这些放在一个{...}块中并删除您在其中的散布逗号。
3. 您正在尝试随时定义新 input变量，这是不可能的。如果您需要一个临时变量，则定义一个不带input$. 如果您需要这个新的临时变量持续存在并在其他反应块中可用，那么您可以使用reactiveValor reactiveValues。现在，input$从input$Seq、input$C和中删除input$P。

这不会产生错误：

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

但是，从任何意义上说，这都不是“表格”，而是一长串字符。

有三种方法可以解决这个问题：

1. （蛮力，不是首选/推荐。）捕获表格输出（如在 R 控制台中）并逐字粘贴。（该paste部分是在文本中获取文字换行符\n。）

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

   

2. 也许您想要一个“真正的”HTML 表格？

   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. 对于“更高级”的桌子，请考虑DT包装。