如何將反應性數據子集放入 renderplot 中？
[英]How do I put a reactive subset of data into renderplot?
問題描述
我是Shiny ，一直在業余時間努力學習。 我有一個 dataframe 的夢幻足球統計數據，我正在嘗試基於selectinput()和sliderbar()的 plot。 我使用renderprint()來確保我的輸入並在滑塊或選擇更改時進行更正。 我在 reactive() 中有滑塊和 select 輸入，我只是在其中對數據進行子集化。 然后我將反應性 function 作為數據輸入到我的ggplot()中。 當嘗試 plot 這些圖表時，我收到"Error: object 'columnName' not found" ，但僅針對某些列。 請幫我找到這個問題的根源。
最好的，戴維斯
這是代碼：
######################################################################
#------------------------Load libraries------------------------------#
######################################################################
library(shiny)
library(bslib)
library(shinydashboardPlus)
library(ggplot2)
library(shinyWidgets)
######################################################################
#------------------------Data import and Clean-----------------------#
######################################################################
FantFootDF <- read_excel("~/Desktop/Fantasy/2021 Fantasy Stats.xltx")
FantFootDF <- as.data.frame(FantFootDF)
colnames(FantFootDF) <- paste(FantFootDF[1,])
FantFootDF <- FantFootDF[-1,]
colnames(FantFootDF) <- c("Rk","Player","Team","FantPos","Age",
"G","GS","Cmp","PAtt","PYds","PTD",
"Int","RuAtt","RuYds","RuYA","RuTD",
"Rec","ReYds","ReYA","ReTD","Fmb","FL",
"TTD","2PM","2PP","FantPt","PPR","DKPt",
"FDPt","VBD","PosRank","OvRank")
FantFootDF[!is.na(FantFootDF$FantPos),]
NumColumns <- c("Rk","Age",
"G","GS","Cmp","PAtt","PYds","PTD",
"Int","RuAtt","RuYds","RuYA","RuTD",
"Rec","ReYds","ReYA","ReTD","Fmb","FL",
"TTD","2PM","2PP","FantPt","PPR","DKPt",
"FDPt","VBD","PosRank","OvRank")
FantFootDF[NumColumns] <- lapply(FantFootDF[NumColumns], as.numeric)
FantFootDF[is.na(FantFootDF)] = 0
FinalDF <- FantFootDF
######################################################################
#------------------------User Interface------------------------------#
######################################################################
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Fantasy Football GUI"),
#Sidebar
sidebarLayout(
sidebarPanel(
pickerInput("position",
"Position(s)",
choices = unique(FinalDF$FantPos),
options = list(`actions-box` = TRUE),
multiple = T),
pickerInput("playername",
"Player Name",
choices = unique(FinalDF$Player),
options = list(`actions-box` = TRUE),
multiple = T),
pickerInput("team",
"Team",
choices = unique(FinalDF$Team),
options = list(`actions-box` = TRUE),
multiple = T),
sliderInput("age",
"Age",
min = min(FinalDF$Age),
max = max(FinalDF$Age),
value = c(min(FinalDF$Age), max(FinalDF$Age))),
sliderInput("completions",
"Completions",
min = min(FinalDF$Cmp),
max = max(FinalDF$Cmp),
value = c(min(FinalDF$Cmp), max(FinalDF$Cmp))),
sliderInput("Pattempts",
"Passing Attempts",
min = min(FinalDF$PAtt),
max = max(FinalDF$PAtt),
value = c(min(FinalDF$PAtt), max(FinalDF$PAtt))),
sliderInput("Pyards",
"Passing Yards",
min = min(FinalDF$PYds),
max = max(FinalDF$PYds),
value = c(min(FinalDF$PYds), max(FinalDF$PYds))),
sliderInput("Ptds",
"Passing TD's",
min = min(FinalDF$PTD),
max = max(FinalDF$PTD),
value = c(min(FinalDF$PTD), max(FinalDF$PTD))),
sliderInput("RuAttempts",
"Rushing Attempts",
min = min(FinalDF$RuAtt),
max = max(FinalDF$RuAtt),
value = c(min(FinalDF$RuAtt), max(FinalDF$RuAtt))),
sliderInput("RuYards",
"Rushing Yards",
min = min(FinalDF$RuYds),
max = max(FinalDF$RuYds),
value = c(min(FinalDF$RuYds), max(FinalDF$RuYds))),
sliderInput("RuYperA",
"Yards per Rushing Attempt",
min = min(FinalDF$RuYA),
max = max(FinalDF$RuYA),
value = c(min(FinalDF$RuYA), max(FinalDF$RuYA))),
sliderInput("RuTDs",
"Rushing TD's",
min = min(FinalDF$RuTD),
max = max(FinalDF$RuTD),
value = c(min(FinalDF$RuTD), max(FinalDF$RuTD))),
sliderInput("rec",
"Receptions",
min = min(FinalDF$Rec),
max = max(FinalDF$Rec),
value = c(min(FinalDF$Rec), max(FinalDF$Rec))),
sliderInput("ReYards",
"Receiving Yards",
min = min(FinalDF$ReYds),
max = max(FinalDF$ReYds),
value = c(min(FinalDF$ReYds), max(FinalDF$ReYds))),
sliderInput("ReYperA",
"Yards per Reception",
min = min(FinalDF$ReYA),
max = max(FinalDF$ReYA),
value = c(min(FinalDF$ReYA), max(FinalDF$ReYA))),
sliderInput("ReTDs",
"Receiving TD's",
min = min(FinalDF$ReTD),
max = max(FinalDF$ReTD),
value = c(min(FinalDF$ReTD), max(FinalDF$ReTD))),
sliderInput("fumb",
"Fumbles",
min = min(FinalDF$Fmb),
max = max(FinalDF$Fmb),
value = c(min(FinalDF$Fmb), max(FinalDF$Fmb))),
sliderInput("ppr",
"1 PPR Total Points",
min = min(FinalDF$PPR),
max = max(FinalDF$PPR),
value = c(min(FinalDF$PPR), max(FinalDF$PPR)))
),
#Main Panel
mainPanel(
selectInput("plottype",
"Which Plot",
choices = c("PPR by Player",
"PPR by Team",
"PPR by Age")),
plotOutput("plot1"),
tableOutput("table"),
verbatimTextOutput("minmax")
)
)
)
######################################################################
#--------------------------------Server------------------------------#
######################################################################
server <- function(input, output) {
#Reactive to subset data and reduce size in graps
df <- reactive({
a = subset(FinalDF,
FantPos = input$position,
Player = input$playername,
Team = input$team,
Age >= input$age[1] & Age <= input$age[2],
Cmp >= input$completions[1] & Cmp <= input$completions[2],
PAtt >= input$Pattempts[1] & PAtt <= input$Pattempts[2],
PYds >= input$Pyards[1] & PYds <= input$Pyards[2],
PTD >= input$Ptds[1] & PTD <= input$Ptds[2],
RuYA >= input$RuYperA[1] & RuYA <= input$RuYperA[2],
RuAtt >= input$RuAttempts[1] & RuAtt <= input$RuAttempts[2],
RuYds >= input$RuYards[1] & RuYds <= input$RuYards[2],
RuTD >= input$RuTDs[1] & RuTD <= input$RuTDs[2],
Rec >= input$rec[1] & Rec <= input$rec[2],
ReYds >= input$ReYards[1] & ReYds <= input$ReYards[2],
ReYA >= input$ReYperA[1] & ReYA <= input$ReYperA[2],
ReTD >= input$ReTDs[1] & ReTD <= input$ReTDs[2],
Fmb >= input$fumb[1] & Fmb <= input$fumb[2],
PPR >= input$ppr[1] & PPR <= input$ppr[2]
)
return(a)
})
#Plot
output$plot1 <- renderPlot({
# generate bins based on input$bins from ui.R
if(input$plottype == "PPR by Player"){
ggplot(data = df()) +
geom_point(data = df(),
aes(x = Player,
y = PPR,
color = FantPos)) +
ggtitle("PPR Points") +
xlab("Player") +
ylab("PPR Points")
}
else if(input$plottype == "PPR by Team"){
ggplot(data = df()) +
geom_point(data = df(),
aes(x = Team,
y = PPR,
color = FantPos)) +
ggtitle("PPR Points") +
xlab("Player") +
ylab("PPR Points")
}
else if(input$plottype == "PPR by Age"){
ggplot(data = df()) +
geom_point(data = df(),
aes(x = Age,
y = PPR,
color = FantPos)) +
ggtitle("PPR Points") +
xlab("Player") +
ylab("PPR Points")
}
})
#Checking inputs
output$minmax <- renderText(
paste("age", input$age[1], input$age[2], "\ncompletions =",
input$completions[1],input$completions[2],"\nPattempts =",
input$Pattempts[1],input$Pattempts[2],"\nPyards =",
input$Pyards[1],input$Pyards[2],"\nPtds =",
input$Ptds[1],input$Ptds[2],"\nRuYperA =",
input$RuYperA[1],input$RuYperA[2],"\nRuAttempts =",
input$RuAttempts[1],input$RuAttempts[2],"\nRuYards =",
input$RuYards[1],input$RuYards[2],"\nRuTDs =",
input$RuTDs[1],input$RuTDs[2],"\nrec =",
input$rec[1],input$rec[2],"\nReYards =",
input$ReYards[1],input$ReYards[2],"\nReYperA =",
input$ReYperA[1],input$ReYperA[2],"\nReTDs =",
input$ReTDs[1],input$ReTDs[2],"\nfumb =",
input$fumb[1],input$fumb[2],"\nppr =",
input$ppr[1], input$ppr[2])
)
}
# Run the application
shinyApp(ui = ui, server = server)
1 個解決方案
解決方案1
1 2022-10-02 15:46:11
我很抱歉。 下次我一定會包括一個可重現的例子。 我通過制作一個較小的 DataFrame 來復制代碼。復制的代碼有效，所以我再次查看了我的原始數據。 最后有一列是 NA。 重命名列時，我忘記了末尾的索引。 我也從子集更改為過濾器。 不知道為什么沒有名字的最后一列把一切都搞砸了，但是 shiny 在這些更改之后按照我想要的方式運行。
R - 如何在閃亮中使用 selectInput 來更改 ggplot renderPlot 中的 x 和填充變量？
[英]R - How do I use selectInput in shiny to change the x and fill variables in a ggplot renderPlot?
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.