使用嵌入do.call（）中閃亮

Question

我試圖用閃亮+ 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') 
) 
) 

的代碼是不可運行的，問題是「帕」似乎是一成不變的，它僅包含第一次迭代的值。我知道應該有更好的方法來做到這一點，請提供代碼，如果你想出來，謝謝！

Answer 1

首先，代碼仍然不可再生原樣。我懷疑你已經在你的環境中運行了部分提供的代碼（例如，在我的機器上沒有找到你提供的代碼找到'pars'對象）。

其次，我想你剛纔提出的申請陳述過於複雜。 apply語句的思想是爲了提高代碼的可讀性，而不是for循環。在這裏你已經塞滿了lapply的陳述，很難解析任何東西。

爲了解決這個問題，我打破了組件分開成自己lapply語句（這是更爲平易近人現在）。什麼是你和以前的代碼發生的事情是，你的pars對象從a對象把所有的變量。一旦這些組件分離出來，我可以很容易地修改pars聲明來遍歷每個a元素。這爲每次迭代（即變量）提供了不同的值。我只包括server.R，因爲你的用戶界面沒有變化。

作爲您對下面的評論的後續支持，您確定interp和quote參數是不必要的（爲了清楚起見，我通常會避免再次使用它們，我的個人喜好）。至於最佳實踐，我將其概括爲「清晰然後表現」的概念。如果你不確定你的物體，那麼看看他們！下面你會發現一個更新的server.R文件。我也對它進行了最低限度的評論。您還可以找到訪問bsGroupButton值的示例。你可以看到它是你必須引用的組編號。這應該讓你開始（一定要加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)) 
    }) 
})