I'm building a section for my app and I'm struggling to create the desired output.
I have: n checkboxInput
s for my 'channels' then i checkboxGroupInput
s of parameters for each channel (identical sets) and j checkboxGroupInput
s of calculations to select for each ChannelxParameter combination.
I deliberately didn't go overboard, so I chose not to allow the user to choose different statistics per Channel * Parameter combination.
What I am looking to get as reactive output
is a named
list
:
1. where names are combined names of input
of the Channels and Parameters: i.e. paste('Channel', 'Parameter')
2. "values" are text strings of the selected statistics / calculations
3. The list
should only contain the names of selected channel.parameter combination
4. Remove the list
element or value from the list
if the user deselects a statistic, parameter or channel
In this case the expected output
would be a list
that looks like this:
$SWS.Height
[1] "Sum" "Max"
$SWS.Total
[1] "Sum" "Max"
$FL.Red.Height
[1] "Mean" "Stdev"
$FL.Red.Width
[1] "Mean" "Stdev"
App
: so far only print
s what is selected
library(shiny)
Channels <- c('SWS', 'FWS', 'FL.Red', 'FL.Orange', 'FL.Yellow')
Parameters <- c('Height', 'Width', 'Average', 'Total', 'Slope', 'Fill.Factor', 'Correlation.Coeff', 'Fill.Factor')
ui <- fluidPage(
h5('Channels', style = 'font-weight:bold'),
fluidRow(
lapply(Channels, function(x) {
column(2, checkboxInput(inputId = paste('Channel', x, sep = ''), label = x))
})
),
h5('Parameters', style = 'font-weight:bold'),
fluidRow(
lapply(Channels, function(x) {
column(2,
checkboxGroupInput(inputId = paste("Parameters", x, sep = ''), label = NULL, choiceValues =Parameters,
choiceNames = gsub('\\.', '\\ ', Parameters)) )})
),
h5('Statistics', style = 'font-weight:bold'),
fluidRow(
lapply(Channels, function(x) {
column(2,
checkboxGroupInput(paste("Calculations", x, sep = ''), label = NULL, c('Sum', 'Mean', 'Stdev', 'Max', 'Coef.Var'))
)
})
)
)
server <- function(input, output, session) {
values <- reactiveValues(Statisticlist = list())
## build observer to deselect all sub category checkboxes if channel is deselected
lapply(Channels, function(x) {
observeEvent(input[[paste('Channel', x, sep = '')]], {
if(!input[[paste('Channel', x, sep = '')]]) {
updateCheckboxGroupInput(session, inputId = paste("Parameters", x, sep = ''), selected=character(0))
updateCheckboxGroupInput(session, inputId = paste("Calculations", x, sep = ''), selected=character(0))
}
})
})
## attempt to fill named list with selection, and remove it when deselected
observe({
lapply(Channels, function(x) {
if(input[[paste('Channel', x, sep = '')]]) {
if(!is.null(input[[paste("Parameters", x, sep = '')]])) {
if(!is.null(input[[paste("Calculations", x, sep = '')]])) {
print(paste(x, input[[paste("Parameters", x, sep = '')]], sep = '.'))
print(input[[paste("Calculations", x, sep = '')]])
# values$Statisticlist <- list(paste(x, input[[paste("Parameters", x, sep = '')]], sep = '.') = input[[paste("Calculations", x, sep = '')]]) ## what to do here....
}
}
}
})
})
}
shinyApp(ui, server)
Aucun commentaire:
Enregistrer un commentaire