R Shiny - Hiding an Output When a Value Changes - r

I Would like to make a form type Shiny app where the output is shown when a user clicks and action button, but the output is subsequently hidden if an input values changes.
Here is an example:
library(shiny)
library(shinyjs)
ui <- fluidPage(
radioButtons("myRadioButton", label = h4("Radio Input"),
choices = list("A" = 0,
"B" = 1,
"C" = 2),
selected = character(0)),
numericInput("myNumericInput", label = h4("Numeric Input"),
value = NA, min = 0, max = 50, step = 1),
actionButton("submit", "Submit"),
textOutput("myOutput")
)
server <- function(input, output, session){
score <- reactive({
scoreOut <- paste(input$myRadioButton, input$myNumericInput)
})
observeEvent(input$myRadioButton, {
hide("myOutput")
})
observeEvent(input$myNumericInput, {
hide("myOutput")
})
observeEvent(input$submit, {
show("myOutput")
output$myOutput <- renderText({
paste("This is your value:", score())
})
})
}
shinyApp(ui, server)
So in the above example the output displays after "Submit" is clicked. What I would like is if you go back and change say the radio or numeric input, the output disappears until "Submit" is clicked again.

You missed the useShinyjs() in the UI to load the JavaScript required to execute the hide function:
library(shiny)
library(shinyjs)
ui <- fluidPage(
# load required Java Script
useShinyjs(),
radioButtons("myRadioButton",
label = h4("Radio Input"),
choices = list(
"A" = 0,
"B" = 1,
"C" = 2
),
selected = character(0)
),
numericInput("myNumericInput",
label = h4("Numeric Input"),
value = NA, min = 0, max = 50, step = 1
),
actionButton("submit", "Submit"),
textOutput("myOutput")
)
server <- function(input, output, session) {
score <- reactive({
scoreOut <- paste(input$myRadioButton, input$myNumericInput)
})
observeEvent(input$myRadioButton, {
hide("myOutput")
})
observeEvent(input$myNumericInput, {
hide("myOutput")
})
observeEvent(input$submit, {
show("myOutput")
output$myOutput <- renderText({
paste("This is your value:", score())
})
})
}
shinyApp(ui, server)

Related

Disable button in UI based on input from module in Shiny app

In a Shiny app, I’m trying to disable/enable an action button in the UI of the main app based on user's input from a module. Basically, I want the “Next Page” (submit) button to be disabled until the user responds to the last item (item3). When the user responds to the last item, I want the button to be enabled. However, my app isn’t updating the toggle state of the action button.
Here’s a minimal reproducible example using a {Golem} structure:
app_ui.R:
library("shiny")
library("shinyjs")
app_ui <- function(request) {
tagList(
useShinyjs(),
fluidPage(
mod_mod1_ui("mod1_ui_1"),
actionButton(inputId = "submit",
label = "Next Page")
)
)
}
app_server.R:
library("shiny")
library("shinyjs")
app_server <- function( input, output, session ) {
state <- mod_mod1_server("mod1_ui_1")
# Enable the "Next Page" button when the user responds to the last item
observe({
toggleState("submit", state == TRUE)
})
}
mod_mod1.R:
library("shiny")
library("shinyjs")
mod_mod1_ui <- function(id){
ns <- NS(id)
tagList(
radioButtons(inputId = ns("item1"),
label = "Item 1",
choices = c(1, 2, 3, 4),
selected = character(0)),
radioButtons(inputId = ns("item2"),
label = "Item 2",
choices = c(1, 2, 3, 4),
selected = character(0)),
radioButtons(inputId = ns("item3"),
label = "Item 3",
choices = c(1, 2, 3, 4),
selected = character(0))
)
}
mod_mod1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
# When the user completes the last survey question
completed <- logical(1)
observe({
lastQuestion <- input$item3
if(!is.null(lastQuestion)){
completed <- TRUE
} else {
completed <- FALSE
}
browser()
})
return(completed)
})
}
Using browser() statements, it appears that the completed variable is correctly being updated in the module, but that the state variable isn’t updating in the main app.
I am not clear if you want this to work when the user responds to only item3 or all items (1 thru 3). I am assuming that it is the latter. However, you can modify as your use case requires it. Defining a reactiveValues object works. Try this
library("shiny")
library("js")
mod_mod1_ui <- function(id){
ns <- NS(id)
tagList(
radioButtons(inputId = ns("item1"),
label = "Item 1",
choices = c(1, 2, 3, 4),
selected = character(0)),
radioButtons(inputId = ns("item2"),
label = "Item 2",
choices = c(1, 2, 3, 4),
selected = character(0)),
radioButtons(inputId = ns("item3"),
label = "Item 3",
choices = c(1, 2, 3, 4),
selected = character(0))
)
}
mod_mod1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
# When the last survey question is completed
rv <- reactiveValues(completed=1)
observe({
lastQuestion <- input$item3
if(!is.null(lastQuestion) & !is.null(input$item2) & !is.null(input$item1)){
rv$completed <- 1
} else {
rv$completed <- 0
}
print(rv$completed )
#browser()
})
return(rv)
})
}
app_ui <- function(request) {
fluidPage(
useShinyjs(),
tagList(
mod_mod1_ui("mod1_ui_1"),
actionButton(inputId = "submit",
label = "Next Page")
)
)
}
app_server <- function( input, output, session ) {
state <- mod_mod1_server("mod1_ui_1")
# Don't show "Next Page" button until last item is completed
observe({
toggleState("submit", state$completed == TRUE)
})
}
shinyApp(ui = app_ui, server = app_server)

A shiny app that appends numbers to a 1D vector

I would like this app to add whatever number is selected (above zero) in the numeric input to a 1d vector every time that the button is pressed. It should then present that vector as a list of numbers in a box.
library(shiny)
options(shiny.autoreload = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "minrep"),
dashboardSidebar(
numericInput("number",
label = "Enter a number",
value = 0,
min = 1,
max = 100000),
actionButton(
"add.number",
label = "add a number"
),
box(
title = "List of numbers",
span(
textOutput("numbers"),
style = "color:black"
)
)
),
dashboardBody()
)
server <- function(input, output, session) {
list_numbers <- c()
new_number <-
eventReactive(input$add.number, {
input$number
})
observeEvent(input$add.number,{
list_numbers <- append(list_numbers, new_number())
})
output$numbers <- renderText(
list_numbers
)
}
shinyApp(ui, server)
Sure, the trick will be to store our vector as a reactiveValue, so we can access it and change it from wherever we want.
library(shiny)
ui <- fluidPage(
numericInput("number", label = "Enter a number", value = 1, min = 1, max = 100000),
actionButton("add.number", label = "add a number"),
textOutput("numbers")
)
server <- function(input, output, session) {
#Reactive value to store our vector
reactives <- reactiveValues(
list_numbers = c()
)
#Button is pressed
observeEvent(input$add.number, {
reactives$list_numbers <- append(reactives$list_numbers, input$number)
})
#Textbox Output
output$numbers <- renderText(
reactives$list_numbers
)
}
shinyApp(ui, server)

Using a reactive value in an IF-statement in the UI in R Shiny

I am trying to create a conditional UI in Shiny that depends on the input of a user. I specifically want to do the if in the UI part and NOT in the server part.
Here is an example of what I aim to accomplish.
# app.R
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
if(output$out < 50){
shinyjs::hide(shiny::mainPanel(h1(textOutput("text"))))
}else{
shiny::mainPanel(h1(textOutput("text")))
}
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
var <- shiny::reactive(input$a)
output$out <- renderText({ var() })
}
shiny::shinyApp(ui = ui, server = server)
Is there a way that I can use the reactive value in the UI part of the function?
I think conditionalPanel could be a good solution for what you want to do
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
shiny::mainPanel(
conditionalPanel(
condition = "input.a > 50",
h1(textOutput("text")))
)
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
}
shiny::shinyApp(ui = ui, server = server)
Hope this helps!!

Getting an input list containing inputs present in the current session

I want to retrieve the list of inputs in the current shiny session.
We can retrieve the list of inputs using names(input).
I have a uiOutput and based on different conditions I am rendering different types inputs. The current problem I am facing is that when the condition changes the inputs from previous renderUI is also present in the list. Is there a way to get only the inputs in the current session?
To explain my query better I have the following sample code:
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output){
observeEvent(input$slider,{
if(input$slider == 1){
output$UI <- renderUI(
textInput("txt1",label = "Slider in position 1")
)
}else if(input$slider == 2){
output$UI <- renderUI(
textInput("txt2",label = "Slider in position 2")
)
}else{
output$UI <- renderUI(
textInput("txt3",label = "Slider in position 3")
)
}
})
observeEvent(input$btn,{
output$textOp <- renderText(
paste0(names(input), ",")
)
})
}
shinyApp(ui = ui, server = server)
In the above code when I first click on action button labelled "Show Input" I get the following text as the output:
btn, slider, txt1,
Now when I move the slider to 2 my output is as follows:
btn, slider, txt1, txt2,
Here txt1 was generated when the slider was at position 1, and this renderUI was overridden by output$UI <- renderUI(textInput("txt2",label = "Slider in position 2")). I want an input list where txt1 is not there. Is there a way to do that?
I came up with kind of a workaround, assuming you dont have any inputs that should take a value of NULL. You could set the values of the inputs, that you wish to remove, to NULL and filter for non - NULLs when you display the names.
library(shiny)
ui <- fluidPage(
tags$script("
Shiny.addCustomMessageHandler('resetValue', function(variableName) {
Shiny.onInputChange(variableName, null);
});
"
),
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output, session){
observeEvent(input$slider,{
for(nr in 1:3){
if(nr != input$slider) session$sendCustomMessage(type = "resetValue", message = paste0("txt", nr))
}
})
output$UI <- renderUI(
textInput(paste0("txt", input$slider), label = paste0("Slider in position ", input$slider))
)
global <- reactiveValues()
observe({
inp = c()
for(name in names(input)){
if(!is.null(input[[name]])){
inp <- c(inp, name)
}
}
isolate(global$inputs <- inp)
})
output$textOp <- renderText({
global$inputs
})
}
shinyApp(ui = ui, server = server)

How to overwrite output using 2nd action button

I have a shiny app which writes a dataframe to output when an action button is pressed. This is the "Go" button in the bare-bones example below. I have a reset button which resets the values of the inputs. I'm wondering how I might also reset the output (so it becomes NULL & disappears when "reset" is pressed).
I've tried to pass input$goButtonReset to the eventReactive function (with the intention of using an if statement inside to indicate which button was making the call) but this didn't seem to be possible.
Any help much appreciated!
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
observeEvent(input$goButtonReset, {
updateSelectInput(session, "Input1", selected = "NULL")
})
writePF <- eventReactive(input$goButton, {
data.frame("test output")
})
output$pf <- renderTable({
writePF()
})
}
shinyApp(ui = ui, server = server)
You could try using reactiveValues to store the data frame. This worked for me:
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
df <- reactiveValues()
observeEvent(input$goButton,{
df$writePF <- data.frame("test output")
})
observeEvent(input$goButtonReset,{
df$writePF <- NULL
})
output$pf <- renderTable({
df$writePF
})
}
shinyApp(ui = ui, server = server)

Resources