英文:
How do I ensure reactable::getReactableState() returns the correct row selection in a Shiny app when table is regenerated?
问题
下面是您要翻译的部分:
I have a Shiny app (please see end for a minimum working example) with a "parent" reactable table and a drilldown table that pops up when a user clicks on a row of the parent table. The information on which row is selected in the parent is obtained via `reactable::getReactableState()`. However, when the user switches to a different "parent" table, the function returns the row selection for the outdated table, not the updated one.
This occurs event though the output for the new parent table has completed its calculations and is fully updated by the time the drilldown table starts its calculations. After the whole system is finished and the app is idle, something (and I'm not sure what) triggers the input to `reactable::getReactableState()` to be invalidated, and the reactives fire again, but this time using the updated (or "correct" from my perspective) tables, and returns the expected result, which is that now no row is selected.
Referring to the reactive graph below, what I want to do is have `input$tables-table_parent__reactable__selected` set to not NULL every time `input$tables-data_set` changes.
[![enter image description here](https://i.stack.imgur.com/unrre.png)](https://i.stack.imgur.com/unrre.png)
I have tried to do this via the `session$sendCustomMessage()` and `Shiny.addCustomMessageHandler` approach found here: [https://stackoverflow.com/questions/43267911/change-the-input-value-in-shiny-from-server](https://stackoverflow.com/questions/43267911/change-the-input-value-in-shiny-from-server), but I find that, although I can change `input$tables-table_parent__reactable__selected` value it doesn't seem to send the info to the browser until after all the outputs are done calculating when `input$tables-data_set` is changed.
A minimum working example:
UI module:
```R
drilldownUI <- function(id) {
ns <- NS(id)
tagList(
tags$script("
Shiny.addCustomMessageHandler('tables-table_parent__reactable__selected', function(value) {
Shiny.setInputValue('tables-table_parent__reactable__selected', value);
});
"),
shiny::selectizeInput(
inputId = ns("data_set"),
label = "Data set",
choices = c("iris", "cars"),
selected = "iris"
),
reactable::reactableOutput(outputId = ns("table_parent"),
width = "100%"),
reactable::reactableOutput(
outputId = NS(id, "drilldown_table"),
width = "100%"
)
)
}
Server module:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <- list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(
data_grouped(),
selection = "single",
onClick = "select"
)
})
selected <- reactive({
out <- reactable::getReactableState("table_parent", "selected")
if(is.null(out)||out=="NULL") return(NULL)
out
})
output$drilldown_table <- reactable::renderReactable({
req(selected())
# This should only fire after a new parent table is generated and the row selection is
# reset to NULL, but it fires once the new table is generated and BEFORE the row selection
# is reset to NULL
selected_group <- data_grouped()[selected(), ][[grouping_var()]]
drilldown_data <- dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
observeEvent(input$data_set, {
session$sendCustomMessage("tables-table_parent__reactable__selected", 'NULL')
})
})
App:
library(shiny)
library(reactable)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(
drilldownUI("tables")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
drilldownServer("tables")
}
# Run the application
shinyApp(ui = ui, server = server)
希望这可以帮助您理解代码和问题的背景。
英文:
I have a Shiny app (please see end for a minimum working example) with a "parent" reactable table and a drilldown table that pops up when a user clicks on a row of the parent table. The information on which row is selected in the parent is obtained via reactable::getReactableState()
. However, when the user switches to a different "parent" table, the function returns the row selection for the outdated table, not the updated one.
This occurs event though the output for the new parent table has completed it's calculations and is fully updated by the time the drilldown table starts it's calculations. After the whole systems finished and the app is idle, something (and I'm not sure what) triggers the input to reactable::getReactableState()
to be invalidated, and the reactives fire again, but this time using the updated (or "correct" from my perspective) tables, and returns the expected result, which is that now row is selected.
Referring to the reactive graph below, what I want to do is have input$tables-table_parent__reactable__selected
set not NULL every time input$tables-data_set
changes.
I have tried to do this via the session$sendCustomMessage()
and Shiny.addCustomMessageHandler
approach found here: https://stackoverflow.com/questions/43267911/change-the-input-value-in-shiny-from-server, but I find that, although I can change input$tables-table_parent__reactable__selected
value it doesn't seem to send send the info to the browser until after all the outputs are done caculating when input$tables-data_set
is changed.
A minimum working example:
UI module:
drilldownUI <- function(id) {
ns <- NS(id)
tagList(
tags$script("
Shiny.addCustomMessageHandler('tables-table_parent__reactable__selected', function(value) {
Shiny.setInputValue('tables-table_parent__reactable__selected', value);
});
"),
shiny::selectizeInput(
inputId = ns("data_set"),
label = "Data set",
choices = c("iris", "cars"),
selected = "iris"
),
reactable::reactableOutput(outputId = ns("table_parent"),
width = "100%"),
reactable::reactableOutput(
outputId = NS(id, "drilldown_table"),
width = "100%"
)
)
}
Server module:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <-
list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(
data_grouped(),
selection = "single",
onClick = "select"
)
})
selected <- reactive({
out <- reactable::getReactableState("table_parent", "selected")
if(is.null(out)||out=="NULL") return(NULL)
out
})
output$drilldown_table <- reactable::renderReactable({
req(selected())
# This should only fire after a new parent table is generated and the row selection is
# reset to NULL, but it fires once the new table is generated and BEFORE the row selection
# is reset to NULL
selected_group <- data_grouped()[selected(), ][[grouping_var()]]
drilldown_data <- dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
observeEvent(input$data_set, {
session$sendCustomMessage("tables-table_parent__reactable__selected", 'NULL')
})
})
App:
library(shiny)
library(reactable)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(
drilldownUI("tables")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
drilldownServer("tables")
}
# Run the application
shinyApp(ui = ui, server = server)
答案1
得分: 1
I found the solution thanks in part to this SO answer https://stackoverflow.com/a/39440482/9474704.
The key was to consider the row selection a state, rather than just reacting to input changes. Then, by using reactiveValues()
instead of reactive()
, I could update the state in multiple places using observeEvent()
.
An important additional piece of information was that observe
functions are eager, and you can set a priority, so when the user changes the input$data_set
, I could reset the row selection to 0 before the drilldown reactable::renderReactable()
section was evaluated.
The updates to the server module below for an example of the working solution:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <-
list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
# Create output for parent table
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(data_grouped(),
selection = "single",
onClick = "select")
})
# Create state variable
selected <- reactiveValues(n = 0)
currentSelected <- reactive({
reactable::getReactableState("table_parent", "selected")
})
observeEvent(currentSelected(), priority = 0, {
selected$n <- currentSelected()
})
# When data set input changes, set the selected number of rows to 0e
observeEvent(input$data_set,
label = "reset_selection",
priority = 9999, {
selected$n <- 0
})
# Create output for drilldown table
output$drilldown_table <- reactable::renderReactable({
req(selected$n > 0)
selected_group <-
data_grouped()[selected$n, ][[grouping_var()]]
drilldown_data <-
dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
})
}
英文:
I found the solution thanks in part to this SO answer https://stackoverflow.com/a/39440482/9474704.
The key was to consider the row selection a state, rather than just reacting to input changes. Then, by using reactiveValues()
instead of reactive()
, I could update the state in multiple places using observeEvent()
.
An important additonal piece of information was that observe
functions are eager, and you can set a priority, so when the user changes the input$data_set
, I could reset the row selection to 0 before the drilldown reactable::renderReactable()
section was evaluated.
The updates to the server module below for an example of the working solution:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <-
list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
# Create output for parent table
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(data_grouped(),
selection = "single",
onClick = "select")
})
# Create state variable
selected <- reactiveValues(n = 0)
currentSelected <- reactive({
reactable::getReactableState("table_parent", "selected")
})
observeEvent(currentSelected(), priority = 0, {
selected$n <- currentSelected()
})
# When data set input changes, set the selected number of rows to 0e
observeEvent(input$data_set,
label = "reset_selection",
priority = 9999, {
selected$n <- 0
})
# Create output for drilldown table
output$drilldown_table <- reactable::renderReactable({
req(selected$n > 0)
selected_group <-
data_grouped()[selected$n, ][[grouping_var()]]
drilldown_data <-
dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
})
}
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论