I Want to update a Value based on a textInput() within an modalDialog(). I found this answer which does work, but it uses reactiveValues() which creates problems in my case further down in my code.
Is there a way to to update my value text through textInput() and modalDialog() without the use of reactiveValues()?
This works
library(shiny)
library(shinyWidgets)
if (interactive()) {
shinyApp(
ui <- fluidPage(
actionBttn("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)
})
}
)
}
This does not work
It fails to update the value l when I dont use the l <- reactiveValues().
library(shiny)
library(shinyWidgets)
if (interactive()) {
shinyApp(
ui <- fluidPage(
actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),
verbatimTextOutput(outputId = "text")
),
server = function(input, output, session) {
l <- NULL
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'),
footer=tagList(
actionButton('submit', 'Submit'),
modalButton('cancel')
)
))
})
# only store the information if the user clicks submit
observeEvent(input$submit, {
removeModal()
l <- input$name
})
# display whatever is listed in l
output$text <- renderPrint({
if (is.null(l)) return(NULL)
paste('Name:', l)
})
}
)
}
renderPrint needs a reactive dependency to be invalidated and re-rendered. Accordingly using a non-reactive variable in this scenario isn't making any sense.
You should rather work on the downstream problems.
Here is another approach using eventReactive:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
br(),
actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),
verbatimTextOutput(outputId = "text")
)
server <- function(input, output, session) {
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'),
footer=tagList(
actionButton('submit', 'Submit'),
modalButton('cancel')
)
))
})
# only store the information if the user clicks submit
submittedName <- eventReactive(input$submit, {
removeModal()
input$name
})
output$text <- renderPrint({
req(submittedName())
paste('Name:', submittedName())
})
}
shinyApp(ui, server)
Edit: using reactiveVal for the placeholder:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
br(),
actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),
verbatimTextOutput(outputId = "text")
)
server <- function(input, output, session) {
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'),
footer=tagList(
actionButton('submit', 'Submit'),
modalButton('cancel')
)
))
})
submittedName <- reactiveVal("placeholder")
# only store the information if the user clicks submit
observeEvent(input$submit, {
removeModal()
submittedName(input$name)
})
output$text <- renderPrint({
paste('Name:', submittedName())
})
}
shinyApp(ui, server)
Related
I'd like to run the action button automatically when users open/land on 'tab1'. Therefore, instead of clicking the Refresh button to view the date, I'd like to have the date printed automatically. Is there a way to do this? My real code is more complicated that this simple example. However, it demonstrates what I'd like to do. Thank you!
library(shiny)
ui <- fluidPage(
shiny::tabPanel(value = 'tab1', title = 'Data page',
br(),
shiny::actionButton("btn", "Refresh!"),
br(),
shiny::verbatimTextOutput("out")
)
)
server <- function(input, output, session) {
curr_date <- shiny::eventReactive(input$btn, {
format(Sys.Date(), "%c")
})
output$out <- shiny::renderText({
print(curr_date())
})
}
shinyApp(ui, server)
You can make curr_date reactive to the tabset:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(value = 'tab1', title = 'Data page',
br(),
actionButton("btn", "Refresh!"),
br(),
verbatimTextOutput("out")
),
tabPanel(value = 'tab2', title = 'Other tab'),
id = "tabset"
)
)
server <- function(input, output, session) {
curr_date <- eventReactive(list(input$btn, input$tabset), {
req(input$tabset == 'tab1')
format(Sys.time(), "%c")
})
output$out <- renderText({
print(curr_date())
})
}
shinyApp(ui, server)
You should use reactiveValues() and observeEvent() for this. Inside server function:
server <- function(input, output, session) {
text_out <- reactiveValues(date = format(Sys.Date(), "%c"))
observeEvent(input$btn, {
text_out$date <- "something else"
})
output$out <- renderText({
print(text_out$date)
}
I have a simple task of printing the output of a call to table() on a selected variable.
I want to display the output when the button "Print" is clicked.
In the following example, once the button is clicked, the output is always triggered when I change the selected variable.
If I clicked "Print", and then change the selected variable, I want the ouput to be gone, waited to be printed again when clicking "Print".
Thank you!
Here is a reproducible example:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab = reactive( table(data[[input$selectedvar]]) )
observeEvent(input$print, {
output$info = renderPrint( tab() )
})
}
shinyApp(ui, server)
That's because output$info is reactive to tab(), even while it is enclosed in an observeEvent. I think this app does what you want:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab <- reactiveVal()
observeEvent(input$selectedvar, {
tab(NULL)
})
observeEvent(input$print, {
tab(table(data[[input$selectedvar]]))
})
output$info <- renderPrint({
tab()
})
}
shinyApp(ui, server)
I need some help I want to show my reactive tabPanel in a popup with the shinyBS package.
Everything seems to work well except the creation of popup.
I am inspired by :
1) R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
2)Show dataTableOutput in modal in shiny app
My code :
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE)
),
mainPanel(
uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs = length(input$decision)
# create tabPanel with datatable in it
myTabs = lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
bsModal(
id = "modalExample",
"yb",
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
)
})
shinyApp(ui, server)
Thanks in advance for any help !
bsModal is an UI element, so you need to put it into you UI. Within this modal you want to show the tabPanels (rendered via uiOutput), so all you need to do is to place your bsModal into the UI, and within this bsModal you have your uiOutput. All what is left is to add an actionButton which shows the modal.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your species",
choices = unique(iris$Species),
selected = unique(iris$Species), multiple = TRUE),
actionButton("show", "Show")
),
mainPanel(
bsModal("modalExample",
"myTitle",
"show",
uiOutput('mytabs')
)
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs <- length(input$decision)
# create tabPanel with datatable in it
myTabs <- lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
})
shinyApp(ui, server)
It's not clear to me what you want to do (maybe #thothal has the right answer). What about this app ?
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE),
actionButton("trigger_modal", "View modal")
),
mainPanel(
uiOutput("modal")
# uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
# output$mytabs <- renderUI({
# nTabs = length(input$decision)
# # create tabPanel with datatable in it
# myTabs = lapply(seq_len(nTabs), function(i) {
# tabPanel(paste0("dataset_", input$decision[i]),
# tableOutput(paste0("datatable_",i))
# )
# })
#
# do.call(tabsetPanel, myTabs)
# })
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
output$modal <- renderUI({
bsModal(
id = "modalExample",
"yb",
trigger = "trigger_modal",
do.call(tagList, lapply(seq_along(input$decision), function(i){
tableOutput(paste0("datatable_",i))
}))
)
})
})
shinyApp(ui, server)
I would like to develop an application with two buttons :
1. Calculate
2. Refresh
When I click on the button "Calculate", a second button appears. When I click on the second button, a sentence appears : "Le resultat est...". The button refresh clean the web page. Now the page is clean and only the two initial buttons appears : Calculate and Refresh.
If i click another time on the button Calculate, the sentence "Le resultat est..." appears without click on the second button.
Question : How can i do obtain the sentence "Le resultat est..." only after a click on the second button ?
Below my code :
library(shiny)
data_Modele <- deval_Shiny
ui <- fluidPage(
actionButton("runif", "Uniform"),
actionButton("reset", "Clear"),
uiOutput("plot")
)
server <- function(input, output){
v <- reactiveValues(data = NULL)
observeEvent(input$runif, {
v$data <- round(runif(1, min=1, max=nrow(deval_Shiny)),digits = 0)
output$Button<- renderUI({
actionButton("button", "click me")
})
})
observeEvent(input$reset, {
v$data <- NULL
})
observeEvent(input$button, {
output$Reponse <- renderText(paste0("Le resultat est :",v$data))
})
output$plot <- renderUI({
if (is.null(v$data)) return()
tagList(
uiOutput("Button"),
uiOutput("Reponse")
)
})
}
shinyApp(ui, server)
Thank you in advance for your help :)
J.
If you want your uiOutputs to behave separately, I would suggest not to bind them together inside output$plot. So if you don't need them to be together, I would add a variable show_response to control whether you want to display the response or not.
library(shiny)
ui <- fluidPage(
actionButton("runif", "Uniform"),
actionButton("reset", "Clear"),
uiOutput("Button"),
uiOutput("Reponse")
)
server <- function(input, output){
v <- reactiveValues(data = NULL)
show_response <- reactiveValues(state = FALSE)
observeEvent(input$runif, {
v$data <- round(runif(1, min = 1, max = 100), digits = 0)
})
observeEvent(input$reset, {
v$data <- NULL
show_response$state <- FALSE
})
observeEvent(input$button, {
show_response$state <- TRUE
})
output$Button <- renderUI({
req(v$data)
actionButton("button", "click me")
})
output$Reponse <- renderText({
req(show_response$state)
paste0("Le resultat est :", v$data)
})
}
shinyApp(ui, server)
You can use shinyjs and its show and hide functions:
library(shiny)
library(shinyjs)
deval_Shiny <- mtcars
data_Modele <- deval_Shiny
ui <- fluidPage(
useShinyjs(),
actionButton("runif", "Uniform"),
actionButton("reset", "Clear"),br(),
actionButton("button", "click me"),
textOutput("Reponse")
)
server <- function(input, output){
observe({
hide("button")
hide("Reponse")
})
v <- reactiveValues(data = NULL)
observeEvent(input$runif,{
show("button")
v$data <- round(runif(1, min=1, max=nrow(deval_Shiny)),digits = 0)
})
observeEvent(input$reset, {
hide("button")
hide("Reponse")
})
output$Reponse <- renderText(paste0("Le resultat est :",v$data))
observeEvent(input$button, {
show("Reponse")
})
}
shinyApp(ui, server)
I am building a shiny app and I want to refresh the main panel screen. Here is a sample code. I have a submit button to display the data and I have a re-fresh button to clear the screen. I am not so sure how to code the re-fresh button in R and shiny since I am new to this. Thanks for looking into
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
You could add the possibility of return nothing from the renderUI() if the refresh button is used.
As it is not that straightforward to reset an action button you would have to use a workaround with a reactive variable.
if(global$refresh) return()
This reactive variable you can control with the refresh and submit button
E.g. if(input$refresh1) isolate(global$refresh <- TRUE)
which you wrap in seperate observe functions.
Full code see below:
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(refresh = FALSE)
observe({
if(input$refresh1) isolate(global$refresh <- TRUE)
})
observe({
if(input$submit1) isolate(global$refresh <- FALSE)
})
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
if(global$refresh) return()
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)