R闪亮的动态过滤

【问题标题】：R shiny dynamic filteringR闪亮的动态过滤
【发布时间】：2018-08-27 03:22:04
【问题描述】：

这里有新的 R 闪亮用户.. 我有 6 个用于数据表的过滤器，并且希望能够让动态过滤器在任何方向上工作。例如：我有过滤器 A、B、C、D、E、F。如果我在 A 或 B 或 C 等处过滤，我希望所有其他过滤器动态更新以显示过滤数据表的 unique() 等等，如果我向任意方向移动过滤器。

我尝试了许多不同的技术，但它们似乎都无法正常工作。最终我硬着头皮写了最冗长的代码来解释过滤器方向的所有可能组合。比如：

首先在 ui.R 我为过滤器 A、B、C、D、E、F 设置 selectInput

然后在 server.R 我很容易过滤表格

tt <- reactive({
    dt <- mytable
    dt <- dt[,input$ColumnsToShow2,drop=FALSE]
if (input$A != "All") {
  dt <- dt[dt$A == input$A,]
}

if (input$B != "All") {
  dt <- dt[dt$B == input$B,]
}
if (input$C != "All") {
  dt <- dt[dt$C == input$C,]
}
if (input$D != "All") {
  dt <- dT[dt$D == input$D,]
}
if (input$E != "All") {
  dt <- dt[dt$E == input$E,]
}
if (input$F != "All") {
  dt <- dt[dt$F == input$F,]
}
    dt   
})

然后我去 - 

observe({
#One filter is used:

If A!="All" && B && C && D && E && F are all =="All", then UpdateSelectInput filters B,C,D,E,F

If B!="All" and A && C && D && E && F are all == "All", then 
UpdateSelectInput filters A,C,D,E,F 

If C and so on, you get the logic

#Two filters are used: 
If A!="All" && B!="All" && C && D && E && F are all == "All", then 
UpdateSelectInput filters C, D, E, F

if A!="All" && C!="All" && B && D && E && F are all == "All", then 
UpdateSelectInput filters B, D, E, F

#etc all the way through 

if E!="All" && F!="All" && A && B && C && D are all == "All", then
UpdateSelectInput filters A, B, C, D.

#three filters are used...all the way through 5 filters are used

)}

你现在明白了。我很确定您可以设置一个类似的示例来使用。

注意：当我尝试只使用 6 if != "All" 而不使用额外的 "&&" 布尔条件时（就像我过滤数据表本身所做的那样），它不起作用。

我的过滤器按照我想要的方式完美地工作，但我的直觉是我在这方面工作太努力了。

感谢您阅读本文并提供帮助！

附录 - 这是一个我希望工作但没有工作的示例：

data <- structure(list(Country.Name = structure(c(1L, 1L, 1L, 1L, 1L, 
                                                     1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L
), .Label = c("High income", "Low income", "Mid income"), class =             
"factor"), 
Country.Code = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
                       2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L,     
3L), .Label = c("HIC", 

"LIC", "MIC"), class = "factor"), Indicator.Name = structure(c(10L, 

9L, 11L, 8L, 6L, 4L, 7L, 5L, 3L, 2L, 18L, 19L, 1L, 17L, 16L, 

12L, 20L, 13L, 14L, 15L, 3L), .Label = c("2005 PPP conversion factor, 
GDP (LCU per international $)", 

"2005 PPP conversion factor, private consumption (LCU per international 
$)", 

"Adequacy of social protection and labor programs (% of total welfare 
of beneficiary households)", 

"Adequacy of unemployment benefits and ALMP (% of total welfare of 
beneficiary households)", 

"Benefit incidence of social protection and labor programs to poorest 
quintile (% of total SPL benefits)", 

"Benefit incidence of unemployment benefits and ALMP to poorest 
quintile (% of total U/ALMP benefits)", 

"Coverage of social protection and labor programs (% of population)", 

"Coverage of unemployment benefits and ALMP (% of population)", 

"Coverage of unemployment benefits and ALMP in 2nd quintile (% of 
population)", 

"Coverage of unemployment benefits and ALMP in 3rd quintile (% of 
population)", 

"Coverage of unemployment benefits and ALMP in poorest quintile (% of 
population)", 

"DEC alternative conversion factor (LCU per US$)", "Net secondary 
income (Net current transfers from abroad) (constant LCU)", 

"Net secondary income (Net current transfers from abroad) (current 
LCU)", 

"Net secondary income (Net current transfers from abroad) (current 
US$)", 

"Official exchange rate (LCU per US$, period average)", "PPP conversion 
factor, GDP (LCU per international $)", 

"PPP conversion factor, private consumption (LCU per international $)", 

"Price level ratio of PPP conversion factor (GDP) to market exchange 
rate", 

"Terms of trade adjustment (constant LCU)"), class = "factor"), 
Indicator.Code = structure(c(21L, 20L, 19L, 18L, 17L, 16L, 
                         15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 
5L, 4L, 3L, 
                         2L, 1L), .Label = c("NY.GSR.NFCY.CN", 
"NY.GSR.NFCY.KN", "NY.TAX.NIND.CD", 
                                             "NY.TAX.NIND.CN", 
"NY.TAX.NIND.KN", "NY.TRF.NCTR.CD", "NY.TRF.NCTR.CN", 
                                             "NY.TRF.NCTR.KN", 
"NY.TTF.GNFS.KN", "PA.NUS.ATLS", "PA.NUS.FCRF", 
                                             "PA.NUS.PPP", 
"PA.NUS.PPP.05", "PA.NUS.PPPC.RF", "per_allsp.cov_pop_tot", 

"per_lm_alllm.adq_pop_tot", "per_lm_alllm.ben_q1_tot", 
"per_lm_alllm.cov_pop_tot", 
                                             "per_lm_alllm.cov_q1_tot", 
"per_lm_alllm.cov_q2_tot", "per_lm_alllm.cov_q3_tot"
                         ), class = "factor"), Source.no = 
structure(c(3L, 3L, 3L, 

3L, 3L, 3L, 3L, 3L, 3L, 8L, 1L, 7L, 8L, 1L, 5L, 4L, 9L, 6L, 

2L, 10L, 11L), .Label = c(" for Economic Co-operation and Development 
(OECD).", 

" nonresidents. Data are in current local currency.", "es include both 
direct and indirect beneficiaries.", 

"expressed in local currency units per U.S. dollar.", "local currency 
units relative to the U.S. dollar).", 

"nonresidents. Data are in constant local currency.", "onversion 
factors are based on the 2011 ICP round.", 

"rapolated estimates based on the latest ICP round.", "stant prices. 
Data are in constant local currency.", 

"to nonresidents. Data are in current U.S. dollars.", "to producers. 
Data are in constant local currency."

), class = "factor"), Source.organization = structure(c(4L, 

4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 2L, 5L, 

3L, 3L, 3L, 3L, 3L), .Label = c("d Bank, International Comparison 
Program database.", 

"Monetary Fund, International Financial Statistics.", "ounts data, and 
OECD National Accounts data files.", 

"sehold surveys. (datatopics.worldbank.org/aspire/)", "stics, 
supplemented by World Bank staff estimates."

), class = "factor")), .Names = c("Country.Name", "Country.Code", 

"Indicator.Name", "Indicator.Code", "Source.no", "Source.organization"

), class = "data.frame", row.names = c(NA, -21L))


shinyApp(
  ui = fluidPage(

    fluidRow(
      column(2,
             selectInput("CN",
                         "Country name:",
                         c("All",
                           unique(as.character(data$Country.Name))))
      ),
      column(2,
             selectInput("CC",
                         "Country code:",
                         c("All",
                           unique(as.character(data$Country.Code))))
      ),
      column(2,
             selectInput("IN",
                         "Indicator name:",
                         c("All",
                           unique(as.character(data$Indicator.Name))))
      ),
      column(2,
             selectInput("IC",
                         "Indicator Code:",
                         c("All",
                           unique(as.character(data$Indicator.Code))))
      ),
      column(2,
             selectInput("SN",
                         "Source no:",
                         c("All",
                           unique(as.character(data$Source.no))))
      ),
      column(2,
             selectInput("SO",
                         "Source org:",
                         c("All",
                           unique(as.character(data$Source.organization))))
      )

    ),

    fluidRow(
      div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
    )
  ),
  server = function(input, output,session) {

    table_one <- reactive({
      if (input$CN != "All") {
        data <- data[data$Country.Name == input$CN,]
      }
      if (input$CC != "All") {
        data <- data[data$Country.Code == input$CC,]
      }
      if (input$IN != "All") {
        data <- data[data$Indicator.Name == input$IN,]
      }
      if (input$IC != "All") {
        data <- data[data$Indicator.Code == input$IC,]
      }
      if (input$SN != "All") {
        data <- data[data$Source.no == input$SN,]
      }
      if (input$SO != "All") {
        data <- data[data$Source.organization == input$SO,]
      }
      data 
    }) 


    output$table1 <- DT::renderDataTable(DT::datatable({
      table_one()
    },rownames = FALSE,
    options = list(scrollX=TRUE,
                   autoWidth = TRUE,
                   columnDefs = list(list(width = '150px', targets = "_all")))

    ))

    #filter code begin
    #if all filters are "all"
    observe({
      if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(data$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(data$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(data$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(data$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(data$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(data$Source.organization))))
      }

      #otherwise
      if (input$CN!="All"){
        #updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$CC!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        #updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$IN!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        #updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$IC!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        #updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$SN!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        #updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$SO!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        #updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }

    })

  }
)

【问题讨论】：

    标签： r dynamic filter shiny


    【解决方案1】：

    使用 dplyr 的 filter() 函数和管道可能是答案。我在 renderPlot({}) 服务器函数中使用它，它对我有用（我没有在观察函数中尝试过）。

    data = data %>% filter(if(input$CN == 'ALL'){Country.Name %in% c("countryname_1", "countryname_2",...,"countryname_n")} else {Country.Name == input$CN}) %>%
  filter(if(input$CC == 'ALL'){Country.Code %in% c("countrycode_1",..,"countrycode_n")} else {Country.Code == input$CC}) %>%

    每个过滤器都以此类推

    如果您有很多国家/地区，可能有更好的方法来获取未过滤的版本，而不是 if 语句中的这一部分：Country.Code %in% c("countrycode_1",..,"countrycode_n")，但 if/else 嵌套在过滤器中, 和过滤器语句与 %>% 管道连接的每个属性对我有用（并节省了很多空间）。

    这些链接也可能有帮助： filtering values

    using filter with if/else statement

    *编辑更新：我最终把这个过滤器功能配置放在了观察功能中，效果很好，看起来也更有条理

    【讨论】：

      【解决方案2】：

      您不必单独编码来更新每个下拉菜单。您可以使数据集反应，并将下拉选项设置为该反应数据集中的列值。

      您可能希望使用Observe 函数来更新 SelectInput。

         observe(
        UpdateSelectInput(session,inputId,label, choices = c(unique(dataframe()$Column))
    )

      如果你提供一个可重现的例子，它会更容易演示

      更新的解决方案

      shinyApp(
  ui = fluidPage(

    fluidRow(
      column(2,
             selectInput("CN",
                         "Country name:",
                         c("All",
                           unique(as.character(data$Country.Name))))
      ),
      column(2,
             selectInput("CC",
                         "Country code:",
                         c("All",
                           unique(as.character(data$Country.Code))))
      ),
      column(2,
             selectInput("IN",
                         "Indicator name:",
                         c("All",
                           unique(as.character(data$Indicator.Name))))
      ),
      column(2,
             selectInput("IC",
                         "Indicator Code:",
                         c("All",
                           unique(as.character(data$Indicator.Code))))
      ),
      column(2,
             selectInput("SN",
                         "Source no:",
                         c("All",
                           unique(as.character(data$Source.no))))
      ),
      column(2,
             selectInput("SO",
                         "Source org:",
                         c("All",
                           unique(as.character(data$Source.organization))))
      )

    ),

    fluidRow(
      div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
    ),
    fluidRow(actionButton('reset','reset'))
  ),
  server = function(input, output,session) {

    rv = reactiveValues()
    rv$data=data

    observe({
      #table_one <- data
      if (input$CN != "All") {
        rv$data <- rv$data[rv$data$Country.Name == input$CN,]
      }
      if (input$CC != "All") {
        rv$data <- rv$data[rv$data$Country.Code == input$CC,]
      }
      if (input$IN != "All") {
        rv$data <- rv$data[rv$data$Indicator.Name == input$IN,]
      }
      if (input$IC != "All") {
        rv$data <- rv$data[rv$data$Indicator.Code == input$IC,]
      }
      if (input$SN != "All") {
        rv$data <- rv$data[rv$data$Source.no == input$SN,]
      }
      if (input$SO != "All") {
        rv$data <- rv$data[data$Source.organization == input$SO,]
      }

    }) 
    observeEvent(input$reset,{
      rv$data <- data
    })

    output$table1 <- DT::renderDataTable(DT::datatable({
      rv$data
    },rownames = FALSE,
    options = list(scrollX=TRUE,
                   autoWidth = TRUE,
                   columnDefs = list(list(width = '150px', targets = "_all")))

    ))

    #filter code begin
    #if all filters are "all"
    observe({
      #if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(rv$data$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(rv$data$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(rv$data$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(rv$data$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(rv$data$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(rv$data$Source.organization))))

    })

  }
)

      代码演示了如何使用 reactiveValues 更新下拉菜单。我还没有编写代码来处理“全部”情况，但提供了一个重置​​按钮作为解决方法。您可以添加代码来捕获所有情况，而无需重置按钮。

      【讨论】：

      • 我实际上在当前的解决方案中这样做了 - 我不跟踪和过滤单独的数据表，我过滤“当前”过滤的数据表。我认为这不像在数据表中那样起作用的问题至少部分是因为过滤变得模棱两可。我稍后会提供一个可重现的内容...
      • 请提供“数据”。您可以使用 dput 来提供相同的
      • 刚刚做到了！ :) 对此感到抱歉
      • 当您选择多个过滤器并且最后一个过滤器似乎不起作用时，它会变得有点笨拙，但更重要的是我明白了这个想法并且可以使用它来查看！谢谢阿什利奇！！
      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2018-02-13
      • 2020-10-30
      • 1970-01-01
      • 2020-08-18
      • 1970-01-01
      • 1970-01-01
      • 2015-01-19
      相关资源
      最近更新 更多
      热门标签
      Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode