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

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 调用做什么，因为据我所知，没有包含任何链接到它的示例代码。但是，我设法为动态 showing/hiding 正弦参数的选择框和文本字段组合了一个工作示例。

我发现将 ui 代从服务器移至 ui 更容易实现。这解决了为尚不存在的输入评估条件的问题，因为在 ui 方面，函数只是写 html.

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

代码：

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。对于动态 showing/hiding 或 enabling/disabling 对象，Dean Attali (link) 的包 shinyjs 有一些不错的工具，允许您仅使用R 语法。

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

renderUI+lapply: trying to build a better code

r

shiny