ST537_Assgn4_PRCTICE
Teague Teece
2025-06-04
library(shiny)
library(bslib)
library(dplyr)
library(ggplot2)
library(ggExtra)
library(readr)
library(gganimate)
library(scales)
library(viridis)
library(plotly)
library(tinytex)
library(ggExtra)
library(tidyverse)# Load data properly
National_Supply <- read_csv("C:/Users/teecet/Downloads/NSD All Supply Data 2025-05-25.csv")
df_num <- National_Supply |> select(where(is.numeric), -Year)
completers_over_time <- National_Supply %>%
filter(Year >= 2014, Year <= 2024) %>%
group_by(State, Year) %>%
summarise(total_completers = sum(Program_Completers, na.rm = TRUE)) %>%
ungroup()#all supply data? this isnt producing anything in the plot....
#filtered_data <- reactive({ req(input$states, input$year) df |> filter(State %in% input$states, Year == input$year)})
# UI
#ui <- fluidPage( titlePanel("Ag Teacher National Supply Data"), sidebarLayout( sidebarPanel( varSelectInput("xvar", "X Variable", df_num, selected = "Program_Completers"),varSelectInput("yvar", "Y Variable", df_num selected = "Institutions"), checkboxGroupInput("states", "Select States", choices = unique(df$State), selected = unique(df$State)), checkboxInput("color_by_state", "Color by State", TRUE), checkboxInput("smooth", "Add Smoother", FALSE), checkboxInput("show_margins", "Show Marginal Plots", TRUE), sliderInput("year", "Select Year:", min = min(df$Year, na.rm = TRUE), max = max(df$Year, na.rm = TRUE), value = min(df$Year, na.rm = TRUE), step = 1, sep = "", animate = animationOptions(interval = 1000, loop = TRUE)) ), mainPanel( plotOutput("scatterPlot") ) ))
# Server
#server <- function(input, output, session) {
# filtered_data <- reactive({
# req(input$states, input$year)
# df |>
# filter(State %in% input$states, Year == input$year)
# })
# output$scatterPlot <- renderPlot({
# data <- filtered_data()
# p <- ggplot(data, aes(x = .data[[input$xvar]], y = .data[[input$yvar]])) +
# geom_point(aes(color = if (input$color_by_state) State else NULL), alpha = 0.7) +
# theme_minimal()
# if (input$smooth) {
# p <- p + geom_smooth(method = "loess", se = FALSE)
# }
# if (input$show_margins) {
# p <- ggExtra::ggMarginal(p, type = "histogram", margins = "both")
# } else {
# p # without margins
# } })}
# Run the app
#shinyApp(ui = ui, server = server)#from exploration assignment - bar chart with medians
selected_states <- c("Oregon", "Washington", "Wyoming", "Arizona", "Nevada", "Montana", "Idaho")
state_averages_west <- completers_over_time %>%
filter(State %in% selected_states) %>%
group_by(State) %>%
summarise(avg_completers = mean(total_completers, na.rm = TRUE)) %>%
ungroup()
completers_over_time <- National_Supply %>%
filter(Year >= 2014, Year <= 2024) %>%
group_by(State, Year) %>%
summarise(total_completers = sum(Program_Completers, na.rm = TRUE)) %>%
ungroup()## `summarise()` has grouped output by 'State'. You can override using the
## `.groups` argument.ggplot(state_averages_west, aes(x = reorder(State, -avg_completers), y = avg_completers, fill = avg_completers)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = round(avg_completers, 1)), vjust = -0.5, size = 4) +
scale_fill_viridis_c(option = "turbo", name = "Avg Completers") +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
labs(
title = "Average Program Completers (2014–2024)",
x = "State",
y = "Average # Completers"
) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ui_bargraph <- fluidPage(
titlePanel("Average Program Completers (2014–2024)"),
sidebarLayout(
sidebarPanel(
helpText("Bar chart of average program completers by state (Western US).")
),
mainPanel(
plotOutput("barPlot", height = "600px")
)
)
)
server_bargraph <- function(input, output) {
output$barPlot <- renderPlot({
ggplot(state_averages_west, aes(x = reorder(State, -avg_completers), y = avg_completers, fill = avg_completers)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = round(avg_completers, 1)), vjust = -0.5, size = 4) +
scale_fill_viridis_c(option = "turbo", name = "Avg Completers") +
scale_y_continuous(breaks = pretty_breaks(n = 10)) +
labs(
x = "State",
y = "Average # Completers"
) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
})
}
shinyApp(ui = ui_bargraph, server = server_bargraph)Shiny applications not supported in static R Markdown documents
#plot from exploration assignment. maybe try to make interactive?
completers_over_time <- National_Supply %>%
filter(Year >= 2014, Year <= 2024) %>%
group_by(State, Year) %>%
summarise(total_completers = sum(Program_Completers, na.rm = TRUE)) %>%
ungroup()## `summarise()` has grouped output by 'State'. You can override using the
## `.groups` argument.ui_spaghetti <- fluidPage(
titlePanel("Program Completers Over Time by State (2014–2024)"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "selected_states",
label = "Select State(s):",
choices = unique(completers_over_time$State),
selected = unique(completers_over_time$State),
multiple = TRUE
)
),
mainPanel(
plotOutput("linePlot", height = "600px")
)
)
)
server_spaghetti <- function(input, output) {
observe({
updateSelectInput(
session,
inputId = "selected_states",
choices = unique(completers_over_time$State),
selected = unique(completers_over_time$State)
)
})
filtered_data <- reactive({
req(input$selected_states)
completers_over_time <- National_Supply %>%
filter(Year >= 2014, Year <= 2024) %>%
group_by(State, Year) %>%
summarise(total_completers = sum(Program_Completers, na.rm = TRUE)) %>%
ungroup()
completers_over_time %>%
filter(State %in% input$selected_states)
})
output$linePlot <- renderPlot({
p2<-ggplot(filtered_data(), aes(x = Year, y = total_completers, group = State, color = State)) +
geom_line(alpha = 0.7, size = 1) +
scale_color_viridis_d(option = "turbo") +
labs(
title = "Program Completers Over Time by State (2014–2024)",
x = "Year",
y = "Total Program Completers"
) +
theme_minimal() +
theme(legend.position = "right")
ggplotly(p2)
})
}
shinyApp(ui = ui_spaghetti, server = server_spaghetti)Shiny applications not supported in static R Markdown documents
#this is a animated shiny plot of program completers over time by state (hopefully)
ui <- fluidPage(
titlePanel("Program Completers Over Time by State (2014–2024)"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "selected_states",
label = "Select State(s):",
choices = unique(completers_over_time$State),
selected = unique(completers_over_time$State),
multiple = TRUE
)
),
mainPanel(
plotlyOutput("animatedPlot", height = "600px")
)
)
)
server <- function(input, output, session) {
filtered_data <- reactive({
req(input$selected_states)
completers_over_time %>%
filter(State %in% input$selected_states)
})
output$animatedPlot <- renderPlotly({
df <- filtered_data()
# Base plot: show full historical lines (the trail)
base <- plot_ly(
df,
x = ~Year, y = ~total_completers, color = ~State,
type = 'scatter', mode = 'lines',
line = list(width = 1),
hoverinfo = 'none',
showlegend = FALSE
)
# Animated dot: shows current year (moves through time)
animated <- plot_ly(
df,
x = ~Year, y = ~total_completers, color = ~State,
frame = ~Year,
type = 'scatter', mode = 'markers',
marker = list(size = 10, opacity = 0.8),
hoverinfo = 'text',
text = ~paste("State:", State,
"<br>Year:", Year,
"<br>Completers:", total_completers)
)
# Combine layers
subplot(base, animated) %>%
layout(
title = "Program Completers Over Time by State (with Trails)",
xaxis = list(title = "Year"),
yaxis = list(title = "Total Program Completers"),
legend = list(title = list(text = "<b>State</b>"))
) %>%
animation_opts(frame = 1000, transition = 300, redraw = FALSE) %>%
animation_slider(currentvalue = list(prefix = "Year: "))
})
}
shinyApp(ui, server)Shiny applications not supported in static R Markdown documents