R/detections/unique_individual_station_composition.R

In d2gex/seabasstfm: What the Package Does (One Line, Title Case)

source("R/detections//input_data.R")
source("R/graph_utils.R")
library("ggVennDiagram")
#----------------------------------------------------------------------
#   Generate monthly individual detection composition heatmaps and barplots by stations
#----------------------------------------------------------------------

monthly_detections_as_list <- slide_data_by_date_interval(data,
                                                          start,
                                                          end,
                                                          granularity)
period_names <- names(monthly_detections_as_list)
hetmaps_graphs <- list()
composition_graphs <- list()
barplot_dfs <- list()
for (i in seq_along(monthly_detections_as_list)) {
  period_df <- monthly_detections_as_list[[i]]
  p_name <- period_names[[i]]
  
  # (1) Generate composition heatmap
  period_df <- period_df %>%
    select(station, ind_name) %>%
    group_by(station, ind_name) %>%
    summarise(detections = n(), .groups = "drop")
  period_df <- period_df[order(period_df$ind_name),]
  
  # heatmap_matrix_i <- prepare_heatmap_data(
  #   period_df,
  #   'detections',
  #   'station',
  #   'ind_name',
  #   month_as_name = FALSE,
  #   by_percentage = FALSE,
  #   min_row_sum = 50
  # )
  # 
  # col <- colorRamp2(c(
  #   min(heatmap_matrix_i),
  #   mean(heatmap_matrix_i),
  #   max(heatmap_matrix_i)
  # ),
  # c("green", "white", "red"))
  
  # heatmap_graph_i <- draw_interval_heatmap(
  #   heatmap_matrix_i,
  #   paste(
  #     "Individual detections by stations for",
  #     format_month_year(p_name)
  #   ),
  #   "Detections",
  #   by_col_rows_order = TRUE,
  #   font_size = 8,
  #   col = col
  # )
  # hetmaps_graphs[[i]] <- heatmap_graph_i
  
  # (2) Generate composition barplots
  
  period_df <- period_df %>%
    select(station) %>%
    group_by(station) %>%
    summarise(composition = n(), .groups = "drop")
  
  # composition_plot_i <- generate_bar_plot(
  #   period_df,
  #   'station',
  #   'composition',
  #   paste(
  #     "Number of  unique individuals mixed up at each station for",
  #     format_month_year(p_name)
  #   ),
  #   "No Unique Individuals",
  #   'Stations',
  #   "Unique Individuals",
  #   month_as_name = FALSE,
  #   show_bar_values = TRUE
  # )
  barplot_dfs[[i]] <- period_df
  # composition_graphs[[i]] <- composition_plot_i
  
}

# hetmaps_graphs <- rbind(hetmaps_graphs, composition_graphs)
# #----------------------------------------------------------------------
# #   Generate annually heatmaps with individual detections by station
# #----------------------------------------------------------------------
#
# all_periods <- monthly_detections %>%
#   select(station, ind_name) %>%
#   group_by(station, ind_name) %>%
#   summarise(detections = n(), .groups = "drop")
# all_periods <- all_periods[order(all_periods$ind_name),]
#
# heatmap_matrix_overall <- prepare_heatmap_data(
#   all_periods,
#   'detections',
#   'station',
#   'ind_name',
#   month_as_name = FALSE,
#   by_percentage = FALSE,
#   min_row_sum = 50
# )
#
# heatmap_graph_overall <- draw_interval_heatmap(
#   heatmap_matrix_overall,
#   paste("Individual detections by stations for the whole series"),
#   "Detections",
#   by_col_rows_order = TRUE,
#   font_size = 8,
#   col = col
# )
# hetmaps_graphs[[length(hetmaps_graphs) + 1]] <- heatmap_graph_overall
#
# all_periods <- all_periods %>%
#   select(station) %>%
#   group_by(station) %>%
#   summarise(composition=n(), .groups = "drop")
#
# composition_plot_all <- generate_bar_plot(
#   all_periods,
#   'station',
#   'composition',
#   "Unique individuals mixed up at each station for the whole series",
#   "No Unique Individuals",
#   'Stations',
#   "Unique Individuals",
#   month_as_name = FALSE,
#   show_bar_values = TRUE
# )
# hetmaps_graphs[[length(hetmaps_graphs) + 1]] <- composition_plot_all
#
# to_path <-
#   file.path(OUTPUT,
#             paste("monthly_unique_individual_detection_by_station", suffix, sep = ""))
#
# plots_to_pdf(hetmaps_graphs,
#              to_path,
#              paper_type,
#              paper_height,
#              paper_width)


#----------------------------------------------------------------------
#   Build unique individual grids for 2020-2021 winter
#----------------------------------------------------------------------

# all_plots <- list()
# j = 1
# for (i in 4:7) {
#   p_name <- period_names[[i]]
#   if (i > 5) {
#     show_x_axis_label = TRUE
#   }
#   else {
#     show_x_axis_label = FALSE
#   }
#   barplot_dfs [[i]] <-
#     barplot_dfs[[i]][barplot_dfs[[i]]$composition != 1,]
#   month_plot <- generate_bar_plot(
#     barplot_dfs[[i]],
#     'station',
#     'composition',
#     paste(format_month_year(p_name), sep = ""),
#     NULL,
#     'Stations',
#     "No unique individuals",
#     month_as_name = FALSE,
#     show_bar_values = TRUE,
#     show_legend = FALSE,
#     show_x_axis_label = show_x_axis_label
#   )
#   all_plots[[j]] <- month_plot
#   j <- j + 1
# }
# 
# 
# main_common_title <-
#   "Number of unique individuals mixed at each station for the winter 2020/2021 "
# tgrob <- text_grob(main_common_title, size = 15, just = "centre")
# 
# grid_title_plot <- ggarrange(plotlist = list (as_ggplot(tgrob)),
#                              ncol = 1,
#                              nrow = 1)
# 
# grid_row1_plot <- ggarrange(plotlist = all_plots[1:2],
#                             ncol = 2,
#                             nrow = 1)
# 
# grid_row2_plot <-
#   ggarrange(plotlist = all_plots[3:length(all_plots)],
#             ncol = 2,
#             nrow = 1)
# 
# plot_list <- list(grid_title_plot, grid_row1_plot, grid_row2_plot)
# outer_grid <-
#   ggarrange(
#     plotlist = plot_list,
#     ncol = 1,
#     nrow = 3,
#     heights = c(1, 5, 5)
#   )
# 
# to_path <-
#   file.path(OUTPUT,
#             paste("gid_unique_individuals_per_station_and_month",
#                   suffix, sep = ""))
# 
# plots_to_pdf(list(outer_grid),
#              to_path,
#              paper_type,
#              paper_height,
#              paper_width)

#-------------------------------------------------------------------------------------------
#   Build unique individual Dec, Jan, Feb 2021 and entire time series (25 stations only)
#-------------------------------------------------------------------------------------------

all_plots <- list()
j = 1
max_stations <- 25
for (i in 4:6) {
  p_name <- period_names[[i]]
  df <- barplot_dfs [[i]]
  df <- df %>% arrange(desc(composition)) %>% head(max_stations)
  month_plot <- generate_bar_plot(
    df,
    'station',
    'composition',
    paste(format_month_year(p_name), sep = ""),
    NULL,
    'Stations',
    "Unique Individuals",
    month_as_name = FALSE,
    show_bar_values = TRUE,
    show_legend = FALSE,
    show_x_axis_label = TRUE
  )
  all_plots[[j]] <- month_plot
  j <- j + 1
}

estuaries_stations <- c("M25", "M26", "G06", "G07", "G08")
metric_thresholds <- c(100, length(estuaries_stations))
# Generate graph to show stations we are talking about
gc <- build_graph_context(data)
sub_graph <- subgraph(gc$only_loops_g, vids = estuaries_stations)
coords_simple_g <-
  get_graph_coordinates(sub_graph, locs)
bb_simple_g <-
  adjust_coord_bb(coords_simple_g, min_half_size = 2000)

estuary_plot <- plot_graph_centrality_metric(
  sub_graph,
  coords_simple_g,
  locs,
  bb_simple_g,
  coast,
  "Locations of estuary stations",
  'loops',
  metric_thresholds,
  show_legend = FALSE,
  show_labels = TRUE
)


# Generate Ven diagram

jan_feb <- monthly_detections %>% 
  filter(period=="2021-01" | period=="2021-02") %>% 
  filter(station %in% estuaries_stations)

rest_year <- monthly_detections %>% 
  filter(grepl("2021", period, ignore.case = TRUE)) %>% 
  filter(period!="2021-01" & period!="2021-02") %>% 
  filter(station %in% estuaries_stations)

individual_mix <- list(jan_feb = unique(jan_feb$ind_name), 
                       rest_year = unique(rest_year$ind_name))

mixing_diagram <- ggVennDiagram(individual_mix, 
                                category.names = c("Jan-Feb 2021","Mar-Dec 2021")) +
  guides(fill = guide_legend(title = "No Unique Individuals"))


# Draw the grid
main_common_title <-
  paste("Number of unique individuals mixing at estuary stations", 
        paste(estuaries_stations, collapse = ","), "for year 2021")
tgrob <- text_grob(main_common_title, size = 15, just = "centre")

grid_title_plot <- ggarrange(plotlist = list (as_ggplot(tgrob)),
                             ncol = 1,
                             nrow = 1)


grid_row1_plot <- ggarrange(plotlist = list(estuary_plot, mixing_diagram),
                            ncol = 2,
                            nrow = 1)

grid_row2_plot <- ggarrange(plotlist = all_plots[1:3],
                            ncol = 3,
                            nrow = 1)



plot_list <- list(grid_title_plot, grid_row1_plot, grid_row2_plot)
outer_grid <-
  ggarrange(
    plotlist = plot_list,
    ncol = 1,
    nrow = 3,
    heights = c(1, 5, 5)
  )

to_path <-
  file.path(
    OUTPUT,
    paste(
      "grid_unique_individuals_per_station_month_whole_series",
      suffix,
      sep = ""
    )
  )

plots_to_pdf(list(outer_grid),
             to_path,
             paper_type,
             paper_height,
             paper_width)