2

我正在尝试使用 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”似乎是静态的，它只包含第一次迭代的值。我知道应该有更好的方法来做到这一点，如果你想通了，请提供代码，谢谢！

4

1 回答 1

1

首先，代码仍然无法按原样重现。我怀疑您已经在您的环境中运行了部分提供的代码（例如，在我的机器上没有使用您提供的代码找到“pars”对象）。

其次，我认为您刚刚使您的应用语句过于复杂。apply 语句的想法是提高代码的可读性，而不是 for 循环。在这里，您在陈述中塞进了太多东西，lapply以至于很难解析出任何东西。

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

作为您在下面评论的后续行动，您认为interpandquote参数是不必要的是正确的（为了清楚起见，我通常会再次避免使用它们，我个人的偏好）。至于最佳实践，我将其总结为一个概念“清晰度然后性能”。如果您不确定您的对象，那么看看他们！您将在下面找到更新的 server.R 文件。我也对它进行了最低限度的评论。您还将找到访问bsGroupButton值的示例。您可以看到它是您必须引用的组 ID 。这应该可以帮助您入门（请务必添加tableOutput('result')到您的 ui.R。我强烈建议您查看 ShinyBS 的文档或至少查看演示页面。

简洁和带注释的服务器.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))
  })
})
于 2014-10-13T13:58:29.527 回答