diff --git a/r_app/2_CI_data_prep.R b/r_app/2_CI_data_prep.R index 84e61bc..a3233be 100644 --- a/r_app/2_CI_data_prep.R +++ b/r_app/2_CI_data_prep.R @@ -172,7 +172,7 @@ missing_pixels_count <- layer_5_list %>% global(., fun="notNA") %>% total_pixels = total_pix_area$notNA, missing_pixels_percentage = round(100 -((notNA/total_pix_area$notNA)*100)), thres_5perc = as.integer(missing_pixels_percentage < 5), - thres_40perc = as.integer(missing_pixels_percentage < 40) + thres_40perc = as.integer(missing_pixels_percentage < 45) ) # cloud_perc_list <- freq(layer_5_list, usenames = TRUE) %>% @@ -204,7 +204,7 @@ if(sum(missing_pixels_count$thres_5perc)>1){ }else if(sum(missing_pixels_count$thres_40perc)>1){ message("More than 1 image contains clouds, composite made of <40% cloud cover images") - cloudy_rasters_list <- vrt_list[index_5perc] + cloudy_rasters_list <- vrt_list[index_40perc] rsrc <- sprc(cloudy_rasters_list) x <- mosaic(rsrc, fun = "max") @@ -213,7 +213,7 @@ if(sum(missing_pixels_count$thres_5perc)>1){ }else if(sum(missing_pixels_count$thres_40perc)==1){ message("Only 1 image available but contains clouds") - x <- rast(vrt_list[index_5perc[1]]) + x <- rast(vrt_list[index_40perc[1]]) names(x) <- c("CI") }else{ diff --git a/r_app/CI_report_dashboard_planet.Rmd b/r_app/CI_report_dashboard_planet.Rmd index 87a9743..37694fb 100644 --- a/r_app/CI_report_dashboard_planet.Rmd +++ b/r_app/CI_report_dashboard_planet.Rmd @@ -7,7 +7,7 @@ params: output: word_document: reference_docx: !expr file.path("word-styles-reference-var1.docx") - # toc: true + toc: true editor_options: chunk_output_type: console --- @@ -70,7 +70,7 @@ week <- week(today) #week = lubridate::week(Sys.time()) ## week = 26 #title_var <- paste0("CI dashboard week ", week, " - all pivots dashboard using 3x3 meter resolution") -subtitle_var <- paste("Report generated on", today) +subtitle_var <- paste("Report generated on", Sys.Date()) today_minus_1 <- as.character(ymd(today) - 7) today_minus_2 <- as.character(ymd(today) - 14) @@ -118,6 +118,9 @@ last_week_dif_raster_abs <- (CI - CI_m1) three_week_dif_raster_abs <- (CI - CI_m3) AllPivots0 <-st_read(here(data_dir, "pivot_20210625.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")) + + joined_spans <-st_read(here(data_dir, "spans2.geojson")) %>% st_transform(crs(AllPivots0)) pivots_dates <- readRDS(here(harvest_dir, "harvest_data_new")) %>% filter( @@ -125,6 +128,8 @@ pivots_dates <- readRDS(here(harvest_dir, "harvest_data_new")) %>% filter( "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") %>% rename(pivot = pivot.x) #%>% select(-pivot.y) @@ -133,9 +138,6 @@ AllPivots_merged <- AllPivots %>% AllPivots_merged <- st_transform(AllPivots_merged, crs = proj4string(CI)) -AllPivots_merged$pivot <- as.factor(AllPivots_merged$pivot) -AllPivots_merged$pivot <- ordered(AllPivots_merged$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")) - pivot_names <- unique(CI_quadrant$pivot) ``` @@ -243,7 +245,7 @@ ci_plot <- function(pivotName){ CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, show_legend= T, legend_is_portrait = T, week = week_minus_2, age = age -2) CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week_minus_1, age = age -1) - CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week_minus_1, age = age ) + CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week, age = age ) CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week,AllPivots2, joined_spans2, show_legend = T, legend_is_portrait = T, week_1 = week, week_2 = week_minus_1, age = age) @@ -280,11 +282,13 @@ cum_ci_plot <- function(pivotName){ unique_seasons <- unique(date_preperation_perfect_pivot$season) - if(length(unique_seasons) == 3) { - unique_seasons <- unique_seasons[c(2,3)] - } else { - unique_seasons <- unique_seasons - } + if(length(unique_seasons) == 3) { + unique_seasons <- unique_seasons[c(2,3)] + } else if(length(unique_seasons) == 4) { + unique_seasons <- unique_seasons[c(3,4)] + } else { + unique_seasons <- unique_seasons + } perfect_pivot <- perfect_pivot_raw @@ -307,7 +311,11 @@ cum_ci_plot <- function(pivotName){ labs(title = paste("14 day rolling MEAN CI rate - Pivot ", pivotName))+ # 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") + - theme(axis.text.x = element_text(angle = 60, hjust = 1)) + theme(axis.text.x = element_text(angle = 60, hjust = 1), + legend.justification=c(1,0), legend.position = c(1, 0), + legend.title = element_text(size = 8), + legend.text = element_text(size = 8)) + + guides(color = guide_legend(nrow = 2, byrow = TRUE)) # options(repr.plot.width = 2, repr.plot.height = 2) subchunkify(g, 3.2, 10) @@ -343,28 +351,22 @@ tm_shape(CI, unit = "m")+ tm_shape(AllPivots)+ tm_borders( col = "black") + tm_text("pivot_quadrant", size = .6, col = "black") - - -# 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_layout(legend.outside = TRUE,legend.outside.position = "bottom",legend.show = T, main.title = "Overview all fields - CI difference")+ -# tm_scale_bar(position = c("right", "top"), text.color = "black") + -# -# tm_compass(position = c("right", "top"), text.color = "black") + -# tm_shape(AllPivots)+ tm_borders( col = "black") + -# tm_text("pivot_quadrant", size = .6, col = "black") - - - -# tm_shape(last_week_dif_raster, unit = "m")+ -# tm_raster(breaks = c(-Inf,-50,-25,-5,5,25, Inf), palette = "RdYlGn", midpoint = NA,legend.is.portrait = T) + -# tm_layout(legend.outside = TRUE,legend.outside.position = "right",legend.show = F, main.title = "Overview all fields - CI difference %")+ -# tm_scale_bar(position = c("right", "top"), text.color = "black") + -# -# tm_compass(position = c("right", "top"), text.color = "black") + -# tm_shape(AllPivots)+ tm_borders( col = "black") + -# tm_text("pivot_quadrant", size = .6, col = "black") ``` +\newpage + +```{r echo=FALSE, fig.height=7.3, fig.width=9, message=FALSE, warning=FALSE} + + 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_layout(legend.outside = TRUE,legend.outside.position = "bottom",legend.show = T, main.title = "Overview all fields - CI difference")+ + tm_scale_bar(position = c("right", "top"), text.color = "black") + + + tm_compass(position = c("right", "top"), text.color = "black") + + tm_shape(AllPivots)+ tm_borders( col = "black") + + tm_text("pivot_quadrant", size = .6, col = "black") + +``` + # Estate fields \newpage diff --git a/r_app/Rplots.pdf b/r_app/Rplots.pdf index 0755b82..6b91ab7 100644 Binary files a/r_app/Rplots.pdf and b/r_app/Rplots.pdf differ