So, you solve one problem and run into the next.
I've now succesfully build a part of code that dynamically creates uiOutput, i.e. a number of sliders, buttons and/or textfields and the amount of them depends on a value that comes rolling out of my model in an ealier step.
However, I'm pretty clueless how to observe whether they are "clicked" / "changed" by the user. Lets say, the model gives out a nr 12 then the server tells my ui to make 12 buttons. I want to know when the user pushes ANY of the buttons and WHICH button it is
To give a clear example in words: if user clicks button 8, i want to have R tell me "User clicked button 8". The objective is to have not only dynamic buttons, but also dynamic reactions to the use of them.
One of the final aims I have is to collect a list of yes / no answers and entered names for each of the elements. So I'm looking for a universal way to hang conditions to observeevent for button " i" or text field "j" and so on
Here is a fully functional minimal example of how I create the dynamic UI.
SERVER:
shinyServer = function(input, output, session) {
################# start functionality HOME TAB #############################
values <- reactiveValues()
observeEvent(input$myNr, {
values$nrofelements <- input$myNr })
observeEvent(values$nrofelements, {
if (values$nrofelements > 0 & values$nrofelements < 25) {
output$sliders <- renderUI({
lapply(1:values$nrofelements, function(j) {
sliderInput(inputId = paste0("ind", j), label = paste("Individual", j),
min = 0, max = 20000, value = c(0, 500), step = 100)
})
})
output$buttons <- renderUI({
lapply(1:values$nrofelements, function(i) {
div(br(),bsButton(inputId = paste0("indr", i), label = paste("Yes", i), block = FALSE, style = "succes"), br(), br() )
})
})
}
})
observe({
if(values$nrofelements != ""){
for(nr in 1:values$nrofelements){
if(!is.null(input[[paste0("indr", nr)]])) print(paste0("Inputname 'indr", nr, "': ", "value is ", isolate(input[[paste0("indr", nr)]])))
}
}
})
}
and the UI.r
library(shiny)
library(shinydashboard)
library(shinybs)
ui <- dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs", menuItem("Home", tabName = "Home", icon = icon("book"))
)
),
dashboardBody(
tabItems(
### HOME ###_________
tabItem(tabName = "Home", class = 'rightAlign',
h5("Enter desired nr of elements here"),
textInput(inputId ="myNr", label = NULL , placeholder = NULL),
fluidRow(
column(3,
uiOutput("sliders")),
column(1,
uiOutput("buttons")
)
),
textOutput('clickedwhat')
)
)
)
)
Ok, so after long puzzling I have managed to find an answer that works:
server.R
shinyServer = function(input, output, session) {
################# start functionality HOME TAB #############################
values <- reactiveValues()
dynamicvalues <- reactiveValues()
observeEvent (input$myNr, {
values$nrofelements <- paste0(input$myNr) })
#### RENDER DYNAMIC UI
observeEvent(values$nrofelements, {
if (isolate(values$nrofelements>0)) {
output$actionbuttons <- renderUI({
lapply(1:values$nrofelements, function(ab) {
if (!is.null(dynamicvalues[[paste0("button", ab)]])) { if(dynamicvalues[[paste0("button", ab)]] == 0 ) {
div(br(), actionButton(inputId = paste0("ind", ab), label = paste("highlight", ab)), br(), br()) }
else { div(br(), actionButton(inputId = paste0("ind", ab), label = paste("unhighlight", ab)), br(), br())} }
else {
div(br(), actionButton(inputId = paste0("ind", ab), label = paste("highlight", ab)), br(), br()) }
})
})
output$allbutton <- renderUI({ div( br(), br(), actionButton(inputId = "All", label = "All"), br(), br())
})
output$buttons <- renderUI({
lapply(1:values$nrofelements, function(bsb) {
div(br(),bsButton(inputId = paste0("indr", bsb), label = paste("Yes", bsb),
block = FALSE, style = "succes", onclick = paste0("Shiny.onInputChange('rnd',", bsb,")")), br(), br() )
})
})
output$multicheckbox <- renderUI ({
div( br(), checkboxInput(inputId = "multiselect", label ="allow multiselect", value = FALSE, width = NULL), br()) })
}
})
#### OBSERVE DYNAMIC UI
observeEvent( values$nrofelements, {
if (values$nrofelements> 0) {
isolate(lapply(1:values$nrofelements, function(su) {
dynamicvalues[[paste0("button", su)]] <- 0 }))
dynamiclistB <- reactiveValuesToList(dynamicvalues)
values$dynamiclistB2 <- as.character(unlist(dynamiclistB, use.names = FALSE))
isolate(lapply(1:values$nrofelements, function(ob) {
observeEvent(input[[paste0("ind", ob)]], {
if (input$multiselect == FALSE) {
for (clicked in 1:values$nrofelements) { if ( ob != clicked) { dynamicvalues[[paste0("button", clicked)]] <- 0} }}
if (is.null(dynamicvalues[[paste0("button", ob)]])) {dynamicvalues[[paste0("button", ob)]] <- 1}
else { if (dynamicvalues[[paste0("button", ob)]] == 1) {dynamicvalues[[paste0("button", ob)]] <- 0}
else { dynamicvalues[[paste0("button", ob)]] <- 1}
}
dynamiclist <- reactiveValuesToList(dynamicvalues)
values$dynamiclist2 <- as.character(unlist(dynamiclist, use.names = FALSE))
print(paste0("dl = ", toString(values$dynamiclist2)))
print(paste("ob =", ob ))
values$button_nr_clicked <- ob
myVector <- vector(mode="character", length=values$nrofelements)
myVector <- replace(myVector, myVector == "", "GREY")
myVector[values$button_nr_clicked]="RED"
print(paste("pallete = ", toString(myVector)))
print( "-----------next click event prints the below this line--------------------------------------------------------------")
}) }) ) }})
observeEvent(input$All,{
myVector <- NULL
myVector <- vector(mode="character", length=values$nrofelements)
myVector <- replace(myVector, myVector == "", "RED")
print(paste("pallete = ", toString(myVector)))
print( "-----------next click event prints the below this line--------------------------------------------------------------")
})
}
and the UI.R
library(shiny)
library(shinydashboard)
library(shinyBS)
ui <- dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs", menuItem("Home", tabName = "Home", icon = icon("book"))
)
),
dashboardBody(
tabItems(
### HOME ###_________
tabItem(tabName = "Home",
h5("Enter desired nr of elements here"),
textInput(inputId ="myNr", label = NULL , placeholder = "NULL"),
fluidRow(
column(3,
uiOutput("actionbuttons"),
uiOutput("allbutton")),
column(1,
uiOutput("buttons")
)
),
uiOutput("multicheckbox")
)
)
)
)
As you can see I build in some extra features like the "All" button, which I will use in reality to run a pallete with a rainbow of colors (each group in the plotly 3D scatter it's own color, and the "multi select check box so the user can hightlight either 1 group, or multiple.
what we have now is:
var 'ob' that reports the last clicked button var 'dl' that gives a list of 0's and 1's to see who's highlighted / clicked var 'pallete that converts the clicks into "RED" or "GREY" status
Next I will work on building text input fields to add a name to the groups, possibly a color picker so the user can custom compose his/her own pallete and a modification of the bsButtons into YES/NO buttons by conditionaly rendering the Label as YES or NO as i did with the highlight / unhighlight buttons to allow the user to select which groups to "keep" and which to "remove" for the next clustering phase.
Still wondering whether it's possible to achieve the same with the observer structure BigDataScientist started with.............