Как создать слайдер в приложении Shiny / Plotly, который возвращает что-либо между диапазонами, выбранными в SliderInput? - PullRequest
Новая
       17

Как создать слайдер в приложении Shiny / Plotly, который возвращает что-либо между диапазонами, выбранными в SliderInput?

0 голосов
/ 13 декабря 2018

В настоящее время я смотрю на соотношение между набранными бонусными очками и очками за игру в премьер-лиге Fantasy.Я сделал приложение 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 (напор (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")

Ответы [ 2 ]

0 голосов
/ 13 декабря 2018

Проблема с функцией фильтрации заключается в использовании %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)
0 голосов
/ 13 декабря 2018

Переменные 'должны иметь хотя бы одно значение.' Ошибка появляется, потому что при определенных комбинациях фильтров GW_subset() выдаст пустой data.frame.

Попробуйте добавить req(nrow(GW_subset()) > 0) в свой renderPlotly, чтобы не допустить рендеринга графика, или определите, что еще должно произойти, если GW_subset() пусто.

...