R shiny plot colour conditionally based on values on separate data frame

user_14355998 0
Viewed 76

I'm fairly new to r and shiny, so bear with me - I have created a plot which shows the accumulated weekly distance covered by players in a sports team, where the user can select the player and the week range. Each player has an individual target distance they should meet and I want the data points in the plot to be green if they have met the target and red if they have not.

The data for weekly distance and target distance are located in different data frames (and they need to be) so I need that when a player is selected in selectInput(), the weekly distance is pulled from the first data frame and the target for the same player is pulled from the second data frame and used for conditional formatting.

EDIT - This is the gps2 data frame (though the PlayerName column lists the actual name which I've changed to initials here):

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"))

And the targets 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"))

I have been working on this for a few days now and can't wrap my head around how to do it or find a post which describes what I want to do. So far this is what I have:

# 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)

Right now the data points changes based on an arbitrary value (5) as I was trying to expand on that. I hope this explains in enough detail what I'm trying to do, thanks in advance for your help!

shiny ggplot2 r
1 Answers

Here's a working example that may be helpful.

First, would left_join your actual distances by players, and their target distances. This will rename columns with "Actual" or "Target" as suffixes to keep them apart.

In geom_point you can use color = DistanceActual > DistanceTarget to have differential color based on whether a distance is greater or less than the target.

I simplified the other functions for demonstration.

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)
user_34606700
Related