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

我正在构建一个新的闪亮的应用程序，虽然它可以工作，但代码太广泛，没有我想要的那么被动。现在我在server.R

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

对于中的每个变量

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

 })

 ...

 }))

使用lappy和renderUI。但是

plotOutput(paste0('distPlot',i))

没有策划任何事情，而且

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

不要有条件地出现，相反，它总是存在的

---

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

我不确定您想对plotOutput调用执行什么操作，因为据我所知，没有包含任何链接到它的示例代码。但是，我成功地创建了一个工作示例，用于动态显示/隐藏正弦参数的选择框和文本字段

我发现将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)

---

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

paste返回一个字符串，这意味着在第一个Lappy循环中，输入[[paste0'trans'，i，='sine']]将解析为输入[[transday=='sine']]，它正在尝试从输入列表中选择名为transday=='sine'的元素。这样的元素不存在，因此conditionalPanel的条件输入计算结果为NULL。如果我更改为输入[[paste0'trans'，I]]=='sine'仍不起作用..您仍将传递一个字符串作为条件，该条件需要是一个逻辑值才能起作用。您需要将其更改为conditionalPanelcondition=input[[paste0'trans'，i]='sine'，..，不带引号，因为您建议我得到一个错误：if！is.naattribValue中的错误{：参数长度为零对不起，我似乎对conditionalPanel的条件参数下了结论。我以前没有使用过该函数，所以我只是假设它需要一个R条件-在检查文档后，我可以看出您的条件规范没有任何问题。我稍微做了些手脚，我想我找到了一个有效的解决方案。我将在下面发布。这非常有用！非常感谢！

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

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)