Question

我正在构建一个新的Shiny应用程序，虽然它有效但代码太广泛而且没有我想要的那么反应。现在我在server.R

dayData <- reactive({...})
pday <- function(data){...}
output$distPlotday <- renderPlot(function() {print(pday(dayData)) })

和ui.R

plotOutput("distPlotday")

中的每个变量

checkboxGroupInput("checkGroup", "Dataset Features:", 
   choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))

但我希望我能做更像这样的事情：

shinyServer(function(input, output, session) {
... 

output$sliders <- renderUI({
lapply(input$checkGroup, function(i) {
fluidRow(                          
  column(4, 
         selectInput(paste0('trans',i), i,
                     choices = c('linear','quadratic','sine')) ,
         conditionalPanel(
           condition = "input[[paste0('trans',i)]]== 'sine'",
           withMathJax(),
           h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
           textInput3(paste0('trans',i,'a'), h5('A:'), 
                      value = 10),
           textInput3(paste0('trans',i,'b'), h5('C:'), 
                      value = 1),
           textInput3(paste0('trans',i,'c'), h5('D:'), 
                      value = 0.1),
           helpText("Note: B has already been picked up")
         ),
         plotOutput(paste0('distPlot',i))
  ))
  })

 })

 ...

 }))

 shinyUI(navbarPage("",
               tabPanel("Data",
                        sidebarLayout(
                          sidebarPanel(
                            checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                               choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                               selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                          ),
                          mainPanel(
                            numericInput("obs", label = h5("Number of observations to view"), 15, min = 10, max = 20, step = 1),
                            tableOutput("view")
                          )
                        )
               ),
               tabPanel("Variable transformation", uiOutput(outputId = "sliders"))
               ))

使用lapply和renderUI。但是

plotOutput(paste0('distPlot',i))

没有绘制任何内容，而

conditionalPanel(condition = "input[[paste0('trans',i)]]== 'sine'",...)

不要有条件地出现，而是始终存在。

有什么建议吗？谢谢你的帮助！

Answer 1

我不确定你想对plotOutput调用做什么，因为据我所知，没有包含链接到它的任何示例代码。但是，我设法将一个工作示例放在一起，用于动态显示/隐藏正弦参数的选择框和文本字段。

我发现将ui生成从服务器移动到ui更容易实现。这解决了对尚不存在的输入进行评估的条件问题，因为在ui方面，函数只是编写html。

另一个好处是，这样每次复选框输入更改时都不会重新呈现输入字段 - 这意味着它们的值会通过打开和关闭来保持，并启用或禁用单个变量赢得' t导致其他人的值重置。

代码：

library(shiny)

vars <- c("day","hour","source","service","relevancy",
          "tollfree","distance","similarity")

ui <- shinyUI(navbarPage("",
  tabPanel("Data",
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
          choices = c("day","hour","source","service","relevancy",
                      "tollfree","distance","similarity"), inline = F,
          selected = c("day", "hour","source","service","relevancy",
                       "tollfree","distance","similarity")
        )
      ),

      mainPanel(
        numericInput("obs", label = h5("Number of observations to view"),
                     value = 15, min = 10, max = 20, step = 1),
        tableOutput("view")
      )
    )
  ),

  tabPanel("Variable transformation",
    fluidRow(                          
      column(4,
        lapply(vars, function(i) {
           div(
             conditionalPanel(
               condition =
                 # javascript expression to check that the box for 
                 # variable i is checked in the input
                 paste0("input['checkGroup'].indexOf('", i,"') != -1"),

               selectInput(paste0('trans',i), i,
                           choices = c('linear','quadratic','sine'))
             ),

             conditionalPanel(
               condition =
                 paste0("input['trans", i, "'] == 'sine' ",
                    " && input['checkGroup'].indexOf('", i,"') != -1"),

               withMathJax(),
               h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
               textInput(paste0('trans',i,'a'), h5('A:'), value = 10),
               textInput(paste0('trans',i,'b'), h5('C:'), value = 1),
               textInput(paste0('trans',i,'c'), h5('D:'), value = 0.1),
               helpText("Note: B has already been picked up")
             )
           )
        })
      )
    )
  )
))

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

shinyApp(ui, server)

PS。为了动态显示/隐藏或启用/禁用对象，Dean Attali（link）的包shinyjs有一些很好的工具，允许您仅使用R语法调用基本的javascript。

renderUI + lapply：尝试构建更好的代码

1 个答案: