无法使用 Shiny 中的 eventReactive() 函数过滤每个用户输入的数据

Question

我正在用 Shiny 构建我的第一个应用程序，我一直想更好地了解反应性。我已经完成了 http://shiny.rstudio.com/tutorial/ 上的教程。我正在处理与网球相关的数据集，并希望使用包 'radarchart' 创建一个雷达图。我能够使用反应式表达式成功呈现单选按钮和 select 输入框。

但是，单击 'Go!' 按钮后，控制台显示以下错误："Error in filter_impl: incorrect length (0), expecting: 27"。虽然应用程序本身没有出现错误，但单击 'Go!' 按钮时没有呈现。

调试后，我发现当我尝试使用用户的select输入值过滤数据时会发生此错误（server.R 中的第 60-63 行）。我主要关心的是根据用户的 selection 过滤数据，我无法以任何方式做到这一点。我也尝试过使用 eventReactive()、observe() 以及 reactiveValues() 函数，但都没有成功。我已将 renderChartJSRadar 函数包装在 eventReactive 函数中，但我不太确定这样做是否正确。

我对这种情况下的反应性应该如何工作以及我缺少什么来使其工作感到困惑。代码如下所示。我真的很感激任何帮助。

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

为了调试简单，我将您的应用放在一个文件中。

菜单显示正确：闪亮的部分应该有效。基本思想是输入变量已经是反应性的，因此从中构建一个反应性函数是多余的（至少在这种情况下）。

在 renderChartJSRadar 中，z、y 和 x 被正确初始化（一旦初始化，NULL 情况被丢弃）。此外 renderChartJSRadar 已经是反应式的，但因为它是 "eagerly reactive" 它在未设置其他值时启动，因此过滤 NULL.

在renderChartJSRadar中，需要在计算分数的R逻辑中进行调试。目前有一个错误：不幸的是我无法提供帮助，因为我无法告诉你想要达到的目标 - 而且我不打网球:)

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)

至于防止每次用户更改三个输入之一时绘制雷达图，这可以使用 isolate。

例如（代码未经测试，但它应该可以工作:)）

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()
      })

或者非常相似的东西。以 input$var 为例。由于它在 isolate 内，用户的任何更改都不会触发 renderChartJSRadar 的执行。在上面的代码中，仅更改 input$button 会触发 renderChartJSRadar.

的执行

无法使用 Shiny 中的 eventReactive() 函数过滤每个用户输入的数据

Unable to filter data per user's inputs using eventReactive() function in Shiny

r

radar-chart

shiny

dplyr

shiny-reactivity