如何在Shining/Plotly应用程序上创建一个滑块，以返回在SliderInput上选择的范围之间的任何内容？
我目前正在研究梦幻超级联赛中积分和每场得分之间的关系。我制作了一个闪亮/生动的应用程序。我想制作另一个带有“价格”滑块的过滤器，该滑块返回与所选价格范围对应的数据。例如，返回所有价格介于当前成本4.0和6.0之间的玩家。目前我的代码失败了，因为它出现了错误“Faceting变量必须至少有一个值。任何帮助都将不胜感激如何在Shining/Plotly应用程序上创建一个滑块，以返回在SliderInput上选择的范围之间的任何内容？,r,shiny,rstudio,plotly,R,Shiny,Rstudio,Plotly,我目前正在研究梦幻超级联赛中积分和每场得分之间的关系。我制作了一个闪亮/生动的应用程序。我想制作另一个带有“价格”滑块的过滤器，该滑块返回与所选价格范围对应的数据。例如，返回所有价格介于当前成本4.0和6.0之间的玩家。目前我的代码失败了，因为它出现了错误“Faceting变量必须至少有一个值。任何帮助都将不胜感激 #load packaages library(shiny) library(plotly) library(ggplot2) library(ggrepel) library(dp
#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)
GW_subset（）考虑在
renderPlotlyreq（nrow（GW_subset（））>0）GW_subset（）%。
%%要求您将范围作为向量传递。使用滑块值，您可以执行如下操作：x>=left&x感谢您的回复ozacha。你的建议消除了这个很大的错误。我可以做些什么来让我的绘图返回所选SliderInput范围内的所有数据行吗？目前，只有当价格与当前成本完全匹配时，才会返回绘图点。请参见@ismirsehregal的答案——您必须以不同的方式定义间隔，我没有注意到这一点。
> 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")
#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)