新的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
)}
您现在明白了。我很确定您可以设置一个类似的示例来使用它。
NB：当我尝试仅使用6个!!“ 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))))
}
})
}
)
答案 0 :(得分：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嵌套在内部过滤器，以及与％>％管道连接的每个属性的过滤器语句对我来说都是有效的（并节省了大量空间）。
这些链接可能也有帮助： filtering values
答案 1 :(得分：0)
您不必单独编写代码即可更新每个下拉菜单。您可以使数据集具有反应性，并将下拉选项设置为该反应性数据集中的列值。
您可能想使用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))))
})
}
)
该代码演示了如何使用reactValues更新下拉列表。我没有编写代码来处理“全部”情况，但是提供了“重置”按钮作为解决方法。您可以添加代码来捕获所有情况，而无需重置按钮。