More french integration

NAMESPACE

@@ -20,6 +20,7 @@ export(get_cvs)
 export(get_os)
 export(mod_paths)
 export(modify_prop_female_iscam)
+export(plot_age_mat_ogives)
 export(plot_trawl_footprint)
 export(props_all)
 export(props_comm)

R/plot_age_mat_ogives.R

@@ -0,0 +1,101 @@
+#' Create a 2-panel plot (one for each sex) of maturity ogives for
+#' several different scenarios
+#'
+#' @param d A data frame created  in the document code chunk `calc-maturities`
+#'
+#' @return A [ggplot2::ggplot()] object
+#' @export
+plot_age_mat_ogives <- function(d){
+
+  female_cols <- brewer.pal(n = 8, name = "YlOrRd")
+  female_cols <- female_cols[4:7]
+  female_cols <- rev(female_cols)
+
+  male_cols <- brewer.pal(n = 9, name = "YlGnBu")
+  male_cols <- male_cols[4:8]
+  male_cols <- rev(male_cols)
+
+  plot_ogive_by_sex <- function(d,
+                                plot_sex = tr("Female"),
+                                col_vec = female_cols,
+                                ogive_size = 1.3,
+                                ogive_alpha = 0.4) {
+
+    models <- unique(d$model)
+    # Translate sex
+    d <- d |>
+      mutate(sex = tr(sex)) |>
+      mutate(age = factor(age))
+
+    p <- d |>
+      filter(sex == !!plot_sex) |>
+      ggplot() +
+      geom_point(aes(age,
+                     prop_mature,
+                     colour = model),
+                 alpha = 0.7) +
+      scale_color_manual(values = col_vec,
+                         name = "Model") +
+      ylab(tr("Proportion mature")) +
+      xlab(tr("Age")) +
+      ggtitle(plot_sex) +
+      ggsidekick::theme_sleek() +
+      theme(axis.text.x = element_text(size = 7))
+
+    add_ogive <- \(p, i){
+
+      p + geom_function(
+        data = NULL,
+        size = ogive_size,
+        alpha = ogive_alpha,
+        fun = \(x){
+          plogis(x,
+                 d[d$model == models[i] & d$sex == plot_sex, ]$age50mat[1],
+                 d[d$model == models[i] & d$sex == plot_sex, ]$sd50mat[1])
+        },
+        colour = col_vec[i],
+        inherit.aes = FALSE) +
+        geom_vline(data = NULL,
+                   size = ogive_size / 2,
+                   lty = "dashed",
+                   alpha = ogive_alpha,
+                   xintercept = d[d$model == models[i] &
+                                          d$sex == plot_sex, ]$age50mat[1],
+                   colour = col_vec[i])
+    }
+
+    for (i in seq_along(models)){
+      p <- p |>
+        add_ogive(i)
+    }
+
+    p + coord_cartesian(expand = FALSE,
+                        xlim = c(0, 26))
+  }
+
+  p1 <- plot_ogive_by_sex(d,
+                                 plot_sex = tr("Male"),
+                                 col_vec = male_cols) +
+    theme(legend.title = element_blank(),
+          axis.title.x = element_blank(),
+          legend.position = c(0.7, 0.25))
+
+  p2 <- plot_ogive_by_sex(d,
+                                 plot_sex = tr("Female"),
+                                 col_vec = female_cols) +
+    theme(axis.text.y = element_blank(),
+          axis.ticks.y = element_blank(),
+          axis.title.y = element_blank(),
+          legend.title = element_blank(),
+          axis.title.x = element_blank(),
+          legend.position = c(0.7, 0.25))
+
+  xlab <- ggplot(data.frame(l = tr("Age"), x = 13, y = 1)) +
+    geom_text(aes(x, y, label = l))+
+    theme_void()
+
+  grid.arrange(grobs = list(p1, p2),
+               ncol = 2,
+               # left = paste0(tr("Length"), " (cm)"),
+               bottom = tr("Age (years)"))
+}

R/table-prop-female.R

@@ -14,6 +14,8 @@
 #' @param format The format of table as in [knitr::kable()]
 #' @param yrs A vector of years to include in the output table. If `NULL`,
 #' all years will be included
+#' @params ret_means Logical. If `TRUE`, return a list of the gear mean values.
+#' Takes priority over `ret_df`
 #'
 #' @return A [csasdown::csas_table()]
 #' @importFrom csasdown csas_table
@@ -24,16 +26,29 @@ table_prop_female <- function(prop_lst,
                               return_df = FALSE,
                               format = "latex",
                               yrs = NULL,
+                              ret_means = FALSE,
                               ...){
 
+  ct_sym <- sym(tr("Commercial trawl"))
+  qcs_sym <- sym(tr("QCS"))
+  hs_sym <- sym(tr("HS"))
+  wcvi_sym <- sym(tr("WCVI"))
+  wchg_sym <- sym(tr("WCHG"))
+
   d <- map_df(prop_lst, ~{.x}) |>
     pivot_wider(names_from = "data_source", values_from = "prop_female") |>
     rename(Year = year,
-           `Commercial trawl` = commercial_coastwide,
-           `QCS` = qcsss,
-           `HS` = hsss,
-           `WCVI` = wcviss,
-           `WCHG` = wchgss)
+           !!ct_sym := commercial_coastwide,
+           !!qcs_sym := qcsss,
+           !!hs_sym := hsss,
+           !!wcvi_sym := wcviss,
+           !!wchg_sym := wchgss)
+
+  mean_vec <- d[-1] |> colMeans(na.rm = TRUE)
+  if(ret_means){
+    return(mean_vec)
+  }
+
   j <- bind_cols(d[, 1], map_df(d[-1], ~{f(.x, 2)}))
 
   k <- bind_cols(j[, 1], map_df(j[-1], ~{gsub("\\s*NA\\s*", "--", .x)})) |>
@@ -60,6 +75,10 @@ table_prop_female <- function(prop_lst,
   if(return_df){
     return(x)
   }
+  # Translate Year
+  x <- x |>
+    mutate(Year = tr("Year"))
+
   out <- csas_table(x,
              format = format,
              ...)
@@ -131,6 +150,30 @@ table_prop_female_weights <- function(samples = NULL,
   if(return_df){
     return(d)
   }
+  # Translate column names
+  survey_sym <- sym(tr("Survey"))
+  year_sym <- sym(tr("Year"))
+  num_trips_sym <- sym(tr("Number of trips"))
+  num_samples_sym <- sym(tr("Number of samples"))
+  num_weights_m_sym <- sym(tr("Number of weights - Male"))
+  num_weights_f_sym <- sym(tr("Number of weights - Female"))
+
+  if(type == "survey"){
+    d <- d |>
+      mutate(Survey = tr(Survey)) |>
+      rename(!!survey_sym := `Survey`,
+             !!year_sym := `Year`,
+             !!num_samples_sym := `Number of samples`,
+             !!num_weights_m_sym := `Number of weights - Male`,
+             !!num_weights_f_sym := `Number of weights - Female`)
+  }else{
+    d <- d |>
+      rename(!!year_sym := `Year`,
+             !!num_trips_sym := `Number of trips`,
+             !!num_samples_sym := `Number of samples`,
+             !!num_weights_m_sym := `Number of weights - Male`,
+             !!num_weights_f_sym := `Number of weights - Female`)
+  }
 
   tab <- csas_table(d,
                     format = "latex",