In the below code for a Shiny app, I am expecting the print line to execute when the user clicks on a new row in the datatable. When I do this, the textOutput updates with the selected row via input$table_rows_selected as expected. But why does change <- reactive({ }) not take a dependency on changes to input$table_rows_selected and trigger the print message?
I see that it works with observe({}) but ultimately I want to use a value that reactive returns in different places (e.g here return and return2).
library(shiny)
library(DT)
ui <- fluidPage(
DT::DTOutput("table"),
textOutput("selected"),
textOutput("return"),
textOutput("return2")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
data.frame(a = 1:3, b = 4:6)
}, selection = 'single')
output$selected <- renderText({
input$table_rows_selected
})
change <- reactive({
input$table_rows_selected
print("it changed!")
"return"
})
output$return <- renderText({
isolate(change())
})
output$return2 <- renderText({
paste0(isolate(change()), "_2")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your code has 2 problems:
a reactive is just a function, therefore its return value is the last value generated in the reactive -> you need to put input$table_rows_selected last
the isolate(change()) means that reactives don't have a dependency on input$table_rows_selected -> remove the isolate
library(shiny)
library(DT)
ui <- fluidPage(
DT::DTOutput("table"),
textOutput("selected"),
textOutput("return"),
textOutput("return2")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
data.frame(a = 1:3, b = 4:6)
}, selection = 'single')
output$selected <- renderText({
input$table_rows_selected
})
change <- reactive({
print("it changed!")
input$table_rows_selected
})
output$return <- renderText({
change()
})
output$return2 <- renderText({
paste0(change(), "_2")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I'm working on a shiny app that streams data and am updating the UI via renderTable every second. When the app renders the table dims between each update which is annoying from a visual perspective. Is there a way to disable this behavior?
output$table_state <- renderTable({
invalidateLater(1000)
get_table_state()
})
If get_table_state() performs a long computation, you can try to execute it outside renderTable(). Notice the use of observe here.
Example app
library(shiny)
library(tidyverse)
long_calculation <- function() {
Sys.sleep(1)
iris
}
ui <- fluidPage(
fluidRow(
column(width = 6,
tableOutput('table_slow')),
column(width = 6, tableOutput('table2')))
)
server <- function(input, output, session) {
df <- reactiveValues(x = NULL)
output$table_slow <- renderTable({
invalidateLater(1000)
long_calculation()
})
iris_no_dim <- observe({
invalidateLater(1000)
df$x <- long_calculation()})
output$table2 <- renderTable({
df$x
})
}
shinyApp(ui, server)
I'm making an app in which the user can create as many tables as he/she wants and display the code necessary to remake each individual table using shinymeta. I can generate the code for each of these tables but I have a problem when I want to create a complete modal that shows every code for each table.
To be clearer, here's a reproducible example:
library(shiny)
library(dplyr)
library(shinymeta)
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
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
return(data())
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
expandChain(x1_data)
})
))
})
}
shinyApp(ui, server)
When you click on "Launch", two buttons are generated and you can display a table ("Show table") and the code to remake this table ("Show code"). You can click on "Launch" indefinitely and the table will be named x1_data, x2_data, etc.
However, when I try to generate the code that unites every individual code (by clicking on "Show the full code"), x1_data is not found. Using x1_data() does not work either. I'm not a fan of asking two questions in one post but I will do this now:
How can I access the reactive elements created inside modules?
How can I "merge" every individual code in a big one?
Also asked on RStudio Community
Edit: following a comment, I add a second reactive expression in my example, so that I can't use return on both of them.
Ok, I came up with an answer that has the module return the expandChain() results rather than trying to render them again in the server:
library(shiny)
library(dplyr)
library(shinymeta)
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
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
########################################
### create list of reactive objects ####
########################################
return(list(
expandChain(data(), data2())
)
)
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big list object
my_data <- reactive({
req(count$value)
my_set <- 1:count$value
### lapply through the different name spaces so all are captured ###
final <- lapply(my_set, function(x){
temp <- callModule(module_server, paste0("x", x))
return(temp)
})
return(final)
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
temp <- sapply(unlist(my_data()), function(x){
print(x)
})
})
))
})
}
shinyApp(ui, server)
I have a table where when you click on a cell, i print the value of that cell on verbatimTextOutput().
I would like to know how to retrieve only the values of a cell belonging to column a and if i click elsewhere i keep the last value of the clicked cell belonging to column a
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE)
)
server <- function(input, output) {
output$output <- renderText({
#val()
input$table_cell_clicked$value
})
val <- reactive(
if(input$table_cell_clicked$col==1){
input$table_cell_clicked$value
} else{ }
)
# the datatable
dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
output$table <- DT::renderDataTable({
DT::datatable(dt, select="none")})
}
# Run the application
shinyApp(ui = ui, server = server)
Here's a way using reactiveVal() to store value of valid last clicked cell. Also see comments for more info.
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE)
)
server <- function(input, output) {
dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
# the datatable
output$table <- DT::renderDataTable({
DT::datatable(dt, select="none")
})
val <- reactiveVal() # val stores value of valid last clicked cell
observe({
req(input$table_cell_clicked$col == 1) # if() will work as well but req() is cleaner
val(input$table_cell_clicked$value) # update val() only if cell is in column 1
})
output$output <- renderPrint({
val()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have created a large number of data tables using mapply, however, I need to access the data tables in a following step. R assigns random IDs to these tables if the user does not specify the IDs. Here is an example of what I would like to do:
library(shiny)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2), elementId = "DT_Test")
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
If I look at the html, the elementID did not change to what I wanted, in fact, R gives the warning:
Warning in origRenderFunc() :
Ignoring explicitly provided widget ID "DT_Test"; Shiny doesn't use them
Even after the call, still not sure what you are trying to do.
But if you have a list of datatables and you want to access them, it works rather well like this:
library(shiny)
library(purrr)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
h2("elementId values"),
verbatimTextOutput("elementId_values"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
table <- DT::datatable(head(mtcars, 2), elementId = "DT_Test")
table2 <- DT::datatable(tail(mtcars, 1), elementId = "DT_Test2")
list_of_data_tables <- list(table, table2)
element_ids <- purrr::map(list_of_data_tables, "elementId")
output$elementId_values <- renderPrint({
element_ids
})
output$dt <- DT::renderDataTable({
list_of_data_tables[[which(element_ids == "DT_Test2")]]
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
I have 4 action buttons...but want same return value name. Since it is used in other elements. I initialize the reactive element as
myReactiveDF <- reactiveValues(data=NULL)
myReactiveDF <- eventReactive(input$action1, {
call functions
return(dataframe)
})
myReactiveDF <- eventReactive(input$action2, {
call functions
return(dataframe)
})
.....
However only the last button 4 works. The first three do not.
All the other elements use the same reactive element (dataframe) to get populated.
I tried observeEvent but it doesn't return values.
The following code should address your requirement as I understand them:
library(shiny)
ui <- fluidPage(
fluidRow(column(2, selectInput('action1', label = "Action1:", choices = c('a','b') )),
column(4, selectInput('action2', label = "Action2:", choices = c('A','B') ))),
fluidRow( verbatimTextOutput("outputs"))
)
server = function(input, output, session){
v <- reactiveValues(data = NULL)
observeEvent(input$action1, {
v$data <- input$action1
})
observeEvent(input$action2, {
v$data <- input$action2
})
output$outputs <- renderText({
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
If what you need is different, please let me know so that I can amend the answer.