持久选择使用DT和R Shiny
我有一个Shiny用例，我希望允许用户通过选择列并查看某些摘要统计信息来过滤他们的数据。我们的想法是允许他们快速深入到更细粒度的组并查看结果。它运行良好，除非用户在更高级别进行选择，然后重置所有过滤器和选择，并且需要再次选择。我一直在努力使这些过滤器保持持久性，并且在某些情况下只会更新。
例如，用户希望查看瑞士和德国（2级）工程师（1级）的收入中位数，并按年龄（3级）显示。他们会按每个表上方的selectInput值进行排序以选择类别，然后选择表中的值以包含变量，例如＆＃34;工程师＆＃34;如下图所示。
如果他们想看看＆＃34; Pilot＆＃34;改变结果，国家过滤器将消失。我希望所有人都留在原地，这是让我适合的部分。
有关如何解决此问题的任何想法？此示例的代码如下：
服务器：
library(shiny)
library(DT)
library(plyr)
library(dplyr)
# Generate income data
n <- 1000
age <- sample(20:60, n, replace=TRUE)
sex <- sample(c("M", "F"), n, replace=TRUE)
country <- sample(c("US", "CA", "UK", "DE", "CH", "NL"), n, replace=TRUE)
occupation <- sample(c("Engineer", "Doctor", "Retail", "Pilot"), n, replace=TRUE)
income <- sample(20000:120000, n, replace=TRUE)
df <- data.frame(age, sex, country, income, occupation)
categories <- c("None", "age", "sex", "country", "occupation")
shinyServer(function(input, output, session) {
output$selection_1 <- renderUI({
selectInput("selection_1", "Level 1 Selection", selected = "None",
choices = categories)
})
output$selection_2 <- renderUI({
selectInput("selection_2", "Level 2 Selection", selected = "None",
choices = categories)
})
output$selection_3 <- renderUI({
selectInput("selection_3", "Level 3 Selection", selected = "None",
choices = categories)
})
table_1 <- reactive({
validate(
need(input$selection_1 != "None", "Select a variable for aggregation.")
)
ddply(df, input$selection_1, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_1_agg <- DT::renderDataTable(
table_1(),
rownames = TRUE,
selection = list(selected = "")
)
# Get values to match on subsequent tables
table_1_vals <- reactive({
table_1()[input$table_1_agg_rows_selected, 1]
})
# Filter table 2
table_2 <- reactive({
validate(
need(input$selection_2 != "None", "Select a variable for aggregation.")
)
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df2 <- df[df[,sel_1_col] %in% table_1_vals(),]
}else{
df2 <- df
}
ddply(df2, input$selection_2, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_2_agg <- DT::renderDataTable(
table_2(),
rownames = TRUE,
selection = list(selected = "")
)
# Get values to match on subsequent tables
table_2_vals <- reactive({
table_2()[input$table_2_agg_rows_selected, 1]
})
# Filter table 3
table_3 <- reactive({
validate(
need(input$selection_3 != "None", "Select a variable for aggregation.")
)
df3 <- df
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df3 <- df3[df3[,sel_1_col] %in% table_1_vals(),]
}
if(length(table_2_vals())>0){
sel_2_col <- grep(input$selection_2, names(df))
df3 <- df3[df3[,sel_2_col] %in% table_2_vals(),]
}
ddply(df3, input$selection_3, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_3_agg <- DT::renderDataTable(
table_3(),
rownames = TRUE,
selection = list(selected = "")
)
})
UI：
shinyUI(fluidPage(
fluidRow(
column(6,
uiOutput("selection_1"),
DT::dataTableOutput("table_1_agg")),
column(6,
uiOutput("selection_2"),
DT::dataTableOutput("table_2_agg"))
),
fluidRow(
column(6,
br(),
uiOutput("selection_3"),
DT::dataTableOutput("table_3_agg"))
)
))
谢谢！
2 个答案:
答案 0 :(得分：0)
一个选项是存储选定的行，稍后在重绘表时使用。这可以使用额外的renderUI来创建表，并使用参数selection来指示要选择的行。
library(shiny)
library(DT)
library(dplyr)
library(plyr)
# Generate income data
n <- 1000
age <- sample(20:60, n, replace=TRUE)
sex <- sample(c("M", "F"), n, replace=TRUE)
country <- sample(c("US", "CA", "UK", "DE", "CH", "NL"), n, replace=TRUE)
occupation <- sample(c("Engineer", "Doctor", "Retail", "Pilot"), n, replace=TRUE)
income <- sample(20000:120000, n, replace=TRUE)
df <- data.frame(age, sex, country, income, occupation)
categories <- c("None", "age", "sex", "country", "occupation")
ui <- shinyUI(fluidPage(
fluidRow(
column(6,
uiOutput("selection_1"),
DT::dataTableOutput("table_1_agg")),
column(6,
uiOutput("selection_2"),
uiOutput("table_2_aggUI")
)
),
fluidRow(
column(6,
br(),
uiOutput("selection_3"),
uiOutput("table_3_aggUI")
)
)
))
server <- shinyServer(function(input, output, session) {
table2_selected <- NULL
table3_selected <- NULL
output$selection_1 <- renderUI({
selectInput("selection_1", "Level 1 Selection", selected = "None",
choices = categories)
})
output$selection_2 <- renderUI({
selectInput("selection_2", "Level 2 Selection", selected = "None",
choices = categories)
})
output$selection_3 <- renderUI({
selectInput("selection_3", "Level 3 Selection", selected = "None",
choices = categories)
})
table_1 <- reactive({
validate(
need(input$selection_1 != "None", "Select a variable for aggregation.")
)
ddply(df, input$selection_1, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_1_agg <- DT::renderDataTable(
table_1(),
rownames = TRUE,
selection = list(selected = "")
)
# Get values to match on subsequent tables
table_1_vals <- reactive({
table_1()[input$table_1_agg_rows_selected, 1]
})
# Filter table 2
table_2 <- reactive({
validate(
need(input$selection_2 != "None", "Select a variable for aggregation.")
)
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df2 <- df[df[,sel_1_col] %in% table_1_vals(),]
}else{
df2 <- df
}
ddply(df2, input$selection_2, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_2_aggUI <- renderUI({
# to redraw UI if data on table_2() change
table_2()
output$table_2_agg <- DT::renderDataTable(
isolate(table_2()),
rownames = TRUE,
selection = list(target = 'row', selected = table2_selected)
)
DT::dataTableOutput("table_2_agg")
})
# keep record of selected rows
observeEvent(input$table_2_agg_rows_selected, {
table2_selected <<- as.integer(input$table_2_agg_rows_selected)
cat("Table 2 selected:", table2_selected, "\n")
})
# Get values to match on subsequent tables
table_2_vals <- reactive({
table_2()[input$table_2_agg_rows_selected, 1]
})
# Filter table 3
table_3 <- reactive({
validate(
need(input$selection_3 != "None", "Select a variable for aggregation.")
)
df3 <- df
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df3 <- df3[df3[,sel_1_col] %in% table_1_vals(),]
}
if(length(table_2_vals())>0){
sel_2_col <- grep(input$selection_2, names(df))
df3 <- df3[df3[,sel_2_col] %in% table_2_vals(),]
}
ddply(df3, input$selection_3, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_3_aggUI <- renderUI({
# to redraw UI if data on table_3() change
table_3()
output$table_3_agg <- DT::renderDataTable(
isolate(table_2()),
rownames = TRUE,
selection = list(target = 'row', selected = table3_selected)
)
DT::dataTableOutput("table_3_agg")
})
# keep record of selected rows
observeEvent(input$table_3_agg_rows_selected, {
table3_selected <<- as.integer(input$table_3_agg_rows_selected)
cat("Table 3 selected:", table3_selected, "\n")
})
})
shinyApp(ui = ui, server = server)
答案 1 :(得分：0)
您可以通过添加以下功能来实现此目的：
-
初始化临时反应变量。在t0时刻，此变量将以值NULL或0开始，但在重绘之前，它将暂时捕获当前所选行和表的过滤选项
prev_selections = reactiveValues(table2 = NULL, prev_rows_t2 = NULL, new_rows_t2 = NULL, filterop_t2 = 0, table3 = NULL, prev_rows_t3 = NULL, new_rows_t3 = NULL, filterop_t3 = 0) -
因为您在表N中选择的行将过滤表N + 1，...您需要在重绘它们之前创建下游表的副本。使用
observeEvent捕获应用过滤器的表格和值（下面的表2）observeEvent(input$table_2_agg_rows_selected,{ prev_selections$table2 = table_2() prev_selections$filterop_t2 = input$selection_2 }) -
为每个表创建第二个
observeEvent集合，以在重绘表之前和之后捕获当前选定的行。observeEvent的这个集合将由上游表中的行选择触发（下面的表2）observeEvent({input$table_1_agg_rows_selected input$selection_2}, { prev_selections$prev_rows_t2 = isolate(prev_selections$table2[input$table_2_agg_rows_selected,][1]) prev_selections$new_rows_t2 = isolate(if ( input$selection_2 == prev_selections$filterop_t2 ) {which(table_2()[,1] %in% prev_selections$prev_rows_t2[,1])} else {NULL}) }) -
使用步骤3中的值作为
selection = list(selected = )DT::renderDataTable参数的输入。不要忘记按HubertL's answer here 从
datatable内拨打DT::renderDataTable
以下完整代码：
library(shiny)
library(DT)
library(plyr)
library(dplyr)
# Generate income data
n <- 1000
age <- sample(20:60, n, replace=TRUE)
sex <- sample(c("M", "F"), n, replace=TRUE)
country <- sample(c("US", "CA", "UK", "DE", "CH", "NL"), n, replace=TRUE)
occupation <- sample(c("Engineer", "Doctor", "Retail", "Pilot"), n, replace=TRUE)
income <- sample(20000:120000, n, replace=TRUE)
df <- data.frame(age, sex, country, income, occupation)
categories <- c("None", "age", "sex", "country", "occupation")
server <- shinyServer(function(input, output, session) {
output$selection_1 <- renderUI({
selectInput("selection_1", "Level 1 Selection", selected = "None",
choices = categories)
})
output$selection_2 <- renderUI({
selectInput("selection_2", "Level 2 Selection", selected = "None",
choices = categories)
})
output$selection_3 <- renderUI({
selectInput("selection_3", "Level 3 Selection", selected = "None",
choices = categories)
})
table_1 <- reactive({
validate(
need(input$selection_1 != "None", "Select a variable for aggregation.")
)
ddply(df, input$selection_1, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_1_agg <- DT::renderDataTable(
table_1(),
rownames = TRUE,
selection = list(selected = "")
)
# Get values to match on subsequent tables
table_1_vals <- reactive({
table_1()[input$table_1_agg_rows_selected, 1]
})
# Filter table 2
table_2 <- reactive({
validate(
need(input$selection_2 != "None", "Select a variable for aggregation.")
)
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df2 <- df[df[,sel_1_col] %in% table_1_vals(),]
}else{
df2 <- df
}
ddply(df2, input$selection_2, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_2_agg <- DT::renderDataTable(
datatable(table_2(),
rownames = TRUE,
selection = list(target = 'row', selected = prev_selections$new_rows_t2))
)
# Get values to match on subsequent tables
table_2_vals <- reactive({
table_2()[input$table_2_agg_rows_selected, 1]
})
# Filter table 3
table_3 <- reactive({
validate(
need(input$selection_3 != "None", "Select a variable for aggregation.")
)
df3 <- df
# Filter selected values from table_1
if(length(table_1_vals())>0){
sel_1_col <- grep(input$selection_1, names(df))
df3 <- df3[df3[,sel_1_col] %in% table_1_vals(),]
}
if(length(table_2_vals())>0){
sel_2_col <- grep(input$selection_2, names(df))
df3 <- df3[df3[,sel_2_col] %in% table_2_vals(),]
}
ddply(df3, input$selection_3, summarize,
Count = length(income),
Med_Income = median(income))
})
output$table_3_agg <- DT::renderDataTable(
datatable(table_3(),
rownames = TRUE,
selection = list(target = 'row', selected = prev_selections$new_rows_t3))
)
## Retain highlighted rows in temp variables and enable persistent filtering
#initialize temp variables
prev_selections = reactiveValues(table2 = NULL, prev_rows_t2 = NULL, new_rows_t2 = NULL, filterop_t2 = 0,
table3 = NULL, prev_rows_t3 = NULL, new_rows_t3 = NULL, filterop_t3 = 0)
#Capture current selections/highlights in Table N
observeEvent(input$table_2_agg_rows_selected,
{
prev_selections$table2 = table_2()
prev_selections$filterop_t2 = input$selection_2
})
observeEvent(input$table_3_agg_rows_selected,
{
prev_selections$table3 = table_3()
prev_selections$filterop_t3 = input$selection_3
})
#Observe upstream events (e.g. highlights in Table N-1,...) and enable persistent selection
#Table 2
observeEvent({input$table_1_agg_rows_selected
input$selection_2},
{
prev_selections$prev_rows_t2 = isolate(prev_selections$table2[input$table_2_agg_rows_selected,][1])
prev_selections$new_rows_t2 = isolate(if ( input$selection_2 == prev_selections$filterop_t2 )
{which(table_2()[,1] %in% prev_selections$prev_rows_t2[,1])} else {NULL})
})
#Table 3
observeEvent({
input$table_1_agg_rows_selected
input$table_2_agg_rows_selected
input$selection_3
},
{
prev_selections$prev_rows_t3 = isolate(prev_selections$table3[input$table_3_agg_rows_selected,][1])
prev_selections$new_rows_t3 = isolate(if ( input$selection_3 == prev_selections$filterop_t3 )
{which(table_3()[,1] %in% prev_selections$prev_rows_t3[,1])} else {NULL})
})
})
ui <- shinyUI(fluidPage(
fluidRow(
column(6,
uiOutput("selection_1"),
DT::dataTableOutput("table_1_agg")),
column(6,
uiOutput("selection_2"),
DT::dataTableOutput("table_2_agg"))
),
fluidRow(
column(6,
br(),
uiOutput("selection_3"),
DT::dataTableOutput("table_3_agg"))
)
))
shinyApp(ui = ui, server = server)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？