I am trying to create a dashboard, but I keep coming across the error, faceting variable must have at least one value. I am new to shiny, and I think the issue is with the filter in the reactive.
I am trying to be able to filter dates for the selected athlete for the two variable that I selected through facet_wrap.
structure(list(Name = c("Player_1", "Player_1", "Player_1", "Player_1",
"Player_1", "Player_1", "Player_1", "Player_1", "Player_1", "Player_1",
"Player_1", "Player_1", "Player_1", "Player_1", "Player_1", "Player_2",
"Player_2", "Player_2", "Player_2", "Player_2", "Player_2", "Player_2",
"Player_2", "Player_2", "Player_2", "Player_2", "Player_2", "Player_2",
"Player_2", "Player_2", "Player_2", "Player_2"), Date = c("10/25/22",
"10/20/22", "10/18/22", "10/11/22", "10/4/22", "9/29/22", "9/22/22",
"9/20/22", "9/15/22", "9/13/22", "9/8/22", "9/6/22", "9/1/22",
"8/30/22", "8/25/22", "10/25/22", "10/20/22", "10/18/22", "10/11/22",
"10/6/22", "10/4/22", "9/29/22", "9/27/22", "9/22/22", "9/20/22",
"9/15/22", "9/13/22", "9/8/22", "9/6/22", "9/1/22", "8/30/22",
"8/25/22"), Eccentric Duration [ms]
= c(672, 712, 625, 659,
673, 745, 563, 763, 915, 581, 726, 593, 691, 661, 588, 423, 406,
481, 424, 397, 396, 455, 409, 431, 469, 440, 435, 450, 431, 471,
466, 448), RSI-modified [m/s]
= c(0.28, 0.3, 0.29, 0.28, 0.29,
0.27, 0.34, 0.26, 0.24, 0.33, 0.27, 0.31, 0.28, 0.27, 0.33, 0.46,
0.46, 0.38, 0.47, 0.48, 0.49, 0.42, 0.48, 0.4, 0.37, 0.38, 0.4,
0.41, 0.39, 0.36, 0.36, 0.43)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -32L))
library(shiny)
library(tidyverse)
library(plotly)
library(DT)
library(viridis)
theme_set(theme_classic())
### Load in the data
force_data <- read_csv('metrics.csv') %>%
drop_na()
#### Change the date
force_data$date_formatted <- as.Date(force_data$Date,
tryFormats = c("%m/%d/%y"))
readiness <- force_data %>%
select(Name, date_formatted, `Eccentric Duration [ms]`, `RSI-
modified [m/s]`) %>%
pivot_longer(cols = 3:4,
names_to = "Names",
values_to = "Values")
# Define UI for application that draws a histogram
ui <- navbarPage("Force Plate Dashboard",
tabPanel("Readiness",
selectInput("Athlete",
label = h3("Select Athlete"),
choices = unique(readiness$Name),
selected = 1),
dateRangeInput("Date",
label = h3("Select Date:"),
start = "2020-08-25",
end = NULL),
mainPanel(plotlyOutput("Plot1"))
))
server <- function(input, output, session) {
dat <- reactive({
d <- readiness %>%
group_by(Name) %>%
filter(date_formatted %in% input$Date,
Name == input$Athlete)
d
})
output$Plot1 <- renderPlotly({
d <- dat()
readiness_plot <- print(
ggplotly(
ggplot(d, aes(date_formatted, Values)) +
geom_line(color = "blue") +
geom_point() +
labs(x = NULL, y = NULL) +
scale_color_viridis_d() +
theme_classic() +
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size = 9, angle = 45,
vjust = 1, hjust = 1, color = "black"),
axis.text.y = element_text(size = 10, color =
"black"),
strip.text.x = element_text(size = 12, face =
"bold"),
panel.spacing = unit(1, "lines"),
legend.position = "bottom",
legend.title = element_blank()) +
facet_wrap(~Names, scales = "free")))
print(readiness_plot)
})
}
# Run the application
shinyApp(ui = ui, server = server)