Question

我目前正在查看幻想英超联赛中的得分积分和每场比赛得分之间的关系。我制作了一个Shiny / Plotly应用程序。我想用“价格”滑块制作另一个过滤器，该过滤器返回与所选价格范围相对应的数据。例如。返回价格介于Current.Cost 4.0和6.0之间的所有玩家。目前，我的代码因出现错误而失败，因为“缩进变量必须至少具有一个值。任何帮助将不胜感激。

#load packaages
library(shiny)
library(plotly)
library(ggplot2)
library(ggrepel)
library(dplyr)
BPSvsPPG <- read.csv("file:///C:/Users/haoso/Documents/FPL_Database.csv", stringsAsFactors = FALSE)

# Filter the Data
BPSvsPPG2 <- subset(BPSvsPPG, AveragePoints > 4) 
n_total <- max(BPSvsPPG2$RoundNo)
names <- unique(BPSvsPPG2$Full.Name)
positions <- unique(BPSvsPPG2$PositionsList)
min_price <- min(BPSvsPPG2$Current.Cost)
max_price <- max(BPSvsPPG2$Current.Cost)
mean_price <- mean(BPSvsPPG2$Current.Cost)
latestRound <- max(BPSvsPPG2$RoundNo)

# Create UI 
ui <- fluidPage(
  sidebarLayout(
    # Inputs
    sidebarPanel(
      # y-axis
      selectInput(inputId = "y",
                  label = "AverageBPS", 
                  choices = "AverageBPS",
                  selected = "AverageBPS"), 
      # x-axis
      selectInput(inputId = "x",
                  label = "AveragePoints",
                  choices = "AveragePoints",
                  selected = "AveragePoints"),

      # positions
      selectInput(inputId = "Pos",
                  label = "Positions",
                  choices = positions),

      # round no
      numericInput(inputId = "RoundNo", 
                   label = "RoundNo", 
                   min = 1, max = n_total, 
                   value = latestRound),

      # price slider
      sliderInput(inputId = "Price", 
                  label = "Price", 
                  min = min_price, max = max_price, 
                  value = c(min_price, mean_price))

    ), 
    # Outputs
    mainPanel(
      plotlyOutput("BPS"),
      verbatimTextOutput("event")
    )
  )
)
# Server code
server <- function(input, output) {

  # Create Subset of Data for GW 
  GW_subset <- reactive({
    req(input$RoundNo, input$Price)
    filter(BPSvsPPG2, RoundNo %in% input$RoundNo & PositionsList %in% input$Pos & Current.Cost %in% input$Price)
  })

  # renderPlotly
  output$BPS <- renderPlotly({
    p <- ggplot(GW_subset(), aes_string(x = input$x, y = input$y)) + 
      geom_point(aes(text = paste("Name:", Full.Name, "<br>", 
                                  "Price:", Current.Cost, "<br>", 
                                  "Team:", Team, "<br>", 
                                  "AverageBPS:", AverageBPS, "<br>",
                                  "PPG:", AveragePoints), colour = Team, 
                      size = AverageBPS/AveragePoints)) + 
                      facet_wrap(~PositionsList) + 
                      ggtitle(input$RoundNo)

    ggplotly(p, tooltip = "text")
    })

  # renderPrint
  output$event <- renderPrint({
    d <- event_data("plotly_hover") 
    if (is.null(d)) "Hover on a point!" else d
  })
}

shinyApp(ui, server)

dput（head（BPSvsPPG））的输出

> dput(head(BPSvsPPG))
structure(list(Full.Name = c("Tammy Abraham", "Adam Smith", "Adrian", 
"Sergio Aguero", "Nathan Ake", "Marc Albrighton"), Current.Cost = c(5.5, 
4.5, 4.5, 11, 5, 5.4), GW = c("GW1", "GW1", "GW1", "GW1", "GW1", 
"GW1"), BPSLastRound = c("0", "25", "0", "4", "33", "0"), FirstName = c("Tammy", 
"", "", "Sergio", "Nathan", "Marc"), Surname = c("Abraham", "Adam Smith", 
"Adrian", "Aguero", "Ake", "Albrighton"), PositionsList = c("FWD", 
"DEF", "GLK", "FWD", "DEF", "MID"), Team = c("CHE", "BOU", "WHU", 
"MCI", "BOU", "LEI"), Cost = c(5500000L, 4500000L, 4500000L, 
11000000L, 5000000L, 5400000L), PointsLastRound = c(0L, 6L, 0L, 
2L, 8L, 0L), TotalPoints = c(0L, 6L, 0L, 2L, 8L, 0L), AveragePoints = c(0, 
6, 0, 2, 8, 0), AveragePointsPerDollar = c(0, 1.33e-06, 0, 1.82e-07, 
1.6e-06, 0), TotalPointsPerDollar = c(0, 1.33e-06, 0, 1.82e-07, 
1.6e-06, 0), GameweekWeighting = c(0L, 0L, 0L, 0L, 0L, 0L), TransfersOut = c(1823L, 
2437L, 1999L, 53898L, 9917L, 13253L), YellowCards = c(0L, 0L, 
0L, 0L, 0L, 0L), GoalsConceded = c(0L, 0L, 0L, 0L, 0L, 0L), GoalsConcededPoints = c(0L, 
0L, 0L, 0L, 0L, 0L), Saves = c(0L, 0L, 0L, 0L, 0L, 0L), SavesPoints = c(0L, 
0L, 0L, 0L, 0L, 0L), GoalsScored = c(0L, 0L, 0L, 0L, 0L, 0L), 
    GoalsScoredPoints = c(0L, 0L, 0L, 0L, 0L, 0L), ValueSeason = c(0, 
    1.3, 0, 0.2, 1.6, 0), TransfersOutRound = c(1823L, 2437L, 
    1999L, 53898L, 9917L, 13253L), PriceRise = c(0L, 0L, 0L, 
    0L, 0L, -1L), PriceFallRound = c(0L, 0L, 0L, 0L, 0L, 1L), 
    LastSeasonPoints = c(0L, 6L, 0L, 2L, 8L, 0L), PriceFall = c(0L, 
    0L, 0L, 0L, 0L, 1L), ValueForm = c(0, 1.3, 0, 0.2, 1.6, 0
    ), PenaltiesMissed = c(0L, 0L, 0L, 0L, 0L, 0L), Form = c(0, 
    6, 0, 2, 8, 0), Bonus = c(0L, 0L, 0L, 0L, 2L, 0L), FanRating = c(0L, 
    0L, 0L, 0L, 0L, 0L), CleanSheets = c(0L, 1L, 0L, 1L, 1L, 
    0L), CleanSheetPoints = c(0L, 0L, 0L, 0L, 0L, 0L), Assists = c(0L, 
    0L, 0L, 0L, 0L, 0L), SelectedByPercent = c(0.2, 0.7, 0.5, 
    33.2, 4.3, 0.9), TransfersIn = c(416L, 7257L, 212L, 135506L, 
    26175L, 384L), OwnGoals = c(0L, 0L, 0L, 0L, 0L, 0L), EAIndex = c(0L, 
    0L, 0L, 0L, 0L, 0L), PenaltiesSaved = c(0L, 0L, 0L, 0L, 0L, 
    0L), DreamteamCount = c(0L, 0L, 0L, 0L, 0L, 0L), MinutesPlayed = c(0L, 
    90L, 0L, 78L, 90L, 0L), TransfersInRound = c(416L, 7257L, 
    212L, 135506L, 26175L, 384L), PriceRiseRound = c(0L, 0L, 
    0L, 0L, 0L, -1L), RedCards = c(0L, 0L, 0L, 0L, 0L, 0L), BPS = c(0L, 
    25L, 0L, 4L, 33L, 0L), RoundNo = c(1L, 1L, 1L, 1L, 1L, 1L
    ), AverageBPS = c(0, 25, 0, 4, 33, 0)), row.names = c(NA, 
6L), class = "data.frame")

Answer 1

“ Faceting变量必须至少具有一个值。” 出现错误，因为使用特定的过滤器组合，GW_subset()将给出一个空的data.frame。

请考虑在req(nrow(GW_subset()) > 0)内添加renderPlotly，以防止plotly渲染图，或者定义GW_subset()为空时还会发生什么。

Answer 2

过滤器功能的问题是使用%in%。 %in%要求您将范围作为向量传递。使用滑块值，您可以执行以下操作：x >= left & x <= right。请参见下面的代码。另一种选择是使用between()提供的library(dplyr)。

#load packaages
library(shiny)
library(plotly)
library(ggplot2)
library(ggrepel)
library(dplyr)
BPSvsPPG <- read.csv("file:///C:/Users/haoso/Documents/FPL_Database.csv", stringsAsFactors = FALSE)

# Filter the Data
BPSvsPPG2 <- subset(BPSvsPPG, AveragePoints > 4) 
n_total <- max(BPSvsPPG2$RoundNo)
names <- unique(BPSvsPPG2$Full.Name)
positions <- unique(BPSvsPPG2$PositionsList)
min_price <- min(BPSvsPPG2$Current.Cost)
max_price <- max(BPSvsPPG2$Current.Cost)
mean_price <- mean(BPSvsPPG2$Current.Cost)
latestRound <- max(BPSvsPPG2$RoundNo)

# Create UI 
ui <- fluidPage(
  sidebarLayout(
    # Inputs
    sidebarPanel(
      # y-axis
      selectInput(inputId = "y",
                  label = "AverageBPS", 
                  choices = "AverageBPS",
                  selected = "AverageBPS"), 
      # x-axis
      selectInput(inputId = "x",
                  label = "AveragePoints",
                  choices = "AveragePoints",
                  selected = "AveragePoints"),

      # positions
      selectInput(inputId = "Pos",
                  label = "Positions",
                  choices = positions),

      # round no
      numericInput(inputId = "RoundNo", 
                   label = "RoundNo", 
                   min = 1, max = n_total, 
                   value = latestRound),

      # price slider
      sliderInput(inputId = "Price", 
                  label = "Price", 
                  min = min_price, max = max_price, 
                  value = c(min_price, mean_price))

    ), 
    # Outputs
    mainPanel(
      plotlyOutput("BPS"),
      verbatimTextOutput("event")
    )
  )
)
# Server code
server <- function(input, output) {

  # Create Subset of Data for GW 
  GW_subset <- reactive({
    req(input$RoundNo, input$Price)
    filter(BPSvsPPG2, RoundNo %in% input$RoundNo & PositionsList %in% input$Pos & Current.Cost >= input$Price[1] & Current.Cost <= input$Price[2])
  })

  # renderPlotly
  output$BPS <- renderPlotly({
    req(nrow(GW_subset()) > 0)

    p <- ggplot(GW_subset(), aes_string(x = input$x, y = input$y)) + 
      geom_point(aes(text = paste("Name:", Full.Name, "<br>", 
                                  "Price:", Current.Cost, "<br>", 
                                  "Team:", Team, "<br>", 
                                  "AverageBPS:", AverageBPS, "<br>",
                                  "PPG:", AveragePoints), colour = Team, 
                     size = AverageBPS/AveragePoints)) + 
      facet_wrap(~PositionsList) + 
      ggtitle(input$RoundNo)

    ggplotly(p, tooltip = "text")
  })

  # renderPrint
  output$event <- renderPrint({
    d <- event_data("plotly_hover") 
    if (is.null(d)) "Hover on a point!" else d
  })
}

shinyApp(ui, server)

如何在Shiny / Plotly App上创建一个滑块，该滑块返回SliderInput上所选范围之间的任何值？

2 个答案: