闪亮的 Flexdasboard 反应式仪表未更新
Shiny Flexdasboard Reactive Gauge not Updating
我在我的 shinyapp 中添加了反应量表。该仪表将显示最近的跳跃高度得分与运动员之前所有时间的最小值和最大值的比较。
select输入设置为 Athlete 和最近的日期 (max(jumpdata$Date))。我的代码非常适用于最大反应式仪表，但不会为最小值进行反应式更新。当我 运行 应用程序时，第一个运动员的输入显示最小值，然后在我更新和 select 不同的输入时保持相同的值（但最大变化）。
我不确定障碍在哪里，因为最大值正在更新。
ui.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyUI(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", gaugeOutput("Gauge_JH"))
))
))
server.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyServer(function(input, output){
output$Gauge_JH <- renderGauge({
f <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete & Date == c(max(jumpdata$Date)))
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
g <- gauge(f$JumpHeight_cm, min = min(t$JumpHeight_cm), max = max(t$JumpHeight_cm), symbol = 'cm', gaugeSectors(
success = c((max(t$JumpHeight_cm)*.9), max(t$JumpHeight_cm)), warning = c((max(t$JumpHeight_cm)*.8), max(t$JumpHeight_cm)*.9), danger = c(min(t$JumpHeight_cm), max(t$JumpHeight_cm)*.8)
))
print(g)
})
})
数据
jumpdata <- structure(list(Athlete = structure(c(1L, 1L, 1L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L,
11L, 11L, 11L, 12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L,
14L, 14L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L), .Label = c("Athlete 1", "Athlete 10",
"Athlete 11", "Athlete 12", "Athlete 13", "Athlete 14", "Athlete 2",
"Athlete 3", "Athlete 4", "Athlete 5", "Athlete 6", "Athlete 7",
"Athlete 8", "Athlete 9"), class = "factor"), Date = structure(c(1L,
4L, 5L, 1L, 3L, 5L, 7L, 2L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 6L, 7L, 2L, 4L, 5L, 8L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
6L, 7L, 1L, 3L, 5L, 7L), .Label = c("2020-01-06", "2020-01-07",
"2020-01-13", "2020-01-14", "2020-01-21", "2020-01-23", "2020-01-27",
"2020-01-28"), class = "factor"), Position = structure(c(2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L), .Label = c("DEF", "FWD", "GOALIE"), class = "factor"),
Program = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L,
4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L), .Label = c("Navy", "Red", "RTP", "White"), class = "factor"),
mRSI = c(0.36, 0.38, 0.42, 0.46, 0.46, 0.47, 0.48, 0.31,
0.3, 0.24, 0.3, 0.29, 0.26, 0.28, 0.28, 0.36, 0.35, 0.43,
0.43, 0.28, 0.31, 0.28, 0.3, 0.33, 0.36, 0.35, 0.37, 0.37,
0.36, 0.37, 0.36, 0.3, 0.36, 0.34, 0.37, 0.26, 0.28, 0.34,
0.3, 0.39, 0.4, 0.43, 0.43, 0.43, 0.47, 0.46, 0.48, 0.34,
0.36, 0.33, 0.37, 0.28, 0.28, 0.34, 0.33), SystemWeight = c(617.21,
612.4, 620.45, 672.08, 682.23, 670.5, 663.41, 517.33, 515.23,
511.62, 517.85, 697.55, 703.92, 689.43, 691.33, 859.06, 845.9,
850.97, 851.84, 655.79, 665.09, 673.91, 667.92, 626.78, 632.92,
634.52, 624.88, 637.55, 645.6, 648.78, 646.64, 558.03, 563.23,
569.58, 560.95, 693.63, 695.54, 684.37, 684.58, 641.18, 660.8,
663.95, 660, 594.92, 596.97, 591.36, 585.64, 522.35, 518.17,
530.95, 523.5, 780.65, 789.81, 775.84, 775.48), FTCT = c(0.61,
0.62, 0.67, 0.74, 0.75, 0.77, 0.77, 0.54, 0.55, 0.44, 0.53,
0.53, 0.49, 0.53, 0.56, 0.6, 0.58, 0.68, 0.68, 0.53, 0.57,
0.54, 0.55, 0.61, 0.63, 0.64, 0.65, 0.59, 0.58, 0.59, 0.59,
0.51, 0.59, 0.59, 0.59, 0.53, 0.57, 0.63, 0.59, 0.76, 0.76,
0.79, 0.78, 0.67, 0.72, 0.72, 0.74, 0.63, 0.65, 0.61, 0.63,
0.49, 0.5, 0.53, 0.57), JumpHeight_cm = c(28.97, 29.78, 31.43,
35.83, 35.41, 36.59, 36.92, 27.56, 26.11, 26.15, 26.82, 26.15,
25.08, 24.98, 24.62, 29.39, 30.17, 32.42, 32.56, 26.6, 27.25,
25.58, 27.88, 29.17, 31.58, 28.48, 31.24, 33.73, 32.78, 33.09,
33.43, 29.73, 31.91, 30.65, 32.98, 24.15, 24.24, 27.57, 25.44,
26.68, 26.39, 27.43, 28.87, 35.44, 36.29, 35.71, 36.06, 26.79,
27.76, 26.82, 29.71, 28.69, 26.9, 31.12, 29.77), EJH = c(17.6,
18.58, 21.11, 26.66, 26.69, 28.08, 28.38, 14.99, 14.39, 11.41,
14.33, 13.8, 12.34, 13.29, 13.67, 17.58, 17.5, 22.03, 22.19,
14.03, 15.59, 13.92, 15.39, 17.7, 19.75, 18.37, 20.3, 19.99,
18.9, 19.62, 19.61, 15.09, 18.8, 18.18, 19.6, 12.78, 13.87,
17.28, 15.06, 20.44, 20.12, 21.74, 22.52, 23.8, 26.25, 25.68,
26.73, 16.99, 18.13, 16.42, 18.82, 14.09, 13.43, 16.61, 16.9
), Weight = c(62.94, 62.45, 63.27, 68.54, 69.57, 68.38, 67.65,
52.76, 52.54, 52.17, 52.81, 71.13, 71.78, 70.31, 70.5, 87.61,
86.26, 86.78, 86.87, 66.88, 67.82, 68.72, 68.11, 63.92, 64.54,
64.71, 63.72, 65.02, 65.84, 66.16, 65.94, 56.91, 57.44, 58.09,
57.2, 70.74, 70.93, 69.79, 69.81, 65.39, 67.39, 67.71, 67.31,
60.67, 60.88, 60.31, 59.72, 53.27, 52.84, 54.15, 53.39, 79.61,
80.54, 79.12, 79.08)), class = "data.frame", row.names = c(NA,
-55L))
根据 github 上发布的解决方法，这是我的新代码，但我无法渲染它。根据我原来的标准，我不确定要包含什么作为 input$range。
ui.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyUI(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", gaugeOutput("Gauge_JH")),
uiOutput("Gauge_JH_Proxy")
))
))
server.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyServer(function(input, output){
output$Gauge_JH <- renderGauge({
f <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete & Date == c(max(jumpdata$Date)))
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
g <- gauge(f$JumpHeight_cm, min = min(t$JumpHeight_cm), max = max(t$JumpHeight_cm), symbol = 'cm', gaugeSectors(
success = c((max(t$JumpHeight_cm)*.9), max(t$JumpHeight_cm)), warning = c((max(t$JumpHeight_cm)*.8), max(t$JumpHeight_cm)*.9), danger = c(min(t$JumpHeight_cm), max(t$JumpHeight_cm)*.8)
))
print(g)
})
output$Gauge_JH_Proxy <- renderUI({
input$Athlete # force re-rendering
gaugeOutput(outputId = "Gauge_JH", width = "30%", height = "200px")
})
})
可以通过使用 renderUI 和 debounce（延迟渲染，以便计算准备就绪）来解决此问题。
请注意，我已经更改了范围逻辑以实际显示一些颜色并查看以下内容：
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- structure(list(Athlete = structure(c(1L, 1L, 1L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L,
11L, 11L, 11L, 12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L,
14L, 14L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L), .Label = c("Athlete 1", "Athlete 10",
"Athlete 11", "Athlete 12", "Athlete 13", "Athlete 14", "Athlete 2",
"Athlete 3", "Athlete 4", "Athlete 5", "Athlete 6", "Athlete 7",
"Athlete 8", "Athlete 9"), class = "factor"), Date = structure(c(1L,
4L, 5L, 1L, 3L, 5L, 7L, 2L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 6L, 7L, 2L, 4L, 5L, 8L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
6L, 7L, 1L, 3L, 5L, 7L), .Label = c("2020-01-06", "2020-01-07",
"2020-01-13", "2020-01-14", "2020-01-21", "2020-01-23", "2020-01-27",
"2020-01-28"), class = "factor"), Position = structure(c(2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L), .Label = c("DEF", "FWD", "GOALIE"), class = "factor"),
Program = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L,
4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L), .Label = c("Navy", "Red", "RTP", "White"), class = "factor"),
mRSI = c(0.36, 0.38, 0.42, 0.46, 0.46, 0.47, 0.48, 0.31,
0.3, 0.24, 0.3, 0.29, 0.26, 0.28, 0.28, 0.36, 0.35, 0.43,
0.43, 0.28, 0.31, 0.28, 0.3, 0.33, 0.36, 0.35, 0.37, 0.37,
0.36, 0.37, 0.36, 0.3, 0.36, 0.34, 0.37, 0.26, 0.28, 0.34,
0.3, 0.39, 0.4, 0.43, 0.43, 0.43, 0.47, 0.46, 0.48, 0.34,
0.36, 0.33, 0.37, 0.28, 0.28, 0.34, 0.33), SystemWeight = c(617.21,
612.4, 620.45, 672.08, 682.23, 670.5, 663.41, 517.33, 515.23,
511.62, 517.85, 697.55, 703.92, 689.43, 691.33, 859.06, 845.9,
850.97, 851.84, 655.79, 665.09, 673.91, 667.92, 626.78, 632.92,
634.52, 624.88, 637.55, 645.6, 648.78, 646.64, 558.03, 563.23,
569.58, 560.95, 693.63, 695.54, 684.37, 684.58, 641.18, 660.8,
663.95, 660, 594.92, 596.97, 591.36, 585.64, 522.35, 518.17,
530.95, 523.5, 780.65, 789.81, 775.84, 775.48), FTCT = c(0.61,
0.62, 0.67, 0.74, 0.75, 0.77, 0.77, 0.54, 0.55, 0.44, 0.53,
0.53, 0.49, 0.53, 0.56, 0.6, 0.58, 0.68, 0.68, 0.53, 0.57,
0.54, 0.55, 0.61, 0.63, 0.64, 0.65, 0.59, 0.58, 0.59, 0.59,
0.51, 0.59, 0.59, 0.59, 0.53, 0.57, 0.63, 0.59, 0.76, 0.76,
0.79, 0.78, 0.67, 0.72, 0.72, 0.74, 0.63, 0.65, 0.61, 0.63,
0.49, 0.5, 0.53, 0.57), JumpHeight_cm = c(28.97, 29.78, 31.43,
35.83, 35.41, 36.59, 36.92, 27.56, 26.11, 26.15, 26.82, 26.15,
25.08, 24.98, 24.62, 29.39, 30.17, 32.42, 32.56, 26.6, 27.25,
25.58, 27.88, 29.17, 31.58, 28.48, 31.24, 33.73, 32.78, 33.09,
33.43, 29.73, 31.91, 30.65, 32.98, 24.15, 24.24, 27.57, 25.44,
26.68, 26.39, 27.43, 28.87, 35.44, 36.29, 35.71, 36.06, 26.79,
27.76, 26.82, 29.71, 28.69, 26.9, 31.12, 29.77), EJH = c(17.6,
18.58, 21.11, 26.66, 26.69, 28.08, 28.38, 14.99, 14.39, 11.41,
14.33, 13.8, 12.34, 13.29, 13.67, 17.58, 17.5, 22.03, 22.19,
14.03, 15.59, 13.92, 15.39, 17.7, 19.75, 18.37, 20.3, 19.99,
18.9, 19.62, 19.61, 15.09, 18.8, 18.18, 19.6, 12.78, 13.87,
17.28, 15.06, 20.44, 20.12, 21.74, 22.52, 23.8, 26.25, 25.68,
26.73, 16.99, 18.13, 16.42, 18.82, 14.09, 13.43, 16.61, 16.9
), Weight = c(62.94, 62.45, 63.27, 68.54, 69.57, 68.38, 67.65,
52.76, 52.54, 52.17, 52.81, 71.13, 71.78, 70.31, 70.5, 87.61,
86.26, 86.78, 86.87, 66.88, 67.82, 68.72, 68.11, 63.92, 64.54,
64.71, 63.72, 65.02, 65.84, 66.16, 65.94, 56.91, 57.44, 58.09,
57.2, 70.74, 70.93, 69.79, 69.81, 65.39, 67.39, 67.71, 67.31,
60.67, 60.88, 60.31, 59.72, 53.27, 52.84, 54.15, 53.39, 79.61,
80.54, 79.12, 79.08)), class = "data.frame", row.names = c(NA,
-55L))
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
ui <- fluidPage(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", uiOutput("Gauge_JH_Proxy"))
))
))
server <- function(input, output, session) {
output$Gauge_JH <- renderGauge({
g()
})
Athlete <- debounce(reactive({input$Athlete}), 500)
output$Gauge_JH_Proxy <- renderUI({
req(Athlete()) # force rerendering
gaugeOutput("Gauge_JH")
})
g <- reactive({
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
f <- t %>% filter(Date == max(Date))
minJump = min(t$JumpHeight_cm)
maxJump = max(t$JumpHeight_cm)
diffJump = maxJump-minJump
gauge(
value = f$JumpHeight_cm,
min = min(t$JumpHeight_cm),
max = max(t$JumpHeight_cm),
sectors = gaugeSectors(
success = c(min(t$JumpHeight_cm) + diffJump * 0.8, max(t$JumpHeight_cm)),
warning = c(min(t$JumpHeight_cm) + diffJump * 0.4, min(t$JumpHeight_cm) + diffJump * 0.8),
danger = c(min(t$JumpHeight_cm), min(t$JumpHeight_cm) + diffJump * 0.4)
),
symbol = 'cm'
)
})
}
shinyApp(ui, server)
但是，由于所有这些不便，我会切换图书馆。
这是一个 plotly 方法：
library(shiny)
library(shinydashboard)
library(dplyr)
library(plotly)
# jumpdata <- [copy & paste jumpdata here]
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
ui <- fluidPage(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
plotlyOutput("Gauge_JH_plotly", height = 250, width = "50%")
))
))
server <- function(input, output, session) {
output$Gauge_JH_plotly <- renderPlotly({
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
f <- t %>% filter(Date == max(Date))
currentJump = f$JumpHeight_cm
meanJump = mean(t$JumpHeight_cm)
minJump = min(t$JumpHeight_cm)
maxJump = max(t$JumpHeight_cm)
diffJump = maxJump-minJump
success = c(min(t$JumpHeight_cm) + diffJump * 0.8, max(t$JumpHeight_cm))
warning = c(min(t$JumpHeight_cm) + diffJump * 0.4, min(t$JumpHeight_cm) + diffJump * 0.8)
danger = c(min(t$JumpHeight_cm), min(t$JumpHeight_cm) + diffJump * 0.4)
ranges <- unique(c(danger, warning, success))
currentJumpColor <- c("red", "orange", "green")[findInterval(currentJump, ranges, rightmost.closed = TRUE)]
fig <- plot_ly(
domain = list(x = c(0, 1), y = c(0, 1)),
value = currentJump,
title = list(text = "Jump Height [cm]"),
type = "indicator",
mode = "gauge+number+delta",
delta = list(reference = meanJump),
gauge = list(
bar = list(color = currentJumpColor),
axis = list(range = list(minJump, maxJump)),
steps = list(
list(range = danger, color = "lightgray"),
list(range = warning, color = "gray")),
threshold = list(
line = list(color = "green", width = 4),
thickness = 0.75,
value = maxJump)))
fig <- fig %>% layout(margin = list(l=30, r=30, t=80, b=30))
fig
})
}
shinyApp(ui, server)
我在我的 shinyapp 中添加了反应量表。该仪表将显示最近的跳跃高度得分与运动员之前所有时间的最小值和最大值的比较。
select输入设置为 Athlete 和最近的日期 (max(jumpdata$Date))。我的代码非常适用于最大反应式仪表，但不会为最小值进行反应式更新。当我 运行 应用程序时，第一个运动员的输入显示最小值，然后在我更新和 select 不同的输入时保持相同的值（但最大变化）。
我不确定障碍在哪里，因为最大值正在更新。
ui.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyUI(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", gaugeOutput("Gauge_JH"))
))
))
server.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyServer(function(input, output){
output$Gauge_JH <- renderGauge({
f <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete & Date == c(max(jumpdata$Date)))
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
g <- gauge(f$JumpHeight_cm, min = min(t$JumpHeight_cm), max = max(t$JumpHeight_cm), symbol = 'cm', gaugeSectors(
success = c((max(t$JumpHeight_cm)*.9), max(t$JumpHeight_cm)), warning = c((max(t$JumpHeight_cm)*.8), max(t$JumpHeight_cm)*.9), danger = c(min(t$JumpHeight_cm), max(t$JumpHeight_cm)*.8)
))
print(g)
})
})
数据
jumpdata <- structure(list(Athlete = structure(c(1L, 1L, 1L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L,
11L, 11L, 11L, 12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L,
14L, 14L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L), .Label = c("Athlete 1", "Athlete 10",
"Athlete 11", "Athlete 12", "Athlete 13", "Athlete 14", "Athlete 2",
"Athlete 3", "Athlete 4", "Athlete 5", "Athlete 6", "Athlete 7",
"Athlete 8", "Athlete 9"), class = "factor"), Date = structure(c(1L,
4L, 5L, 1L, 3L, 5L, 7L, 2L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 6L, 7L, 2L, 4L, 5L, 8L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
6L, 7L, 1L, 3L, 5L, 7L), .Label = c("2020-01-06", "2020-01-07",
"2020-01-13", "2020-01-14", "2020-01-21", "2020-01-23", "2020-01-27",
"2020-01-28"), class = "factor"), Position = structure(c(2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L), .Label = c("DEF", "FWD", "GOALIE"), class = "factor"),
Program = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L,
4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L), .Label = c("Navy", "Red", "RTP", "White"), class = "factor"),
mRSI = c(0.36, 0.38, 0.42, 0.46, 0.46, 0.47, 0.48, 0.31,
0.3, 0.24, 0.3, 0.29, 0.26, 0.28, 0.28, 0.36, 0.35, 0.43,
0.43, 0.28, 0.31, 0.28, 0.3, 0.33, 0.36, 0.35, 0.37, 0.37,
0.36, 0.37, 0.36, 0.3, 0.36, 0.34, 0.37, 0.26, 0.28, 0.34,
0.3, 0.39, 0.4, 0.43, 0.43, 0.43, 0.47, 0.46, 0.48, 0.34,
0.36, 0.33, 0.37, 0.28, 0.28, 0.34, 0.33), SystemWeight = c(617.21,
612.4, 620.45, 672.08, 682.23, 670.5, 663.41, 517.33, 515.23,
511.62, 517.85, 697.55, 703.92, 689.43, 691.33, 859.06, 845.9,
850.97, 851.84, 655.79, 665.09, 673.91, 667.92, 626.78, 632.92,
634.52, 624.88, 637.55, 645.6, 648.78, 646.64, 558.03, 563.23,
569.58, 560.95, 693.63, 695.54, 684.37, 684.58, 641.18, 660.8,
663.95, 660, 594.92, 596.97, 591.36, 585.64, 522.35, 518.17,
530.95, 523.5, 780.65, 789.81, 775.84, 775.48), FTCT = c(0.61,
0.62, 0.67, 0.74, 0.75, 0.77, 0.77, 0.54, 0.55, 0.44, 0.53,
0.53, 0.49, 0.53, 0.56, 0.6, 0.58, 0.68, 0.68, 0.53, 0.57,
0.54, 0.55, 0.61, 0.63, 0.64, 0.65, 0.59, 0.58, 0.59, 0.59,
0.51, 0.59, 0.59, 0.59, 0.53, 0.57, 0.63, 0.59, 0.76, 0.76,
0.79, 0.78, 0.67, 0.72, 0.72, 0.74, 0.63, 0.65, 0.61, 0.63,
0.49, 0.5, 0.53, 0.57), JumpHeight_cm = c(28.97, 29.78, 31.43,
35.83, 35.41, 36.59, 36.92, 27.56, 26.11, 26.15, 26.82, 26.15,
25.08, 24.98, 24.62, 29.39, 30.17, 32.42, 32.56, 26.6, 27.25,
25.58, 27.88, 29.17, 31.58, 28.48, 31.24, 33.73, 32.78, 33.09,
33.43, 29.73, 31.91, 30.65, 32.98, 24.15, 24.24, 27.57, 25.44,
26.68, 26.39, 27.43, 28.87, 35.44, 36.29, 35.71, 36.06, 26.79,
27.76, 26.82, 29.71, 28.69, 26.9, 31.12, 29.77), EJH = c(17.6,
18.58, 21.11, 26.66, 26.69, 28.08, 28.38, 14.99, 14.39, 11.41,
14.33, 13.8, 12.34, 13.29, 13.67, 17.58, 17.5, 22.03, 22.19,
14.03, 15.59, 13.92, 15.39, 17.7, 19.75, 18.37, 20.3, 19.99,
18.9, 19.62, 19.61, 15.09, 18.8, 18.18, 19.6, 12.78, 13.87,
17.28, 15.06, 20.44, 20.12, 21.74, 22.52, 23.8, 26.25, 25.68,
26.73, 16.99, 18.13, 16.42, 18.82, 14.09, 13.43, 16.61, 16.9
), Weight = c(62.94, 62.45, 63.27, 68.54, 69.57, 68.38, 67.65,
52.76, 52.54, 52.17, 52.81, 71.13, 71.78, 70.31, 70.5, 87.61,
86.26, 86.78, 86.87, 66.88, 67.82, 68.72, 68.11, 63.92, 64.54,
64.71, 63.72, 65.02, 65.84, 66.16, 65.94, 56.91, 57.44, 58.09,
57.2, 70.74, 70.93, 69.79, 69.81, 65.39, 67.39, 67.71, 67.31,
60.67, 60.88, 60.31, 59.72, 53.27, 52.84, 54.15, 53.39, 79.61,
80.54, 79.12, 79.08)), class = "data.frame", row.names = c(NA,
-55L))
根据 github 上发布的解决方法，这是我的新代码，但我无法渲染它。根据我原来的标准，我不确定要包含什么作为 input$range。
ui.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyUI(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", gaugeOutput("Gauge_JH")),
uiOutput("Gauge_JH_Proxy")
))
))
server.r
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- read.csv("SO CMJ Dummy.csv")
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
shinyServer(function(input, output){
output$Gauge_JH <- renderGauge({
f <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete & Date == c(max(jumpdata$Date)))
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
g <- gauge(f$JumpHeight_cm, min = min(t$JumpHeight_cm), max = max(t$JumpHeight_cm), symbol = 'cm', gaugeSectors(
success = c((max(t$JumpHeight_cm)*.9), max(t$JumpHeight_cm)), warning = c((max(t$JumpHeight_cm)*.8), max(t$JumpHeight_cm)*.9), danger = c(min(t$JumpHeight_cm), max(t$JumpHeight_cm)*.8)
))
print(g)
})
output$Gauge_JH_Proxy <- renderUI({
input$Athlete # force re-rendering
gaugeOutput(outputId = "Gauge_JH", width = "30%", height = "200px")
})
})
可以通过使用 renderUI 和 debounce（延迟渲染，以便计算准备就绪）来解决此问题。
请注意，我已经更改了范围逻辑以实际显示一些颜色并查看以下内容：
library(shiny)
library(shinydashboard)
library(flexdashboard)
library(dplyr)
jumpdata <- structure(list(Athlete = structure(c(1L, 1L, 1L, 7L, 7L, 7L,
7L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L,
11L, 11L, 11L, 12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L,
14L, 14L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 6L, 6L, 6L, 6L), .Label = c("Athlete 1", "Athlete 10",
"Athlete 11", "Athlete 12", "Athlete 13", "Athlete 14", "Athlete 2",
"Athlete 3", "Athlete 4", "Athlete 5", "Athlete 6", "Athlete 7",
"Athlete 8", "Athlete 9"), class = "factor"), Date = structure(c(1L,
4L, 5L, 1L, 3L, 5L, 7L, 2L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 6L, 7L, 2L, 4L, 5L, 8L, 1L, 3L, 5L, 7L, 1L, 3L,
5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L, 5L, 7L, 1L, 3L,
6L, 7L, 1L, 3L, 5L, 7L), .Label = c("2020-01-06", "2020-01-07",
"2020-01-13", "2020-01-14", "2020-01-21", "2020-01-23", "2020-01-27",
"2020-01-28"), class = "factor"), Position = structure(c(2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L), .Label = c("DEF", "FWD", "GOALIE"), class = "factor"),
Program = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L,
4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L), .Label = c("Navy", "Red", "RTP", "White"), class = "factor"),
mRSI = c(0.36, 0.38, 0.42, 0.46, 0.46, 0.47, 0.48, 0.31,
0.3, 0.24, 0.3, 0.29, 0.26, 0.28, 0.28, 0.36, 0.35, 0.43,
0.43, 0.28, 0.31, 0.28, 0.3, 0.33, 0.36, 0.35, 0.37, 0.37,
0.36, 0.37, 0.36, 0.3, 0.36, 0.34, 0.37, 0.26, 0.28, 0.34,
0.3, 0.39, 0.4, 0.43, 0.43, 0.43, 0.47, 0.46, 0.48, 0.34,
0.36, 0.33, 0.37, 0.28, 0.28, 0.34, 0.33), SystemWeight = c(617.21,
612.4, 620.45, 672.08, 682.23, 670.5, 663.41, 517.33, 515.23,
511.62, 517.85, 697.55, 703.92, 689.43, 691.33, 859.06, 845.9,
850.97, 851.84, 655.79, 665.09, 673.91, 667.92, 626.78, 632.92,
634.52, 624.88, 637.55, 645.6, 648.78, 646.64, 558.03, 563.23,
569.58, 560.95, 693.63, 695.54, 684.37, 684.58, 641.18, 660.8,
663.95, 660, 594.92, 596.97, 591.36, 585.64, 522.35, 518.17,
530.95, 523.5, 780.65, 789.81, 775.84, 775.48), FTCT = c(0.61,
0.62, 0.67, 0.74, 0.75, 0.77, 0.77, 0.54, 0.55, 0.44, 0.53,
0.53, 0.49, 0.53, 0.56, 0.6, 0.58, 0.68, 0.68, 0.53, 0.57,
0.54, 0.55, 0.61, 0.63, 0.64, 0.65, 0.59, 0.58, 0.59, 0.59,
0.51, 0.59, 0.59, 0.59, 0.53, 0.57, 0.63, 0.59, 0.76, 0.76,
0.79, 0.78, 0.67, 0.72, 0.72, 0.74, 0.63, 0.65, 0.61, 0.63,
0.49, 0.5, 0.53, 0.57), JumpHeight_cm = c(28.97, 29.78, 31.43,
35.83, 35.41, 36.59, 36.92, 27.56, 26.11, 26.15, 26.82, 26.15,
25.08, 24.98, 24.62, 29.39, 30.17, 32.42, 32.56, 26.6, 27.25,
25.58, 27.88, 29.17, 31.58, 28.48, 31.24, 33.73, 32.78, 33.09,
33.43, 29.73, 31.91, 30.65, 32.98, 24.15, 24.24, 27.57, 25.44,
26.68, 26.39, 27.43, 28.87, 35.44, 36.29, 35.71, 36.06, 26.79,
27.76, 26.82, 29.71, 28.69, 26.9, 31.12, 29.77), EJH = c(17.6,
18.58, 21.11, 26.66, 26.69, 28.08, 28.38, 14.99, 14.39, 11.41,
14.33, 13.8, 12.34, 13.29, 13.67, 17.58, 17.5, 22.03, 22.19,
14.03, 15.59, 13.92, 15.39, 17.7, 19.75, 18.37, 20.3, 19.99,
18.9, 19.62, 19.61, 15.09, 18.8, 18.18, 19.6, 12.78, 13.87,
17.28, 15.06, 20.44, 20.12, 21.74, 22.52, 23.8, 26.25, 25.68,
26.73, 16.99, 18.13, 16.42, 18.82, 14.09, 13.43, 16.61, 16.9
), Weight = c(62.94, 62.45, 63.27, 68.54, 69.57, 68.38, 67.65,
52.76, 52.54, 52.17, 52.81, 71.13, 71.78, 70.31, 70.5, 87.61,
86.26, 86.78, 86.87, 66.88, 67.82, 68.72, 68.11, 63.92, 64.54,
64.71, 63.72, 65.02, 65.84, 66.16, 65.94, 56.91, 57.44, 58.09,
57.2, 70.74, 70.93, 69.79, 69.81, 65.39, 67.39, 67.71, 67.31,
60.67, 60.88, 60.31, 59.72, 53.27, 52.84, 54.15, 53.39, 79.61,
80.54, 79.12, 79.08)), class = "data.frame", row.names = c(NA,
-55L))
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
ui <- fluidPage(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
box(title = "Jump Height", uiOutput("Gauge_JH_Proxy"))
))
))
server <- function(input, output, session) {
output$Gauge_JH <- renderGauge({
g()
})
Athlete <- debounce(reactive({input$Athlete}), 500)
output$Gauge_JH_Proxy <- renderUI({
req(Athlete()) # force rerendering
gaugeOutput("Gauge_JH")
})
g <- reactive({
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
f <- t %>% filter(Date == max(Date))
minJump = min(t$JumpHeight_cm)
maxJump = max(t$JumpHeight_cm)
diffJump = maxJump-minJump
gauge(
value = f$JumpHeight_cm,
min = min(t$JumpHeight_cm),
max = max(t$JumpHeight_cm),
sectors = gaugeSectors(
success = c(min(t$JumpHeight_cm) + diffJump * 0.8, max(t$JumpHeight_cm)),
warning = c(min(t$JumpHeight_cm) + diffJump * 0.4, min(t$JumpHeight_cm) + diffJump * 0.8),
danger = c(min(t$JumpHeight_cm), min(t$JumpHeight_cm) + diffJump * 0.4)
),
symbol = 'cm'
)
})
}
shinyApp(ui, server)
但是，由于所有这些不便，我会切换图书馆。
这是一个 plotly 方法：
library(shiny)
library(shinydashboard)
library(dplyr)
library(plotly)
# jumpdata <- [copy & paste jumpdata here]
jumpdata$Date <- as.Date(jumpdata$Date, "%Y-%m-%d")
ui <- fluidPage(
fluidPage(
sidebarPanel(width = 3,
selectInput("Athlete", label = "Athlete",
choices = unique(jumpdata$Athlete))),
mainPanel(
fluidRow(
plotlyOutput("Gauge_JH_plotly", height = 250, width = "50%")
))
))
server <- function(input, output, session) {
output$Gauge_JH_plotly <- renderPlotly({
t <- jumpdata %>%
select(Date, Athlete, JumpHeight_cm) %>%
filter(Athlete == input$Athlete)
f <- t %>% filter(Date == max(Date))
currentJump = f$JumpHeight_cm
meanJump = mean(t$JumpHeight_cm)
minJump = min(t$JumpHeight_cm)
maxJump = max(t$JumpHeight_cm)
diffJump = maxJump-minJump
success = c(min(t$JumpHeight_cm) + diffJump * 0.8, max(t$JumpHeight_cm))
warning = c(min(t$JumpHeight_cm) + diffJump * 0.4, min(t$JumpHeight_cm) + diffJump * 0.8)
danger = c(min(t$JumpHeight_cm), min(t$JumpHeight_cm) + diffJump * 0.4)
ranges <- unique(c(danger, warning, success))
currentJumpColor <- c("red", "orange", "green")[findInterval(currentJump, ranges, rightmost.closed = TRUE)]
fig <- plot_ly(
domain = list(x = c(0, 1), y = c(0, 1)),
value = currentJump,
title = list(text = "Jump Height [cm]"),
type = "indicator",
mode = "gauge+number+delta",
delta = list(reference = meanJump),
gauge = list(
bar = list(color = currentJumpColor),
axis = list(range = list(minJump, maxJump)),
steps = list(
list(range = danger, color = "lightgray"),
list(range = warning, color = "gray")),
threshold = list(
line = list(color = "green", width = 4),
thickness = 0.75,
value = maxJump)))
fig <- fig %>% layout(margin = list(l=30, r=30, t=80, b=30))
fig
})
}
shinyApp(ui, server)