diff --git a/.github/workflows/r-cmd-check.yml b/.github/workflows/r-cmd-check.yml
index 07e996d..dd153fc 100644
--- a/.github/workflows/r-cmd-check.yml
+++ b/.github/workflows/r-cmd-check.yml
@@ -4,7 +4,7 @@ on:
push:
branches: [main]
pull_request:
- branches: [main] # Added to also run tests on PRs
+ branches: [main]
jobs:
test:
@@ -19,18 +19,15 @@ jobs:
with:
r-version: 'release'
- - name: Install additional dependencies
+ - name: Install dependencies
run: |
if [ -f "install_dependencies.R" ]; then
Rscript install_dependencies.R
else
echo "No install_dependencies.R found, skipping..."
fi
+ Rscript -e 'if (!requireNamespace("testthat", quietly = TRUE)) install.packages("testthat")'
- name: Run tests with testthat
run: |
- Rscript -e '
- if (!require("testthat")) install.packages("testthat")
- library(testthat)
- results <- test_dir("tests/testthat", reporter = "summary")
- if (!all(results)) stop("Some tests failed.")'
+ Rscript -e 'library(testthat); test_dir("tests/testthat", reporter = "summary")'
diff --git a/app/app.R b/app/app.R
index c34a907..c9a1701 100644
--- a/app/app.R
+++ b/app/app.R
@@ -8,35 +8,28 @@ library(jsonlite)
library(dplyr)
library(flexdashboard)
library(lubridate)
-# Render the line plot showing the trend of Risk over Date
+library(tigris) # For county data
+library(sf) # For handling spatial data
library(gridExtra)
+library(plotly)
source("functions/stations.R")
source("functions/logic.R")
source("functions/auxiliar_functions.R")
-station_choices <- c("All" = "all", setNames(names(stations), sapply(stations, function(station) station$name)))
+station_choices <- c("All" = "all", setNames(names(stations),
+ sapply(stations, function(station) station$name)))
+
+# Load county data for Wisconsin
+county_boundaries <- counties(state = "WI", cb = TRUE, class = "sf")
# Define UI
ui <- dashboardPage(
- title = "Tarspot Forecasting App (Beta)",
+ title = "Tar Spot Forecasting App (Beta)",
dashboardHeader(
+ title = "Tar Spot Forecasting App (Beta)",
titleWidth = 450
- ) |> tagAppendChild(
- div(
- "Tarspot Forecasting App (Beta)",
- style = "
- display: block;
- font-size: 1.5em;
- margin-block-start: 0.5em;
- font-weight: bold;
- color: white;
- margin-right: auto; # Center or align as needed
- text-align: center;", # Ensure the text aligns properly
- align = "center" # Change alignment if needed
- ),
- .cssSelector = "nav"
),
dashboardSidebar(
@@ -44,8 +37,6 @@ ui <- dashboardPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://fonts.googleapis.com/css2?family=Public+Sans:wght@400;600;700&display=swap")
),
-
- # Custom CSS for controlling appearance
tags$style(HTML("
.box {
padding: 10px;
@@ -54,22 +45,22 @@ ui <- dashboardPage(
margin: 0 auto;
}
.leaflet-container {
- height: 500px !important; # Ensure map height fits the layout
+ height: 500px !important;
}
")),
-
sidebarMenu(
- h2(strong(HTML(" Settings")), style = "font-size:18px;"),
- selectInput("custom_station_code", "Please Select an Station",
+ #h2(strong(HTML(" Settings")), style = "font-size:18px;"),
+ sliderInput("risk_threshold", "Action Threshold (%)",
+ min = 20, max = 50, value = 35, step = 1),
+ menuItem(textOutput("current_date"), icon = icon("calendar-day")),
+ selectInput("custom_station_code", "Please Select a Station",
choices = station_choices),
- #selectInput("custom_disease", "Please Select A Disease",
- # choices = c("Tarspot","Gray Leaf Spot")),
checkboxInput("fungicide_applied", "No Fungicide in the last 14 days?", value = FALSE),
checkboxInput("crop_growth_stage", "Growth stage within V10-R3?", value = FALSE),
- sliderInput("risk_threshold", "Set Risk Threshold (%)",
- min = 20, max = 50, value = 35, step = 1),
tags$p("Note: Weather plots may have a short delay.", style = "color: gray; font-style: italic; font-size: 12px;")
+ # Note and today's date as menu items
+ #menuItem(text = "Note: Weather plots may have a short delay.", icon = icon("info-circle")),
)
),
@@ -86,12 +77,11 @@ ui <- dashboardPage(
font-weight: bold;
margin-bottom: 10px;
margin-left: 20px;
- padding: 10px; /* Adds space inside the box */
- border: 2px solid green; /* Adds a green border */
- border-radius: 5px; /* Rounds the corners */
- background-color: #f9f9f9; /* Light background color */
- box-shadow: 2px 2px 5px rgba(0, 0, 0, 0.1); /* Adds a subtle shadow */
- "
+ padding: 10px;
+ border: 2px solid green;
+ border-radius: 5px;
+ background-color: #f9f9f9;
+ box-shadow: 2px 2px 5px rgba(0, 0, 0, 0.1);"
)
),
box(
@@ -100,21 +90,20 @@ ui <- dashboardPage(
)
),
fluidRow(
- # Show the Risk trend plot conditionally
conditionalPanel(
condition = "input.custom_station_code != 'all' && input.fungicide_applied && input.crop_growth_stage",
box(
- h2(strong("Tarspot Risk in the last 7 days"), style = "font-size:18px;"),
- plotOutput("risk_trend"), # Show the Risk trend plot here
+ h2(strong("Tar Spot Risk Trend"), style = "font-size:18px;"),
+ plotOutput("risk_trend"),
textOutput("risk_class_text"),
- width = 12 # Full width for visibility
+ width = 12
)
)
),
fluidRow(
box(
textOutput("station_info"),
- tableOutput("weather_data"), # Output to show weather data
+ tableOutput("weather_data"),
width = 12
)
)
@@ -128,68 +117,64 @@ server <- function(input, output, session) {
selected_station_data <- reactive({
station_code <- input$custom_station_code
if (station_code == "all") {
- return(stations) # Return all stations if "All" is selected
+ return(stations)
} else {
- return(list(station_code = stations[[station_code]])) # Return the selected station as a named list
+ return(list(station_code = stations[[station_code]]))
}
})
- # Fetch station weather data and risk probability when a station is selected
+ # Fetch station weather data and risk probability
weather_data <- reactive({
station_code <- input$custom_station_code
if (station_code != "all") {
station <- stations[[station_code]]
- station_name <- station$name # Get station name
- risk_threshold <- input$risk_threshold / 100 # Convert risk threshold to a percentage
+ risk_threshold <- input$risk_threshold / 100
current <- Sys.time()
today_ct <- with_tz(current, tzone = "America/Chicago")
-
- mo <- 3 # historical data in terms of num of months
+ mo <- 6
out <- from_ct_to_gmt(today_ct, mo)
-
- # Convert both dates to Unix timestamps in GMT
start_time <- out$start_time_gmt
end_time <- out$end_time_gmt
-
- # Call the API or function to get the data
- result <- call_tarspot_for_station(station_code, station_name, risk_threshold, start_time) # Fetch data
-
+ result <- call_tarspot_for_station(station_code, station$name, risk_threshold, start_time)
airtemp <- api_call_wisconet_data_daily(station_code, start_time, end_time)
- print("===========here ")
- print(result)
-
return(list(tarspot = result, airtemp = airtemp))
} else {
return(NULL)
}
})
- # Render the leaflet map
+ # Render the leaflet map with an initial layer control
output$mymap <- renderLeaflet({
- leaflet() %>%
- addTiles() %>%
- setView(lng = -89.75, lat = 44.76, zoom = 6) # Default map view over Wisconsin
+ leaflet() %>%
+ addTiles() %>%
+ setView(lng = -89.75, lat = 44.76, zoom = 6) %>%
+ addPolygons(
+ data = county_boundaries,
+ color = "darkgreen",
+ weight = 1,
+ opacity = 1,
+ fillOpacity = 0.2,
+ fillColor = "lightpink",
+ group = "County Boundaries",
+ popup = ~NAME
+ ) %>%
+ addLayersControl(
+ overlayGroups = c("County Boundaries"),
+ options = layersControlOptions(collapsed = TRUE)
+ )
})
- # Update the map based on the selected station(s)
+ output$current_date <- renderText({
+ paste("Today’s Date:", Sys.Date())
+ })
+
+ # Update map based on selected station
observe({
station_data <- selected_station_data()
- selected_station <- input$selected_station #
-
- leafletProxy("mymap") %>% clearMarkers() #
-
- # Center on selected station
- if (!is.null(selected_station)) {
- station <- station_data[[selected_station]]
- leafletProxy("mymap") %>%
- setView(lng = station$longitude, lat = station$latitude, zoom = 3)
- }
-
-
- # Loop through each station and add a marker
+ leafletProxy("mymap") %>% clearMarkers()
for (station_code in names(station_data)) {
station <- station_data[[station_code]]
- leafletProxy("mymap") %>%
+ leafletProxy("mymap") %>%
addMarkers(lng = station$longitude, lat = station$latitude,
popup = paste0("", station$name, "
",
station$location, "
",
@@ -198,34 +183,33 @@ server <- function(input, output, session) {
}
})
- # Display station info based on the selection
output$risk_label <- renderText({
- # Ensure weather_data is not NULL
crop_fung <- input$fungicide_applied
crop_gs <- input$crop_growth_stage
if (!is.null(weather_data()) && crop_fung && crop_gs) {
- # Extract the most recent Risk_Class as a single value
- most_recent_risk <- weather_data()$tarspot %>%
- slice_max(order_by = date_day, n = 1) %>% # Get the row with the latest date
- pull(Risk_Class) %>%
- as.character() %>%
- .[1] # Ensure only one value is taken
+ # Extract the most recent risk data
+ most_recent_data <- weather_data()$tarspot %>%
+ slice_max(order_by = date_day, n = 1) # Get the row with the latest date
- # Display the most recent risk level
- paste("Current Risk Level:", most_recent_risk)
+ # Extract Risk and Risk_Class separately
+ most_recent_risk <- most_recent_data %>% pull(Risk)%>%round(2)%>%
+ as.character() %>%.[1]
+ most_recent_risk_class <- most_recent_data %>% pull(Risk_Class)%>%
+ as.character() %>%.[1]
+ # Combine Risk Class and formatted Risk into a single message
+ paste("Risk ", most_recent_risk_class, most_recent_risk, '%')
+
} else {
- NULL # Hide the output if data is missing
+ NULL
}
})
-
output$station_info <- renderText({
station_code <- input$custom_station_code
if (station_code == "all") {
return("You have selected all stations.
- Please select one to see the risk of tarspot.
- If you applied a fungicide in the last 14 days to your crop,
- we can not estimate a probability of tarspot.")
+ Please select one to see the risk of Tar Spot.
+ If you applied a fungicide in the last 14 days to your crop, we cannot estimate a probability of Tar Spot.")
} else {
station <- stations[[station_code]]
paste("You have selected", station$name, "in", station$state)
@@ -233,51 +217,40 @@ server <- function(input, output, session) {
})
output$risk_trend <- renderPlot({
- # Get the weather data
- weatheroutputs <- weather_data()
-
- # Select the columns of interest from tarspot and airtemp
+ weatheroutputs <- weather_data()
data <- weatheroutputs$tarspot
-
variables_at_rh <- weatheroutputs$airtemp
station_code <- input$custom_station_code
+ threshold<-input$risk_threshold
station <- stations[[station_code]]
- # Plot 1: Tarspot Risk Trend Plot
tarspot_plot <- NULL
if (!is.null(data)) {
df <- data %>%
- mutate(Date = ymd(date_day)) %>% # Convert date_day to Date
- dplyr::select(Date, Risk, Risk_Class)
-
+ mutate(Date = ymd(date_day)) %>%
+ select(Date, Risk, Risk_Class)
tarspot_plot <- plot_trend(df, station) +
- geom_hline(yintercept = 35, linetype = "dashed", color = "red") # Horizontal line at Risk = 35
+ geom_hline(yintercept = threshold, linetype = "dashed", color = "red")
} else {
- tarspot_plot <- ggplot() +
- ggtitle("No Tarspot Data Available") +
+ tarspot_plot <- ggplot() +
+ ggtitle("No Tar Spot Data Available") +
theme_void()
}
- # Plot 2: Weather Data (Temperature and Humidity)
weather_plot <- NULL
if (!is.null(variables_at_rh)) {
- # Example call to the function
weather_plot <- plot_weather_data(variables_at_rh, station = station)
-
- # Display the plot
- print(weather_plot)
-
} else {
- weather_plot <- ggplot() +
+ weather_plot <- ggplot() +
ggtitle("No Weather Data Available") +
theme_void()
}
- # Arrange the two plots side by side
- grid.arrange(tarspot_plot, weather_plot, ncol = 2)
+ grid.arrange(tarspot_plot#, weather_plot, ncol = 2
+ )
})
}
# Run the application
-shinyApp(ui = ui, server = server)
\ No newline at end of file
+shinyApp(ui = ui, server = server)
diff --git a/app/functions/auxiliar_functions.R b/app/functions/auxiliar_functions.R
index 193b7a3..ac51363 100644
--- a/app/functions/auxiliar_functions.R
+++ b/app/functions/auxiliar_functions.R
@@ -1,4 +1,3 @@
-# Load necessary packages
library(lubridate)
library(httr)
library(jsonlite)
@@ -103,17 +102,44 @@ plot_weather_data <- function(data, station) {
return(weather_plot)
}
-
-plot_trend <- function(df, station){
+#################### Risk trend
+plot_trend1 <- function(df, station){
ggplot(df, aes(x = Date, y = Risk)) +
geom_line(color = "#0C7BDC") +
- geom_point(color = "#FFC20A") +
+ geom_point(color = "#FFC20A", size = 4) +
geom_text(aes(label = Risk_Class),
vjust = -0.5,
color = "black") +
labs(title = paste(station$name, "Station,", station$region, "Region,", station$state),
x = "Date",
- y = "Probability of Tarspot (%)") +
- scale_y_continuous(labels = percent_format(scale = 1)) + # Formats y-axis as percentages
+ y = "Probability of Tar Spot (%)") +
+ scale_y_continuous(labels = percent_format(scale = 1),
+ breaks = seq(0, 100, by = 25)) +
theme_minimal()
+}
+
+library(ggplot2)
+library(scales)
+
+plot_trend <- function(df, station){
+ ggplot(df, aes(x = Date, y = Risk)) +
+ geom_line(color = "#0C7BDC") +
+ geom_point(color = "#FFC20A", size = 4) +
+ geom_text(aes(label = Risk_Class),
+ vjust = -0.5,
+ color = "black",
+ size = 5) +
+ labs(title = paste(station$name, "Station,", station$region, "Region,", station$state),
+ x = "Date",
+ y = "Probability of Tar Spot (%)") +
+ scale_y_continuous(labels = percent_format(scale = 1),
+ breaks = seq(0, 100, by = 25)) +
+
+ # Control x-axis date formatting and frequency
+ scale_x_date(date_breaks = "1 day", date_labels = "%d-%b") +
+
+ theme_minimal() +
+ theme(
+ axis.text.x = element_text(angle = 45, hjust = 1) # Rotate date labels for readability
+ )
}
\ No newline at end of file
diff --git a/app/rsconnect/connect.doit.wisc.edu/moros2/forecasting_tools.dcf b/app/rsconnect/connect.doit.wisc.edu/moros2/forecasting_tools.dcf
index 90894d3..090d5a0 100644
--- a/app/rsconnect/connect.doit.wisc.edu/moros2/forecasting_tools.dcf
+++ b/app/rsconnect/connect.doit.wisc.edu/moros2/forecasting_tools.dcf
@@ -5,7 +5,7 @@ account: moros2
server: connect.doit.wisc.edu
hostUrl: https://connect.doit.wisc.edu/__api__
appId: 367
-bundleId: 2400
+bundleId: 2405
url: https://connect.doit.wisc.edu/tarspot_forecasting_app/
version: 1
asMultiple: FALSE