我正在努力通过连续通过多个过滤器来解决问题，有时结果不是预期的。在下面的示例中，有7只鹿，2只熊，1只美洲狮，1只海狸，1只臭鼬，1只麋鹿和3只麋鹿。当您选择一种或多种种类时，有时通过过滤器的行数与应该的数量不相同。
例如。当我选择Bear，Beaver和Cougar时，它将产生4行的数据集，但是，在显示行数的textoutput中，将显示nrow = 3。添加更多选择有时会使其余的过滤器通过，有时则不会。有时，在选择Deer时（您希望获得7行数据），仅传递3行。
看看下面的可复制示例。
服务器：
library(shiny)
library(dplyr)
shinyServer(function(input, output, session, clientData) {
Accident.Date <- as.Date(c("2018-06-04", "2018-06-05", "2018-06-06", "2018-06-07", "2018-06-08", "2018-06-09", "2018-06-10", "2018-06-11", "2018-06-12", "2018-06-13", "2018-06-14", "2018-06-15", "2018-06-16", "2018-06-17", "2018-06-18", "2018-07-18"))
Time.of.Kill <- as.character(c("DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DAY", "DAY", "DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DARK", "DUSK", "DARK", "DAY"))
Sex <- as.character(c("MALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "MALE", "MALE", "FEMALE", "FEMALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "FEMALE"))
Age <- as.character(c("ADULT", "YOUNG", "UNKNOWN", "ADULT", "UNKNOWN", "ADULT", "YOUNG", "YOUNG", "ADULT", "ADULT", "ADULT", "YOUNG", "ADULT", "YOUNG", "YOUNG", "ADULT"))
Species <- as.character(c("Deer", "Deer", "Deer", "Bear", "Deer", "Cougar", "Bear", "Beaver", "Deer", "Skunk", "Moose", "Deer", "Deer", "Elk", "Elk", "Elk"))
Year <- as.numeric(c("0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0"))
data <- data.frame(Accident.Date, Time.of.Kill, Sex, Age, Species, stringsAsFactors = FALSE)
data <- data %>% mutate(Data.Set = "Current")
#A set of reactive filters. Only data that has passed all filters is passed to the map, graph, datatable etc. **Order goes datacheck > yearcheck > speccheck > sexcheck > timecheck > agecheck > indaterange
bindata <- reactive({
filter(data, Data.Set %in% input$datacheck)
})
yrdata <- reactive({
filter(bindata(), Year %in% input$yearcheck)
})
specdata <- reactive({
subset(yrdata(), Species %in% input$speccheck)
})
sexdata <- reactive({
filter(specdata(), Sex %in% input$sexcheck)
})
timedata <- reactive({
filter(sexdata(), Time.of.Kill %in% input$timecheck)
})
agedata <- reactive({
filter(timedata(), Age %in% input$agecheck)
})
#Does the date range filter. Selects min and max from the two inputs of the observed indaterange filter.
data1 <- reactive({ filter(agedata(),
Accident.Date >= input$inDateRange[[1]],
Accident.Date <= input$inDateRange[[2]])
})
#If statement for choosing between current and historical datasets. If current is selected, year is set to 0 and the selection box is hidden.
observe({ if (input$datacheck == 'Current')
updateSelectInput(session, "yearcheck", choices = c("0"), selected = c("0"))
else
updateSelectizeInput(session, "yearcheck", choices = sort(unique(bindata()$Year), decreasing = TRUE), server=TRUE)
})
observe({
req((input$datacheck == 'Historical'))
updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)
})
#Creates the observed Species
observeEvent(input$yearcheck, {
x <- input$yearcheck
if (is.null(x))
x <- character(0)
updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)
})
#Creates the observed Sex
observeEvent(input$speccheck, {
x <- input$speccheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "sexcheck",
choices = unique(specdata()$Sex),
selected = unique(specdata()$Sex),
inline = TRUE)
})
#Creates the observed Time
observeEvent(input$sexcheck,{
x <- input$sexcheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "timecheck",
choices = unique(sexdata()$Time.of.Kill),
selected = unique(sexdata()$Time.of.Kill),
inline = TRUE)
})
#Creates the observed Age
observeEvent(input$timecheck,{
x <- input$timecheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "agecheck",
choices = unique(timedata()$Age),
selected = unique(timedata()$Age),
inline = TRUE)
})
#Creates the observed dates and suppresses warnings from the min max
observeEvent(input$agecheck, {
x <- input$agecheck
if (is.null(x))
x <- character(0)
#And update the date range values to match those of the dataset
updateDateRangeInput(
session = session,
inputId = "inDateRange",
start = min(suppressWarnings(agedata()$Accident.Date)),
end = max(suppressWarnings(agedata()$Accident.Date))
)
})
output$txt <- renderText({nrow(data1())})
})
ui：
navbarPage("Test", id="nav",
tabPanel("Map",
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = FALSE, top = 200, left = 5, right = "auto", bottom = "auto",
width = "auto", height = "auto",
radioButtons("datacheck", label = tags$div( HTML("<b>Dataset</b>")),
choices = c("Current" = "Current", "Historical" = "Historical"),
selected = c("Current"), inline = TRUE),
conditionalPanel(condition = "input.datacheck != 'Current'",
#Only displays yearcheck for historical as there is no year column on current dataset. Current dataset has had all year values set to 0.
selectizeInput("yearcheck", label = "Select Year (Only Available for Historical)", choices = NULL, options = list(placeholder = 'Select Year:', maxOptions = 40, maxItems = 40))),
selectizeInput("speccheck", h3("Select Species:"), choices = NULL, options = list(placeholder = 'Select Species: (Max 12) ', maxOptions = 36, maxItems = 12)),
conditionalPanel(condition = "input.speccheck >= '1'",
dateRangeInput("inDateRange", "Date range input:"),
checkboxGroupInput("sexcheck", label = tags$div( HTML("<b>Sex</b><br>"))),
checkboxGroupInput("agecheck", label = tags$div( HTML("<b>Age</b><br>"))),
checkboxGroupInput("timecheck", label = tags$div( HTML("<b>Time of Accident</b><br>")))
),
verbatimTextOutput("txt")
)))
任何帮助将不胜感激。我已经为此抓了一段时间了。
答案 0 :(得分：0)
问题与您更新复选框的方式有关。使用您的代码：选择first BEAR，输出看起来不错，但是，如果添加BEAVER，则什么也不会发生。为什么？因为当您的过滤器通过
timedata <- reactive({
filter(sexdata(),(Time.of.Kill %in% input$timecheck))
})
由于BEAR并未将DAWN设为Time.of.Kill，因此BEAVER无法通过此过滤器。
这是我的解决方法：
shinyServer(function(input, output, session, clientData) {
Accident.Date <- as.Date(c("2018-06-04", "2018-06-05", "2018-06-06", "2018-06-07", "2018-06-08", "2018-06-09", "2018-06-10", "2018-06-11", "2018-06-12", "2018-06-13", "2018-06-14", "2018-06-15", "2018-06-16", "2018-06-17", "2018-06-18", "2018-07-18"))
Time.of.Kill <- as.character(c("DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DAY", "DAY", "DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DARK", "DUSK", "DARK", "DAY"))
Sex <- as.character(c("MALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "MALE", "MALE", "FEMALE", "FEMALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "FEMALE"))
Age <- as.character(c("ADULT", "YOUNG", "UNKNOWN", "ADULT", "UNKNOWN", "ADULT", "YOUNG", "YOUNG", "ADULT", "ADULT", "ADULT", "YOUNG", "ADULT", "YOUNG", "YOUNG", "ADULT"))
Species <- as.character(c("Deer", "Deer", "Deer", "Bear", "Deer", "Cougar", "Bear", "Beaver", "Deer", "Skunk", "Moose", "Deer", "Deer", "Elk", "Elk", "Elk"))
Year <- as.numeric(c("0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0"))
data <- data.frame(Accident.Date, Time.of.Kill, Sex, Age, Species, stringsAsFactors = FALSE)
data <- data %>% mutate(Data.Set = "Current")
#A set of reactive filters. Only data that has passed all filters is passed to the map, graph, datatable etc. **Order goes datacheck > yearcheck > speccheck > sexcheck > timecheck > agecheck > indaterange
bindata <- reactive({
filter(data, Data.Set %in% input$datacheck)
})
yrdata <- reactive({
filter(bindata(), Year %in% input$yearcheck)
})
specdata <- reactive({
sub <- subset(yrdata(), Species %in% input$speccheck)
})
sexdata <- reactive({
filter(specdata(), Sex %in% input$sexcheck)
})
timedata <- reactive({
filter(sexdata(),(Time.of.Kill %in% input$timecheck))
})
agedata <- reactive({
filter(timedata(), Age %in% input$agecheck)
})
#Does the date range filter. Selects min and max from the two inputs of the observed indaterange filter.
data1 <- reactive({ filter(agedata(),
Accident.Date >= input$inDateRange[[1]],
Accident.Date <= input$inDateRange[[2]])
})
#If statement for choosing between current and historical datasets. If current is selected, year is set to 0 and the selection box is hidden.
observe({ if (input$datacheck == 'Current')
updateSelectInput(session, "yearcheck", choices = c("0"), selected = c("0"))
else
updateSelectizeInput(session, "yearcheck", choices = sort(unique(bindata()$Year), decreasing = TRUE), server=TRUE)
})
observe({
req((input$datacheck == 'Historical'))
updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)
})
#Creates the observed Species
observeEvent(input$yearcheck, {
x <- input$yearcheck
if (is.null(x))
x <- character(0)
updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)
})
#Creates the observed Sex
observeEvent(input$speccheck, {
x <- input$speccheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "sexcheck",
choices = unique(bindata()$Sex),
selected = unique(bindata()$Sex),
inline = TRUE)
})
#Creates the observed Time
observeEvent(input$sexcheck,{
x <- input$sexcheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "timecheck",
choices = unique(bindata()$Time.of.Kill),
selected = unique(bindata()$Time.of.Kill),
inline = TRUE)
})
#Creates the observed Age
observeEvent(input$timecheck,{
x <- input$timecheck
if (is.null(x))
x <- character(0)
updateCheckboxGroupInput(session, inputId = "agecheck",
choices = unique(bindata()$Age),
selected = unique(bindata()$Age),
inline = TRUE)
})
#Creates the observed dates and suppresses warnings from the min max
observeEvent(input$agecheck, {
x <- input$agecheck
if (is.null(x))
x <- character(0)
#And update the date range values to match those of the dataset
updateDateRangeInput(
session = session,
inputId = "inDateRange",
start = min(suppressWarnings(bindata()$Accident.Date)),
end = max(suppressWarnings(bindata()$Accident.Date))
)
})
output$txt <- renderText({nrow(data1())})
})
我唯一的更改是使用bindata()更新复选框，这将强制全部出现，因此不会对动物进行预过滤。
因此，我的解决方案是放弃创建动态检查，并从第一次选择动物开始就显示所有内容。
答案 1 :(得分：0)
解决方案非常明显。只需将updateinputs放置在observe（）内，而不是尝试观察上游输入的变化即可获得所需的效果。这已应用于所有上游updateinputs。
observe({
x <- input$agecheck
if (is.null(x))
x <- character(0)
#And update the date range values to match those of the dataset
updateDateRangeInput(
session = session,
inputId = "inDateRange",
start = suppressWarnings(min(agedata()$Accident.Date)),
end = suppressWarnings(max(agedata()$Accident.Date))
)
})
这解决了问题！