R блестящая динамическая фильтрация

Question

Новый R R блестящий пользователь здесь .. У меня есть 6 фильтров для данных, и я хочу иметь возможность динамических фильтров, работающих в любом направлении.Например: у меня есть фильтры A, B, C, D, E, F. Если я фильтрую по A, B или C и т. Д., Я хочу, чтобы все другие фильтры динамически обновлялись, чтобы показывать unique () отфильтрованных данных и так далее, если ядвигайтесь сквозь фильтры в любом направлении.

Я испробовал несколько разных техник, но все они, похоже, не сработали.В конце концов я укусил пулю и написал самый подробный код, чтобы учесть все возможные комбинации направлений фильтра.Например:

Сначала в ui.R Я настроил selectInput для фильтров A, B, C, D, E, F

Затем на сервере.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, если! = "Все" без дополнительных условий "&&" для логического значения (например,Я сделал, чтобы отфильтровать саму информацию), она не сработала.

У меня фильтры работают так, как я хочу, но мое внутреннее ощущение, что я слишком усердно работаю над этим.

Спасибо за чтение всего этого и за вашу помощь !!

Приложение - вот пример, который я ожидал, но не работал:

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

    })

  }
)

Answer 1

Ответом может быть использование функции filter () и конвейер из dplyr.Я использовал его внутри серверной функции 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

Answer 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))))

    })

  }
)

Код демонстрирует, как можно обновить раскрывающиеся списки, используя реактивные значения.Я не написал код для обработки ситуации «Все», но предоставил кнопку «Сброс» в качестве обходного пути.Вы можете добавить код для захвата ситуации All без необходимости кнопки сброса.