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

你快到了！只需使其具有反应性，以便根据其反应值（复选框）进行更改：

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

并在out_table()中使用out_table代替output$myplot_table。

Answer 2

您将某些内容存储在输出（output$value <- renderPrint(...)）中，但实际上并未将该输出放在UI中。如果您将主面板更改为：

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

至少你看到价值出现了。这个是TRUE或FALSE。

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

因此，请将服务器中的分配更改为：

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

注意：通过将其称为函数（即out_table()调用中的datatable）来获取无效值的值

如何将复选框输入传递给shinyServer（）中的函数

2 个答案: