使用DT和R的持久选择

我有一个闪亮的用例，允许用户通过选择列和查看某些摘要统计信息来过滤数据。这样做的目的是让他们能够快速深入到更细粒度的组并查看结果。它运行良好，除非用户在更高级别进行选择，然后所有过滤器和选择都会重置，需要再次选择。我在使这些过滤器持久化和只在某些情况下更新方面遇到了一些麻烦

例如，用户希望查看瑞士和德国1级工程师2级的收入中值，并按年龄3级显示。他们将按每个表上方的selectInput值进行排序，以选择类别，然后选择表中的值以包括变量，如下图所示

如果他们想看到试点如何改变结果，国家过滤器将消失。我希望这些都能保持原位，而这正是让我感到舒服的部分

关于如何解决这个问题有什么想法吗？此示例的代码如下所示：

服务器：

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 = "")
  )
})

---

谢谢

一个选项是存储所选行，并在以后重新绘制表格时使用。这可以使用一个额外的renderi来放置表的创建，并使用参数选择来指示要选择的行

有光泽的图书馆 图书馆 图书馆弹琴 图书馆 生成收入数据

---

n一个选项是存储所选行，并在以后重新绘制表格时使用。这可以使用一个额外的renderi来放置表的创建，并使用参数选择来指示要选择的行

有光泽的图书馆 图书馆 图书馆弹琴 图书馆 生成收入数据

---

n您可以通过添加以下功能来实现这一点：

初始化一个临时反应变量。在时刻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})
  })

在DT:：renderDataTable的selection=listselected=参数中使用步骤3中的值作为输入。别忘了根据从DT:：renderDataTable中调用datatable

完整代码如下：

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)

---

您可以通过添加以下功能来实现这一点：

初始化一个临时反应变量。在时刻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})
  })

在DT:：renderDataTable的selection=listselected=参数中使用步骤3中的值作为输入。别忘了根据从DT:：renderDataTable中调用datatable

完整代码如下：

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)