I am new with Shiny. I have developed a very simple app that modifies a string inserted in a text input after the click of a button. The result appears in a text output present from the beginning. This is my code:
# ui.R
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter"),
verbatimTextOutput("value")
)
# server.R
library(shiny)
library(shinyjs)
server <- function(input, output) {
output$value <- reactive({
# toggle(id="caption")
input$btn_input
v <- isolate({input$caption})
if (v == "xxx") {
value <- paste(v, "a")
} else {
value <- paste(v, "b")
}
value
})
}
I would like the text output to appear only after clicking the button.
At the same time I would like the caption, the text input and the button to disappear after clicking the button.
What is the easiest way to make this change? Thanks in advance.
I think conditionalPanel is the easiest way:
library(shiny)
ui <- fluidPage(
conditionalPanel(
"input.btn_input === 0",
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter")
),
conditionalPanel(
"input.btn_input !== 0",
style = "display: none;",
verbatimTextOutput("value")
)
)
server <- function(input, output) {
Value <- eventReactive(input$btn_input, {
v <- input$caption
if (v == "xxx") {
paste(v, "a")
} else {
paste(v, "b")
}
})
output$value <- renderPrint({
Value()
})
}
shinyApp(ui, server)
If you want a "Back" button, as asked in your comment, you can proceed as follows:
library(shiny)
ui <- fluidPage(
conditionalPanel(
"output.show_input",
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter")
),
conditionalPanel(
"output.show_output",
style = "display: none;",
verbatimTextOutput("value"),
actionButton("btn_back", "Back")
)
)
server <- function(input, output) {
ShowInput <- reactiveVal(TRUE)
output$show_input <- reactive({
ShowInput()
})
outputOptions(output, "show_input", suspendWhenHidden = FALSE)
ShowOutput <- reactiveVal(FALSE)
output$show_output <- reactive({
ShowOutput()
})
outputOptions(output, "show_output", suspendWhenHidden = FALSE)
observeEvent(input$btn_input, {
ShowInput(FALSE)
ShowOutput(TRUE)
})
observeEvent(input$btn_back, {
ShowInput(TRUE)
ShowOutput(FALSE)
})
Value <- eventReactive(input$btn_input, {
v <- input$caption
if (v == "xxx") {
paste(v, "a")
} else {
paste(v, "b")
}
})
output$value <- renderPrint({
Value()
})
}
shinyApp(ui, server)
...
# output$value <- reactive({
output$value <- eventReactive(input$btn_input, {
...
Related
I am trying to pass a value assigned in an observeEvent to another observeEvent in shiny. In addition to the codes below, I also attempted to use my_dynamic_table(), but unfortunately I couldn't achieve my goal.
My aim is to have "Something 1" on the screen if my_dynamic_table is not empty.
library(shiny)
library(DT)
my_dynamic_table = data.frame(NA)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
observeEvent (input$call ,{
my_dynamic_table <- mtcars
output$table_out <- DT::renderDataTable(
my_dynamic_table
) # renderDataTable : table_out
})
observeEvent (input$save,{
output$text <- renderText({
if(nrow(my_dynamic_table)>1) {
"Something 1"
}else {
"Something 2"
}
}) #renderText
}) #observeEvent
} #server
) #shinyApp
One option to achieve that would be to use a reactiveVal or reactiveValues:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call", "Call"),
actionButton("save", "Save"),
verbatimTextOutput("text"),
DT::dataTableOutput("table_out")
),
server = function(input, output, session) {
my_dynamic_table <- reactiveVal(data.frame())
observeEvent(input$call, {
my_dynamic_table(mtcars)
output$table_out <- DT::renderDataTable(
my_dynamic_table()
)
})
observeEvent(input$save, {
output$text <- renderText({
if (nrow(my_dynamic_table()) > 0) {
"Something 1"
} else {
"Something 2"
}
}) # renderText
}) # observeEvent
} # server
) # shinyApp
While I do think that using reactiveValues is a good solution to this problem, I'd say its never a good idea to use an output inside an observeEvent(). I would rearrange the code as below. In the observeEvent we observe the action buttons, and when clicked, update the reactiveValues. Those are again intermediates for your output.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
my <- reactiveValues(dynamic_table = data.frame(NA),
text = NA)
observeEvent(input$call, {
my$dynamic_table <- mtcars
})
observeEvent(input$save, {
if (nrow(my$dynamic_table) > 1) {
my$text <- "Something 1"
} else {
my$text <-"Something 2"
}
})
output$text <- renderText({
req(input$save)
my$text
})
output$table_out <- DT::renderDataTable({
req(input$call)
my$dynamic_table
})
} #server
) #shinyApp
I want to disable "3" when "B" is selected and move radio button selection to "1". When "A" is selected again, I want "3" to be enable again. I tried a couple of things with shinyjs::runjs("") but it didn't work out in desirable way. Any help will be appreciated.
library(shiny)
library(shinyjs)
library(shinyWidgets)
if (interactive()) {
ui <- fluidPage(
useShinyjs(),
selectInput(inputId="input",
label="choose ",
c("A" = "a",
"B" = "b")),
radioButtons(inputId="select",
label="number",
c("1"="one",
"2"="two",
"3"="three")),
mainPanel(verbatimTextOutput("output")
)
)
server <- function(input, output) {
observeEvent(input$input, {
if(input$input=="b"){
# disable 3
shinyjs::runjs("")
}else{
# enable 3 again if input$input=="a"
}
})
output$output <- renderText({ input$select })
}
shinyApp(ui, server)
}
One way to do it is use conditionPanel. Try this.
library(shiny)
library(shinyjs)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
selectInput(inputId="input",
label="choose ",
c("A" = "a",
"B" = "b")),
conditionalPanel(condition = "input.input == 'a'",
radioButtons(inputId="select",
label="number",
c("1"="one",
"2"="two",
"3"="three"),
selected="three")
),
conditionalPanel(condition = "input.input == 'b'",
radioButtons(inputId="select2",
label="number",
c("1"="one",
"2"="two"),
selected="one")
),
mainPanel(verbatimTextOutput("output")
)
)
server <- function(input, output) {
mysel <- reactive({
if (input$input=="a") {
sel <- input$select
} else{
sel <- input$select2
}
sel
})
output$output <- renderText({ mysel() })
}
shinyApp(ui, server)
Another way is to use updateRadioButtons.
ui <- fluidPage(
useShinyjs(),
selectInput(inputId="input",
label="choose ",
c("A" = "a",
"B" = "b")),
radioButtons(inputId="select",
label="number",
c("1"="one",
"2"="two",
"3"="three"),
selected="one"),
mainPanel(verbatimTextOutput("output")
)
)
server <- function(input, output, session) {
observeEvent(input$input, {
if(input$input=="b"){
mychoices <- c("1"="one", "2"="two")
}else{
mychoices <- c("1"="one", "2"="two", "3"="three")
}
updateRadioButtons(session, "select", choices = mychoices)
})
output$output <- renderText({ input$select })
}
shinyApp(ui, server)
Here's an example:
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tabPanel(
"tab 2",
actionButton(ns("change_dataset"), "change dataset")
)
}
mod_server <- function(input, output, session){
data <- reactive({ mtcars })
observeEvent(input$change_dataset, {
data <- reactive({ iris })
# Comment the line above and uncomment the
# one below to check that this button works:
# print("button works")
})
return(
list(
data_1 = data
)
)
}
ui <- navbarPage(
title = "",
id = "a_navbar",
tabPanel(
"tab 1",
dataTableOutput("data_test")
),
mod_ui("tab_2")
)
server <- function(input, output, session) {
mod_return <- callModule(mod_server, "tab_2")
output$data_test <- renderDataTable({
mod_return$data_1()
})
}
shinyApp(ui, server)
Basically, this app displays the mtcars dataset in tab 1, and it should display the iris dataset if the user clicks on the button "change dataset" in tab 2. But clicking on this button does not update the table. Why is this the case? How can I fix it?
You should avoid nesting reactives in observers.
You can use eventReactive instead. Please check the following:
library(shiny)
library(DT)
mod_ui <- function(id) {
ns <- NS(id)
tabPanel("tab 2",
actionButton(ns("change_dataset"), "change dataset"))
}
mod_server <- function(input, output, session) {
data <- eventReactive(input$change_dataset, {
if (input$change_dataset %% 2) {
iris
} else {
mtcars
}
}, ignoreNULL = FALSE)
return(list(data_1 = data))
}
ui <- navbarPage(
title = "",
id = "a_navbar",
tabPanel("tab 1",
DT::dataTableOutput("data_test")),
mod_ui("tab_2")
)
server <- function(input, output, session) {
mod_return <- callModule(mod_server, "tab_2")
output$data_test <- DT::renderDataTable({
mod_return$data_1()
})
}
shinyApp(ui, server)
Another approach would be to set a reactiveVal in the observeEvent.
I'm trying to create a tabset where tabs are dynamically added. Each new tab has the same carousel with images. The carousel is loaded from a module.
This would be the desired end result, but that works for multiple dynamically added tabs:
Reading other SO questions leads me to believe that I might need a nested module. Alternatively I've made a mistake with insertUI. Help much appreciated!
Here is a MVE where you need to place a single png in the same folder as the code:
library(shiny)
library(slickR)
my_module_UI <- function(id) {
ns <- NS(id)
slickROutput(ns("slickr"), width="100%")
}
my_module <- function(input, output, session) {
output$slickr <- renderSlickR({
imgs <- list.files("", pattern=".png", full.names = TRUE)
slickR(imgs)
})
}
ui <- fluidPage(
tabItem(tabName = "main_tab_id",
tabsetPanel(id = "test_tabs",
tabPanel(
title = "First tab",
value = "page1",
fluidRow(textInput('new_tab_name', 'New tab name'),
actionButton('add_tab_button','Add'))
)
)
)
)
server <- function(input, output, session) {
tab_list <- NULL
observeEvent(input$add_tab_button,
{
tab_title <- input$new_tab_name
if(tab_title %in% tab_list == FALSE){
appendTab(inputId = "test_tabs",
tabPanel(
title=tab_title,
div(id="placeholder") # Content
)
)
# A "unique" id based on the system time
new_id <- gsub("\\.", "", format(Sys.time(), "%H%M%OS3"))
insertUI(
selector = "#placeholder",
where = "beforeBegin",
ui = my_module_UI(new_id)
)
callModule(my_module, new_id)
tab_list <<- c(tab_list, tab_title)
}
updateTabsetPanel(session, "test_tabs", selected = tab_title)
})
}
shinyApp(ui, server)
This is an interesting exercise in modules.
carousel_module simply renders the carousel
my_tab module, creates a tab and an observeEvent for each tab which listens to tab clicks
library(shiny)
library(slickR)
carousel_ui <- function(id){
ns <- NS(id)
slickROutput(ns("slickr"), width="100%")
}
carousel_module <- function(input, output, session) {
output$slickr <- renderSlickR({
imgs <- list.files("~/Desktop/imgs", pattern=".png", full.names = TRUE)
slickR(imgs)
})
}
my_tab <- function(input,output,session,parent_session,tab_element,tab_name){
ns = session$ns
appendTab(inputId = "test_tabs",
tabPanel(
title = tab_name,
value = tab_name,
carousel_ui(ns("carousel")) # Operating in the parent session so explicitly supply the namespace
),
session = parent_session
)
updateTabsetPanel(parent_session, "test_tabs", selected = tab_name) # Refer to test_tabs from the parent namespace
# Need to update the carousel every time the user clicks on a tab
# Else the carousel is only updated on the latest tab created
observeEvent(tab_element(),{
req(tab_element())
if(tab_element() == tab_name){
cat("Running\n")
callModule(carousel_module,"carousel")# This module knows the namespace so no need to supply the namespace
}
})
}
ui <- fluidPage(
tabsetPanel(id = "test_tabs",
tabPanel(
title = "First tab",
value = "page1",
fluidRow(textInput('new_tab_name', 'New tab name'),
actionButton('add_tab_button','Add'))
)
)
)
)
server <- function(input, output, session) {
tab_list <- NULL
observeEvent(input$add_tab_button,{
tab_title <- input$new_tab_name
callModule(my_tab,tab_title,session,reactive(input$test_tabs),input$new_tab_name)
})
}
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)