This commit is contained in:
Martin Folkerts 2024-09-17 14:56:33 +02:00
parent 22222990b6
commit 056b8dd67b
3 changed files with 22 additions and 13 deletions

Binary file not shown.

View file

@ -17,11 +17,15 @@ if (!is.character(project_dir)) {
source("parameters_project.R") source("parameters_project.R")
source("ci_extraction_utils.R") source("ci_extraction_utils.R")
# Check if the file exists
pivot_stats2 <- readRDS(here(cumulative_CI_vals_dir,"combined_CI_data.rds")) %>% file_path <- here(cumulative_CI_vals_dir, "combined_CI_data.rds")
pivot_stats2 <- data.frame()
if (file.exists(file_path)) {
pivot_stats2 <- readRDS(file_path) %>%
ungroup() %>% ungroup() %>%
group_by(field, sub_field) %>% group_by(field, sub_field) %>%
summarise(across(everything(), ~ first(na.omit(.))), .groups = "drop") summarise(across(everything(), ~ first(na.omit(.))), .groups = "drop")
}
#%>% drop_na(pivot_quadrant) #%>% drop_na(pivot_quadrant)
@ -61,7 +65,6 @@ extract_CI_data <- function(field_names, harvesting_data, field_CI_data, season)
ApproxFun <- approxfun(x = filtered_field_CI_data$Date, y = filtered_field_CI_data$value) ApproxFun <- approxfun(x = filtered_field_CI_data$Date, y = filtered_field_CI_data$value)
Dates <- seq.Date(ymd(min(filtered_field_CI_data$Date)), ymd(max(filtered_field_CI_data$Date)), by = 1) Dates <- seq.Date(ymd(min(filtered_field_CI_data$Date)), ymd(max(filtered_field_CI_data$Date)), by = 1)
LinearFit <- ApproxFun(Dates) LinearFit <- ApproxFun(Dates)
# Combine interpolated data with the original CI data # Combine interpolated data with the original CI data
CI <- data.frame(Date = Dates, FitData = LinearFit) %>% CI <- data.frame(Date = Dates, FitData = LinearFit) %>%
left_join(., filtered_field_CI_data, by = "Date") %>% left_join(., filtered_field_CI_data, by = "Date") %>%
@ -97,19 +100,20 @@ CI_all <- map_df(years, function(yr) {
# Filter sub_fields to only include those with value data in pivot_stats_long # Filter sub_fields to only include those with value data in pivot_stats_long
valid_sub_fields <- sub_fields %>% valid_sub_fields <- sub_fields %>%
keep(~ any(pivot_stats_long$sub_field == .x)) keep(~ any(pivot_stats_long$sub_field == .x))
# Extract data for each valid field # Extract data for each valid field
map(valid_sub_fields, ~ extract_CI_data(.x, harvesting_data = harvesting_data, field_CI_data = pivot_stats_long, season = yr)) %>% map(valid_sub_fields, ~ extract_CI_data(.x, harvesting_data = harvesting_data, field_CI_data = pivot_stats_long, season = yr)) %>%
list_rbind() list_rbind()
}) })
CI_all <- CI_all %>% group_by(model) %>% mutate(CI_per_day = FitData - lag(FitData), # it will crash here if CI_all is empty and will not overwrite the rds rendering growth_model.R useless
cumulative_CI = cumsum(FitData)) # if(nrow(CI_all) > 0){
CI_all <- CI_all %>%
group_by(model) %>%
mutate(CI_per_day = FitData - lag(FitData), cumulative_CI = cumsum(FitData))
# }
message('CI_all cumulative') message('CI_all cumulative')
head(CI_all)
message('show head') message('show head')
saveRDS(CI_all, here(cumulative_CI_vals_dir,"All_pivots_Cumulative_CI_quadrant_year_v2.rds")) saveRDS(CI_all, here(cumulative_CI_vals_dir,"All_pivots_Cumulative_CI_quadrant_year_v2.rds"))

View file

@ -18,6 +18,7 @@ daily_vrt <- here(data_dir, "vrt")
harvest_dir <- here(data_dir, "HarvestData") harvest_dir <- here(data_dir, "HarvestData")
dir.create(here(laravel_storage_dir), showWarnings = FALSE) dir.create(here(laravel_storage_dir), showWarnings = FALSE)
dir.create(here(reports_dir), showWarnings = FALSE)
dir.create(here(data_dir), showWarnings = FALSE) dir.create(here(data_dir), showWarnings = FALSE)
dir.create(here(log_dir), showWarnings = FALSE) dir.create(here(log_dir), showWarnings = FALSE)
dir.create(here(extracted_CI_dir), showWarnings = FALSE) dir.create(here(extracted_CI_dir), showWarnings = FALSE)
@ -68,3 +69,7 @@ log_file <- here(log_dir, paste0(format(Sys.Date(), "%Y%m%d"), ".log"))
log_message <- function(message) { log_message <- function(message) {
cat(message, "\n", file = log_file, append = TRUE) cat(message, "\n", file = log_file, append = TRUE)
} }
log_head <- function(list) {
log_message(paste(capture.output(str(head(AllPivots0))), collapse = "\n"))
}