Display selectInput and sliderInput values on action button click - r

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()
)
})

Related

Display and hide actionButton based on 2 other actionButtons

Below I press the first actionButton() "Show" to display another actionButton() but I would like also a second actionButton() named "Hide" that will hide the actionButton() that is displayed after clicking the "Show".
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
uiOutput("button2")
)
)
))
server = shinyServer(function(input, output, session) {
observeEvent(input$button1, {
output$button2 <- renderUI({
actionButton("button2", label = "Press Button 2")
})
})
})
shinyApp(ui = ui, server = server)
One option is to put the second button inside a conditionalPanel and set a toggle to display/hide the panel. See working code below.
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
conditionalPanel(condition = "output.display",
actionButton("button2", label = "Press Button 2"))
)
)
))
server = shinyServer(function(input, output, session) {
r <- reactiveValues(
toggle = NULL
)
observeEvent(input$button1, {
r$toggle = 1
})
observeEvent(input$button1b, {
r$toggle = 0
})
output$display <- reactive({
r$toggle
})
outputOptions(output, "display", suspendWhenHidden = FALSE)
})
shinyApp(ui = ui, server = server)
Another option is to dynamically insert and remove UI elements. But that option requires creation/destruction of UI elements every time the buttons are clicked. See example here

How to create a popup window for user to input information in R shiny?

Here is an example. What I want is that users can run the demo as many time as they want by DEMO button. However when they click Browse for uploading local data (not reset button as I demonstrated in the example), I would popup a window to let users input their name and state in two input boxes. In the below example, by click RESET, a single popup box will launch (may be not a proper way).
library(shiny)
library(shinyWidgets)
if (interactive()) {
# Display an important message that can be dismissed only by clicking the
# dismiss button.
shinyApp(
ui <- fluidPage(
tabsetPanel(
##tabPanel-Input
tabPanel("Input", fluid = TRUE,
# tab title ----
titlePanel("Upload data"),
# sidebar layout with input and output tables ----
sidebarLayout(
# sidebar panel for inputs ----
sidebarPanel(
#show ct demo
actionBttn("runexample", "DEMO", style="simple", size="sm", color = "primary"),
# input1: Select a file ----
fileInput("file1", "Count matrix File (.xlsx)",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
#action run
actionBttn("runbutton", "GO", style="simple", size="sm", color = "primary"),
actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),
verbatimTextOutput(outputId = "reset"),
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
span(textOutput("nrows"),style="color:blue"),
span(textOutput("ncols"),style="color:blue"),
tableOutput("matrix"),
)
)
)
)
),
server = function(input, output, session) {
###display demo count matrix
observeEvent(input$runexample, {
#ngenes
output$nrows <- renderText({paste("Number of genes: ", dim(mtcars)[1], " [First 10 rows displayed]")})
#nsamples
output$ncols<- renderText({paste("Number of genes: ", (dim(mtcars)[2]), " [First 10 rows displayed]")})
#display 10rows count matrix
output$matrix <- renderTable({
mtcars
})
}
)
observeEvent(input$reset, {
inputSweetAlert(
session = session, inputId = "mytext", input = "text",
title = "This is a free program, please leave your email:"
)
})
output$text <- renderPrint(input$mytext)
}
)
}
Here is an example using the modal dialog option provided by shiny. I trimmed your example down to the bits that mattered:
library(shiny)
if (interactive()) {
shinyApp(
ui <- fluidPage(
actionButton("reset", "RESET", style="simple", size="sm", color = "warning"),
verbatimTextOutput(outputId = "text")
),
server = function(input, output, session) {
l <- reactiveValues()
observeEvent(input$reset, {
# display a modal dialog with a header, textinput and action buttons
showModal(modalDialog(
tags$h2('Please enter your personal information'),
textInput('name', 'Name'),
textInput('state', 'State'),
footer=tagList(
actionButton('submit', 'Submit'),
modalButton('cancel')
)
))
})
# only store the information if the user clicks submit
observeEvent(input$submit, {
removeModal()
l$name <- input$name
l$state <- input$state
})
# display whatever is listed in l
output$text <- renderPrint({
if (is.null(l$name)) return(NULL)
paste('Name:', l$name, 'and state:', l$state)
})
}
)
}

Make icon of airDatepickerInput clickable

I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)

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

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?

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