Using background color in ggplot to help illustrate data (Standard deviation)

Hello Everyone,

I hope this is the right place to ask this question.

I have a simple data frame with the following variables: "Date", "Athlete", "Weight"

I am currently creating a Rshiny dashboard. One of the goals is to graph Athlete Weights over time. There are multiple athletes in the data set. My code currently filters the data by an athlete select input and graphs that athlete's data over time (code included below)

However, I would like to provide additional information regarding whether the athlete's weight variation is acceptable or not acceptable. What I would like to do is have a simple line graph of Athlete 1 weight over time.. and in the background of the ggplot have the background color change dependent on the whole data set (all athletes' weight standard deviation (SD of the data frame will be continuously changing with additional weight inputs)).

I envision this as a linegraph with a light, semi-transparent green background for "within 1 SD", a light, semi-transparent orange background for "between 1 and 2 SD" and a light, semi-transparent red background for ">2 SD"

I hope this makes sense, if not I would love to improve my explanation. Below is my current server code.

Thank you for your time and help.

'''

 server <- function(session, input, output) {

  output$plot1 <- renderPlotly({
  
       df_filtered <- filter(df, Date >= format(input$daterange[1]) & Date <= format(input$daterange[2])) %>% 
                                filter(Playername == input$Playernameinput) 
                   

     print(
        ggplotly(
          ggplot(df_filtered, aes(x= Date, y= Weight)) +
                         geom_point(size=1.25)+
                         geom_line(color = "Red")+
                        theme_bw()+
                        theme(axis.line = element_line(colour = "black"),
                        axis.title = element_text(face="bold"),
                        axis.text.x = element_text(angle = 45, hjust=1)) +
                       scale_x_date(date_labels = "%b/%d/%y")
        ))
    })

   }

'''

I am not sure what you want to compare to what to change the color but I made an example where there are three values of Athlete, the sd of each athlete is calculated, and the color of the plot background is determined by the sd value. Does this help? You have to manually change which athlete is plotted in this example.

DATES <- seq.Date(as.Date("2020-01-01"), length.out = 10, by = "day")
set.seed(1)
DF <- data.frame(Athlete = rep(c("A", "B", "C"), each = 10),
                 Date = rep(DATES, 3),
                 Weight = c(rnorm(10, 100, 1), rnorm(10, 100, 3), rnorm(10, 100, 0.5)))

library(ggplot2)
library(dplyr, warn.conflicts = FALSE)

tmp <- filter(DF, Athlete == "C")
TmpSD <- sd(tmp$Weight)
FillColor <- case_when(TmpSD < 0.5 ~ "palegreen1", 
                       TmpSD < 1.0 ~ "lightgoldenrod1", 
                       TmpSD > 1 ~ "pink1")
ggplot(tmp, aes(Date, Weight)) + geom_line() + 
  theme(panel.background = element_rect(fill = FillColor)) 

Created on 2021-03-19 by the reprex package (v0.3.0)

1 Like

Thank you for response. You have understood what I am trying to do well. Just for extra clarity, I am trying to compare 1 athlete's weight to the standard deviations of the whole team.

I have incorporated your code but it is not working. I do not get any errors, but the background of my ggplot remains white.

I have included my updated code below. I hope you dont mind but I included the more complex version of my code (in reality there is a team select input, a player select input and a date range selection in the UI.

'''

  df_filtered <- filter(df, Date >= format(input$daterange[1]) & Date <= format(input$daterange[2])) %>% 
                 filter(Team %in% input$Teaminput) %>% 
                 filter(Playername == input$Playernameinput) 


  teamfiltereddata <-filter(df, Team %in% input$Teaminput)
  WeightSD <- sd(teamfiltereddata$Weight)
  FillColor <- case_when(WeightSD < 0.5 ~ "palegreen1", 
                         WeightSD < 1.0 ~ "lightgoldenrod1", 
                         WeightSD > 1 ~ "pink1")

  ggplotly(
    ggplot(df_filtered, aes(x= Date, y= Weight)) +
      geom_point(size=1.25)+
      geom_line(color = "black")+
      theme_bw()+
      theme(axis.line = element_line(colour = "Black"), 
            axis.text = element_text(size=8), 
            axis.title = element_text(face="bold"),
            axis.text.x = element_text(angle = 45, hjust=1)) + 
      scale_x_date(date_labels = "%b/%d/%y") +
      theme(panel.background = element_rect(fill = FillColor))
  )

'''

I really appreciate your time, thanks again for the help

I do not see anything wrong with your code. I copied over your calls to theme() and wrapped the ggplot() call in ggplotly() in case there was something funny in all of that and the code works for me. The only thing I changed on my side is that I set one of the case_when conditions to catch the case when TmpSD == 1 which I left out by mistake. Have you tried running your code outside of shiny in a plain R session? You would have to replace all of your values like input$Teaminput with hard coded values. I don't know why the code would not work inside of shiny but shiny does add another layer of processing so in cases where I am stumped I step back from it just to simplify the problem.

DATES <- seq.Date(as.Date("2020-01-01"), length.out = 10, by = "day")
set.seed(1)
DF <- data.frame(Athlete = rep(c("A", "B", "C"), each = 10),
                 Date = rep(DATES, 3),
                 Weight = c(rnorm(10, 100, 1), rnorm(10, 100, 3), rnorm(10, 100, 0.5)))

library(ggplot2)
library(dplyr, warn.conflicts = FALSE)
library(plotly)

tmp <- filter(DF, Athlete == "C")
TmpSD <- sd(tmp$Weight)
FillColor <- case_when(TmpSD < 0.5 ~ "palegreen1", 
                       TmpSD < 1.0 ~ "lightgoldenrod1", 
                       TmpSD >= 1 ~ "pink1")
ggplotly(ggplot(tmp, aes(Date, Weight)) + geom_point(size=1.25)+
           geom_line(color = "black")+ 
           theme_bw()+
           theme(axis.line = element_line(colour = "Black"), 
                 axis.text = element_text(size=8), 
                 axis.title = element_text(face="bold"),
                 axis.text.x = element_text(angle = 45, hjust=1)) + 
           scale_x_date(date_labels = "%b/%d/%y") +
           theme(panel.background = element_rect(fill = FillColor))
)
1 Like

Sorry the delay in my response! I have investigated this issue and it is not working as expected! I will continue working on this and see if I can find a solution!

Thank you for your guidance

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.