Merge pull request #20 from astamm/native-pipe

Switch to native R pipe operator.

DESCRIPTION

@@ -40,6 +40,7 @@ Description: A flexible statistical framework for network-valued data analysis.
     autism" <doi:10.1111/rssc.12463>.
 License: GPL (>= 3)
 Encoding: UTF-8
+Depends: R (>= 4.1.0)
 Imports: 
     igraph,
     Rcpp,
@@ -50,7 +51,6 @@ Imports:
     forcats,
     ggplot2,
     rlang,
-    magrittr,
     flipr,
     cli,
     withr,

NAMESPACE

@@ -6,7 +6,6 @@ S3method(as_vertex_partition,list)
 S3method(autoplot,nvd)
 S3method(mean,nvd)
 S3method(plot,nvd)
-export("%>%")
 export(as_nvd)
 export(as_vertex_partition)
 export(dist_frobenius)
@@ -47,7 +46,6 @@ export(var_nvd)
 importFrom(Rcpp,sourceCpp)
 importFrom(ggplot2,autoplot)
 importFrom(graphics,plot)
-importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
 importFrom(rlang,`:=`)
 importFrom(tibble,tibble)

R/nvd-class.R

@@ -233,12 +233,12 @@ is_nvd <- function(obj) {
 #' sim <- sample2_sbm(n, 68, p1, c(17, 17, 17, 17), p2, seed = 1234)
 sample2_sbm <- function(n, nv, p1, b1, p2 = p1, b2 = b1, seed = NULL) {
   withr::local_seed(seed)
-  sim <- n %>%
+  sim <- n |>
     purrr::rerun(
       x = igraph::sample_sbm(nv, p1, b1),
       y = igraph::sample_sbm(nv, p2, b2)
-    ) %>%
-    purrr::transpose() %>%
+    ) |>
+    purrr::transpose() |>
     purrr::map(as_nvd)
 }
 

R/subgraphs.R

@@ -22,7 +22,7 @@ NULL
 #' @rdname subgraphs
 subgraph_full <- function(g, vids) {
   if (!igraph::is_named(g)) igraph::V(g)$name <- seq_len(igraph::gorder(g))
-  igraph::induced_subgraph(g, unlist(vids)) %>%
+  igraph::induced_subgraph(g, unlist(vids)) |>
     igraph::set_graph_attr("atoms", names(vids))
 }
 
@@ -32,25 +32,25 @@ subgraph_intra <- function(g, vids) {
   if (!igraph::is_named(g)) igraph::V(g)$name <- seq_len(igraph::gorder(g))
   # Handle graph attributes
   ga_names <- igraph::graph_attr_names(g)
-  ga_values <- ga_names %>%
-    purrr::map(~ igraph::graph_attr(g, .x)) %>%
+  ga_values <- ga_names |>
+    purrr::map(~ igraph::graph_attr(g, .x)) |>
     rlang::set_names(ga_names)
-  vids %>%
-    purrr::map(~ igraph::induced_subgraph(g, .x)) %>%
-    purrr::map(delete_graph_attributes) %>%
-    purrr::reduce(igraph::disjoint_union) %>%
-    add_graph_attributes(ga_values) %>%
+  vids |>
+    purrr::map(~ igraph::induced_subgraph(g, .x)) |>
+    purrr::map(delete_graph_attributes) |>
+    purrr::reduce(igraph::disjoint_union) |>
+    add_graph_attributes(ga_values) |>
     igraph::set_graph_attr("atoms", names(vids))
 }
 
 #' @export
 #' @rdname subgraphs
 subgraph_inter <- function(g, vids) {
   if (!igraph::is_named(g)) igraph::V(g)$name <- seq_len(igraph::gorder(g))
-  vids %>%
-    purrr::map(~ igraph::induced_subgraph(g, .x)) %>%
-    purrr::reduce(igraph::disjoint_union) %>%
-    igraph::difference(big = subgraph_full(g, vids)) %>%
+  vids |>
+    purrr::map(~ igraph::induced_subgraph(g, .x)) |>
+    purrr::reduce(igraph::disjoint_union) |>
+    igraph::difference(big = subgraph_full(g, vids)) |>
     igraph::set_graph_attr("atoms", names(vids))
 }
 

R/tests.R

@@ -137,8 +137,8 @@ test2_global <- function(x, y,
     return(y)
   }
 
-  stat_functions <- stats %>%
-    strsplit(split = ":") %>%
+  stat_functions <- stats |>
+    strsplit(split = ":") |>
     purrr::map(~ {
       if (length(.x) == 1) {
         s <- paste0("stat_", .x)
@@ -237,21 +237,21 @@ test2_local <- function(x, y, partition,
   # Initialize output for intra-adjusted pvalues
   stop_intra <- FALSE
   skip_intra <- NULL
-  p_intra <- utils::combn(E, 1, simplify = FALSE) %>%
-    purrr::transpose() %>%
-    purrr::simplify_all() %>%
-    rlang::set_names("E") %>%
-    tibble::as_tibble() %>%
+  p_intra <- utils::combn(E, 1, simplify = FALSE) |>
+    purrr::transpose() |>
+    purrr::simplify_all() |>
+    rlang::set_names("E") |>
+    tibble::as_tibble() |>
     dplyr::mutate(pvalue = 0, truncated = FALSE)
 
   # Intialize output for inter-adjusted pvalues
   stop_inter <- FALSE
   skip_inter <- NULL
-  p_inter <- utils::combn(E, 2, simplify = FALSE) %>%
-    purrr::transpose() %>%
-    purrr::simplify_all() %>%
-    rlang::set_names(c("E1", "E2")) %>%
-    tibble::as_tibble() %>%
+  p_inter <- utils::combn(E, 2, simplify = FALSE) |>
+    purrr::transpose() |>
+    purrr::simplify_all() |>
+    rlang::set_names(c("E1", "E2")) |>
+    tibble::as_tibble() |>
     dplyr::mutate(pvalue = 0, truncated = FALSE)
 
   for (i in 1:psize) {
@@ -273,8 +273,8 @@ test2_local <- function(x, y, partition,
         next()
 
       element_value <- sas[[j]]
-      individuals <- element_name %>%
-        strsplit(",") %>%
+      individuals <- element_name |>
+        strsplit(",") |>
         purrr::simplify()
 
       # Tests on full subgraphs
@@ -362,15 +362,15 @@ test2_local <- function(x, y, partition,
 }
 
 .update_intra_pvalues <- function(output, c, p, alpha) {
-  output %>%
+  output |>
     dplyr::mutate(
       pvalue = purrr::map2_dbl(.data$E, .data$pvalue, ~ dplyr::if_else(.x %in% c, pmax(.y, p), .y)),
       truncated = .data$pvalue >= alpha
     )
 }
 
 .update_inter_pvalues <- function(output, c, p, alpha) {
-  output %>%
+  output |>
     dplyr::mutate(
       pvalue = purrr::pmap_dbl(
         list(.data$E1, .data$E2, .data$pvalue),
@@ -382,8 +382,8 @@ test2_local <- function(x, y, partition,
 
 .update_skip_list <- function(skip_list, individuals) {
   for (k in 1:length(individuals)) {
-    tmp <- individuals %>%
-      utils::combn(k, paste0, collapse = ",", simplify = FALSE) %>%
+    tmp <- individuals |>
+      utils::combn(k, paste0, collapse = ",", simplify = FALSE) |>
       purrr::simplify()
     skip_list <- unique(c(skip_list, tmp))
   }
@@ -392,11 +392,11 @@ test2_local <- function(x, y, partition,
 
 test2_subgraph <- function(x, y, subpartition, fun,
                            representation, distance, stats, B, test, k, seed) {
-  x <- x %>%
-    purrr::map(rlang::as_function(fun), vids = subpartition) %>%
+  x <- x |>
+    purrr::map(rlang::as_function(fun), vids = subpartition) |>
     as_nvd()
-  y <- y %>%
-    purrr::map(rlang::as_function(fun), vids = subpartition) %>%
+  y <- y |>
+    purrr::map(rlang::as_function(fun), vids = subpartition) |>
     as_nvd()
   test2_global(
     x, y,

R/vertex_partition.R

@@ -33,8 +33,8 @@ as_vertex_partition.list <- function(x) {
 #' @export
 as_vertex_partition.character <- function(x) {
   areas <- sort(unique(x))
-  x <- areas %>%
-    purrr::map(~ which(x == .x)) %>%
+  x <- areas |>
+    purrr::map(~ which(x == .x)) |>
     rlang::set_names(areas)
   class(x) <- c("vertex_partition", class(x))
   x
@@ -63,13 +63,13 @@ as_vertex_partition.integer <- function(x) {
 #' all_inter <- purrr::modify_depth(sa, 2, ~ subgraph_inter(g, .x))
 generate_sigma_algebra <- function(x) {
   N <- length(x)
-  N:1 %>%
-    purrr::map(utils::combn, x = x, simplify = FALSE) %>%
-    rlang::set_names(paste0("D", N:1)) %>%
+  N:1 |>
+    purrr::map(utils::combn, x = x, simplify = FALSE) |>
+    rlang::set_names(paste0("D", N:1)) |>
     purrr::map(~ rlang::set_names(
       x = .x,
-      nm = .x %>%
-        purrr::map(names) %>%
+      nm = .x |>
+        purrr::map(names) |>
         purrr::map_chr(paste0, collapse = ",")
     ))
 }

R/visualizations.R

@@ -89,7 +89,7 @@ autoplot.nvd <- function(object,
                          memberships = rep(1, length(object)),
                          method = "mds",
                          ...) {
-  nvd_data(x = object, memberships = memberships, method = method) %>%
+  nvd_data(x = object, memberships = memberships, method = method) |>
     ggplot2::ggplot(ggplot2::aes(
       x = .data$V1,
       y = .data$V2,