Add the ability to niche_ellipse() to handle three isotopes

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nichetools
 Type: Package
 Title: Complementary Package to 'nicheROVER' and 'SIBER'
-Version: 0.3.2
+Version: 0.3.3
 Authors@R: 
     c(person(given = "Benjamin L.", 
                   family = "Hlina",
@@ -27,7 +27,8 @@ Imports:
     rlang,
     SIBER,
     tibble,
-    tidyr
+    tidyr,
+    tidyselect
 License: CC0
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(create_comparisons)
+export(create_isotope_pairs)
 export(extract_group_metrics)
 export(extract_layman)
 export(extract_mu)
@@ -15,6 +16,7 @@ import(ellipse)
 import(purrr)
 import(tibble)
 import(tidyr)
+import(tidyselect)
 importFrom(lifecycle,deprecated)
 importFrom(nicheROVER,niche.size)
 importFrom(rlang,":=")

R/create_isotope_pairs.R

@@ -0,0 +1,55 @@
+#' Create isotope pairs
+#'
+#' @param isotope_n number of isotopes
+#' @param isotope_names names of isotopes
+#'
+#' @export
+
+create_isotope_pairs <- function(isotope_n = NULL,
+                                 isotope_names = NULL) {
+
+  # create name vector that will be used to id isotopes.
+  if (is.null(isotope_n)) {
+    isotope_n <- 3
+  }
+  if (!is.numeric(isotope_n) || !(isotope_n %in% c(3))) {
+    cli::cli_abort("Argument 'isotope_n' must 3.")
+  }
+
+  if (isotope_n == 3) {
+    if (is.null(isotope_names)) {
+      isotope_names <- c("d13c", "d15n", "d34s")
+    }
+  }
+ if (!is.character(isotope_names)) {
+      cli::cli_abort("Argument 'isotope_names' must be a character.")
+    }
+
+  # ---- create every combo in table ----
+  iso_combo <- tidyr::expand_grid(iso_a = isotope_names,
+                                  iso_b = isotope_names) |>
+    dplyr::filter(iso_a < iso_b) |>
+    dplyr::mutate(
+      iso_ab = paste(iso_a, iso_b, sep = "_")
+    ) |>
+    dplyr::distinct(iso_ab) |>
+    tidyr::separate_wider_delim(iso_ab, names = c("iso_a", "iso_b"),
+                                delim = "_")
+
+  # created id column
+  iso_combo$id <- 1:nrow(iso_combo)
+
+  # pivot longer to create vector that  can be used to filter combinations
+  split_iso <- split(iso_combo, iso_combo$id) |>
+    purrr::map(~ tidyr::pivot_longer(.x, cols = -id,
+                                     values_to = "iso_name") |>
+                 dplyr::mutate(
+                   iso_name = factor(iso_name, level = c("d34s",
+                                                         "d13c",
+                                                         "d15n"))
+                 ) |>
+                 dplyr::arrange(iso_name) |>
+                 getElement("iso_name")
+    )
+  return(split_iso)
+}

R/extract_group_metrics.R

@@ -90,7 +90,7 @@ extract_group_metrics <- function(data = NULL,
 
 
   # set data formatt
-  if(is.null(data_format)) {
+  if (is.null(data_format)) {
     data_format <- "long"
   }
 

R/extract_layman.R

@@ -183,7 +183,7 @@ extract_layman <- function(data,
     element_y <- "N"
   }
 
-  if(type %in% "bay") {
+  if (type %in% "bay") {
 
     df_layman <- data |>
       purrr::map(~ as_tibble(.x)) |>
@@ -224,7 +224,7 @@ extract_layman <- function(data,
 
       return(df_layman)
     }
-    if (data_format %in% "wide"){
+    if (data_format %in% "wide") {
       return(df_layman)
     }
   }

R/extract_mu.R

@@ -12,7 +12,8 @@
 #' you're using. Defaults to `"nicheROVER"`.
 #' Alternatively the user can supply the argument with `"SIBER"`.
 #' @param isotope_names is a vector of `character` string used change the column name
-#' of isotopes used in the analysis. Defaults to `c("d13c", "d15n")`.
+#' of isotopes used in the analysis. Defaults to `c("d13c", "d15n")`. To be used when
+#' `pkg` is set to `"SIBER"`.
 #' @param data_format a `character` string that decides whether the returned object is
 #' in long or wide format. Default is `"long"`, with the alternative supplied
 #' being `"wide"`.
@@ -27,6 +28,7 @@
 #' from [{SIBER}](https://CRAN.R-project.org/package=SIBER).
 #' The third and fourth columns contains the actual names of the communities
 #' and groups the user is working with (e.g., `"region"`, `"common_name"`).
+#'  To be used when `pkg` is set to `"SIBER"`.
 #'
 #' @return Returns a `tibble` of extracted estimates of \eqn{\mu} created by the
 #' function `niw.post()` or `siberMVN()` in the packages
@@ -98,28 +100,9 @@ extract_mu <- function(data,
                    'nicheROVER' or 'SIBER'.")
   }
 
-  # defaults of isotpoe a and b
-  if (is.null(isotope_names)) {
-    isotope_names <- c("d13c", "d15n")
-  }
-
-  # Check if isotope_names is a character vector
-  if (!is.vector(isotope_names) || !is.character(isotope_names)) {
-    cli::cli_abort("The supplied argument for 'isotope_names' must be a vector of characters.")
-  }
-
-  # Check if isotope_names has exactly 2 elements
-  if (length(isotope_names) != 2) {
-    cli::cli_abort("The 'isotope_names' vector must have exactly 2 elements, representing isotope_a and isotope_b.")
-  }
-
-  # # Check if isotope_b is character
-  # if (!is.character(isotope_b)) {
-  #   cli::cli_abort("The supplied argument for 'isotope_b' must be a character.")
-  # }
 
 
-  # sett data formatt
+  # sett data format
   if (is.null(data_format)) {
     data_format <- "long"
   }
@@ -191,6 +174,20 @@ extract_mu <- function(data,
     }
 
 
+    # defaults of isotpoe a and b
+    if (is.null(isotope_names)) {
+      isotope_names <- c("d13c", "d15n")
+    }
+
+    # Check if isotope_names is a character vector
+    if (!is.vector(isotope_names) || !is.character(isotope_names)) {
+      cli::cli_abort("The supplied argument for 'isotope_names' must be a vector of characters.")
+    }
+
+    # Check if isotope_names has exactly 2 elements
+    if (length(isotope_names) != 2) {
+      cli::cli_abort("'isotope_names' must have exactly 2 elements, representing isotope_a and isotope_b")
+    }
     id_isotope <- isotope_names
 
 
@@ -199,7 +196,7 @@ extract_mu <- function(data,
         df <- .x[, 5:6] |>
           t() |>
           as.numeric() |>
-          matrix(ncol = 1, byrow = T) |>
+          matrix(ncol = 1, byrow = TRUE) |>
           as.data.frame() |>
           tibble::as_tibble()
 
@@ -219,12 +216,12 @@ extract_mu <- function(data,
       dplyr::rename(
         mu_est = V1
       ) |>
-      dplyr::select(metric, sample_name,sample_number, isotope, mu_est) %>%
+      dplyr::select(metric, sample_name,sample_number, isotope, mu_est)  |>
       separate_wider_delim(sample_name, cols_remove = FALSE,
                            delim = ".", names = c("community",
-                                                  "group")) %>%
+                                                  "group"))  |>
       left_join(community_df, by = c("community",
-                                     "group")) %>%
+                                     "group"))  |>
       dplyr::select(metric:sample_number, community_name,
                     group_name, isotope, mu_est)
 

R/extract_overlap.R

@@ -32,11 +32,11 @@ extract_overlap <- function(data,
   }
 
   # set name_a null
-  if (is.null(name_a)){
+  if (is.null(name_a)) {
     name_a <- "sample_name_a"
   }
   # set name_b null
-  if (is.null(name_b)){
+  if (is.null(name_b)) {
     name_b <- "sample_name_b"
   }
 
@@ -60,12 +60,12 @@ extract_overlap <- function(data,
     tidyr::pivot_longer(cols = -c(id, species_a),
                         names_to = "species_b",
                         values_to = "niche_overlap") |>
-    tidyr::separate(species_b, into = c("species_b", "sample_number"),
-                    sep = "\\.") |>
+    tidyr::separate_wider_delim(species_b, names = c("species_b", "sample_number"),
+                    delim = ".") |>
     dplyr::rename(
       {{name_a}} := species_a,
       {{name_b}} := species_b
-    ) %>%
+    ) |>
     dplyr::mutate(
       niche_overlap_perc = niche_overlap * 100
     )

R/extract_sigma.R

@@ -109,7 +109,7 @@ extract_sigma <-  function(data,
         dplyr::bind_rows(.id = "isotope_num") |>
         dplyr::mutate(
           id = 1
-        ) %>%
+        ) |>
         tidyr::pivot_longer(-id)
 
       isotope_length <- unique(isotope_number$value)
@@ -145,7 +145,7 @@ extract_sigma <-  function(data,
         dplyr::bind_rows(.id = "isotope_num") |>
         dplyr::mutate(
           id = 1
-        ) %>%
+        ) |>
         tidyr::pivot_longer(-id)
 
       isotope_length <- unique(isotope_number$value)
@@ -171,8 +171,9 @@ extract_sigma <-  function(data,
                           names_to = "isotope",
                           values_to = "post_sample"
       ) |>
-      tidyr::separate(isotope, into = c("isotope", "sample_number"),
-                      sep = "\\.")
+      tidyr::separate_wider_delim(isotope, names = c("isotope", "sample_number"),
+
+                        delim = ".")
 
 
 
@@ -220,7 +221,7 @@ extract_sigma <-  function(data,
         df <- .x[, 1:4] |>
           t() |>
           as.numeric() |>
-          matrix(ncol = 2, byrow = T) |>
+          matrix(ncol = 2, byrow = TRUE) |>
           as.data.frame() |>
           tibble::as_tibble()