Merge pull request #41 from NINAnor/div_issues_fix

updated to 2023 document versions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Norimon
 Title: Utility Functions for the National Insect Monitoring in Norway
-Version: 0.0.0.9019
+Version: 0.0.0.91
 Authors@R: 
     person(given = "Jens", family = "Åström", email = "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6114-0440"))

NAMESPACE

@@ -37,6 +37,7 @@ export(longerHobo2202)
 export(longerHobo2301)
 export(map_plot)
 export(plot_ano_herb_sum)
+export(plot_asv)
 export(plot_beta_part)
 export(plot_climate_comparison)
 export(ts_plot)

R/combine_dist_to_comm_mat.R

@@ -35,7 +35,6 @@ combine_dist_to_comm_mat <- function(comm_mat,
                                      region_name,
                                      habitat_type){
 
-
   comm_mat_to_prosess <- comm_mat %>%
     select(-c(year, locality))
 
@@ -44,7 +43,6 @@ combine_dist_to_comm_mat <- function(comm_mat,
     dplyr::select(locality) %>%
     dplyr::pull()
 
-
   dist_q <- paste0("
   SELECT a.locality as loc_a, b.locality loc_b,
   ST_Distance(ST_Centroid(a.geom), ST_Centroid(b.geom)) as distance
@@ -69,7 +67,7 @@ combine_dist_to_comm_mat <- function(comm_mat,
   ")
 
   dist <- DBI::dbGetQuery(con,
-                     dist_q)
+                          dist_q)
 
   ##Now arrange these together and plot
   #something like this?
@@ -86,7 +84,7 @@ combine_dist_to_comm_mat <- function(comm_mat,
     matrix(.,
            ncol = 1)
 
-  dist_beta <- dist %>%s
+  dist_beta <- dist %>%
     cbind(beta_sim) %>%
     cbind(beta_sne) %>%
     cbind(beta_sor) %>%

R/get_community_matrix.R

@@ -34,41 +34,37 @@
 
 
 get_community_matrix <- function(limit = NULL,
-                                     id_type = c("metabarcoding"),
-                                     trap_type = "MF",
-                                     dataset = "NasIns",
-                                     subset_years = NULL,
-                                     subset_orders = NULL,
-                                     subset_families = NULL,
-                                     subset_species = NULL,
-                                     subset_habitat = NULL,
-                                     subset_region = c(NULL,
-                                                       "\u00d8stlandet",
-                                                       "Tr\u00f8ndelag",
-                                                       "S\u00f8rlandet",
-                                                       "Nord-Norge"),
-                                     exclude_singletons = F,
-                                     transposed_matrix = F,
-                                     as_tibble = F){
+                                 id_type = c("metabarcoding"),
+                                 trap_type = "MF",
+                                 dataset = "NasIns",
+                                 subset_years = NULL,
+                                 subset_orders = NULL,
+                                 subset_families = NULL,
+                                 subset_species = NULL,
+                                 subset_habitat = NULL,
+                                 subset_region = NULL,
+                                 exclude_singletons = F,
+                                 transposed_matrix = F,
+                                 as_tibble = F){
 
   Norimon::checkCon()
 
-
   dataset <- match.arg(dataset,
                        choices = c("NasIns",
                                    "OkoTrond",
                                    "TidVar",
                                    "Nerlands\u00f8ya"))
-  if(subset_region){
-    subset_region = match.arg(subset_region, c("Tr\u00f8ndelag", "\u00d8stlandet", "S\u00f8rlandet", "Nord-Norge"))
-}
+
   trap_type <- match.arg(trap_type,
                          choices = c("MF", "VF", "All", NULL))
 
   if(!is.null(subset_years)){
-  subset_years <- as.numeric(subset_years)
+    subset_years <- as.numeric(subset_years)
   }
 
+  if(!is.null(subset_region)){
+    subset_region = match.arg(subset_region, c("Tr\u00f8ndelag", "\u00d8stlandet", "S\u00f8rlandet", "Nord-Norge"))
+  }
 
   ##Set up table sources
   ##Probably needs updating after new batch of data. Also need to test filtering of different identification types
@@ -107,14 +103,11 @@ get_community_matrix <- function(limit = NULL,
                      "year" = "year",
                      "locality" = "locality"))
 
-
-
   if(id_type == "metabarcoding"){
     joined <- joined %>%
       filter(identification_type == "metabarcoding")
   }
 
-
   if(!is.null(subset_years)){
     subset_years <- c(NA, subset_years) #To allow one-length subsets
     joined <- joined %>%
@@ -154,20 +147,15 @@ get_community_matrix <- function(limit = NULL,
       filter(habitat_type %IN% subset_habitat)
   }
 
-
-
   #filter on dataset
 
   if(!is.null(dataset)){
     joined <- joined %>%
       filter(project_short_name == dataset)
   }
 
-
-
   ##Aggregate data to choosen level
 
-
   ##Exclude 2020 4 week samplings
 
   joined <-  joined %>%
@@ -212,8 +200,6 @@ get_community_matrix <- function(limit = NULL,
       filter(!(species_latin_fixed %in% to_exclude))
   }
 
-
-
   res <- res %>%
     select(-count) %>%
     pivot_wider(names_from = species_latin_fixed,
@@ -223,8 +209,6 @@ get_community_matrix <- function(limit = NULL,
             locality)
 
 
-
-
   if(!is.null(limit)){
     res <- joined %>%
       head(limit)
@@ -235,15 +219,13 @@ get_community_matrix <- function(limit = NULL,
       as_tibble()
   }
 
-
   if(transposed_matrix){
     res <- res %>%
       select(-c(1:2)) %>%
       t()
 
   }
 
-
   return(res)
 
 }

R/plot_ano_herb_sum.R

@@ -20,43 +20,45 @@ plot_ano_herb_sum <- function(){
 
   Norimon::checkCon()
 
-  ano_herb_agg <- tbl(con,
-                      DBI::Id(schema = "views",
-                         table = "ano_herb_agg")) %>%
-    filter(project_short_name == "NasIns")
+  ano_herb_agg <- dplyr::tbl(con,
+                             DBI::Id(schema = "views",
+                                     table = "ano_herb_agg")) %>%
+    dplyr::filter(project_short_name == "NasIns")
 
 
   loc_reg <- get_localities(dataset = "NasIns") %>%
-    mutate(habitat_type = ifelse(habitat_type == "Forest", "Skog", habitat_type)) %>%
-    st_drop_geometry() %>%
-    select(locality,
-           region_name)
+    dplyr::mutate(habitat_type = ifelse(habitat_type == "Forest", "Skog", habitat_type)) %>%
+    sf::st_drop_geometry() %>%
+    dplyr::select(locality,
+                  region_name)
 
   xlim <- ano_herb_agg %>%
-    summarise(min = min(year, na.rm = TRUE),
-              max = max(year, na.rm = TRUE)) %>%
-    collect() %>%
+    dplyr::summarise(min = min(year, na.rm = TRUE),
+                     max = max(year, na.rm = TRUE)) %>%
+    dplyr::collect() %>%
     as.vector()
 
   ano_herb_agg %>%
-    left_join(loc_reg,
-              by = c("locality" = "locality"),
-              copy = TRUE) %>%
-    group_by(region_name) %>%
-    ggplot(.) +
-    geom_point(aes(x = year,
-                   y = ano_median_cover,
-                   size = ano_median_no_spec,
-                   col = region_name),
-               alpha = 0.7,
-               position = position_jitterdodge(dodge.width = 0.4,
-                                               jitter.height = 2,
-                                               jitter.width = 0)) +
-    scale_x_continuous(breaks= seq(xlim[[1]], xlim[[2]])) +
-    scale_color_nina(name = "Region") +
-    scale_size(name = "Artantall\nkarplanter") +
-    guides(color = guide_legend(override.aes = list(size=5))) +
-    xlab("\u00e5r") +
-    ylab("Dekningsgrad %")
+    dplyr::left_join(loc_reg,
+                     by = c("locality" = "locality"),
+                     copy = TRUE) %>%
+    dplyr::group_by(region_name) %>%
+    ggplot2::ggplot(.) +
+    ggplot2::geom_point(aes(x = year,
+                            y = ano_median_cover,
+                            size = ano_median_no_spec,
+                            col = region_name),
+                        alpha = 0.7,
+                        position = position_jitterdodge(dodge.width = 0.4,
+                                                        jitter.height = 2,
+                                                        jitter.width = 0)) +
+    ggplot2::scale_x_continuous(breaks= seq(xlim[[1]], xlim[[2]])) +
+    NinaR::scale_color_nina(name = "Region") +
+    ggplot2::scale_size(name = "Artsantall\nkarplanter") +
+    ggplot2::guides(color = guide_legend(override.aes = list(size = 4))) +
+    ggplot2::theme(legend.title = element_text(size = 8),
+                   legend.margin = margin(c(0, 0, 0, 0), unit = "pt")) +
+    ggplot2::xlab("\u00C5r") +
+    ggplot2::ylab("Dekningsgrad %")
 
 }

R/plot_asv.R

@@ -0,0 +1,111 @@
+#' plot_asv
+#'
+#' @param species Character string of latin species name to plot
+#' @param background relative path to a background image.
+#' @param pie_scale scaling factor relative to map size (how large should the pies be) 0-1
+#' @param size another (?) sizing
+#' @param caption Use species name as caption? Boolean
+#' @param title Pptional title. Null or character.
+#' @param scale_to_sum_reads Should slices be scaled to the sum of the reads? Boolean
+#' @param ...
+#'
+#' @return a ggplot object
+#'
+#' @export
+#'
+#' @examples
+#'
+#' \dontrun{
+#'
+#' plot_asv("Erebia ligea")#'
+#'
+#' }
+#'
+#'
+plot_asv <- function(species = NULL,
+                     background = "ortofoto/hele_norge.png",
+                     pie_scale = 0.5,
+                     size = 0.1,
+                     caption = TRUE,
+                     title = NULL,
+                     scale_to_sum_reads = TRUE,
+                     ...){
+
+  jon_asv <- get_asv_loc(species = species) %>%
+    mutate(scale_sum_reads = scale(sum_reads, center = min(sum_reads), scale = diff(range(sum_reads))))
+  # %>%
+  #  filter(locality %in% c("Skog_02", "Semi-nat_11"))
+
+  if(!file.exists(background)) stop("Background image file not found")
+
+  tt <- terra::rast(background)
+  ext_background <- as.vector(terra::ext(tt))
+  img <- png::readPNG(background)
+  g <- grid::rasterGrob(img, interpolate=TRUE)
+
+  if(scale_to_sum_reads){
+    jon_asv$r <- log(jon_asv$sum_reads) * diff(ext_background[1:2]) / 100 * pie_scale
+  } else {
+    jon_asv$r <- diff(ext_background[1:2]) / 100 * pie_scale
+  }
+
+  jon_asv <- jon_asv %>%
+    mutate(locality = factor(locality, levels = unique(locality[order(desc(r))]))) %>%
+    arrange(desc(r))
+
+  p1 <- ggplot() +
+    annotation_custom(g, xmin = ext_background[1],
+                      xmax = ext_background[2],
+                      ymin = ext_background[3],
+                      ymax = ext_background[4]) +
+    lapply(split(jon_asv, jon_asv$locality),
+           function(d) {
+             geom_arc_bar(aes(x0 = x_25833,
+                              y0 = y_25833,
+                              r = r,
+                              r0 = 0,
+                              amount = perc_reads,
+                              fill = sequence_id
+             ),
+             size = size,
+             data = d,
+             stat = "pie",
+             inherit.aes = TRUE)
+           })  +
+    coord_fixed() +
+    xlim(ext_background[1:2]) +
+    ylim(ext_background[3:4]) +
+    theme(legend.position="none",
+          panel.border = element_blank(),
+          #axis.line=element_line(color = "black"),
+          axis.text.x=element_blank(), #remove x axis labels
+          axis.ticks.x=element_blank(), #remove x axis ticks
+          axis.text.y=element_blank(),  #remove y axis labels
+          axis.ticks.y=element_blank(),
+          plot.margin = unit(c(0, 0, 0, 0), "pt"),
+          plot.caption.position = "panel",
+          plot.caption = element_text(vjust = 10,
+                                      hjust = 0.5,
+                                      size = 14,
+                                      margin = margin(0, 0, 0, 0)),
+          plot.title = element_text(hjust = 0.5,
+                                    vjust = 0)
+
+    ) +
+    xlab("") +
+    ylab("") +
+    scale_fill_nina()
+
+  if(caption){
+    p1 <- p1 +
+      labs(caption = species)
+  }
+
+  if(!is.null(title)){
+    p1 <- p1 +
+      labs(title = title)
+  }
+
+  p1
+
+}

R/utils.R

@@ -250,6 +250,25 @@ toiNEXT <- function(input){
 }
 
 
+#' get_asv_loc
+#' @noRd
+get_asv_loc <- function(species = NULL,
+                        dataset = c("NasIns"),
+                        subset_year = NULL
+){
+
+  asv_perc_reads <- tbl(con,
+                        Id(schema = "views",
+                           table = "asv_perc_reads"))
+
+  asv_wider <- asv_perc_reads %>%
+    filter(species_latin_fixed %in% species) %>%
+    # mutate(value = round(perc_reads * 100, 4)) %>%
+    collect() %>%
+    as.data.frame()
 
+  return(asv_wider)
+
+}