Konnte nicht filtern Daten pro Benutzer Eingaben mit EventReactive() -Funktion in Shiny

Question

Ich baue meine erste App in Shiny und ich wollte eine bessere Vorstellung von Reaktivität bekommen. Ich habe die Tutorials unter http://shiny.rstudio.com/tutorial/ durchgegangen. Ich arbeite an einem tennisbezogenen Datensatz und möchte mit dem Paket 'radarchart' ein Radardiagramm erstellen. Ich bin in der Lage, die Optionsfelder zu rendern und Eingabefeld erfolgreich mit reaktiven Ausdrücken auswählen.

Wenn Sie jedoch auf "Go!" Schaltfläche, die Konsole zeigt den folgenden Fehler: "Fehler in Filter_impl: falsche Länge (0), erwartet: 27". In der App selbst wird jedoch kein Fehler angezeigt. Beim Klicken auf "Go!" Taste.

Nach dem Debuggen, sehe ich, dass dieser Fehler auftritt, wenn ich Daten mit der Auswahl der Eingabewerte des Benutzers filtern möchte (Zeilen 60-63 in Server.R). Mein Hauptanliegen ist Filtern der Daten nach der Auswahl des Benutzers, ich kann das in keiner Weise tun. Ich habe versucht, eventReactive(), observe() sowie reactiveValues ​​() Funktionen auch ohne Erfolg zu verwenden. Ich habe die renderChartJSRadar-Funktion innerhalb der eventReactive-Funktion eingeschlossen, aber ich bin mir nicht ganz sicher, ob das der richtige Weg ist.

Ich bin verwirrt, wie die Reaktivität in diesem Fall funktionieren sollte und was ich vermisse, damit es funktioniert. Der Code ist wie folgt. Ich würde wirklich jede Art von Hilfe zu schätzen wissen.

ui.R

library(xlsx) 
library(shiny) 
library(dplyr) 
source("chart.R") 
library(radarchart) 

shinyUI(fluidPage(

      titlePanel("Match Radar Chart"), 

      sidebarLayout(
      sidebarPanel(
       selectInput("var", 
         label = "Choose a tournament", 
         choices = tour, 
         selected = "Auckland"), 

       uiOutput("radioButtons"), 
       uiOutput("selectControls"), 
       actionButton("update", "Go!") 
      ), 

       mainPanel(
       chartJSRadarOutput("radarChart", width = "450", height = "300") 
      ) 
     ) 
)) 

server.R

library(xlsx) 
library(dplyr) 
library(radarchart) 
library(data.table) 
source("chart.R") 
library(shiny) 
library(grDevices) 


shinyServer(function(input, output, session) { 

    output$radioButtons <- renderUI({ 
       dataInput <- reactive({input$var}) 
       z <- dataInput() 
       buttons <- numrounds(z) 
       radioButtons("button", "Select a round: ", choices = buttons, inline = FALSE) 
     }) 

    output$selectControls <- renderUI({ 
       dataInput <- reactive({input$var}) 
       z <- dataInput() 
       dataInput1 <- reactive({input$button}) 
       y <- dataInput1() 
       winner <- mydata %>% 
         filter(tourney_name == z) %>% 
         filter(round == y) %>% 
         select(winner_name) %>% 
         sapply(as.character) %>% 
         as.vector() 

       loser <- mydata %>% 
         filter(tourney_name == z) %>% 
         filter(round == y) %>% 
         select(loser_name) %>% 
         sapply(as.character) %>% 
         as.vector() 

       players <- c(winner, loser) 

       selectInput("select", "Select a match: ", choices = players, selected = 1, multiple = FALSE) 

    })  

      output$radarChart <- eventReactive(input$update, { 
      renderChartJSRadar({ 
      dataInput1 <- reactive({input$var}) 
      z <- dataInput1() 
      dataInput2 <- reactive({input$button}) 
      y <- dataInput2() 
      dataInput3 <- reactive({input$select}) 
      x <- dataInput3() 
      match <- mydata %>% 
       filter(tourney_name == z) %>% 
       filter(round == y) %>% 
       filter(winner_name == x) 

      scoresw <- vector() 
      scoresl <- vector() 
      for(j in 25:33) { 
        scoresw <- c(scoresw, match()[j]) 
      } 
      for(j in 34:42) { 
        scoresl <- c(scoresl, match()[j]) 
      } 

      scores <- list(winner = scoresw, loser = scoresl) 
      labs <- c("Aces", "Double Faults", "Service points", "1st Service In", "1st Service won", "2nd Service won", "Service games", "Break points saved", "Break points faced") 
      c <- grDevices::col2rgb(c("green", "red")) 

      chartJSRadar(scores = scores, labs = labs, labelSize = 15, colMatrix = c) 
    }) 
    }) 

}) 

chart.R

mydata <- read.csv("Match Radar/Data/atp_matches_2014_edited.csv", header = TRUE) 
tour <- unique(data$tourney_name) 


numrounds <- function(z) { 
    for(i in 1:64) { 
    rounds <- mydata %>% 
     filter(tourney_name == z) %>% 
     summarise(number = n_distinct(round)) 

    if(rounds == 3){ 
     buttons <- c("RR", "SF", "F") 
    } 
    else if(rounds == 5){ 
     buttons <- c("R32", "R16", "QF", "SF", "F") 
    } 
    else if(rounds == 6){ 
     buttons <- c("R64", "R32", "R16", "QF", "SF", "F") 
    } 
    else { 
     buttons <- c("R128", "R64", "R32", "R16", "QF", "SF", "F") 
    } 
    } 
    buttons 
} 

Answer 1

habe ich Ihre Anwendung in einer einzigen Datei zum Debuggen der Einfachheit.

Die Menüs werden korrekt angezeigt: Der glänzende Teil sollte funktionieren. Die Grundidee ist, dass die Eingangsvariablen bereits reaktiv sind, so dass (zumindest in diesem Fall) eine reaktive Funktion überflüssig ist.

In renderChartJSRadar werden z, y und x korrekt initialisiert (sobald die anfänglichen NULL-Fälle verworfen werden). Auch renderChartJSRadar ist bereits reaktiv, aber da es "eifrig reaktiv" ist, startet es, wenn die anderen Werte nicht gesetzt sind, daher die Filterung für NULL.

In renderChartJSRadar gibt es Debugging in der R-Logik, die den Score berechnen. Derzeit gibt es einen Fehler: leider kann ich nicht helfen, wie ich kann nicht sagen, was Sie erreichen wollen - und ich spiele nicht Tennis :)

library(xlsx) 
library(dplyr) 
library(radarchart) 
# library(data.table) 
# source("chart.R") 
library(shiny) 
library(grDevices) 

#------------------------------------------------------------------------------ 

mydata <- read.csv("./data/atp_matches_2014.csv", header = TRUE) 
tour <- unique(mydata$tourney_name) 

numrounds <- function(z) { 
    for(i in 1:64) { 
    rounds <- mydata %>% 
     filter(tourney_name == z) %>% 
     summarise(number = n_distinct(round)) 

    if(rounds == 3){ 
     buttons <- c("RR", "SF", "F") 
    } 
    else if(rounds == 5){ 
     buttons <- c("R32", "R16", "QF", "SF", "F") 
    } 
    else if(rounds == 6){ 
     buttons <- c("R64", "R32", "R16", "QF", "SF", "F") 
    } 
    else { 
     buttons <- c("R128", "R64", "R32", "R16", "QF", "SF", "F") 
    } 
    } 
    return(buttons) 
} 

#------------------------------------------------------------------------------ 

ui <- fluidPage(

    titlePanel("Match Radar Chart"), 

    sidebarLayout(
    sidebarPanel(
     selectInput("var", 
        label = "Choose a tournament", 
        choices = tour, 
        selected = "Auckland"), 

     uiOutput("radioButtons"), 
     uiOutput("selectControls"), 
     actionButton("update", "Go!") 
    ), 

    mainPanel(
     chartJSRadarOutput("radarChart", width = "450", height = "300") 
    ) 
) 
) 

#------------------------------------------------------------------------------ 

server <- function(input, output, session){ 
    session$onSessionEnded({ stopApp }) 

    output$radioButtons <- renderUI({ 
    # dataInput <- reactive({input$var}) 

    z <- input$var 
    buttons <- numrounds(z) 
    radioButtons("button", "Select a round: ", choices = buttons, inline = FALSE) 
    }) 

    output$selectControls <- renderUI({ 

    # dataInput <- reactive({input$var}) 
    z <- input$var 
    # dataInput1 <- reactive({input$button}) 
    y <- input$button #dataInput1() 
    winner <- mydata %>% 
     filter(tourney_name == z) %>% 
     filter(round == y) %>% 
     select(winner_name) %>% 
     sapply(as.character) %>% 
     as.vector() 

    loser <- mydata %>% 
     filter(tourney_name == z) %>% 
     filter(round == y) %>% 
     select(loser_name) %>% 
     sapply(as.character) %>% 
     as.vector() 

    players <- c(winner, loser) 

    selectInput("select", "Select a match: ", choices = players, selected = 1, multiple = FALSE) 

    })  

    output$radarChart <- renderChartJSRadar({ 
    # browser() 
     if(is.null(input$button)) return() 
     if(is.null(input$select)) return() 
     # dataInput1 <- reactive({input$var}) 
     z <- input$var # dataInput1() 
     # dataInput2 <- reactive({input$button}) 
     y <- input$button # dataInput2() 
     # dataInput3 <- reactive({input$select}) 
     x <- input$select # dataInput3() 
     match <- mydata %>% 
     filter(tourney_name == z) %>% 
     filter(round == y) %>% 
     filter(winner_name == x) 

     scoresw <- vector() 
     scoresl <- vector() 
     for(j in 25:33) { 
     scoresw <- c(scoresw, match()[j]) 
     } 
     for(j in 34:42) { 
     scoresl <- c(scoresl, match()[j]) 
     } 

     scores <- list(winner = scoresw, loser = scoresl) 
     labs <- c("Aces", "Double Faults", "Service points", "1st Service In", "1st Service won", "2nd Service won", "Service games", "Break points saved", "Break points faced") 
     c <- grDevices::col2rgb(c("green", "red")) 

     chartJSRadar(scores = scores, labs = labs, labelSize = 15, colMatrix = c) 

    }) 

} 
#------------------------------------------------------------------------------ 

shinyApp(ui, server) 

Was die Radarkarte zu verhindern, um die Benutzer jedes Mal gezogen werden ändert einen der drei Eingänge, dies ist möglich mit isolate.

Zum Beispiel (Code nicht getestet, aber es sollte funktionieren :))

output$radarChart <- renderChartJSRadar({ 
     if(is.null(input$button)) return() 
     isolate({ 
      if(is.null(input$select)) return() 
      z <- input$var # dataInput1() 
      y <- input$button # dataInput2() 
      x <- input$select # dataInput3() 
     }) 

Oder etwas sehr ähnlich. Nehmen Sie zum Beispiel . Da es in isolate ist, löst jede Änderung durch den Benutzer nicht die Ausführung von renderChartJSRadar aus. Im obigen Code lösen nur Änderungen an der Eingabe $ Schaltfläche die Ausführung von renderChartJSRadar aus.