R根据单独数据帧上的值有条件地绘制亮图颜色

Question

我对r很陌生，很有光泽，所以请耐心等待-我创建了一个图，显示了运动队球员每周累积的距离，用户可以在其中选择球员和周范围。每个玩家都有自己应该达到的目标距离，如果他们达到了目标，我希望图中的数据点是绿色的，如果没有达到目标，则是红色的。

周距离和目标距离的数据位于不同的数据帧中(它们需要(，所以我需要当在selectInput((中选择玩家时，从第一个数据帧中提取周距离，从第二个数据帧提取同一玩家的目标，并用于条件格式化。

编辑-这是gps2数据帧(尽管PlayerName列列出了实际名称，我在这里改成了首字母缩写(：

structure(list(Week = c(14, 14, 14, 14, 14, 15), PlayerName = c("CF", 
"DR", "GB", "KB", "RA", 
"AM"), Distance = c(3.8088, 2.1279, 2.4239, 1.3565, 
4.5082, 4.4097), SprintDistance = c(291.473, 146.97, 11.071, 
67.596, 252.787, 0), TopSpeed = c(22.6402, 21.3442, 20.5762, 
21.6002, 20.5602, 18.6401)), row.names = c(NA, -6L), groups = structure(list(
Week = c(14, 15), .rows = structure(list(1:5, 6L), ptype = integer(0), class = c("vctrs_list_of", 
"vctrs_vctr", "list"))), row.names = 1:2, class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"))

目标数据帧：

structure(list(PlayerName = c("AM", "AB", "AMc", 
"BC", "CD", "CM"), Distance = c(28.2753333333333, 
34.867, NA, 31.633, 34.6122, 32.1405), SprintDistance = c(1355.2, 
1074.85, NA, 2426.55, 2430.54, 2447.9), TopSpeed = c(32.61, 30.3, 
NA, 36.82, 42, 33.44)), row.names = c(NA, -6L), class = c("tbl_df", 
"tbl", "data.frame"))

我已经在这方面工作了几天了，我不知道该怎么做，也找不到一个描述我想做什么的帖子。到目前为止，这就是我所拥有的：

# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(gps2$PlayerName),
selected = "AB"),

#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),

# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {
# Total Distance ----
# Data for distance plot
TD_plot <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2],
) %>%
select(Distance)
})

# Build distance plot
output$TD <- renderPlot({
ggplot(TD_plot()) +
geom_point(aes(Week, Distance,
color = Distance > 5),
stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, Distance), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})
# Data for distance table
TD_sum <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2])%>%
select(Distance) %>%
pivot_wider(.,
names_from = Week,
values_from = Distance)
})
# Build distance table
output$TDsum <- renderTable(TD_sum())

}
shinyApp(ui = ui, server = server)

现在，数据点根据任意值(5(进行更改，因为我正试图对此进行扩展。我希望这能足够详细地解释我要做的事情，提前感谢你的帮助！

Answer 1

这里有一个可能有用的工作示例。

首先，请left_join玩家的实际距离和他们的目标距离。这将用"；实际"；或"；目标"；作为后缀以将它们分隔开。

在geom_point中，您可以使用color = DistanceActual > DistanceTarget根据距离是否大于或小于目标来获得差异颜色。

我简化了其他功能进行演示。

library(shiny)
library(tidyverse)
full_data <- left_join(gps2, df_targets, by = "PlayerName", suffix = c("Actual", "Target"))
# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(full_data$PlayerName),
selected = "player1"),

#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),

# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {

# Filter by week and player name
TD_data <- reactive({
full_data %>%
filter(PlayerName == input$name,
Week >= input$week [1],
Week <= input$week [2])
})

# Build distance plot
output$TD <- renderPlot({
ggplot(TD_data()) +
geom_point(aes(Week, DistanceActual, color = DistanceActual > DistanceTarget), stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, DistanceActual), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})

# Build distance table
output$TDsum <- renderTable(
TD_data() %>% 
select(Week, DistanceActual)
)

}
shinyApp(ui = ui, server = server)