Skip to content

Commit

Permalink
Merge pull request #42 from IDEMSInternational/LC_changes
Browse files Browse the repository at this point in the history 
Changing stop to warning to allow compatibility with missing seasonal_length
  • Loading branch information
@lilyclements
lilyclements authored Oct 19, 2023
2 parents 3b7a89a + e015fae commit e1e5921
Show file tree
Hide file tree
Showing 3 changed files with 49 additions and 35 deletions.
80 changes: 47 additions & 33 deletions R/annual_rainfall_summaries.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,7 @@
annual_rainfall_summaries <- function(country, station_id, summaries = c("annual_rain", "start_rains", "end_rains", "end_season", "seasonal_rain", "seasonal_length")) {
# Get data definitions and summary definitions
data_names <- epicsadata::data_definitions(station_id = station_id)
summaries_1 <- summaries[ !summaries == 'seasonal_length']
definitions <- definitions(country = country, station_id = station_id, summaries = summaries_1)
definitions <- definitions(country = country, station_id = station_id, summaries = summaries)

# Fetch daily data and preprocess
daily <- epicsadata::get_daily_data(country = country, station_id = station_id)
Expand Down Expand Up @@ -166,31 +165,33 @@ annual_rainfall_summaries <- function(country, station_id, summaries = c("annual
warning("Missing value in seasonal_rain definitions for na_rm. Setting na_rm = FALSE")
definitions$seasonal_rain$na_rm <- FALSE
}
if ("end_season" %in% summaries) {
warning("Performing seasonal_rain with end_season")
season_rain <- rpicsa::seasonal_rain(summary_data = summary_data, start_date = "start_rains", end_date = "end_season",
daily, date_time = data_names$date, station = data_names$station, year = data_names$year, rain = data_names$rain,
total_rain = as.logical(definitions$seasonal_rain$seasonal_rain),
n_rain = as.logical(definitions$seasonal_rain$n_rain),
rain_day = definitions$seasonal_rain$rain_day,
na_rm = as.logical(definitions$seasonal_rain$na_rm),
na_prop = definitions$seasonal_rain$na_prop,
na_n = definitions$seasonal_rain$na_n,
na_consec = definitions$seasonal_rain$na_consec,
na_n_non = definitions$seasonal_rain$na_n_non)
} else if ("end_rains" %in% summaries) {
warning("Performing seasonal_rain with end_rains")
season_rain <- rpicsa::seasonal_rain(summary_data = summary_data, start_date = "start_rains", end_date = "end_rains",
daily, date_time = data_names$date, station = data_names$station, year = data_names$year, rain = data_names$rain,
total_rain = as.logical(definitions$seasonal_rain$seasonal_rain),
n_rain = as.logical(definitions$seasonal_rain$n_rain),
rain_day = definitions$seasonal_rain$rain_day,
na_rm = as.logical(definitions$seasonal_rain$na_rm),
na_prop = definitions$seasonal_rain$na_prop,
na_n = definitions$seasonal_rain$na_n,
na_consec = definitions$seasonal_rain$na_consec,
na_n_non = definitions$seasonal_rain$na_n_non)
if (is.null(definitions$seasonal_rain$end_type)){
present_values <- c("start_rains", "end_rains", "end_season") %in% summaries
if ((length(present_values[present_values]) == 3) || (identical(present_values, c(TRUE, FALSE, TRUE)))) {
warning("Performing seasonal_rain with end_season")
end_date = "end_season"
}
if (identical(present_values, c(TRUE, TRUE, FALSE))) {
end_date = "end_rains"
}
} else {
if (definitions$seasonal_rain$end_type == "rains"){
end_date = "end_rains"
} else {
end_date = "end_season"
}
}
season_rain <- rpicsa::seasonal_rain(summary_data = summary_data,
start_date = "start_rains", end_date = end_date,
daily, date_time = data_names$date, station = data_names$station,
year = data_names$year, rain = data_names$rain,
total_rain = as.logical(definitions$seasonal_rain$seasonal_rain),
n_rain = as.logical(definitions$seasonal_rain$n_rain),
rain_day = definitions$seasonal_rain$rain_day,
na_rm = as.logical(definitions$seasonal_rain$na_rm),
na_prop = definitions$seasonal_rain$na_prop,
na_n = definitions$seasonal_rain$na_n, na_consec = definitions$seasonal_rain$na_consec,
na_n_non = definitions$seasonal_rain$na_n_non)
summary_data <- dplyr::full_join(summary_data, season_rain)
} else {
stop("start_rains and at least one of end_season or end_rains is required to calculate seasonal_rain")
Expand All @@ -199,15 +200,28 @@ annual_rainfall_summaries <- function(country, station_id, summaries = c("annual

if ("seasonal_length" %in% summaries) {
if (require_start_rains && require_end_rains) {
if ("end_season" %in% summaries) {
warning("Performing seasonal_length with end_season")
season_length <- rpicsa::seasonal_length(summary_data = summary_data, start_date = "start_rains", end_date = "end_season",
data = daily, date_time = data_names$date, station = data_names$station, year = data_names$year, rain = data_names$rain)
if (is.null(definitions$seasonal_length$end_type)){
present_values <- c("start_rains", "end_rains", "end_season") %in%
summaries
if ((length(present_values[present_values]) == 3) ||
(identical(present_values, c(TRUE, FALSE, TRUE)))) {
warning("Performing seasonal_length with end_season")
end_date = "end_season"
}
if (identical(present_values, c(TRUE, TRUE, FALSE))) {
end_date = "end_rains"
}
} else {
warning("Performing seasonal_length with end_rains")
season_length <- rpicsa::seasonal_length(summary_data = summary_data, start_date = "start_rains", end_date = "end_rains",
data = daily, date_time = data_names$date, station = data_names$station, year = data_names$year, rain = data_names$rain)
if (definitions$seasonal_length$end_type == "rains"){
end_date = "end_rains"
} else {
end_date = "end_season"
}
}
season_length <- rpicsa::seasonal_length(summary_data = summary_data,
start_date = "start_rains", end_date = end_date,
data = daily, date_time = data_names$date, station = data_names$station,
year = data_names$year, rain = data_names$rain)
summary_data <- dplyr::full_join(summary_data, season_length)
} else {
stop("start_rains and at least one of end_season or end_rains is required to calculate seasonal_length")
Expand Down
2 changes: 1 addition & 1 deletion R/crop_success_probabilities.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,4 +76,4 @@ crop_success_probabilities <- function(country,
list_return[[1]] <- c(season_data[[1]], definitions)
list_return[[2]] <- summary_crops
return(list_return)
}
}
2 changes: 1 addition & 1 deletion R/definitions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ definitions <- function(country, station_id, summaries){
# are any NULL 1 = NULL
null_check <- purrr::map_dbl(.x = summaries, .f = ~ is.null(definition_data[[.x]]))
if (any(null_check == 1)){
stop(paste0("Not all summaries are defined in the json definition file: ",
warning(paste0("Not all summaries are defined in the json definition file: ",
paste(x = names(definition_data)[which(null_check == 1)], collapse = ", ")))
}
definition_data[sapply(definition_data, is.null)] <- NULL
Expand Down

0 comments on commit e1e5921

Please sign in to comment.