此应用程序旨在根据Shiny应用程序中的2个输入选择创建更大数据集的子集。我使用了here上找到的下拉按钮功能。
# func --------------------------------------------------------------------
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
我的应用程序旨在根据Shiny应用程序中的2个输入选择创建更大数据集的子集。对于这两个下拉菜单，我想要多个选择选项，类似于multiple=TRUE中的selectInput。虽然dropdownbutton菜单允许我选择多个选项，但它会随机省略应包含在输出中的数据。当我使用selectInput时，我得到了正确的子集。任何解决方案？
其次，我的selectAll按钮无效。
问题是当我选择
时ou1 <- levels(df$OperatingUnit)
ou <- setNames(as.list(ou1),ou1)
indi1 <- levels(df$indicator)
indi <- setNames(as.list(indi1),indi1)
ui->...
inputPanel(
dropdownButton(
label = "Select OU", status = "default", width = 120,
actionButton(inputId = "all", label = "Select all"),
checkboxGroupInput(inputId = "check1", label = "Choose", choices = paste(ou))
),
dropdownButton(
label = "Select Indicators", status = "default", width = 150,
checkboxGroupInput(inputId = "check2", label = "Choose", choices = paste(indi))
),
tableOutput("tab1")
))
服务器 - ＆gt;
shinyServer(function(input, output, session) {
dataset - changes based on menu selections
df1 <- reactive({
df[df$OperatingUnit==input$check1 & df$indicator==input$check2,]
})
output$tab1<- renderTable({
head(df1(), n = 10)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("PSNU_IM", '.csv', sep='')
},
content = function(file) {
write.csv(df1(), file)
}
)
# Select all / Unselect all
observeEvent(input$all, {
if (is.null(input$check1)) {
updateCheckboxGroupInput(
session = session, inputId = "check1", selected = paste(ou)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check1", selected = ""
)
}
})
})
)`
我的数据子集：
structure(list(Region = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L), .Label = "Africa", class = "factor"), OperatingUnit = structure(c(3L,
3L, 3L, 3L, 3L, 3L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L), .Label = c("Angola", "Botswana",
"Cameroon"), class = "factor"), SNU1Uid = structure(c(5L, 5L,
9L, 9L, 4L, 5L, 1L, 4L, 5L, 4L, 4L, 5L, 4L, 9L, 3L, 9L, 4L, 9L,
4L, 4L, 4L, 3L, 4L, 4L, 5L, 5L, 9L, 5L, 4L, 4L, 3L, 3L, 9L, 4L,
4L, 9L, 4L, 7L, 8L, 6L, 2L), .Label = c("", "BTRiZA58YEx", "HxXMyMSODnm",
"IaFLxtEwIwk", "Jm3YTCERxvX", "MERiZA58YEx", "MTRiZA58YEx", "MTRiZA68YEx",
"MTRiZG58YEx"), class = "factor"), PSNUuid = structure(c(29L,
11L, 23L, 23L, 10L, 29L, 1L, 13L, 18L, 30L, 8L, 2L, 9L, 7L, 15L,
19L, 33L, 16L, 27L, 31L, 21L, 3L, 20L, 25L, 14L, 32L, 7L, 28L,
22L, 22L, 24L, 12L, 16L, 8L, 9L, 5L, 10L, 4L, 6L, 17L, 26L), .Label = c("",
"a2nQs7VmYiD", "AbJXFBhkc4U", "AFX0cjkDX6A", "AFX0djkDX6A", "AFX0djkFX6A",
"AW764lDxjdr", "clasYX5teTV", "fHkrk3yL1uU", "gOaZeiwAoCD", "GP5qeoiXMtA",
"hvNtuMClAXW", "hz2Tdvrxqbp", "JIcgSOsSpSV", "js5vRAkkqxB", "k7lIVnxWbm7",
"KFX0djkDX6A", "MIvAFWhI9Yc", "Ns6ZJi0iwJj", "oAgxCCStCQe", "PJKaNADvNfi",
"r5xWCJ4ZqYQ", "rjDWLPMhaY0", "VaHOXJU4rir", "vewKgey8sOW", "VFX0djkDX6A",
"Vq1CnJNw46x", "vqaBeYFtUn0", "VZPPWeDuJqU", "YuCzvkHV2X5", "YXiMSh7CqES",
"zU7eKPwFr69", "ZxJNWnk4hYW"), class = "factor"), indicator = structure(c(5L,
5L, 1L, 5L, 1L, 1L, 4L, 1L, 1L, 2L, 5L, 1L, 1L, 5L, 1L, 5L, 5L,
5L, 5L, 3L, 1L, 5L, 1L, 1L, 5L, 5L, 1L, 5L, 1L, 3L, 1L, 1L, 5L,
5L, 1L, 5L, 5L, 6L, 6L, 5L, 5L), .Label = c("CARE_CURR", "GEND_GBV",
"GEND_NORM", "HRH_PRE", "TX_CURR", "TX_NEW"), class = "factor"),
numeratorDenom = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L), .Label = "N", class = "factor"), indicatorType = structure(c(1L,
1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L,
2L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L), .Label = c("DSD",
"TA"), class = "factor"), disaggregate = structure(c(4L,
1L, 1L, 6L, 6L, 1L, 5L, 1L, 2L, 1L, 6L, 1L, 1L, 3L, 1L, 6L,
6L, 1L, 1L, 6L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("Age/Sex",
"Age/Sex Aggregated", "Age/Sex, Aggregated", "Aggregated Age/Sex",
"Grad Cadre", "Total Numerator"), class = "factor"), categoryOptionComboName = structure(c(8L,
7L, 16L, 13L, 13L, 23L, 19L, 14L, 9L, 3L, 13L, 16L, 21L,
2L, 17L, 13L, 13L, 2L, 11L, 13L, 18L, 1L, 14L, 4L, 1L, 10L,
23L, 12L, 20L, 6L, 22L, 15L, 7L, 12L, 16L, 5L, 2L, 12L, 16L,
5L, 2L), .Label = c("<1, Female", "<1, Male", "<10, Female",
"<15, Male", "1-4, Male", "10-14, Male", "15-19, Female",
"15+, Female", "15+, Male", "20+, Female", "20+, Male", "5-14, Male",
"default", "Female, 15-19", "Female, 20-24", "Female, 25-49",
"Female, 5-9", "Female, 50+", "Lab Professionals", "Male, <1",
"Male, 1-4", "Male, 20-24", "Male, 50+"), class = "factor"),
Age = structure(c(10L, 9L, 13L, 1L, 1L, 14L, 1L, 9L, 10L,
3L, 1L, 13L, 5L, 2L, 6L, 1L, 1L, 2L, 12L, 1L, 14L, 2L, 9L,
4L, 2L, 12L, 14L, 7L, 2L, 8L, 11L, 11L, 9L, 7L, 13L, 5L,
2L, 7L, 13L, 5L, 2L), .Label = c(" ", " <01", " <10",
" <15", " 01-04", " 05-09", " 05-14", " 10-14", " 15-19",
" 15+", " 20-24", " 20+", " 25-49", " 50+"), class = "factor"),
Sex = structure(c(2L, 2L, 2L, 1L, 1L, 3L, 1L, 2L, 3L, 2L,
1L, 2L, 3L, 3L, 2L, 1L, 1L, 3L, 3L, 1L, 2L, 2L, 2L, 3L, 2L,
2L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 3L, 2L, 3L, 3L, 3L, 2L, 3L,
3L), .Label = c("", "Female", "Male"), class = "factor"),
FY2016Q4 = c(60L, 42L, 144L, 606L, 977L, 509L, 475L, 827L,
455L, 966L, 432L, 372L, 333L, 0L, 583L, 339L, 423L, 107L,
341L, 45L, 818L, 299L, 679L, 261L, 964L, 338L, 470L, 879L,
421L, 351L, 490L, 464L, 416L, 844L, 752L, 708L, 506L, 889L,
230L, 586L, 576L), FY2016APR = c(4L, 471L, 106L, 876L, 873L,
490L, 65L, 360L, 232L, 673L, 646L, 548L, 495L, 846L, 215L,
11L, 405L, 953L, 411L, 610L, 907L, 755L, 580L, 967L, 594L,
213L, 227L, 54L, 25L, 930L, 266L, 512L, 277L, 150L, 454L,
478L, 720L, 666L, 249L, 886L, 781L), FY2017_TARGETS = c(464L,
853L, 907L, 598L, 685L, 791L, 232L, 981L, 217L, 705L, 920L,
890L, 144L, 545L, 159L, 615L, 72L, 570L, 325L, 138L, 919L,
743L, 316L, 673L, 867L, 488L, 652L, 683L, 805L, 616L, 701L,
911L, 985L, 595L, 576L, 132L, 396L, 856L, 721L, 353L, 105L
)), .Names = c("Region", "OperatingUnit", "SNU1Uid", "PSNUuid",
"indicator", "numeratorDenom", "indicatorType", "disaggregate",
"categoryOptionComboName", "Age", "Sex", "FY2016Q4", "FY2016APR",
"FY2017_TARGETS"), class = "data.frame", row.names = c(NA, -41L
))
答案 0 :(得分：1)
您在过滤data.frame使用%in%而不是==时过滤，因为您比较的两个矢量不具有相同的长度，例如：
df1 <- reactive({
df[df$OperatingUnit %in% input$check1 & df$indicator %in% input$check2, ]
})
对于第二个＆＃34;选择所有＆＃34;按钮，如果你想要点击它，你必须在你的服务器上放一个observeEvent：
observeEvent(input$all1, {
if (is.null(input$check2)) {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = paste(indi)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = ""
)
}
})