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
Related
I have the shiny app below and I would like to toggle between a plot (default) and its table using the same actionButton().
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("exc",
"Exchange")
),
mainPanel(
uiOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
renderPlot({
plot(mtcars)
})
}
else{
renderDataTable(
datatable(
mtcars)
)
}
})
}
shinyApp(ui = ui, server = server)
I think what you have is close. I would create separate outputs for the plot and table as below (output$plot and output$table) and call them depending on state of your reactiveVal. Let me know if this is the behavior you had in mind.
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
plotOutput("plot")
}
else{
dataTableOutput("table")
}
})
output$plot <- renderPlot({
plot(mtcars)
})
output$table <- renderDataTable(datatable(mtcars))
}
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 making an app with modules in which the user can create as many UI as he wants. Each UI contain one table and I would like to give the possibility to the user to see the code for each of this table separately, not in a unique chunk. Therefore, I included the part of the code with expandChain in my module (module_server).
However, expandChain won't detect the reactive stuff I'm calling because the name of this stuff changes since it is created in a module. Take a look at the app below:
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(count$value))
callModule(module_server, count$value)
})
}
shinyApp(ui, server)
When I try to show the code for the table generated, I have the error:
Warning: Error in : <text>:2:2: unexpected input
1: `1_data` <- mtcars
2: 1_
^
133: <Anonymous>
Since the module renames data() by adding a number, data() is not recognized by expandChain. I tried with:
expandChain(paste0(id, "_data()"))
without success (since expandChain does not support character).
Does anybody know how to do it?
Also asked on RStudio Community
Here's the solution given on RStudio Community (see the link for some additional details):
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
}
shinyApp(ui, server)
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)
}
An example:
UI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
radioButtons("orderdata", "Sort by :",
c("Name" = "name",
"MRDNo" = "mrdno"
))
),
mainPanel(
uiOutput("deatilscv")
)
)
))
Server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output) {
observeEvent(input$orderdata,
{
output$deatilscv <- renderUI({
if(input$orderdata=="name")
{
mid<-c("1","2")
name<-c("a","b")
datatable1 <- data.frame(mid,name)
fluidPage(shinyjs::useShinyjs(),
actionButton("button1", "CLICK") )
}
else if(input$orderdata=="mrdno")
{
mid<-c("3","4")
name<-c("c","d")
datatable2 <- data.frame(mid,name)
fluidPage(shinyjs::useShinyjs(),
actionButton("button1", "CLICK") )
}
})
})
observeEvent(
input$button1,{
a <- datatable1[1,2] #this shows an error object 'datatable1' not found
print(a)
})
observeEvent(
input$button2,{
a <- datatable2[1,2] #this shows an error object 'datatable2' not found
print(a)
})
})
There are two errors in the program as shown above.How can the datatables be accessed in the observe event?
Not sure what you are trying to accomplish. Maybe you can explain how your app should work. I change your code to show the datasets according to the selected radiobutton. You do not need to put the output inside the observeEvent.
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
radioButtons("orderdata", "Sort by :",
c("Name" = "name",
"MRDNo" = "mrdno" ))
),
mainPanel(
tableOutput("deatilscv")
)
)
))
server <- shinyServer(function(input, output) {
# observeEvent(input$orderdata, {
output$deatilscv <- renderTable({
if(input$orderdata=="name") {
mid <- c("1","2"); name <-c("a","b")
datatable <- data.frame(mid,name)
# fluidPage(shinyjs::useShinyjs(), actionButton("button1", "CLICK") )
} else if(input$orderdata=="mrdno") {
mid<-c("3","4"); name<-c("c","d")
datatable <- data.frame(mid,name)
# fluidPage(shinyjs::useShinyjs(), actionButton("button1", "CLICK") )
}
})
# })
# observeEvent( input$button1,{
#
# a <- datatable1[1,2] #this shows an error object 'datatable1' not found
# print(a)
# })
# observeEvent( input$button2,{
# a <- datatable2[1,2] #this shows an error object 'datatable2' not found
# print(a)
# })
})
shinyApp(ui, server)
I think you need to separate observeEvent function from renderTable function.
Then, save the observeEvent as a class object to be called later in the renderTable (output) function, something like this:
my_table <- observeEvent({
datatable <- data.frame(input$orderdata)
### to call your table later on
print(datatable)
})
#Put the render function outside the observe event
output$deatilscv <- renderTable({
rendered_table <- mytable( )
})
}