# WARNING - Generated by {fusen} from dev/flat_plots.Rmd: do not edit by hand # nolint: line_length_linter.

#' Log reduction matrix calculation
#' 
#' Calculate the difference of maximal log reduction achieve according to regulation 
#' @param scenario data.frame with log_reduction column obtained with simulate_treatment function
#' @param regulation data.frame regulation value to compare to simulation results
#' @importFrom formattable formattable
#' @importFrom purrr map
#' @import dplyr
#' @importFrom tidyr unnest pivot_wider
#' @return formattable 
#' 
#' @export
#' @examples
#' \donttest{
#' library(dplyr)
#' library(purrr)
#' scenario_example <- create_scenario(system.file("input_1culture_2pop.xlsx", 
#'                                                 package = "ambre"))
#'
#' scenario_exposure <- scenario_example |> mutate(
#'      volume = map(
#'          .x = config,                                         
#'          .f = ~ simulate_exposure(config = .x)))
#'
#' scenario_patho <- update_pathogen(scenario = scenario_exposure, 
#'                                   pathoName = c("Rotavirus", "Campylobacter jejuni"))
#' concentration = map(.x = scenario_patho$config,
#'                    .f= ~ simulate_inflow(.x))
#' scenario_concentration <- scenario_patho |> mutate(inflow_concentration = concentration)
#' scenario_ini_dose <- initial_dose_calculation(scenario = scenario_concentration)
#'
#' scenario_barrier <- update_treatment_scheme(scenario = scenario_ini_dose, initial_situation = TRUE)
#'
#' scenario_barrier$config <- purrr::pmap(
#'   list(
#'     config = scenario_barrier$config,
#'     barrierID = scenario_barrier$SupplementaryProcessID,
#'     cropHeight = scenario_barrier$CropHeight,
#'     matrixID = scenario_barrier$MatrixID,
#'     popID = scenario_barrier$PopulationID,
#'     decay = scenario_barrier$nb_day_decay
#'   ),
#'   function(config, barrierID, cropHeight, matrixID, popID, decay) {
#'
#'     if (barrierID %in% c(24, 26, 27, 28) &&
#'         matrixID %in% c(3, 5)) {
#'
#'       update_logreduction_specific_barrier(
#'         config = config,
#'         cropHeight = cropHeight,
#'         barrierID = barrierID
#'       )
#'
#'     } else if (barrierID %in% c(12)) {
#'
#'       update_logreduction_decay(
#'         config = config,
#'         cropHeight = cropHeight,
#'         barrierID = barrierID,
#'         popID = popID,
#'         nb_day_decay = decay
#'       )
#'
#'     } else if (barrierID %in% c(9,13,14,15,16,17,18,24,26,27,28)) {
#'
#'       update_logreduction_path(
#'         config = config,
#'         matrixID = matrixID,
#'         barrierID = barrierID,
#'         popID = popID
#'       )
#'
#'     } else {
#'       config
#'     }
#'   }
#' )
#'   
#' scenario_logreduction <- scenario_barrier |> 
#'     mutate(log_reduction = map(config, simulate_treatment))
#'   
#'
#' regulation_reduction <- config_ambre$regulation$regulation_value |> 
#'   dplyr::filter(Country == "France") |>
#'   dplyr::select(-c(Concentration, Country, RegulationID))
#'
#' regulation_matrix_log(scenario = scenario_logreduction,
#'                       regulation = regulation_reduction)
#' }
regulation_matrix_log <- function(scenario, regulation){
  
  if (!"log_reduction" %in% names(scenario)) {
  stop("The log_reduction column is missing from the scenario object; run simulate_treatment function to create it")
  }
  
  total_logreduction_regulation <- map(
    scenario$log_reduction,
    ~ .x$events_long |>
        filter(TreatmentID %in% 1:7) |>
        group_by(repeatID, eventID, PathogenGroup) |>
        summarise(total_logreduction = round(sum(logreduction),0), .groups = "drop")
  )
    
  scenario$log_reduction_regulation <- total_logreduction_regulation
  
  
  regulation_evaluation <- map2(.x= scenario$inflow_concentration, 
                                .y = scenario$log_reduction_regulation,
                                .f= ~left_join(.x$events, .y, by = c("repeatID", "eventID", "PathogenGroup")) |>
                          mutate(effluent = 10^(log10(inflow) - total_logreduction))
                          )
    
  
  scenario$regulation <- regulation_evaluation  
  

  abattement_total <- scenario |> select(CropName, regulation)
  reduction_achieve <- map(
    abattement_total$regulation,
    ~ .x |>
      group_by(PathogenGroup) |>
      summarise(
        max_logreduction = round(max(total_logreduction, na.rm = TRUE),0),
        .groups = "drop"
      )
  )
  pathogen_group <- map(.x = reduction_achieve, .f = ~.x$PathogenGroup)
  logreduc <- map(.x = reduction_achieve, .f = ~.x$max_logreduction)
  
  abattement_total$PathogenGroup <- pathogen_group
  abattement_total$reduction_achieve <- logreduc
  
  abattement <- abattement_total |> select(-regulation) |> unnest(c(PathogenGroup, reduction_achieve))
  
  
  abattement_class <- abattement |> 
    left_join(config_ambre$regulation$regulation_crop, by = "CropName")
  
  
  abattement_total_class_regulation <- abattement_class |> 
    left_join(regulation, by= c("Class","PathogenGroup")) |>
    unique() |>
    rename(reduction_regulation = Reduction) |>
    rename(target_class = Class)|>
                          mutate(color = case_when(
                                            reduction_regulation > reduction_achieve ~ "#e74c3c",
                                            reduction_regulation <= reduction_achieve ~ "#2ecc71",   # vert clair
                                             TRUE         ~ "#bdbdbd"
                                          ))
  tableau_valeur <- abattement_total_class_regulation |>
    select(CropName, PathogenGroup, reduction_achieve, target_class) |>
    rename("Crop name" = CropName) |> 
    rename("Target water class" = target_class) |>
    pivot_wider(names_from=PathogenGroup, values_from = reduction_achieve)
  
  tableau_couleur <- abattement_total_class_regulation |>
    rename("Crop name" = CropName) |> 
    rename("Target water class" = target_class) |>
    select("Crop name", "PathogenGroup", "color", "Target water class") |>
    pivot_wider(names_from=PathogenGroup, values_from = color)
  
  tableau_name <- tableau_valeur |> select(-c("Crop name", "Target water class"))
  colonnes_pathogenes <- names(tableau_name)
   
  liste_formats <- setNames(
    lapply(colonnes_pathogenes, function(col) {
      format_color(tableau_couleur[[col]])
    }),
    colonnes_pathogenes
  )
  
  table <- formattable(tableau_valeur, liste_formats)
  return(table)
    
}
