Skip to content

Commit

Permalink
ADD test
Browse files Browse the repository at this point in the history
  • Loading branch information
@mariaob1201
mariaob1201 committed Nov 5, 2024
1 parent f797c42 commit 51b9874
Show file tree
Hide file tree
Showing 4 changed files with 120 additions and 124 deletions.
11 changes: 4 additions & 7 deletions .github/workflows/r-cmd-check.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ on:
push:
branches: [main]
pull_request:
branches: [main] # Added to also run tests on PRs
branches: [main]

jobs:
test:
Expand All @@ -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")'
193 changes: 83 additions & 110 deletions app/app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,44 +8,35 @@ 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(
width = 450,
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;
Expand All @@ -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("&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Settings")), style = "font-size:18px;"),
selectInput("custom_station_code", "Please Select an Station",
#h2(strong(HTML("&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;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")),
)
),

Expand All @@ -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(
Expand All @@ -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
)
)
Expand All @@ -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("<strong>", station$name, "</strong><br>",
station$location, "<br>",
Expand All @@ -198,86 +183,74 @@ 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)
}
})

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)
shinyApp(ui = ui, server = server)
Loading

0 comments on commit 51b9874

Please sign in to comment.