How do you create a slider on Shiny/Plotly App that returns anything between the ranges selected on the SliderInput?

Question

I am currently looking at the relationship between Bonus Points Scored and Points Per Game in Fantasy Premier League. I have made a Shiny/Plotly app. I would like to make another filter with a "Price" slider that returns the data corresponding to the range of prices that is selected. E.g. return all players that have price between Current.Cost 4.0 & 6.0. Currently my code fails as it comes up with error 'Faceting variables must have at least one value. Any help would be greatly appreciated.

#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)

Output of 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")

score 2 · Answer 1 · answered Dec 13 '18 at 12:16

The problem with you filter function is the usage of %in%. %in% requires you to pass the range as a vector. With the slider values you can do something like: x >= left & x <= right. Please see the code below. An alternative would be using between() provided by 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)

score 1 · Answer 2 · answered Dec 13 '18 at 10:19

1

The 'Faceting variables must have at least one value.' error shows up because with a specific combinations of filters, the GW_subset() will give an empty data.frame.

Consider adding req(nrow(GW_subset()) > 0) inside your renderPlotly to prevent plotly from rendering the plot, or define what else should happen if GW_subset() is empty.

answered Dec 13 '18 at 10:19

ozacha

1,212
9
14

Thanks for your response ozacha. Your suggestion gets rid of the error which is great. Is there anything I can do to make my plot return all the rows of data that are within the range of the selected SliderInput? At the moment, the plot points are only returned if the price exactly matches with the current cost. – Housy33 Dec 13 '18 at 10:47
1

See @ismirsehregal's answer -- you will have to define the interval in a different way, I missed that. – ozacha Dec 13 '18 at 14:12

How do you create a slider on Shiny/Plotly App that returns anything between the ranges selected on the SliderInput?

2 Answers2