Dynamische UND ODER Filter in R Shiny

Question

I mit wählbarer eine Reihe von dynamischen Datenfiltern auf mehreren Feldern zu machen habe Schwierigkeiten und/oder zwischen Feldern zu kommen, die wie folgt aussehen:

Hier ist mein Beispielcode. Ich bin mir nur nicht sicher, wie man die Filter verbindet (AND/OR) richtig funktioniert.

library(shiny) 
library(dplyr) 
library(DT) 

data("baseball") 

Year = unique(baseball$year) 
Team = unique(baseball$team) 
Stint = unique(baseball$stint) 

runApp(list(ui = fluidPage(
    titlePanel("Summary"), 

    sidebarLayout(
    sidebarPanel(

     selectInput("year", label = "Year", choices = Year, selected = NULL, multiple = TRUE), 
     selectInput("filter_join1", label = "", choices = c("OR","AND")), 
     selectInput("team", label = "Team", choices = Team, selected = NULL, multiple = TRUE), 
     selectInput("filter_join2", label = "", choices = c("OR","AND")), 
     selectInput("stint", label = "Stint", choices = Stint, selected = NULL, multiple = TRUE) 
    ), 

    mainPanel(
     DT::dataTableOutput("table") 
    ) 
) 
), 

server = function(input, output, session) { 
    WorkingDataset <- reactive({ 
    df_temp <- baseball %>% 
     filter(
     is.null(input$year) | year %in% input$year, 
     is.null(input$team) | team %in% input$team, 
     is.null(input$stint) | stint %in% input$stint 
    ) 
    }) 

    output$table <- DT::renderDataTable({ WorkingDataset() }) 

}) 

) 

Answer 1

Say, haben wir die iris-Datensatz und wir wollen es einige subsetting tun.

iris$Species 

# We can also use `with` for that 
with(iris, Species) 

# We are interested in more complicated subsetting though. Want to have all rows 
# with 'setosa' 
with(iris, Species %in% 'setosa') 
iris[with(iris, Species %in% 'setosa'), ] 

# Now 'setosa' with some more condition 
iris[with(iris, Species %in% 'setosa' & Sepal.Length > 5.3), ] 


# That works perfectly. There is, however, an another way doing the exact thing in r. 
# We can input the subsetting condition as a character string, then change it to 
# the `expression` and `eval`uate it. 

cond_str <- paste0("with(iris, Species %in% 'setosa' & Sepal.Length > 5.3)") 
cond_str 
# which is the same as 
cond_str <- paste0("with(iris, ", "Species %in% ", "'", "setosa", "'", " & ", 
        "Sepal.Length > ", "5.3", ")") 
cond_str 

# This second approach will prove very powerful since we will replace "setosa" 
# with, say, `input$species` later on. 


cond <- parse(text = cond_str) 
cond 
eval(cond) 
iris[eval(cond), ] # √ 

Es wird noch etwas komplizierter, weil input$species ein Vektor sein kann und als Ergebnis können wir mehrere Zeichenketten als Ausgabe erhalten. Zum Beispiel:

Spec <- c("setosa", "virginica") # ~ input$species 
paste0("with(iris, Species %in% ", Spec, ")") 

# We want only one character string! So, we'll have to collapse the vector Spec 
paste0("with(iris, Species %in% ", 
     paste0(Spec, collapse = " "), ")") 

# This is still not what we wanted. We have to wrap the entries into "c()" 
# and add quote marks. So, it's going to be pretty technical: 
paste0("with(iris, Species %in% ", 
     "c(", paste0("'", Spec, collapse = "',"), "'))") 

# Now, this is what we wanted :) Let's check it 
check <- eval(parse(text = paste0("with(iris, Species %in% ", 
     "c(", paste0("'", Spec, collapse = "',"), "'))"))) 
iris[check, ] # √ 

Nun lassen Sie uns auf die glänzende App bewegen. Da ich nicht weiß, wo ich das Dataset baseball finden kann, das Ihren Variablen entsprechen würde, werde ich den diamonds Datensatz aus dem Paket ggplot2 verwenden und dplyr nicht verwenden.

Ich änderte leicht Ihre App - Namen von Variablen geändert und dann den Trick, ich oben beschrieben, für die Teilmenge verwendet. Es sollte Ihnen leicht fallen, mein Beispiel an Ihr Problem anzupassen.

library(shiny) 
library(DT) 

# data("diamonds") don't know where I can find this dataset, hence I'll use 
       # diamond dataset 

library(ggplot2) # for diamonds dataset 


cut <- unique(as.character(diamonds$cut)) # or just levels(diamonds$cut) 
color <- unique(as.character(diamonds$color)) 
clarity <- unique(as.character(diamonds$clarity)) 

runApp(list(ui = fluidPage(
    titlePanel("Summary"), 

    sidebarLayout(
     sidebarPanel(
     # changed names of inputs 
     selectInput("cut", label = "Cut", choices = cut, selected = NULL, multiple = T), 
     selectInput("filter_join1", label = "", choices = c("OR","AND")), 
     selectInput("color", label = "Color", choices = color, selected = NULL, multiple = T), 
     selectInput("filter_join2", label = "", choices = c("OR","AND")), 
     selectInput("clarity", label = "Clarity", choices = clarity, selected = NULL, multiple = T) 
    ), 

     mainPanel(
     DT::dataTableOutput("table") 
    ) 
    ) 
), 

    server = function(input, output, session) { 

    WorkingDataset <- reactive({ 
     req(input$cut, input$color, input$clarity) 
     # show table only if all three inputs are available 

     # depending on filter_join inputs return "OR" or "AND" 
     join1 <- ifelse(test = input$filter_join1 == "OR", yes = "| ", no = "& ") 
     join2 <- ifelse(test = input$filter_join2 == "OR", yes = "| ", no = "& ") 

     # You could do this differently: just set choices = c("OR" = "|", "AND" = "&")) 
     # in the selectInput widget. 

     # Similar as in the example above with the iris dataset. 

     cond_str <- paste0(
     "with(diamonds, ", 
     paste0("cut %in% ", "c(", paste0("'", input$cut, collapse = "',"), "')", colapse = " "), 
     join1, 
     paste0("color %in% ", "c(", paste0("'", input$color, collapse = "',"), "')", colapse = " "), 
     join2, 
     paste0("clarity %in% ", "c(", paste0("'", input$clarity, collapse = "',"), "')", colapse = " "), 
     ")") 

     print(cond_str) # print the result to the console 
     cond <- parse(text = cond_str) 
     df <- as.data.frame(diamonds)[eval(cond), ] 
     df 
    }) 

    output$table <- DT::renderDataTable({ WorkingDataset() }) 

    }) 
)