From 93a2eb4583dc25723ba187fbb62b31aea82f0d01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jens=20=C3=85str=C3=B6m?= Date: Fri, 16 Feb 2024 14:58:40 +0100 Subject: [PATCH] updated to 2023 document versions --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/combine_dist_to_comm_mat.R | 6 +- R/get_community_matrix.R | 52 ++++++---------- R/plot_ano_herb_sum.R | 62 +++++++++---------- R/plot_asv.R | 111 +++++++++++++++++++++++++++++++++++ R/utils.R | 19 ++++++ man/get_community_matrix.Rd | 2 +- man/plot_asv.Rd | 50 ++++++++++++++++ 9 files changed, 234 insertions(+), 71 deletions(-) create mode 100644 R/plot_asv.R create mode 100644 man/plot_asv.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 31a8b78..be24d6a 100644 --- a/DESCRIPTION +++ b/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 = "jens.astrom@nina.no", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6114-0440")) diff --git a/NAMESPACE b/NAMESPACE index 15333aa..c672269 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/combine_dist_to_comm_mat.R b/R/combine_dist_to_comm_mat.R index e8c659e..2f2c5b0 100644 --- a/R/combine_dist_to_comm_mat.R +++ b/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) %>% diff --git a/R/get_community_matrix.R b/R/get_community_matrix.R index affb035..56822d7 100644 --- a/R/get_community_matrix.R +++ b/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,8 +147,6 @@ get_community_matrix <- function(limit = NULL, filter(habitat_type %IN% subset_habitat) } - - #filter on dataset if(!is.null(dataset)){ @@ -163,11 +154,8 @@ get_community_matrix <- function(limit = NULL, 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,7 +219,6 @@ get_community_matrix <- function(limit = NULL, as_tibble() } - if(transposed_matrix){ res <- res %>% select(-c(1:2)) %>% @@ -243,7 +226,6 @@ get_community_matrix <- function(limit = NULL, } - return(res) } diff --git a/R/plot_ano_herb_sum.R b/R/plot_ano_herb_sum.R index 2d66edf..0713528 100644 --- a/R/plot_ano_herb_sum.R +++ b/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 %") } diff --git a/R/plot_asv.R b/R/plot_asv.R new file mode 100644 index 0000000..aa852f0 --- /dev/null +++ b/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 + +} diff --git a/R/utils.R b/R/utils.R index 8176e29..3c58a51 100644 --- a/R/utils.R +++ b/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) + +} diff --git a/man/get_community_matrix.Rd b/man/get_community_matrix.Rd index f8e58b6..6f63682 100644 --- a/man/get_community_matrix.Rd +++ b/man/get_community_matrix.Rd @@ -14,7 +14,7 @@ get_community_matrix( subset_families = NULL, subset_species = NULL, subset_habitat = NULL, - subset_region = c(NULL, "Østlandet", "Trøndelag", "Sørlandet", "Nord-Norge"), + subset_region = NULL, exclude_singletons = F, transposed_matrix = F, as_tibble = F diff --git a/man/plot_asv.Rd b/man/plot_asv.Rd new file mode 100644 index 0000000..40cc440 --- /dev/null +++ b/man/plot_asv.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_asv.R +\name{plot_asv} +\alias{plot_asv} +\title{plot_asv} +\usage{ +plot_asv( + species = NULL, + background = "ortofoto/hele_norge.png", + pie_scale = 0.5, + size = 0.1, + caption = TRUE, + title = NULL, + scale_to_sum_reads = TRUE, + ... +) +} +\arguments{ +\item{species}{Character string of latin species name to plot} + +\item{background}{relative path to a background image.} + +\item{pie_scale}{scaling factor relative to map size (how large should the pies be) 0-1} + +\item{size}{another (?) sizing} + +\item{caption}{Use species name as caption? Boolean} + +\item{title}{Pptional title. Null or character.} + +\item{scale_to_sum_reads}{Should slices be scaled to the sum of the reads? Boolean} + +\item{...}{} +} +\value{ +a ggplot object +} +\description{ +plot_asv +} +\examples{ + +\dontrun{ + +plot_asv("Erebia ligea")#' + +} + + +}