Wie erstellt man einen dynamischen Filter in R Shiny?

Question

Ich baue eine App mit einer Upload-Funktion und einer Filterfunktion für Kategorievariablen. Auf diese Weise können Benutzer ein wenig Daten manipulieren, indem sie Spalten und Werte angeben. Die Filterfunktion funktioniert jedoch nicht. Der Code wird vereinfacht wie folgt:

#ui.R 
library(shiny) 

fluidPage(
    titlePanel("Test Dynamic Column Selection"), 
    sidebarLayout(
    sidebarPanel(
     fileInput('file1', 'Choose CSV File', 
      accept=c('text/csv', 
        'text/comma-separated-values,text/plain', 
        '.csv')), 
     hr(), 
     checkboxInput('header', 'Header', TRUE), 
     radioButtons('sep', 'Separator', 
       c(Comma=',', 
       Semicolon=';', 
       Tab='\t'), 
       ','), 
     hr(), 
     uiOutput("choose_columns"), 
     hr(), 
     uiOutput("choose_column"), 
     textInput('column_value', label = 'Value'), 
     actionButton('filter', label = 'Filter') 
    ), 
    mainPanel(
     tableOutput('contents') 
    ) 
) 
) 

#server.R 
library(shiny) 

function(input, output) { 

    uploaded_data <- reactive({ 
    inFile <- input$file1 
    read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote) 
    }) 

    react_vals <- reactiveValues(data = NULL) 

    output$choose_columns <- renderUI({ 
    if(is.null(input$file1)) 
     return() 

    colnames <- names(react_vals$data) 

    checkboxGroupInput("choose_columns", "Choose columns", 
        choices = colnames, 
        selected = colnames) 
    }) 

    output$choose_column <- renderUI({ 
    if(is.null(input$file1)) 
     return() 
    is_factor <- sapply(react_vals$data, is.factor) 
    colnames <- names(react_vals$data[, is_factor]) 
    selectInput("choose_column", "Choose column", choices = colnames) 
    }) 

    observeEvent(input$file1, react_vals$data <- uploaded_data()) 
    observeEvent(input$choose_columns, react_vals$data <- react_vals$data[, input$choose_columns]) 

    # This line of code does not work :(
    observeEvent(input$filter, react_vals$data <- subset(react_vals$data, input$choose_column != input$column_value)) 

    output$contents <- renderTable(react_vals$data) 
} 

Answer 1

Ich denke, es mehr Probleme mit den App waren, versuche ich es Schritt für Schritt zu erklären:

1. input$choose_columns ist abhängig von dem react_vals$data Blindwert und damit Wenn Sie ein Kontrollkästchen deaktivieren, weist Shiny react_vals$data einen neuen Wert mit einer Spalte weniger zu und gibt dann das input$choose_columns UI erneut aus, sodass ein Kontrollkästchen weniger verfügbar ist. (Das Gleiche gilt für die input$choose_columnselectInput)

Ihr Code:

colnames <- names(react_vals$data)

Ersatzcode:

colnames <- names(uploaded_data()) 

2. Verwenden req() bei der Überprüfung, ob eine Datei ist hochgeladen, Benutzeroberfläche wird gerendert usw. Es ist die beste Vorgehensweise.

Ihr Code:

if(is.null(input$file1)) return()

Ersatzcode:

req(input$file1) 

3. Filterung funktioniert nicht. Grundsätzlich, warum es nicht funktionierte, ist, dass es versucht, eine Teilmenge basierend auf dem Vergleich zweier Strings von input$choose_column und input$column_value zu lösen.

d.h .: „Spaltenname A“ = „Wert: etwas“

Welche TRUE in der Regel für alle Zeilen zurückgibt, und es endete nicht zu filtern.

Ich kam mit 2 Lösungen, sie sind ein bisschen hässlich, also wenn jemand mit einer besseren Lösung kommt, zögern Sie nicht zu kommentieren/bearbeiten.

#server.R 
library(shiny) 
function(input, output) { 

    uploaded_data <- reactive({ 
    inFile <- input$file1 
    read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote) 
    }) 

    react_vals <- reactiveValues(data = NULL) 

    output$choose_columns <- renderUI({ 
    req(input$file1) 

    colnames <- names(uploaded_data()) 
    checkboxGroupInput("choose_columns", "Choose columns", 
         choices = colnames, 
         selected = colnames) 
    }) 

    output$choose_column <- renderUI({ 
    req(input$file1) 
    is_factor <- sapply(uploaded_data(), is.factor) 
    colnames <- colnames(uploaded_data()[is_factor]) 
    selectInput("choose_column", "Choose column", choices = colnames) 
    }) 

    observeEvent(input$file1, react_vals$data <- uploaded_data()) 
    observeEvent(input$choose_columns, react_vals$data <- uploaded_data()[, input$choose_columns]) 

    observeEvent(input$filter, { 
    react_vals$data <- 
     #Option A 
     eval(parse(text = sprintf("subset(uploaded_data(), %s != '%s')", input$choose_column, input$column_value))) 

     #Option B 
     #subset(uploaded_data(), uploaded_data()[, which(names(uploaded_data()) == input$choose_column)] != input$column_value) 
    }) 

    output$contents <- renderTable(react_vals$data) 
} 

shinyApp(ui, server)