Using embedded do.call() in Shiny - shiny

Question

I'm trying to use Shiny + ShinyBS to create a collapsible panel whitch contains a bunch of column values per column.
However, I'm having trouble in applying do.call correctly (or in the sequence I want).
Source code for 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))
})
})
Source code for ui.R:
require(shiny)
shinyUI(
fluidPage(
uiOutput('plot')
)
)
The code can NOT run! The problem is pars seems to be static, it only contains the value of the first iteration.

Answer 1

Firstly, the code was still not reproducible as is. I suspect you had run parts of the provided code within your environment (e.g. the 'pars' object was not found with your provided code on my machine).
Second, I think you have just made your apply statements too complex. The idea of apply statements is to improve readability of your code as opposed to for loops. Here you have crammed so much in to the lapply statements that it is difficult to parse out anything.
To address this, I broke the components apart into their own lapply statements (which is far more approachable now). What was happening with your previous code is that your pars object was taking all the variables from the a object. Once these components were separated, I could easily just alter the pars statement to iterate through each a element. This provides the different values for each iteration (i.e. variable). I have only included the server.R as there is not changes to your ui.R
As a followup to your comments below, you are correct that the interp and quote arguments are unnecessary (I generally avoid them again for clarity, my personal preference). As for best practices, I sum it up in one concept 'clarity then performance'. If you are unsure about your objects then LOOK AT THEM! Below you will find an updated server.R file. I have also minimally commented it. You will also find an example of accessing the bsGroupButton values. You can see it is the group id that you must reference. This should get you started (be sure to add tableOutput('result') to your ui.R. I highly recommend you look into the documentation of ShinyBS or at least the demo page.
Concise and annotated 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)
})
})
original answer for 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))
})
})