From 01994a9810c7272742095cccb1982c68f80779c1 Mon Sep 17 00:00:00 2001 From: Robrecht Cannoodt Date: Fri, 27 Mar 2026 12:58:34 +0100 Subject: [PATCH 1/3] modernise package --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/test-coverage.yaml | 4 +- DESCRIPTION | 5 +- NAMESPACE | 4 - NEWS.md | 18 ++++ R/adapt_orient_topology.R | 22 ++--- R/add_regulatory_network.R | 2 +- R/calculate_average.R | 6 +- R/calculate_geodesic_distances.R | 69 ++++++++------- R/calculate_trajectory_dimred.R | 72 ++++++++-------- R/classify_milestone_network.R | 8 +- ...rt_milestone_percentages_to_progressions.R | 28 +++---- ...rt_progressions_to_milestone_percentages.R | 20 ++--- R/method_create_ti_method_container.R | 6 +- R/method_create_ti_method_r.R | 6 +- R/method_execute.R | 6 +- R/method_extract_args.R | 16 ++-- R/method_get_ti_methods.R | 12 +-- R/method_process_definition.R | 2 +- R/package.R | 7 +- R/project_waypoints.R | 4 +- R/simplify_igraph_network.R | 72 ++++++++-------- R/simplify_trajectory.R | 34 ++++---- R/wrap_add_branch_trajectory.R | 34 ++++---- R/wrap_add_cell_graph.R | 53 ++++++------ R/wrap_add_cell_waypoints.R | 52 ++++++------ R/wrap_add_cluster_graph.R | 34 ++++---- R/wrap_add_cyclic_trajectory.R | 10 +-- R/wrap_add_dimred.R | 36 ++++---- R/wrap_add_dimred_projection.R | 26 +++--- R/wrap_add_end_state_probabilities.R | 14 ++-- R/wrap_add_expression.R | 4 +- R/wrap_add_feature_importance.R | 2 +- R/wrap_add_grouping.R | 42 +++++----- R/wrap_add_prior_information.R | 26 +++--- R/wrap_add_pseudotime.R | 2 +- R/wrap_add_root.R | 27 +++--- R/wrap_add_timings.R | 2 +- R/wrap_add_trajectory.R | 42 +++++----- R/wrap_add_waypoints.R | 60 ++++++------- R/wrap_data.R | 2 +- R/wrap_gather_cells_at_milestones.R | 10 +-- R/wrap_label_milestones.R | 28 +++---- inst/tests/testthat/helper-ti_comp1.R | 10 +-- inst/tests/testthat/helper-ti_identity.R | 8 +- inst/tests/testthat/helper-ti_random.R | 10 +-- inst/tests/testthat/helper-ti_shuffle.R | 12 +-- man/add_trajectory.Rd | 6 +- man/create_ti_method_r.Rd | 2 +- man/dynwrap-package.Rd | 28 +++++++ man/dynwrap.Rd | 9 -- man/simplify_igraph_network.Rd | 2 +- tests/testthat/test-adapt_orient_topology.R | 6 +- tests/testthat/test-calculate_average.R | 2 +- .../test-calculate_geodesic_distances.R | 14 ++-- .../test-calculate_trajectory_dimred.R | 4 +- .../test-classify_milestone_network.R | 24 +++--- .../testthat/test-method_create_ti_method_r.R | 6 +- tests/testthat/test-method_infer_trajectory.R | 2 +- .../test-method_parse_parameter_definition.R | 22 ++--- tests/testthat/test-milestone_convertors.R | 14 ++-- tests/testthat/test-simplify_igraph_network.R | 10 +-- tests/testthat/test-simplify_trajectory.R | 44 +++++----- .../test-wrap_add_branch_trajectory.R | 4 +- tests/testthat/test-wrap_add_cell_graph.R | 10 +-- tests/testthat/test-wrap_add_cell_waypoints.R | 18 ++-- .../test-wrap_add_cyclic_trajectory.R | 12 +-- tests/testthat/test-wrap_add_dimred.R | 50 +++++------ .../test-wrap_add_dimred_projection.R | 6 +- .../test-wrap_add_end_state_probabilities.R | 8 +- tests/testthat/test-wrap_add_expression.R | 16 ++-- tests/testthat/test-wrap_add_grouping.R | 12 +-- .../test-wrap_add_linear_trajectory.R | 10 +-- .../test-wrap_add_prior_information.R | 84 +++++++++---------- tests/testthat/test-wrap_add_pseudotime.R | 4 +- .../test-wrap_add_root_and_add_pseudotime.R | 4 +- tests/testthat/test-wrap_add_timings.R | 8 +- tests/testthat/test-wrap_add_trajectory.R | 2 +- tests/testthat/test-wrap_add_waypoints.R | 10 +-- tests/testthat/test-wrap_cell_group.R | 14 ++-- tests/testthat/test-wrap_cluster_graph.R | 8 +- tests/testthat/test-wrap_label_milestones.R | 8 +- vignettes/create_ti_method_container.Rmd | 4 +- vignettes/create_ti_method_definition.Rmd | 6 +- vignettes/create_ti_method_r.Rmd | 2 +- 85 files changed, 741 insertions(+), 725 deletions(-) create mode 100644 man/dynwrap-package.Rd delete mode 100755 man/dynwrap.Rd diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 73acdb7b..580a2c6a 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -30,7 +30,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v5 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 629335e6..76b1d28f 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -16,7 +16,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v5 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-r@v2 with: @@ -56,7 +56,7 @@ jobs: - name: Upload test results if: failure() - uses: actions/upload-artifact@v4 + uses: actions/upload-artifact@v7 with: name: coverage-test-failures path: ${{ runner.temp }}/package diff --git a/DESCRIPTION b/DESCRIPTION index 6fdbaf6e..e5757a29 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Description: Provides functionality to infer trajectories from single-cell data, represent them into a common format, and adapt them. Other biological information can also be added, such as cellular grouping, RNA velocity and annotation. Saelens et al. (2019) . -Version: 1.2.5 +Version: 1.3.0 Authors@R: c( person( "Robrecht", @@ -26,7 +26,7 @@ URL: https://github.com/dynverse/dynwrap BugReports: https://github.com/dynverse/dynwrap/issues License: MIT + file LICENSE LazyData: TRUE -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Encoding: UTF-8 Depends: @@ -40,7 +40,6 @@ Imports: dynparam, igraph, glue, - magrittr, Matrix, methods, purrr (>= 1.0.0), diff --git a/NAMESPACE b/NAMESPACE index 24d38707..ff682fbf 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -122,10 +122,6 @@ importFrom(igraph,graph_from_data_frame) importFrom(igraph,is_directed) importFrom(igraph,layout_with_fr) importFrom(igraph,neighborhood) -importFrom(magrittr,"%$%") -importFrom(magrittr,"%<>%") -importFrom(magrittr,set_colnames) -importFrom(magrittr,set_rownames) importFrom(methods,as) importFrom(methods,formalArgs) importFrom(methods,is) diff --git a/NEWS.md b/NEWS.md index cf389aa4..c6c6cf12 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,21 @@ +# dynwrap 1.3.0 + +* MODERNISATION: Replace `%>%` pipes with native `|>` pipe throughout. + +* MODERNISATION: Remove `magrittr` dependency; replace `set_rownames()`/`set_colnames()` with base R assignments. + +* MODERNISATION: Replace deprecated `dplyr::do()` with `reframe()`. + +* MODERNISATION: Replace deprecated `mutate_at()` with `mutate(across())`. + +* FIX: Add missing `"id"` to `globalVariables()` to silence R CMD check NOTE about no visible binding for global variable `id`. + +* FIX: Replace relative cross-vignette URLs (`../create_ti_method_xxx`) with proper file-relative links to silence R CMD check NOTE. + +* MINOR CHANGE: Update GitHub Actions workflows to use `actions/checkout@v6` and `actions/upload-artifact@v7`. + +* MINOR CHANGE: Add `pkgdown.yaml` GitHub Actions workflow for website deployment. + # dynwrap 1.2.5 * BUG FIX `convert_definition()`: Fix for purrr having deprecated `invoke` in favour of `exec` (PR #166). diff --git a/R/adapt_orient_topology.R b/R/adapt_orient_topology.R index 42ea6f3f..2b4879a3 100755 --- a/R/adapt_orient_topology.R +++ b/R/adapt_orient_topology.R @@ -25,45 +25,45 @@ flip_edges <- function( paste0(trajectory$milestone_network$from, trajectory$milestone_network$to) ), msg = "All edges in the milestone_network_toflip should also be present in the trajectory milestone network") - milestone_network_toflip <- milestone_network_toflip %>% + milestone_network_toflip <- milestone_network_toflip |> select(from, to) # flip edge if from is later than to - trajectory$milestone_network <- trajectory$milestone_network %>% - left_join(milestone_network_toflip %>% mutate(flip = TRUE), c("from", "to")) %>% + trajectory$milestone_network <- trajectory$milestone_network |> + left_join(milestone_network_toflip |> mutate(flip = TRUE), c("from", "to")) |> mutate(flip = ifelse(is.na(flip), FALSE, flip)) # flip milestone network & progressions - trajectory$progressions <- trajectory$progressions %>% - left_join(trajectory$milestone_network %>% select(from, to, flip), c("from", "to")) %>% + trajectory$progressions <- trajectory$progressions |> + left_join(trajectory$milestone_network |> select(from, to, flip), c("from", "to")) |> mutate( from2 = from, from = ifelse(flip, to, from), to = ifelse(flip, from2, to), percentage = ifelse(flip, 1-percentage, percentage) - ) %>% + ) |> select(-flip, -from2) if (!is.null(trajectory$dimred_segment_progressions)) { trajectory$dimred_segment_progressions <- - trajectory$dimred_segment_progressions %>% - left_join(trajectory$milestone_network %>% select(from, to, flip), c("from", "to")) %>% + trajectory$dimred_segment_progressions |> + left_join(trajectory$milestone_network |> select(from, to, flip), c("from", "to")) |> mutate( from2 = from, from = ifelse(flip, to, from), to = ifelse(flip, from2, to), percentage = ifelse(flip, 1-percentage, percentage) - ) %>% + ) |> select(-flip, -from2) } - trajectory$milestone_network <- trajectory$milestone_network %>% + trajectory$milestone_network <- trajectory$milestone_network |> mutate( from2 = from, from = ifelse(flip, to, from), to = ifelse(flip, from2, to), directed = TRUE - ) %>% + ) |> select(-flip, -from2) trajectory diff --git a/R/add_regulatory_network.R b/R/add_regulatory_network.R index 2f9e0cb7..0f5c667c 100644 --- a/R/add_regulatory_network.R +++ b/R/add_regulatory_network.R @@ -58,7 +58,7 @@ add_regulatory_network <- function(dataset, regulatory_network, regulatory_netwo regulatory_network_sc$target <- factor(regulatory_network_sc$target, targets) } - dataset <- dataset %>% extend_with( + dataset <- dataset |> extend_with( "dynwrap::with_regulatory_network", regulatory_network = regulatory_network, regulatory_network_sc = regulatory_network_sc, diff --git a/R/calculate_average.R b/R/calculate_average.R index 334f2863..956727e8 100755 --- a/R/calculate_average.R +++ b/R/calculate_average.R @@ -21,8 +21,8 @@ #' @rdname calculate_average calculate_average_by_group <- function(x, cell_grouping) { milestone_percentages <- - cell_grouping %>% - mutate(percentage = 1) %>% + cell_grouping |> + mutate(percentage = 1) |> rename(milestone_id = group_id) calculate_average_by_milestone_percentages(x, milestone_percentages) @@ -30,7 +30,7 @@ calculate_average_by_group <- function(x, cell_grouping) { calculate_average_by_milestone_percentages <- function(x, milestone_percentages) { # cast milestone percentages to matrix - milpct_m <- milestone_percentages %>% + milpct_m <- milestone_percentages |> reshape2::acast(cell_id ~ milestone_id, value.var = "percentage", fill = 0, fun.aggregate = sum) stat <- colSums(milpct_m) diff --git a/R/calculate_geodesic_distances.R b/R/calculate_geodesic_distances.R index a6b264db..c4437292 100755 --- a/R/calculate_geodesic_distances.R +++ b/R/calculate_geodesic_distances.R @@ -70,7 +70,7 @@ calculate_geodesic_distances_ <- function( waypoint_ids <- unique(c(waypoint_ids, waypoint_milestone_percentages$waypoint_id)) milestone_percentages <- bind_rows( milestone_percentages, - waypoint_milestone_percentages %>% rename(cell_id = waypoint_id) + waypoint_milestone_percentages |> rename(cell_id = waypoint_id) ) } @@ -80,20 +80,19 @@ calculate_geodesic_distances_ <- function( # rename milestones to avoid name conflicts between cells and milestones milestone_trafo_fun <- function(x) paste0("MILESTONE_", x) - milestone_network <- milestone_network %>% mutate(from = milestone_trafo_fun(from), to = milestone_trafo_fun(to)) - milestone_ids <- milestone_ids %>% milestone_trafo_fun() - milestone_percentages <- milestone_percentages %>% mutate(milestone_id = milestone_trafo_fun(milestone_id)) - divergence_regions <- divergence_regions %>% mutate(milestone_id = milestone_trafo_fun(milestone_id)) + milestone_network <- milestone_network |> mutate(from = milestone_trafo_fun(from), to = milestone_trafo_fun(to)) + milestone_ids <- milestone_ids |> milestone_trafo_fun() + milestone_percentages <- milestone_percentages |> mutate(milestone_id = milestone_trafo_fun(milestone_id)) + divergence_regions <- divergence_regions |> mutate(milestone_id = milestone_trafo_fun(milestone_id)) # add 'extra' divergences for transitions not in a divergence extra_divergences <- - milestone_network %>% - # filter(from != to) %>% # filter self edges - rowwise() %>% - mutate(in_divergence = divergence_regions %>% group_by(divergence_id) %>% summarise(match = all(c(from, to) %in% milestone_id)) %>% {any(.$match)}) %>% - filter(!in_divergence) %>% - do({tibble(divergence_id = paste0(.$from, "__", .$to), milestone_id = c(.$from, .$to), is_start = c(T, F))}) %>% - ungroup() %>% + milestone_network |> + # filter(from != to) |> # filter self edges + rowwise() |> + mutate(in_divergence = divergence_regions |> group_by(divergence_id) |> summarise(match = all(c(from, to) %in% milestone_id)) |> (\(x) any(x$match))()) |> + filter(!in_divergence) |> + reframe(tibble(divergence_id = paste0(from, "__", to), milestone_id = c(from, to), is_start = c(TRUE, FALSE))) |> distinct(divergence_id, milestone_id, .keep_all = TRUE) divergence_regions <- bind_rows( @@ -111,17 +110,17 @@ calculate_geodesic_distances_ <- function( # calculate cell-cell distances for pairs of cells that are in the same transition, i.e. an edge or a divergence region cell_in_tent_distances <- map_df(divergence_ids, function(did) { - dir <- divergence_regions %>% filter(divergence_id == did) - mid <- dir %>% filter(is_start) %>% .$milestone_id + dir <- divergence_regions |> filter(divergence_id == did) + mid <- dir |> filter(is_start) |> pull(milestone_id) tent <- dir$milestone_id tent_nomid <- setdiff(tent, mid) tent_distances <- igraph::distances(mil_gr, v = mid, to = tent, mode = "out", weights = igraph::E(mil_gr)$length) relevant_pct <- - milestone_percentages %>% - group_by(cell_id) %>% - filter(all(milestone_id %in% tent)) %>% + milestone_percentages |> + group_by(cell_id) |> + filter(all(milestone_id %in% tent)) |> ungroup() if (nrow(relevant_pct) <= 1) { @@ -129,14 +128,14 @@ calculate_geodesic_distances_ <- function( } scaled_dists <- - relevant_pct %>% + relevant_pct |> mutate(dist = percentage * tent_distances[mid, milestone_id]) pct_mat <- bind_rows( - scaled_dists %>% select(from = cell_id, to = milestone_id, length = dist), - tent_distances %>% as.data.frame() %>% gather(from, length) %>% mutate(to = from) - ) %>% + scaled_dists |> select(from = cell_id, to = milestone_id, length = dist), + tent_distances |> as.data.frame() |> gather(from, length) |> mutate(to = from) + ) |> reshape2::acast(from ~ to, value.var = "length", fill = 0) wp_cells <- rownames(pct_mat)[rownames(pct_mat) %in% waypoint_ids] @@ -150,7 +149,7 @@ calculate_geodesic_distances_ <- function( if (!isFALSE(directed)) { # calculate the sign of the distance # distance is negative if the cell is closer to the beginning than the waypoint - begin <- dir %>% filter(is_start) %>% pull(milestone_id) + begin <- dir |> filter(is_start) |> pull(milestone_id) signs <- sign(-outer(distances[, begin], distances[begin, ], "-")) signs[is.na(signs)] <- 1 # when disconnected, sign will be NaN, so that distance remains + Inf @@ -159,10 +158,10 @@ calculate_geodesic_distances_ <- function( distances <- distances * signs } - distances <- distances %>% - as.matrix() %>% - reshape2::melt(varnames = c("from", "to"), value.name = "length") %>% - mutate_at(c("from", "to"), as.character) %>% + distances <- distances |> + as.matrix() |> + reshape2::melt(varnames = c("from", "to"), value.name = "length") |> + mutate(across(c("from", "to"), as.character)) |> filter(from != to) distances @@ -181,26 +180,26 @@ calculate_geodesic_distances_ <- function( cell_in_tent_distances$from2, cell_in_tent_distances$to ) - cell_in_tent_distances <- cell_in_tent_distances %>% select(-from2) + cell_in_tent_distances <- cell_in_tent_distances |> select(-from2) cell_in_tent_distances$length <- abs(cell_in_tent_distances$length) # add reverse edges if distance approx. zero # this is necessary because the direction will be taken into account cell_in_tent_distances <- bind_rows( cell_in_tent_distances, - cell_in_tent_distances %>% - filter(length <= 1e-20) %>% - mutate(from2 = from, from = to, to = from2) %>% + cell_in_tent_distances |> + filter(length <= 1e-20) |> + mutate(from2 = from, from = to, to = from2) |> select(-from2) ) } # combine all networks into one graph gr <- - bind_rows(milestone_network, cell_in_tent_distances) %>% - group_by(from, to) %>% - summarise(length = min(length)) %>% - ungroup() %>% + bind_rows(milestone_network, cell_in_tent_distances) |> + group_by(from, to) |> + summarise(length = min(length)) |> + ungroup() |> igraph::graph_from_data_frame(directed = directed, vertices = unique(c(milestone_ids, cell_ids_trajectory, waypoint_ids))) # compute cell-to-cell distances across entire graph @@ -209,7 +208,7 @@ calculate_geodesic_distances_ <- function( directed == "reverse" ~ "in", TRUE ~ "all" ) - out <- gr %>% + out <- gr |> igraph::distances( v = waypoint_ids, to = cell_ids_trajectory, diff --git a/R/calculate_trajectory_dimred.R b/R/calculate_trajectory_dimred.R index 208a8f91..a87bb971 100755 --- a/R/calculate_trajectory_dimred.R +++ b/R/calculate_trajectory_dimred.R @@ -47,7 +47,7 @@ calculate_trajectory_dimred <- function( milestone_ids <- trajectory$milestone_ids num_milestones <- length(milestone_ids) milestone_network <- - trajectory$milestone_network %>% + trajectory$milestone_network |> filter(to != "FILTERED_CELLS") milestone_percentages <- trajectory$milestone_percentages is_directed <- any(trajectory$milestone_network$directed) @@ -58,23 +58,23 @@ calculate_trajectory_dimred <- function( # for better layout results if (!is.null(trajectory$divergence_regions) && nrow(trajectory$divergence_regions) > 0) { divergence_edges <- - get_divergence_triangles(trajectory$divergence_regions) %>% - left_join(milestone_network %>% select(start = from, node1 = to, length1 = length, directed), by = c("start", "node1")) %>% - left_join(milestone_network %>% select(start = from, node2 = to, length2 = length), by = c("start", "node2")) %>% - mutate(length = (length1 + length2) / 2) %>% + get_divergence_triangles(trajectory$divergence_regions) |> + left_join(milestone_network |> select(start = from, node1 = to, length1 = length, directed), by = c("start", "node1")) |> + left_join(milestone_network |> select(start = from, node2 = to, length2 = length), by = c("start", "node2")) |> + mutate(length = (length1 + length2) / 2) |> select(from = node1, to = node2, length, directed) structure <- bind_rows(structure, divergence_edges) } # adjust weights on structure to make it easier to plot if (adjust_weights && min(structure$length) * 3 < max(structure$length)) { - structure <- structure %>% mutate( + structure <- structure |> mutate( length = sqrt(dynutils::scale_minmax(length) + .5) ) } # add weights as length - structure <- structure %>% + structure <- structure |> mutate(weight = pmax(length, 1e-5)) # round weights to some closest value @@ -83,35 +83,33 @@ calculate_trajectory_dimred <- function( # reduce dimensionality on milestone_network gr <- igraph::graph_from_data_frame(structure, vertices = milestone_ids) - layout <- - igraph::layout_with_kk(gr, dim = 2, maxiter = 10000) %>% - dynutils::scale_uniform() %>% - set_rownames(milestone_ids) %>% - set_colnames(paste0("comp_", seq_len(ncol(.)))) - space_milest_df <- layout %>% - as.data.frame() %>% + layout <- igraph::layout_with_kk(gr, dim = 2, maxiter = 10000) |> + dynutils::scale_uniform() + rownames(layout) <- milestone_ids + colnames(layout) <- paste0("comp_", seq_len(ncol(layout))) + space_milest_df <- layout |> + as.data.frame() |> rownames_to_column() # project dimensionality to samples mix_dimred <- function(milid, milpct) { - apply(layout[milid,,drop = FALSE], 2, function(x) sum(x * milpct)) %>% t %>% as_tibble + apply(layout[milid,,drop = FALSE], 2, function(x) sum(x * milpct)) |> t() |> as_tibble() } # create output for samples - cell_positions <- milestone_percentages %>% - group_by(cell_id) %>% - do(mix_dimred(.$milestone_id, .$percentage)) %>% - ungroup %>% + cell_positions <- milestone_percentages |> + group_by(cell_id) |> + reframe(mix_dimred(milestone_id, percentage)) |> slice(match(cell_ids, cell_id)) # create output for milestones - milestone_positions <- space_milest_df %>% + milestone_positions <- space_milest_df |> rename(milestone_id = rowname) # create output for edges between milestones - edge_positions <- milestone_network %>% - left_join(space_milest_df %>% select(from = rowname, comp_1_from = comp_1, comp_2_from = comp_2), by = "from") %>% - left_join(space_milest_df %>% select(to = rowname, comp_1_to = comp_1, comp_2_to = comp_2), by = "to") %>% + edge_positions <- milestone_network |> + left_join(space_milest_df |> select(from = rowname, comp_1_from = comp_1, comp_2_from = comp_2), by = "from") |> + left_join(space_milest_df |> select(to = rowname, comp_1_to = comp_1, comp_2_to = comp_2), by = "to") |> select(from, to, length, directed, comp_1_from, comp_2_from, comp_1_to, comp_2_to) # extra lines and polygons for divergence regions @@ -120,17 +118,17 @@ calculate_trajectory_dimred <- function( triags <- get_divergence_triangles(trajectory$divergence_regions) divergence_edge_positions <- - triags %>% - select(from = node1, to = node2) %>% - left_join(space_milest_df %>% select(from = rowname, comp_1_from = comp_1, comp_2_from = comp_2), by = "from") %>% - left_join(space_milest_df %>% select(to = rowname, comp_1_to = comp_1, comp_2_to = comp_2), by = "to") + triags |> + select(from = node1, to = node2) |> + left_join(space_milest_df |> select(from = rowname, comp_1_from = comp_1, comp_2_from = comp_2), by = "from") |> + left_join(space_milest_df |> select(to = rowname, comp_1_to = comp_1, comp_2_to = comp_2), by = "to") # define polygon triangles divergence_polygon_positions <- - triags %>% - mutate(triangle_id = paste0("triangle_", row_number())) %>% - select(-divergence_id) %>% - gather(triangle_part, milestone_id, -triangle_id) %>% + triags |> + mutate(triangle_id = paste0("triangle_", row_number())) |> + select(-divergence_id) |> + gather(triangle_part, milestone_id, -triangle_id) |> left_join(milestone_positions, "milestone_id") } else { divergence_edge_positions <- tibble(from = character(0), to = character(0), comp_1_from = numeric(0), comp_2_from = numeric(0), comp_1_to = numeric(0), comp_2_to = numeric(0)) @@ -161,20 +159,20 @@ calculate_trajectory_dimred <- function( #' @noRd get_divergence_triangles <- function(divergence_regions) { map_df(unique(divergence_regions$divergence_id), function(did) { - rel_did <- divergence_regions %>% filter(divergence_id == did) + rel_did <- divergence_regions |> filter(divergence_id == did) - fr <- rel_did %>% filter(is_start) %>% pull(milestone_id) - tos <- rel_did %>% filter(!is_start) %>% pull(milestone_id) + fr <- rel_did |> filter(is_start) |> pull(milestone_id) + tos <- rel_did |> filter(!is_start) |> pull(milestone_id) crossing( node1 = tos, node2 = tos - ) %>% - filter(node1 > node2) %>% + ) |> + filter(node1 > node2) |> mutate( divergence_id = did, start = fr - ) %>% + ) |> select(divergence_id, start, node1, node2) }) } diff --git a/R/classify_milestone_network.R b/R/classify_milestone_network.R index 632c0ab4..26d4dfb9 100755 --- a/R/classify_milestone_network.R +++ b/R/classify_milestone_network.R @@ -44,9 +44,9 @@ classify_milestone_network <- function(milestone_network) { is_directed <- any(milestone_network$directed) - gr <- milestone_network %>% - mutate(weight = length) %>% - igraph::graph_from_data_frame(directed = is_directed) %>% + gr <- milestone_network |> + mutate(weight = length) |> + igraph::graph_from_data_frame(directed = is_directed) |> simplify_igraph_network() props <- determine_milenet_props(gr) @@ -222,7 +222,7 @@ has_cycle_function <- function(gr) { } else { for (from in names(igraph::V(gr))) { # if two nodes are connected by multiple edges, return true - if (any(duplicated(igraph::neighbors(gr, from) %>% names))) { + if (any(duplicated(igraph::neighbors(gr, from) |> names()))) { return(TRUE) } # if there are two different paths between two distinct nodes, return true diff --git a/R/convert_milestone_percentages_to_progressions.R b/R/convert_milestone_percentages_to_progressions.R index 5e854294..aa21ef65 100755 --- a/R/convert_milestone_percentages_to_progressions.R +++ b/R/convert_milestone_percentages_to_progressions.R @@ -25,36 +25,36 @@ convert_milestone_percentages_to_progressions <- function( ) { # for cells that have 2 or more milestones progr_part1 <- - milestone_network %>% - inner_join(milestone_percentages, by = c("to" = "milestone_id")) %>% - inner_join(milestone_percentages %>% select(cell_id, milestone_id), by = c("from" = "milestone_id", "cell_id")) %>% + milestone_network |> + inner_join(milestone_percentages, by = c("to" = "milestone_id")) |> + inner_join(milestone_percentages |> select(cell_id, milestone_id), by = c("from" = "milestone_id", "cell_id")) |> select(cell_id, from, to, percentage) # for cells that have just 1 milestone milnetdf <- bind_rows( - milestone_network %>% transmute(milestone_id = to, from, to, percentage = 1), - milestone_network %>% transmute(milestone_id = from, from, to, percentage = 0) + milestone_network |> transmute(milestone_id = to, from, to, percentage = 1), + milestone_network |> transmute(milestone_id = from, from, to, percentage = 0) ) milpct_just1 <- - milestone_percentages %>% - group_by(cell_id) %>% + milestone_percentages |> + group_by(cell_id) |> filter(n() == 1) progr_part2 <- if (nrow(milpct_just1) > 0) { - milpct_just1 %>% - select(-percentage) %>% - left_join(milnetdf, by = "milestone_id") %>% - filter(percentage == max(percentage)) %>% # prefer rows where percentage == 1 - sample_n(1) %>% - ungroup() %>% + milpct_just1 |> + select(-percentage) |> + left_join(milnetdf, by = "milestone_id") |> + filter(percentage == max(percentage)) |> # prefer rows where percentage == 1 + sample_n(1) |> + ungroup() |> select(cell_id, from, to, percentage) } else { NULL } progr <- - bind_rows(progr_part1, progr_part2) %>% + bind_rows(progr_part1, progr_part2) |> arrange(match(cell_id, cell_ids)) assert_that( diff --git a/R/convert_progressions_to_milestone_percentages.R b/R/convert_progressions_to_milestone_percentages.R index c678cebe..c67f27d2 100755 --- a/R/convert_progressions_to_milestone_percentages.R +++ b/R/convert_progressions_to_milestone_percentages.R @@ -29,21 +29,21 @@ convert_progressions_to_milestone_percentages <- function( stop("In ", sQuote("progressions"), ", cells should only have 1 unique from milestone.") } - check_edges <- progressions %>% - left_join(milestone_network, by = c("from", "to")) %>% - left_join(milestone_network %>% select(to = from, from = to, length2 = length), by = c("from", "to")) + check_edges <- progressions |> + left_join(milestone_network, by = c("from", "to")) |> + left_join(milestone_network |> select(to = from, from = to, length2 = length), by = c("from", "to")) if (any(is.na(check_edges$length) & is.na(check_edges$length2))) { stop("All from-to combinations in ", sQuote("progressions"), " should be in ", sQuote("milestone_network"), " as well.") } # determine milestone percentages for self edges - selfs <- progressions %>% - filter(from == to) %>% - select(cell_id, milestone_id = from) %>% + selfs <- progressions |> + filter(from == to) |> + select(cell_id, milestone_id = from) |> mutate(percentage = 1) - progressions <- progressions %>% + progressions <- progressions |> filter(from != to) # determine milestone percentages for 'from' milestones @@ -51,12 +51,12 @@ convert_progressions_to_milestone_percentages <- function( from_pct <- 1 - tapply(progressions$percentage, progressions$cell_id, sum, default = NA_real_) froms <- tibble( cell_id = names(from_mls) %||% character(), - milestone_id = from_mls[cell_id] %>% unname() %>% as.character(), - percentage = from_pct[cell_id] %>% unname() %>% as.numeric() + milestone_id = from_mls[cell_id] |> unname() |> as.character(), + percentage = from_pct[cell_id] |> unname() |> as.numeric() ) # determine milestone percentages for 'to' milestones - tos <- progressions %>% + tos <- progressions |> select(cell_id, milestone_id = to, percentage) # return all percentages diff --git a/R/method_create_ti_method_container.R b/R/method_create_ti_method_container.R index 11b14b63..dec6cdd3 100755 --- a/R/method_create_ti_method_container.R +++ b/R/method_create_ti_method_container.R @@ -126,7 +126,7 @@ create_ti_method_container <- function( container_id = method$run$container_id, command = NULL, args = args, - volumes = paste0(preproc_meta$dir_dynwrap %>% fix_windows_path(), ":/ti"), + volumes = paste0(preproc_meta$dir_dynwrap |> fix_windows_path(), ":/ti"), workspace = "/ti/workspace", verbose = preproc_meta$verbose, debug = preproc_meta$debug @@ -155,8 +155,8 @@ fix_windows_path <- function(path) { path <- gsub("\\\\", "/", path) start <- - gsub("^([a-zA-Z]):/.*", "/\\1", path) %>% - tolower + gsub("^([a-zA-Z]):/.*", "/\\1", path) |> + tolower() gsub("[^:/]:", start, path) } diff --git a/R/method_create_ti_method_r.R b/R/method_create_ti_method_r.R index 27af6ce5..0e483d9f 100755 --- a/R/method_create_ti_method_r.R +++ b/R/method_create_ti_method_r.R @@ -45,7 +45,7 @@ #' } #' } #' -#' wrap_data(cell_ids = rownames(expression)) %>% +#' wrap_data(cell_ids = rownames(expression)) |> #' add_linear_trajectory(pseudotime = pseudotime) #' } #' @@ -137,8 +137,8 @@ generate_parameter_documentation <- function(definition) { parameter <- definition$parameters$parameters[[parameter_id]] param_desc <- dynparam::get_description(parameter, sep = ". ") # escape { and } to avoid roxygen issues - param_desc_escaped <- param_desc %>% - stringr::str_replace_all("\\{", "\\\\{") %>% + param_desc_escaped <- param_desc |> + stringr::str_replace_all("\\{", "\\\\{") |> stringr::str_replace_all("\\}", "\\\\}") paste0("@param ", parameter$id, " ", param_desc_escaped, ".") } diff --git a/R/method_execute.R b/R/method_execute.R index 8c5d876e..cbc06e69 100755 --- a/R/method_execute.R +++ b/R/method_execute.R @@ -123,7 +123,7 @@ timings <- map_dbl(timings, as.numeric) # calculate timing differences - timings_diff <- diff(timings[c("execution_start", "method_beforepreproc", "method_afterpreproc", "method_aftermethod", "method_afterpostproc", "execution_stop")]) %>% + timings_diff <- diff(timings[c("execution_start", "method_beforepreproc", "method_afterpreproc", "method_aftermethod", "method_afterpostproc", "execution_stop")]) |> set_names(c("time_sessionsetup", "time_preprocessing", "time_method", "time_postprocessing", "time_sessioncleanup")) # create a summary tibble @@ -134,8 +134,8 @@ stdout = stds$stdout, stderr = stds$stderr, error = error, - prior_df = list(method$wrapper$inputs %>% rename(prior_id = input_id) %>% mutate(given = prior_id %in% names(inputs))) - ) %>% + prior_df = list(method$wrapper$inputs |> rename(prior_id = input_id) |> mutate(given = prior_id %in% names(inputs))) + ) |> bind_cols(as.data.frame(as.list(timings_diff))) }, error = function(e) { stop("Error produced in dynwrap input/output:\n", as.character(e)) diff --git a/R/method_extract_args.R b/R/method_extract_args.R index ddf03c14..82e0efe4 100755 --- a/R/method_extract_args.R +++ b/R/method_extract_args.R @@ -3,11 +3,11 @@ inputs ) { input_ids_dataset <- - inputs %>% - filter(required, type == "expression") %>% + inputs |> + filter(required, type == "expression") |> pull(input_id) - map(input_ids_dataset, get_expression, dataset = dataset) %>% + map(input_ids_dataset, get_expression, dataset = dataset) |> set_names(input_ids_dataset) } @@ -27,8 +27,8 @@ # required, check if the prior infirm required_prior_ids <- - inputs %>% - filter(required, type == "prior_information") %>% + inputs |> + filter(required, type == "prior_information") |> pull(input_id) if (!all(required_prior_ids %in% names(priors))) { @@ -36,7 +36,7 @@ missing_priors <- setdiff(required_prior_ids, names(priors)) missing_priors_text <- glue::glue_collapse(crayon::bold(missing_priors), sep = ", ", last = " and ") - add_prior_information_params_text <- glue::glue("{missing_priors} = ") %>% glue::glue_collapse(", ") + add_prior_information_params_text <- glue::glue("{missing_priors} = ") |> glue::glue_collapse(", ") add_prior_information_text <- crayon::italic(glue::glue("add_prior_information(dataset, {add_prior_information_params_text})")) stop( @@ -53,8 +53,8 @@ # optional optional_prior_ids <- - inputs %>% - filter(!required, type == "prior_information", input_id %in% give_priors) %>% + inputs |> + filter(!required, type == "prior_information", input_id %in% give_priors) |> pull(input_id) if (!all(optional_prior_ids %in% names(priors))) { diff --git a/R/method_get_ti_methods.R b/R/method_get_ti_methods.R index 167ee78f..f583ea8f 100755 --- a/R/method_get_ti_methods.R +++ b/R/method_get_ti_methods.R @@ -53,23 +53,23 @@ get_ti_methods <- function( fun <- get(function_name, env) if (evaluate) { - meth_metadata <- fun() %>% discard(is.function) + meth_metadata <- fun() |> discard(is.function) } else { - meth_metadata <- list(id = function_name %>% stringr::str_replace("^ti_", "")) + meth_metadata <- list(id = function_name |> stringr::str_replace("^ti_", "")) } meth_metadata$fun <- fun meth_metadata }) - }) %>% - unlist(recursive = FALSE) %>% + }) |> + unlist(recursive = FALSE) |> list_as_tibble() if (!is.null(method_ids)) { assert_that(all(method_ids %in% ti_methods$id | grepl("/", method_ids))) - ti_methods <- ti_methods %>% slice(match(method_ids, id)) + ti_methods <- ti_methods |> slice(match(method_ids, id)) docker_repos <- - method_ids %>% + method_ids |> keep(~ grepl("/", .)) ti_methods2 <- list_as_tibble(map(docker_repos, function(repo) { diff --git a/R/method_process_definition.R b/R/method_process_definition.R index 9c04afb9..2c04672b 100755 --- a/R/method_process_definition.R +++ b/R/method_process_definition.R @@ -34,7 +34,7 @@ definition <- function( package = NULL, parameters = parameter_set() ) { - definition <- as.list(environment()) %>% + definition <- as.list(environment()) |> add_class("dynwrap::ti_method") inputs <- c(definition$wrapper$input_required, definition$wrapper$input_optional) diff --git a/R/package.R b/R/package.R index ba378f4b..33e462ab 100755 --- a/R/package.R +++ b/R/package.R @@ -10,12 +10,10 @@ #' @import assertthat #' @import dynparam #' @importFrom tibble is_tibble as_tibble tibble enframe deframe lst tribble rownames_to_column column_to_rownames -#' @importFrom magrittr %<>% %$% set_rownames set_colnames #' @importFrom glue glue #' -#' @docType package -#' @name dynwrap -NULL +#' @keywords internal +"_PACKAGE" @@ -44,6 +42,7 @@ if(getRversion() >= "2.15.1") { "ix", "label", "length1", "length2", "milestone_id", "new_milestone_id", "new_new_milestone_id", "node", "node1", "node2", "num_cells", "one", "percentage", "PREDICT", "prior_id", "required", "rowname", + "id", "match", "membership", "order", "path", "sd", "start", "waypoint_id", "weight", "zero", "time", "to", "to_waypoint", "triangle_id", "triangle_part", "type", "comp_1_from", "comp_2_from", "comp_1_to", "comp_2_to", "str_subset")) diff --git a/R/project_waypoints.R b/R/project_waypoints.R index 7fa0ff44..df453525 100755 --- a/R/project_waypoints.R +++ b/R/project_waypoints.R @@ -34,7 +34,7 @@ project_waypoints <- function( # apply kernel on geodesic distances # in theory, many kernels are possible here, but for now this is fixed to a normal kernel - weights <- waypoints$geodesic_distances %>% + weights <- waypoints$geodesic_distances |> stats::dnorm(sd = trajectory_projection_sd) assert_that(all(!is.na(weights))) @@ -89,7 +89,7 @@ project_trajectory <- function( lst( dimred_segment_points = dimred_segment_points, - dimred_segment_progressions = waypoints$progressions %>% select(from, to, percentage), + dimred_segment_progressions = waypoints$progressions |> select(from, to, percentage), dimred_milestones = dimred_milestones ) } diff --git a/R/simplify_igraph_network.R b/R/simplify_igraph_network.R index 84ecbba1..28e49d9c 100755 --- a/R/simplify_igraph_network.R +++ b/R/simplify_igraph_network.R @@ -62,7 +62,7 @@ simplify_igraph_network <- function( # make sure all from -> to are present in edge points in the same directions as the graph if (!is.null(edge_points)) { edge_points <- bind_rows( - anti_join(edge_points, igraph::as_data_frame(gr), c("from", "to")) %>% rename(from = to, to = from) %>% mutate(percentage = 1 - percentage), + anti_join(edge_points, igraph::as_data_frame(gr), c("from", "to")) |> rename(from = to, to = from) |> mutate(percentage = 1 - percentage), semi_join(edge_points, igraph::as_data_frame(gr), c("from", "to")) ) } @@ -73,7 +73,7 @@ simplify_igraph_network <- function( force_keep <- paste0("#M#", force_keep) } if (!is.null(edge_points)) { - edge_points <- edge_points %>% mutate_at(c("from", "to"), ~ paste0("#M#", .)) + edge_points <- edge_points |> mutate_at(c("from", "to"), ~ paste0("#M#", .)) } # add weight attribute if not already present @@ -95,8 +95,8 @@ simplify_igraph_network <- function( keep_v <- simplify_determine_nodes_to_keep(subgr = subgr, is_directed = is_directed, force_keep = force_keep) sub_edge_points <- if (!is.null(edge_points)) { - edge <- igraph::as_data_frame(subgr) %>% select(from, to) - edges_bothdir <- bind_rows(edge, edge %>% select(from = to, to = from)) %>% unique() + edge <- igraph::as_data_frame(subgr) |> select(from, to) + edges_bothdir <- bind_rows(edge, edge |> select(from = to, to = from)) |> unique() inner_join(edges_bothdir, edge_points, by = c("from", "to")) } else { NULL @@ -107,7 +107,7 @@ simplify_igraph_network <- function( keep_v[[1]] <- TRUE } - num_vs <- igraph::V(subgr) %>% length + num_vs <- igraph::V(subgr) |> length() neighs <- simplify_get_neighbours(subgr, is_directed) to_process <- !keep_v @@ -147,10 +147,10 @@ simplify_igraph_network <- function( right_path[[length(right_path) + 1]] <- tibble(from = j_prev, to = j, weight = simplify_get_edge(subgr, j_prev, j)$weight) } - left_path <- bind_rows(rev(left_path)) %>% - mutate_at(c("from", "to"), ~ igraph::V(subgr)$name[.]) - right_path <- bind_rows(right_path) %>% - mutate_at(c("from", "to"), ~ igraph::V(subgr)$name[.]) + left_path <- bind_rows(rev(left_path)) |> + mutate(across(c("from", "to"), ~ igraph::V(subgr)$name[.])) + right_path <- bind_rows(right_path) |> + mutate(across(c("from", "to"), ~ igraph::V(subgr)$name[.])) if (i == j && !allow_self_loops) { path <- bind_rows(left_path, right_path) @@ -168,21 +168,21 @@ simplify_igraph_network <- function( igraph::V(subgr)[[v_rem]]$name <- naml # add new milestone - sub_edge_points <- sub_edge_points %>% mutate_at(c("from", "to"), ~ ifelse(. == nam, namr, .)) - subgr <- subgr %>% igraph::add_vertices(1, attr = list(name = namr)) + sub_edge_points <- sub_edge_points |> mutate(across(c("from", "to"), ~ ifelse(. == nam, namr, .))) + subgr <- subgr |> igraph::add_vertices(1, attr = list(name = namr)) v_add <- igraph::V(subgr)[[namr]] # remove edge between v_rem and j - subgr <- subgr %>% - igraph::add.edges( - c(v_rem, v_add, v_add, j), attr = list(weight = c(0, simplify_get_edge(subgr, v_rem, j)$weight), directed = is_directed) - ) %>% - {igraph::delete.edges(., simplify_get_edge(., v_rem, j))} + subgr <- igraph::add.edges( + subgr, + c(v_rem, v_add, v_add, j), attr = list(weight = c(0, simplify_get_edge(subgr, v_rem, j)$weight), directed = is_directed) + ) + subgr <- igraph::delete.edges(subgr, simplify_get_edge(subgr, v_rem, j)) keep_v[nam] <- TRUE } else if (nrow(path) > 3) { # remove nodes, except for i_prev and j_prev nami <- igraph::V(subgr)[[i]]$name - rem_path <- path %>% filter(from != nami & to != nami) + rem_path <- path |> filter(from != nami & to != nami) rplcd <- simplify_replace_edges(subgr, sub_edge_points, i_prev, j_prev, rem_path, is_directed) subgr <- rplcd$subgr @@ -211,7 +211,7 @@ simplify_igraph_network <- function( } } - subgr <- subgr %>% igraph::delete.vertices(which(!keep_v)) + subgr <- subgr |> igraph::delete.vertices(which(!keep_v)) lst(subgr, sub_edge_points) }) @@ -228,7 +228,7 @@ simplify_igraph_network <- function( if (is.null(edge_points)) { outgr } else { - seps <- seps %>% mutate_at(c("from", "to"), ~ gsub("^#M#", "", .)) + seps <- seps |> mutate(across(c("from", "to"), ~ gsub("^#M#", "", .))) lst(gr = outgr, edge_points = seps) } } @@ -236,7 +236,7 @@ simplify_igraph_network <- function( simplify_determine_nodes_to_keep <- function(subgr, is_directed, force_keep) { name_check <- igraph::V(subgr)$name %in% force_keep - loop_check <- igraph::V(subgr) %>% + loop_check <- igraph::V(subgr) |> map_lgl(~ igraph::are_adjacent(subgr, ., .)) degr_check <- @@ -250,17 +250,17 @@ simplify_determine_nodes_to_keep <- function(subgr, is_directed, force_keep) { } simplify_get_neighbours <- function(subgr, is_directed) { - num_vs <- igraph::V(subgr) %>% length + num_vs <- igraph::V(subgr) |> length() if (is_directed) { - neighs_in <- seq_len(num_vs) %>% map(~igraph::neighbors(subgr, ., mode = "in") %>% as.integer) - neighs_out <- seq_len(num_vs) %>% map(~igraph::neighbors(subgr, ., mode = "out") %>% as.integer) + neighs_in <- seq_len(num_vs) |> map(~igraph::neighbors(subgr, ., mode = "in") |> as.integer()) + neighs_out <- seq_len(num_vs) |> map(~igraph::neighbors(subgr, ., mode = "out") |> as.integer()) lst( neighs_in, neighs_out ) } else { - neighs <- seq_len(num_vs) %>% map(~igraph::neighbors(subgr, .) %>% as.integer) + neighs <- seq_len(num_vs) |> map(~igraph::neighbors(subgr, .) |> as.integer()) lst( neighs ) @@ -294,21 +294,21 @@ simplify_get_next <- function(neighs, v_rem, is_directed, left = NA, prev = NA) } simplify_get_edge_points_on_path <- function(sub_edge_points, path) { - rev_path <- path %>% select(from = to, to = from) + rev_path <- path |> select(from = to, to = from) - sepaj <- sub_edge_points %>% + sepaj <- sub_edge_points |> anti_join(path, by = c("from", "to")) - toflip <- sepaj %>% + toflip <- sepaj |> inner_join(rev_path, by = c("from", "to")) on_path <- bind_rows( sub_edge_points, - toflip %>% rename(from = to, to = from) %>% mutate(percentage = 1 - percentage) - ) %>% + toflip |> rename(from = to, to = from) |> mutate(percentage = 1 - percentage) + ) |> inner_join(path, by = c("from", "to")) not_on_path <- - sepaj %>% + sepaj |> anti_join(rev_path, by = c("from", "to")) lst(on_path, not_on_path) @@ -326,23 +326,23 @@ simplify_replace_edges <- function(subgr, sub_edge_points, i, j, path, is_direct } path_len <- sum(path$weight) - subgr <- subgr %>% igraph::add.edges( + subgr <- subgr |> igraph::add.edges( c(i, j), attr = list(weight = path_len, directed = is_directed) ) if (!is.null(sub_edge_points)) { - path <- path %>% mutate(cs = cumsum(weight) - weight) + path <- path |> mutate(cs = cumsum(weight) - weight) out <- simplify_get_edge_points_on_path(sub_edge_points, path) processed_edge_points <- - out$on_path %>% - mutate(from = igraph::V(subgr)$name[[i]], to = igraph::V(subgr)$name[[j]]) %>% - mutate(percentage = case_when(path_len == 0 ~ 0.5, TRUE ~ (cs + percentage * weight) / path_len)) %>% + out$on_path |> + mutate(from = igraph::V(subgr)$name[[i]], to = igraph::V(subgr)$name[[j]]) |> + mutate(percentage = case_when(path_len == 0 ~ 0.5, TRUE ~ (cs + percentage * weight) / path_len)) |> select(id, from, to, percentage) if (swap) { - processed_edge_points <- processed_edge_points %>% mutate(percentage = 1 - percentage) + processed_edge_points <- processed_edge_points |> mutate(percentage = 1 - percentage) } sub_edge_points <- bind_rows(out$not_on_path, processed_edge_points) diff --git a/R/simplify_trajectory.R b/R/simplify_trajectory.R index 791f2b3b..0efa1c59 100755 --- a/R/simplify_trajectory.R +++ b/R/simplify_trajectory.R @@ -16,18 +16,18 @@ #' @export simplify_trajectory <- function(trajectory, allow_self_loops = FALSE) { gr <- igraph::graph_from_data_frame( - d = trajectory$milestone_network %>% rename(weight = length), + d = trajectory$milestone_network |> rename(weight = length), directed = any(trajectory$milestone_network$directed), vertices = trajectory$milestone_ids ) # cell simplification - edge_points <- trajectory$progressions %>% rename(id = cell_id) %>% mutate(id = paste0("SIMPLIFYCELL_", id)) + edge_points <- trajectory$progressions |> rename(id = cell_id) |> mutate(id = paste0("SIMPLIFYCELL_", id)) if (!is.null(trajectory$dimred_segment_points) && !is.null(trajectory$dimred_segment_progressions)) { edge_points <- bind_rows( edge_points, - trajectory$dimred_segment_progressions %>% mutate(id = paste0("SIMPLIFYSEGMENT_", seq_len(n()))) + trajectory$dimred_segment_progressions |> mutate(id = paste0("SIMPLIFYSEGMENT_", seq_len(n()))) ) } @@ -39,20 +39,20 @@ simplify_trajectory <- function(trajectory, allow_self_loops = FALSE) { edge_points = edge_points ) milestone_ids <- igraph::V(out$gr)$name - milestone_network <- igraph::as_data_frame(out$gr) %>% - select(from, to, length = weight, directed) %>% + milestone_network <- igraph::as_data_frame(out$gr) |> + select(from, to, length = weight, directed) |> distinct(from, to, .keep_all = TRUE) - progressions <- out$edge_points %>% - filter(grepl("^SIMPLIFYCELL_", id)) %>% + progressions <- out$edge_points |> + filter(grepl("^SIMPLIFYCELL_", id)) |> transmute(cell_id = gsub("^SIMPLIFYCELL_", "", id), from, to, percentage) # test whether milestone_network and progressions contain the exact same edges - different_edges <- progressions %>% group_by(from, to) %>% summarise() %>% anti_join(milestone_network, c("from", "to")) + different_edges <- progressions |> group_by(from, to) |> summarise() |> anti_join(milestone_network, c("from", "to")) if (nrow(different_edges) > 0) { stop("Trajectory simplification: some edges that are in the progressions are not present in the milestone network! This indicates a bug with edge flipping.") } - newtrajectory <- trajectory %>% + newtrajectory <- trajectory |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -67,18 +67,18 @@ simplify_trajectory <- function(trajectory, allow_self_loops = FALSE) { } if (!is.null(trajectory$dimred_segment_points) && !is.null(trajectory$dimred_segment_progressions)) { filtered_segs <- - out$edge_points %>% - filter(grepl("^SIMPLIFYSEGMENT_", id)) %>% - mutate(id = as.integer(gsub("^SIMPLIFYSEGMENT_", "", id))) %>% - group_by(from, to) %>% - arrange(percentage) %>% - filter(!duplicated(percentage)) %>% - ungroup() %>% + out$edge_points |> + filter(grepl("^SIMPLIFYSEGMENT_", id)) |> + mutate(id = as.integer(gsub("^SIMPLIFYSEGMENT_", "", id))) |> + group_by(from, to) |> + arrange(percentage) |> + filter(!duplicated(percentage)) |> + ungroup() |> arrange(from, to, percentage) newtrajectory$dimred_segment_points <- trajectory$dimred_segment_points[filtered_segs$id, , drop = FALSE] newtrajectory$dimred_segment_progressions <- - filtered_segs %>% select(from, to, percentage) + filtered_segs |> select(from, to, percentage) } # TODO: if newtrajectory contains grouping, dimred, ..., remove them as necessary diff --git a/R/wrap_add_branch_trajectory.R b/R/wrap_add_branch_trajectory.R index 8e0607e9..4e6f827a 100755 --- a/R/wrap_add_branch_trajectory.R +++ b/R/wrap_add_branch_trajectory.R @@ -74,32 +74,32 @@ add_branch_trajectory <- function( milestone_mapper_network <- tibble( from = paste0(branch_ids, "_from"), to = paste0(branch_ids, "_from") - ) %>% bind_rows( + ) |> bind_rows( tibble( from = paste0(branch_network$from, "_to"), to = paste0(branch_network$to, "_from") ) - ) %>% bind_rows( + ) |> bind_rows( tibble( from = paste0(branch_ids, "_to"), to = paste0(branch_ids, "_to") ) ) - mapper <- milestone_mapper_network %>% igraph::graph_from_data_frame() %>% igraph::components() %>% .$membership + mapper <- milestone_mapper_network |> igraph::graph_from_data_frame() |> igraph::components() |> (\(x) x$membership)() milestone_network$from <- as.character(mapper[milestone_network$from]) milestone_network$to <- as.character(mapper[milestone_network$to]) # merge branches info with milestone network - milestone_network <- milestone_network %>% + milestone_network <- milestone_network |> left_join(branches, "branch_id") # add extra milestones between loops, ie. A -> A becomes A -> A-0a -> A-0b -> A new_edge_length <- sum(milestone_network$length)/nrow(milestone_network)/100 - for (branch_id in milestone_network %>% filter(from == to) %>% pull(branch_id)) { - milestone_id <- milestone_network %>% filter(branch_id == !!branch_id) %>% pull(from) + for (branch_id in milestone_network |> filter(from == to) |> pull(branch_id)) { + milestone_id <- milestone_network |> filter(branch_id == !!branch_id) |> pull(from) new_milestone_ids <- paste0(milestone_id, "-", branch_id, c("a", "b")) - milestone_network <- milestone_network %>% - mutate(to = ifelse(branch_id == !!branch_id, new_milestone_ids[1], to)) %>% + milestone_network <- milestone_network |> + mutate(to = ifelse(branch_id == !!branch_id, new_milestone_ids[1], to)) |> bind_rows( tibble( from = new_milestone_ids, @@ -112,15 +112,15 @@ add_branch_trajectory <- function( } # create progressions - progressions <- branch_progressions %>% - left_join(milestone_network, "branch_id") %>% + progressions <- branch_progressions |> + left_join(milestone_network, "branch_id") |> select(cell_id, from, to, percentage) - milestone_network <- milestone_network %>% + milestone_network <- milestone_network |> select(from, to, length, directed) # create trajectory - dataset %>% + dataset |> add_trajectory( milestone_network = milestone_network, progressions = progressions @@ -133,13 +133,13 @@ check_branch_network <- function(branch_ids, branch_network) { assert_that(ncol(branch_network) == 2) assert_that(setequal(colnames(branch_network), c("from", "to"))) - branch_network <- branch_network %>% select(from, to) + branch_network <- branch_network |> select(from, to) assert_that(is.character(branch_network$from)) assert_that(is.character(branch_network$to)) assert_that(branch_network$from %all_in% branch_ids) assert_that(branch_network$to %all_in% branch_ids) - assert_that(!any(duplicated(branch_network %>% select(from, to)))) + assert_that(!any(duplicated(branch_network |> select(from, to)))) branch_network } @@ -149,14 +149,14 @@ check_branches <- function(branch_ids, branches) { assert_that(ncol(branches) == 3) assert_that(setequal(colnames(branches), c("branch_id", "length", "directed"))) - branches <- branches %>% select(branch_id, length, directed) + branches <- branches |> select(branch_id, length, directed) assert_that(is.character(branches$branch_id)) assert_that(is.numeric(branches$length)) assert_that(is.logical(branches$directed)) assert_that(branches$branch_id %all_in% branch_ids) - assert_that(!any(duplicated(branches %>% select(branch_id)))) + assert_that(!any(duplicated(branches |> select(branch_id)))) assert_that(!any(is.na(branches$length))) assert_that(!any(is.na(branches$directed))) @@ -168,7 +168,7 @@ check_branch_progressions <- function(cell_ids, branch_ids, branch_progressions) assert_that(ncol(branch_progressions) == 3) assert_that(setequal(colnames(branch_progressions), c("cell_id", "branch_id", "percentage"))) - branch_progressions <- branch_progressions %>% select(cell_id, branch_id, percentage) + branch_progressions <- branch_progressions |> select(cell_id, branch_id, percentage) assert_that(is.character(branch_progressions$cell_id)) assert_that(is.character(branch_progressions$branch_id)) diff --git a/R/wrap_add_cell_graph.R b/R/wrap_add_cell_graph.R index f77dbebc..4c0fbd9e 100755 --- a/R/wrap_add_cell_graph.R +++ b/R/wrap_add_cell_graph.R @@ -65,7 +65,7 @@ add_cell_graph <- function( # check to_keep if (is.character(to_keep)) { cell_ids <- unique(c(cell_graph$from, cell_graph$to)) - to_keep <- (cell_ids %in% to_keep) %>% set_names(cell_ids) + to_keep <- (cell_ids %in% to_keep) |> set_names(cell_ids) } else { cell_ids <- names(to_keep) } @@ -83,7 +83,7 @@ add_cell_graph <- function( # make igraph object ids <- names(to_keep) - gr <- igraph::graph_from_data_frame(cell_graph %>% rename(weight = length), directed = is_directed, vertices = ids) + gr <- igraph::graph_from_data_frame(cell_graph |> rename(weight = length), directed = is_directed, vertices = ids) # STEP 1: for each cell, find closest milestone v_keeps <- names(to_keep)[to_keep] @@ -91,7 +91,7 @@ add_cell_graph <- function( closest_trajpoint <- v_keeps[apply(dists, 1, which.min)] # STEP 2: simplify backbone - gr <- gr %>% + gr <- gr |> igraph::induced.subgraph(v_keeps) milestone_ids <- igraph::V(gr)$name @@ -99,51 +99,50 @@ add_cell_graph <- function( # STEP 3: Calculate progressions of cell_ids # determine which nodes were on each path milestone_network_proto <- - igraph::as_data_frame(gr) %>% - as_tibble() %>% - rowwise() %>% + igraph::as_data_frame(gr) |> + as_tibble() |> + rowwise() |> mutate( - path = igraph::shortest_paths(gr, from, to, mode = "out")$vpath %>% map(names) - ) %>% + path = igraph::shortest_paths(gr, from, to, mode = "out")$vpath |> map(names) + ) |> ungroup() # for each node, find an edge which contains the node and # calculate its progression along that edge progressions <- - milestone_network_proto %>% - rowwise() %>% - do(with(., tibble(from, to, weight, node = path))) %>% - ungroup %>% - group_by(node) %>% - slice(1) %>% + milestone_network_proto |> + rowwise() |> + reframe(from = from, to = to, weight = weight, node = unlist(path)) |> + group_by(node) |> + slice(1) |> mutate( percentage = ifelse(weight == 0, 0, igraph::distances(gr, from, node) / weight) - ) %>% - ungroup() %>% + ) |> + ungroup() |> right_join( tibble(cell_id = ids, node = closest_trajpoint), by = "node" - ) %>% + ) |> select(cell_id, from, to, percentage) # create output - milestone_network <- milestone_network_proto %>% - select(from, to, length = weight) %>% + milestone_network <- milestone_network_proto |> + select(from, to, length = weight) |> mutate(directed = is_directed) # rename milestones so the milestones don't have the # same names as the nodes renamefun <- function(x) { - paste0(milestone_prefix, x) %>% + paste0(milestone_prefix, x) |> set_names(names(x)) } - milestone_network <- milestone_network %>% - mutate_at(c("from", "to"), renamefun) - milestone_ids <- milestone_ids %>% - renamefun - progressions <- progressions %>% - mutate_at(c("from", "to"), renamefun) + milestone_network <- milestone_network |> + mutate(across(c("from", "to"), renamefun)) + milestone_ids <- milestone_ids |> + renamefun() + progressions <- progressions |> + mutate(across(c("from", "to"), renamefun)) # return output add_trajectory( @@ -153,6 +152,6 @@ add_cell_graph <- function( divergence_regions = NULL, progressions = progressions, ... - ) %>% + ) |> simplify_trajectory() } diff --git a/R/wrap_add_cell_waypoints.R b/R/wrap_add_cell_waypoints.R index 719c605a..01ab3ccd 100755 --- a/R/wrap_add_cell_waypoints.R +++ b/R/wrap_add_cell_waypoints.R @@ -30,7 +30,7 @@ add_cell_waypoints <- function(trajectory, num_cells_selected = 100) { )) # create output structure - trajectory %>% extend_with( + trajectory |> extend_with( "dynwrap::with_cell_waypoints", waypoint_cells = waypoint_cells ) @@ -52,43 +52,43 @@ determine_cell_trajectory_positions <- function( progressions, divergence_regions ) { - divergence_ids <- divergence_regions$divergence_id %>% unique + divergence_ids <- divergence_regions$divergence_id |> unique() - cells_in_milestone <- milestone_percentages %>% - filter(percentage > 1-1e-6) %>% + cells_in_milestone <- milestone_percentages |> + filter(percentage > 1-1e-6) |> mutate(index = match(milestone_id, milestone_ids)) cells_in_divergence <- map_df(seq_along(divergence_ids), function(dii) { - mid <- divergence_regions %>% - filter(divergence_id == divergence_ids[[dii]]) %>% - filter(!is_start) %>% + mid <- divergence_regions |> + filter(divergence_id == divergence_ids[[dii]]) |> + filter(!is_start) |> pull(milestone_id) - mid_start <- divergence_regions %>% - filter(divergence_id == divergence_ids[[dii]]) %>% - filter(is_start) %>% + mid_start <- divergence_regions |> + filter(divergence_id == divergence_ids[[dii]]) |> + filter(is_start) |> pull(milestone_id) - cells <- progressions %>% - filter(percentage < 1-1e-6, percentage > 1e-6) %>% - filter(from == mid_start, to %in% mid) %>% - filter(cell_id %in% cell_id[duplicated(cell_id)]) %>% - pull(cell_id) %>% + cells <- progressions |> + filter(percentage < 1-1e-6, percentage > 1e-6) |> + filter(from == mid_start, to %in% mid) |> + filter(cell_id %in% cell_id[duplicated(cell_id)]) |> + pull(cell_id) |> unique() tibble(index = dii, cell_id = cells, divergence_id = divergence_ids[dii]) }) - cells_on_edge <- progressions %>% - filter(percentage < 1-1e-6, percentage > 1e-6) %>% - filter(!cell_id %in% cell_id[duplicated(cell_id)]) %>% - left_join(milestone_network %>% mutate(index = seq_len(n())) %>% select(from, to, index), by = c("from", "to")) + cells_on_edge <- progressions |> + filter(percentage < 1-1e-6, percentage > 1e-6) |> + filter(!cell_id %in% cell_id[duplicated(cell_id)]) |> + left_join(milestone_network |> mutate(index = seq_len(n())) |> select(from, to, index), by = c("from", "to")) places <- bind_rows( - cells_in_milestone %>% mutate(type = "in_milestone"), - cells_on_edge %>% mutate(type = "on_edge"), - cells_in_divergence %>% mutate(type = "in_divergence") + cells_in_milestone |> mutate(type = "in_milestone"), + cells_on_edge |> mutate(type = "on_edge"), + cells_in_divergence |> mutate(type = "in_divergence") ) } @@ -108,10 +108,10 @@ select_waypoint_cells <- function( milestone_percentages, progressions, divergence_regions - ) %>% - group_by(type, index) %>% - summarise(num_cells = n(), cells = list(cell_id)) %>% - ungroup() %>% + ) |> + group_by(type, index) |> + summarise(num_cells = n(), cells = list(cell_id)) |> + ungroup() |> mutate( percentage = num_cells / sum(num_cells), num_cells_to_select = pmin(ceiling(percentage * num_cells_selected), num_cells) diff --git a/R/wrap_add_cluster_graph.R b/R/wrap_add_cluster_graph.R index f68596b1..f80b3502 100755 --- a/R/wrap_add_cluster_graph.R +++ b/R/wrap_add_cluster_graph.R @@ -47,7 +47,7 @@ add_cluster_graph <- function( if (is.null(grouping)) { assert_that(is_wrapper_with_grouping(dataset)) } else { - dataset <- dataset %>% add_grouping(grouping) + dataset <- dataset |> add_grouping(grouping) } grouping <- get_grouping(dataset) grouping <- grouping[!is.na(grouping)] @@ -67,18 +67,18 @@ add_cluster_graph <- function( # prefer to put a cell at the end of a transition, but put it at the start # if there is no other option. both_directions <- bind_rows( - milestone_network %>% select(from, to) %>% mutate(label = from, percentage = 0), - milestone_network %>% select(from, to) %>% mutate(label = to, percentage = 1) + milestone_network |> select(from, to) |> mutate(label = from, percentage = 0), + milestone_network |> select(from, to) |> mutate(label = to, percentage = 1) ) progressions <- tibble( cell_id = names(grouping), label = grouping - ) %>% - left_join(both_directions, by = "label") %>% - group_by(cell_id) %>% - arrange(desc(percentage)) %>% - slice(1) %>% - ungroup() %>% + ) |> + left_join(both_directions, by = "label") |> + group_by(cell_id) |> + arrange(desc(percentage)) |> + slice(1) |> + ungroup() |> select(-label) # return output @@ -97,14 +97,14 @@ add_cluster_graph <- function( cluster_graph_add_explicit_splits <- function(milestone_network) { # add extra splits - milestone_ids_implicit_split <- table(milestone_network$from) %>% keep(~.>=2) %>% names() %>% discard(~. %in% milestone_network$to) + milestone_ids_implicit_split <- table(milestone_network$from) |> keep(~.>=2) |> names() |> discard(~. %in% milestone_network$to) if (length(milestone_ids_implicit_split) > 0) { - milestone_ids_explicit_split <- paste0("split_", milestone_ids_implicit_split) %>% set_names(milestone_ids_implicit_split) - milestone_network <- milestone_network %>% + milestone_ids_explicit_split <- paste0("split_", milestone_ids_implicit_split) |> set_names(milestone_ids_implicit_split) + milestone_network <- milestone_network |> mutate( from = ifelse(from %in% names(milestone_ids_explicit_split), milestone_ids_explicit_split[from], from) - ) %>% + ) |> bind_rows( tibble( from = names(milestone_ids_explicit_split), @@ -116,14 +116,14 @@ cluster_graph_add_explicit_splits <- function(milestone_network) { } # add extra convergences - milestone_ids_implicit_convergence <- table(milestone_network$to) %>% keep(~.>=2) %>% names() %>% discard(~. %in% milestone_network$from) + milestone_ids_implicit_convergence <- table(milestone_network$to) |> keep(~.>=2) |> names() |> discard(~. %in% milestone_network$from) if (length(milestone_ids_implicit_convergence) > 0) { - milestone_ids_explicit_convergence <- paste0("convergence_", milestone_ids_implicit_convergence) %>% set_names(milestone_ids_implicit_convergence) - milestone_network <- milestone_network %>% + milestone_ids_explicit_convergence <- paste0("convergence_", milestone_ids_implicit_convergence) |> set_names(milestone_ids_implicit_convergence) + milestone_network <- milestone_network |> mutate( to = ifelse(to %in% names(milestone_ids_explicit_convergence), milestone_ids_explicit_convergence[to], to) - ) %>% + ) |> bind_rows( tibble( from = milestone_ids_explicit_convergence, diff --git a/R/wrap_add_cyclic_trajectory.R b/R/wrap_add_cyclic_trajectory.R index 4575321b..d0ce50c3 100755 --- a/R/wrap_add_cyclic_trajectory.R +++ b/R/wrap_add_cyclic_trajectory.R @@ -62,13 +62,13 @@ add_cyclic_trajectory <- function( progressions <- tibble( time = 3 * pseudotime, cell_id = names(pseudotime) - ) %>% - mutate(edge_id = ifelse(time <= 1, 1L, ifelse(time <= 2, 2L, 3L))) %>% - left_join(milestone_network, by = "edge_id") %>% - mutate(percentage = time - (edge_id - 1)) %>% + ) |> + mutate(edge_id = ifelse(time <= 1, 1L, ifelse(time <= 2, 2L, 3L))) |> + left_join(milestone_network, by = "edge_id") |> + mutate(percentage = time - (edge_id - 1)) |> select(cell_id, from, to, percentage) - milestone_network <- milestone_network %>% + milestone_network <- milestone_network |> select(from, to, length, directed) # return output diff --git a/R/wrap_add_dimred.R b/R/wrap_add_dimred.R index 85690a08..80295d3f 100755 --- a/R/wrap_add_dimred.R +++ b/R/wrap_add_dimred.R @@ -107,7 +107,7 @@ add_dimred <- function( } # create output structure - dataset %>% extend_with( + dataset |> extend_with( "dynwrap::with_dimred", dimred = dimred, dimred_milestones = dimred_milestones, @@ -139,8 +139,8 @@ get_dimred <- function(dataset, dimred = NULL, expression_source = "expression", # dataframe if ("cell_id" %in% colnames(dimred)) { rownames(dimred) <- NULL - dimred <- dimred %>% - as.data.frame() %>% + dimred <- dimred |> + as.data.frame() |> column_to_rownames("cell_id") } @@ -222,14 +222,14 @@ process_dimred <- function(dataset, dimred, identifier = "cell_id", has_rownames dimred[[identifier]] <- as.character(dimred[[identifier]]) rownames(dimred) <- NULL dimred <- - dimred %>% - as.data.frame() %>% - column_to_rownames(identifier) %>% + dimred |> + as.data.frame() |> + column_to_rownames(identifier) |> as.matrix() } assert_that(length(rownames(dimred)) == nrow(dimred)) } else { - dimred <- dimred %>% as.matrix() + dimred <- dimred |> as.matrix() } assert_that(is.numeric(dimred)) @@ -247,18 +247,18 @@ process_dimred <- function(dataset, dimred, identifier = "cell_id", has_rownames connect_dimred_segments <- function(dimred_segment_progressions, dimred_segment_points, milestone_network) { milestone_ids <- unique(c(milestone_network$from, milestone_network$to)) - connections <- milestone_ids %>% map(function(milestone_id) { + connections <- milestone_ids |> map(function(milestone_id) { # find the indices of the segment points that are closest to the milestone - ixs <- dimred_segment_progressions %>% - mutate(ix = row_number()) %>% - group_by(from, to) %>% - arrange(percentage) %>% + ixs <- dimred_segment_progressions |> + mutate(ix = row_number()) |> + group_by(from, to) |> + arrange(percentage) |> filter( xor( (row_number() == 1) & (from == !!milestone_id), (row_number() == n()) & (to == !!milestone_id) ) - ) %>% + ) |> pull(ix) if (length(ixs) > 0) { @@ -266,11 +266,11 @@ connect_dimred_segments <- function(dimred_segment_progressions, dimred_segment_ # create progressions for each new point progressions <- bind_rows( - milestone_network %>% filter(from == !!milestone_id) %>% select(from, to) %>% mutate(percentage = 0), - milestone_network %>% filter(to == !!milestone_id) %>% select(from, to) %>% mutate(percentage = 1) + milestone_network |> filter(from == !!milestone_id) |> select(from, to) |> mutate(percentage = 0), + milestone_network |> filter(to == !!milestone_id) |> select(from, to) |> mutate(percentage = 1) ) - points <- dimred_segment_points[ixs, , drop = FALSE] %>% colMeans() %>% rep(nrow(progressions)) %>% matrix(nrow = nrow(progressions), byrow = TRUE) + points <- dimred_segment_points[ixs, , drop = FALSE] |> colMeans() |> rep(nrow(progressions)) |> matrix(nrow = nrow(progressions), byrow = TRUE) list( progressions = progressions, @@ -284,8 +284,8 @@ connect_dimred_segments <- function(dimred_segment_progressions, dimred_segment_ } }) - connecting_progressions <- connections %>% map_dfr("progressions") - connecting_points <- connections %>% map("points") %>% do.call(rbind, .) + connecting_progressions <- connections |> map_dfr("progressions") + connecting_points <- connections |> map("points") |> do.call(rbind, .) list( dimred_segment_progressions = bind_rows(dimred_segment_progressions, connecting_progressions), diff --git a/R/wrap_add_dimred_projection.R b/R/wrap_add_dimred_projection.R index d36ec4ea..123a341e 100755 --- a/R/wrap_add_dimred_projection.R +++ b/R/wrap_add_dimred_projection.R @@ -88,12 +88,12 @@ add_dimred_projection <- function( segment_end = dimred_milestones[milestone_network$to, , drop = FALSE] ) progressions <- - milestone_network %>% - slice(proj$segment) %>% + milestone_network |> + slice(proj$segment) |> mutate( cell_id = names(proj$segment), percentage = proj$progression - ) %>% + ) |> select(cell_id, from, to, percentage) } else { # if grouping / clusterings are given, project cells only to segments @@ -105,7 +105,7 @@ add_dimred_projection <- function( # select all cells in this group if (length(cids) > 0) { - mns <- milestone_network %>% filter(from == group_id | to == group_id) + mns <- milestone_network |> filter(from == group_id | to == group_id) if (nrow(mns) > 0) { # project to segments @@ -135,23 +135,23 @@ add_dimred_projection <- function( }) # add missing group ids as clusters to the milestone network - missing_gids <- group_ids %>% setdiff(c(milestone_network$from, milestone_network$to)) - milestone_network <- milestone_network %>% + missing_gids <- group_ids |> setdiff(c(milestone_network$from, milestone_network$to)) + milestone_network <- milestone_network |> bind_rows(tibble(from = missing_gids, to = missing_gids, length = 0, directed = FALSE)) } dimred_segment_progressions <- - milestone_network %>% - select(from, to) %>% - mutate(zero = from, one = to) %>% - gather(percentage, milestone_id, zero, one) %>% + milestone_network |> + select(from, to) |> + mutate(zero = from, one = to) |> + gather(percentage, milestone_id, zero, one) |> mutate(percentage = c(zero = 0, one = 1)[percentage]) dimred_segment_points <- dimred_milestones[dimred_segment_progressions$milestone_id, , drop = FALSE] dimred_segment_progressions <- - dimred_segment_progressions %>% + dimred_segment_progressions |> select(from, to, percentage) # construct output @@ -162,7 +162,7 @@ add_dimred_projection <- function( divergence_regions = NULL, progressions = progressions, ... - ) %>% add_dimred( + ) |> add_dimred( dimred = dimred, dimred_milestones = dimred_milestones, dimred_segment_points = dimred_segment_points, @@ -171,7 +171,7 @@ add_dimred_projection <- function( # add cell grouping of a milestone_assignment was given if (!is.null(grouping)) { - out <- out %>% add_grouping( + out <- out |> add_grouping( group_ids = milestone_ids, grouping = grouping ) diff --git a/R/wrap_add_end_state_probabilities.R b/R/wrap_add_end_state_probabilities.R index e50f29ca..e92c3a22 100755 --- a/R/wrap_add_end_state_probabilities.R +++ b/R/wrap_add_end_state_probabilities.R @@ -53,7 +53,7 @@ add_end_state_probabilities <- function( } else { assert_that(all(0 <= pseudotime & pseudotime <= 1)) } - dataset <- dataset %>% add_pseudotime(pseudotime) + dataset <- dataset |> add_pseudotime(pseudotime) } else { assert_that("pseudotime" %in% names(dataset)) pseudotime <- dataset$pseudotime @@ -64,7 +64,7 @@ add_end_state_probabilities <- function( if (ncol(end_state_probabilities) == 1) { # process as linear of no end_state_probabilities are provided - dataset %>% + dataset |> add_linear_trajectory( pseudotime = pseudotime, directed = TRUE, @@ -91,11 +91,11 @@ add_end_state_probabilities <- function( ) # construct progressions - progressions <- end_state_probabilities %>% - gather("to", "percentage", -cell_id) %>% - mutate(from = start_milestone_id) %>% - group_by(cell_id) %>% - mutate(percentage = percentage / sum(percentage) * pseudotime[cell_id]) %>% # scale percentage so that sum = 1 + progressions <- end_state_probabilities |> + gather("to", "percentage", -cell_id) |> + mutate(from = start_milestone_id) |> + group_by(cell_id) |> + mutate(percentage = percentage / sum(percentage) * pseudotime[cell_id]) |> # scale percentage so that sum = 1 ungroup() # return output diff --git a/R/wrap_add_expression.R b/R/wrap_add_expression.R index 507755eb..96c52cbb 100755 --- a/R/wrap_add_expression.R +++ b/R/wrap_add_expression.R @@ -61,7 +61,7 @@ add_expression <- function( } # create output structure - dataset %>% extend_with( + dataset |> extend_with( "dynwrap::with_expression", counts = counts, expression = expression, @@ -150,7 +150,7 @@ wrap_expression <- function( feature_ids = feature_ids, feature_info = feature_info, ... - ) %>% + ) |> add_expression( counts = counts, expression = expression, diff --git a/R/wrap_add_feature_importance.R b/R/wrap_add_feature_importance.R index ca31c846..02f94c70 100644 --- a/R/wrap_add_feature_importance.R +++ b/R/wrap_add_feature_importance.R @@ -39,7 +39,7 @@ add_feature_importance <- function( ) # create output structure - dataset %>% extend_with( + dataset |> extend_with( "dynwrap::with_feature_importance", feature_importance = feature_importance, ... diff --git a/R/wrap_add_grouping.R b/R/wrap_add_grouping.R index 6c89c15e..f28d668e 100755 --- a/R/wrap_add_grouping.R +++ b/R/wrap_add_grouping.R @@ -52,7 +52,7 @@ add_grouping <- function( ) # create output structure - dataset %>% extend_with( + dataset |> extend_with( "dynwrap::with_grouping", group_ids = group_ids, grouping = grouping, @@ -75,8 +75,8 @@ get_grouping <- function(dataset, grouping = NULL) { grouping <- set_names(dataset$grouping, dataset$cell_ids) } else if (is_wrapper_with_prior_information(dataset)) { if("groups_id" %in% names(dataset$prior_information)) { - grouping <- dataset$prior_information$groups_id %>% - {set_names(.$group_id, .$cell_id)} + grouping <- dataset$prior_information$groups_id |> + (\(x) set_names(x$group_id, x$cell_id))() } } else { stop("Wrapper does not contain a grouping, provide grouping or add a grouping to wrapper using add_grouping") @@ -142,23 +142,23 @@ NULL group_onto_trajectory_edges <- function(trajectory, group_template = "{from}->{to}") { # first map cells to largest percentage (in case of divergence regions) progressions <- - trajectory$progressions %>% - group_by(cell_id) %>% - arrange(-percentage) %>% - slice(1) %>% + trajectory$progressions |> + group_by(cell_id) |> + arrange(-percentage) |> + slice(1) |> ungroup() # do the actual grouping grouping <- - progressions %>% - group_by(from, to) %>% - mutate(group_id = as.character(glue::glue(group_template))) %>% - ungroup() %>% - select(cell_id, group_id) %>% + progressions |> + group_by(from, to) |> + mutate(group_id = as.character(glue::glue(group_template))) |> + ungroup() |> + select(cell_id, group_id) |> deframe() cell_ids <- trajectory$cell_ids - ifelse(cell_ids %in% names(grouping), grouping[cell_ids], NA) %>% + ifelse(cell_ids %in% names(grouping), grouping[cell_ids], NA) |> set_names(cell_ids) } @@ -166,17 +166,17 @@ group_onto_trajectory_edges <- function(trajectory, group_template = "{from}->{t #' @rdname group_from_trajectory #' @export group_onto_nearest_milestones <- function(trajectory) { - grouping <- trajectory$milestone_percentages %>% - group_by(cell_id) %>% - arrange(-percentage) %>% - slice(1) %>% - mutate(percentage = 1) %>% - ungroup() %>% - select(cell_id, milestone_id) %>% + grouping <- trajectory$milestone_percentages |> + group_by(cell_id) |> + arrange(-percentage) |> + slice(1) |> + mutate(percentage = 1) |> + ungroup() |> + select(cell_id, milestone_id) |> deframe() cell_ids <- trajectory$cell_ids - ifelse(cell_ids %in% names(grouping), grouping[cell_ids], NA) %>% + ifelse(cell_ids %in% names(grouping), grouping[cell_ids], NA) |> set_names(cell_ids) } diff --git a/R/wrap_add_prior_information.R b/R/wrap_add_prior_information.R index fbe77043..776fba5d 100755 --- a/R/wrap_add_prior_information.R +++ b/R/wrap_add_prior_information.R @@ -65,7 +65,7 @@ add_prior_information <- function( start_n, end_n, dimred - ) %>% discard(is.null) + ) |> discard(is.null) if (!is.null(start_id)) { assert_that(all(start_id %in% dataset$cell_ids)) @@ -133,7 +133,7 @@ add_prior_information <- function( prior_information <- purrr::list_modify(calculated_prior_information, !!!prior_information) } - dataset %>% extend_with( + dataset |> extend_with( "dynwrap::with_prior", prior_information = prior_information ) @@ -230,7 +230,7 @@ generate_prior_information <- function( wrap_data( id = "tmp", cell_ids = c(cell_ids, pseudocell) - ) %>% + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -276,8 +276,8 @@ generate_prior_information <- function( } else { if (verbose) cat("Computing groups id\n") groups_id <- - milestone_percentages %>% - group_by(cell_id) %>% + milestone_percentages |> + group_by(cell_id) |> summarise(group_id = milestone_id[which.max(percentage)]) } @@ -285,7 +285,7 @@ generate_prior_information <- function( groups_network <- given$groups_network } else { if (verbose) cat("Computing groups network\n") - groups_network <- milestone_network %>% select(from, to) + groups_network <- milestone_network |> select(from, to) } ## MARKER GENES ## @@ -295,13 +295,13 @@ generate_prior_information <- function( if (verbose) cat("Computing features id\n") if (!is.null(feature_info) && "housekeeping" %in% colnames(feature_info)) { - features_id <- feature_info %>% - filter(!housekeeping) %>% + features_id <- feature_info |> + filter(!housekeeping) |> pull(feature_id) } else { requireNamespace("ranger") data <- data.frame( - PREDICT = groups_id %>% slice(match(rownames(expression), cell_id)) %>% pull(group_id) %>% as.factor, + PREDICT = groups_id |> slice(match(rownames(expression), cell_id)) |> pull(group_id) |> as.factor(), as.matrix(expression), ## TODO: can this work with a sparse matrix, somehow? check.names = FALSE, stringsAsFactors = FALSE @@ -318,7 +318,7 @@ generate_prior_information <- function( verbose = FALSE ) rfsh <- ranger::ranger( - data = data %>% mutate(PREDICT = sample(PREDICT)), + data = data |> mutate(PREDICT = sample(PREDICT)), num.trees = 2000, mtry = min(50, ncol(expression)), sample.fraction = min(250 / nrow(expression), 1), @@ -329,9 +329,9 @@ generate_prior_information <- function( verbose = FALSE ) features_id <- - rf$variable.importance %>% - sort(decreasing = TRUE) %>% - keep(~ . > quantile(rfsh$variable.importance, .75)) %>% + rf$variable.importance |> + sort(decreasing = TRUE) |> + keep(~ . > quantile(rfsh$variable.importance, .75)) |> names() } } diff --git a/R/wrap_add_pseudotime.R b/R/wrap_add_pseudotime.R index 4693bf26..4c31c0f5 100755 --- a/R/wrap_add_pseudotime.R +++ b/R/wrap_add_pseudotime.R @@ -62,7 +62,7 @@ add_pseudotime <- function(trajectory, pseudotime = NULL) { process_pseudotime <- function(data_wrapper, pseudotime) { # convert to named vector if necessary if(is.data.frame(pseudotime) && all(c("cell_id", "pseudotime") %in% colnames(pseudotime))) { - pseudotime <- pseudotime %>% select(cell_id, pseudotime) %>% deframe() + pseudotime <- pseudotime |> select(cell_id, pseudotime) |> deframe() } pseudotime } diff --git a/R/wrap_add_root.R b/R/wrap_add_root.R index 72c85f48..92efa080 100755 --- a/R/wrap_add_root.R +++ b/R/wrap_add_root.R @@ -42,10 +42,10 @@ add_root <- function( if (!is.null(root_cell_id)) { if(!root_cell_id %in% trajectory$cell_ids) {stop("Invalid root_cell_id")} - root_milestone_id <- trajectory$milestone_percentages %>% filter(cell_id == root_cell_id) %>% filter(percentage == max(percentage)) %>% pull(milestone_id) + root_milestone_id <- trajectory$milestone_percentages |> filter(cell_id == root_cell_id) |> filter(percentage == max(percentage)) |> pull(milestone_id) } else if (is.null(root_milestone_id)) { message("root cell or milestone not provided, trying first outgoing milestone_id") - root_milestone_id <- setdiff(trajectory$milestone_network$from, trajectory$milestone_network$to) %>% first() + root_milestone_id <- setdiff(trajectory$milestone_network$from, trajectory$milestone_network$to) |> first() if(is.na(root_milestone_id)) { message("Could not find outgoing milestone_id, using first milestone_id as root") @@ -57,17 +57,17 @@ add_root <- function( if (flip_edges) { gr <- igraph::graph_from_data_frame( - trajectory$milestone_network %>% rename(weight = length), + trajectory$milestone_network |> rename(weight = length), directed = any(trajectory$milestone_network$directed) ) # TODO: allow to add multiple roots for disconnected trajectories?? # get milestones already downstream of the root - ord1 <- igraph::distances(gr, v = root_milestone_id, mode = "out")[1,] %>% keep(is.finite) %>% sort() %>% names() + ord1 <- igraph::distances(gr, v = root_milestone_id, mode = "out")[1,] |> keep(is.finite) |> sort() |> names() # add milestones upstream of the root id - ord2 <- igraph::distances(gr, v = root_milestone_id, mode = "all")[1,] %>% keep(is.finite) %>% sort() %>% names() + ord2 <- igraph::distances(gr, v = root_milestone_id, mode = "all")[1,] |> keep(is.finite) |> sort() |> names() milestone_order <- union(ord1, ord2) # why though? should disconnected milestones be reordered? @@ -77,24 +77,23 @@ add_root <- function( # determine which edges to flip milestone_network_toflip <- - trajectory$milestone_network %>% + trajectory$milestone_network |> mutate( flip = match(from, milestone_order) > match(to, milestone_order) - ) %>% + ) |> filter(!is.na(flip), flip) trajectory <- flip_edges(trajectory, milestone_network_toflip) # order milestone network milestone_order <- - trajectory$milestone_network %>% - igraph::graph_from_data_frame() %>% - igraph::dfs(root_milestone_id, unreachable = TRUE) %>% - .$order %>% - names() + trajectory$milestone_network |> + igraph::graph_from_data_frame() |> + igraph::dfs(root_milestone_id, unreachable = TRUE) |> + (\(x) names(x$order))() trajectory$milestone_network <- - trajectory$milestone_network %>% + trajectory$milestone_network |> arrange(map2_int(from, to, ~max(which(milestone_order %in% c(.x, .y))))) } @@ -116,7 +115,7 @@ add_root <- function( add_root_using_expression <- function(trajectory, features_oi, expression_source = "expression") { expression <- get_expression(trajectory, expression_source) - root_cell_id <- rownames(expression)[expression[, features_oi, drop = F] %>% Matrix::rowMeans() %>% which.max()] + root_cell_id <- rownames(expression)[expression[, features_oi, drop = F] |> Matrix::rowMeans() |> which.max()] trajectory <- add_root(trajectory, root_cell_id) trajectory diff --git a/R/wrap_add_timings.R b/R/wrap_add_timings.R index 8a9f5ec2..29dbdb98 100755 --- a/R/wrap_add_timings.R +++ b/R/wrap_add_timings.R @@ -32,7 +32,7 @@ add_timings <- function( assert_that(is.list(timings)) # create output structure - trajectory %>% extend_with( + trajectory |> extend_with( "dynwrap::with_timings", timings = timings ) diff --git a/R/wrap_add_trajectory.R b/R/wrap_add_trajectory.R index bd9cedb2..4f05d39f 100755 --- a/R/wrap_add_trajectory.R +++ b/R/wrap_add_trajectory.R @@ -40,12 +40,12 @@ #' "B", "D", 1, FALSE, #' ) #' milestone_network -#' progressions <- milestone_network %>% -#' sample_n(length(dataset$cell_ids), replace = TRUE, weight = length) %>% +#' progressions <- milestone_network |> +#' sample_n(length(dataset$cell_ids), replace = TRUE, weight = length) |> #' mutate( #' cell_id = dataset$cell_ids, #' percentage = runif(n()) -#' ) %>% +#' ) |> #' select(cell_id, from, to, percentage) #' progressions #' divergence_regions <- tribble( @@ -130,17 +130,17 @@ add_trajectory <- function( } # check whether cells in tents are explicitly mentioned in divergence_regions - tents <- progressions %>% - filter(cell_id %in% cell_id[duplicated(cell_id)]) %>% # cell_id must occur multiple times - group_by(from, to) %>% - summarise(n = n()) %>% + tents <- progressions |> + filter(cell_id %in% cell_id[duplicated(cell_id)]) |> # cell_id must occur multiple times + group_by(from, to) |> + summarise(n = n()) |> ungroup() for (fr in unique(tents$from)) { - te <- tents %>% filter(from == fr) - divreg <- divergence_regions %>% filter(is_start, milestone_id == fr) + te <- tents |> filter(from == fr) + divreg <- divergence_regions |> filter(is_start, milestone_id == fr) if (nrow(divreg) >= 1) { - divreg2 <- divergence_regions %>% filter(divergence_id == divreg$divergence_id) + divreg2 <- divergence_regions |> filter(divergence_id == divreg$divergence_id) assert_that(te$to %all_in% divreg2$milestone_id, msg = "All divergence regions need to be explicitly defined") } else { stop("Not all divergence regions are specified; check progressions or divergence regions") @@ -148,7 +148,7 @@ add_trajectory <- function( } # create output structure - dataset <- dataset %>% extend_with( + dataset <- dataset |> extend_with( "dynwrap::with_trajectory", milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -182,7 +182,7 @@ check_milestone_network <- function(milestone_ids, milestone_network, allow_self setequal(colnames(milestone_network), c("from", "to", "length", "directed")) ) - milestone_network <- milestone_network %>% select(from, to, length, directed) + milestone_network <- milestone_network |> select(from, to, length, directed) assert_that( is.character(milestone_network$from), @@ -191,7 +191,7 @@ check_milestone_network <- function(milestone_ids, milestone_network, allow_self is.logical(milestone_network$directed), milestone_network$from %all_in% milestone_ids, milestone_network$to %all_in% milestone_ids, - !any(duplicated(milestone_network %>% select(from, to))) + !any(duplicated(milestone_network |> select(from, to))) ) if (!allow_self_loops) { @@ -199,11 +199,11 @@ check_milestone_network <- function(milestone_ids, milestone_network, allow_self } check1 <- milestone_network - if (allow_self_loops) check1 <- check1 %>% filter(from != to) + if (allow_self_loops) check1 <- check1 |> filter(from != to) check <- inner_join( - check1 %>% transmute(from, to, left = "left"), - check1 %>% transmute(from = to, to = from, right = "right"), + check1 |> transmute(from, to, left = "left"), + check1 |> transmute(from = to, to = from, right = "right"), by = c("from", "to") ) assert_that(nrow(check) == 0, msg = "Milestone network should not contain A->B B->A edges") @@ -216,14 +216,14 @@ check_divergence_regions <- function(milestone_ids, divergence_regions) { assert_that(ncol(divergence_regions) == 3) assert_that(setequal(colnames(divergence_regions), c("divergence_id", "milestone_id", "is_start"))) - divergence_regions <- divergence_regions %>% select(divergence_id, milestone_id, is_start) + divergence_regions <- divergence_regions |> select(divergence_id, milestone_id, is_start) assert_that(is.character(divergence_regions$divergence_id)) assert_that(is.character(divergence_regions$milestone_id)) assert_that(is.logical(divergence_regions$is_start)) assert_that(divergence_regions$milestone_id %all_in% milestone_ids) - dr_check <- divergence_regions %>% group_by(divergence_id) %>% summarise(num_starts = sum(is_start)) + dr_check <- divergence_regions |> group_by(divergence_id) |> summarise(num_starts = sum(is_start)) assert_that(all(dr_check$num_starts == 1)) divergence_regions @@ -234,7 +234,7 @@ check_milestone_percentages <- function(cell_ids, milestone_ids, milestone_perce assert_that(ncol(milestone_percentages) == 3) assert_that(setequal(colnames(milestone_percentages), c("cell_id", "milestone_id", "percentage"))) - milestone_percentages <- milestone_percentages %>% select(cell_id, milestone_id, percentage) + milestone_percentages <- milestone_percentages |> select(cell_id, milestone_id, percentage) assert_that(is.character(milestone_percentages$cell_id)) assert_that(is.character(milestone_percentages$milestone_id)) @@ -258,7 +258,7 @@ check_progressions <- function(cell_ids, milestone_ids, milestone_network, progr assert_that(ncol(progressions) == 4) assert_that(setequal(colnames(progressions), c("cell_id", "from", "to", "percentage"))) - progressions <- progressions %>% select(cell_id, from, to, percentage) + progressions <- progressions |> select(cell_id, from, to, percentage) assert_that(is.character(progressions$cell_id)) assert_that(is.character(progressions$from)) @@ -278,7 +278,7 @@ check_progressions <- function(cell_ids, milestone_ids, milestone_network, progr assert_that(all(pg_check >= 0 & pg_check < (1 + 1e-6)), msg = "Sum of progressions per cell_id should be exactly one") # check edges - pg_check <- progressions %>% left_join(milestone_network, by = c("from", "to")) + pg_check <- progressions |> left_join(milestone_network, by = c("from", "to")) assert_that(all(!is.na(pg_check$directed)), msg = "All progressions (from, to) edges need to be part of the milestone network") progressions diff --git a/R/wrap_add_waypoints.R b/R/wrap_add_waypoints.R index dc617d66..a08e2b9b 100755 --- a/R/wrap_add_waypoints.R +++ b/R/wrap_add_waypoints.R @@ -25,13 +25,13 @@ select_waypoints <- function( # create uniform progressions # waypoints which lie on a milestone will get a special name, so that they are the same between milestone network edges - waypoint_progressions <- trajectory$milestone_network %>% - mutate(percentage = map(trafo(length), ~c(seq(0, ., min(resolution, .))/., 1))) %>% - select(-length, -directed) %>% - unnest(percentage) %>% - group_by(from, to, percentage) %>% # remove duplicate waypoints - filter(row_number() == 1) %>% - ungroup() %>% + waypoint_progressions <- trajectory$milestone_network |> + mutate(percentage = map(trafo(length), ~c(seq(0, ., min(resolution, .))/., 1))) |> + select(-length, -directed) |> + unnest(percentage) |> + group_by(from, to, percentage) |> # remove duplicate waypoints + filter(row_number() == 1) |> + ungroup() |> mutate( waypoint_id = case_when( percentage == 0 ~ paste0("MILESTONE_BEGIN_W", from, "_", to), @@ -41,17 +41,17 @@ select_waypoints <- function( ) # create waypoint percentages from progressions - waypoint_milestone_percentages <- waypoint_progressions %>% - group_by(waypoint_id) %>% - filter(row_number() == 1) %>% - ungroup() %>% - rename(cell_id = waypoint_id) %>% - convert_progressions_to_milestone_percentages( - "this argument is unnecessary, I can put everything I want in here!", - trajectory$milestone_ids, - trajectory$milestone_network, - . - ) %>% + waypoint_progressions_filtered <- waypoint_progressions |> + group_by(waypoint_id) |> + filter(row_number() == 1) |> + ungroup() |> + rename(cell_id = waypoint_id) + waypoint_milestone_percentages <- convert_progressions_to_milestone_percentages( + "this argument is unnecessary, I can put everything I want in here!", + trajectory$milestone_ids, + trajectory$milestone_network, + waypoint_progressions_filtered + ) |> rename(waypoint_id = cell_id) # calculate distance @@ -61,20 +61,20 @@ select_waypoints <- function( )[waypoint_progressions$waypoint_id, ] # also create network between waypoints - waypoint_network <- waypoint_progressions %>% - group_by(from, to) %>% - mutate(from_waypoint = waypoint_id, to_waypoint = lead(waypoint_id, 1)) %>% - drop_na() %>% - ungroup() %>% + waypoint_network <- waypoint_progressions |> + group_by(from, to) |> + mutate(from_waypoint = waypoint_id, to_waypoint = lead(waypoint_id, 1)) |> + drop_na() |> + ungroup() |> select(from = from_waypoint, to = to_waypoint, from_milestone_id = from, to_milestone_id = to) # create waypoints and their properties - waypoints <- waypoint_milestone_percentages %>% - group_by(waypoint_id) %>% - arrange(-percentage) %>% - filter(row_number() == 1) %>% - ungroup() %>% - mutate(milestone_id = ifelse(percentage == 1, milestone_id, NA)) %>% + waypoints <- waypoint_milestone_percentages |> + group_by(waypoint_id) |> + arrange(-percentage) |> + filter(row_number() == 1) |> + ungroup() |> + mutate(milestone_id = ifelse(percentage == 1, milestone_id, NA)) |> select(-percentage) lst( @@ -126,7 +126,7 @@ add_waypoints <- inherit_default_params(select_waypoints, function( )) # create output structure - trajectory %>% extend_with( + trajectory |> extend_with( "dynwrap::with_waypoints", waypoints = waypoints ) diff --git a/R/wrap_data.R b/R/wrap_data.R index e8534e7c..8ea7e87a 100755 --- a/R/wrap_data.R +++ b/R/wrap_data.R @@ -76,7 +76,7 @@ wrap_data <- function( - list() %>% extend_with( + list() |> extend_with( "dynwrap::data_wrapper", id = id, cell_ids = cell_ids, diff --git a/R/wrap_gather_cells_at_milestones.R b/R/wrap_gather_cells_at_milestones.R index 84e1f9ca..28862009 100755 --- a/R/wrap_gather_cells_at_milestones.R +++ b/R/wrap_gather_cells_at_milestones.R @@ -18,13 +18,13 @@ gather_cells_at_milestones <- function(trajectory) { assert_that(is_wrapper_with_trajectory(trajectory)) milestone_percentages <- - trajectory$milestone_percentages %>% - group_by(cell_id) %>% - slice(which.max(percentage)) %>% - mutate(percentage = 1) %>% + trajectory$milestone_percentages |> + group_by(cell_id) |> + slice(which.max(percentage)) |> + mutate(percentage = 1) |> ungroup() - trajectory %>% + trajectory |> add_trajectory( milestone_network = trajectory$milestone_network, divergence_regions = trajectory$divergence_regions, diff --git a/R/wrap_label_milestones.R b/R/wrap_label_milestones.R index 944836ee..732f752b 100755 --- a/R/wrap_label_milestones.R +++ b/R/wrap_label_milestones.R @@ -57,7 +57,7 @@ label_milestones <- function(trajectory, labelling) { # add labelling to wrapper trajectory$milestone_labelling <- milestone_labelling - trajectory %>% extend_with( + trajectory |> extend_with( "dynwrap::with_milestone_labelling", milestone_labelling = milestone_labelling ) @@ -75,9 +75,9 @@ label_milestones_markers <- function(trajectory, markers, expression_source = "e map_df(milestone_ids, function(milestone_id) { assert_that(all_in(features_oi, colnames(expression))) - cells_oi <- trajectory$milestone_percentages %>% - filter(milestone_id == !!milestone_id) %>% - top_n(n_nearest_cells, percentage) %>% + cells_oi <- trajectory$milestone_percentages |> + filter(milestone_id == !!milestone_id) |> + top_n(n_nearest_cells, percentage) |> pull(cell_id) tibble( @@ -85,27 +85,27 @@ label_milestones_markers <- function(trajectory, markers, expression_source = "e new_milestone_id = new_milestone_id, expression = mean(expression[cells_oi, features_oi]) ) - }) %>% + }) |> mutate(new_milestone_id = new_milestone_id) }) # select top old milestone id - mapping <- local_expression %>% - group_by(new_milestone_id) %>% - top_n(1, expression) %>% + mapping <- local_expression |> + group_by(new_milestone_id) |> + top_n(1, expression) |> ungroup() # multiple mappings if (any(table(mapping$new_milestone_id) > 1)) { - too_many <- table(mapping$new_milestone_id) %>% keep(~. > 1) %>% names() + too_many <- table(mapping$new_milestone_id) |> keep(~. > 1) |> names() warning(stringr::str_glue("{too_many} was mapped to multiple milestones, adding integer suffices")) - mapping <- mapping %>% - group_by(new_milestone_id) %>% + mapping <- mapping |> + group_by(new_milestone_id) |> mutate( new_new_milestone_id = ifelse(n() > 1, new_milestone_id, paste0(new_milestone_id, "_", row_number())) - ) %>% - ungroup() %>% + ) |> + ungroup() |> select(new_milestone_id = new_new_milestone_id) } @@ -121,7 +121,7 @@ label_milestones_markers <- function(trajectory, markers, expression_source = "e # add labelling to wrapper trajectory$milestone_labelling <- milestone_labelling - trajectory %>% extend_with( + trajectory |> extend_with( "dynwrap::with_milestone_labelling", milestone_labelling = milestone_labelling ) diff --git a/inst/tests/testthat/helper-ti_comp1.R b/inst/tests/testthat/helper-ti_comp1.R index baff0b6d..6d1e7bb6 100755 --- a/inst/tests/testthat/helper-ti_comp1.R +++ b/inst/tests/testthat/helper-ti_comp1.R @@ -45,17 +45,17 @@ ti_comp1 <- dynwrap::create_ti_method_r( names(pseudotime) <- rownames(expression) # TIMING: done with method - tl <- tl %>% add_timing_checkpoint("method_aftermethod") + tl <- tl |> add_timing_checkpoint("method_aftermethod") # return output wrap_data( cell_ids = rownames(expression) - ) %>% add_linear_trajectory( + ) |> add_linear_trajectory( pseudotime = pseudotime - ) %>% add_dimred( + ) |> add_dimred( dimred = dimred - ) %>% add_timings( - timings = tl %>% add_timing_checkpoint("method_afterpostproc") + ) |> add_timings( + timings = tl |> add_timing_checkpoint("method_afterpostproc") ) }, diff --git a/inst/tests/testthat/helper-ti_identity.R b/inst/tests/testthat/helper-ti_identity.R index 6639ba01..371e1e8d 100755 --- a/inst/tests/testthat/helper-ti_identity.R +++ b/inst/tests/testthat/helper-ti_identity.R @@ -27,19 +27,19 @@ ti_identity <- dynwrap::create_ti_method_r( tl <- add_timing_checkpoint(NULL, "method_afterpreproc") # TIMING: done with method - tl <- tl %>% add_timing_checkpoint("method_aftermethod") + tl <- tl |> add_timing_checkpoint("method_aftermethod") # return output wrap_data( cell_ids = dataset$cell_ids, cell_info = dataset$cell_info - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = dataset$milestone_ids, milestone_network = dataset$milestone_network, divergence_regions = dataset$divergence_regions, progressions = dataset$progressions - ) %>% add_timings( - timings = tl %>% add_timing_checkpoint("method_afterpostproc") + ) |> add_timings( + timings = tl |> add_timing_checkpoint("method_afterpostproc") ) } ) diff --git a/inst/tests/testthat/helper-ti_random.R b/inst/tests/testthat/helper-ti_random.R index 8aad54f8..e053c843 100755 --- a/inst/tests/testthat/helper-ti_random.R +++ b/inst/tests/testthat/helper-ti_random.R @@ -30,7 +30,7 @@ ti_random <- dynwrap::create_ti_method_r( tl <- add_timing_checkpoint(NULL, "method_afterpreproc") gr <- igraph::ba.game(num_milestones) - milestone_network <- igraph::as_data_frame(gr) %>% + milestone_network <- igraph::as_data_frame(gr) |> mutate( from = paste0("milestone_", from), to = paste0("milestone_", to), @@ -49,18 +49,18 @@ ti_random <- dynwrap::create_ti_method_r( ) # TIMING: done with method - tl <- tl %>% add_timing_checkpoint("method_aftermethod") + tl <- tl |> add_timing_checkpoint("method_aftermethod") # return output wrap_data( cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, progressions = progressions, divergence_regions = NULL - ) %>% add_timings( - timings = tl %>% add_timing_checkpoint("method_afterpostproc") + ) |> add_timings( + timings = tl |> add_timing_checkpoint("method_afterpostproc") ) } ) diff --git a/inst/tests/testthat/helper-ti_shuffle.R b/inst/tests/testthat/helper-ti_shuffle.R index 0dcebf06..ae138cdf 100755 --- a/inst/tests/testthat/helper-ti_shuffle.R +++ b/inst/tests/testthat/helper-ti_shuffle.R @@ -30,24 +30,24 @@ ti_shuffle <- dynwrap::create_ti_method_r( # permute cell labels allcells <- rownames(counts) - mapper <- magrittr::set_names(sample(allcells), allcells) - progressions <- dataset$progressions %>% mutate( + mapper <- set_names(sample(allcells), allcells) + progressions <- dataset$progressions |> mutate( cell_id = mapper[cell_id] ) # TIMING: done with method - tl <- tl %>% add_timing_checkpoint("method_aftermethod") + tl <- tl |> add_timing_checkpoint("method_aftermethod") # return output wrap_data( cell_ids = dataset$cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = dataset$milestone_ids, milestone_network = dataset$milestone_network, progressions = progressions, divergence_regions = dataset$divergence_regions - ) %>% add_timings( - timings = tl %>% add_timing_checkpoint("method_afterpostproc") + ) |> add_timings( + timings = tl |> add_timing_checkpoint("method_afterpostproc") ) } ) diff --git a/man/add_trajectory.Rd b/man/add_trajectory.Rd index 97ae36b6..27763911 100755 --- a/man/add_trajectory.Rd +++ b/man/add_trajectory.Rd @@ -70,12 +70,12 @@ milestone_network <- tribble( "B", "D", 1, FALSE, ) milestone_network -progressions <- milestone_network \%>\% - sample_n(length(dataset$cell_ids), replace = TRUE, weight = length) \%>\% +progressions <- milestone_network |> + sample_n(length(dataset$cell_ids), replace = TRUE, weight = length) |> mutate( cell_id = dataset$cell_ids, percentage = runif(n()) - ) \%>\% + ) |> select(cell_id, from, to, percentage) progressions divergence_regions <- tribble( diff --git a/man/create_ti_method_r.Rd b/man/create_ti_method_r.Rd index 7c4f13ae..ba9ce5e3 100755 --- a/man/create_ti_method_r.Rd +++ b/man/create_ti_method_r.Rd @@ -65,7 +65,7 @@ run_fun <- function(expression, priors, parameters, seed, verbose) { } } - wrap_data(cell_ids = rownames(expression)) \%>\% + wrap_data(cell_ids = rownames(expression)) |> add_linear_trajectory(pseudotime = pseudotime) } diff --git a/man/dynwrap-package.Rd b/man/dynwrap-package.Rd new file mode 100644 index 00000000..a3c1e346 --- /dev/null +++ b/man/dynwrap-package.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/package.R +\docType{package} +\name{dynwrap-package} +\alias{dynwrap} +\alias{dynwrap-package} +\title{Inferring and adapting single-cell trajectories} +\description{ +\figure{logo.png} +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/dynverse/dynwrap} + \item Report bugs at \url{https://github.com/dynverse/dynwrap/issues} +} + +} +\author{ +\strong{Maintainer}: Robrecht Cannoodt \email{rcannood@gmail.com} (\href{https://orcid.org/0000-0003-3641-729X}{ORCID}) + +Authors: +\itemize{ + \item Wouter Saelens \email{wouter.saelens@gmail.com} (\href{https://orcid.org/0000-0002-7114-6248}{ORCID}) +} + +} +\keyword{internal} diff --git a/man/dynwrap.Rd b/man/dynwrap.Rd deleted file mode 100755 index c80132df..00000000 --- a/man/dynwrap.Rd +++ /dev/null @@ -1,9 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R -\docType{package} -\name{dynwrap} -\alias{dynwrap} -\title{Inferring and adapting single-cell trajectories} -\description{ -\figure{logo.png} -} diff --git a/man/simplify_igraph_network.Rd b/man/simplify_igraph_network.Rd index d4acde60..743f1e88 100755 --- a/man/simplify_igraph_network.Rd +++ b/man/simplify_igraph_network.Rd @@ -13,7 +13,7 @@ simplify_igraph_network( ) } \arguments{ -\item{gr}{An igraph object, see \code{\link[igraph:make_graph]{igraph::graph()}}} +\item{gr}{An igraph object, see \code{\link[igraph:graph]{igraph::graph()}}} \item{allow_duplicated_edges}{Whether or not to allow duplicated edges between nodes.} diff --git a/tests/testthat/test-adapt_orient_topology.R b/tests/testthat/test-adapt_orient_topology.R index 0dc43876..9aa66b38 100755 --- a/tests/testthat/test-adapt_orient_topology.R +++ b/tests/testthat/test-adapt_orient_topology.R @@ -19,7 +19,7 @@ test_that("flip_edges works correctly", { trajectory <- wrap_data( cell_ids = cell_ids - ) %>% + ) |> add_trajectory(milestone_network = milestone_network, progressions = progressions) trajectory$dimred_segment_progressions <- tribble( @@ -28,7 +28,7 @@ test_that("flip_edges works correctly", { "B", "C", 1 ) - trajectory_flipped <- flip_edges(trajectory, milestone_network %>% filter(from == "B", to == "A")) + trajectory_flipped <- flip_edges(trajectory, milestone_network |> filter(from == "B", to == "A")) expect_true(all( c("A->B", "B->C") %in% @@ -81,7 +81,7 @@ test_that("orient_topology_to_velocity orients a linear trajectory correctly", { counts = expression, expression = expression, expression_future = expression_future - ) %>% + ) |> add_trajectory(milestone_network = milestone_network, progressions = progressions) # TODO: move to scvelo package or re-enable this part of the test? diff --git a/tests/testthat/test-calculate_average.R b/tests/testthat/test-calculate_average.R index 31e5d70d..289ea9c6 100755 --- a/tests/testthat/test-calculate_average.R +++ b/tests/testthat/test-calculate_average.R @@ -20,7 +20,7 @@ test_that("Testing function", { }) test_that("Testing edge cases", { - x_grouped <- calculate_average_by_group(x["C1", , drop = FALSE], cell_grouping %>% filter(cell_id == "C1")) + x_grouped <- calculate_average_by_group(x["C1", , drop = FALSE], cell_grouping |> filter(cell_id == "C1")) expect_equal(nrow(x_grouped), 1) expect_equal(ncol(x_grouped), 10) expect_equal(rownames(x_grouped), group_ids[[1]]) diff --git a/tests/testthat/test-calculate_geodesic_distances.R b/tests/testthat/test-calculate_geodesic_distances.R index 551a4692..3da0ff02 100755 --- a/tests/testthat/test-calculate_geodesic_distances.R +++ b/tests/testthat/test-calculate_geodesic_distances.R @@ -40,7 +40,7 @@ test_that("Testing calculate_geodesic_distances", { trajectory <- wrap_data( id = "test", cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, @@ -126,7 +126,7 @@ test_that("Testing calculate_geodesic_distances with a gap in the middle", { trajectory <- wrap_data( id = "test", cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, @@ -174,7 +174,7 @@ test_that("Testing calculate_geodesic_distances with filtered cells", { trajectory <- wrap_data( id = "test", cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, @@ -193,7 +193,7 @@ test_that("Testing calculate_geodesic_distances with filtered cells", { test_that("Testing calculate_geodesic_distances with zero length self loops", { trajectory <- - wrap_data(cell_ids = c("A", "B", "C")) %>% + wrap_data(cell_ids = c("A", "B", "C")) |> add_trajectory( milestone_network = tibble(from = "a", to = "a", length = 0, directed = TRUE), progressions = tibble(from = "a", to = "a", cell_id = c("A", "B", "C"), percentage = 1), @@ -227,7 +227,7 @@ test_that("Testing calculate_geodesic_distances while taking into account direct "g", "C", "A", 0, "h", "C", "A", 0.5, ) - dataset <- wrap_data(cell_ids = progressions$cell_id) %>% + dataset <- wrap_data(cell_ids = progressions$cell_id) |> add_trajectory( milestone_network = milestone_network, progressions = progressions @@ -252,7 +252,7 @@ test_that("Testing calculate_geodesic_distances while taking into account direct "e", "B", "C", 0.5, "f", "B", "C", 1 ) - dataset <- wrap_data(cell_ids = progressions$cell_id) %>% + dataset <- wrap_data(cell_ids = progressions$cell_id) |> add_trajectory( milestone_network = milestone_network, progressions = progressions @@ -289,7 +289,7 @@ test_that("Testing calculate_geodesic_distances with a disconnected graph and wh "g", "D", "E", 0, "h", "D", "E", 0.5, ) - dataset <- wrap_data(cell_ids = progressions$cell_id) %>% + dataset <- wrap_data(cell_ids = progressions$cell_id) |> add_trajectory( milestone_network = milestone_network, progressions = progressions diff --git a/tests/testthat/test-calculate_trajectory_dimred.R b/tests/testthat/test-calculate_trajectory_dimred.R index 99fe3489..cf26f490 100755 --- a/tests/testthat/test-calculate_trajectory_dimred.R +++ b/tests/testthat/test-calculate_trajectory_dimred.R @@ -40,7 +40,7 @@ divergence_regions <- tribble( trajectory <- wrap_data( id = id, cell_ids = cell_ids -) %>% add_trajectory( +) |> add_trajectory( milestone_network = milestone_network, divergence_regions = divergence_regions, milestone_percentages = milestone_percentages @@ -53,7 +53,7 @@ test_that("calculate_trajectory_dimred output format is correct", { edge_positions <- dimred$edge_positions expect_equal(colnames(edge_positions), c("from", "to", "length", "directed", "comp_1_from", "comp_2_from", "comp_1_to", "comp_2_to")) - join_check <- edge_positions %>% inner_join(milestone_network, by = c("from", "to")) + join_check <- edge_positions |> inner_join(milestone_network, by = c("from", "to")) expect_equal(join_check$length.x, join_check$length.y) milestone_positions <- dimred$milestone_positions diff --git a/tests/testthat/test-classify_milestone_network.R b/tests/testthat/test-classify_milestone_network.R index d80f736b..d67c19f7 100755 --- a/tests/testthat/test-classify_milestone_network.R +++ b/tests/testthat/test-classify_milestone_network.R @@ -56,12 +56,12 @@ all_networks <- list( to2 = c(ord[2:5], ord[6:10], ord[c(11,12:16)]), length = 1, directed = FALSE - ) %>% + ) |> mutate( mix = sample(c(T, F), n(), replace = TRUE), from = ifelse(mix, from2, to2), to = ifelse(mix, to2, from2) - ) %>% + ) |> select(from, to, length, directed) } ), @@ -97,38 +97,38 @@ all_networks <- list( to2 = c(ord[2:5], ord[6:10], ord[c(11,12:16)], ord[c(17, 18:21)]), length = 1, directed = FALSE - ) %>% + ) |> mutate( mix = sample(c(T, F), n(), replace = TRUE), from = ifelse(mix, from2, to2), to = ifelse(mix, to2, from2) - ) %>% - sample_n(nrow(.)) %>% + ) |> + (\(x) sample_n(x, nrow(x)))() |> select(from, to, length, directed) } ), "tree" = list( "simple_binary" = tibble(from = c("A", "B", "B", "C", "C"), to = c("B", "C", "D", "E", "F"), length = 2, directed = TRUE), "intermediate" = tibble(from = c(rep("root", 6), LETTERS[1:6], LETTERS[1:6]), to = c(LETTERS[1:6], LETTERS[7:12], LETTERS[13:18]), length = 1.5, directed = TRUE), - "shuffled" = tibble(from = c(rep("root", 6), rep("A", 10), rep("B", 3)), to = LETTERS[1:19], length = 1, directed = TRUE) %>% sample_n(nrow(.)), + "shuffled" = (\(x) sample_n(x, nrow(x)))(tibble(from = c(rep("root", 6), rep("A", 10), rep("B", 3)), to = LETTERS[1:19], length = 1, directed = TRUE)), "simple_binary" = tibble(from = c("A", "B", "B", "C", "C"), to = c("B", "C", "D", "E", "F"), length = 2, directed = FALSE), "intermediate" = tibble(from = c(rep("root", 6), LETTERS[1:6], LETTERS[1:6]), to = c(LETTERS[1:6], LETTERS[7:12], LETTERS[13:18]), length = 1.5, directed = FALSE), "shuffled" = tibble( from2 = c(rep("root", 6), rep("A", 10), rep("B", 3)), to2 = LETTERS[1:19], length = 1, directed = FALSE - ) %>% + ) |> mutate( mix = sample(c(T, F), n(), replace = TRUE), from = ifelse(mix, from2, to2), to = ifelse(mix, to2, from2) - ) %>% - sample_n(nrow(.)) %>% + ) |> + (\(x) sample_n(x, nrow(x)))() |> select(from, to, length, directed) ), "acyclic_graph" = list( "bifur_conv_from_start" = tibble(from = c("A", "A", "B", "C"), to = c("B", "C", "D", "D"), length = 0.4, directed = TRUE), "bifur_conv" = tibble(from = c("A", "B", "B", "C", "D", "E"), to = c("B", "C", "D", "E", "E", "F"), length = 0.4, directed = TRUE), - "directed_complete" = crossing(from = LETTERS, to = LETTERS, length = 1, directed = TRUE) %>% filter(from < to), + "directed_complete" = crossing(from = LETTERS, to = LETTERS, length = 1, directed = TRUE) |> filter(from < to), "conv_bifur" = tibble(from = c("A", "B", "C", "C"), to = c("C", "C", "D", "E"), length = 1, directed = TRUE), "conv_bifur_big" = tibble(from = c("A", "B", "C", "D", "D", "D"), to = c("D", "D", "D", "E", "F", "G"), length = 1, directed = TRUE) ), @@ -161,8 +161,8 @@ for (network_type in names(all_networks)) { test_that("Example trajectories match", { - example_trajectory_types <- map(trajectory_types$example_network, mutate, directed = TRUE, length = 1) %>% - map(classify_milestone_network) %>% + example_trajectory_types <- map(trajectory_types$example_network, mutate, directed = TRUE, length = 1) |> + map(classify_milestone_network) |> map_chr("network_type") testthat::expect_equal(trajectory_types$id, example_trajectory_types) diff --git a/tests/testthat/test-method_create_ti_method_r.R b/tests/testthat/test-method_create_ti_method_r.R index 3d2ad9a2..ceff5abe 100755 --- a/tests/testthat/test-method_create_ti_method_r.R +++ b/tests/testthat/test-method_create_ti_method_r.R @@ -20,7 +20,7 @@ dummy_definition <- definition( dummy_run_fun = function(counts, parameters) { wrap_data( cell_ids = parameters$fruit - ) %>% + ) |> add_linear_trajectory( pseudotime = set_names(0, parameters$fruit) ) @@ -38,8 +38,8 @@ dummy <- create_ti_method_r( dummy_instance <- dummy() dataset <- - wrap_data(cell_ids = "a") %>% - add_linear_trajectory(pseudotime = c(a = 1)) %>% + wrap_data(cell_ids = "a") |> + add_linear_trajectory(pseudotime = c(a = 1)) |> add_expression( counts = matrix(0:1, ncol = 2, dimnames = list("a", c("A", "B"))), expression = matrix(0:1, ncol = 2, dimnames = list("a", c("A", "B"))) diff --git a/tests/testthat/test-method_infer_trajectory.R b/tests/testthat/test-method_infer_trajectory.R index e441574a..1b72977c 100755 --- a/tests/testthat/test-method_infer_trajectory.R +++ b/tests/testthat/test-method_infer_trajectory.R @@ -30,7 +30,7 @@ dataset <- feature_info, extras1 = extras1, extras2 = extras2 - ) %>% + ) |> add_prior_information(start_id = cell_ids[[1]]) test_that("Testing infer_trajectory with control methods", { diff --git a/tests/testthat/test-method_parse_parameter_definition.R b/tests/testthat/test-method_parse_parameter_definition.R index 8179aa04..95dc907b 100755 --- a/tests/testthat/test-method_parse_parameter_definition.R +++ b/tests/testthat/test-method_parse_parameter_definition.R @@ -103,21 +103,21 @@ # # par_set <- parse_parameter_definition(parameter_definition) # -# sampled_parameters <- ParamHelpers::generateDesign(1000, par_set, trafo = TRUE) %>% -# ParamHelpers::dfRowsToList(par_set) %>% +# sampled_parameters <- ParamHelpers::generateDesign(1000, par_set, trafo = TRUE) |> +# ParamHelpers::dfRowsToList(par_set) |> # dynutils::list_as_tibble() # # test_that("Parameters can be parsed and sampled", { # testthat::expect_setequal(sampled_parameters$fixed, 42) # -# numbers <- sampled_parameters[, c("integer", "numeric", "integer_vector", "numeric_vector")] %>% unlist() +# numbers <- sampled_parameters[, c("integer", "numeric", "integer_vector", "numeric_vector")] |> unlist() # testthat::expect_true(all(numbers >= 10)) # testthat::expect_true(all(numbers <= 20)) # -# discretes <- sampled_parameters[, c("discrete", "discrete_vector")] %>% unlist() +# discretes <- sampled_parameters[, c("discrete", "discrete_vector")] |> unlist() # testthat::expect_true(all(discretes %in% c("a", "b", "c"))) # -# logicals <- sampled_parameters[, c("logical", "logical_vector")] %>% unlist() +# logicals <- sampled_parameters[, c("logical", "logical_vector")] |> unlist() # testthat::expect_true(all(logicals %in% c(TRUE, FALSE))) # }) # @@ -125,13 +125,13 @@ # # test_that("Parameters are sampled from the correct distributions", { # for(col in c("numeric", "numeric_vector")) { -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # # expect_gt(ks.test(numbers, runif(10000, 10, 20))$p.value, 0.1) # } # # for(col in c("integer", "integer_vector")) { -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # # suppressWarnings( # expect_gt(ks.test(numbers, round(runif(10000, 10, 20)))$p.value, 0.1) @@ -139,17 +139,17 @@ # } # # col <- "numeric_norm" -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # expect_gt(ks.test(numbers, rnorm(10000, 15, 0.5))$p.value, 0.1) # # col <- "integer_norm" -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # suppressWarnings( # expect_gt(ks.test(numbers, round(rnorm(10000, 15, 0.5)))$p.value, 0.1) # ) # # col <- "numeric_exp" -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # numbers2 <- rexp(100000, 1) + 10 # numbers2 <- numbers2[numbers2 < 20] # suppressWarnings( @@ -157,7 +157,7 @@ # ) # # col <- "integer_exp" -# numbers <- sampled_parameters[,col ] %>% unlist() +# numbers <- sampled_parameters[,col ] |> unlist() # numbers2 <- rexp(100000, 1) + 10 # numbers2 <- round(numbers2[numbers2 < 20]) # suppressWarnings( diff --git a/tests/testthat/test-milestone_convertors.R b/tests/testthat/test-milestone_convertors.R index b2e6f893..e1e395f7 100755 --- a/tests/testthat/test-milestone_convertors.R +++ b/tests/testthat/test-milestone_convertors.R @@ -57,8 +57,8 @@ progressions <- tribble( test_that("Testing convert_milestone_percentages_to_progressions", { progressions_calc <- convert_milestone_percentages_to_progressions(cell_ids, milestone_ids, milestone_network, milestone_percentages) - prog_control <- progressions %>% rename(orig = percentage) %>% - full_join(progressions_calc %>% rename(calc = percentage), by = c("cell_id", "from", "to")) %>% + prog_control <- progressions |> rename(orig = percentage) |> + full_join(progressions_calc |> rename(calc = percentage), by = c("cell_id", "from", "to")) |> mutate( diff = abs(orig - calc), check = !is.na(orig) & !is.na(calc) & diff < 1e-6 @@ -66,13 +66,13 @@ test_that("Testing convert_milestone_percentages_to_progressions", { expect_true(all(prog_control$check)) # expect error because cells are positioned on edges that are not in the milestone_network - expect_error(convert_milestone_percentages_to_progressions(cell_ids, milestone_ids, milestone_network %>% slice(-1), milestone_percentages)) + expect_error(convert_milestone_percentages_to_progressions(cell_ids, milestone_ids, milestone_network |> slice(-1), milestone_percentages)) }) test_that("Testing convert_progressions_to_milestone_percentages", { milestone_percentages_calc <- convert_progressions_to_milestone_percentages(cell_ids, milestone_ids, milestone_network, progressions) - perc_control <- milestone_percentages %>% rename(orig = percentage) %>% - full_join(milestone_percentages_calc %>% rename(calc = percentage), by = c("cell_id", "milestone_id")) %>% + perc_control <- milestone_percentages |> rename(orig = percentage) |> + full_join(milestone_percentages_calc |> rename(calc = percentage), by = c("cell_id", "milestone_id")) |> mutate( diff = abs(orig - calc), orig_check = !is.na(orig) | calc == 0, @@ -81,11 +81,11 @@ test_that("Testing convert_progressions_to_milestone_percentages", { expect_true(all(perc_control$check)) # expect error because cells are position on edges that are not in the milestone_network - expect_error(convert_progressions_to_milestone_percentages(cell_ids, milestone_ids, milestone_network %>% slice(-1), progressions)) + expect_error(convert_progressions_to_milestone_percentages(cell_ids, milestone_ids, milestone_network |> slice(-1), progressions)) # expect error because cell k is in two different 'from' progressions. expect_error(convert_progressions_to_milestone_percentages( cell_ids, milestone_ids, milestone_network, - progressions %>% add_row(cell_id = c("k", "k"), from = c("A", "B"), to = c("C", "D"), percentage = c(.1, .2)) + progressions |> add_row(cell_id = c("k", "k"), from = c("A", "B"), to = c("C", "D"), percentage = c(.1, .2)) )) }) diff --git a/tests/testthat/test-simplify_igraph_network.R b/tests/testthat/test-simplify_igraph_network.R index 7be73c1d..034ee44b 100755 --- a/tests/testthat/test-simplify_igraph_network.R +++ b/tests/testthat/test-simplify_igraph_network.R @@ -156,20 +156,20 @@ for (test in tests) { newgr <- simplify_igraph_network(gr, allow_duplicated_edges = TRUE) newnet <- igraph::as_data_frame(newgr) - expected <- test$expected_net %>% + expected <- test$expected_net |> mutate(from = as.character(from), to = as.character(to)) - exp2 <- bind_rows(expected, expected %>% rename(from = to, to = from)) %>% mutate(left = TRUE) - new2 <- bind_rows(newnet, newnet %>% rename(from = to, to = from)) %>% mutate(right = TRUE) + exp2 <- bind_rows(expected, expected |> rename(from = to, to = from)) |> mutate(left = TRUE) + new2 <- bind_rows(newnet, newnet |> rename(from = to, to = from)) |> mutate(right = TRUE) control <- full_join(exp2, new2, by = c("from", "to", "weight", "directed")) pass_check <- all(!is.na(control$left) & !is.na(control$right)) # cat(ifelse(pass_check, "SUCCEEDED!", "FAILED!"), " ", test$name, " ", ifelse(test$directed, "(directed)", "(undirected)"), "\n", sep = "") # cat("Original:\n") - # print(test$net %>% as.data.frame) + # print(test$net |> as.data.frame) # cat("Expected:\n") - # print(test$expected_net %>% as.data.frame) + # print(test$expected_net |> as.data.frame) # cat("Got:\n") # print(newnet) # cat("============================\n") diff --git a/tests/testthat/test-simplify_trajectory.R b/tests/testthat/test-simplify_trajectory.R index 0a0463f1..a69543c0 100755 --- a/tests/testthat/test-simplify_trajectory.R +++ b/tests/testthat/test-simplify_trajectory.R @@ -35,7 +35,7 @@ test_that("Simple test", { wrap_data( id = id, cell_ids = cell_ids - ) %>% + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -75,7 +75,7 @@ test_that("Test whether simplify is able to correctly simplify an undirected", { wrap_data( id = id, cell_ids = cell_ids - ) %>% + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -117,7 +117,7 @@ test_that("Test whether simplify is able to correctly simplify an undirected cyc wrap_data( id = id, cell_ids = cell_ids - ) %>% + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -161,23 +161,19 @@ test_that("Test whether simplify is able to correctly simplify a graph with a di "12","B", "F", 0.4 ) - dimred <- - runif(length(cell_ids) * 3) %>% - matrix(ncol = 3) %>% - magrittr::set_colnames(c("comp_1", "comp_2", "comp_3")) %>% - magrittr::set_rownames(cell_ids) - dimred_milestones <- - runif(length(milestone_ids) * 3) %>% - matrix(ncol = 3) %>% - magrittr::set_colnames(c("comp_1", "comp_2", "comp_3")) %>% - magrittr::set_rownames(milestone_ids) + dimred <- matrix(runif(length(cell_ids) * 3), ncol = 3) + colnames(dimred) <- c("comp_1", "comp_2", "comp_3") + rownames(dimred) <- cell_ids + dimred_milestones <- matrix(runif(length(milestone_ids) * 3), ncol = 3) + colnames(dimred_milestones) <- c("comp_1", "comp_2", "comp_3") + rownames(dimred_milestones) <- milestone_ids dimred_segment_progressions <- - milestone_network %>% - mutate(percentage = map(seq_len(n()), ~ c(0, .5, 1))) %>% - unnest(percentage) %>% + milestone_network |> + mutate(percentage = map(seq_len(n()), ~ c(0, .5, 1))) |> + unnest(percentage) |> select(from, to, percentage) dimred_segment_points <- - dimred_segment_progressions %>% + dimred_segment_progressions |> pmap(function(from, to, percentage) { if (percentage == 0) { dimred_milestones[from, , drop = FALSE] @@ -186,20 +182,20 @@ test_that("Test whether simplify is able to correctly simplify a graph with a di } else { (dimred_milestones[from, , drop = FALSE] + dimred_milestones[to, , drop = FALSE])/2 + runif(3, -.1, .1) } - }) %>% - do.call(rbind, .) %>% - magrittr::set_rownames(NULL) + }) + dimred_segment_points <- do.call(rbind, dimred_segment_points) + rownames(dimred_segment_points) <- NULL trajectory <- wrap_data( id = id, cell_ids = cell_ids - ) %>% + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, progressions = progressions - ) %>% + ) |> add_dimred( dimred = dimred, dimred_milestones = dimred_milestones, @@ -214,8 +210,8 @@ test_that("Test whether simplify is able to correctly simplify a graph with a di # check dimred related values expect_equal( - simp$dimred_segment_points %>% as.vector() %>% unique() %>% sort(), - trajectory$dimred_segment_points %>% as.vector() %>% unique() %>% sort(), + simp$dimred_segment_points |> as.vector() |> unique() |> sort(), + trajectory$dimred_segment_points |> as.vector() |> unique() |> sort(), tol = 1e-3 ) expect_equal(nrow(simp$dimred_segment_points), nrow(simp$dimred_segment_progressions)) diff --git a/tests/testthat/test-wrap_add_branch_trajectory.R b/tests/testthat/test-wrap_add_branch_trajectory.R index 4ec59023..61c997f9 100755 --- a/tests/testthat/test-wrap_add_branch_trajectory.R +++ b/tests/testthat/test-wrap_add_branch_trajectory.R @@ -28,7 +28,7 @@ wr_orig <- wrap_data( test_that("Testing add_trajectory with milestone_percentages", { wr <- - wr_orig %>% + wr_orig |> add_branch_trajectory( branch_ids = branch_ids, branch_network = branch_network, @@ -80,7 +80,7 @@ wr_orig <- wrap_data( test_that("Testing add_trajectory with milestone_percentages", { wr <- - wr_orig %>% + wr_orig |> add_branch_trajectory( branch_ids = branch_ids, branch_network = branch_network, diff --git a/tests/testthat/test-wrap_add_cell_graph.R b/tests/testthat/test-wrap_add_cell_graph.R index b7ebc3a2..3f541ef8 100755 --- a/tests/testthat/test-wrap_add_cell_graph.R +++ b/tests/testthat/test-wrap_add_cell_graph.R @@ -30,7 +30,7 @@ test_that("Testing add_cell_graph", { ) to_keep <- c(A = T, B = T, C = T, D = T, E = T, "F" = T, G = T, H = T, a = F, b = F, bb = F, c = F, cc = F, d = F) - wr <- wr_orig %>% add_cell_graph( + wr <- wr_orig |> add_cell_graph( cell_graph = cell_graph, to_keep = to_keep, milestone_prefix = "ML_" @@ -48,17 +48,17 @@ test_that("Testing add_cell_graph", { expect_equal(wr$milestone_ids, paste0("ML_", c("A", "D", "F", "G", "H"))) - test_strs <- wr$milestone_network %>% {paste(.$from, .$to, .$length, .$directed, sep = "|")} %>% sort + test_strs <- wr$milestone_network |> (\(.x) paste(.x$from, .x$to, .x$length, .x$directed, sep = "|"))() |> sort() expected_strs <- c( "ML_A|ML_D|1.8|FALSE", "ML_D|ML_F|0.9|FALSE", "ML_D|ML_G|1.3|FALSE", "ML_F|ML_G|0.1|FALSE", "ML_G|ML_H|1|FALSE" - ) %>% sort + ) |> sort() expect_equal(test_strs, expected_strs) - test_strs <- wr$progressions %>% {paste(.$cell_id, .$from, .$to, round(.$percentage, 2), sep = "|")} %>% sort + test_strs <- wr$progressions |> (\(.x) paste(.x$cell_id, .x$from, .x$to, round(.x$percentage, 2), sep = "|"))() |> sort() expected_strs <- c( 'a|ML_A|ML_D|0', 'A|ML_A|ML_D|0', @@ -74,6 +74,6 @@ test_that("Testing add_cell_graph", { 'F|ML_D|ML_F|1', 'G|ML_D|ML_G|1', 'H|ML_G|ML_H|1' - ) %>% sort + ) |> sort() expect_equal(test_strs, expected_strs) }) diff --git a/tests/testthat/test-wrap_add_cell_waypoints.R b/tests/testthat/test-wrap_add_cell_waypoints.R index d41b1f51..9b856899 100755 --- a/tests/testthat/test-wrap_add_cell_waypoints.R +++ b/tests/testthat/test-wrap_add_cell_waypoints.R @@ -32,9 +32,9 @@ milestone_percentages <- tribble( "e", "Z", .5, "f", "Z", .8, "f", "A", .2 -) %>% - crossing(i = 1:100) %>% - mutate(cell_id = paste0(cell_id, i)) %>% +) |> + crossing(i = 1:100) |> + mutate(cell_id = paste0(cell_id, i)) |> select(-i) progressions <- convert_milestone_percentages_to_progressions( @@ -55,10 +55,7 @@ test_that("Testing select_waypoint_cells", { num_cells_selected = length(orig_cell_ids) * num_samp ) - waypoint_cells_table <- - waypoint_cells %>% - gsub("[0-9]+", "", .) %>% - table() + waypoint_cells_table <- gsub("[0-9]+", "", waypoint_cells) |> table() expect_equal(names(waypoint_cells_table), orig_cell_ids) expect_true(all(waypoint_cells_table == num_samp)) @@ -70,7 +67,7 @@ test_that("Testing add_cell_waypoints", { wrap_data( id = "test", cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, @@ -84,10 +81,7 @@ test_that("Testing add_cell_waypoints", { waypoint_cells <- trajectory2$waypoint_cells - waypoint_cells_table <- - waypoint_cells %>% - gsub("[0-9]+", "", .) %>% - table() + waypoint_cells_table <- gsub("[0-9]+", "", waypoint_cells) |> table() expect_equal(names(waypoint_cells_table), orig_cell_ids) expect_true(all(waypoint_cells_table == num_samp)) diff --git a/tests/testthat/test-wrap_add_cyclic_trajectory.R b/tests/testthat/test-wrap_add_cyclic_trajectory.R index 079070f5..bd828af4 100755 --- a/tests/testthat/test-wrap_add_cyclic_trajectory.R +++ b/tests/testthat/test-wrap_add_cyclic_trajectory.R @@ -4,7 +4,7 @@ id <- "a" cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") extras <- list("man") -pseudotime <- c(0, .1, .4, .5, .8, 1) %>% set_names(cell_ids) +pseudotime <- c(0, .1, .4, .5, .8, 1) |> set_names(cell_ids) wr_orig <- wrap_data( id = id, @@ -13,7 +13,7 @@ wr_orig <- wrap_data( test_that("Testing add_cyclic_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_cyclic_trajectory( pseudotime = pseudotime, do_scale_minmax = TRUE, @@ -40,7 +40,7 @@ test_that("Testing add_cyclic_trajectory", { test_that("Testing add_cyclic_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_cyclic_trajectory( pseudotime = pseudotime, do_scale_minmax = TRUE, @@ -54,7 +54,7 @@ test_that("Testing add_cyclic_trajectory", { test_that("Testing add_cyclic_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_cyclic_trajectory( pseudotime = pseudotime/10 + .45, do_scale_minmax = FALSE, @@ -70,9 +70,9 @@ test_that("Testing add_cyclic_trajectory", { test_that("Testing add_cyclic_trajectory fails when expected", { expect_error( - wr_orig %>% + wr_orig |> add_cyclic_trajectory( - pseudotime = pseudotime %>% set_names(NULL), + pseudotime = pseudotime |> set_names(NULL), do_scale_minmax = TRUE, directed = FALSE, extras = extras diff --git a/tests/testthat/test-wrap_add_dimred.R b/tests/testthat/test-wrap_add_dimred.R index a1432ce5..e070594c 100755 --- a/tests/testthat/test-wrap_add_dimred.R +++ b/tests/testthat/test-wrap_add_dimred.R @@ -13,7 +13,7 @@ counts <- matrix( ) expression <- log2(counts + 1) -wr_orig <- wrap_data(id = id, cell_ids = cell_ids) %>% +wr_orig <- wrap_data(id = id, cell_ids = cell_ids) |> add_expression(counts = counts, expression = expression) # trajectory data @@ -55,9 +55,9 @@ progressions <- tribble( "single", "fortune", "must", .4 ) progressions_notent <- - progressions %>% - group_by(cell_id) %>% - slice(1) %>% + progressions |> + group_by(cell_id) |> + slice(1) |> ungroup() divergence_regions <- tribble( ~divergence_id, ~milestone_id, ~is_start, @@ -66,7 +66,7 @@ divergence_regions <- tribble( "be", "of", FALSE ) -wr_withtraj <- wr_orig %>% +wr_withtraj <- wr_orig |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -87,10 +87,10 @@ colnames(dimred_segment_points) <- dim_names dimred_segment_progressions <- tibble(from = "man", to = "in", percentage = seq(0, 1, length.out = nrow(dimred_segment_points))) # clustering data -grouping <- sample(milestone_ids, length(cell_ids), replace = TRUE) %>% set_names(cell_ids) +grouping <- sample(milestone_ids, length(cell_ids), replace = TRUE) |> set_names(cell_ids) test_that("Testing add_dimred", { - wr <- wr_orig %>% + wr <- wr_orig |> add_dimred( dimred = dimred @@ -108,7 +108,7 @@ test_that("Testing add_dimred", { test_that("Testing add_dimred including calculation of dimred", { skip_if_not_installed("dyndimre2d") - wr <- wr_orig %>% add_dimred(dimred = dyndimred::dimred_pca) + wr <- wr_orig |> add_dimred(dimred = dyndimred::dimred_pca) # testing is_ti_data_wrapper expect_true(is_wrapper_with_dimred(wr)) @@ -120,7 +120,7 @@ test_that("Testing add_dimred including calculation of dimred", { test_that("Testing add_dimred with traj dimred", { - wr <- wr_withtraj %>% + wr <- wr_withtraj |> add_dimred( dimred = dimred, dimred_milestones = dimred_milestones, @@ -138,11 +138,11 @@ test_that("Testing add_dimred with traj dimred", { }) test_that("Testing add_dimred with cell group", { - wr <- wr_orig %>% + wr <- wr_orig |> add_grouping( group_ids = milestone_ids, grouping = grouping - ) %>% + ) |> add_dimred( dimred = dimred, dimred_milestones = dimred_milestones @@ -158,28 +158,28 @@ test_that("Testing add_dimred with cell group", { test_that("Expect failure on wrong dimred parameter", { expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = NULL ) ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = 1 ) ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = tibble(1, 2) ) ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = as.data.frame(dimred) ) @@ -189,7 +189,7 @@ test_that("Expect failure on wrong dimred parameter", { test_that("Expect failure on wrong dimred_milestones parameter", { expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_milestones = "vbwoc" @@ -200,7 +200,7 @@ test_that("Expect failure on wrong dimred_milestones parameter", { test_that("Expect failure on wrong dimred_segment_progressions parameter", { expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = "hdcoew", @@ -209,7 +209,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = dimred_segment_progressions, @@ -218,7 +218,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = dimred_segment_progressions, @@ -227,7 +227,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = dimred_segment_progressions, @@ -236,7 +236,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = dimred_segment_progressions[-1,], @@ -245,7 +245,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { ) expect_error( - wr_withtraj %>% + wr_withtraj |> add_dimred( dimred = dimred, dimred_segment_progressions = dimred_segment_progressions[,-1], @@ -256,7 +256,7 @@ test_that("Expect failure on wrong dimred_segment_progressions parameter", { test_that("Test add_dimred with projection", { - wr_withdimred <- wr_withtraj %>% + wr_withdimred <- wr_withtraj |> add_dimred( dimred = dimred, project_trajectory = TRUE @@ -268,7 +268,7 @@ test_that("Test add_dimred with projection", { test_that("Test get_dimred", { - wr_withdimred <- wr_withtraj %>% add_dimred(dimred) + wr_withdimred <- wr_withtraj |> add_dimred(dimred) # from trajectory expect_error(get_dimred(wr_orig)) @@ -284,7 +284,7 @@ test_that("Test get_dimred", { expect_equivalent(dimred, dimred2) # df - dimred_df <- dimred %>% as.data.frame() %>% rownames_to_column("cell_id") + dimred_df <- dimred |> as.data.frame() |> rownames_to_column("cell_id") dimred2 <- get_dimred(wr_withdimred, dimred = dimred_df) expect_equivalent(dimred, dimred2) diff --git a/tests/testthat/test-wrap_add_dimred_projection.R b/tests/testthat/test-wrap_add_dimred_projection.R index 2ce6e308..83f8099b 100755 --- a/tests/testthat/test-wrap_add_dimred_projection.R +++ b/tests/testthat/test-wrap_add_dimred_projection.R @@ -33,7 +33,7 @@ milestone_network <- tribble( ) # grouping info -grouping <- sample(milestone_ids, length(cell_ids), replace = T) %>% set_names(cell_ids) +grouping <- sample(milestone_ids, length(cell_ids), replace = T) |> set_names(cell_ids) # dimred data num_dims <- round(runif(1, 3, 10)) @@ -46,7 +46,7 @@ dimred_milestones <- matrix(runif(num_dims * length(milestone_ids), 0, 1), nrow test_that("Testing add_dimred_projection", { - wr <- wr_orig %>% + wr <- wr_orig |> add_dimred_projection( milestone_ids = milestone_ids, milestone_network = milestone_network, @@ -74,7 +74,7 @@ test_that("Testing add_dimred_projection", { test_that("Testing add_dimred_projection with grouping", { - wr <- wr_orig %>% + wr <- wr_orig |> add_dimred_projection( milestone_ids = milestone_ids, milestone_network = milestone_network, diff --git a/tests/testthat/test-wrap_add_end_state_probabilities.R b/tests/testthat/test-wrap_add_end_state_probabilities.R index 8a068490..8a54a1fd 100755 --- a/tests/testthat/test-wrap_add_end_state_probabilities.R +++ b/tests/testthat/test-wrap_add_end_state_probabilities.R @@ -6,8 +6,8 @@ cell_ids <- letters end_state_ids <- LETTERS[1:5] end_state_probabilities <- matrix(runif(length(cell_ids) * length(end_state_ids)), nrow = length(cell_ids)) colnames(end_state_probabilities) <- end_state_ids -end_state_probabilities <- end_state_probabilities %>% as.data.frame() %>% mutate(cell_id = cell_ids) -pseudotime <- runif(length(cell_ids)) %>% set_names(cell_ids) +end_state_probabilities <- end_state_probabilities |> as.data.frame() |> mutate(cell_id = cell_ids) +pseudotime <- runif(length(cell_ids)) |> set_names(cell_ids) wr_orig <- wrap_data( id = id, @@ -15,7 +15,7 @@ wr_orig <- wrap_data( ) test_that("Testing add_end_state_probabilities", { - wr <- wr_orig %>% + wr <- wr_orig |> add_end_state_probabilities( end_state_probabilities = end_state_probabilities, pseudotime = pseudotime @@ -31,7 +31,7 @@ test_that("Testing add_end_state_probabilities", { expect_equivalent(wr$cell_ids, cell_ids) # test with only one end states - wr <- wr_orig %>% + wr <- wr_orig |> add_end_state_probabilities( end_state_probabilities = end_state_probabilities[, "cell_id", drop=F], pseudotime = pseudotime diff --git a/tests/testthat/test-wrap_add_expression.R b/tests/testthat/test-wrap_add_expression.R index eb759f1e..a33449ba 100755 --- a/tests/testthat/test-wrap_add_expression.R +++ b/tests/testthat/test-wrap_add_expression.R @@ -24,7 +24,7 @@ wrapper1 <- cell_ids = cell_ids, cell_info = cell_info, extras1 = extras1 - ) %>% + ) |> add_expression( counts = counts, expression = expression, @@ -63,19 +63,19 @@ test_that("Testing add_expression and get_expression", { expect_is(get_expression(wr, "counts"), "dgCMatrix") expect_is(get_expression(wr, "expression"), "dgCMatrix") - expect_equivalent(get_expression(wr, "counts") %>% as.matrix, counts) - expect_equivalent(get_expression(wr) %>% as.matrix, expression) - expect_equivalent(get_expression("whatever", wr) %>% as.matrix, expression) - expect_equivalent(get_expression(wr, expression) %>% as.matrix, expression) - expect_equivalent(get_expression(wr, counts) %>% as.matrix, counts) + expect_equivalent(get_expression(wr, "counts") |> as.matrix(), counts) + expect_equivalent(get_expression(wr) |> as.matrix(), expression) + expect_equivalent(get_expression("whatever", wr) |> as.matrix(), expression) + expect_equivalent(get_expression(wr, expression) |> as.matrix(), expression) + expect_equivalent(get_expression(wr, counts) |> as.matrix(), counts) expect_error(get_expression(wr, "say what")) expect_error(get_expression("you don't say")) } }) test_that("Testing add tde_overall", { - tde_overall <- tibble(feature_id = feature_info$feature_id) %>% mutate(differentially_expressed = runif(n()) > 0.5) - wrapper_tde <- wrapper1 %>% add_tde_overall(tde_overall) + tde_overall <- tibble(feature_id = feature_info$feature_id) |> mutate(differentially_expressed = runif(n()) > 0.5) + wrapper_tde <- wrapper1 |> add_tde_overall(tde_overall) expect_equal(tde_overall, wrapper_tde$tde_overall) }) diff --git a/tests/testthat/test-wrap_add_grouping.R b/tests/testthat/test-wrap_add_grouping.R index 26a770af..ef5a2b2f 100755 --- a/tests/testthat/test-wrap_add_grouping.R +++ b/tests/testthat/test-wrap_add_grouping.R @@ -9,10 +9,10 @@ cell_info <- tibble( info3 = 1:6 ) -wrapper1 <- wrap_data(id, cell_ids) %>% add_grouping(cell_info$info1) -wrapper2 <- wrap_data(id, cell_ids) %>% add_grouping(unique(cell_info$info1), cell_info$info1) -wrapper3 <- wrap_data(id, cell_ids) %>% add_grouping(tibble(cell_id = cell_ids, group_id = cell_info$info1)) -wrapper4 <- wrap_data(id, cell_ids) %>% add_prior_information(groups_id = tibble(cell_id = cell_ids, group_id = cell_info$info1)) +wrapper1 <- wrap_data(id, cell_ids) |> add_grouping(cell_info$info1) +wrapper2 <- wrap_data(id, cell_ids) |> add_grouping(unique(cell_info$info1), cell_info$info1) +wrapper3 <- wrap_data(id, cell_ids) |> add_grouping(tibble(cell_id = cell_ids, group_id = cell_info$info1)) +wrapper4 <- wrap_data(id, cell_ids) |> add_prior_information(groups_id = tibble(cell_id = cell_ids, group_id = cell_info$info1)) wrapper5 <- wrap_data(id, cell_ids, cell_info) test_that("Testing add_grouping", { @@ -41,12 +41,12 @@ test_that("Testing get_grouping", { milestone_network <- tibble(from = c("A", "B"), to = c("B", "C"), directed = TRUE, length = 1) progressions <- tibble(cell_id = cell_ids, from = c(rep("A", 3), rep("B", 3)), to = c(rep("B", 3), rep("C", 3)), percentage = c(0, 0.5, 1, 0, 0.5, 1)) -trajectory <- wrap_data(id, cell_ids) %>% add_trajectory(milestone_network = milestone_network, progressions = progressions) +trajectory <- wrap_data(id, cell_ids) |> add_trajectory(milestone_network = milestone_network, progressions = progressions) test_that("Testing group_onto_trajectory_edges", { grouping <- group_onto_trajectory_edges(trajectory) expect_equal(length(grouping), length(cell_ids)) expect_equal(names(grouping), cell_ids) - expect_equal(grouping %>% unname(), c("A->B", "A->B", "A->B", "B->C", "B->C", "B->C")) + expect_equal(grouping |> unname(), c("A->B", "A->B", "A->B", "B->C", "B->C", "B->C")) }) diff --git a/tests/testthat/test-wrap_add_linear_trajectory.R b/tests/testthat/test-wrap_add_linear_trajectory.R index fddf96c0..adc10b4e 100755 --- a/tests/testthat/test-wrap_add_linear_trajectory.R +++ b/tests/testthat/test-wrap_add_linear_trajectory.R @@ -4,7 +4,7 @@ id <- "a" cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") extras <- list("man") -pseudotime <- c(0, .1, .4, .5, .8, 1) %>% set_names(cell_ids) +pseudotime <- c(0, .1, .4, .5, .8, 1) |> set_names(cell_ids) wr_orig <- wrap_data( id = id, @@ -13,7 +13,7 @@ wr_orig <- wrap_data( test_that("Testing add_linear_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_linear_trajectory( pseudotime = pseudotime, do_scale_minmax = TRUE, @@ -41,7 +41,7 @@ test_that("Testing add_linear_trajectory", { test_that("Testing add_linear_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_linear_trajectory( pseudotime = pseudotime, do_scale_minmax = TRUE, @@ -69,7 +69,7 @@ test_that("Testing add_linear_trajectory", { test_that("Testing add_linear_trajectory", { wr <- - wr_orig %>% + wr_orig |> add_linear_trajectory( pseudotime = pseudotime/10 + .45, do_scale_minmax = FALSE, @@ -84,7 +84,7 @@ test_that("Testing add_linear_trajectory", { test_that("Testing add_linear_trajectory with some cells filtered", { wr <- - wr_orig %>% + wr_orig |> add_linear_trajectory( pseudotime = pseudotime[-1], do_scale_minmax = TRUE, diff --git a/tests/testthat/test-wrap_add_prior_information.R b/tests/testthat/test-wrap_add_prior_information.R index b2af59b4..87a1e09e 100755 --- a/tests/testthat/test-wrap_add_prior_information.R +++ b/tests/testthat/test-wrap_add_prior_information.R @@ -32,9 +32,9 @@ milestone_percentages <- tribble( "e", "Z", .5, "f", "Z", .8, "f", "A", .2 -) %>% - crossing(i = 1:100) %>% - mutate(cell_id = paste0(cell_id, i)) %>% +) |> + crossing(i = 1:100) |> + mutate(cell_id = paste0(cell_id, i)) |> select(-i) progressions <- convert_milestone_percentages_to_progressions( @@ -99,21 +99,21 @@ test_that("Testing generate_prior_information", { testthat::expect_equal(gsub("[0-9]+", "", prior_info$start_id), "a") - testthat::expect_equal(prior_info$end_milestones %>% sort, c("A", "Y")) + testthat::expect_equal(prior_info$end_milestones |> sort(), c("A", "Y")) testthat::expect_equal(gsub("[0-9]+", "", prior_info$end_id), c("b", "f")) join_check <- - milestone_percentages %>% - group_by(cell_id) %>% - arrange(desc(percentage)) %>% - slice(1) %>% - select(-percentage) %>% - ungroup() %>% + milestone_percentages |> + group_by(cell_id) |> + arrange(desc(percentage)) |> + slice(1) |> + select(-percentage) |> + ungroup() |> full_join(prior_info$groups_id, by = "cell_id") testthat::expect_equal(join_check$group_id, join_check$milestone_id) - testthat::expect_equal(prior_info$groups_network, milestone_network %>% select(from, to)) + testthat::expect_equal(prior_info$groups_network, milestone_network |> select(from, to)) testthat::expect_true(all(prior_info$features_id %in% gene_ids)) @@ -137,12 +137,12 @@ test_that("Testing add_prior_information", { id = "test", cell_ids = cell_ids, cell_info = cell_info - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, divergence_regions = divergence_regions - ) %>% add_expression( + ) |> add_expression( counts = expression, expression = expression, feature_info = feature_info @@ -178,21 +178,21 @@ test_that("Testing add_prior_information", { testthat::expect_equal(gsub("[0-9]+", "", prior_info$start_id), "a") - testthat::expect_equal(prior_info$end_milestones %>% sort, c("A", "Y")) + testthat::expect_equal(prior_info$end_milestones |> sort(), c("A", "Y")) testthat::expect_equal(gsub("[0-9]+", "", prior_info$end_id), c("b", "f")) join_check <- - milestone_percentages %>% - group_by(cell_id) %>% - arrange(desc(percentage)) %>% - slice(1) %>% - select(-percentage) %>% - ungroup() %>% + milestone_percentages |> + group_by(cell_id) |> + arrange(desc(percentage)) |> + slice(1) |> + select(-percentage) |> + ungroup() |> full_join(prior_info$groups_id, by = "cell_id") testthat::expect_equal(join_check$group_id, join_check$milestone_id) - testthat::expect_equal(prior_info$groups_network, milestone_network %>% select(from, to)) + testthat::expect_equal(prior_info$groups_network, milestone_network |> select(from, to)) testthat::expect_true(all(prior_info$features_id %in% gene_ids)) @@ -214,7 +214,7 @@ test_that("Testing add_prior_information", { # with undirected cyclical dataset orig_cell_ids <- c("a", "b", "c", "d", "e", "f") -cell_ids <- orig_cell_ids %>% map(~paste0(., seq_len(20))) %>% unlist() +cell_ids <- orig_cell_ids |> map(~paste0(., seq_len(20))) |> unlist() orig_map <- set_names(gsub("[0-9]+", "", cell_ids), cell_ids) milestone_ids <- c("X", "Y", "Z") @@ -237,12 +237,12 @@ orig_progressions <- tribble( "f", "Z", "X", .6 ) progressions <- - tibble(cell_id = cell_ids, orig_cell_id = orig_map) %>% - left_join(orig_progressions, by = "orig_cell_id") %>% + tibble(cell_id = cell_ids, orig_cell_id = orig_map) |> + left_join(orig_progressions, by = "orig_cell_id") |> mutate( percentage = percentage + runif(n(), -.3, .3), percentage = ifelse(percentage > 1, 1, ifelse(percentage < 0, 0, percentage)) - ) %>% + ) |> select(-orig_cell_id) milestone_percentages <- @@ -257,7 +257,7 @@ num_genes <- 20 orig_gene_ids <- paste0("Gene", seq_len(num_genes)) orig_expression <- matrix(rbinom(num_genes * length(cell_ids), 10000, .01), ncol = num_genes, dimnames = list(cell_ids, orig_gene_ids)) -milpct <- milestone_percentages %>% reshape2::acast(cell_id ~ milestone_id, value.var = "percentage", fill = 0) +milpct <- milestone_percentages |> reshape2::acast(cell_id ~ milestone_id, value.var = "percentage", fill = 0) expression <- cbind(orig_expression, milpct) * 100 + 2 gene_ids <- colnames(expression) @@ -290,16 +290,16 @@ test_that("Testing generate_prior_information", { testthat::expect_true(all(expected_prior %in% names(prior_info))) join_check <- - milestone_percentages %>% - group_by(cell_id) %>% - arrange(desc(percentage)) %>% - slice(1) %>% - select(-percentage) %>% - ungroup() %>% + milestone_percentages |> + group_by(cell_id) |> + arrange(desc(percentage)) |> + slice(1) |> + select(-percentage) |> + ungroup() |> full_join(prior_info$groups_id, by = "cell_id") testthat::expect_equal(join_check$group_id, join_check$milestone_id) - testthat::expect_equal(prior_info$groups_network, milestone_network %>% select(from, to)) + testthat::expect_equal(prior_info$groups_network, milestone_network |> select(from, to)) testthat::expect_true(all(prior_info$features_id %in% gene_ids)) @@ -312,12 +312,12 @@ test_that("Testing add_prior_information", { wrap_data( id = "test", cell_ids = cell_ids - ) %>% add_trajectory( + ) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, divergence_regions = divergence_regions - ) %>% add_expression( + ) |> add_expression( expression = expression, counts = expression ) @@ -351,16 +351,16 @@ test_that("Testing add_prior_information", { testthat::expect_true(all(expected_prior %in% names(prior_info))) join_check <- - milestone_percentages %>% - group_by(cell_id) %>% - arrange(desc(percentage)) %>% - slice(1) %>% - select(-percentage) %>% - ungroup() %>% + milestone_percentages |> + group_by(cell_id) |> + arrange(desc(percentage)) |> + slice(1) |> + select(-percentage) |> + ungroup() |> full_join(prior_info$groups_id, by = "cell_id") testthat::expect_equal(join_check$group_id, join_check$milestone_id) - testthat::expect_equal(prior_info$groups_network, milestone_network %>% select(from, to)) + testthat::expect_equal(prior_info$groups_network, milestone_network |> select(from, to)) testthat::expect_true(all(prior_info$features_id %in% gene_ids)) diff --git a/tests/testthat/test-wrap_add_pseudotime.R b/tests/testthat/test-wrap_add_pseudotime.R index 8fbc9622..aca45eb3 100755 --- a/tests/testthat/test-wrap_add_pseudotime.R +++ b/tests/testthat/test-wrap_add_pseudotime.R @@ -4,7 +4,7 @@ id <- "a" cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") extras <- list("man") -pseudotime <- c(0, .1, .4, .5, .8, 1) %>% set_names(cell_ids) +pseudotime <- c(0, .1, .4, .5, .8, 1) |> set_names(cell_ids) wr_orig <- wrap_data( id = id, @@ -12,7 +12,7 @@ wr_orig <- wrap_data( ) test_that("add_pseudotime works as expected", { - trajectory <- wr_orig %>% add_pseudotime(pseudotime = pseudotime) + trajectory <- wr_orig |> add_pseudotime(pseudotime = pseudotime) expect_equal(trajectory$pseudotime, pseudotime) diff --git a/tests/testthat/test-wrap_add_root_and_add_pseudotime.R b/tests/testthat/test-wrap_add_root_and_add_pseudotime.R index 2649a930..aec99015 100755 --- a/tests/testthat/test-wrap_add_root_and_add_pseudotime.R +++ b/tests/testthat/test-wrap_add_root_and_add_pseudotime.R @@ -39,7 +39,7 @@ milestone_percentages <- tribble( trajectory <- wrap_data( id = "test", cell_ids = cell_ids -) %>% add_trajectory( +) |> add_trajectory( milestone_ids = milestone_ids, milestone_network = milestone_network, milestone_percentages = milestone_percentages, @@ -63,7 +63,7 @@ test_that("Testing add_root on simple linear trajectory", { test_that("Testing add_root on a more complex linear trajectory", { - trajectory2 <- wrap_data(cell_ids = "a") %>% + trajectory2 <- wrap_data(cell_ids = "a") |> add_trajectory( milestone_network = tibble(from = c("2", "1", "4", "3"), to = c("1", "4", "3", "5"), length = 1, directed = TRUE), progressions = tibble(cell_id = "a", from = "2", to = "1", percentage = 0) diff --git a/tests/testthat/test-wrap_add_timings.R b/tests/testthat/test-wrap_add_timings.R index 9bf81ee6..2ca7108e 100755 --- a/tests/testthat/test-wrap_add_timings.R +++ b/tests/testthat/test-wrap_add_timings.R @@ -14,11 +14,11 @@ test_that("Testing add_timings", { tl <- add_timing_checkpoint(NULL, "start") Sys.sleep(1) - tl <- tl %>% add_timing_checkpoint("second") + tl <- tl |> add_timing_checkpoint("second") Sys.sleep(.5) - tl <- tl %>% add_timing_checkpoint("third") + tl <- tl |> add_timing_checkpoint("third") Sys.sleep(.25) - tl <- tl %>% add_timing_checkpoint("stop") + tl <- tl |> add_timing_checkpoint("stop") wr <- wrap_data( @@ -27,7 +27,7 @@ test_that("Testing add_timings", { cell_info = cell_info, extras1 = extras1, extras2 = extras2 - ) %>% + ) |> add_timings( timings = tl ) diff --git a/tests/testthat/test-wrap_add_trajectory.R b/tests/testthat/test-wrap_add_trajectory.R index 748c7471..4c16283b 100755 --- a/tests/testthat/test-wrap_add_trajectory.R +++ b/tests/testthat/test-wrap_add_trajectory.R @@ -40,7 +40,7 @@ divergence_regions <- tribble( trajectory <- wrap_data( id = id, cell_ids = cell_ids -) %>% add_trajectory( +) |> add_trajectory( milestone_network = milestone_network, divergence_regions = divergence_regions, milestone_percentages = milestone_percentages diff --git a/tests/testthat/test-wrap_add_waypoints.R b/tests/testthat/test-wrap_add_waypoints.R index 172bc322..1917aaff 100755 --- a/tests/testthat/test-wrap_add_waypoints.R +++ b/tests/testthat/test-wrap_add_waypoints.R @@ -32,12 +32,12 @@ milestone_percentages <- tribble( "e", "Z", .5, "f", "Z", .8, "f", "A", .2 -) %>% - crossing(i = 1:100) %>% - mutate(cell_id = paste0(cell_id, i)) %>% +) |> + crossing(i = 1:100) |> + mutate(cell_id = paste0(cell_id, i)) |> select(-i) -trajectory <- wrap_data("", cell_ids) %>% +trajectory <- wrap_data("", cell_ids) |> add_trajectory(milestone_ids, milestone_network, divergence_regions, milestone_percentages = milestone_percentages) @@ -59,7 +59,7 @@ test_that("Testing select_waypoints", { test_that("Testing add_cell_waypoints", { - trajectory <- trajectory %>% add_waypoints() + trajectory <- trajectory |> add_waypoints() expect_true(!is.null(trajectory$waypoints)) }) diff --git a/tests/testthat/test-wrap_cell_group.R b/tests/testthat/test-wrap_cell_group.R index 6aedca44..ca3b7f30 100755 --- a/tests/testthat/test-wrap_cell_group.R +++ b/tests/testthat/test-wrap_cell_group.R @@ -4,7 +4,7 @@ context("Testing add_grouping") id <- "a" cell_ids <- letters group_ids <- LETTERS[1:5] -grouping <- sample(group_ids, length(cell_ids), replace = T) %>% set_names(cell_ids) +grouping <- sample(group_ids, length(cell_ids), replace = T) |> set_names(cell_ids) extras <- "banana" wr_orig <- wrap_data( @@ -13,7 +13,7 @@ wr_orig <- wrap_data( ) test_that("Testing add_grouping", { - wr <- wr_orig %>% + wr <- wr_orig |> add_grouping( group_ids = group_ids, grouping = grouping, @@ -34,7 +34,7 @@ test_that("Testing add_grouping", { test_that("Testing add_grouping with a subset of cells", { - wr <- wr_orig %>% + wr <- wr_orig |> add_grouping( group_ids = group_ids, grouping = grouping[1:10], @@ -55,7 +55,7 @@ test_that("Testing add_grouping with a subset of cells", { test_that("Testing add_grouping fails when groupings is not in the correct format", { expect_error( - wr_orig %>% + wr_orig |> add_grouping( group_ids = group_ids, grouping = paste0("HUO", grouping), @@ -64,16 +64,16 @@ test_that("Testing add_grouping fails when groupings is not in the correct forma ) expect_error( - wr_orig %>% + wr_orig |> add_grouping( group_ids = group_ids, - grouping = rep(1, length(cell_ids)) %>% set_names(cell_ids), + grouping = rep(1, length(cell_ids)) |> set_names(cell_ids), extras = extras ) ) expect_error( - wr_orig %>% + wr_orig |> add_grouping( group_ids = group_ids, grouping = tibble(grouping), diff --git a/tests/testthat/test-wrap_cluster_graph.R b/tests/testthat/test-wrap_cluster_graph.R index 7857703a..f1112b84 100755 --- a/tests/testthat/test-wrap_cluster_graph.R +++ b/tests/testthat/test-wrap_cluster_graph.R @@ -4,7 +4,7 @@ context("Testing add_cluster_graph") id <- "a" cell_ids <- letters group_ids <- LETTERS[1:5] -grouping <- sample(group_ids, length(cell_ids), replace = T) %>% set_names(cell_ids) +grouping <- sample(group_ids, length(cell_ids), replace = T) |> set_names(cell_ids) extras <- "banana" wr_without_grouping <- wrap_data( @@ -12,7 +12,7 @@ wr_without_grouping <- wrap_data( cell_ids = cell_ids ) -wr_orig <- wr_without_grouping %>% add_grouping( +wr_orig <- wr_without_grouping |> add_grouping( group_ids = group_ids, grouping = grouping, extras = extras @@ -26,7 +26,7 @@ milestone_network <- tibble( ) test_that("Testing add_cluster_graph", { - wr <- wr_orig %>% + wr <- wr_orig |> add_cluster_graph( milestone_network = milestone_network ) @@ -47,7 +47,7 @@ test_that("Testing add_cluster_graph", { expect_true(all(abs(abs(wr$milestone_percentages$percentage - .5) - .5) < 1e-6)) # test with providing a grouping in cluster_graph - wr <- wr_without_grouping %>% + wr <- wr_without_grouping |> add_cluster_graph( milestone_network = milestone_network, grouping = grouping diff --git a/tests/testthat/test-wrap_label_milestones.R b/tests/testthat/test-wrap_label_milestones.R index 11f8deba..ff90d548 100755 --- a/tests/testthat/test-wrap_label_milestones.R +++ b/tests/testthat/test-wrap_label_milestones.R @@ -28,12 +28,12 @@ expression <- matrix( wr_orig <- wrap_data( id = id, cell_ids = cell_ids -) %>% +) |> add_trajectory(milestone_network = milestone_network, progressions = progressions) test_that("Testing milestone labelling manually", { - wr <- wr_orig %>% label_milestones( + wr <- wr_orig |> label_milestones( labelling = c( "one" = "end", "two" = "begin" @@ -55,7 +55,7 @@ test_that("Testing milestone labelling with expression", { "begin" = "G1", "end" = "G2" ) - wr <- wr_orig %>% label_milestones_markers( + wr <- wr_orig |> label_milestones_markers( markers = markers, expression_source = expression, n_nearest_cells = 2 @@ -69,7 +69,7 @@ test_that("Testing milestone labelling with expression", { # warning when multiple labels are mapped to the same milestone expect_warning( - wr_orig %>% label_milestones_markers( + wr_orig |> label_milestones_markers( markers = list(begin = "G1"), expression_source = expression, n_nearest_cells = 20 diff --git a/vignettes/create_ti_method_container.Rmd b/vignettes/create_ti_method_container.Rmd index de657cda..bb1342ed 100755 --- a/vignettes/create_ti_method_container.Rmd +++ b/vignettes/create_ti_method_container.Rmd @@ -27,7 +27,7 @@ library(dynwrap) library(dplyr) ``` -Once [you have wrapped a method using a script and definition](../create_ti_method_script), all you need to share your method is a _Dockerfile_ which lists all the dependencies that need to be installed. +Once [you have wrapped a method using a script and definition](create_ti_method_definition.html), all you need to share your method is a _Dockerfile_ which lists all the dependencies that need to be installed. We'll work with the following _definition.yml_: @@ -68,7 +68,7 @@ readr::write_file(docker_file, "Dockerfile") knitr::asis_output(paste0("```Dockerfile\n", docker_file, "\n```")) ``` -`dynverse/dynwrappy` is here the base image, which contains the latest version of R, python, dynwrap, dyncli and most tidyverse dependencies. For R methods, you can use the `dynverse/dynwrapr` base. While not required, it's recommended to start from these base images, because dyncli provides an interface to run each method using the docker container from the command line. [As discussed before](../create_ti_method_script), wrapping is also a lot easier using dynwrap. +`dynverse/dynwrappy` is here the base image, which contains the latest version of R, python, dynwrap, dyncli and most tidyverse dependencies. For R methods, you can use the `dynverse/dynwrapr` base. While not required, it's recommended to start from these base images, because dyncli provides an interface to run each method using the docker container from the command line. [As discussed before](create_ti_method_definition.html), wrapping is also a lot easier using dynwrap.
For reproducibility, it's best to specify the tag of the base image. You can find this these tags on dockerhub: https://hub.docker.com/r/dynverse/dynwrapr/tags. diff --git a/vignettes/create_ti_method_definition.Rmd b/vignettes/create_ti_method_definition.Rmd index 7a9fb2ed..f6008ba5 100755 --- a/vignettes/create_ti_method_definition.Rmd +++ b/vignettes/create_ti_method_definition.Rmd @@ -26,7 +26,7 @@ NOT_TRAVIS <- !identical(tolower(Sys.getenv("TRAVIS")), "true") library(dynwrap) ``` -An alternative to wrapping a script inside R, is to wrap it using an external script. Because this does not provide any dependency management, this is not really useful for method end-users, but rather as a way to easily develop a TI method and to ultimately step up towards [containerised wrapping](../create_ti_method_container). +An alternative to wrapping a script inside R, is to wrap it using an external script. Because this does not provide any dependency management, this is not really useful for method end-users, but rather as a way to easily develop a TI method and to ultimately step up towards [containerised wrapping](create_ti_method_container.html). Similarly as a wrapper written in R, you'll need to provide both a definition (= a _definition.yml_) and a way to run the methods (= a script). @@ -53,7 +53,7 @@ The wrapper script will typically have the following structure: - A shebang, such as `#!/usr/bin/env Rscript` or `#!/usr/bin/env python` - A call to dyncli(py) to load in the data, such as `dataset <- dyncli::main()` or `dataset = dynclipy.main()` - All you need to infer the trajectory -- Constructing the trajectory model using [any of the wrapping methods](../create_ti_method_wrappers) +- Constructing the trajectory model using [any of the wrapping methods](create_ti_method_wrappers.html) - A call to dyncli(py) to write the data, such as `dyncli::write_output(trajectory)` or `trajectory.write_output()` A minimal example script for R: @@ -111,7 +111,7 @@ trajectory <- infer_trajectory(dataset, method(), debug = TRUE) ## Making your method available for other users -Wrapping a method inside a script does not have any dependency management, and is therefore only meant for development purposes. To deploy your method to other users, check out the [containerisation tutorial](../create_ti_method_container)! +Wrapping a method inside a script does not have any dependency management, and is therefore only meant for development purposes. To deploy your method to other users, check out the [containerisation tutorial](create_ti_method_container.html)! ## Wrapping a method without dyncli(py) diff --git a/vignettes/create_ti_method_r.Rmd b/vignettes/create_ti_method_r.Rmd index 42bfde9d..d5677149 100755 --- a/vignettes/create_ti_method_r.Rmd +++ b/vignettes/create_ti_method_r.Rmd @@ -81,7 +81,7 @@ run_fun <- function(expression, priors, parameters, seed, verbose) { } ``` -This function returns a trajectory object as described in [create a trajectory](../create_ti_method_wrappers). You may also add other relevant information to this output, often some timing checkpoints (`add_timings`), dimensionality reduction (`add_dimred`) or a cell clustering (`add_grouping`). Check out the [reference](https://dynverse.org/reference/dynwrap/) for an overview or [post an issue or pull request](https://github.com/dynverse/dynwrap) if you want a type of output to be added. +This function returns a trajectory object as described in [create a trajectory](create_ti_method_wrappers.html). You may also add other relevant information to this output, often some timing checkpoints (`add_timings`), dimensionality reduction (`add_dimred`) or a cell clustering (`add_grouping`). Check out the [reference](https://dynverse.org/reference/dynwrap/) for an overview or [post an issue or pull request](https://github.com/dynverse/dynwrap) if you want a type of output to be added. ## Testing it out From 189316d3d11cfa20a7622f9fba73c7b143fb60c5 Mon Sep 17 00:00:00 2001 From: Robrecht Cannoodt Date: Tue, 31 Mar 2026 13:32:00 +0200 Subject: [PATCH 2/3] bump minimum version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e5757a29..b94dc40e 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,7 @@ RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Encoding: UTF-8 Depends: - R (>= 3.0.0) + R (>= 4.1.0) Imports: assertthat, babelwhale, From 1daf1e81430b65d62cdc475b85943358aa4d37cd Mon Sep 17 00:00:00 2001 From: Robrecht Cannoodt Date: Tue, 31 Mar 2026 13:50:11 +0200 Subject: [PATCH 3/3] remove . as a global variable --- R/package.R | 4 ++-- R/wrap_add_dimred.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/package.R b/R/package.R index c1131dce..fae43777 100755 --- a/R/package.R +++ b/R/package.R @@ -34,7 +34,7 @@ NULL # Define valid global variables if(getRversion() >= "2.15.1") { utils::globalVariables(c( - ".", "branch_id", "cell_id", "comp_1", "comp_2", + "branch_id", "cell_id", "comp_1", "comp_2", "correlation", "correlation_mean", "directed", "dist", "divergence_id", "edge_id", "feature_id", "flip", "from", "from_milestone_id", "from_waypoint", "from2", "group_id", @@ -42,7 +42,7 @@ if(getRversion() >= "2.15.1") { "ix", "label", "length1", "length2", "milestone_id", "new_milestone_id", "new_new_milestone_id", "node", "node1", "node2", "num_cells", "one", "percentage", "PREDICT", "prior_id", "required", "rowname", - "id", "match", "membership", "order", "path", + "match", "membership", "order", "path", "sd", "start", "waypoint_id", "weight", "zero", "time", "to", "to_waypoint", "triangle_id", "triangle_part", "type", "comp_1_from", "comp_2_from", "comp_1_to", "comp_2_to", "str_subset")) diff --git a/R/wrap_add_dimred.R b/R/wrap_add_dimred.R index 80295d3f..7d17fa8c 100755 --- a/R/wrap_add_dimred.R +++ b/R/wrap_add_dimred.R @@ -285,7 +285,7 @@ connect_dimred_segments <- function(dimred_segment_progressions, dimred_segment_ }) connecting_progressions <- connections |> map_dfr("progressions") - connecting_points <- connections |> map("points") |> do.call(rbind, .) + connecting_points <- connections |> map("points") |> do.call(rbind) list( dimred_segment_progressions = bind_rows(dimred_segment_progressions, connecting_progressions),