isolieren Funktion mit reaktiven Objekt Basis auf dplyr glänzend

Question

Ich habe eine einfache glänzende App erstellt. Das Ziel ist es, eine histogram mit Optionen zum Bearbeiten der Grafik für jeden Datensatz zu erstellen. Das Problem ist, dass wenn ich eine Dataset-Anwendung ändere, zeige mir zuerst ein leeres Plot und dann ein korrektes Plot. Um das Problem zu verstehen, füge ich renderText hinzu, die mir eine Reihe von Zeilen im getDataParams Datensatz zeigen. Es scheint mir, dass isolate Funktion sollte eine Lösung sein, aber ich habe mehrere Konfigurationen versucht, anscheinend verstehe ich immer noch nicht diese Funktion.

library(lazyeval) 
library(dplyr) 
library(shiny) 
library(ggplot2) 

data(iris) 
data(diamonds) 

ui <- fluidPage(
     column(3, 
      selectInput("data", "", choices = c('', 'iris', 'diamonds')), 
      uiOutput('server_cols'), 
      uiOutput("server_cols_fact"), 
      uiOutput("server_params") 
    ), 
     column(9, 
      plotOutput("plot"), 
      textOutput('text') 

    ) 
) 

server <- function(input, output) { 
     data <- reactive({ 
      switch(input$data, diamonds = diamonds, iris = iris) 
     }) 

     output$server_cols <- renderUI({ 
      validate(need(input$data != "", "Firstly select a dataset.")) 
      data <- data() 
      nam <- colnames(data) 
      selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))]) 
     }) 

     output$server_cols_fact <- renderUI({ 

      req(input$data) 

      data <- data(); nam <- colnames(data) 
      selectizeInput('cols_fact', "Choose a fill columns:", 
          choices = nam[sapply(data, function(x) is.factor(x))]) 
     }) 

     output$server_params <- renderUI({ 

      req(input$cols_fact) 

      data <- isolate(data()); col_nam <- input$cols_fact 
      params_vec <- unique(as.character(data[[col_nam]])) 
      selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec, 
          selected = params_vec, multiple = TRUE) 

     }) 

     getDataParams <- reactive({ 

      df <- isolate(data()) 
      factor_col <- input$cols_fact 
      col_diverse <- eval(factor_col) 

      criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse)) 
      df <- df %>% 
        filter_(criteria) %>% 
        mutate_each_(funs(factor), factor_col) 
     }) 

     output$text <- renderText({ 
      if(!is.null(input$cols)) { 
        print(nrow(getDataParams())) 
      } 
     }) 
     output$plot <- renderPlot({ 
      if (!is.null(input$cols)) { 

        var <- eval(input$cols) 
        print('1') 

        diversifyData <- getDataParams() 
        factor_col <- input$cols_fact 
        print('2') 

        plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) + 
         geom_histogram(color = 'white', binwidth = 1) 

        print('3') 
      } 
      plot 

     }) 

} 

shinyApp(ui, server) 

Answer 1

Hier ist eine Antwort, die ganz minimale Veränderungen gehört und gibt wahrscheinlich einige tiefere Einblicke in die Reaktionsfähigkeit in zukünftigen Projekten zu steuern.

Ihre Programmlogik enthält einige Entscheidungen der Art "tue A wenn B, aber nicht wenn C". Aber es nähert sich ihnen brutal, indem sie "tue A, wenn B" wiederholt, bis schließlich "nicht C" wahr ist. Genauer gesagt: Sie möchten, dass Ihre getDataParams erneuert wird (Aktion A), wenn sich input$cols ändert (Aktion B), aber es werden Fehler ausgegeben, wenn input$params noch nicht geändert wurde (Bedingung C).

Okay, jetzt zum Fix: Wir verwenden eine Funktion von observeEvent, um zu bewerten, ob getDataParams neu berechnet werden sollte. Lets lesen (source):

Sowohl observeEvent und eventReactive einen ignoreNULL Parameter nehmen, dass Verhalten beeinflusst, wenn die eventexpr auf NULL (oder im Spezialfall eines actionButton, 0) auswertet. Wenn in diesen Fällen ignoreNULL TRUE ist, wird ein observeEvent nicht ausgeführt, und ein eventReactive löst einen unbeaufsichtigten Validierungsfehler aus.

Also die Änderung ist im Grunde ein Befehl.Ändern

getDataParams <- reactive({ ... }) 

zu

getDataParams <- eventReactive({ 
    if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){ 
     NULL 
    }else{ 
     if(all(input$params %in% data()[[input$cols_fact]])){ 
     1 
     }else{ 
     NULL 
     } 
    }, { ... }, ignoreNULL = TRUE) 

Hier überprüfen wir, ob input$cols_fact ein gültiger Spaltenname ist und wenn input$params wurde bereits vergeben, und wenn ja, wir überprüfen, ob input$params eine gültige Liste von Faktoren für den gegebenen Säule. Diese Funktion wurde hauptsächlich entworfen, um zu überprüfen, ob ein Element existiert (input$something gibt NULL zurück, wenn es nicht definiert ist), aber wir missbrauchen es für die logische Auswertung und geben NULL in einem Fall und 1 (oder etwas nicht NULL) in dem anderen zurück.

Im Gegensatz zu logischen Tests innerhalb der reaktiven Umgebung wird getDataReactive nicht geändert oder löst überhaupt keine Änderungsereignisse aus, wenn die Bedingung nicht erfüllt ist.

Hinweis: Dies ist die minimale Lösung, die ich gefunden habe. Mit diesem Tool und/oder anderen Änderungen kann der Code noch einigermaßen verbessert werden.

Vollständiger Code unten.

Grüße!

library(lazyeval) 
library(dplyr) 
library(shiny) 
library(ggplot2) 

data(iris) 
data(diamonds) 

ui <- fluidPage(
     column(3, 
      selectInput("data", "", choices = c('', 'iris', 'diamonds')), 
      uiOutput('server_cols'), 
      uiOutput("server_cols_fact"), 
      uiOutput("server_params") 
    ), 
     column(9, 
      plotOutput("plot"), 
      textOutput('text') 

    ) 
) 

server <- function(input, output) { 
     data <- reactive({ 
      switch(input$data, diamonds = diamonds, iris = iris) 
     }) 

     output$server_cols <- renderUI({ 
      validate(need(input$data != "", "Firstly select a dataset.")) 
      data <- data() 
      nam <- colnames(data) 
      selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))]) 
     }) 

     output$server_cols_fact <- renderUI({ 

      req(input$data) 

      data <- data(); nam <- colnames(data) 
      selectizeInput('cols_fact', "Choose a fill columns:", 
          choices = nam[sapply(data, function(x) is.factor(x))]) 
     }) 

     output$server_params <- renderUI({ 

      req(input$cols_fact) 

      data <- isolate(data()); col_nam <- input$cols_fact 
      params_vec <- unique(as.character(data[[col_nam]])) 
      selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec, 
          selected = params_vec, multiple = TRUE) 

     }) 

     getDataParams <- eventReactive({ 
     if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){ 
      NULL 
     }else{ 
      if(all(input$params %in% data()[[input$cols_fact]])){ 
      1 
      }else{ 
      NULL 
      } 
     }, { 
      df <- isolate(data()) 
      factor_col <- input$cols_fact 
      col_diverse <- eval(factor_col) 

      criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse)) 
      df <- df %>% 
        filter_(criteria) %>% 
        mutate_each_(funs(factor), factor_col) 
     }, ignoreNULL = TRUE) 

     output$text <- renderText({ 
      if(!is.null(input$cols)) { 
        print(nrow(getDataParams())) 
      } 
     }) 
     output$plot <- renderPlot({ 
      if (!is.null(input$cols)) { 

        var <- eval(input$cols) 
        print('1') 

        diversifyData <- getDataParams() 
        factor_col <- input$cols_fact 
        print('2') 

        plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) + 
         geom_histogram(color = 'white', binwidth = 1) 

        print('3') 
      } 
      plot 

     }) 

} 

shinyApp(ui, server) 

Answer 2

am besten, um den Fluss zu erklären - ich schaffen ein Bild, das erklärt, wie die Handlung als unten aktualisieren:

• ohne Isolat Code, den Sie also, wird jede Änderung auf jede Kontrolle in jeder Änderung auf den Code wird die Änderung der Steuerung am Ende des Pfeils auslösen. In diesem Fall werden die Ergebnisse 5 Mal aktualisiert.
• Mit dem isolieren Code in Ihrem Code von oben post, Sie bereits zwei kleine Pfeil beseitigen.
• Um den Fall zu vermeiden, den Sie mit erwähnt haben, wenn Wählen Sie eine Füllung Spalten, müssen Sie den großen Pfeil, der ich isoliert von der input$cols_fact in output$plot <- renderPlot{...} reaktiven isolieren beseitigen.
• Damit haben Sie immer noch die Handlung zwei Mal aktualisiert werden, wenn Datentabelle wählen, aber ich denke, es ist akzeptabel, da Sie die Handlung müssen aktiv wieder, wenn Sie tun Wählen Sie numerische Spalten

Hope this Ihre Fragen beantworten ! Viel Spaß beim Spielen mit Shiny!