r语言 - 无法使用 Shiny 中的 eventReactive() 函数过滤每个用户输入的数据



我正在Shiny中构建我的第一个应用程序,我一直想更好地了解反应性。我已经浏览了有关 http://shiny.rstudio.com/tutorial/的教程。我正在研究一个与网球相关的数据集,并希望使用"雷达图"包创建一个雷达图。我能够使用反应式表达式成功呈现单选按钮并选择输入框。

但是,单击"开始!"按钮时,控制台显示以下错误:"filter_impl中的错误:长度不正确 (0),预期:27"。不过,应用程序本身没有显示错误,只是单击"Go!"按钮时没有渲染。

调试时,当我尝试使用用户选择的输入值(服务器中的第 60-63 行)过滤数据时,我看到此错误发生。我主要关心的是根据用户的选择过滤数据,我无法以任何方式做到这一点。我也尝试使用eventReactive(),observe()以及reactiveValues()函数,但没有成功。我已经将renderChartJSRadar函数包装在eventReactive函数中,但我不太确定这是否是正确的方法。

我对这种情况中的反应性应该如何工作以及我缺少什么来使其工作感到困惑。代码如下所示。我真的很感激任何形式的帮助。

用户界面。R

library(xlsx)
library(shiny)
library(dplyr)
source("chart.R")
library(radarchart)
shinyUI(fluidPage(
titlePanel("Match Radar Chart"),
sidebarLayout(
sidebarPanel(
selectInput("var", 
label = "Choose a tournament",
choices = tour,
selected = "Auckland"),
uiOutput("radioButtons"),
uiOutput("selectControls"),
actionButton("update", "Go!")
),
mainPanel(
chartJSRadarOutput("radarChart", width = "450", height = "300")
)
)
))

服务器。R

library(xlsx)
library(dplyr)
library(radarchart)
library(data.table)
source("chart.R")
library(shiny)
library(grDevices)

shinyServer(function(input, output, session) {
output$radioButtons <- renderUI({
dataInput <- reactive({input$var})
z <- dataInput()
buttons <- numrounds(z)
radioButtons("button", "Select a round: ", choices = buttons, inline = FALSE)
})
output$selectControls <- renderUI({
dataInput <- reactive({input$var})
z <- dataInput()
dataInput1 <- reactive({input$button})
y <- dataInput1()
winner <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
select(winner_name) %>%
sapply(as.character) %>%
as.vector()
loser <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
select(loser_name) %>%
sapply(as.character) %>%
as.vector()
players <- c(winner, loser)
selectInput("select", "Select a match: ", choices = players, selected = 1, multiple = FALSE)
})    
output$radarChart <- eventReactive(input$update, {
renderChartJSRadar({
dataInput1 <- reactive({input$var})
z <- dataInput1()
dataInput2 <- reactive({input$button})
y <- dataInput2()
dataInput3 <- reactive({input$select})
x <- dataInput3()
match <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
filter(winner_name == x)
scoresw <- vector()
scoresl <- vector()
for(j in 25:33) {
scoresw <- c(scoresw, match()[j])
}
for(j in 34:42) {
scoresl <- c(scoresl, match()[j])
}
scores <- list(winner = scoresw, loser = scoresl)
labs <- c("Aces", "Double Faults", "Service points", "1st Service In", "1st Service won", "2nd Service won", "Service games", "Break points saved", "Break points faced")
c <- grDevices::col2rgb(c("green", "red"))
chartJSRadar(scores = scores, labs = labs, labelSize = 15, colMatrix = c)
})
})
})

图表。R

mydata <- read.csv("Match Radar/Data/atp_matches_2014_edited.csv", header = TRUE)
tour <- unique(data$tourney_name)

numrounds <- function(z) {
for(i in 1:64) {
rounds <- mydata %>%
filter(tourney_name == z) %>%
summarise(number = n_distinct(round))
if(rounds == 3){
buttons <- c("RR", "SF", "F")
}
else if(rounds == 5){
buttons <- c("R32", "R16", "QF", "SF", "F")
}
else if(rounds == 6){
buttons <- c("R64", "R32", "R16", "QF", "SF", "F")
}
else {
buttons <- c("R128", "R64", "R32", "R16", "QF", "SF", "F")
}
}
buttons
}

为了简化调试,我将您的应用程序放在一个文件中。

菜单显示正确:闪亮的部分应该可以工作。 基本思想是输入变量已经是反应式的,因此从中构建响应式函数是多余的(至少在这种情况下)。

renderChartJSRadar中,z,y 和 x 被正确初始化(一旦初始,NULL 大小写被丢弃)。此外,renderChartJSRadar已经是反应性的,但由于它是"急切的反应",因此当其他值未设置时,它会开始,因此过滤 NULL。

renderChartJSRadar在计算分数的 R 逻辑中需要执行调试。 目前有一个错误:不幸的是,我无能为力,因为我无法说出你想要实现的目标 - 而且我不打网球:)

library(xlsx)
library(dplyr)
library(radarchart)
# library(data.table)
# source("chart.R")
library(shiny)
library(grDevices)
#------------------------------------------------------------------------------
mydata <- read.csv("./data/atp_matches_2014.csv", header = TRUE)
tour <- unique(mydata$tourney_name)
numrounds <- function(z) {
for(i in 1:64) {
rounds <- mydata %>%
filter(tourney_name == z) %>%
summarise(number = n_distinct(round))
if(rounds == 3){
buttons <- c("RR", "SF", "F")
}
else if(rounds == 5){
buttons <- c("R32", "R16", "QF", "SF", "F")
}
else if(rounds == 6){
buttons <- c("R64", "R32", "R16", "QF", "SF", "F")
}
else {
buttons <- c("R128", "R64", "R32", "R16", "QF", "SF", "F")
}
}
return(buttons)
}
#------------------------------------------------------------------------------
ui <- fluidPage(
titlePanel("Match Radar Chart"),
sidebarLayout(
sidebarPanel(
selectInput("var", 
label = "Choose a tournament",
choices = tour,
selected = "Auckland"),
uiOutput("radioButtons"),
uiOutput("selectControls"),
actionButton("update", "Go!")
),
mainPanel(
chartJSRadarOutput("radarChart", width = "450", height = "300")
)
)
)
#------------------------------------------------------------------------------
server <-  function(input, output, session){
session$onSessionEnded({  stopApp  }) 
output$radioButtons <- renderUI({
# dataInput <- reactive({input$var})
z <- input$var
buttons <- numrounds(z)
radioButtons("button", "Select a round: ", choices = buttons, inline = FALSE)
})
output$selectControls <- renderUI({
# dataInput <- reactive({input$var})
z <- input$var
# dataInput1 <- reactive({input$button})
y <- input$button #dataInput1()
winner <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
select(winner_name) %>%
sapply(as.character) %>%
as.vector()
loser <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
select(loser_name) %>%
sapply(as.character) %>%
as.vector()
players <- c(winner, loser)
selectInput("select", "Select a match: ", choices = players, selected = 1, multiple = FALSE)
})    
output$radarChart <- renderChartJSRadar({
# browser()
if(is.null(input$button )) return()
if(is.null(input$select )) return()
# dataInput1 <- reactive({input$var})
z <- input$var # dataInput1()
# dataInput2 <- reactive({input$button})
y <- input$button # dataInput2()
# dataInput3 <- reactive({input$select})
x <- input$select # dataInput3()
match <- mydata %>%
filter(tourney_name == z) %>%
filter(round == y) %>%
filter(winner_name == x)
scoresw <- vector()
scoresl <- vector()
for(j in 25:33) {
scoresw <- c(scoresw, match()[j])
}
for(j in 34:42) {
scoresl <- c(scoresl, match()[j])
}
scores <- list(winner = scoresw, loser = scoresl)
labs <- c("Aces", "Double Faults", "Service points", "1st Service In", "1st Service won", "2nd Service won", "Service games", "Break points saved", "Break points faced")
c <- grDevices::col2rgb(c("green", "red"))
chartJSRadar(scores = scores, labs = labs, labelSize = 15, colMatrix = c)
})
}
#------------------------------------------------------------------------------
shinyApp(ui, server)

至于防止每次用户更改三个输入之一时绘制雷达图,可以使用isolate

例如(代码未经测试,但它应该:)工作)

output$radarChart <- renderChartJSRadar({
if(is.null(input$button )) return()
isolate({
if(is.null(input$select )) return()
z <- input$var # dataInput1()
y <- input$button # dataInput2()
x <- input$select # dataInput3()
})

或者非常相似的东西。 以input$var为例。 由于在isolate范围内,用户的任何更改都不会触发renderChartJSRadar的执行。在上面的代码中,只有对input$button的更改才会触发renderChartJSRadar的执行。

相关内容

  • 没有找到相关文章

最新更新