This commit is contained in:
Martin Folkerts 2024-03-11 10:36:47 +01:00
parent f7d660356c
commit 25715ddef6

View file

@ -49,6 +49,7 @@ library(CAST)
laravel_storage_dir <- here("laravel_app/storage/app/",params$data_dir) laravel_storage_dir <- here("laravel_app/storage/app/",params$data_dir)
data_dir_project <- here(laravel_storage_dir, "Data") data_dir_project <- here(laravel_storage_dir, "Data")
message('DATA_DIR',data_dir_project)
extracted_CI_dir <- here(data_dir_project, "extracted_ci") extracted_CI_dir <- here(data_dir_project, "extracted_ci")
daily_CI_vals_dir <- here(extracted_CI_dir, "daily_vals") daily_CI_vals_dir <- here(extracted_CI_dir, "daily_vals")
cumulative_CI_vals_dir <- here(extracted_CI_dir, "cumulative_vals") cumulative_CI_vals_dir <- here(extracted_CI_dir, "cumulative_vals")
@ -119,20 +120,17 @@ last_week_dif_raster_abs <- (CI - CI_m1)
three_week_dif_raster_abs <- (CI - CI_m3) three_week_dif_raster_abs <- (CI - CI_m3)
AllPivots0 <-st_read(here(data_dir_project, "pivot.geojson")) AllPivots0 <-st_read(here(data_dir_project, "pivot.geojson"))
AllPivots0$pivot <- factor(AllPivots0$pivot, levels = c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3")) # AllPivots0$pivot <- factor(AllPivots0$pivot, levels = c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3"))
AllPivots0
joined_spans <-st_read(here(data_dir_project, "span.geojson")) %>% st_transform(crs(AllPivots0)) joined_spans <-st_read(here(data_dir_project, "span.geojson")) %>% st_transform(crs(AllPivots0))
pivots_dates <- readRDS(here(harvest_dir, "harvest_data_new")) %>% filter( pivots_dates <- readRDS(here(harvest_dir, "harvest_data_new"))
pivot %in% c("1.1", "1.2", "1.3", "1.4", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", # pivots_dates$pivot <- factor(pivots_dates$pivot, levels = c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3"))
"1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3",
"4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3") #without 1.6
)
pivots_dates$pivot <- factor(pivots_dates$pivot, levels = c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3"))
AllPivots <- merge(AllPivots0, pivots_dates, by = "pivot_quadrant") %>% AllPivots <- merge(AllPivots0, pivots_dates, by = "pivot_quadrant") %>%
rename(pivot = pivot.x) #%>% select(-pivot.y) rename(pivot = pivot.x) #%>% select(-pivot.y)
head(AllPivots)
AllPivots_merged <- AllPivots %>% AllPivots_merged <- AllPivots %>%
group_by(pivot) %>% summarise() group_by(pivot) %>% summarise()
@ -342,7 +340,7 @@ tm_shape(RGB_raster, unit = "m") + tm_rgb(r=1, g=2, b=3, max.value = 255) +
``` ```
\newpage \newpage
```{r echo=FALSE, fig.height=7.3, fig.width=9, message=FALSE, warning=FALSE} ```{r ci_overzicht_kaart, echo=FALSE, fig.height=7.3, fig.width=9, message=FALSE, warning=FALSE}
tm_shape(CI, unit = "m")+ tm_shape(CI, unit = "m")+
tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf), palette = "RdYlGn", midpoint = NA,legend.is.portrait = F) + tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf), palette = "RdYlGn", midpoint = NA,legend.is.portrait = F) +
tm_layout(legend.outside = TRUE,legend.outside.position = "bottom",legend.show = T, main.title = "Overview all fields (CI)")+ tm_layout(legend.outside = TRUE,legend.outside.position = "bottom",legend.show = T, main.title = "Overview all fields (CI)")+
@ -355,7 +353,7 @@ tm_shape(CI, unit = "m")+
``` ```
\newpage \newpage
```{r echo=FALSE, fig.height=7.3, fig.width=9, message=FALSE, warning=FALSE} ```{r ci_diff_kaart, echo=FALSE, fig.height=7.3, fig.width=9, message=FALSE, warning=FALSE}
tm_shape(last_week_dif_raster_abs, unit = "m")+ tm_shape(last_week_dif_raster_abs, unit = "m")+
tm_raster(breaks = c(-3,-2,-1,0,1,2, 3), palette = "RdYlGn", midpoint = NA,legend.is.portrait = F) + tm_raster(breaks = c(-3,-2,-1,0,1,2, 3), palette = "RdYlGn", midpoint = NA,legend.is.portrait = F) +
@ -373,7 +371,7 @@ tm_shape(CI, unit = "m")+
```{r plots_ci_estate, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis'} ```{r plots_ci_estate, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis'}
# # pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17")) # # pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17"))
pivots_estate <- AllPivots_merged %>% filter(pivot %in% c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" , "6.1", "6.2", "DL1.1", "DL1.3")) %>% filter(pivot != "1.17") pivots_estate <- AllPivots_merged # %>% filter(pivot %in% c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" , "6.1", "6.2", "DL1.1", "DL1.3")) %>% filter(pivot != "1.17")
# pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17")) # pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17"))
# pivots_estate <- AllPivots_merged %>% filter(pivot %in% c("1.1", "1.2", "1.7")) %>% filter(pivot != "1.17") # pivots_estate <- AllPivots_merged %>% filter(pivot %in% c("1.1", "1.2", "1.7")) %>% filter(pivot != "1.17")
@ -385,20 +383,6 @@ walk(pivots_estate$pivot, ~ {
``` ```
# Coop fields
\newpage
```{r plots_ci_coops, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis'}
pivots_coop <- AllPivots_merged %>% filter(pivot %in% c("2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4"))
# pivots_coop <- AllPivots_merged %>% filter(pivot %in% c("2.1", "2.2"))
walk(pivots_coop$pivot, ~ {
cat("\n") # Add an empty line for better spacing
ci_plot(.x)
cum_ci_plot(.x)
})
```
```{r eval=FALSE, fig.height=10, fig.width=14, include=FALSE} ```{r eval=FALSE, fig.height=10, fig.width=14, include=FALSE}
CI_all2 <- readRDS(here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_whole_pivot_year.rds")) %>% CI_all2 <- readRDS(here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_whole_pivot_year.rds")) %>%
@ -530,7 +514,7 @@ pred_rf_2023 <- predict(model_ffs_rf, newdata=prediction_2023) %>%
``` ```
```{r echo=FALSE} ```{r yield_plaatjes, echo=FALSE}
ggplot(pred_ffs_rf, aes(y = predicted_Tcha , x = Tcha , col = pivot )) + ggplot(pred_ffs_rf, aes(y = predicted_Tcha , x = Tcha , col = pivot )) +
geom_point() +geom_abline() + geom_point() +geom_abline() +
scale_x_continuous(limits = c(50, 160))+ scale_x_continuous(limits = c(50, 160))+