Shiny - reset the value of the input when it is hidden? - r

How can I reset the value of an input when it is hidden? Or better - don't send the data to the server when it is hidden. Is it possible?
For instance:
shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
radioButtons(
inputId = "switch",
label = "Select hide or show:",
choices = c(
"Show" = "show",
"Hide" = "hide"
),
selected = NULL,
inline = FALSE
),
conditionalPanel(
condition = "input.switch == 'show'",
numericInput("n", "N:", min = 0, max = 100, value = 0)
),
actionButton("goButton", "Go!")
),
mainPanel(
textOutput("text")
)
))
shinyServer(function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$text <- renderText({
ntext()
})
})
The UI still sends the data of this numericInput to the server when 'Hide' is checked and the numericInput is hidden. I don't want the UI sends the data when the input is hidden. Or - reset it to 0.
Any ideas?

Related

Update multiple shiny apps inputs with different input widget types

I have designed a Shiny app with two action buttons, Save and Clear. When users click Save, the input values will be stored using local storage of the web browser. When users click Clear, the inputs and local storage would be cleaned.
These functionalities involves updating multiple inputs with update...Input. In this example, I have three inputs all with different widget types. I can specifically write them one by one, which works fine. However, I am wondering if there is a more efficient way to achieve this, such as using for loop or lapply. From this post (https://stackoverflow.com/a/41061114/7669809), it seems like I can use reactiveValuesToList to get all inputs. The real challenge to me is how to dynamically call different update...Input functions for the associated input widget types?
Please let me know if you have any suggestions.
### This script creates an example of the shinystore package
# Load packages
library(shiny)
library(shinyStore)
ui <- fluidPage(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
initStore("store", "shinyStore-ex1"),
textInput(inputId = "Text1", label = "Enter some texts")
),
mainPanel = mainPanel(
fluidRow(
numericInput(inputId = "Number1", label = "Enter a number", value = NA),
sliderInput(inputId = "Slider1", label = "Pick a number", min = 0, max = 100, value = 50),
actionButton("save", "Save", icon("save")),
actionButton("clear", "Clear", icon("stop"))
)
)
)
)
server <- function(input, output, session) {
observe({
if (input$save <= 0){
updateTextInput(session, inputId = "Text1", value = isolate(input$store)$Text1)
updateNumericInput(session, inputId = "Number1", value = isolate(input$store)$Number1)
updateSliderInput(session, inputId = "Slider1", value = isolate(input$store)$Slider1)
}
updateStore(session, name = "Text1", isolate(input$Text1))
updateStore(session, name = "Number1", isolate(input$Number1))
updateStore(session, name = "Slider1", isolate(input$Slider1))
})
observe({
if (input$clear > 0){
updateTextInput(session, inputId = "Text1", value = NA)
updateNumericInput(session, inputId = "Number1", value = NA)
updateSliderInput(session, inputId = "Slider1", value = 50)
updateStore(session, name = "Text1", value = NA)
updateStore(session, name = "Number1", value = NA)
updateStore(session, name = "Slider1", value = 50)
}
})
}
shinyApp(ui, server)
Unfortunately there is no generic updateInput function in shiny. It is still possible to build a wrapper that identifies a certain name to a certain input type, but that will also require to know which argument is allowed or no. For example, updateActionButton doesn't have value or choices as an argument so we'll need numerous if statements.
A possible workaround is to take advantage of renderUI and directly pass the stored values. The only downside is that some functions like SliderInput throw an error when some arguments are NULL, so an if statement is needed to appoint a default value for the first time the app runs. Alternatively a mock app can be executed once to only fill the first values.
Code:
library(shiny)
library(shinyStore)
library(tidyverse)
ui <- fluidPage(
initStore("store", "shinyStore-ex1"),
uiOutput('ui_all'))
server <- function(input, output, session) {
output$ui_all <- renderUI({
tagList(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
textInput(inputId = "Text1", label = "Enter some texts",value = input$store$Text1)
),
mainPanel = mainPanel(
fluidRow(
numericInput(inputId = "Number1", label = "Enter a number", value = input$store$Number1),
sliderInput(inputId = "Slider1", label = "Pick a number", min = 0, max = 100, value = if(is.null(input$store$Slider1)){50} else{input$store$Slider1}),
actionButton("save", "Save", icon("save")),
actionButton("clear", "Clear", icon("stop"))
)
)
))
})
input_nms <- map(c('Text', 'Number', 'Slider'), ~str_c(.x, 1:1)) %>%
reduce(c)
#or if every type of input is repeteated n different times.
# input_nms <- map2(c('Text', 'Number', 'Slider'), c(n1, n2, n3), ~str_c(.x, 1:.y)) %>%
# reduce(c)
observeEvent(input$save, {
input_nms %>%
walk(~updateStore(session = session, name = .x, value = isolate(input[[.x]])))
session$reload() #to force the UI to render again with the new values
})
observeEvent(input$clear, {
input_nms %>%
walk2(c(NA, NA, 50), ~updateStore(session = session, name = .x, value = .y))
})
}
shinyApp(ui, server)

Display selectInput and sliderInput values on action button click

Created an App in which i wanted to take sliderInput and selectInput from user & display it when we click on action button. Intially when we run the app code works fine but when we change the values in sliderInput & selectInput output is displayed automatically without clicking on button.
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar
sidebarLayout(
sidebarPanel(
sliderInput("tm", "select the interval", min = 0, max = 20,value = 10),
selectInput("samples", label = "Select the sample type", c("Sample A","Sample B","Sample C")),
actionButton("act", label = " Update" )
),
mainPanel(
textOutput("val"),
br(),
textOutput("sam")
)
)
))
shinyServer(function(input, output) {
observe(
if(input$act>0){
output$val <- renderText(
paste("You selected the value" ,input$tm)
)
output$sam <- renderText(input$samples)
}
)
})
I want to change the value only when we click action button.
Instead of observe, you can make your output values as eventReactive.
Here is the server side codes (as nothing in ui side has to be changed).
shinyServer(function(input, output) {
val = eventReactive(input$act, {
paste("You selected the value" ,input$tm)
})
sam = eventReactive(input$act, {
input$samples
})
output$val = renderText(
val()
)
output$sam = renderText(
sam()
)
})

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)

Hiding or showing shiny elements without pressing submit

I have a shiny app where i want to hide or show some elements based on user input. This i tried to do by using conditionalPanel in shiny. However, it works only after pressing the submit button. I want to hide or show the textInput element without pressing the submit button. Below is an example what I tried.
UI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("n", "N:", min = 10, max = 1000, value = 200,
step = 10),
checkboxInput("checkbox", label = "Message", value = FALSE),
conditionalPanel(
condition = "input.checkbox == true",
textInput("text", "Text:", "text here")),
submitButton("Submit")
)),
column(6,
plotOutput("plot1", width = 400, height = 300),
verbatimTextOutput("text")
)
)
))
Server.R
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
})
I want to show the textInput as soon as user checks the checkbox and hide it on uncheck without any dependency on submit button.
You can try
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("n", "N:", min = 10, max = 1000, value = 200,
step = 10),
checkboxInput("checkbox_1", label = "Message", value = FALSE),
uiOutput('test')
,actionButton("Submit",label ="Submit" )
)),
column(6,
plotOutput("plot1", width = 400, height = 300),
verbatimTextOutput("text")
)
)
))
server:
shinyServer(function(input, output,session) {
output$test=renderUI({
if(input$checkbox_1==T){
list(textInput("text", "Text:", "text here"),
numericInput("num","num",0), numericInput("num1","num1",0))}
})
observeEvent(input$Submit,{
output$plot1 <- renderPlot({
hist(rnorm(isolate(input$n)))
})
output$text <- renderText({
paste("Input text is:", isolate(input$text))
})
})
})

Shiny: How to make reactive value initialize with default value

Consider the following actionButton demo:
http://shiny.rstudio.com/gallery/actionbutton-demo.html
server.R:
shinyServer(function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
ntext()
})
})
ui.R:
shinyUI(pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
))
In this example, prior to the action button being pressed, the right-hand side panel is empty. I would instead like the text with default value "50" to be rendered by default.
How to I get the output to display with default inputs if the action button has not yet been pressed?
eventReactive also takes ignoreNULL as documented here, which lets you initialise the object without an if statement.
By adding the ,ignoreNULL = FALSE to the original post (give or take some formatting), verbatimTextOutput shows 50 on startup.
This makes for a bit of economy on the server side I guess.
ui <- fluidPage(titlePanel("actionButton test"),
sidebarLayout(
sidebarPanel(
numericInput(
"n",
"N:",
min = 0,
max = 100,
value = 50
),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(verbatimTextOutput("nText"))
))
server <- function(input, output) {
ntext <- eventReactive(input$goButton, {
input$n
}
# Adding this parameter to the original example makes it work as intended
# with 50 in the output field to begin with
, ignoreNULL = FALSE
)
output$nText <- renderText({
ntext()
})
}
shinyApp(ui = ui, server = server)
shinyServer(function(input, output) {
values <- reactiveValues(default = 0)
observeEvent(input$goButton,{
values$default <- input$goButton
})
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
if(values$default == 0){
50
}
else{
ntext()
}
})
})

Resources