Nevedha Ayyanar
Reputation: 865
Enabling and disabling ActionButton dynamically in RShiny
I am developing an application in RShiny. There is a complete button. It's ID is "submit" The complete button should be enabled only when certain details are filled. Initially there are three Numeric Inputs. The ID's are "current", "next", "next1".
The screenshot of Numeric Input is:
Following it, there are three selectize Inputs. The ID's are "sel1", "sel2", "sel3".
The screenshot of Selectize Input is:
Later, there are three textOutputs. The ID's are "text2", "text3", "text4". It should be 100%. To obtain 100%, 3 "reactive()" are used.
This is the RCode used.
require(shiny)
require(shinyjs)
#install.packages("shinyjs")
ui = fluidPage( useShinyjs(),
inlineCSS(list('.lightpink' = "background-color: lightpink",'.red' = "background-color: red", "textarea" = 'text-align: center', '#text3 ' = 'text-align: center', '.form-control' = 'padding:8.5px ')),
fluidRow(
column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
),
column(3, actionButton("submit", "Complete"))
),
fluidRow(
column(3,tags$h3("Actual Work Hours")
),
column(3, wellPanel(
numericInput("current", "Current Week",value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next1", "Next Week", value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next2", "Two weeks from now", value = 40, min = 40, max = 80)
))),
fluidRow(
column(3,tags$h3("About Your Work-Week")
),
column(3, wellPanel(
selectizeInput("sel1", "How was your current week?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Current week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel2", "How busy will be the next week?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Next week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel3", "How busy will be the next two weeks?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Next two week",
onInitialize = I('function() { this.setValue(""); }')
))))),
fluidRow(uiOutput("inputGroup")),
fluidRow(column(3,wellPanel(textOutput("text3")),
tags$head(tags$style("#text3{color: white;
font-style: italic;
}"
)
)))
)
# takes in two arguments
sumN <- function(a, x){
a <- sum(a, as.numeric(x),na.rm=T)
return(a)
}
server <- function(input, output, session) {
Widgets <- eventReactive(input$View,{ input_list <- lapply(1:(input$count),
function(i) {
inputName <- paste("id", i, sep = "")
textInputRow <- function (inputId,value) {
textAreaInput(inputName,"", width = "200px", height = "43px", resize = "horizontal" )
#numericInput(inputName,"",1,0,100)
}
column(4,textInputRow(inputName, "")) })
do.call(tagList, input_list)},ignoreInit = T)
output$inputGroup = renderUI({Widgets()})
getvalues <- reactive({
val <- 0
for(lim in 1:input$count){
observeEvent(input[[paste0("id",lim)]], {
updateTextAreaInput(session,paste0("id",lim), value = ({
x = as.numeric(input[[paste0("id",lim)]])
if(!(is.numeric(x))){0}
else if(!(is.null(x) || is.na(x))){
if(x < 0){
0
}else if(x > 100){
100
} else{
return (isolate(input[[paste0("id",lim)]]))
}
}
else if((is.null(x) || is.na(x))){
0
}
})
)
})
req(as.numeric(input[[paste0("id",lim)]]) >= 0 & as.numeric(input[[paste0("id",lim)]]) <= 100)
val <- sumN(val,as.numeric(input[[paste0("id",lim)]]))
}
val
})
output$text3 <- renderText({
getvalues()
})
observeEvent(getvalues(), {
nn <- getvalues()
if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn)) & nn == 100) {
removeClass("text3", 'red')
addClass('text3','lightpink')
} else { addClass('text3','red')}
})
}
shinyApp(ui=ui, server = server)
The above code does not produce desired output. In short, the Complete button should be enabled only when Numeric Input, Selectize Input are filled and textOutput should be 100%. Can anyone provide a solution for this issue?
Upvotes: 1
Views: 1364
Answers (1)
amrrs
Reputation: 6325
Updated the code with disable and enable of shinyjs and also to account the condition of work week selection.
require(shiny)
require(shinyjs)
#install.packages("shinyjs")
ui = fluidPage( useShinyjs(),
inlineCSS(list('.lightpink' = "background-color: lightpink", ".hide1"="display:none",'.red' = "background-color: red", "textarea" = 'text-align: center', '#text3 ' = 'text-align: center', '.form-control' = 'padding:8.5px ')),
fluidRow(
column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
),
column(3, actionButton("submit", "Complete"))
),
fluidRow(
column(3,tags$h3("Actual Work Hours")
),
column(3, wellPanel(
numericInput("current", "Current Week",value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next1", "Next Week", value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next2", "Two weeks from now", value = 40, min = 40, max = 80)
))),
fluidRow(
column(3,tags$h3("About Your Work-Week")
),
column(3, wellPanel(
selectizeInput("sel1", "How was your current week?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Current week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel2", "How busy will be the next week?",
choices = c("aa",
"bb",
"cc"),
selected = NULL,
options = list(
placeholder = "Next week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel3", "How busy will be the next two weeks?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Next two week",
onInitialize = I('function() { this.setValue(""); }')
))))),
fluidRow(uiOutput("inputGroup")),
fluidRow(column(3,wellPanel(textOutput("text3")),
tags$head(tags$style("#text3{color: white;
font-style: italic;
}"
)
)))
)
# takes in two arguments
sumN <- function(a, x){
a <- sum(a, as.numeric(x),na.rm=T)
return(a)
}
server <- function(input, output, session) {
Widgets <- eventReactive(input$View,{ input_list <- lapply(1:(input$count),
function(i) {
inputName <- paste("id", i, sep = "")
textInputRow <- function (inputId,value) {
textAreaInput(inputName,"", width = "200px", height = "43px", resize = "horizontal" )
#numericInput(inputName,"",1,0,100)
}
column(4,textInputRow(inputName, "")) })
do.call(tagList, input_list)},ignoreInit = T)
output$inputGroup = renderUI({Widgets()})
getvalues <- reactive({
val <- 0
for(lim in 1:input$count){
observeEvent(input[[paste0("id",lim)]], {
updateTextAreaInput(session,paste0("id",lim), value = ({
x = as.numeric(input[[paste0("id",lim)]])
if(!(is.numeric(x))){0}
else if(!(is.null(x) || is.na(x))){
if(x < 0){
0
}else if(x > 100){
100
} else{
return (isolate(input[[paste0("id",lim)]]))
}
}
else if((is.null(x) || is.na(x))){
0
}
})
)
})
req(as.numeric(input[[paste0("id",lim)]]) >= 0 & as.numeric(input[[paste0("id",lim)]]) <= 100)
val <- sumN(val,as.numeric(input[[paste0("id",lim)]]))
}
val
})
output$text3 <- renderText({
getvalues()
})
observeEvent(getvalues(), {
nn <- getvalues()
if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn)) & nn == 100) {
removeClass("text3", 'red')
addClass('text3','lightpink')
if(input$sel1 != "" & input$sel2 != "" & input$sel3 != "") {
enable('submit')
}
#removeClass('submit','hide1')
} else { addClass('text3','red'); #addClass('submit','hide1');
disable('submit')
}
})
}
shinyApp(ui=ui, server = server)
Upvotes: 1
Related Questions
- How to disable one button in a Shiny actionGroupButtons input
- How can I toggle the Action Button on/off using ShinyJS?
- Disable and enable actionButton() by pushing another actionButton() in a shiny app
- How to automatically trigger an action button in R Shiny
- Running codes upon clicking on Action Button in R shiny
- How to enable and disable an Actionbutton in RShiny
- Execute function only on first button press in rshiny
- In RShiny, using actionButton values within conditionalPanel causing many headaches
- R Shiny Action Button to Affect Reactive Control
- actionButton in RShiny : alternative to reset value