library(shiny)
library(shinydashboard)
library(leaflet)
library(plotly)
library(RColorBrewer)
library(readxl)
# Load data
d1 <- read_excel("/path/Desktop/milk.xlsx", sheet ="Data")
# Define UI for dashboard
ui <- dashboardPage(
# Application title
dashboardHeader(title = "Milk Buddy"),
# Sidebar menu
dashboardSidebar(
sidebarMenu(
# About page
menuItem("About", tabName = "about", icon = icon("info-circle")),
# Map page
menuItem("Map", tabName = "map", icon = icon("globe"))
)
),
# Application body
dashboardBody(
# Tab panels
tabItems(
# About page
tabItem(tabName = "about",
# Box to display about information
box(width = 12, status = "primary", solidHeader = TRUE, title = "About Milk Buddy",
textOutput("about_text")),
),
# Map page
tabItem(tabName = "map",
# Box to display map
box(width = 8, status = "primary", solidHeader = TRUE, title = "Milk Shortage Map",
leafletOutput("map")),
# Box to display input widgets
box(width = 4, status = "primary", solidHeader = TRUE, title = "Input",
selectInput("county", "County", choices = unique(d1$County), multiple = TRUE, selected = unique(d1$County)),
selectInput("month", "Month", choices = unique(d1$Month), multiple = TRUE, selected = unique(d1$Month)),
selectInput("shortfall", "Shortfall/No Shortfall", choices = c("Shortfall", "No Shortfall", "All"), selected = "All"),
plotlyOutput("waterfall")
)
)
)
)
)
# Define server logic
server <- function(input, output) {
# About text output
output$about_text <- renderText({
paste("The Milk Buddy app predicts monthly milk shortage by county
and provides an interactive map and data table for visualization
and download. By examining the relationship between Wisconsin's
milk production, maximum Wisconsin temperatures, and the distribution
operations of Feeding America Eastern Wisconsin (FAEW), this analysis
aims to uncover insights for FAEW food procurement and operations teams.
The app will inform strategies to optimize resource allocation, improve
equitable distribution, and minimize milk wastage.")
})
# Create map
output$map <- renderLeaflet({
# Filter data based on user input
filtered_data <- d1 %>%
filter(!is.na(MonthlyShortfall), MonthlyShortfall > 0, County %in% input$county, Month %in% input$month) %>%
filter(if (input$shortfall == "Shortfall") MonthlyShortfall > 0 else if (input$shortfall == "No Shortfall") MonthlyShortfall <= 0 else TRUE)
# Use req() to check if filtered_data is not empty
req(nrow(filtered_data) > 0)
# Create map object
map <- leaflet() %>%
# Set view to Wisconsin
setView(lng = -89.6414, lat = 43.7534, zoom = 6) %>%
# Add base map tiles
addTiles() %>%
# Add markers for each county
addCircleMarkers(
data = filtered_data,
lng = ~Longitude,
lat = ~Latitude,
radius = ~sqrt(MonthlyShortfall/1000),
color = ~colorRampPalette(c("red", "yellow", "blue"))(100)[MonthlyShortfall/max(MonthlyShortfall)],
stroke = FALSE,
fillOpacity = 0.7,
popup = ~paste("County: ", County, "<br>",
"Monthly Shortfall: ", MonthlyShortfall, "gallons")
)
# Add legend
map <- map %>%
addLegend(
position = "bottomright",
pal = palette("RdYlBu"),
values = ~MonthlyShortfall,
title = "Monthly Milk Shortfall",
labFormat = labelFormat(transform = function(x) x/1000, suffix = " thousand gallons")
)
return(map)
})
# Create waterfall chart
output$waterfall <- renderPlotly({
filtered_data <- d1 %>%
filter(!is.na(MonthlyShortfall), MonthlyShortfall > 0, County %in% input$county, Month %in% input$month) %>%
filter(if (input$shortfall == "Shortfall") MonthlyShortfall > 0 else if (input$shortfall == "No Shortfall") MonthlyShortfall <= 0 else TRUE)
# Calculate percentages for each QPR group
filtered_data <- filtered_data %>%
group_by(County, Month) %>%
mutate(TotalWeight = sum(QPR_Group_Weight),
Percentage = QPR_Group_Weight/TotalWeight*100)
if (nrow(filtered_data) > 0) {
chart <- plot_ly(data = filtered_data, x = ~County, y = ~Percentage, type = "bar",
color = ~QPR.Group, colors = c("green", "blue", "red"),
text = ~paste(QPR.Group, ": ", Percentage, "%"),
hovertemplate = paste("%{x}<br>%{y}%<extra></extra>")) %>%
layout(title = "Milk Source Distribution",
xaxis = list(title = "County"),
yaxis = list(title = "Percentage"),
barmode = "stack")
} else {
chart <- plot_ly() %>%
layout(title = "Milk Source Distribution",
xaxis = list(title = "County"),
yaxis = list(title = "Percentage"),
barmode = "stack")
}
return(chart)
})
# Create popup for map
observeEvent(input$map_shape_click, {
if (!is.null(input$map_shape_click)) {
# Get county name and month from clicked marker
county <- input$map_shape_click$properties$County
month <- input$map_shape_click$properties$Month
# Filter data for clicked county and month
filtered_data <- d1 %>%
filter(County == county, Month == month)
# Calculate percentages for each QPR group
filtered_data <- filtered_data %>%
group_by(County, Month) %>%
mutate(TotalWeight = sum(QPR_Group_Weight),
Percentage = QPR_Group_Weight/TotalWeight*100)
# Create popup content
popup_content <- paste("County: ", county, "<br>",
"Rank: ", min(rank(filtered_data$MonthlyShortfall)),
"<br>",
"Milk Source Distribution:",
"<br>",
"1-Donated: ", round(sum(filtered_data$Percentage[filtered_data$QPR.Group == "1-Donated"]), 2), "%",
"<br>",
"2-Purchased: ", round(sum(filtered_data$Percentage[filtered_data$QPR.Group == "2-Purchased"]), 2), "%",
"<br>",
"3-Federal-USD: ", round(sum(filtered_data$Percentage[filtered_data$QPR.Group == "3-Federal-USD"]), 2), "%",
"<br>",
"Max Temp: ", max(filtered_data$MaxTemp))
# Update popup for clicked marker
leafletProxy("map") %>%
clearPopups() %>%
addPopups(input$map_shape_click$lng, input$map_shape_click$lat, popup_content)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Hi everyone, I'm creating an app, everything works except the map. When I run the app, it kept saying Error in UseMethod: no applicable method for 'metaData' applied to an object of class "NULL". Could someone help me? I would really appreciate it!!