SmartCane/r_app/experiments/utils_3.R

# utils for report 
#functions for rmarkdown file


create_RGB_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = TRUE, legend_is_portrait = FALSE, week, age, red = TRUE) {
  r <- if (red) 1 else 4  # Set r based on the value of red
  title <- if (red) paste0("RGB image of the fields") else paste0("False colour image of the fields")
  
  tm_shape(pivot_raster, unit = "m") + tm_rgb(r = r, g = 2, b = 3, max.value = 255) +
    tm_layout(main.title = title, 
              main.title.size = 1) +
    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("sub_field", size = 0.6, col = "gray") +
    tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha = 0.5)
}

create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age, legend_only = F){
  tm_shape(pivot_raster, unit = "m")+
    tm_raster(breaks =  CI_breaks, palette = "RdYlGn",legend.is.portrait = legend_is_portrait ,midpoint = NA) +
    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("sub_field", size = 1/2) +
    tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5) +tmap_options(check.and.fix = TRUE)
}

create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week_1, week_2, age){
  tm_shape(pivot_raster, unit = "m")+
    tm_raster(breaks = CI_diff_breaks, palette = "PRGn",legend.is.portrait = legend_is_portrait ,midpoint = 0, title = "CI difference") +
    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("sub_field", size = 1/2) +
    tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
}

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() %>%
  #   mutate(Age = round(Age))
  
  age <- AllPivots %>%
    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)
  
  singlePivot <- CI %>% crop(., pivotShape) %>% mask(., pivotShape)
  singlePivot_m1 <- CI_m1 %>% crop(., pivotShape) %>% mask(., pivotShape)
  singlePivot_m2 <- CI_m2 %>% crop(., pivotShape) %>% mask(., pivotShape)
  # singlePivot_m3 <- CI_m3 %>% crop(., pivotShape) %>% mask(., pivotShape)
  
  singlePivot_RGB <- RGB_raster %>% crop(., pivotShape) %>% mask(., pivotShape)
  singlePivot_false <- RGB_raster_stretch %>% crop(., pivotShape) %>% mask(., pivotShape)
  
  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()
  
  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)
  CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2,  joined_spans2, show_legend= T, legend_is_portrait =T, week = week_minus_1, age = age  -1)
  CImap <- create_CI_map(singlePivot, AllPivots2,  joined_spans2, show_legend= F, legend_is_portrait = T, week = week, age = age )
  RGBmap <- create_RGB_map(singlePivot_false, AllPivots2,  joined_spans2, show_legend= F,  week = week, age = age, red =T )
  Falsemap <- create_RGB_map(singlePivot_false, AllPivots2,  joined_spans2, show_legend= F,  week = week, age = age, red =F )
  
  
  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)
  CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2,  joined_spans2, show_legend = F, legend_is_portrait = T, week_1 = week, week_2 = week_minus_3, age = age)
  
  # tst <- tmap_arrange(CImap_m2, CImap_m1, CImap,CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
  tst <- tmap_arrange(RGBmap,Falsemap,
                      CImap_m1, CImap, 
                      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("\n")
  # cat('<h2> Pivot', pivotName, '- week', week, '-', age$Age, 'weeks after planting/harvest <h2>')
  # cat(paste("# Pivot",pivots$pivot[i],"\n"))
  print(tst)
  
}


subchunkify <- function(g, fig_height=7, fig_width=5) {
  g_deparsed <- paste0(deparse(
    function() {g}
  ), collapse = '')
  
  sub_chunk <- paste0("```{r sub_chunk_", floor(runif(1) * 10000), ", fig.height=", fig_height, ", fig.width=", fig_width, ", echo=FALSE}",
                      "\n(",
                      g_deparsed
                      , ")()",
                      "\n```
  ")
  
  cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
}

cum_ci_plot <- function(pivotName){
  
  # pivotName = "2.1"
  
  # Check if pivotName exists in the data
  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(
      subchunkify(g, fig_height=2, fig_width = 10)
    )
  } else {
    # message("PivotName '", pivotName, "'  found. Plotting normal graph.")
    data_ci <- CI_quadrant %>% filter(field %in% pivotName)
    
    
    
    data_ci2 <- data_ci  %>% mutate(CI_rate = cumulative_CI/DOY,
                                    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),
    #                                                                                max_date = max(Date),
    #                                                                                days = max_date - min_date)
    
    # Identify unique seasons
    filtered_data <- data_ci2 %>%
      group_by(season) %>%
      mutate(rank = dense_rank(desc(season))) %>%
      filter(rank <= 2) %>%
      ungroup() %>%
      dplyr::select(-rank)
    
    
    # g <- ggplot(data= data_ci2 %>% filter(season %in% unique_seasons)) +
    g <- ggplot(data= filtered_data ) +
      # 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),
           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") +
      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))
    subchunkify(g, fig_height=6, fig_width = 10)
  }
}