Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master'

Browse source 
# Conflicts:
#	laravel_app/public/build/assets/app-a1aeed67.css
#	laravel_app/public/build/manifest.json
This commit is contained in:
guillaume91 2024-06-20 10:42:22 +02:00
parent f3b84a93e1 1e841a0aa6
commit 6d414ecc81
6 changed files with 77 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
laravel_app/public/build/assets/app-f1d6b98f.js Normal file
View file

File diff suppressed because one or more lines are too long

2
laravel_app/storage/debugbar/.gitignore vendored Normal file
View file

@ -0,0 +1,2 @@
*
!.gitignore

4
python_app/planet_download.ipynb
View file

@ -179,7 +179,7 @@
" function setup() {\n",
" return {\n",
" input: [{\n",
" bands: [\"Red\", \"Green\", \"Blue\", \"NIR\", \"UDM2_Clear\"]\n",
" bands: [\"Red\", \"Green\", \"Blue\", \"NIR\", \"udm1\"]\n",
" }],\n",
" output: {\n",
" bands: 4 \n",
@ -199,7 +199,7 @@
" // var CI = [scaledNIR / scaledGreen - 1] ;\n",
"\n",
"// Output the scaled bands and CI\n",
" if (sample.UDM2_Clear != 0) { \n",
" if (sample.udm1 == 0) { \n",
" return [\n",
" scaledRed,\n",
" scaledGreen,\n",

101
r_app/2_CI_data_prep.R
View file

@ -11,6 +11,7 @@ library(terra)
library(tidyverse)
library(lubridate)
library(exactextractr)
library(readxl)
#funcion CI_prep package
date_list <- function(weeks_in_the_paste){
@ -87,10 +88,10 @@ extract_CI_data <- function(field_names, harvesting_data, field_CI_data, season)
# season= 2021
filtered_harvesting_data <- harvesting_data %>%
filter(Year == season, Field %in% field_names)
filter(year == season, field %in% field_names)
filtered_field_CI_data <- field_CI_data %>%
filter(Field %in% field_names)
filter(field %in% field_names)
# CI <- map_df(field_names, ~ {
ApproxFun <- approxfun(x = filtered_field_CI_data$Date, y = filtered_field_CI_data$value)
@ -99,11 +100,11 @@ extract_CI_data <- function(field_names, harvesting_data, field_CI_data, season)
CI <- data.frame(Date = Dates, FitData = LinearFit) %>%
left_join(., filtered_field_CI_data, by = "Date") %>%
filter(Date > filtered_harvesting_data$Season_start & Date < filtered_harvesting_data$Season_end) %>%
filter(Date > filtered_harvesting_data$season_start & Date < filtered_harvesting_data$season_end) %>%
mutate(DOY = seq(1, n(), 1),
model = paste0("Data", season, " : ", field_names),
season = season,
Field = field_names)
field = field_names)
# }) #%>%
#{if (length(field_names) > 0) message("Done!")}
@ -227,14 +228,14 @@ CI_long <- function(field_CI_values, pivot_long_cols){
drop_na(c("value","Date")) %>%
mutate(value = as.numeric(value))%>%
filter_all(all_vars(!is.infinite(.)))%>%
rename(Field = pivot_quadrant)
rename(field = pivot_quadrant)
return(field_CI_long)
}
process_year_data <- function(year, harvest_data, field_CI_long) {
pivots_dates_year <- harvest_data %>% na.omit() %>% filter(Year == year)
pivot_select_model_year <- unique(pivots_dates_year$Field)
pivots_dates_year <- harvest_data %>% na.omit() %>% filter(year == year)
pivot_select_model_year <- unique(pivots_dates_year$field)
data <- map_dfr(pivot_select_model_year, ~ extract_CI_data(.x, harvest_data, field_CI_long, season = year))
@ -301,7 +302,7 @@ create_RGB_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
tm_scale_bar(position = c("right", "top"), text.color = "black") +
tm_compass(position = c("right", "top"), text.color = "black") +
tm_shape(pivot_shape) + tm_borders(col = "gray") +
tm_text("subField", size = 0.6, col = "gray") +
tm_text("sub_field", size = 0.6, col = "gray") +
tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha = 0.5)
}
@ -311,7 +312,7 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks old"),
main.title.size = 1, legend.show = show_legend, legend.only = legend_only) +
tm_shape(pivot_shape) +
tm_borders(lwd = 3) + tm_text("subField", size = 1/2) +
tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5) +tmap_options(check.and.fix = TRUE)
}
@ -321,7 +322,7 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
tm_layout(main.title = paste0("CI change week ", week_1, "- week ",week_2, "\n", age," weeks old"),
main.title.size = 1, legend.show = show_legend) +
tm_shape(pivot_shape) +
tm_borders(lwd = 3) + tm_text("subField", size = 1/2) +
tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
}
@ -329,16 +330,16 @@ ci_plot <- function(pivotName){
# pivotName = "MV2B09"
# pivotName = "1.1"
pivotShape <- AllPivots_merged %>% terra::subset(Field %in% pivotName) %>% st_transform(crs(CI))
# age <- AllPivots %>% dplyr::filter(Field %in% pivotName) %>% st_drop_geometry() %>% dplyr::select(Age) %>% unique() %>%
pivotShape <- AllPivots_merged %>% terra::subset(field %in% pivotName) %>% st_transform(crs(CI))
# age <- AllPivots %>% dplyr::filter(field %in% pivotName) %>% st_drop_geometry() %>% dplyr::select(Age) %>% unique() %>%
# mutate(Age = round(Age))
age <- AllPivots %>%
group_by(Field) %>%
filter(Season == max(Season, na.rm = TRUE), Field %in% pivotName) %>%
group_by(field) %>%
filter(Season == max(Season, na.rm = TRUE), field %in% pivotName) %>%
dplyr::select(Age)%>% st_drop_geometry() %>% unique()
AllPivots2 <- AllPivots0 %>% dplyr::filter(Field %in% pivotName)
AllPivots2 <- AllPivots0 %>% dplyr::filter(field %in% pivotName)
singlePivot <- CI %>% crop(., pivotShape) %>% mask(., pivotShape)
singlePivot_m1 <- CI_m1 %>% crop(., pivotShape) %>% mask(., pivotShape)
@ -351,9 +352,9 @@ ci_plot <- function(pivotName){
abs_CI_last_week <- last_week_dif_raster_abs %>% crop(., pivotShape) %>% mask(., pivotShape)
abs_CI_three_week <- three_week_dif_raster_abs %>% crop(., pivotShape) %>% mask(., pivotShape)
# planting_date <- harvesting_data %>% dplyr::filter(Field %in% pivotName) %>% ungroup() %>% dplyr::select(planting_date) %>% unique()
# planting_date <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% ungroup() %>% dplyr::select(planting_date) %>% unique()
joined_spans2 <- joined_spans %>% st_transform(crs(pivotShape)) %>% dplyr::filter(Field %in% pivotName) %>% st_crop(., pivotShape)
joined_spans2 <- joined_spans %>% st_transform(crs(pivotShape)) %>% dplyr::filter(field %in% pivotName) %>% st_crop(., pivotShape)
# CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, show_legend= T, legend_is_portrait = T, week = week_minus_2, age = age -2)
Legend_map <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, show_legend= T, legend_is_portrait =T, week = week_minus_1, age = age -1, legend_only = T)
@ -372,7 +373,7 @@ ci_plot <- function(pivotName){
CI_max_abs_last_week, CI_max_abs_three_week,
ncol = 2)
cat(paste("## Field", pivotName, "-", age$Age[1], "weeks after planting/harvest", "\n"))
cat(paste("## field", pivotName, "-", age$Age[1], "weeks after planting/harvest", "\n"))
# cat("\n")
# cat('<h2> Pivot', pivotName, '- week', week, '-', age$Age, 'weeks after planting/harvest <h2>')
# cat(paste("# Pivot",pivots$pivot[i],"\n"))
@ -401,7 +402,7 @@ cum_ci_plot <- function(pivotName){
# pivotName = "2.1"
# Check if pivotName exists in the data
if (!pivotName %in% unique(CI_quadrant$Field)) {
if (!pivotName %in% unique(CI_quadrant$field)) {
# message("PivotName '", pivotName, "' not found. Plotting empty graph.")
g <- ggplot() + labs(title = "Empty Graph - Yield dates missing")
return(
@ -409,12 +410,12 @@ cum_ci_plot <- function(pivotName){
)
} else {
# message("PivotName '", pivotName, "' found. Plotting normal graph.")
data_ci <- CI_quadrant %>% filter(Field %in% pivotName)
data_ci <- CI_quadrant %>% filter(field %in% pivotName)
data_ci2 <- data_ci %>% mutate(CI_rate = cumulative_CI/DOY,
week = week(Date))%>% group_by(subField) %>%
week = week(Date))%>% group_by(sub_field) %>%
mutate(mean_rolling10 = rollapplyr(CI_rate , width = 10, FUN = mean, partial = TRUE))
# date_preperation_perfect_pivot <- data_ci2 %>% group_by(season) %>% summarise(min_date = min(Date),
@ -432,11 +433,11 @@ cum_ci_plot <- function(pivotName){
# g <- ggplot(data= data_ci2 %>% filter(season %in% unique_seasons)) +
g <- ggplot(data= filtered_data ) +
# geom_line(aes(Date, mean_rolling10, col = subField)) +
geom_line(aes(Date, CI_rate, col = subField)) +
# geom_line(aes(Date, mean_rolling10, col = sub_field)) +
geom_line(aes(Date, CI_rate, col = sub_field)) +
facet_wrap(~season, scales = "free_x") +
# geom_line(data= perfect_pivot, aes(Date , mean_rolling10, col = "Model CI (p5.1 Data 2022, \n date x axis is fictive)"), lty="11",size=1) +
labs(title = paste("CI rate - Field", pivotName),
labs(title = paste("CI rate - field", pivotName),
y = "CI rate (cumulative CI / Age)")+
# scale_y_continuous(limits=c(0.5,3), breaks = seq(0.5, 3, 0.5))+
scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y") +
@ -704,29 +705,21 @@ raster_files_NEW <- list.files(merged_final,full.names = T, pattern = ".tif")
# separate(Year, into = c("name", "Year"), sep = "(?<=season_start|season_end)\\_", remove = FALSE) %>%
# mutate(name = str_to_title(name)) %>%
# pivot_wider(names_from = name, values_from = value) %>%
# rename(Field = pivot_quadrant)
# rename(field = pivot_quadrant)
#If run for the firsttime, it will extract all data since the start and put into a table.rds. otherwise it will only add on to the existing table.
if (new_project_question == TRUE) {
print("combined_CI_data.rds does not exist. Preparing combined_CI_data.rds file for all available images.")
walk(raster_files_NEW, extract_rasters_daily, field_geojson= field_boundaries, quadrants = F, daily_CI_vals_dir)
# Define the path to the file
file_path <- here(cumulative_CI_vals_dir,"combined_CI_data.rds")
extracted_values <- list.files(here(daily_CI_vals_dir), full.names = TRUE)
# Check if the file exists
if (!file.exists(file_path)) {
# Create the file with columns "column1" and "column2"
data <- data.frame(sub_field=NA, field=NA)
saveRDS(data, file_path)
}
pivot_stats <- extracted_values %>%
map(readRDS) %>% list_rbind() %>%
group_by(subField) %>%
summarise(across(everything(), ~ first(na.omit(.))))
saveRDS(pivot_stats, here(cumulative_CI_vals_dir,"combined_CI_data.rds")) #used to save the rest of the data into one file
pivot_stats2 <- pivot_stats
print("All CI values extracted from all historic images")
} else {
print("combined_CI_data.rds exists, adding the latest image data to the table.")
filtered_files <- map(dates$days_filter, ~ raster_files_NEW[grepl(pattern = .x, x = raster_files_NEW)]) %>%
@ -743,7 +736,7 @@ if (new_project_question == TRUE) {
pivot_stats <- extracted_values %>%
map(readRDS) %>% list_rbind() %>%
group_by(subField) %>%
group_by(sub_field) %>%
summarise(across(everything(), ~ first(na.omit(.))))
combined_CI_data <- readRDS(here(cumulative_CI_vals_dir,"combined_CI_data.rds")) #%>% drop_na(pivot_quadrant)
@ -752,30 +745,29 @@ if (new_project_question == TRUE) {
print("All CI values extracted from latest 7 images.")
saveRDS(combined_CI_data, here(cumulative_CI_vals_dir,"combined_CI_data.rds")) #used to save the rest of the data into one file
}
# gather data into long format for easier calculation and visualisation
pivot_stats_long <- pivot_stats2 %>%
tidyr::gather("Date", value, -Field, -subField, -sub_area ) %>%
tidyr::gather("Date", value, -field, -sub_field ) %>%
mutate(Date = right(Date, 8),
Date = lubridate::ymd(Date)
) %>%
drop_na(c("value","Date")) %>%
mutate(value = as.numeric(value))%>%
filter_all(all_vars(!is.infinite(.))) %>%
# rename(Field = pivot_quadrant,
# subField = Field) %>%
# rename(field = pivot_quadrant,
# sub_field = field) %>%
unique()
# #2021
# pivot_select_model_Data_2021 <- harvesting_data %>% filter(Year == 2021) %>% pull(Field)
# pivot_select_model_Data_2021 <- harvesting_data %>% filter(Year == 2021) %>% pull(field)
#
# pivot_select_model_Data_2022 <- harvesting_data %>% filter(Year == 2022) %>% pull(Field)
# pivot_select_model_Data_2022 <- harvesting_data %>% filter(Year == 2022) %>% pull(field)
pivot_select_model_Data_2023 <- harvesting_data %>% filter(Year == 2023) %>% filter(!is.na(Season_start)) %>% pull(subField)
pivot_select_model_Data_2023 <- harvesting_data %>% filter(year == 2023) %>% filter(!is.na(season_start)) %>% pull(sub_field)
pivot_select_model_Data_2024 <- harvesting_data %>% filter(Year == 2024)%>% filter(!is.na(Season_start)) %>% pull(subField)
pivot_select_model_Data_2024 <- harvesting_data %>% filter(year == 2024)%>% filter(!is.na(season_start)) %>% pull(sub_field)
# pivots_dates_Data_2022 <- pivots_dates0 %>% filter(!is.na(season_end_2022))
# pivot_select_model_Data_2022 <- unique(pivots_dates_Data_2022$pivot_quadrant )
@ -794,10 +786,11 @@ extract_CI_data <- function(field_names, harvesting_data, field_CI_data, season)
# season= 2023
filtered_harvesting_data <- harvesting_data %>%
filter(Year == season, subField %in% field_names)
na.omit() %>%
filter(year == season, sub_field %in% field_names)
filtered_field_CI_data <- field_CI_data %>%
filter(subField %in% field_names)
filter(sub_field %in% field_names)
# CI <- map_df(field_names, ~ {
ApproxFun <- approxfun(x = filtered_field_CI_data$Date, y = filtered_field_CI_data$value)
@ -806,11 +799,11 @@ extract_CI_data <- function(field_names, harvesting_data, field_CI_data, season)
CI <- data.frame(Date = Dates, FitData = LinearFit) %>%
left_join(., filtered_field_CI_data, by = "Date") %>%
filter(Date > filtered_harvesting_data$Season_start & Date < filtered_harvesting_data$Season_end) %>%
filter(Date > filtered_harvesting_data$season_start & Date < filtered_harvesting_data$season_end) %>%
mutate(DOY = seq(1, n(), 1),
model = paste0("Data", season, " : ", field_names),
season = season,
subField = field_names)
sub_field = field_names)
# }) #%>%
#{if (length(field_names) > 0) message("Done!")}

BIN
r_app/Rplots.pdf
View file

Binary file not shown.

8
r_app/parameters_project.R
View file

@ -88,6 +88,12 @@ if(project_dir == "chemba"){
} else {
message("No yield data supplied")
field_boundaries_sf <- st_read(here(data_dir, "pivot.geojson"))
names(field_boundaries_sf) <- c("field", "sub_field", "geometry")
field_boundaries <- field_boundaries_sf %>% vect()
harvesting_data <- read_excel(here(data_dir, "harvest.xlsx"),
col_types = c("numeric", "numeric", "numeric",
"date", "date", "numeric", "text",
"numeric", "numeric"))
}