堆棧內存溢出
  簡體   English   中英

使用DT和R Shiny進行持久選擇

[英]Persistent Selections Using DT and R Shiny

 原文  2017-08-09 14:05:13  7   2    r/ shiny/ dt

問題描述

我有一個Shiny用例，我想允許用戶通過選擇列並查看某些摘要統計信息來過濾其數據。 這樣做的目的是使他們能夠快速深入到更細粒度的組並查看結果。 除非用戶在較高級別上進行選擇，否則它將很好地工作，然后重置所有過濾器和選擇並需要再次選擇。 我一直在使這些過濾器永久存在並且僅在某些情況下進行更新時遇到麻煩。

例如，用戶想要查看瑞士和德國（第2級）的工程師的收入中位數（第1級），並按年齡顯示收入（第3級）。 他們將按每個表上方的selectInput值進行排序，以選擇類別，然后在表中選擇值，以包含變量，例如“ Engineer”，如下圖所示。

應用價值過濾

如果他們想查看“試點”如何更改結果，則國家/地區過濾條件將消失。 我希望所有這些都保留在原處，而這一直是給我合適的部分。

關於如何解決這個問題有什么想法嗎？ 此示例的代碼如下：

服務器： 

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

用戶界面： 

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 個解決方案

解決方案1
 0  2017-08-09 22:39:39

一種選擇是存儲選定的行，並在稍后重繪表時使用。 可以使用附加的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)

解決方案2
 0  2017-08-11 16:29:36

您可以通過添加以下功能來實現：

  1. 初始化臨時反應變量。 在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)

  2. 因為您在表N中選擇的行將過濾表N + 1，所以您需要在重繪下游表之前創建一個副本。 使用observeEvent捕獲應用的過濾器的表和值（表2下方） 

     observeEvent(input$table_2_agg_rows_selected,{ prev_selections$table2 = table_2() prev_selections$filterop_t2 = input$selection_2 })

  3. 為每個表創建第二個observeEvent集合，以捕獲重繪表之前和之后的當前選定行。 觀察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}) })

  4. 將步驟3中的值用作DT::renderDataTable的selection = list(selected = )參數的DT::renderDataTable 。 不要忘記調用datatable從內DT::renderDataTable按這里HubertL的答案

完整代碼如下： 

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)

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 使用 DT 的 Shiny 應用程序中的反應式可編輯表中的持久數據 帶有 Shiny DT 的持久列過濾器 如何在R中使用DT渲染Datatable shiny 帶有DT和閃亮效果的R字形圖 在 R 中使用帶有 Shiny 的 flexdashboard 使 DT (DataTable) 具有響應性 在R Shiny中使用DT數據表將第二行作為列標題 R 使用閃亮、rhandson 和 DT 更改列類型 R Shiny-app DT：使用大於的過濾器 R - 使用 dplyr、DT 和 Shiny 在地圖中創建數據表 如何使用數據表函數替換在 R 中呈現的 DT 中的數據
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM