无法使用Shiny

时间:2017-04-02 02:38:47

标签: r shiny dplyr radar-chart shiny-reactivity

我在Shiny中构建我的第一个应用程序,我的意思是更好地了解反应性。我已经阅读了http://shiny.rstudio.com/tutorial/上的教程。我正在研究与网球相关的数据集,并希望使用雷达图包创建雷达图。我能够使用反应式表达式渲染单选按钮并成功选择输入框。

然而,点击“Go!'按钮,控制台显示以下错误:" filter_impl错误:长度不正确(0),期望:27"。但是,在应用程序本身中没有出现任何错误,只需点击“Go!'按钮。

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

我很困惑这种情况下的反应性应该如何起作用以及我失去了什么才能使其发挥作用。代码如下所示。我真的很感激任何帮助。

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
}

1 个答案:

答案 0 :(得分:1)

我将您的应用放在一个文件中,以简化调试。

菜单显示正确:闪亮部分应该有效。基本思想是输入变量已经被反应,因此从中构建反应函数是多余的(至少在这种情况下)。

renderChartJSRadar z中,y和x被正确初始化(一旦丢弃初始的NULL情况)。同样renderChartJSRadar已经被反应,但因为它是急切的反应性的。它在没有设置其他值时启动,因此过滤为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的执行。在上面的代码中,只有更改为输入$按钮才会触发执行renderChartJSRadar