Question

我正在尝试使用Shiny + ShinyBS创建可折叠面板，每列包含一堆列值。但是，我在正确应用do.call（或按照我想要的顺序）时遇到了麻烦。

server.R的源代码

require(shiny)
library(lazyeval)
library(shinyBS)

l <- lapply(mtcars,function(x)unique(x))

shinyServer(function(input, output) {
  output$plot <- renderUI({    
    col_list<- lapply(1:length(l), function(i) {
      col <- l[[i]]
      a<- lapply(1:min(length(col),10), function(j) {
        interp(quote(bsToggleButton(nm,lb)),.values=list(nm=paste0(names(l)[i],'_val_', j),lb=col[j]))
      })
      pars <- list(inputId =paste0('btng_',names(l)[i]), label = '', value = '',a)

      interp(quote(bsCollapsePanel(names(l)[i],
                                   fluidRow(
                                     column(4,               
                                            do.call(bsButtonGroup,unlist(pars))
                                     )
                                   ),id=nm,value=val)),.values=list(i=i,nm=paste0('test_',i),val='')
      )
    })
    pars2 <- list(multiple = TRUE, open = "test_1", id = "collapse1",col_list)
    do.call(bsCollapse,unlist(pars2))
  })
})

ui.R的源代码

require(shiny)
shinyUI(
  fluidPage(
    uiOutput('plot')
  )
)

代码不可运行，问题是'pars'似乎是静态的，它只包含第一次迭代的值。我知道应该有更好的方法来做到这一点，如果你想出来请提供代码，谢谢！

Answer 1

首先，代码仍然不能再现。我怀疑你在你的环境中运行了部分提供的代码（例如，在我的机器上找不到你提供的代码的'pars'对象）。

其次，我认为你的申请陈述太复杂了。 apply语句的想法是提高代码的可读性，而不是for循环。在这里，你已经把lapply语句塞进了很多东西，很难解析出来。

为了解决这个问题，我将组件拆分为他们自己的lapply语句（现在更加平易近人）。您以前的代码发生的事情是您的pars对象正在从a对象中获取所有变量。一旦这些组件被分离，我就可以轻松地改变pars语句来迭代每个a元素。这为每次迭代（即变量）提供了不同的值。我只包含了server.R，因为你的ui.R没有变化

作为以下评论的后续内容，您是正确的interp和quote参数是不必要的（为了清晰起见，我通常会再次避免使用它们，我个人的偏好）。至于最佳实践，我总结一个概念“清晰度然后表现”。如果你不确定你的物品，那么看看他们！您将在下面找到更新的server.R文件。我也极少评论过它。您还将找到访问bsGroupButton值的示例。您可以看到必须引用的组ID 。这应该可以帮助您入门（务必将tableOutput('result')添加到您的ui.R.我强烈建议您查看ShinyBS或至少demo page的文档。

简明扼要的server.R

require(shiny)
library(shinyBS)

l <- lapply(mtcars,function(x)unique(x))

shinyServer(function(input, output) {

  output$plot <- renderUI({    

    # Create your buttons
    a <- lapply(1:length(l), function(i){
      col <- l[[i]]

      lapply(1:min(length(col),10), function(j){
        bsButton(paste0(names(l)[i], '_val_', j), label=col[j], value=col[j])
      })
    })

    # add the additional arguments for your future bsButtonGroup call
    pars <- lapply(1:length(l), function(i) {
      list(inputId =paste0('btng_',names(l)[i]), label = '', value = '',a[[i]])
    })


    col_list<-lapply(1:length(l), function(i) {

      # separate the components for clarity
      rawButtons <- unlist(pars[i], recursive=F)
      buttons <- do.call(bsButtonGroup, c(rawButtons[[4]], inputId=rawButtons$inputId))

      # collapse the groups into panels
      bsCollapsePanel(title=names(l)[i],
                      buttons, id=paste0('test_',i), value='')
    })

    # Collapse everything, no need for pars2, just add elements in a vector
    do.call(bsCollapse, c(col_list, multiple=TRUE, open="test_1", id="collapse1"))
  })

  output$result<- renderTable({ 

    df <- cbind(c("mpg toggle button", c(deparse(input$btng_mpg))))
    return(df)
    })

})

server.R

的原始答案

require(shiny)
library(shinyBS)
require(lazyeval)

l <- lapply(mtcars,function(x)unique(x))

shinyServer(function(input, output) {

  output$plot <- renderUI({    


    a <- lapply(1:length(l), function(i) {
      col <- l[[i]]

      lapply(1:min(length(col),10), function(j) {
        interp(
          quote(bsToggleButton(nm,lb))
          ,.values=list(nm=paste0(names(l)[i],'_val_', j),lb=col[j]))
      })
    })

    pars <- lapply(1:length(l), function(i) {
      list(inputId =paste0('btng_',names(l)[i]), label = '', value = '',a[[i]])
    })


    col_list<-lapply(1:length(l), function(i) {
      interp(
        quote(
          bsCollapsePanel(names(l)[i],
                                   fluidRow(
                                     column(4,               
                                            do.call(bsButtonGroup,unlist(pars[i]))
                                     )
                                   ),
                          id=nm,value=val))
        ,.values=list(i=i,nm=paste0('test_',i),val='')
      )
    })

    pars2 <- list(multiple = TRUE, open = "test_1", id = "collapse1",col_list)
    do.call(bsCollapse,unlist(pars2))
  })
})

在Shiny中使用嵌入式do.call（）

1 个答案: