javascript - 如何将复选框输入传递给 shinyServer() 中的函数

Question

我有这个Shiny代码，目前可通过 RStudio 部署.我希望它从 Checkbox 获取用户输入并传递值到 get_table() 参数 logit。

library(ggplot2)
library(tidyverse)
library(ggrepel)
library(shiny)
library(DT)
#-------------------------
# Function 
#-------------------------
get_table <- function (dat, logit=FALSE, wanted_cols = c("model","mpg","wt"), data_title="Foo table") {

  # This function creates a table 
  # an perform log function if logit=TRUE

  dat_out <- select(dat, one_of(wanted_cols)) 
  if(logit) {
    dat_out <- select(dat, one_of(wanted_cols[2:length(wanted_cols)])) 
    dat_out <- log(dat_out)
    dat_out <- bind_cols(dat[1], dat_out)

  }
  return(dat_out)

}

#-------------------------
# Begin Shiny App code (ui + server)
#-------------------------
# I literally want to use file as input 
infile <- "https://gist.githubusercontent.com/seankross/a412dfbd88b3db70b74b/raw/5f23f993cd87c283ce766e7ac6b329ee7cc2e1d1/mtcars.csv"
dat <- read_delim(infile,delim=",", col_types = cols())  
get_table(dat,logit=TRUE, wanted_cols=c("model","mpg","wt"), data_title="Cool Table")

ui <- shinyUI(
  fluidPage(

    #  Application title
    titlePanel("Checkbox"),

    # Sidebar with sliders that demonstrate various available
    # options
    sidebarLayout(
      sidebarPanel(
        checkboxInput("checkbox", label = "Log Scale", value = FALSE)        
      ),

      # Show a table summarizing the values entered
      mainPanel(
        DT::dataTableOutput('myplot_table')
      )
    )
  )
)

server <- shinyServer(function(input, output, session) {

  output$value <- renderPrint({ input$checkbox })
  out_table <- get_table(dat,logit=FALSE, wanted_cols=c("model","mpg","wt"), data_title="Cool Table")
  output$myplot_table <- DT::renderDataTable(
    DT::datatable(out_table, options = list(pageLength = 10))
  )
})

shinyApp(ui = ui, server = server)

目前的应用程序看起来像这样:

现在，当我选中该框时，它不会将参数传递给 logit 函数。如果它有效，表中的值将被记录。

我的问题是如何将复选框值传递给 shinyServer() 中的参数？这个我试过了

out_table <- get_table(dat,logit=input$checkbox, wanted_cols=c("model","mpg","wt"), data_title="Cool Table")

但报错:

Warning: 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.)
Stack trace (innermost first):
    47: .getReactiveEnvironment()$currentContext
    46: .subset2(x, "impl")$get
    45: $.reactivevalues
    44: $ [/Users/pduboois/Desktop/Test/toy_app/etc/allinone_app.R#11]
    43: get_table [/Users/pduboois/Desktop/Test/toy_app/etc/allinone_app.R#11]
    42: server [/Users/pdubooisa/Desktop/Test/toy_app/etc/allinone_app.R#57]
     1: runApp
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.)

Answer 1

您将某些内容存储在输出 ( output$value <- renderPrint(...) ) 中，但您从未真正将该输出放入您的 UI 中。如果您将主面板更改为:

mainPanel(
        DT::dataTableOutput('myplot_table'),
        verbatimTextOutput('value')
      )

至少你看到了值(value)的出现。这个是TRUE或 FALSE .

你的第二个错误是忘记了你的 out_table应该是 react 性的。否则它只计算一次，即在应用程序初始化时。

因此将服务器中的分配更改为:

out_table <- reactive({
    get_table(dat,logit=input$checkbox, 
              wanted_cols=c("model","mpg","wt"), 
              data_title="Cool Table")})
output$myplot_table <- DT::renderDataTable(
    DT::datatable(out_table(), options = list(pageLength = 10))
  )

注意:您通过将其作为函数调用来获取 react 值的值(即在对 out_table() 的调用中使用 datatable)