我正在Shiny中创建一个应用程序，我希望根据用户输入更改ggplot中散点图的y变量。但是我无法确定如何根据用户输入更改绘图。我有以下代码：
UI
library(shiny)
shinyUI(fluidPage(
tags$head(
tags$style(HTML("
.multicol {
-webkit-column-count: 3; /* Chrome, Safari, Opera */
-moz-column-count: 3; /* Firefox */
column-count: 3;
}
"))
),
titlePanel(h1('NBA MVPs', align = "center")),
hr(),
mainPanel(
tabsetPanel(type='tabs',
tabPanel("Plot", plotOutput("plot")),
tabPanel("Description",
p("Blah, blah")))),
hr(),
fluidRow(
column(2,
selectInput('stat', "Statistics", choices=c('Field Goal %'=FG.Perc, '3 Pt. %'=ThreePointPerc,"Free Throw %" = "FTPerc", "Rebounds" = "TRB", "Assists" ="ASST", 'Steals' = "STL", "Points" = "PTS", "True Shooting %"= "TrueShootingPerc", "Eff. FG %"= "eFG", "Total Reb. %" = "TRBPerc", "Off. Rating" = "ORtg", "Def. Rating" = "DRtg")))
),
wellPanel(
tags$div(class = "multicol", checkboxGroupInput("player", choices = c('one' = '1', 'two' = '2'), label = "Player/Year", selected = c('1', '2')
))
)
服务器
library(shiny); library(dplyr); library(mosaic); library(ggplot2)
MVP = MVPData
shinyServer(function(input, output){
plotData <- reactive({
var = input$stat
df <- MVPData %>%
filter(player %in% input$player)
df}
)
output$plot <- renderPlot(ggplot(plotData(), aes(x=Rk, y=input$stat, color=player)) + geom_point())
})
现在，散点图将用户输入读取为每个玩家的相同字符串，因此只有一行数据。如果我从选项中删除引号，则会收到错误消息，指出找不到该对象。我也尝试使用names（）函数调用选项，因为选项是数据集的列，但后来我得到一个意外的输入结束错误。
dput（head（MVPData）））的输出是：
structure(list(V1 = c("1", "2", "3", "4", "5", "6"), Rk = 1:6,
G = 1:6, Date = c("2004-11-03", "2004-11-05", "2004-11-06",
"2004-11-09", "2004-11-10", "2004-11-13"), Age = c("30-270",
"30-272", "30-273", "30-276", "30-277", "30-280"), Team = c("PHO",
"PHO", "PHO", "PHO", "PHO", "PHO"), H.A = c("", "@", "@",
"@", "@", ""), Opponent = c("ATL", "PHI", "NJN", "CHI", "CLE",
"SAC"), Outcome = c("W (+30)", "W (+10)", "W (+32)", "W (+20)",
"L (-5)", "L (-2)"), GS = c("1", "1", "1", "1", "1", "1"),
MP = c("24:00:00", "32:00:00", "37:00:00", "33:00:00", "50:00:00",
"36:00:00"), FG = c(6L, 3L, 6L, 3L, 5L, 11L), FGA = c(12L,
5L, 8L, 9L, 13L, 16L), FG.Perc = c(0.5, 0.6, 0.75, 0.333,
0.385, 0.688), ThreePtFG = c(0L, 1L, 1L, 0L, 1L, 5L), ThreePtFGA = c(2L,
1L, 1L, 3L, 3L, 8L), ThreePointPerc = c(0, 1, 1, 0, 0.333,
0.625), FT = c(0L, 2L, 4L, 2L, 4L, 2L), FTA = c(0L, 2L, 4L,
2L, 6L, 2L), FTPerc = c(NA, 1, 1, 1, 0.667, 1), ORB = c(0L,
0L, 1L, 0L, 1L, 2L), DRB = c(3L, 4L, 1L, 3L, 6L, 1L), TRB = c(3L,
4L, 2L, 3L, 7L, 3L), ASST = c(4L, 10L, 8L, 12L, 17L, 7L),
STL = c(2L, 0L, 3L, 0L, 0L, 0L), BLK = c(0L, 0L, 0L, 0L,
0L, 0L), TOV = c(3L, 4L, 6L, 1L, 1L, 3L), PF = c(2L, 5L,
0L, 3L, 5L, 3L), PTS = c(12L, 9L, 17L, 8L, 15L, 29L), GmSc = c(7.9,
8.9, 17.4, 10, 18.5, 24.6), Plus.Minus = c(17L, 4L, 21L,
21L, 1L, 4L), Regular = c(1L, 1L, 1L, 1L, 1L, 1L), TrueShootingPerc = c(0.5,
0.765, 0.871, 0.405, 0.48, 0.859), eFG = c(0.5, 0.7, 0.813,
0.333, 0.423, 0.844), ORBPerc = c(0, 0, 4.2, 0, 1.9, 7.4),
DRBPerc = c(9.2, 14.3, 2.9, 6.9, 13, 3.3), TRBPerc = c(5.5,
6.7, 3.4, 4.1, 7.1, 5.3), ASTPerc = c(24.2, 43.5, 33.2, 63.2,
50.5, 35.4), STLPerc = c(3.9, 0, 4.5, 0, 0, 0), BLKPerc = c(0,
0, 0, 0, 0, 0), TOVPerc = c(20, 40.5, 38.1, 9.2, 6, 15.1),
USGPerc = c(24.8, 12.8, 20.7, 14.9, 13.8, 24.6), ORtg = c(98L,
118L, 122L, 115L, 124L, 163L), DRtg = c(80L, 106L, 96L, 88L,
109L, 135L), Plus.Minus2 = c(7.9, 8.9, 17.4, 10, 18.5, 24.6
), postMVP = c(0L, 0L, 0L, 0L, 0L, 0L), player = c("2",
"2", "1", "2", "1", "2"
)), .Names = c("V1", "Rk", "G", "Date", "Age", "Team", "H.A",
"Opponent", "Outcome", "GS", "MP", "FG", "FGA", "FG.Perc", "ThreePtFG",
"ThreePtFGA", "ThreePointPerc", "FT", "FTA", "FTPerc", "ORB",
"DRB", "TRB", "ASST", "STL", "BLK", "TOV", "PF", "PTS", "GmSc",
"Plus.Minus", "Regular", "TrueShootingPerc", "eFG", "ORBPerc",
"DRBPerc", "TRBPerc", "ASTPerc", "STLPerc", "BLKPerc", "TOVPerc",
"USGPerc", "ORtg", "DRtg", "Plus.Minus2", "postMVP", "player"
), .internal.selfref = <pointer: (nil)>, row.names = c(NA, 6L
), class = c("data.table", "data.frame"))
答案 0 :(得分：0)
为什么不尝试这样的事情
output$plot1 <- renderPlot({
selectedaxis <- input$selectaxis
ifelse(test = selectedaxis == "input$selectedaxis",
yes = ggplot(plotData(), aes(x=Rk, y=input$stat, color=player)) + geom_point(),
no = ggplot(plotData(), aes(x=Rk, y=input$stat, color=player)) + geom_point()
)
})
答案 1 :(得分：0)
我的理解是ggplot2“更喜欢”融化的数据，所以我会做类似的事情：
MVPData_melted <- melt(MVPData, id.vars = c("V1", "Rk","G","Date","Age","Team","H.A","Opponent","Outcome", "player"))
## double check this melt does what you need
然后过滤'变量'列
library(shiny); library(dplyr); library(mosaic); library(ggplot2)
ui <- fluidPage(
tags$head(
tags$style(HTML("
.multicol {
-webkit-column-count: 3; /* Chrome, Safari, Opera */
-moz-column-count: 3; /* Firefox */
column-count: 3;
}
"))
),
titlePanel(h1('NBA MVPs', align = "center")),
hr(),
mainPanel(
tabsetPanel(type='tabs',
tabPanel("Plot", plotOutput("plot")),
tabPanel("Description",
p("Blah, blah")))),
hr(),
fluidRow(
column(2,
selectInput('stat', "Statistics", choices=c('Field Goal %'="FG.Perc", '3 Pt. %'="ThreePointPerc","Free Throw %" = "FTPerc", "Rebounds" = "TRB", "Assists" ="ASST", 'Steals' = "STL", "Points" = "PTS", "True Shooting %"= "TrueShootingPerc", "Eff. FG %"= "eFG", "Total Reb. %" = "TRBPerc", "Off. Rating" = "ORtg", "Def. Rating" = "DRtg")))
),
wellPanel(
tags$div(class = "multicol", checkboxGroupInput("player", choices = c('one' = '1', 'two' = '2'), label = "Player/Year", selected = c('1', '2')
))
)
)
server <- function(input, output){
plotData <- reactive({
var = input$stat
## now filtering on var using the melted data
df <- MVPData_melted %>%
filter(player %in% input$player,
variable == var)
df
})
## i've moved the plot into its own function
output$plot <- renderPlot({
ggplot(plotData(), aes(x=Rk, y=value, color=player)) +
geom_point()
})
}
shinyApp(ui = ui, server = server)