Hello Everyone,
Thank you to anyone who takes the time to read this and assist me.
I am currently creating a R Shiny dashboard for a sports team that will track variables such as player weight over time. So far, I have been successful in manipulating the data and creating plot outputs. However, recently I have written code that is meant to enhance my ggplots and do the following:
-
- Calculate the mean and standard deviation of the weight of all athletes on the team
-
- Create colored background of the ggplot so that the client can easily visualize where a given player’s weight fits within the distribution of the team’s weight distribution (see the attached figure).
My issue is that if I read the data into R with read_csv the vast majority of my code works however, I get an error (below) that is associated with “rect” section of the ggplot.
“Warning: Error in : Invalid input: date_trans works with objects of class Date only”
Alternatively, I could read the data into R with read.csv which can successfully produce my goal figure with the appropriate backgrounds (as seen in the above figure). However, this produces a variety of other errors which previously did not exist in the code (below). As you can see all of these errors seem to be date related.
“Warning: Error in : Problem with mutate() input Date.
x subscript out of bounds”
“Input Date is ceiling_date(Date, unit = "weeks").”
“Warning: Error in : Can't subset columns that don't exist.
x Column Practice_Duration(Avg_min) doesn't exist.”
“Warning: Error in : Problem with mutate() input Date.
x subscript out of bounds”
“Input Date is ceiling_date(Date, unit = "weeks").”
I will provide a version of my code that is as simplified as possible! Sorry if there are any issues with the reproducibility of my example. This is such a broad issue I am having that is difficult to know which sections of code I should and should not include. I gladly will implement your feedback to improve this question!
Here is a sample data frame which normally would be read in via csv.
'''
Playername <- c("Athelte 1","Athlete 2","Athlete 3", "Athlete 4","Athelte 1","Athlete 4", "Athlete 3", "Athelte 1", "Athlete 3","Athlete 4","Athlete 2","Athelte 1","Athlete 4","Athelte 1")
Date <- c("2021-01-01","2021-01-01","2021-01-01","2021-01-01","2021-01-07","2021-01-07","2021-01-07","2021-01-07","2021-01-24","2021-01-24","2021-01-24","2021-01-24","2021-02-02","2021-02-08")
Team <- c("Team 2", "Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2","Team 2")
Weight <- c("65.7","94.2","83.3","85.4","93.8","84.3","83.4","65.6","82.4","83.8","91.9","66.3","85","65.2")
Trainingdata <- data.frame(Playername, Date, Team, Weight)
'''
My code is below:
'''
library (dplyr, warn.conflicts = FALSE)
library(shiny)
library(shinythemes)
library (shinydashboard)
library(ggplot2)
library(readr)
library(plotly)
library (shinyWidgets)
library(tidyverse)
library(tsibble)
library(lubridate)
library(shinycssloaders)
# READ IN ONE OF THE BELOWED COMMENTS: (ISSUES DESCRIBED IN FORUM QUESTION)
# in_path_file <- "user data path/Exampe_Trainingdata2.csv"
# Trainingdata <-read.csv(in_path_file, header=TRUE, sep = ",",na.strings = "NA", nrows = -100, fileEncoding="UTF-8-BOM")
#Trainingdata <- read_csv("Example_Trainingdata2.csv",
# col_types = cols(Date = col_date (format = "%Y-%m-%d")))
## Dashboard details (UI)
ui <-navbarPage(title=title,
tabPanel(title = "Home",icon= icon("Home"),
fluidPage(
fluidRow(
valueBoxOutput("valuebox1", width = 3),
valueBoxOutput("valuebox2", width =3),
valueBoxOutput("valuebox3", width =3)
), #close fluid Row
fluidRow(column(3,
h4("Filter Data", align = "center"),
box(collapsible = FALSE,
width= 12,
dateRangeInput("daterange", "Select Date Range",
start = "2021-01-01",
end = Sys.Date(),
min = "2021-01-01",
max = Sys.Date(),
format = "yyyy/mm/dd",
separator = "-"),
checkboxGroupInput("Teaminput", "Select Team", c("Team 1", "Team 2"), selected ="Team 1"),
selectInput( "Category", "Select Category", c("Overview", "Position", "Age", "Player")),
uiOutput('outputfilter'))
),#closes column
column(6,
box(width=12,
plotlyOutput(outputId = "plot1", height = "400px") %>% withSpinner(type = 1, color = "#B62B34"))
)), #closes column, closes fluid row
fluidRow(
column (6,
plotlyOutput(outputId = "plot2", height = "400px")
),
column(6,
plotlyOutput(outputId = "plot3", height = "400px")
)), #closes column, closes fluid row
), #closes fluidPage
), #closes HOME Panel
) # closes Navbar Body and NAVBAR Page
server <- function(session, input, output) {
#TabPanel 1 (Home) Dynamic Filtering System
observeEvent(input$Category,{
categoryfilterinput<- paste(input$Category)
output$outputfilter <- renderUI({
switch(categoryfilterinput,
"Position" = selectInput("positioninput", "Select Position", choices = c("Forward","Defence", "Goalie")),
"Age" = selectInput("ageinput", "Select Age Range", choices = c("<20","20-23", "23-25", "25-30", ">30")),
"Player" = selectInput("Playernameinput", "Select Player", choices = unique(Trainingdata$Playername)))
})
})
#prevents app closing when neither team is selected
observe({
if (is.null(input$Teaminput)){return ()}
else {updateSelectInput(session, "Playernameinput", "Select Player", choices = Roster %>% filter(Team %in% input$Teaminput) %>% select(Playername))
}
})
#TabPanel 1 (Home) plots
output$plot1 <- renderPlotly({
#filters inputed date and team
df_filtered <- filter(Trainingdata, Date >= format(input$daterange[1]) & Date <= format(input$daterange[2])) %>%
filter(Team %in% input$Teaminput)
# Assist code for background color in ggplot
team_only_filtered <- filter(Trainingdata, Team %in% input$Teaminput)
mean_weight=mean(as.numeric(final_data1$Weight), na.rm = TRUE)
sd_weight=sd(as.numeric(final_data1$Weight), na.rm = TRUE)
upper_1=mean_weight+sd_weight
upper_2=mean_weight+sd_weight*2
upper_3=mean_weight+sd_weight*3
lower_1=mean_weight-sd_weight
lower_2=mean_weight-sd_weight*2
lower_3=mean_weight-sd_weight*3
measure_date <- as.factor(df_filtered$Date)
count_x=n_distinct(measure_date)
x_length=count_x+1
# IF statments for Category inputs
if (input$Category == "Overview") {
df_filtered1 <- df_filtered %>%
mutate(Date = ceiling_date(Date, unit = "weeks")) %>%
group_by(Date) %>%
summarise(across(where(is.numeric), mean, rm.na = TRUE))
}
if (input$Category == "Player") {
df_filtered1 <- df_filtered %>%
filter(Playername %in% input$Playernameinput)
}
ggplotly(
ggplot(df_filtered1, aes(x= Date, y= Weight)) +
geom_point(size=1.25)+
geom_line(color = "Red")+
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(mean_weight) , ymax=c(upper_1), alpha=0.2, fill="green") +
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(mean_weight) , ymax=c(lower_1), alpha=0.2, fill="green") +
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(upper_1) , ymax=c(upper_2), alpha=0.2, fill="yellow") +
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(lower_1) , ymax=c(lower_2), alpha=0.2, fill="yellow") +
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(upper_2) , ymax=c(upper_3), alpha=0.2, fill="red") +
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(lower_2) , ymax=c(lower_3), alpha=0.2, fill="red") +
geom_hline(yintercept=mean_weight, color="blue", size=1)+
annotate("rect", xmin=c(0), xmax=c(x_length), ymin=c(lower_1) , ymax=c(upper_1), alpha=0.2, color="blue", fill="red")+
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") +
ylim (72.0, 118.0) +
ylab("Weight (kg)")
)
})
} #closes server function
# Run the application
shinyApp(ui = ui, server = server)
'''
Thank you for your help and feedback
