├── .Rbuildignore ├── .gitattributes ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── adapt_orient_topology.R ├── add_regulatory_network.R ├── calculate_average.R ├── calculate_geodesic_distances.R ├── calculate_trajectory_dimred.R ├── classify_milestone_network.R ├── container_get.R ├── convert_milestone_percentages_to_progressions.R ├── convert_progressions_to_milestone_percentages.R ├── data.R ├── method_create_ti_method_container.R ├── method_create_ti_method_definition.R ├── method_create_ti_method_r.R ├── method_execute.R ├── method_extract_args.R ├── method_get_ti_methods.R ├── method_infer_trajectory.R ├── method_process_definition.R ├── package.R ├── project_waypoints.R ├── reexport.R ├── simplify_igraph_network.R ├── simplify_trajectory.R ├── wrap_add_attraction.R ├── wrap_add_branch_trajectory.R ├── wrap_add_cell_graph.R ├── wrap_add_cell_waypoints.R ├── wrap_add_cluster_graph.R ├── wrap_add_cyclic_trajectory.R ├── wrap_add_dimred.R ├── wrap_add_dimred_projection.R ├── wrap_add_end_state_probabilities.R ├── wrap_add_expression.R ├── wrap_add_feature_importance.R ├── wrap_add_grouping.R ├── wrap_add_linear_trajectory.R ├── wrap_add_prior_information.R ├── wrap_add_pseudotime.R ├── wrap_add_root.R ├── wrap_add_tde_overall.R ├── wrap_add_timings.R ├── wrap_add_trajectory.R ├── wrap_add_waypoints.R ├── wrap_data.R ├── wrap_gather_cells_at_milestones.R └── wrap_label_milestones.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── data-raw ├── allowed_inputs_outputs.R ├── example_dataset.R ├── priors.R ├── trajectory_types.R └── wrapper_types.R ├── data ├── allowed_inputs.rda ├── allowed_outputs.rda ├── example_dataset.rda ├── example_trajectory.rda ├── prior_usages.rda ├── priors.rda ├── trajectory_type_dag.rda ├── trajectory_types.rda └── wrapper_types.rda ├── dynwrap.Rproj ├── inst ├── CITATION ├── examples │ ├── docker │ │ ├── Dockerfile │ │ ├── definition.yml │ │ └── run.py │ └── script │ │ ├── definition.yml │ │ ├── run.R │ │ └── run.py └── tests │ └── testthat │ ├── helper-ti_comp1.R │ ├── helper-ti_error.R │ ├── helper-ti_identity.R │ ├── helper-ti_random.R │ └── helper-ti_shuffle.R ├── man ├── add_attraction.Rd ├── add_branch_trajectory.Rd ├── add_cell_graph.Rd ├── add_cell_waypoints.Rd ├── add_cluster_graph.Rd ├── add_cyclic_trajectory.Rd ├── add_dimred.Rd ├── add_dimred_projection.Rd ├── add_end_state_probabilities.Rd ├── add_expression.Rd ├── add_feature_importance.Rd ├── add_grouping.Rd ├── add_linear_trajectory.Rd ├── add_prior_information.Rd ├── add_pseudotime.Rd ├── add_regulatory_network.Rd ├── add_root.Rd ├── add_tde_overall.Rd ├── add_timings.Rd ├── add_trajectory.Rd ├── add_waypoints.Rd ├── allowed_inputs.Rd ├── allowed_outputs.Rd ├── calculate_attraction.Rd ├── calculate_average.Rd ├── calculate_geodesic_distances.Rd ├── calculate_trajectory_dimred.Rd ├── classify_milestone_network.Rd ├── common_param.Rd ├── convert_definition.Rd ├── convert_milestone_percentages_to_progressions.Rd ├── convert_progressions_to_milestone_percentages.Rd ├── create_ti_method_container.Rd ├── create_ti_method_definition.Rd ├── create_ti_method_r.Rd ├── def_author.Rd ├── def_container.Rd ├── def_manuscript.Rd ├── def_method.Rd ├── def_package.Rd ├── def_parameters.Rd ├── def_wrapper.Rd ├── definition.Rd ├── dot-method_process_definition.Rd ├── dynwrap.Rd ├── example_dataset.Rd ├── example_trajectory.Rd ├── figures │ ├── dependencies.png │ ├── logo.png │ ├── logo.svg │ ├── overview_wrapping_v3.png │ └── trajectory_model.png ├── flip_edges.Rd ├── gather_cells_at_milestones.Rd ├── generate_parameter_documentation.Rd ├── get_default_parameters.Rd ├── get_ti_methods.Rd ├── group_from_trajectory.Rd ├── infer_trajectories.Rd ├── label_milestones.Rd ├── prior_usages.Rd ├── priors.Rd ├── project_trajectory.Rd ├── project_waypoints.Rd ├── random_seed.Rd ├── reexports.Rd ├── simplify_igraph_network.Rd ├── simplify_trajectory.Rd ├── trajectory_type_dag.Rd ├── trajectory_types.Rd ├── wrap_data.Rd ├── wrap_expression.Rd └── wrapper_types.Rd ├── revdep ├── .gitignore ├── README.md ├── cran.md ├── email.yml ├── failures.md └── problems.md ├── tests ├── testthat.R └── testthat │ ├── nothelper-methods.R │ ├── test-adapt_orient_topology.R │ ├── test-calculate_average.R │ ├── test-calculate_geodesic_distances.R │ ├── test-calculate_trajectory_dimred.R │ ├── test-classify_milestone_network.R │ ├── test-method_create_ti_method_container.R │ ├── test-method_create_ti_method_r.R │ ├── test-method_infer_trajectory.R │ ├── test-method_parse_parameter_definition.R │ ├── test-milestone_convertors.R │ ├── test-simplify_igraph_network.R │ ├── test-simplify_trajectory.R │ ├── test-wrap_add_branch_trajectory.R │ ├── test-wrap_add_cell_graph.R │ ├── test-wrap_add_cell_waypoints.R │ ├── test-wrap_add_cyclic_trajectory.R │ ├── test-wrap_add_dimred.R │ ├── test-wrap_add_dimred_projection.R │ ├── test-wrap_add_end_state_probabilities.R │ ├── test-wrap_add_expression.R │ ├── test-wrap_add_grouping.R │ ├── test-wrap_add_linear_trajectory.R │ ├── test-wrap_add_prior_information.R │ ├── test-wrap_add_pseudotime.R │ ├── test-wrap_add_root_and_add_pseudotime.R │ ├── test-wrap_add_timings.R │ ├── test-wrap_add_trajectory.R │ ├── test-wrap_add_waypoints.R │ ├── test-wrap_cell_group.R │ ├── test-wrap_cluster_graph.R │ ├── test-wrap_data.R │ └── test-wrap_label_milestones.R └── vignettes ├── create_ti_method_container.Rmd ├── create_ti_method_definition.Rmd ├── create_ti_method_r.Rmd ├── create_ti_method_wrappers.Rmd └── heatmap.png /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis 4 | ^\.git$ 5 | ^_pkgdown\.yml$ 6 | ^data-raw$ 7 | ^docs$ 8 | ^.travis_get_hdf5_if_needed.sh$ 9 | ^appveyor\.yml$ 10 | ^containers$ 11 | ^README\.Rmd$ 12 | functions.R 13 | scripts 14 | ^cran-comments\.md$ 15 | ^LICENSE\.md$ 16 | ^LICENSE\.md$ 17 | ^\.github$ 18 | ^revdep$ 19 | ^codecov\.yml$ 20 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | data/* binary 3 | src/* text=lf 4 | R/* text=lf 5 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: | 31 | covr::codecov( 32 | quiet = FALSE, 33 | clean = FALSE, 34 | install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") 35 | ) 36 | shell: Rscript {0} 37 | 38 | - name: Show testthat output 39 | if: always() 40 | run: | 41 | ## -------------------------------------------------------------------- 42 | find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true 43 | shell: bash 44 | 45 | - name: Upload test results 46 | if: failure() 47 | uses: actions/upload-artifact@v3 48 | with: 49 | name: coverage-test-failures 50 | path: ${{ runner.temp }}/package 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.so 6 | *.o 7 | inst/doc 8 | .DS_Store 9 | *.simg 10 | functions.R 11 | scripts 12 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: dynwrap 2 | Type: Package 3 | Title: Representing and Inferring Single-Cell Trajectories 4 | Description: Provides functionality to infer trajectories from single-cell data, 5 | represent them into a common format, and adapt them. Other biological information 6 | can also be added, such as cellular grouping, RNA velocity and annotation. 7 | Saelens et al. (2019) . 8 | Version: 1.2.4 9 | Authors@R: c( 10 | person( 11 | "Robrecht", 12 | "Cannoodt", 13 | email = "rcannood@gmail.com", 14 | role = c("aut", "cre"), 15 | comment = c(ORCID = "0000-0003-3641-729X", github = "rcannood") 16 | ), 17 | person( 18 | "Wouter", 19 | "Saelens", 20 | email = "wouter.saelens@gmail.com", 21 | role = c("aut"), 22 | comment = c(ORCID = "0000-0002-7114-6248", github = "zouter") 23 | ) 24 | ) 25 | URL: https://github.com/dynverse/dynwrap 26 | BugReports: https://github.com/dynverse/dynwrap/issues 27 | License: MIT + file LICENSE 28 | LazyData: TRUE 29 | RoxygenNote: 7.2.3 30 | Roxygen: list(markdown = TRUE) 31 | Encoding: UTF-8 32 | Depends: 33 | R (>= 3.0.0) 34 | Imports: 35 | assertthat, 36 | babelwhale, 37 | crayon, 38 | dplyr, 39 | dynutils (>= 1.0.3), 40 | dynparam, 41 | igraph, 42 | glue, 43 | magrittr, 44 | Matrix, 45 | methods, 46 | purrr, 47 | processx, 48 | readr, 49 | stringr, 50 | reshape2, 51 | tibble, 52 | tidyr, 53 | yaml 54 | Suggests: 55 | covr, 56 | dyndimred, 57 | hdf5r, 58 | knitr, 59 | pkgload, 60 | ranger, 61 | rmarkdown, 62 | testthat 63 | VignetteBuilder: knitr 64 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2014-2020 2 | COPYRIGHT HOLDER: Robrecht Cannoodt, Wouter Saelens 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2014-2020 Robrecht Cannoodt, Wouter Saelens 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/adapt_orient_topology.R: -------------------------------------------------------------------------------- 1 | #' Flip a set of edges of the milestone network 2 | #' 3 | #' @description 4 | #' Note that this will remove associated roots, reroot the trajectory using [add_root()] 5 | #' 6 | #' @inheritParams common_param 7 | #' @param milestone_network_toflip A dataframe with a from and to column, containing the subset of the milestone network #' 8 | #' @keywords adapt_trajectory 9 | #' 10 | #' @return A trajectory object 11 | #' 12 | #' @importFrom methods is 13 | #' 14 | #' @export 15 | flip_edges <- function( 16 | trajectory, 17 | milestone_network_toflip 18 | ) { 19 | assert_that( 20 | is(milestone_network_toflip, "data.frame"), 21 | c("from", "to") %all_in% colnames(milestone_network_toflip) 22 | ) 23 | assert_that(all( 24 | paste0(milestone_network_toflip$from, milestone_network_toflip$to) %in% 25 | paste0(trajectory$milestone_network$from, trajectory$milestone_network$to) 26 | ), msg = "All edges in the milestone_network_toflip should also be present in the trajectory milestone network") 27 | 28 | milestone_network_toflip <- milestone_network_toflip %>% 29 | select(from, to) 30 | 31 | # flip edge if from is later than to 32 | trajectory$milestone_network <- trajectory$milestone_network %>% 33 | left_join(milestone_network_toflip %>% mutate(flip = TRUE), c("from", "to")) %>% 34 | mutate(flip = ifelse(is.na(flip), FALSE, flip)) 35 | 36 | # flip milestone network & progressions 37 | trajectory$progressions <- trajectory$progressions %>% 38 | left_join(trajectory$milestone_network %>% select(from, to, flip), c("from", "to")) %>% 39 | mutate( 40 | from2 = from, 41 | from = ifelse(flip, to, from), 42 | to = ifelse(flip, from2, to), 43 | percentage = ifelse(flip, 1-percentage, percentage) 44 | ) %>% 45 | select(-flip, -from2) 46 | 47 | if (!is.null(trajectory$dimred_segment_progressions)) { 48 | trajectory$dimred_segment_progressions <- 49 | trajectory$dimred_segment_progressions %>% 50 | left_join(trajectory$milestone_network %>% select(from, to, flip), c("from", "to")) %>% 51 | mutate( 52 | from2 = from, 53 | from = ifelse(flip, to, from), 54 | to = ifelse(flip, from2, to), 55 | percentage = ifelse(flip, 1-percentage, percentage) 56 | ) %>% 57 | select(-flip, -from2) 58 | } 59 | 60 | trajectory$milestone_network <- trajectory$milestone_network %>% 61 | mutate( 62 | from2 = from, 63 | from = ifelse(flip, to, from), 64 | to = ifelse(flip, from2, to), 65 | directed = TRUE 66 | ) %>% 67 | select(-flip, -from2) 68 | 69 | trajectory 70 | } 71 | -------------------------------------------------------------------------------- /R/add_regulatory_network.R: -------------------------------------------------------------------------------- 1 | 2 | #' Add a GRN to a dynwrap object 3 | #' 4 | #' @inheritParams common_param 5 | #' @param regulatory_network A data frame consisting of three columns: `"regulator"`, `"target"`, `"strength"`. 6 | #' @param regulatory_network_sc A data frame consisting of four columns: `"cell_id"`, `"regulator"`, `"target"`, `"strength"`. 7 | #' @param regulators The feature ids of the regulators. 8 | #' @param targets The feature ids of the targets. 9 | #' @param ... Extra arguments to be saved in the model. 10 | #' 11 | #' @return A dynwrap object with the regulatory network added. 12 | #' 13 | #' @export 14 | add_regulatory_network <- function(dataset, regulatory_network, regulatory_network_sc = NULL, regulators = NULL, targets = NULL, ...) { 15 | # check regulatory network 16 | assert_that( 17 | is.data.frame(regulatory_network), 18 | regulatory_network %has_names% c("regulator", "target", "strength"), 19 | is.character(regulatory_network$regulator) || is.factor(regulatory_network$regulator), 20 | is.character(regulatory_network$target) || is.factor(regulatory_network$target), 21 | is.numeric(regulatory_network$strength), 22 | !is.null(regulators), 23 | !is.null(targets), 24 | all(regulatory_network$regulator %in% regulators), 25 | all(regulatory_network$target %in% targets) 26 | ) 27 | 28 | if (!is.factor(regulatory_network$regulator)) { 29 | regulatory_network$regulator <- factor(regulatory_network$regulator, regulators) 30 | } 31 | if (!is.factor(regulatory_network$target)) { 32 | regulatory_network$target <- factor(regulatory_network$target, targets) 33 | } 34 | 35 | # check sc regulatory network 36 | cell_ids <- dataset$cell_ids 37 | 38 | assert_that( 39 | is.data.frame(regulatory_network_sc), 40 | regulatory_network_sc %has_names% c("cell_id", "regulator", "target", "strength"), 41 | is.character(regulatory_network_sc$cell_id) || is.factor(regulatory_network_sc$cell_id), 42 | is.character(regulatory_network_sc$regulator) || is.factor(regulatory_network_sc$regulator), 43 | is.character(regulatory_network_sc$target) || is.factor(regulatory_network_sc$target), 44 | is.numeric(regulatory_network_sc$strength), 45 | !is.null(dataset$cell_ids), 46 | all(regulatory_network_sc$cell_id %in% dataset$cell_ids), 47 | all(regulatory_network_sc$regulator %in% regulators), 48 | all(regulatory_network_sc$target %in% targets) 49 | ) 50 | 51 | if (!is.factor(regulatory_network_sc$cell_id)) { 52 | regulatory_network_sc$cell_id <- factor(regulatory_network_sc$cell_id, cell_ids) 53 | } 54 | if (!is.factor(regulatory_network_sc$regulator)) { 55 | regulatory_network_sc$regulator <- factor(regulatory_network_sc$regulator, regulators) 56 | } 57 | if (!is.factor(regulatory_network_sc$target)) { 58 | regulatory_network_sc$target <- factor(regulatory_network_sc$target, targets) 59 | } 60 | 61 | dataset <- dataset %>% extend_with( 62 | "dynwrap::with_regulatory_network", 63 | regulatory_network = regulatory_network, 64 | regulatory_network_sc = regulatory_network_sc, 65 | regulators = regulators, 66 | targets = targets, 67 | ... 68 | ) 69 | 70 | } 71 | -------------------------------------------------------------------------------- /R/calculate_average.R: -------------------------------------------------------------------------------- 1 | #' Calculate average values of a matrix 2 | #' 3 | #' `calculate_average_by_group` will calculate an average value per group, given a matrix with cells in the rows and some features in the columns (e.g. expression matrix) 4 | #' 5 | #' @param x A matrix. One row for every cell; one column for every feature. The rows must be named. 6 | #' @param cell_grouping A data frame denoting the grouping of the cells. 7 | #' Format: `tibble(cell_id = character(), group_id = character())`. 8 | #' 9 | #' @return A matrix containing for each feature (column) the average 10 | #' 11 | #' @keywords derive_trajectory 12 | #' 13 | #' @export 14 | #' 15 | #' @examples 16 | #' calculate_average_by_group( 17 | #' x = example_trajectory$expression, 18 | #' cell_grouping = example_trajectory$prior_information$groups_id 19 | #' ) 20 | #' 21 | #' @rdname calculate_average 22 | calculate_average_by_group <- function(x, cell_grouping) { 23 | milestone_percentages <- 24 | cell_grouping %>% 25 | mutate(percentage = 1) %>% 26 | rename(milestone_id = group_id) 27 | 28 | calculate_average_by_milestone_percentages(x, milestone_percentages) 29 | } 30 | 31 | calculate_average_by_milestone_percentages <- function(x, milestone_percentages) { 32 | # cast milestone percentages to matrix 33 | milpct_m <- milestone_percentages %>% 34 | reshape2::acast(cell_id ~ milestone_id, value.var = "percentage", fill = 0, fun.aggregate = sum) 35 | 36 | stat <- colSums(milpct_m) 37 | stat[stat == 0] <- 1 38 | milpct_m <- sweep(milpct_m, 2, stat, "/") 39 | 40 | # check data objects 41 | assert_that(all.equal(sort(rownames(x)), sort(rownames(milpct_m)))) 42 | 43 | # get same order 44 | milpct_m <- milpct_m[rownames(x), , drop = F] 45 | 46 | t(milpct_m) %*% x 47 | } 48 | -------------------------------------------------------------------------------- /R/container_get.R: -------------------------------------------------------------------------------- 1 | .container_get_definition <- function(container_id) { 2 | requireNamespace("babelwhale") 3 | lines <- babelwhale::read_file(container_id, "/code/definition.yml") 4 | definition_raw <- yaml::read_yaml(text = lines) 5 | 6 | convert_definition(definition_raw) 7 | } 8 | 9 | .container_get_example <- function(container_id) { 10 | requireNamespace("babelwhale") 11 | example_code <- babelwhale::read_file(container_id, "/code/example.R") 12 | 13 | env <- new.env() 14 | 15 | eval(parse(text = example_code), envir = env) 16 | 17 | as.list(env) 18 | } 19 | -------------------------------------------------------------------------------- /R/convert_milestone_percentages_to_progressions.R: -------------------------------------------------------------------------------- 1 | #' Conversion between milestone percentages and progressions 2 | #' 3 | #' @inheritParams wrap_data 4 | #' @inheritParams add_trajectory 5 | #' 6 | #' @return A data frame with columns `cell_id`, `from`, `to`, `percentage`. 7 | #' 8 | #' @seealso [add_trajectory()], [convert_progressions_to_milestone_percentages] 9 | #' 10 | #' @examples 11 | #' progressions <- convert_milestone_percentages_to_progressions( 12 | #' cell_ids = example_trajectory$cell_ids, 13 | #' milestone_ids = example_trajectory$milestone_ids, 14 | #' milestone_network = example_trajectory$milestone_network, 15 | #' milestone_percentages = example_trajectory$milestone_percentages 16 | #' ) 17 | #' head(progressions) 18 | #' 19 | #' @export 20 | convert_milestone_percentages_to_progressions <- function( 21 | cell_ids, 22 | milestone_ids, 23 | milestone_network, 24 | milestone_percentages 25 | ) { 26 | # for cells that have 2 or more milestones 27 | progr_part1 <- 28 | milestone_network %>% 29 | inner_join(milestone_percentages, by = c("to" = "milestone_id")) %>% 30 | inner_join(milestone_percentages %>% select(cell_id, milestone_id), by = c("from" = "milestone_id", "cell_id")) %>% 31 | select(cell_id, from, to, percentage) 32 | 33 | # for cells that have just 1 milestone 34 | milnetdf <- bind_rows( 35 | milestone_network %>% transmute(milestone_id = to, from, to, percentage = 1), 36 | milestone_network %>% transmute(milestone_id = from, from, to, percentage = 0) 37 | ) 38 | milpct_just1 <- 39 | milestone_percentages %>% 40 | group_by(cell_id) %>% 41 | filter(n() == 1) 42 | 43 | progr_part2 <- 44 | if (nrow(milpct_just1) > 0) { 45 | milpct_just1 %>% 46 | select(-percentage) %>% 47 | left_join(milnetdf, by = "milestone_id") %>% 48 | filter(percentage == max(percentage)) %>% # prefer rows where percentage == 1 49 | sample_n(1) %>% 50 | ungroup() %>% 51 | select(cell_id, from, to, percentage) 52 | } else { 53 | NULL 54 | } 55 | 56 | progr <- 57 | bind_rows(progr_part1, progr_part2) %>% 58 | arrange(match(cell_id, cell_ids)) 59 | 60 | assert_that( 61 | unique(milestone_percentages$cell_id) %all_in% progr$cell_id, 62 | msg = "Some cells are on edges which are not contained in the milestone network" 63 | ) 64 | 65 | progr 66 | } 67 | -------------------------------------------------------------------------------- /R/convert_progressions_to_milestone_percentages.R: -------------------------------------------------------------------------------- 1 | #' Conversion between milestone percentages and progressions 2 | #' 3 | #' @inheritParams wrap_data 4 | #' @inheritParams add_trajectory 5 | #' 6 | #' @return A data frame with columns `cell_id`, `milestone_id`, and `percentage`. 7 | #' 8 | #' @seealso [add_trajectory()], [convert_milestone_percentages_to_progressions()] 9 | #' 10 | #' @examples 11 | #' milestone_percentages <- convert_progressions_to_milestone_percentages( 12 | #' cell_ids = example_trajectory$cell_ids, 13 | #' milestone_ids = example_trajectory$milestone_ids, 14 | #' milestone_network = example_trajectory$milestone_network, 15 | #' progressions = example_trajectory$progressions 16 | #' ) 17 | #' head(milestone_percentages) 18 | #' 19 | #' @export 20 | convert_progressions_to_milestone_percentages <- function( 21 | cell_ids, 22 | milestone_ids, 23 | milestone_network, 24 | progressions 25 | ) { 26 | 27 | check_froms <- tapply(progressions$from, progressions$cell_id, function(x) length(unique(x)) == 1) 28 | if (any(!check_froms)) { 29 | stop("In ", sQuote("progressions"), ", cells should only have 1 unique from milestone.") 30 | } 31 | 32 | check_edges <- progressions %>% 33 | left_join(milestone_network, by = c("from", "to")) %>% 34 | left_join(milestone_network %>% select(to = from, from = to, length2 = length), by = c("from", "to")) 35 | 36 | if (any(is.na(check_edges$length) & is.na(check_edges$length2))) { 37 | stop("All from-to combinations in ", sQuote("progressions"), " should be in ", sQuote("milestone_network"), " as well.") 38 | } 39 | 40 | # determine milestone percentages for self edges 41 | selfs <- progressions %>% 42 | filter(from == to) %>% 43 | select(cell_id, milestone_id = from) %>% 44 | mutate(percentage = 1) 45 | 46 | progressions <- progressions %>% 47 | filter(from != to) 48 | 49 | # determine milestone percentages for 'from' milestones 50 | from_mls <- tapply(progressions$from, progressions$cell_id, first, default = NA_character_) 51 | from_pct <- 1 - tapply(progressions$percentage, progressions$cell_id, sum, default = NA_real_) 52 | froms <- tibble( 53 | cell_id = names(from_mls) %||% character(), 54 | milestone_id = from_mls[cell_id] %>% unname() %>% as.character(), 55 | percentage = from_pct[cell_id] %>% unname() %>% as.numeric() 56 | ) 57 | 58 | # determine milestone percentages for 'to' milestones 59 | tos <- progressions %>% 60 | select(cell_id, milestone_id = to, percentage) 61 | 62 | # return all percentages 63 | bind_rows(selfs, froms, tos) 64 | } 65 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' Metadata on the trajectory types 2 | #' 3 | #' @keywords create_ti_method 4 | #' 5 | #' @examples trajectory_types 6 | #' 7 | #' @docType data 8 | "trajectory_types" 9 | 10 | 11 | #' A DAG connecting different trajectory types 12 | #' 13 | #' @keywords create_ti_method 14 | #' 15 | #' @examples trajectory_type_dag 16 | #' 17 | #' @docType data 18 | "trajectory_type_dag" 19 | 20 | 21 | #' Metadata on priors 22 | #' 23 | #' @keywords create_ti_method 24 | #' 25 | #' @examples priors 26 | #' 27 | #' @docType data 28 | "priors" 29 | 30 | 31 | #' Metadata on prior usages 32 | #' 33 | #' @keywords create_ti_method 34 | #' 35 | #' @examples prior_usages 36 | #' 37 | #' @docType data 38 | "prior_usages" 39 | 40 | 41 | 42 | #' All allowed inputs for a TI method 43 | #' 44 | #' @keywords create_ti_method 45 | #' 46 | #' @examples allowed_inputs 47 | #' 48 | #' @docType data 49 | "allowed_inputs" 50 | 51 | 52 | #' All allowed outputs for a TI method 53 | #' 54 | #' @examples allowed_outputs 55 | #' 56 | #' @docType data 57 | "allowed_outputs" 58 | 59 | #' Example dataset 60 | #' 61 | #' @docType data 62 | "example_dataset" 63 | 64 | #' Example trajectory 65 | #' 66 | #' @docType data 67 | "example_trajectory" 68 | 69 | #' Metadata on wrapper types 70 | #' 71 | #' @examples wrapper_types 72 | #' 73 | #' @keywords create_ti_method 74 | #' 75 | #' @docType data 76 | "wrapper_types" 77 | -------------------------------------------------------------------------------- /R/method_create_ti_method_definition.R: -------------------------------------------------------------------------------- 1 | #' Create a TI method from a local method definition file 2 | #' 3 | #' The local method definition file describes a method that is runnable on the local system. 4 | #' See [`vignette("create_ti_method_definition", "dynwrap")`](../doc/create_ti_method_definition.html) for a tutorial on how to create a containerized TI method. 5 | #' 6 | #' @param script Location of the script that will be executed. Has to contain a #! 7 | #' @inheritParams .method_process_definition 8 | #' 9 | #' @inherit create_ti_method_container return 10 | #' 11 | #' @keywords create_ti_method 12 | #' 13 | #' @return A method definition 14 | #' 15 | #' @examples 16 | #' 17 | #' # See the vignette "create_ti_method_definition" to get a good idea on how 18 | #' # to use this function. 19 | #' 20 | #' # create a definition.yaml file and a run.R/py script. 21 | #' # method <- create_ti_method_definition("definition.yml", "run.R") 22 | #' # trajectory <- infer_trajectory(example_dataset, method(), verbose = TRUE) 23 | #' 24 | #' @importFrom yaml read_yaml 25 | #' 26 | #' @export 27 | create_ti_method_definition <- function( 28 | definition, 29 | script, 30 | return_function = TRUE 31 | ) { 32 | definition_path <- normalizePath(definition) 33 | definition <- .method_load_definition(definition) 34 | 35 | if (!is.null(script)) script <- normalizePath(script) 36 | 37 | definition$run <- list( 38 | backend = "script", 39 | script = script, 40 | definition = definition_path 41 | ) 42 | 43 | .method_process_definition(definition = definition, return_function = return_function) 44 | } 45 | 46 | 47 | .method_execution_execute_script <- function(method, preproc_meta) { 48 | # copy over script and rds 49 | file.copy(normalizePath(method$run$script), preproc_meta$dir_dynwrap) 50 | script_location <- basename(method$run$script) 51 | file.copy(normalizePath(method$run$definition), paste0(preproc_meta$dir_dynwrap, "/definition.yml")) 52 | 53 | # print information if desired 54 | if (preproc_meta$verbose) { 55 | cat("Input saved to ", preproc_meta$dir_dynwrap, "\n", sep = "") 56 | } 57 | 58 | # determine command 59 | if (grepl("*.r$", tolower(script_location))) { 60 | command <- "Rscript" 61 | args <- script_location 62 | } else if (grepl("*.py$", tolower(script_location))) { 63 | command <- "python" 64 | args <- script_location 65 | } else { # don't recognise extension 66 | command <- paste0("./", script_location) 67 | args <- c() 68 | } 69 | 70 | # append extra args 71 | args <- c(args, "--dataset", "input.h5", "--output", "output.h5") 72 | if (preproc_meta$debug) args <- c(args, "--debug") 73 | 74 | # run script 75 | process <- processx::run( 76 | command = command, 77 | args = args, 78 | wd = preproc_meta$dir_dynwrap, 79 | echo = as.logical(preproc_meta$verbose) || preproc_meta$debug, 80 | echo_cmd = as.logical(preproc_meta$verbose) || preproc_meta$debug, 81 | spinner = TRUE 82 | ) 83 | 84 | # return output 85 | dynutils::read_h5(file.path(preproc_meta$dir_dynwrap, "output.h5")) 86 | } 87 | -------------------------------------------------------------------------------- /R/method_extract_args.R: -------------------------------------------------------------------------------- 1 | .method_extract_inputs <- function( 2 | dataset, 3 | inputs 4 | ) { 5 | input_ids_dataset <- 6 | inputs %>% 7 | filter(required, type == "expression") %>% 8 | pull(input_id) 9 | 10 | map(input_ids_dataset, get_expression, dataset = dataset) %>% 11 | set_names(input_ids_dataset) 12 | } 13 | 14 | #' @importFrom utils data 15 | .method_extract_priors <- function( 16 | dataset, 17 | inputs, 18 | give_priors = NULL 19 | ) { 20 | # extract prior information 21 | priors <- dataset$prior_information 22 | priors$dataset <- dataset 23 | 24 | if (!priors %has_names% give_priors) { 25 | warning("Unknown priors requested: ", paste(setdiff(give_priors, names(priors)), collapse = ", ")) 26 | } 27 | 28 | # required, check if the prior infirm 29 | required_prior_ids <- 30 | inputs %>% 31 | filter(required, type == "prior_information") %>% 32 | pull(input_id) 33 | 34 | if (!all(required_prior_ids %in% names(priors))) { 35 | # construct informative error message for missing priors 36 | missing_priors <- setdiff(required_prior_ids, names(priors)) 37 | missing_priors_text <- glue::glue_collapse(crayon::bold(missing_priors), sep = ", ", last = " and ") 38 | 39 | add_prior_information_params_text <- glue::glue("{missing_priors} = ") %>% glue::glue_collapse(", ") 40 | add_prior_information_text <- crayon::italic(glue::glue("add_prior_information(dataset, {add_prior_information_params_text})")) 41 | 42 | stop( 43 | glue::glue( 44 | "Prior information {missing_priors_text} is missing from dataset {dataset$id} but is required by the method. \n", 45 | " -> If known, you can add this prior information using {add_prior_information_text}. \n", 46 | " -> Otherwise, this method cannot be used.", 47 | .trim = FALSE 48 | ) 49 | ) 50 | } 51 | 52 | args_required_priors <- priors[required_prior_ids] 53 | 54 | # optional 55 | optional_prior_ids <- 56 | inputs %>% 57 | filter(!required, type == "prior_information", input_id %in% give_priors) %>% 58 | pull(input_id) 59 | 60 | if (!all(optional_prior_ids %in% names(priors))) { 61 | warning( 62 | "Prior information ", 63 | paste(setdiff(optional_prior_ids, names(priors)), collapse = ";"), 64 | " is optional, but missing from dataset ", 65 | dataset$id, 66 | ". Will not give this prior to method.", 67 | "\n" 68 | ) 69 | } 70 | 71 | args_optional_priors <- priors[intersect(optional_prior_ids, names(priors))] 72 | 73 | # output 74 | c( 75 | args_required_priors, 76 | args_optional_priors 77 | ) 78 | } 79 | -------------------------------------------------------------------------------- /R/method_get_ti_methods.R: -------------------------------------------------------------------------------- 1 | is_dynmethods_installed <- function() { 2 | tryCatch( 3 | { 4 | find.package("dynmethods") 5 | TRUE 6 | }, 7 | error = function(e) { 8 | FALSE 9 | } 10 | ) 11 | } 12 | 13 | #' Return all TI that are installed in one or more packages 14 | #' 15 | #' @param method_ids The method identifiers. NULL if listing all methods 16 | #' @param as_tibble Whether or not to return the ti_methods as a tibble 17 | #' @param ti_packages In which packages to look for TI methods. This will by default look into dynmethods if it is installed, otherwise in dynwrap. 18 | #' @param evaluate Whether to evaluate the functions 19 | #' 20 | #' @return A dataframe (or list if `as_tibble = FALSE`) containing the name (_id_) of the TI method and the function (_fun_) to load in the method. 21 | #' 22 | #' @keywords infer_trajectory 23 | #' 24 | #' @examples 25 | #' head(get_ti_methods()) 26 | #' 27 | #' @importFrom utils lsf.str 28 | #' @importFrom stringr str_replace 29 | #' @export 30 | get_ti_methods <- function( 31 | method_ids = NULL, 32 | as_tibble = TRUE, 33 | ti_packages = ifelse(is_dynmethods_installed(), "dynmethods", "dynwrap"), 34 | evaluate = FALSE 35 | ) { 36 | ti_methods <- map(ti_packages, function(package) { 37 | 38 | if (package == "dynwrap") { 39 | requireNamespace("pkgload") 40 | root <- system.file("tests/testthat/", package = "dynwrap") 41 | env <- new.env() 42 | for (file in list.files(root, full.names = TRUE)) { 43 | source(file, local = env) 44 | } 45 | } else { 46 | requireNamespace(package) 47 | env <- asNamespace(package) 48 | } 49 | 50 | function_names <- lsf.str(env, pattern = "^ti_") 51 | 52 | map(function_names, function(function_name) { 53 | fun <- get(function_name, env) 54 | 55 | if (evaluate) { 56 | meth_metadata <- fun() %>% discard(is.function) 57 | } else { 58 | meth_metadata <- list(id = function_name %>% stringr::str_replace("^ti_", "")) 59 | } 60 | meth_metadata$fun <- fun 61 | meth_metadata 62 | }) 63 | }) %>% 64 | unlist(recursive = FALSE) %>% 65 | list_as_tibble() 66 | 67 | if (!is.null(method_ids)) { 68 | assert_that(all(method_ids %in% ti_methods$id | grepl("/", method_ids))) 69 | ti_methods <- ti_methods %>% slice(match(method_ids, id)) 70 | 71 | docker_repos <- 72 | method_ids %>% 73 | keep(~ grepl("/", .)) 74 | 75 | ti_methods2 <- list_as_tibble(map(docker_repos, function(repo) { 76 | funner <- create_ti_method_container(repo) 77 | out <- funner() 78 | out$fun <- funner 79 | 80 | if (evaluate) { 81 | out <- out[c("id", "fun")] 82 | } 83 | 84 | out 85 | })) 86 | 87 | ti_methods <- bind_rows(ti_methods, ti_methods2) 88 | } 89 | 90 | if (as_tibble) { 91 | ti_methods 92 | } else { 93 | mapdf(ti_methods, identity) 94 | } 95 | } 96 | 97 | -------------------------------------------------------------------------------- /R/package.R: -------------------------------------------------------------------------------- 1 | #' Inferring and adapting single-cell trajectories 2 | #' 3 | #' ![](logo.png) 4 | #' 5 | #' @import dplyr 6 | #' @import tidyr 7 | #' @import dynutils 8 | #' @import readr 9 | #' @import purrr 10 | #' @import assertthat 11 | #' @import dynparam 12 | #' @importFrom tibble is_tibble as_tibble tibble enframe deframe lst tribble rownames_to_column column_to_rownames 13 | #' @importFrom magrittr %<>% %$% set_rownames set_colnames 14 | #' @importFrom glue glue 15 | #' 16 | #' @docType package 17 | #' @name dynwrap 18 | NULL 19 | 20 | 21 | 22 | #' Common param 23 | #' 24 | #' These parameters are commonly used in dynwrap. 25 | #' 26 | #' @param trajectory The trajectory as created by [infer_trajectory()] or [add_trajectory()] 27 | #' @param dataset A dataset created by [wrap_data()] or [wrap_expression()] 28 | #' 29 | #' @keywords internal 30 | #' @name common_param 31 | #' 32 | #' @return Internal documentation 33 | NULL 34 | 35 | 36 | # Define valid global variables 37 | if(getRversion() >= "2.15.1") { 38 | utils::globalVariables(c( 39 | ".", "branch_id", "cell_id", "comp_1", "comp_2", 40 | "correlation", "correlation_mean", "directed", "dist", 41 | "divergence_id", "edge_id", "feature_id", "flip", "from", 42 | "from_milestone_id", "from_waypoint", "from2", "group_id", 43 | "housekeeping", "in_divergence", "index", "input_id", "is_start", 44 | "ix", "label", "length1", "length2", "milestone_id", "new_milestone_id", 45 | "new_new_milestone_id", "node", "node1", "node2", "num_cells", 46 | "one", "percentage", "PREDICT", "prior_id", "required", "rowname", 47 | "sd", "start", "waypoint_id", "weight", "zero", "time", "to", "to_waypoint", 48 | "triangle_id", "triangle_part", "type", "comp_1_from", "comp_2_from", 49 | "comp_1_to", "comp_2_to", "str_subset")) 50 | } 51 | -------------------------------------------------------------------------------- /R/reexport.R: -------------------------------------------------------------------------------- 1 | #' @importFrom babelwhale test_docker_installation 2 | #' @export 3 | babelwhale::test_docker_installation 4 | 5 | #' @importFrom babelwhale test_singularity_installation 6 | #' @export 7 | babelwhale::test_singularity_installation 8 | 9 | #' @importFrom babelwhale create_config 10 | #' @export 11 | babelwhale::create_config 12 | 13 | #' @importFrom babelwhale create_docker_config 14 | #' @export 15 | babelwhale::create_docker_config 16 | 17 | #' @importFrom babelwhale create_singularity_config 18 | #' @export 19 | babelwhale::create_singularity_config 20 | 21 | #' @importFrom babelwhale get_default_config 22 | #' @export 23 | babelwhale::get_default_config 24 | 25 | #' @importFrom babelwhale set_default_config 26 | #' @export 27 | babelwhale::set_default_config 28 | 29 | #' @importFrom dynutils test_h5_installation 30 | #' @export 31 | dynutils::test_h5_installation 32 | -------------------------------------------------------------------------------- /R/wrap_add_attraction.R: -------------------------------------------------------------------------------- 1 | #' Add attraction of cells using RNA velocity 2 | #' 3 | #' @inheritParams common_param 4 | #' 5 | #' @return A dynwrap object with the attraction added. 6 | add_attraction <- function( 7 | dataset 8 | ) { 9 | current <- get_expression(dataset, "expression") 10 | projected <- get_expression(dataset, "expression_future") 11 | 12 | calculate_attraction(current, projected) 13 | } 14 | 15 | 16 | 17 | 18 | #' Calculate the attraction of cells to other cells using velocity 19 | #' 20 | #' @param current Current expression 21 | #' @param projected Projected expression based on RNA velocity 22 | #' @param cells Which cells to use 23 | #' @param n_waypoints Number of waypoints to use 24 | #' @param k K knns 25 | #' 26 | #' @return Matrix containing the attraction (\[-1, 1\]) of each cell to the waypoint cells 27 | calculate_attraction <- function( 28 | current, 29 | projected, 30 | cells = colnames(projected), 31 | n_waypoints = 50, 32 | k = 50 33 | ) { 34 | assertthat::assert_that(nrow(current) == nrow(projected)) 35 | assertthat::assert_that(ncol(current) == ncol(projected)) 36 | 37 | # select waypoint cells 38 | n_waypoints <- min(n_waypoints, length(cells)) 39 | k <- min(n_waypoints, k) 40 | waypoint_cells <- sample(cells, n_waypoints) 41 | 42 | em <- as.matrix(current) 43 | ccells <- cells 44 | em <- em[, ccells] 45 | nd <- as.matrix(projected[, ccells] - current[, ccells]) 46 | cgenes <- intersect(rownames(em), rownames(nd)) 47 | nd <- nd[cgenes, ] 48 | em <- em[cgenes, ] 49 | 50 | # calculate correlation 51 | # this is an adapted version of colDeltaCorLog10 with waypoints 52 | transfo <- function(x) (log10(abs(x) + 1) * sign(x)) 53 | 54 | nd2 <- transfo(nd) 55 | 56 | waypoint <- waypoint_cells[[1]] 57 | cell <- cells[[1]] 58 | 59 | emw <- em[, waypoint_cells] 60 | 61 | cors <- map(waypoint_cells, function(waypoint) { 62 | print(waypoint) 63 | diff <- transfo(emw[, waypoint] - em) 64 | cors <- pcor(diff, nd2) 65 | rownames(cors) <- waypoint 66 | cors[is.na(cors)] <- 0 67 | cors 68 | }) 69 | attraction <- do.call(rbind, cors) 70 | colnames(attraction) <- colnames(em) 71 | attraction 72 | } 73 | 74 | 75 | 76 | pcor <- function(x, y = x, method = "pearson", use = "everything") { 77 | assertthat::assert_that(ncol(x) == ncol(y)); 78 | matrix(purrr::map_dbl(seq_len(ncol(x)), ~ cor(x[,.], y[,.], method = method, use = use)), nrow = 1) 79 | } 80 | -------------------------------------------------------------------------------- /R/wrap_add_cyclic_trajectory.R: -------------------------------------------------------------------------------- 1 | #' Constructs a circular trajectory using the pseudotime values of each cell. 2 | #' 3 | #' The pseudotime is divided into three equally sized segments, and are placed within a trajectory in the form A -> B -> C -> A 4 | #' 5 | #' @inheritParams common_param 6 | #' @param pseudotime A named vector of pseudo times. 7 | #' @param directed Whether or not the directionality of the pseudotime is predicted. 8 | #' @param do_scale_minmax Whether or not to scale the pseudotime between 0 and 1. 9 | #' Otherwise, will assume the values are already within that range. 10 | #' @param ... extra information to be stored in the wrapper. 11 | #' 12 | #' @inherit add_trajectory return 13 | #' 14 | #' @keywords create_trajectory 15 | #' 16 | #' @return A trajectory object 17 | #' 18 | #' @export 19 | #' 20 | #' @examples 21 | #' library(tibble) 22 | #' dataset <- wrap_data(cell_ids = letters) 23 | #' 24 | #' pseudotime <- tibble(cell_id = dataset$cell_ids, pseudotime = runif(length(dataset$cell_ids))) 25 | #' pseudotime 26 | #' trajectory <- add_cyclic_trajectory(dataset, pseudotime) 27 | #' 28 | #' # for plotting the result, install dynplot 29 | #' #- dynplot::plot_graph(trajectory) 30 | add_cyclic_trajectory <- function( 31 | dataset, 32 | pseudotime, 33 | directed = FALSE, 34 | do_scale_minmax = TRUE, 35 | ... 36 | ) { 37 | # check data wrapper 38 | assert_that(is_data_wrapper(dataset)) 39 | 40 | pseudotime <- process_pseudotime(dataset, pseudotime) 41 | 42 | # scale pseudotime 43 | if (do_scale_minmax) { 44 | pseudotime <- scale_minmax(pseudotime) 45 | } else { 46 | assert_that(all(0 <= pseudotime & pseudotime <= 1)) 47 | } 48 | 49 | # construct milestones 50 | milestone_ids <- c("A", "B", "C") 51 | 52 | # construct milestone_network 53 | milestone_network <- tibble( 54 | from = milestone_ids, 55 | to = milestone_ids[c(2,3,1)], 56 | directed = directed, 57 | length = 1, 58 | edge_id = seq_along(milestone_ids) 59 | ) 60 | 61 | # construct progressions 62 | progressions <- tibble( 63 | time = 3 * pseudotime, 64 | cell_id = names(pseudotime) 65 | ) %>% 66 | mutate(edge_id = ifelse(time <= 1, 1L, ifelse(time <= 2, 2L, 3L))) %>% 67 | left_join(milestone_network, by = "edge_id") %>% 68 | mutate(percentage = time - (edge_id - 1)) %>% 69 | select(cell_id, from, to, percentage) 70 | 71 | milestone_network <- milestone_network %>% 72 | select(from, to, length, directed) 73 | 74 | # return output 75 | add_trajectory( 76 | dataset = dataset, 77 | milestone_ids = milestone_ids, 78 | milestone_network = milestone_network, 79 | divergence_regions = NULL, 80 | progressions = progressions, 81 | pseudotime = pseudotime, 82 | ... 83 | ) 84 | } 85 | -------------------------------------------------------------------------------- /R/wrap_add_feature_importance.R: -------------------------------------------------------------------------------- 1 | #' Add a feature importance to a dataset 2 | #' 3 | #' @inheritParams common_param 4 | #' @param feature_importance The impotances of the features, can be a named vector or a dataframe with columns *feature_id* and *importance* 5 | #' @param ... Extra information to be stored in the dataset 6 | #' 7 | #' @keywords adapt_trajectory 8 | #' 9 | #' @return A dynwrap object with the feature importance added. 10 | #' 11 | #' @examples 12 | #' dataset <- example_dataset 13 | #' 14 | #' feature_importance <- runif(nrow(dataset$feature_info)) 15 | #' names(feature_importance) <- dataset$feature_info$feature_id 16 | #' 17 | #' dataset <- add_feature_importance(dataset, feature_importance) 18 | #' head(dataset$feature_importance) 19 | #' 20 | #' @export 21 | add_feature_importance <- function( 22 | dataset, 23 | feature_importance, 24 | ... 25 | ) { 26 | if (is.vector(feature_importance)) { 27 | assert_that(!is.null(names(feature_importance))) 28 | 29 | feature_importance <- enframe(feature_importance, "feature_id", "importance") 30 | } 31 | 32 | assert_that( 33 | # check whether dataset is a data wrapper 34 | is_data_wrapper(dataset), 35 | 36 | is.data.frame(feature_importance), 37 | "feature_id" %in% colnames(feature_importance), 38 | "importance" %in% colnames(feature_importance) 39 | ) 40 | 41 | # create output structure 42 | dataset %>% extend_with( 43 | "dynwrap::with_feature_importance", 44 | feature_importance = feature_importance, 45 | ... 46 | ) 47 | } 48 | 49 | #' @rdname add_feature_importance 50 | #' @export 51 | is_wrapper_with_feature_importance <- function(dataset) { 52 | is_data_wrapper(dataset) && "dynwrap::with_feature_importance" %in% class(dataset) 53 | } 54 | 55 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /R/wrap_add_linear_trajectory.R: -------------------------------------------------------------------------------- 1 | #' Constructs a linear trajectory using pseudotime values 2 | #' 3 | #' @inheritParams common_param 4 | #' @param pseudotime A named vector of pseudo times. 5 | #' @param directed Whether the trajectory will be directed. 6 | #' @param do_scale_minmax Whether or not to scale the pseudotime between 0 and 1. 7 | #' Otherwise, will assume the values are already within that range. 8 | #' @param ... extra information to be stored in the trajectory 9 | #' 10 | #' @keywords create_trajectory 11 | #' 12 | #' @inherit add_trajectory return 13 | #' 14 | #' @return A trajectory object 15 | #' 16 | #' @export 17 | #' 18 | #' @examples 19 | #' library(tibble) 20 | #' dataset <- wrap_data(cell_ids = letters) 21 | #' 22 | #' pseudotime <- tibble( 23 | #' cell_id = dataset$cell_ids, 24 | #' pseudotime = runif(length(dataset$cell_ids)) 25 | #' ) 26 | #' 27 | #' trajectory <- add_linear_trajectory(dataset, pseudotime) 28 | add_linear_trajectory <- function( 29 | dataset, 30 | pseudotime, 31 | directed = FALSE, 32 | do_scale_minmax = TRUE, 33 | ... 34 | ) { 35 | # check data wrapper 36 | assert_that(is_data_wrapper(dataset)) 37 | 38 | pseudotime <- process_pseudotime(dataset, pseudotime) 39 | 40 | # scale pseudotime 41 | if (do_scale_minmax) { 42 | pseudotime <- scale_minmax(pseudotime) 43 | } else { 44 | assert_that(all(0 <= pseudotime & pseudotime <= 1)) 45 | } 46 | 47 | # construct milestones 48 | milestone_ids <- c("milestone_begin", "milestone_end") 49 | 50 | # construct milestone_network 51 | milestone_network <- tibble( 52 | from = milestone_ids[[1]], 53 | to = milestone_ids[[2]], 54 | length = 1, 55 | directed = directed 56 | ) 57 | 58 | # construct progressions 59 | progressions <- tibble( 60 | cell_id = names(pseudotime), 61 | from = milestone_ids[[1]], 62 | to = milestone_ids[[2]], 63 | percentage = pseudotime 64 | ) 65 | 66 | # return output 67 | add_trajectory( 68 | dataset = dataset, 69 | milestone_ids = milestone_ids, 70 | milestone_network = milestone_network, 71 | divergence_regions = NULL, 72 | progressions = progressions, 73 | pseudotime = pseudotime, 74 | ... 75 | ) 76 | } 77 | -------------------------------------------------------------------------------- /R/wrap_add_pseudotime.R: -------------------------------------------------------------------------------- 1 | #' @rdname add_pseudotime 2 | #' @export 3 | calculate_pseudotime <- function(trajectory) { 4 | if(!"root_milestone_id" %in% names(trajectory)) { 5 | warning("Trajectory is not rooted. Add a root to the trajectory using dynwrap::add_root(). This will result in an error in future releases.") 6 | trajectory <- add_root(trajectory) 7 | } 8 | 9 | mid <- trajectory$root_milestone_id 10 | mid_tempname <- paste0("MyRootMilestone", mid) 11 | 12 | geod <- calculate_geodesic_distances( 13 | trajectory, 14 | waypoint_cells = mid_tempname, 15 | waypoint_milestone_percentages = tibble(waypoint_id = mid_tempname, milestone_id = mid, percentage = 1), 16 | directed = TRUE 17 | ) 18 | rownames(geod) <- mid 19 | 20 | if (nrow(geod) == 1) { 21 | geod[1,] 22 | } else { 23 | t(geod) 24 | } 25 | } 26 | 27 | 28 | #' Add or calculate pseudotime as distance from the root 29 | #' 30 | #' When calculating the pseudotime, the trajectory is expected to be rooted (see [add_root()]) 31 | #' 32 | #' @inheritParams common_param 33 | #' @param pseudotime Named vector containing the pseudotime for every cell. If not given, the pseudotime will be calculated. 34 | #' 35 | #' @return The trajectory with *pseudotime* added, which is a named vector containing the pseudotime values for every cell. 36 | #' 37 | #' @keywords derive_trajectory 38 | #' 39 | #' @seealso [add_root()], [add_linear_trajectory()] 40 | #' 41 | #' @export 42 | add_pseudotime <- function(trajectory, pseudotime = NULL) { 43 | if (is.null(pseudotime)) { 44 | pseudotime <- calculate_pseudotime(trajectory) 45 | } else { 46 | pseudotime <- process_pseudotime(trajectory, pseudotime) 47 | } 48 | 49 | # check names of pseudotime 50 | cell_ids <- trajectory$cell_ids 51 | assert_that( 52 | is.numeric(pseudotime), 53 | !is.null(names(pseudotime)), 54 | setequal(names(pseudotime), cell_ids), 55 | length(names(pseudotime) )== length(cell_ids) 56 | ) 57 | 58 | trajectory$pseudotime <- pseudotime[trajectory$cell_ids] 59 | trajectory 60 | } 61 | 62 | process_pseudotime <- function(data_wrapper, pseudotime) { 63 | # convert to named vector if necessary 64 | if(is.data.frame(pseudotime) && all(c("cell_id", "pseudotime") %in% colnames(pseudotime))) { 65 | pseudotime <- pseudotime %>% select(cell_id, pseudotime) %>% deframe() 66 | } 67 | pseudotime 68 | } 69 | -------------------------------------------------------------------------------- /R/wrap_add_tde_overall.R: -------------------------------------------------------------------------------- 1 | #' Add information on overall differentially expressed features 2 | #' 3 | #' To calculate differential expression within trajectories, check out the [dynfeature](https://github.com/dynverse/dynfeature) package. 4 | #' 5 | #' @inheritParams common_param 6 | #' @param tde_overall A dataframe containing the *feature_id*, and some other columns including whether it is differentially expressed (*differentially_expressed*), the rank of differential expression among all other features (*rank*), the p-value (*pval*) or corrected value (*qval*), and the log-fold change (*lfc*). 7 | #' 8 | #' @return A trajectory containing *tde_overall*, a dataframe containing the *feature_id*, and some other columns including whether it is differentially expressed (*differentially_expressed*), the rank of differential expression among all other features (*rank*), the p-value (*pval*) or corrected value (*qval*), and the log-fold change (*lfc*). 9 | #' 10 | #' @examples 11 | #' trajectory <- example_trajectory 12 | #' tde_overall <- tibble::tibble( 13 | #' feature_id = trajectory$feature_info$feature_id, 14 | #' differentially_expressed = sample(c(TRUE, FALSE), length(feature_id), replace = TRUE) 15 | #' ) 16 | #' trajectory <- add_tde_overall(trajectory, tde_overall) 17 | #' trajectory$tde_overall 18 | #' 19 | #' @keywords adapt_trajectory 20 | #' 21 | #' @export 22 | add_tde_overall <- function(trajectory, tde_overall) { 23 | feature_ids <- colnames(get_expression(trajectory)) 24 | 25 | # check format of diffexp_overall 26 | assert_that(!is.null(names(tde_overall))) 27 | assert_that(is_tibble(tde_overall)) 28 | assert_that(is.logical(tde_overall$differentially_expressed)) 29 | assert_that(is.character(tde_overall$feature_id)) 30 | assert_that(setequal(tde_overall$feature_id, feature_ids)) 31 | 32 | trajectory$tde_overall <- tde_overall 33 | trajectory 34 | } 35 | -------------------------------------------------------------------------------- /R/wrap_add_timings.R: -------------------------------------------------------------------------------- 1 | #' Add timings to a trajectory 2 | #' 3 | #' @inheritParams common_param 4 | #' @param timings A list of timings. 5 | #' 6 | #' @keywords adapt_trajectory 7 | #' 8 | #' @return A dynwrap object with the timings added. 9 | #' 10 | #' @examples 11 | #' trajectory <- example_trajectory 12 | #' trajectory <- add_timings( 13 | #' trajectory, 14 | #' list(start = 0, end = 1) 15 | #' ) 16 | #' 17 | #' @export 18 | add_timings <- function( 19 | trajectory, 20 | timings 21 | ) { 22 | assert_that(is_data_wrapper(trajectory)) 23 | 24 | if (is.data.frame(timings)) { 25 | timings <- tibble::deframe(timings) 26 | } 27 | 28 | if (is.numeric(timings) && !is.null(timings)) { 29 | timings <- as.list(timings) 30 | } 31 | 32 | assert_that(is.list(timings)) 33 | 34 | # create output structure 35 | trajectory %>% extend_with( 36 | "dynwrap::with_timings", 37 | timings = timings 38 | ) 39 | } 40 | 41 | #' @inheritParams add_timings 42 | #' @rdname add_timings 43 | #' 44 | #' @export 45 | is_wrapper_with_timings <- function(trajectory) { 46 | is_data_wrapper(trajectory) && "dynwrap::with_timings" %in% class(trajectory) 47 | } 48 | 49 | #' Helper function for storing timings information. 50 | #' 51 | #' @param name The name of the timings checkpoint. 52 | #' 53 | #' @rdname add_timings 54 | #' 55 | #' @export 56 | add_timing_checkpoint <- function(timings, name) { 57 | if (is.null(timings)) { 58 | timings <- list() 59 | } 60 | timings[[name]] <- as.numeric(Sys.time()) 61 | timings 62 | } 63 | -------------------------------------------------------------------------------- /R/wrap_data.R: -------------------------------------------------------------------------------- 1 | #' A data wrapper for datasets and trajectories 2 | #' 3 | #' @param id A unique identifier for the data. If `NULL`, a random string will be generated. 4 | #' @param cell_ids The identifiers of the cells. 5 | #' @param cell_info Optional meta-information pertaining the cells. 6 | #' @param feature_ids The identifiers of the features. 7 | #' @param feature_info Optional meta-information pertaining the features. 8 | #' @param ... Extra information to be stored in the wrapper. 9 | #' 10 | #' @return A list containing *id*, *cell_ids* and *cell_info* (if specified) 11 | #' 12 | #' @keywords create_trajectory 13 | #' 14 | #' @export 15 | #' 16 | #' @examples 17 | #' dataset <- wrap_data( 18 | #' cell_ids = c("A", "B", "C") 19 | #' ) 20 | #' dataset$cell_ids 21 | wrap_data <- function( 22 | id = NULL, 23 | cell_ids, 24 | cell_info = NULL, 25 | feature_ids = NULL, 26 | feature_info = NULL, 27 | ... 28 | ) { 29 | 30 | # process id 31 | if (is.null(id)) { 32 | id <- dynutils::random_time_string("data_wrapper") 33 | } 34 | assert_that( 35 | is.character(id), 36 | length(id) == 1 37 | ) 38 | 39 | # process cell ids 40 | if (is_tibble(cell_ids) && ncol(cell_ids) == 1 && "cell_ids" %in% names(cell_ids)) { 41 | cell_ids <- cell_ids$cell_ids 42 | } 43 | assert_that( 44 | is.character(cell_ids), 45 | !any(duplicated(cell_ids)) 46 | ) 47 | 48 | # process cell info 49 | if (is.null(cell_info)) { 50 | cell_info <- tibble(cell_id = cell_ids) 51 | } 52 | assert_that( 53 | is.data.frame(cell_info), 54 | all.equal(cell_info$cell_id, cell_ids) 55 | ) 56 | 57 | # process feature ids 58 | if (!is.null(feature_ids)) { 59 | if (is_tibble(feature_ids) && ncol(feature_ids) == 1 && "feature_ids" %in% names(feature_ids)) { 60 | feature_ids <- feature_ids$feature_ids 61 | } 62 | assert_that( 63 | is.character(feature_ids), 64 | !any(duplicated(feature_ids)) 65 | ) 66 | 67 | # process feature info 68 | if (is.null(feature_info)) { 69 | feature_info <- tibble(feature_id = feature_ids) 70 | } 71 | assert_that( 72 | is.data.frame(cell_info), 73 | all.equal(cell_info$cell_id, cell_ids) 74 | ) 75 | } 76 | 77 | 78 | 79 | list() %>% extend_with( 80 | "dynwrap::data_wrapper", 81 | id = id, 82 | cell_ids = cell_ids, 83 | cell_info = cell_info, 84 | feature_ids = feature_ids, 85 | feature_info = feature_info, 86 | ... 87 | ) 88 | } 89 | 90 | #' @rdname wrap_data 91 | #' @inheritParams common_param 92 | #' 93 | #' @export 94 | is_data_wrapper <- function(dataset) { 95 | "dynwrap::data_wrapper" %in% class(dataset) 96 | } 97 | -------------------------------------------------------------------------------- /R/wrap_gather_cells_at_milestones.R: -------------------------------------------------------------------------------- 1 | #' Gather cells to their closest milestones 2 | #' 3 | #' Cells will be moved to their closest milestones. 4 | #' 5 | #' @inheritParams common_param 6 | #' 7 | #' @return A trajectory where cells where moved to the closest milestone, the milestone_percentages and progressions will be adapated. 8 | #' 9 | #' @keywords adapt_trajectory 10 | #' 11 | #' @examples 12 | #' trajectory <- example_trajectory 13 | #' trajectory <- gather_cells_at_milestones(trajectory) 14 | #' head(trajectory$milestone_percentages) 15 | #' 16 | #' @export 17 | gather_cells_at_milestones <- function(trajectory) { 18 | assert_that(is_wrapper_with_trajectory(trajectory)) 19 | 20 | milestone_percentages <- 21 | trajectory$milestone_percentages %>% 22 | group_by(cell_id) %>% 23 | slice(which.max(percentage)) %>% 24 | mutate(percentage = 1) %>% 25 | ungroup() 26 | 27 | trajectory %>% 28 | add_trajectory( 29 | milestone_network = trajectory$milestone_network, 30 | divergence_regions = trajectory$divergence_regions, 31 | milestone_percentages = milestone_percentages, 32 | trajectory_cell_positioning = "milestones" 33 | ) 34 | } 35 | 36 | 37 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "dynwrap: Representing and Inferring Single-Cell Trajectories" 3 | output: 4 | github_document: 5 | html_preview: false 6 | editor_options: 7 | chunk_output_type: console 8 | --- 9 | 10 | 11 | 12 | ```{r, echo = FALSE, message = FALSE, error = FALSE, warning = FALSE} 13 | library(tidyverse) 14 | ``` 15 | 16 | [![R-CMD-check](https://github.com/dynverse/dynwrap/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/dynverse/dynwrap/actions/workflows/R-CMD-check.yaml) 17 | [![Codecov test coverage](https://codecov.io/gh/dynverse/dynwrap/branch/master/graph/badge.svg)](https://app.codecov.io/gh/dynverse/dynwrap?branch=master) 18 | [**Tutorials**](https://dynverse.org) 19 | [**Reference documentation**](https://dynverse.org/reference/dynwrap/) 20 | 21 | 22 | 23 | 24 | **dynwrap** contains the code for a common model of single-cell trajectories. The package can: 25 | 26 | * Wrap the input data of a trajectory inference method, such as expression and prior information 27 | * Run a trajectory inference method in R, in a docker container or a singularity container 28 | * Wrap the output of a trajectory inference method, such as the pseudotime, a clustering or a branch network, and convert it into a common trajectory model 29 | * Further postprocess and adapt the trajectory model, such as labelling the milestones and rooting the trajectory 30 | 31 | ![](man/figures/trajectory_model.png) 32 | 33 | Documentation and the API reference for dynwrap can be found at the dyvnerse documentation website: https://dynverse.org/ . 34 | 35 | dynwrap was used to wrap 50+ trajectory inference method within docker containers in [dynmethods](https://github.com/dynverse/dynmethods). 36 | 37 | ![](man/figures/overview_wrapping_v3.png) 38 | 39 | The advantage of using a common model is that it allows: 40 | 41 | * Comparison between a prediction and a gold standard, eg. using [dyneval](https://github.com/dynverse/dyneval) 42 | * Comparing two predictions 43 | * Easily visualise the trajectory, eg. using [dynplot](https://github.com/dynverse/dynplot) 44 | * Extracting relevant features/genes, eg. using [dynfeature](https://github.com/dynverse/dynfeature) 45 | 46 | 47 | ## Latest changes 48 | 49 | Check out `news(package = "dynwrap")` or [NEWS.md](NEWS.md) for a full list of changes. 50 | 51 | 52 | 53 | ```{r news, echo=FALSE, results="asis"} 54 | cat(dynutils::recent_news()) 55 | ``` 56 | 57 | ## Dynverse dependencies 58 | 59 | 60 | ![](man/figures/dependencies.png) 61 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | reference: 2 | - id: "create_trajectory" 3 | title: "Creating a trajectory" 4 | desc: "Methods to create a trajectory" 5 | - id: "adapt_trajectory" 6 | title: "Adapting a trajectory model" 7 | desc: "Methods to adapt a trajectory" 8 | - id: "derive_trajectory" 9 | title: "Calculations from a trajectory" 10 | desc: "Deriving features from a trajectory model" 11 | - id: "create_ti_method" 12 | title: "Creating a TI method" 13 | desc: "Methods to create a TI method wrapper" 14 | - id: "infer_trajectory" 15 | title: "Running a TI method" 16 | desc: "Methods to run one or more TI methods" 17 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # dynwrap 1.2.4 2 | 3 | * Resubmission after babelwhale was removed from CRAN. 4 | 5 | * MINOR CHANGE: Added `@return` documentation to all functions. 6 | 7 | ## Test environments 8 | * local Fedora install, R 4.2 9 | * ubuntu 22.04, mac os x, windows (on github actions), R 4.2 10 | * win-builder (devel and release) 11 | -------------------------------------------------------------------------------- /data-raw/allowed_inputs_outputs.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | devtools::load_all() 3 | 4 | # # allowed outputs --------------------------------------- 5 | # 6 | # # all functions which start with an "add", but filtered by: 7 | # # if they contain "The trajectory model." as return value in documentation 8 | # # or if they are one of: 9 | # output_ids_builds_upon_trajectory <- c("root", "pseudotime", "waypoints", "dimred", "grouping", "timings") 10 | # 11 | # requireNamespace("dynwrap") 12 | # add_ids <- as.character(lsf.str(asNamespace("dynwrap"))) %>% 13 | # stringr::str_subset("^add_.*") 14 | # 15 | # requireNamespace("Rd2roxygen") 16 | # allowed_outputs <- map_df(add_ids, function(add_id) { 17 | # print(add_id) 18 | # 19 | # output_id <- gsub("add_(.*)", "\\1", add_id) 20 | # 21 | # file <- paste0("man/", add_id, ".Rd") 22 | # rd <- Rd2roxygen::parse_file(file) 23 | # 24 | # creates_trajectory <- str_detect(rd$value, ".*The trajectory model.*") && !is.null(rd$value) 25 | # builds_upon_trajectory <- output_id %in% output_ids_builds_upon_trajectory 26 | # 27 | # processor <- get_output_processor(output_id) 28 | # 29 | # # exception for trajectory 30 | # if (output_id == "trajectory") { 31 | # processor$required_args <- c(processor$required_args, "milestone_percentages", "progressions") 32 | # processor$optional_args <- processor$optional_args[!processor$optional_args %in% c("progressions", "milestone_percentages")] 33 | # } 34 | # 35 | # if (creates_trajectory || builds_upon_trajectory) { 36 | # tibble( 37 | # output_id = output_id, 38 | # description = rd$title, 39 | # creates_trajectory = creates_trajectory, 40 | # required_args = list(processor$required_args), 41 | # optional_args = list(processor$optional_args) 42 | # ) 43 | # } else { 44 | # tibble() 45 | # } 46 | # }) 47 | 48 | # allowed inputs -------------------------------- 49 | # will use expression/counts and all priors EXCEPT dataset 50 | data("priors", package = "dynwrap") 51 | 52 | allowed_inputs <- tribble( 53 | ~input_id, ~description, 54 | "expression", "Expression matrix (sparse)", 55 | "counts", "Raw counts matrix (sparse)", 56 | "expression_future", "Future expression matrix based on RNA velocity (sparse)" 57 | ) %>% bind_rows( 58 | priors %>% select(input_id = prior_id, description = description) 59 | ) 60 | 61 | usethis::use_data(allowed_outputs, allowed_inputs, overwrite = TRUE) 62 | -------------------------------------------------------------------------------- /data-raw/example_dataset.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(dynwrap) 3 | 4 | set.seed(1) 5 | 6 | ncells <- 500 7 | pseudotime <- runif(ncells) 8 | 9 | expression <- matrix( 10 | c( 11 | pseudotime, 12 | (.5 - pseudotime) ** 2, 13 | sqrt(20 - pseudotime * 2) 14 | ), 15 | ncol = 3, 16 | dimnames = list(as.character(rep(seq_len(ncells))), as.character(c("A", "B", "C"))) 17 | ) 18 | expression <- expression + rnorm(length(expression), sd = 0.02) 19 | 20 | names(pseudotime) <- rownames(expression) <- paste0("Cell", seq_len(nrow(expression))) 21 | 22 | start_id <- rownames(expression)[which.min(pseudotime)] 23 | 24 | counts <- round(expression) 25 | 26 | example_dataset <- 27 | wrap_data( 28 | id = "example", 29 | cell_ids = rownames(counts) 30 | ) %>% 31 | add_expression( 32 | expression = expression, 33 | counts = counts 34 | ) %>% 35 | add_dimred( 36 | dimred = expression 37 | ) 38 | 39 | example_trajectory <- example_dataset %>% 40 | add_linear_trajectory( 41 | pseudotime = pseudotime, 42 | directed = TRUE 43 | ) %>% 44 | add_prior_information() %>% 45 | add_cell_waypoints() %>% 46 | add_dimred(dimred = expression) 47 | 48 | dynplot::plot_graph(example_trajectory) 49 | dynplot::plot_dimred(example_trajectory) 50 | dynplot::plot_heatmap(example_trajectory) 51 | dynplot::plot_dimred(dynwrap::example_trajectory, "feature", feature_oi = "C") 52 | 53 | usethis::use_data(example_trajectory, overwrite = TRUE) 54 | usethis::use_data(example_dataset, overwrite = TRUE) 55 | -------------------------------------------------------------------------------- /data-raw/priors.R: -------------------------------------------------------------------------------- 1 | library(tibble) 2 | 3 | priors <- tribble( 4 | ~prior_id, ~name, ~description, ~type, ~format, ~example, 5 | "start_id", "Start cell(s)", "One or more start cell identifiers", "soft", "character vector", "C1,C2,C3", 6 | 7 | "end_id", "End cell(s)", "One or more end cell identifiers", "soft", "character vector", "C1,C2,C3", 8 | 9 | "end_n", "# end states", "The number of end states", "soft", "integer", "1", 10 | 11 | "start_n", "# start states", "The number of start states", "soft", "integer", "4", 12 | 13 | "leaves_n", "# leaves", "The number of leaves", "soft", "integer", "5", 14 | 15 | "groups_id", "Cell clustering", "Named character vector linking the cell identifiers to different states/branches", "hard", "named character vector", "C1=A,C2=B,C3=B", 16 | 17 | "groups_n", "# states", "Number of states/branches, including start, end and intermediary states", "soft", "integer", "5", 18 | 19 | "groups_network", "State network", "Dataframe containing the known network between states/branches. Contains a from and to column", "hard", "dataframe(from: character, to: character)", "A,B;B,C;B,D", 20 | 21 | "timecourse_continuous", "Time course (continuous)", "Named numeric vector linking the cell ids to time points", "hard", "named double vector", "C1=0.1,C2=0.4,C3=0.8", 22 | 23 | "timecourse_discrete", "Time course (discrete)", "Named numeric vector linking the cell ids to time course points", "hard", "named integer vector", "C1=1,C2=4,C3=7", 24 | 25 | "features_id", "Marker genes", "Genes/features known to be important in the dynamic process", "soft", "character vector", "G1,G2,G3", 26 | 27 | "dataset", "The full dataset", "The full dataset, including (if available) the gold standard", "hard", "dynwrap::wrap_data(...)", "dataset.rds/loom/h5", 28 | 29 | "dimred", "A dimensionality reduction", "A dimensionality reduction of the cells", "soft", "named matrix", "named matrix[num cells x num dimensions¨]" 30 | ) 31 | 32 | prior_usages <- tribble( 33 | ~prior_usage, ~color, 34 | "optional", "#0074D9", 35 | "no", "#EEEEEE", 36 | "required", "#FF4136" 37 | ) 38 | 39 | usethis::use_data(priors, prior_usages, overwrite = TRUE) 40 | -------------------------------------------------------------------------------- /data-raw/wrapper_types.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | wrapper_types <- tribble( 4 | ~id, ~long_name, ~short_name, ~colour, 5 | "direct", "Direct", "Direct", "#ff3c2f", 6 | "linear", "Linear pseudotime", "Linear", "#0076dc", 7 | "cyclic", "Cyclical pseudotime", "Cyclic", "#2ec5c5", 8 | "end_state_prob", "End state probability", "Prob", "#edd100", 9 | "cluster_assignment", "Cluster assignment", "Cluster", "#ffa500", 10 | "orth_proj", "Orthogonal projection", "Proj", "#2ecc40", 11 | "cell_graph", "Cell graph", "Cell", "#a000dc" 12 | ) 13 | 14 | usethis::use_data(wrapper_types) 15 | -------------------------------------------------------------------------------- /data/allowed_inputs.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/allowed_inputs.rda -------------------------------------------------------------------------------- /data/allowed_outputs.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/allowed_outputs.rda -------------------------------------------------------------------------------- /data/example_dataset.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/example_dataset.rda -------------------------------------------------------------------------------- /data/example_trajectory.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/example_trajectory.rda -------------------------------------------------------------------------------- /data/prior_usages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/prior_usages.rda -------------------------------------------------------------------------------- /data/priors.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/priors.rda -------------------------------------------------------------------------------- /data/trajectory_type_dag.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/trajectory_type_dag.rda -------------------------------------------------------------------------------- /data/trajectory_types.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/trajectory_types.rda -------------------------------------------------------------------------------- /data/wrapper_types.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/data/wrapper_types.rda -------------------------------------------------------------------------------- /dynwrap.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | bibtype = "Article", 3 | author = c( 4 | person( 5 | "Robrecht", 6 | "Cannoodt", 7 | email = "rcannood@gmail.com", 8 | role = c("aut", "cre"), 9 | comment = c(ORCID = "0000-0003-3641-729X", github = "rcannood") 10 | ), 11 | person( 12 | "Wouter", 13 | "Saelens", 14 | email = "wouter.saelens@gmail.com", 15 | role = c("aut"), 16 | comment = c(ORCID = "0000-0002-7114-6248", github = "zouter") 17 | ) 18 | ), 19 | title = "dynwrap: Functionality for containerised trajectory inference.", 20 | journal = "In Progress", 21 | year = "2019" 22 | ) 23 | bibentry( 24 | bibtype = "Article", 25 | author = c( 26 | person( 27 | "Robrecht", 28 | "Cannoodt", 29 | email = "rcannood@gmail.com", 30 | role = c("aut", "cre"), 31 | comment = c(ORCID = "0000-0003-3641-729X", github = "rcannood") 32 | ), 33 | person( 34 | "Wouter", 35 | "Saelens", 36 | email = "wouter.saelens@gmail.com", 37 | role = c("aut"), 38 | comment = c(ORCID = "0000-0002-7114-6248", github = "zouter") 39 | ), 40 | person("Helena", "Todorov", comment = c(ORCID = "0000-0002-1594-8609")), 41 | person("Yvan", "Saeys", comment = c(ORCID = "0000-0002-0415-1506")) 42 | ), 43 | title = "A comparison of single-cell trajectory inference methods.", 44 | journal = "Nature Biotechnology", 45 | year = "2019", 46 | month = "4", 47 | doi = "10.1038/s41587-019-0071-9" 48 | ) 49 | -------------------------------------------------------------------------------- /inst/examples/docker/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM dynverse/dynwrappy_tester:latest 2 | 3 | COPY definition.yml run.py /code/ 4 | 5 | ENTRYPOINT ["/code/run.py"] 6 | 7 | -------------------------------------------------------------------------------- /inst/examples/docker/definition.yml: -------------------------------------------------------------------------------- 1 | method: 2 | id: comp_1 3 | 4 | parameters: 5 | - id: component 6 | default: 1 7 | type: integer 8 | distribution: 9 | type: uniform 10 | lower: 1 11 | upper: 10 12 | description: The nth component to use 13 | 14 | wrapper: 15 | input_required: expression 16 | input_optional: start_id 17 | -------------------------------------------------------------------------------- /inst/examples/docker/run.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import dynclipy 4 | dataset = dynclipy.main() 5 | 6 | import pandas as pd 7 | import sklearn.decomposition 8 | 9 | # infer trajectory 10 | pca = sklearn.decomposition.PCA() 11 | dimred = pca.fit_transform(dataset['expression']) 12 | pseudotime = pd.Series( 13 | dimred[:, dataset['parameters']['component']-1], 14 | index = dataset['expression'].index 15 | ) 16 | 17 | # build trajectory 18 | trajectory = dynclipy.wrap_data(cell_ids = dataset['expression'].index) 19 | trajectory.add_linear_trajectory(pseudotime = pseudotime) 20 | 21 | # save output 22 | trajectory.write_output(dataset['output']) 23 | -------------------------------------------------------------------------------- /inst/examples/script/definition.yml: -------------------------------------------------------------------------------- 1 | method: 2 | id: comp_1 3 | 4 | parameters: 5 | - id: component 6 | default: 1 7 | type: integer 8 | distribution: 9 | type: uniform 10 | lower: 1 11 | upper: 10 12 | description: The nth component to use 13 | 14 | wrapper: 15 | input_required: expression 16 | input_optional: start_id 17 | -------------------------------------------------------------------------------- /inst/examples/script/run.R: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env Rscript 2 | 3 | dataset <- dyncli::main() 4 | 5 | library(dynwrap) 6 | library(dplyr) 7 | library(stats) 8 | library(dyncli) 9 | 10 | # infer trajectory 11 | pca <- prcomp(dataset$expression) 12 | 13 | pseudotime <- pca$x[, dataset$parameters$component] 14 | 15 | # flip pseudotimes using start_id 16 | if (!is.null(dataset$priors$start_id)) { 17 | if (mean(pseudotime[start_id]) > 0.5) { 18 | pseudotime <- 1 - pseudotime 19 | } 20 | } 21 | 22 | # build trajectory 23 | trajectory <- wrap_data(cell_ids = rownames(dataset$expression)) %>% 24 | add_linear_trajectory(pseudotime = pseudotime) 25 | 26 | # save output 27 | write_output(trajectory, dataset$output) 28 | -------------------------------------------------------------------------------- /inst/examples/script/run.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import dynclipy 4 | dataset = dynclipy.main() 5 | 6 | import pandas as pd 7 | import sklearn.decomposition 8 | 9 | # infer trajectory 10 | pca = sklearn.decomposition.PCA() 11 | dimred = pca.fit_transform(dataset['expression']) 12 | pseudotime = pd.Series( 13 | dimred[:, dataset['parameters']['component']-1], 14 | index = dataset['expression'].index 15 | ) 16 | 17 | # build trajectory 18 | trajectory = dynclipy.wrap_data(cell_ids = dataset['expression'].index) 19 | trajectory.add_linear_trajectory(pseudotime = pseudotime) 20 | 21 | # save output 22 | trajectory.write_output(dataset['output']) 23 | -------------------------------------------------------------------------------- /inst/tests/testthat/helper-ti_comp1.R: -------------------------------------------------------------------------------- 1 | #' Inferring trajectories with Component 1 2 | #' 3 | #' Wrapper around TI method 4 | #' 5 | #' @param component The component to use 6 | ti_comp1 <- dynwrap::create_ti_method_r( 7 | definition = dynwrap::definition( 8 | # describe method 9 | dynwrap::def_method( 10 | id = "comp1" 11 | ), 12 | 13 | # describe tuneable parameters 14 | parameters = dynparam::parameter_set( 15 | dynparam::integer_parameter( 16 | id = "component", 17 | default = 1, 18 | distribution = dynparam::uniform_distribution(1L, 10L) 19 | ) 20 | ), 21 | 22 | # describe wrapper 23 | wrapper = dynwrap::def_wrapper( 24 | # describe run fun inputs and outputs 25 | input_required = "expression", 26 | input_optional = NULL 27 | ) 28 | 29 | ), 30 | 31 | # function to run the method with 32 | run_fun = function( 33 | expression, 34 | parameters, 35 | seed = NA, 36 | verbose = FALSE 37 | ) { 38 | if (length(seed) > 0 && is.finite(seed)) set.seed(seed) 39 | 40 | # TIMING: done with preproc 41 | tl <- add_timing_checkpoint(NULL, "method_afterpreproc") 42 | 43 | dimred <- prcomp(as.matrix(expression), rank. = 10)$x 44 | pseudotime <- dimred[,parameters$component] 45 | names(pseudotime) <- rownames(expression) 46 | 47 | # TIMING: done with method 48 | tl <- tl %>% add_timing_checkpoint("method_aftermethod") 49 | 50 | # return output 51 | wrap_data( 52 | cell_ids = rownames(expression) 53 | ) %>% add_linear_trajectory( 54 | pseudotime = pseudotime 55 | ) %>% add_dimred( 56 | dimred = dimred 57 | ) %>% add_timings( 58 | timings = tl %>% add_timing_checkpoint("method_afterpostproc") 59 | ) 60 | }, 61 | 62 | # describe packages needed by method 63 | package_loaded = c("dplyr", "tidyr", "purrr", "dynwrap", "dynutils"), 64 | package_required = NULL 65 | ) 66 | -------------------------------------------------------------------------------- /inst/tests/testthat/helper-ti_error.R: -------------------------------------------------------------------------------- 1 | #' Inferring trajectories with Control: error 2 | #' 3 | #' This control method will always produce an error. 4 | ti_error <- dynwrap::create_ti_method_r( 5 | dynwrap::definition( 6 | method = dynwrap::def_method(id = "error"), 7 | wrapper = dynwrap::def_wrapper(input_required = "counts") 8 | ), 9 | 10 | # function to run the method with 11 | run_fun = function( 12 | counts, 13 | seed = NA, 14 | verbose = FALSE 15 | ) { 16 | stop("This control method always errors.") 17 | } 18 | ) 19 | 20 | -------------------------------------------------------------------------------- /inst/tests/testthat/helper-ti_identity.R: -------------------------------------------------------------------------------- 1 | #' Inferring trajectories with Control: identity 2 | #' 3 | #' This control method will return the gold standard. 4 | #' 5 | #' @param dummy_param This parameter does not do anything. 6 | ti_identity <- dynwrap::create_ti_method_r( 7 | dynwrap::definition( 8 | method = dynwrap::def_method(id = "identity"), 9 | wrapper = dynwrap::def_wrapper(input_required = c("counts", "dataset")) 10 | ), 11 | 12 | # describe packages needed by method 13 | package_loaded = c("dplyr", "tidyr", "purrr", "dynwrap", "dynutils"), 14 | 15 | # function to run the method with 16 | run_fun = function( 17 | counts, 18 | priors, 19 | seed = NA, 20 | verbose = FALSE 21 | ) { 22 | dataset <- priors$dataset 23 | 24 | if (length(seed) > 0 && is.finite(seed)) set.seed(seed) 25 | 26 | # TIMING: done with preproc 27 | tl <- add_timing_checkpoint(NULL, "method_afterpreproc") 28 | 29 | # TIMING: done with method 30 | tl <- tl %>% add_timing_checkpoint("method_aftermethod") 31 | 32 | # return output 33 | wrap_data( 34 | cell_ids = dataset$cell_ids, 35 | cell_info = dataset$cell_info 36 | ) %>% add_trajectory( 37 | milestone_ids = dataset$milestone_ids, 38 | milestone_network = dataset$milestone_network, 39 | divergence_regions = dataset$divergence_regions, 40 | progressions = dataset$progressions 41 | ) %>% add_timings( 42 | timings = tl %>% add_timing_checkpoint("method_afterpostproc") 43 | ) 44 | } 45 | ) 46 | -------------------------------------------------------------------------------- /inst/tests/testthat/helper-ti_random.R: -------------------------------------------------------------------------------- 1 | #' Inferring trajectories with Control: random 2 | #' 3 | #' This control method will always produce a random trajectory. 4 | #' 5 | #' @param dummy_param This parameter does not do anything. 6 | ti_random <- dynwrap::create_ti_method_r( 7 | dynwrap::definition( 8 | method = dynwrap::def_method(id = "random"), 9 | wrapper = dynwrap::def_wrapper(input_required = "counts") 10 | ), 11 | 12 | # describe packages needed by method 13 | package_loaded = c("dplyr", "tidyr", "purrr", "dynwrap", "dynutils"), 14 | package_required = NULL, 15 | 16 | # function to run the method with 17 | run_fun = function( 18 | counts, 19 | seed = NA, 20 | verbose = FALSE 21 | ) { 22 | if (length(seed) > 0 && is.finite(seed)) set.seed(seed) 23 | 24 | num_milestones <- 15 25 | 26 | # generate network 27 | milestone_ids <- paste0("milestone_", seq_len(num_milestones)) 28 | 29 | # TIMING: done with preproc 30 | tl <- add_timing_checkpoint(NULL, "method_afterpreproc") 31 | 32 | gr <- igraph::ba.game(num_milestones) 33 | milestone_network <- igraph::as_data_frame(gr) %>% 34 | mutate( 35 | from = paste0("milestone_", from), 36 | to = paste0("milestone_", to), 37 | length = 1, 38 | directed = FALSE 39 | ) 40 | 41 | # put cells on random edges of network 42 | cell_ids <- rownames(counts) 43 | 44 | progressions <- data.frame( 45 | cell_id = cell_ids, 46 | milestone_network[sample.int(nrow(milestone_network), length(cell_ids), replace = TRUE), 1:2], 47 | percentage = stats::runif(length(cell_ids)), 48 | stringsAsFactors = FALSE 49 | ) 50 | 51 | # TIMING: done with method 52 | tl <- tl %>% add_timing_checkpoint("method_aftermethod") 53 | 54 | # return output 55 | wrap_data( 56 | cell_ids = cell_ids 57 | ) %>% add_trajectory( 58 | milestone_ids = milestone_ids, 59 | milestone_network = milestone_network, 60 | progressions = progressions, 61 | divergence_regions = NULL 62 | ) %>% add_timings( 63 | timings = tl %>% add_timing_checkpoint("method_afterpostproc") 64 | ) 65 | } 66 | ) 67 | -------------------------------------------------------------------------------- /inst/tests/testthat/helper-ti_shuffle.R: -------------------------------------------------------------------------------- 1 | #' Inferring trajectories with Control: shuffle 2 | #' 3 | #' This control method will return the milestone network of the provided 4 | #' gold standard, but will shuffle the cell positions randomly. 5 | #' 6 | #' @param dummy_param This parameter does not do anything. 7 | ti_shuffle <- dynwrap::create_ti_method_r( 8 | dynwrap::definition( 9 | method = dynwrap::def_method(id = "shuffle"), 10 | wrapper = dynwrap::def_wrapper(input_required = c("counts", "dataset")) 11 | ), 12 | 13 | # describe packages needed by method 14 | package_loaded = c("dplyr", "tidyr", "purrr", "dynwrap", "dynutils"), 15 | package_required = NULL, 16 | 17 | # function to run the method with 18 | run_fun = function( 19 | counts, 20 | priors, 21 | seed = NA, 22 | verbose = FALSE 23 | ) { 24 | dataset <- priors$dataset 25 | 26 | if (length(seed) > 0 && is.finite(seed)) set.seed(seed) 27 | 28 | # TIMING: done with preproc 29 | tl <- add_timing_checkpoint(NULL, "method_afterpreproc") 30 | 31 | # permute cell labels 32 | allcells <- rownames(counts) 33 | mapper <- magrittr::set_names(sample(allcells), allcells) 34 | progressions <- dataset$progressions %>% mutate( 35 | cell_id = mapper[cell_id] 36 | ) 37 | 38 | # TIMING: done with method 39 | tl <- tl %>% add_timing_checkpoint("method_aftermethod") 40 | 41 | # return output 42 | wrap_data( 43 | cell_ids = dataset$cell_ids 44 | ) %>% add_trajectory( 45 | milestone_ids = dataset$milestone_ids, 46 | milestone_network = dataset$milestone_network, 47 | progressions = progressions, 48 | divergence_regions = dataset$divergence_regions 49 | ) %>% add_timings( 50 | timings = tl %>% add_timing_checkpoint("method_afterpostproc") 51 | ) 52 | } 53 | ) 54 | 55 | -------------------------------------------------------------------------------- /man/add_attraction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_attraction.R 3 | \name{add_attraction} 4 | \alias{add_attraction} 5 | \title{Add attraction of cells using RNA velocity} 6 | \usage{ 7 | add_attraction(dataset) 8 | } 9 | \arguments{ 10 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 11 | } 12 | \value{ 13 | A dynwrap object with the attraction added. 14 | } 15 | \description{ 16 | Add attraction of cells using RNA velocity 17 | } 18 | -------------------------------------------------------------------------------- /man/add_branch_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_branch_trajectory.R 3 | \name{add_branch_trajectory} 4 | \alias{add_branch_trajectory} 5 | \title{Construct a trajectory given its branch network and the pseudotime of the cells on one of the branches.} 6 | \usage{ 7 | add_branch_trajectory( 8 | dataset, 9 | branch_network, 10 | branches, 11 | branch_progressions, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{branch_network}{The network between branches, a dataframe with a \emph{from} and \emph{to} branch identifier} 19 | 20 | \item{branches}{The length and directedness of the branches, a dataframe with the branch identifier (\emph{branch_id}), the length of the branch (\emph{length}) and whether it is \emph{directed}} 21 | 22 | \item{branch_progressions}{Specifies the progression of a cell along a transition in the branch network. A dataframe containing the \emph{cell_id}, \emph{branch_id} and its progression along the edge (\emph{percentage}, between 0 and 1)} 23 | 24 | \item{...}{extra information to be stored in the trajectory} 25 | } 26 | \value{ 27 | A trajectory object 28 | } 29 | \description{ 30 | The branch network is converted to a milestone network by giving each branch a start and end milestone. If two branches are connected in the branch network, the end milestone of branch 1 and start milestone of branch 2 will be merged. 31 | } 32 | \details{ 33 | The resulting trajectory will always be directed. 34 | } 35 | \examples{ 36 | dataset <- wrap_data(cell_ids = letters) 37 | 38 | branch_network <- tibble::tibble(from = c("A", "A"), to = c("B", "C")) 39 | branch_network 40 | branches <- tibble::tibble(branch_id = c("A", "B", "C"), length = 1, directed = TRUE) 41 | branches 42 | branch_progressions <- tibble::tibble( 43 | cell_id = dataset$cell_ids, 44 | branch_id = sample(branches$branch_id, length(dataset$cell_ids), replace = TRUE), 45 | percentage = runif(length(dataset$cell_ids)) 46 | ) 47 | branch_progressions 48 | 49 | trajectory <- add_branch_trajectory( 50 | dataset, 51 | branch_network, 52 | branches, 53 | branch_progressions 54 | ) 55 | 56 | # for plotting the result, install dynplot 57 | #- dynplot::plot_graph(trajectory) 58 | } 59 | \keyword{create_trajectory} 60 | -------------------------------------------------------------------------------- /man/add_cell_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_cell_graph.R 3 | \name{add_cell_graph} 4 | \alias{add_cell_graph} 5 | \title{Constructs a trajectory using a graph between cells, by mapping cells onto a set of backbone cells.} 6 | \usage{ 7 | add_cell_graph( 8 | dataset, 9 | cell_graph, 10 | to_keep, 11 | milestone_prefix = "milestone_", 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{cell_graph}{The edges between cells, a dataframe containing the \emph{from} and \emph{to} cells, the *length, and whether this edge is \emph{directed}} 19 | 20 | \item{to_keep}{Whether a cells is part of the backbone. May be a character vector with the identifiers of the backbone cells, or a named boolean vector whether a cell is from the backbone} 21 | 22 | \item{milestone_prefix}{A prefix to add to the id of the cell ids when they are used as milestones, in order to avoid any naming conflicts,} 23 | 24 | \item{...}{extra information to be stored in the wrapper.} 25 | } 26 | \value{ 27 | A trajectory object 28 | } 29 | \description{ 30 | The cells that are part of the backbone will form the trajectory. All other cells are moved towards the nearest cell that is part of the backbone. 31 | } 32 | \examples{ 33 | library(dplyr) 34 | dataset <- wrap_data(cell_ids = letters) 35 | 36 | backbone_cell_graph <- tibble::tibble( 37 | from = letters[1:10], 38 | to = letters[2:11], 39 | length = 1, 40 | directed = TRUE 41 | ) 42 | leaves_cell_graph <- tibble::tibble( 43 | from = letters[12:26], 44 | to = sample(letters[1:11], 15, replace = TRUE), 45 | length = 1, 46 | directed = TRUE 47 | ) 48 | cell_graph <- bind_rows(backbone_cell_graph, leaves_cell_graph) 49 | cell_graph 50 | to_keep <- letters[1:11] 51 | to_keep 52 | 53 | trajectory <- add_cell_graph(dataset, cell_graph, to_keep) 54 | 55 | # for plotting the result, install dynplot 56 | #- dynplot::plot_graph(trajectory) 57 | } 58 | \keyword{create_trajectory} 59 | -------------------------------------------------------------------------------- /man/add_cell_waypoints.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_cell_waypoints.R 3 | \name{add_cell_waypoints} 4 | \alias{add_cell_waypoints} 5 | \alias{is_wrapper_with_waypoint_cells} 6 | \alias{determine_cell_trajectory_positions} 7 | \alias{select_waypoint_cells} 8 | \title{Add or select waypoint cells of a trajectory} 9 | \usage{ 10 | add_cell_waypoints(trajectory, num_cells_selected = 100) 11 | 12 | is_wrapper_with_waypoint_cells(trajectory) 13 | 14 | determine_cell_trajectory_positions( 15 | milestone_ids, 16 | milestone_network, 17 | milestone_percentages, 18 | progressions, 19 | divergence_regions 20 | ) 21 | 22 | select_waypoint_cells( 23 | milestone_ids, 24 | milestone_network, 25 | milestone_percentages, 26 | progressions, 27 | divergence_regions, 28 | num_cells_selected = 100 29 | ) 30 | } 31 | \arguments{ 32 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 33 | 34 | \item{num_cells_selected}{About the number of cells selected as waypoints} 35 | 36 | \item{milestone_ids}{The ids of the milestones in the trajectory. Type: Character vector.} 37 | 38 | \item{milestone_network}{The network of the milestones. 39 | Type: Data frame(from = character, to = character, length = numeric, directed = logical).} 40 | 41 | \item{milestone_percentages}{A data frame specifying what percentage milestone each cell 42 | consists of. 43 | Type: Data frame(cell_id = character, milestone_id = character, percentage = numeric).} 44 | 45 | \item{progressions}{Specifies the progression of a cell along a transition in the milestone_network. 46 | Type: Data frame(cell_id = character, from = character, to = character, percentage = numeric).} 47 | 48 | \item{divergence_regions}{A data frame specifying the divergence 49 | regions between milestones (e.g. a bifurcation). 50 | Type: Data frame(divergence_id = character, milestone_id = character, is_start = logical).} 51 | } 52 | \value{ 53 | \strong{\code{add_cell_waypoints}} returns a trajectory with \emph{waypoint_cells}, a character vector containing the cell ids of the waypoint cells 54 | 55 | \strong{\code{select_waypoint_cells}} returns a character vector containing the cell ids of the waypoint cells 56 | 57 | A dynwrap object with the waypoint cells added. 58 | } 59 | \description{ 60 | Waypoint cells are cells spread across all of the trajectory such that there is no other cell 61 | that has a large geodesic distance to any of the waypoint cells. 62 | } 63 | \keyword{adapt_trajectory} 64 | -------------------------------------------------------------------------------- /man/add_cluster_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_cluster_graph.R 3 | \name{add_cluster_graph} 4 | \alias{add_cluster_graph} 5 | \title{Constructs a trajectory using a cell grouping and a network between groups. Will use an existing grouping if it is present in the dataset.} 6 | \usage{ 7 | add_cluster_graph( 8 | dataset, 9 | milestone_network, 10 | grouping = NULL, 11 | explicit_splits = FALSE, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{milestone_network}{A network of milestones.} 19 | 20 | \item{grouping}{A grouping of the cells, can be a named vector or a dataframe with \emph{group_id} and \emph{cell_id}} 21 | 22 | \item{explicit_splits}{Whether to make splits specific by adding a starting node. For example: A->B, A->C becomes A->X, X->B, X->C} 23 | 24 | \item{...}{extra information to be stored in the wrapper.} 25 | } 26 | \value{ 27 | A trajectory object 28 | } 29 | \description{ 30 | A trajectory in this form will rarely be useful, given that cells are only placed at the milestones themselves, but not on the edges between milestones. A better alternative might be to project the cells using a dimensionality reduction, see \code{\link[=add_dimred_projection]{add_dimred_projection()}}. 31 | } 32 | \examples{ 33 | library(tibble) 34 | dataset <- wrap_data(cell_ids = letters) 35 | 36 | milestone_network <- tibble::tibble( 37 | from = c("A", "B", "B"), 38 | to = c("B", "C", "D"), 39 | directed = TRUE, 40 | length = 1 41 | ) 42 | milestone_network 43 | grouping <- sample(c("A", "B", "C", "D"), length(dataset$cell_ids), replace = TRUE) 44 | grouping 45 | trajectory <- add_cluster_graph(dataset, milestone_network, grouping) 46 | 47 | # for plotting the result, install dynplot 48 | #- dynplot::plot_graph(trajectory) 49 | } 50 | \keyword{create_trajectory} 51 | -------------------------------------------------------------------------------- /man/add_cyclic_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_cyclic_trajectory.R 3 | \name{add_cyclic_trajectory} 4 | \alias{add_cyclic_trajectory} 5 | \title{Constructs a circular trajectory using the pseudotime values of each cell.} 6 | \usage{ 7 | add_cyclic_trajectory( 8 | dataset, 9 | pseudotime, 10 | directed = FALSE, 11 | do_scale_minmax = TRUE, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{pseudotime}{A named vector of pseudo times.} 19 | 20 | \item{directed}{Whether or not the directionality of the pseudotime is predicted.} 21 | 22 | \item{do_scale_minmax}{Whether or not to scale the pseudotime between 0 and 1. 23 | Otherwise, will assume the values are already within that range.} 24 | 25 | \item{...}{extra information to be stored in the wrapper.} 26 | } 27 | \value{ 28 | A trajectory object 29 | } 30 | \description{ 31 | The pseudotime is divided into three equally sized segments, and are placed within a trajectory in the form A -> B -> C -> A 32 | } 33 | \examples{ 34 | library(tibble) 35 | dataset <- wrap_data(cell_ids = letters) 36 | 37 | pseudotime <- tibble(cell_id = dataset$cell_ids, pseudotime = runif(length(dataset$cell_ids))) 38 | pseudotime 39 | trajectory <- add_cyclic_trajectory(dataset, pseudotime) 40 | 41 | # for plotting the result, install dynplot 42 | #- dynplot::plot_graph(trajectory) 43 | } 44 | \keyword{create_trajectory} 45 | -------------------------------------------------------------------------------- /man/add_dimred_projection.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_dimred_projection.R 3 | \name{add_dimred_projection} 4 | \alias{add_dimred_projection} 5 | \title{Constructs a trajectory by projecting cells within a dimensionality reduction} 6 | \usage{ 7 | add_dimred_projection( 8 | dataset, 9 | milestone_ids = NULL, 10 | milestone_network, 11 | dimred, 12 | dimred_milestones, 13 | grouping = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 19 | 20 | \item{milestone_ids}{The ids of the milestones in the trajectory. Type: Character vector.} 21 | 22 | \item{milestone_network}{The network of the milestones. 23 | Type: Data frame(from = character, to = character, length = numeric, directed = logical).} 24 | 25 | \item{dimred}{Can be 26 | \itemize{ 27 | \item A function which will perform the dimensionality reduction, see \code{\link[dyndimred:dimred]{dyndimred::list_dimred_methods()}} 28 | \item A matrix with the dimensionality reduction, with cells in rows and dimensions (\emph{comp_1}, \emph{comp_2}, ...) in columns 29 | }} 30 | 31 | \item{dimred_milestones}{An optional dimensionality reduction of the milestones. A matrix with milestones in rows and components (\emph{comp_1}, \emph{comp_2}, ...) in columns 32 | 33 | This will be automatically calculated if \code{project_trajectory = TRUE}} 34 | 35 | \item{grouping}{A grouping of the cells, can be a named vector or a dataframe with \emph{group_id} and \emph{cell_id}} 36 | 37 | \item{...}{extra information to be stored in the wrapper.} 38 | } 39 | \value{ 40 | A trajectory object 41 | } 42 | \description{ 43 | A dimensionality reduction of cells and milestones is used, along with the milestone network, to project cells onto the nearest edge. Optionally, a cell grouping can be given which will restrict the edges on which a cell can be projected. 44 | } 45 | \examples{ 46 | library(tibble) 47 | dataset <- wrap_data(cell_ids = letters) 48 | 49 | milestone_network <- tibble::tibble( 50 | from = c("A", "B", "B"), 51 | to = c("B", "C", "D"), 52 | directed = TRUE, 53 | length = 1 54 | ) 55 | milestone_network 56 | dimred <- matrix( 57 | runif(length(dataset$cell_ids) * 2), 58 | ncol = 2, 59 | dimnames = list(dataset$cell_ids, c("comp_1", "comp_2")) 60 | ) 61 | dimred 62 | dimred_milestones <- matrix( 63 | runif(2*4), 64 | ncol = 2, 65 | dimnames = list(c("A", "B", "C", "D"), c("comp_1", "comp_2")) 66 | ) 67 | dimred_milestones 68 | trajectory <- add_dimred_projection( 69 | dataset, 70 | milestone_network = milestone_network, 71 | dimred = dimred, 72 | dimred_milestones = dimred_milestones 73 | ) 74 | 75 | # for plotting the result, install dynplot 76 | #- dynplot::plot_graph(trajectory) 77 | } 78 | \keyword{create_trajectory} 79 | -------------------------------------------------------------------------------- /man/add_end_state_probabilities.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_end_state_probabilities.R 3 | \name{add_end_state_probabilities} 4 | \alias{add_end_state_probabilities} 5 | \title{Constructs a multifurcating trajectory using end state probabilities} 6 | \usage{ 7 | add_end_state_probabilities( 8 | dataset, 9 | end_state_probabilities, 10 | pseudotime = NULL, 11 | do_scale_minmax = TRUE, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{end_state_probabilities}{A dataframe containing the \emph{cell_id} and additional numeric columns containing the probability for every end milestone. If the tibble contains only a cell_id column, the data will be processed using \code{add_linear_trajectory}} 19 | 20 | \item{pseudotime}{A named vector of pseudo times.} 21 | 22 | \item{do_scale_minmax}{Whether or not to scale the pseudotime between 0 and 1. 23 | Otherwise, will assume the values are already within that range.} 24 | 25 | \item{...}{Extras to be added to the trajectory} 26 | } 27 | \value{ 28 | A trajectory object 29 | } 30 | \description{ 31 | Constructs a multifurcating trajectory using the pseudotime values of each cell and their end state probabilities. 32 | If pseudotime values are not given, will use pseudotime already present in the dataset. 33 | } 34 | \examples{ 35 | dataset <- wrap_data(cell_ids = letters) 36 | 37 | pseudotime <- runif(length(dataset$cell_ids)) 38 | names(pseudotime) <- dataset$cell_ids 39 | pseudotime 40 | end_state_probabilities <- tibble::tibble( 41 | cell_id = dataset$cell_ids, 42 | A = runif(length(dataset$cell_ids)), 43 | B = 1-A 44 | ) 45 | end_state_probabilities 46 | trajectory <- add_end_state_probabilities(dataset, end_state_probabilities, pseudotime) 47 | 48 | # for plotting the result, install dynplot 49 | #- dynplot::plot_graph(trajectory) 50 | } 51 | \keyword{create_trajectory} 52 | -------------------------------------------------------------------------------- /man/add_expression.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_expression.R 3 | \name{add_expression} 4 | \alias{add_expression} 5 | \alias{is_wrapper_with_expression} 6 | \alias{get_expression} 7 | \title{Add count and normalised expression values to a dataset} 8 | \usage{ 9 | add_expression( 10 | dataset, 11 | counts, 12 | expression, 13 | feature_info = NULL, 14 | expression_future = NULL, 15 | ... 16 | ) 17 | 18 | is_wrapper_with_expression(dataset) 19 | 20 | get_expression(dataset, expression_source = "expression") 21 | } 22 | \arguments{ 23 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 24 | 25 | \item{counts}{The counts values of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 26 | 27 | \item{expression}{The normalised expression values of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 28 | 29 | \item{feature_info}{Optional meta-information of the features, a dataframe with at least \emph{feature_id} as column} 30 | 31 | \item{expression_future}{Projected expression using RNA velocity of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 32 | 33 | \item{...}{extra information to be stored in the dataset} 34 | 35 | \item{expression_source}{The source of expression, can be "counts", "expression", an expression matrix, or another dataset which contains expression} 36 | } 37 | \value{ 38 | A dynwrap object with the expression added. 39 | } 40 | \description{ 41 | Add count and normalised expression values to a dataset 42 | } 43 | \examples{ 44 | cell_ids <- c("A", "B", "C") 45 | counts <- matrix(sample(0:10, 3*10, replace = TRUE), nrow = 3) 46 | rownames(counts) <- cell_ids 47 | colnames(counts) <- letters[1:10] 48 | expression <- log2(counts + 1) 49 | 50 | dataset <- wrap_data(id = "my_awesome_dataset", cell_ids = cell_ids) 51 | dataset <- add_expression(dataset, counts = counts, expression = expression) 52 | 53 | str(dataset$expression) 54 | str(dataset$counts) 55 | 56 | } 57 | \keyword{adapt_trajectory} 58 | -------------------------------------------------------------------------------- /man/add_feature_importance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_feature_importance.R 3 | \name{add_feature_importance} 4 | \alias{add_feature_importance} 5 | \alias{is_wrapper_with_feature_importance} 6 | \title{Add a feature importance to a dataset} 7 | \usage{ 8 | add_feature_importance(dataset, feature_importance, ...) 9 | 10 | is_wrapper_with_feature_importance(dataset) 11 | } 12 | \arguments{ 13 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 14 | 15 | \item{feature_importance}{The impotances of the features, can be a named vector or a dataframe with columns \emph{feature_id} and \emph{importance}} 16 | 17 | \item{...}{Extra information to be stored in the dataset} 18 | } 19 | \value{ 20 | A dynwrap object with the feature importance added. 21 | } 22 | \description{ 23 | Add a feature importance to a dataset 24 | } 25 | \examples{ 26 | dataset <- example_dataset 27 | 28 | feature_importance <- runif(nrow(dataset$feature_info)) 29 | names(feature_importance) <- dataset$feature_info$feature_id 30 | 31 | dataset <- add_feature_importance(dataset, feature_importance) 32 | head(dataset$feature_importance) 33 | 34 | } 35 | \keyword{adapt_trajectory} 36 | -------------------------------------------------------------------------------- /man/add_grouping.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_grouping.R 3 | \name{add_grouping} 4 | \alias{add_grouping} 5 | \alias{is_wrapper_with_grouping} 6 | \alias{get_grouping} 7 | \title{Add a cell grouping to a dataset} 8 | \usage{ 9 | add_grouping(dataset, grouping, group_ids = NULL, ...) 10 | 11 | is_wrapper_with_grouping(dataset) 12 | 13 | get_grouping(dataset, grouping = NULL) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{grouping}{A grouping of the cells, can be a named vector or a dataframe with \emph{group_id} and \emph{cell_id}} 19 | 20 | \item{group_ids}{All group identifiers, optional} 21 | 22 | \item{...}{Extra information to be stored in the dataset} 23 | } 24 | \value{ 25 | A dynwrap object with the grouping added. 26 | } 27 | \description{ 28 | Add a cell grouping to a dataset 29 | } 30 | \examples{ 31 | dataset <- example_dataset 32 | 33 | grouping <- sample(c("A", "B", "C"), length(dataset$cell_ids), replace = TRUE) 34 | names(grouping) <- dataset$cell_ids 35 | 36 | dataset <- add_grouping(dataset, grouping) 37 | head(dataset$grouping) 38 | 39 | } 40 | \keyword{adapt_trajectory} 41 | -------------------------------------------------------------------------------- /man/add_linear_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_linear_trajectory.R 3 | \name{add_linear_trajectory} 4 | \alias{add_linear_trajectory} 5 | \title{Constructs a linear trajectory using pseudotime values} 6 | \usage{ 7 | add_linear_trajectory( 8 | dataset, 9 | pseudotime, 10 | directed = FALSE, 11 | do_scale_minmax = TRUE, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 17 | 18 | \item{pseudotime}{A named vector of pseudo times.} 19 | 20 | \item{directed}{Whether the trajectory will be directed.} 21 | 22 | \item{do_scale_minmax}{Whether or not to scale the pseudotime between 0 and 1. 23 | Otherwise, will assume the values are already within that range.} 24 | 25 | \item{...}{extra information to be stored in the trajectory} 26 | } 27 | \value{ 28 | A trajectory object 29 | } 30 | \description{ 31 | Constructs a linear trajectory using pseudotime values 32 | } 33 | \examples{ 34 | library(tibble) 35 | dataset <- wrap_data(cell_ids = letters) 36 | 37 | pseudotime <- tibble( 38 | cell_id = dataset$cell_ids, 39 | pseudotime = runif(length(dataset$cell_ids)) 40 | ) 41 | 42 | trajectory <- add_linear_trajectory(dataset, pseudotime) 43 | } 44 | \keyword{create_trajectory} 45 | -------------------------------------------------------------------------------- /man/add_pseudotime.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_pseudotime.R 3 | \name{calculate_pseudotime} 4 | \alias{calculate_pseudotime} 5 | \alias{add_pseudotime} 6 | \title{Add or calculate pseudotime as distance from the root} 7 | \usage{ 8 | calculate_pseudotime(trajectory) 9 | 10 | add_pseudotime(trajectory, pseudotime = NULL) 11 | } 12 | \arguments{ 13 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 14 | 15 | \item{pseudotime}{Named vector containing the pseudotime for every cell. If not given, the pseudotime will be calculated.} 16 | } 17 | \value{ 18 | The trajectory with \emph{pseudotime} added, which is a named vector containing the pseudotime values for every cell. 19 | } 20 | \description{ 21 | When calculating the pseudotime, the trajectory is expected to be rooted (see \code{\link[=add_root]{add_root()}}) 22 | } 23 | \seealso{ 24 | \code{\link[=add_root]{add_root()}}, \code{\link[=add_linear_trajectory]{add_linear_trajectory()}} 25 | } 26 | \keyword{derive_trajectory} 27 | -------------------------------------------------------------------------------- /man/add_regulatory_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_regulatory_network.R 3 | \name{add_regulatory_network} 4 | \alias{add_regulatory_network} 5 | \title{Add a GRN to a dynwrap object} 6 | \usage{ 7 | add_regulatory_network( 8 | dataset, 9 | regulatory_network, 10 | regulatory_network_sc = NULL, 11 | regulators = NULL, 12 | targets = NULL, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 18 | 19 | \item{regulatory_network}{A data frame consisting of three columns: \code{"regulator"}, \code{"target"}, \code{"strength"}.} 20 | 21 | \item{regulatory_network_sc}{A data frame consisting of four columns: \code{"cell_id"}, \code{"regulator"}, \code{"target"}, \code{"strength"}.} 22 | 23 | \item{regulators}{The feature ids of the regulators.} 24 | 25 | \item{targets}{The feature ids of the targets.} 26 | 27 | \item{...}{Extra arguments to be saved in the model.} 28 | } 29 | \value{ 30 | A dynwrap object with the regulatory network added. 31 | } 32 | \description{ 33 | Add a GRN to a dynwrap object 34 | } 35 | -------------------------------------------------------------------------------- /man/add_root.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_root.R 3 | \name{add_root} 4 | \alias{add_root} 5 | \alias{add_root_using_expression} 6 | \alias{is_rooted} 7 | \alias{remove_root} 8 | \title{Root the trajectory} 9 | \usage{ 10 | add_root( 11 | trajectory, 12 | root_cell_id = trajectory$root_cell_id, 13 | root_milestone_id = trajectory$root_milestone_id, 14 | flip_edges = TRUE 15 | ) 16 | 17 | add_root_using_expression( 18 | trajectory, 19 | features_oi, 20 | expression_source = "expression" 21 | ) 22 | 23 | is_rooted(trajectory) 24 | 25 | remove_root(trajectory) 26 | } 27 | \arguments{ 28 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 29 | 30 | \item{root_cell_id}{The root cell id, not required if root_milestone_id is given} 31 | 32 | \item{root_milestone_id}{The root milestone id, not required if root_cell_id is given} 33 | 34 | \item{flip_edges}{Whether to flip edges which are going in the other direction compared to the root} 35 | 36 | \item{features_oi}{The feature ids which will be used to root} 37 | 38 | \item{expression_source}{Source of the expression, either a string or a matrix} 39 | } 40 | \value{ 41 | A trajectory, with a \emph{root_milestone_id} and with adapted \emph{milestone_network} and \emph{progressions} based on the rooting. 42 | } 43 | \description{ 44 | Designates a milestone as root, and changes the direction of any edges so that they move away from the specified root (if \code{flip_edges=TRUE}, default). 45 | } 46 | \details{ 47 | A \code{root_cell_id} can also be specified, and the root milestone will be determined as the milestone with the closest geodesic distance to this cell. 48 | } 49 | \examples{ 50 | # add a root using a root cell 51 | trajectory <- example_trajectory 52 | trajectory <- add_root( 53 | trajectory, 54 | root_cell_id = sample(trajectory$cell_ids, 1) 55 | ) 56 | trajectory$root_milestone_id 57 | 58 | # add a root using a root milestone id 59 | trajectory <- add_root( 60 | trajectory, 61 | root_milestone_id = "milestone_end" 62 | ) 63 | trajectory$root_milestone_id 64 | trajectory$milestone_network 65 | 66 | } 67 | \keyword{adapt_trajectory} 68 | -------------------------------------------------------------------------------- /man/add_tde_overall.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_tde_overall.R 3 | \name{add_tde_overall} 4 | \alias{add_tde_overall} 5 | \title{Add information on overall differentially expressed features} 6 | \usage{ 7 | add_tde_overall(trajectory, tde_overall) 8 | } 9 | \arguments{ 10 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 11 | 12 | \item{tde_overall}{A dataframe containing the \emph{feature_id}, and some other columns including whether it is differentially expressed (\emph{differentially_expressed}), the rank of differential expression among all other features (\emph{rank}), the p-value (\emph{pval}) or corrected value (\emph{qval}), and the log-fold change (\emph{lfc}).} 13 | } 14 | \value{ 15 | A trajectory containing \emph{tde_overall}, a dataframe containing the \emph{feature_id}, and some other columns including whether it is differentially expressed (\emph{differentially_expressed}), the rank of differential expression among all other features (\emph{rank}), the p-value (\emph{pval}) or corrected value (\emph{qval}), and the log-fold change (\emph{lfc}). 16 | } 17 | \description{ 18 | To calculate differential expression within trajectories, check out the \href{https://github.com/dynverse/dynfeature}{dynfeature} package. 19 | } 20 | \examples{ 21 | trajectory <- example_trajectory 22 | tde_overall <- tibble::tibble( 23 | feature_id = trajectory$feature_info$feature_id, 24 | differentially_expressed = sample(c(TRUE, FALSE), length(feature_id), replace = TRUE) 25 | ) 26 | trajectory <- add_tde_overall(trajectory, tde_overall) 27 | trajectory$tde_overall 28 | 29 | } 30 | \keyword{adapt_trajectory} 31 | -------------------------------------------------------------------------------- /man/add_timings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_timings.R 3 | \name{add_timings} 4 | \alias{add_timings} 5 | \alias{is_wrapper_with_timings} 6 | \alias{add_timing_checkpoint} 7 | \title{Add timings to a trajectory} 8 | \usage{ 9 | add_timings(trajectory, timings) 10 | 11 | is_wrapper_with_timings(trajectory) 12 | 13 | add_timing_checkpoint(timings, name) 14 | } 15 | \arguments{ 16 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 17 | 18 | \item{timings}{A list of timings.} 19 | 20 | \item{name}{The name of the timings checkpoint.} 21 | } 22 | \value{ 23 | A dynwrap object with the timings added. 24 | } 25 | \description{ 26 | Add timings to a trajectory 27 | 28 | Helper function for storing timings information. 29 | } 30 | \examples{ 31 | trajectory <- example_trajectory 32 | trajectory <- add_timings( 33 | trajectory, 34 | list(start = 0, end = 1) 35 | ) 36 | 37 | } 38 | \keyword{adapt_trajectory} 39 | -------------------------------------------------------------------------------- /man/add_waypoints.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_waypoints.R 3 | \name{select_waypoints} 4 | \alias{select_waypoints} 5 | \alias{add_waypoints} 6 | \alias{is_wrapper_with_waypoints} 7 | \title{Add or create waypoints to a trajectory} 8 | \usage{ 9 | select_waypoints( 10 | trajectory, 11 | n_waypoints = 200, 12 | trafo = sqrt, 13 | resolution = sum(trafo(trajectory$milestone_network$length))/n_waypoints, 14 | recompute = FALSE 15 | ) 16 | 17 | add_waypoints( 18 | trajectory, 19 | n_waypoints = 200, 20 | trafo = sqrt, 21 | resolution = sum(trafo(trajectory$milestone_network$length))/n_waypoints, 22 | recompute = FALSE 23 | ) 24 | 25 | is_wrapper_with_waypoints(trajectory) 26 | } 27 | \arguments{ 28 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 29 | 30 | \item{n_waypoints}{The number of waypoints} 31 | 32 | \item{trafo}{Transformation function of the edge lengths} 33 | 34 | \item{resolution}{The resolution of the waypoints, measured in the same units as the lengths of the milestone network edges, will be automatically computed using n_waypoints} 35 | 36 | \item{recompute}{Force recompute} 37 | } 38 | \value{ 39 | \strong{\code{add_waypoints}} returns the trajectory with \emph{waypoints} added, which is a list containing: 40 | \itemize{ 41 | \item \emph{milestone_percentages} and \emph{progressions}: The milestone percentages and progressions of each waypoint, in the same format as the cell equivalents (see \code{\link[=add_trajectory]{add_trajectory()}}) but with a \emph{waypoint_id} column instead of a \emph{cell_id} column 42 | \item \emph{geodesic_distances}: a matrix with the geodesic distance of each waypoint (rows) to every cell (columns) 43 | \item \emph{waypoint_network}: a dataframe containing the network between consecutive waypoints, it contains information on the connected waypoints (\emph{from} and \emph{to}) and the edge on which they reside (\emph{from_milestone_id} and \emph{to_milestone_id}) 44 | \item \emph{waypoints}: the waypoint identifiers 45 | } 46 | 47 | **\code{select_waypoints} returns the list as mentioned in \code{add_waypoints} 48 | } 49 | \description{ 50 | Waypoints are points along the trajectory, which do not necessarily correspond to cells. They are selected in such a way that all parts of the trajectory are covered 51 | } 52 | \keyword{adapt_trajectory} 53 | -------------------------------------------------------------------------------- /man/allowed_inputs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{allowed_inputs} 5 | \alias{allowed_inputs} 6 | \title{All allowed inputs for a TI method} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 16 rows and 2 columns. 9 | } 10 | \usage{ 11 | allowed_inputs 12 | } 13 | \description{ 14 | All allowed inputs for a TI method 15 | } 16 | \examples{ 17 | allowed_inputs 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /man/allowed_outputs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{allowed_outputs} 5 | \alias{allowed_outputs} 6 | \title{All allowed outputs for a TI method} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 14 rows and 5 columns. 9 | } 10 | \usage{ 11 | allowed_outputs 12 | } 13 | \description{ 14 | All allowed outputs for a TI method 15 | } 16 | \examples{ 17 | allowed_outputs 18 | 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /man/calculate_attraction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_attraction.R 3 | \name{calculate_attraction} 4 | \alias{calculate_attraction} 5 | \title{Calculate the attraction of cells to other cells using velocity} 6 | \usage{ 7 | calculate_attraction( 8 | current, 9 | projected, 10 | cells = colnames(projected), 11 | n_waypoints = 50, 12 | k = 50 13 | ) 14 | } 15 | \arguments{ 16 | \item{current}{Current expression} 17 | 18 | \item{projected}{Projected expression based on RNA velocity} 19 | 20 | \item{cells}{Which cells to use} 21 | 22 | \item{n_waypoints}{Number of waypoints to use} 23 | 24 | \item{k}{K knns} 25 | } 26 | \value{ 27 | Matrix containing the attraction ([-1, 1]) of each cell to the waypoint cells 28 | } 29 | \description{ 30 | Calculate the attraction of cells to other cells using velocity 31 | } 32 | -------------------------------------------------------------------------------- /man/calculate_average.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_average.R 3 | \name{calculate_average_by_group} 4 | \alias{calculate_average_by_group} 5 | \title{Calculate average values of a matrix} 6 | \usage{ 7 | calculate_average_by_group(x, cell_grouping) 8 | } 9 | \arguments{ 10 | \item{x}{A matrix. One row for every cell; one column for every feature. The rows must be named.} 11 | 12 | \item{cell_grouping}{A data frame denoting the grouping of the cells. 13 | Format: \code{tibble(cell_id = character(), group_id = character())}.} 14 | } 15 | \value{ 16 | A matrix containing for each feature (column) the average 17 | } 18 | \description{ 19 | \code{calculate_average_by_group} will calculate an average value per group, given a matrix with cells in the rows and some features in the columns (e.g. expression matrix) 20 | } 21 | \examples{ 22 | calculate_average_by_group( 23 | x = example_trajectory$expression, 24 | cell_grouping = example_trajectory$prior_information$groups_id 25 | ) 26 | 27 | } 28 | \keyword{derive_trajectory} 29 | -------------------------------------------------------------------------------- /man/calculate_geodesic_distances.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_geodesic_distances.R 3 | \name{calculate_geodesic_distances} 4 | \alias{calculate_geodesic_distances} 5 | \alias{compute_tented_geodesic_distances} 6 | \title{Calculate geodesic distances between cells in a trajectory} 7 | \usage{ 8 | calculate_geodesic_distances( 9 | trajectory, 10 | waypoint_cells = NULL, 11 | waypoint_milestone_percentages = NULL, 12 | directed = FALSE 13 | ) 14 | 15 | compute_tented_geodesic_distances( 16 | trajectory, 17 | waypoint_cells = NULL, 18 | waypoint_milestone_percentages = NULL 19 | ) 20 | } 21 | \arguments{ 22 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 23 | 24 | \item{waypoint_cells}{A vector of waypoint cells. Only the geodesic distances between waypoint cells and all other cells will be calculated.} 25 | 26 | \item{waypoint_milestone_percentages}{The milestone percentages of non-cell waypoints, containing waypoint_id, milestone_id and percentage columns} 27 | 28 | \item{directed}{Take into account the directions of the milestone edges. The cells that cannot be reached from a particular waypoint will have distance infinity. You can also give a character, if it is "forward" it will look forward, if it is "reverse" it will look in the reversed direction} 29 | } 30 | \value{ 31 | A matrix containing geodesic distances between each waypoint cell (rows) and cell (columns) 32 | } 33 | \description{ 34 | Will calculate geodesic distances between cells within a trajectory. To speed things up, only the distances with a set of waypoint cells are calculated. 35 | } 36 | \details{ 37 | The geodesic distance takes into account the length of an edge regions of delayed commitment. 38 | } 39 | \examples{ 40 | geodesic_distances <- calculate_geodesic_distances(example_trajectory) 41 | geodesic_distances[1:10, 1:10] 42 | 43 | } 44 | \keyword{derive_trajectory} 45 | -------------------------------------------------------------------------------- /man/calculate_trajectory_dimred.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_trajectory_dimred.R 3 | \name{calculate_trajectory_dimred} 4 | \alias{calculate_trajectory_dimred} 5 | \title{Layout the trajectory and its cells in 2 dimensions using a graph layout} 6 | \usage{ 7 | calculate_trajectory_dimred(trajectory, adjust_weights = FALSE) 8 | } 9 | \arguments{ 10 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 11 | 12 | \item{adjust_weights}{Whether or not to rescale the milestone network weights} 13 | } 14 | \value{ 15 | A list containg 16 | \itemize{ 17 | \item \emph{milestone_positions}: A dataframe containing the \emph{milestone_id} 18 | and the location of each milestone (\emph{comp_1} and \emph{comp_2}) 19 | \item \emph{edge_positions}: A dataframe containing for each edge 20 | (\emph{from}, \emph{to}, \emph{length} and \emph{directed} columns) the position 21 | of the from milestone (\emph{comp_1_from} and \emph{comp_2_from}) and to 22 | milestone (\emph{comp_1_to} and \emph{comp_2_to}). 23 | \item \emph{cell_positions}: A dataframe containing the \emph{cell_id} and the 24 | ¨location of each cell (\emph{comp_1} and \emph{comp_2}) 25 | \item \emph{divergence_edge_positions}: A dataframe as \emph{edge_positions} 26 | but for each edge within a divergence 27 | \item \emph{divergence_polygon_positions}: A dataframe containing the \emph{triangle_id} 28 | and the location of the milestone within a divergence (\emph{comp_1} and \emph{comp_2}) 29 | } 30 | } 31 | \description{ 32 | Layout the trajectory and its cells in 2 dimensions using a graph layout 33 | } 34 | \examples{ 35 | trajectory_dimred <- calculate_trajectory_dimred(example_trajectory) 36 | head(trajectory_dimred$milestone_positions) 37 | head(trajectory_dimred$edge_positions) 38 | head(trajectory_dimred$cell_positions) 39 | 40 | } 41 | \seealso{ 42 | \code{\link[=wrap_data]{wrap_data()}} 43 | } 44 | \keyword{derive_trajectory} 45 | -------------------------------------------------------------------------------- /man/classify_milestone_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/classify_milestone_network.R 3 | \name{classify_milestone_network} 4 | \alias{classify_milestone_network} 5 | \title{Classify a milestone network} 6 | \usage{ 7 | classify_milestone_network(milestone_network) 8 | } 9 | \arguments{ 10 | \item{milestone_network}{A milestone network} 11 | } 12 | \value{ 13 | A list containing 14 | \itemize{ 15 | \item \emph{network_type}: The network type (also known as the trajectory_type). See \code{dynwrap::trajectory_types} for an overview. 16 | \item \emph{directed}: Whether the trajectory is directed 17 | \item \emph{properties}: Different properties of the trajectory, including: 18 | \itemize{ 19 | \item \emph{is_directed}: Whether the trajectory is directed 20 | \item \emph{max_degree}: The maximal degree 21 | \item \emph{num_branch_nodes}: The number of branching nodes 22 | \item \emph{num_outer_nodes}: Number of leaf (outer) nodes 23 | \item \emph{is_self_loop}: Whether it contains self-loops 24 | \item \emph{has_cycles}: Whether it has cycles 25 | \item \emph{num_components}: The number of independent components 26 | } 27 | } 28 | } 29 | \description{ 30 | Classify a milestone network 31 | } 32 | \examples{ 33 | milestone_network <- tibble::tibble( 34 | from = c("A", "B", "C"), 35 | to = c("B", "C", "A"), 36 | length = 1, 37 | directed = TRUE 38 | ) 39 | classification <- classify_milestone_network(milestone_network) 40 | classification$network_type 41 | classification$directed 42 | 43 | milestone_network <- tibble::tibble( 44 | from = c("A", "B", "B", "C", "C"), 45 | to = c("B", "C", "D", "E", "F"), 46 | length = 2, 47 | directed = FALSE 48 | ) 49 | classification <- classify_milestone_network(milestone_network) 50 | classification$network_type 51 | classification$directed 52 | classification$props 53 | 54 | } 55 | \seealso{ 56 | \code{dynwrap::trajectory_types} 57 | } 58 | -------------------------------------------------------------------------------- /man/common_param.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \name{common_param} 4 | \alias{common_param} 5 | \title{Common param} 6 | \arguments{ 7 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 8 | 9 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 10 | } 11 | \value{ 12 | Internal documentation 13 | } 14 | \description{ 15 | These parameters are commonly used in dynwrap. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/convert_definition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{convert_definition} 4 | \alias{convert_definition} 5 | \title{Convert a definition loaded in from a yaml} 6 | \usage{ 7 | convert_definition(definition_raw) 8 | } 9 | \arguments{ 10 | \item{definition_raw}{The raw definition loaded from the yaml} 11 | } 12 | \description{ 13 | Convert a definition loaded in from a yaml 14 | } 15 | \keyword{create_ti_method} 16 | -------------------------------------------------------------------------------- /man/convert_milestone_percentages_to_progressions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_milestone_percentages_to_progressions.R 3 | \name{convert_milestone_percentages_to_progressions} 4 | \alias{convert_milestone_percentages_to_progressions} 5 | \title{Conversion between milestone percentages and progressions} 6 | \usage{ 7 | convert_milestone_percentages_to_progressions( 8 | cell_ids, 9 | milestone_ids, 10 | milestone_network, 11 | milestone_percentages 12 | ) 13 | } 14 | \arguments{ 15 | \item{cell_ids}{The identifiers of the cells.} 16 | 17 | \item{milestone_ids}{The ids of the milestones in the trajectory. Type: Character vector.} 18 | 19 | \item{milestone_network}{The network of the milestones. 20 | Type: Data frame(from = character, to = character, length = numeric, directed = logical).} 21 | 22 | \item{milestone_percentages}{A data frame specifying what percentage milestone each cell 23 | consists of. 24 | Type: Data frame(cell_id = character, milestone_id = character, percentage = numeric).} 25 | } 26 | \value{ 27 | A data frame with columns \code{cell_id}, \code{from}, \code{to}, \code{percentage}. 28 | } 29 | \description{ 30 | Conversion between milestone percentages and progressions 31 | } 32 | \examples{ 33 | progressions <- convert_milestone_percentages_to_progressions( 34 | cell_ids = example_trajectory$cell_ids, 35 | milestone_ids = example_trajectory$milestone_ids, 36 | milestone_network = example_trajectory$milestone_network, 37 | milestone_percentages = example_trajectory$milestone_percentages 38 | ) 39 | head(progressions) 40 | 41 | } 42 | \seealso{ 43 | \code{\link[=add_trajectory]{add_trajectory()}}, \link{convert_progressions_to_milestone_percentages} 44 | } 45 | -------------------------------------------------------------------------------- /man/convert_progressions_to_milestone_percentages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_progressions_to_milestone_percentages.R 3 | \name{convert_progressions_to_milestone_percentages} 4 | \alias{convert_progressions_to_milestone_percentages} 5 | \title{Conversion between milestone percentages and progressions} 6 | \usage{ 7 | convert_progressions_to_milestone_percentages( 8 | cell_ids, 9 | milestone_ids, 10 | milestone_network, 11 | progressions 12 | ) 13 | } 14 | \arguments{ 15 | \item{cell_ids}{The identifiers of the cells.} 16 | 17 | \item{milestone_ids}{The ids of the milestones in the trajectory. Type: Character vector.} 18 | 19 | \item{milestone_network}{The network of the milestones. 20 | Type: Data frame(from = character, to = character, length = numeric, directed = logical).} 21 | 22 | \item{progressions}{Specifies the progression of a cell along a transition in the milestone_network. 23 | Type: Data frame(cell_id = character, from = character, to = character, percentage = numeric).} 24 | } 25 | \value{ 26 | A data frame with columns \code{cell_id}, \code{milestone_id}, and \code{percentage}. 27 | } 28 | \description{ 29 | Conversion between milestone percentages and progressions 30 | } 31 | \examples{ 32 | milestone_percentages <- convert_progressions_to_milestone_percentages( 33 | cell_ids = example_trajectory$cell_ids, 34 | milestone_ids = example_trajectory$milestone_ids, 35 | milestone_network = example_trajectory$milestone_network, 36 | progressions = example_trajectory$progressions 37 | ) 38 | head(milestone_percentages) 39 | 40 | } 41 | \seealso{ 42 | \code{\link[=add_trajectory]{add_trajectory()}}, \code{\link[=convert_milestone_percentages_to_progressions]{convert_milestone_percentages_to_progressions()}} 43 | } 44 | -------------------------------------------------------------------------------- /man/create_ti_method_container.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_create_ti_method_container.R 3 | \name{create_ti_method_container} 4 | \alias{create_ti_method_container} 5 | \title{Create a TI method from a docker / singularity container} 6 | \usage{ 7 | create_ti_method_container( 8 | container_id, 9 | pull_if_needed = TRUE, 10 | return_function = TRUE 11 | ) 12 | } 13 | \arguments{ 14 | \item{container_id}{The name of the container repository (e.g. \code{"dynverse/ti_angle"}).} 15 | 16 | \item{pull_if_needed}{Pull the container if not yet available.} 17 | 18 | \item{return_function}{Whether to return a function that allows you to override the default parameters, or just return the method meta data as is.} 19 | } 20 | \value{ 21 | A function that can be used to adapt the parameters of the method. This functions returns a list containing all metadata of the method, and can be used to \link[=infer_trajectory]{infer a trajectory} 22 | } 23 | \description{ 24 | These functions create a TI method from a container using \code{babelwhale}. Supports both docker and singularity as a backend. See \href{../doc/create_ti_method_container.html}{\code{vignette("create_ti_method_container", "dynwrap")}} for a tutorial on how to create a containerized TI method. 25 | } 26 | \examples{ 27 | library(babelwhale) 28 | 29 | # only run if docker works on this platform 30 | if (test_docker_installation()) { 31 | method <- create_ti_method_container("dynverse/ti_angle") 32 | trajectory <- infer_trajectory(example_dataset, method()) 33 | } 34 | 35 | } 36 | \seealso{ 37 | vignette("create_ti_method_container", "dynwrap") 38 | } 39 | \keyword{create_ti_method} 40 | -------------------------------------------------------------------------------- /man/create_ti_method_definition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_create_ti_method_definition.R 3 | \name{create_ti_method_definition} 4 | \alias{create_ti_method_definition} 5 | \title{Create a TI method from a local method definition file} 6 | \usage{ 7 | create_ti_method_definition(definition, script, return_function = TRUE) 8 | } 9 | \arguments{ 10 | \item{definition}{A definition, see \code{\link[=definition]{definition()}}} 11 | 12 | \item{script}{Location of the script that will be executed. Has to contain a #!} 13 | 14 | \item{return_function}{Whether to return a function that allows you to override the default parameters, or just return the method meta data as is.} 15 | } 16 | \value{ 17 | A method definition 18 | } 19 | \description{ 20 | The local method definition file describes a method that is runnable on the local system. 21 | See \href{../doc/create_ti_method_definition.html}{\code{vignette("create_ti_method_definition", "dynwrap")}} for a tutorial on how to create a containerized TI method. 22 | } 23 | \examples{ 24 | 25 | # See the vignette "create_ti_method_definition" to get a good idea on how 26 | # to use this function. 27 | 28 | # create a definition.yaml file and a run.R/py script. 29 | # method <- create_ti_method_definition("definition.yml", "run.R") 30 | # trajectory <- infer_trajectory(example_dataset, method(), verbose = TRUE) 31 | 32 | } 33 | \keyword{create_ti_method} 34 | -------------------------------------------------------------------------------- /man/create_ti_method_r.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_create_ti_method_r.R 3 | \name{create_ti_method_r} 4 | \alias{create_ti_method_r} 5 | \title{Create a TI method from an R function wrapper} 6 | \usage{ 7 | create_ti_method_r( 8 | definition, 9 | run_fun, 10 | package_required = character(), 11 | package_loaded = character(), 12 | remotes_package = character(), 13 | return_function = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{definition}{A definition, see \code{\link[=definition]{definition()}}} 18 | 19 | \item{run_fun}{A function to infer a trajectory, with parameters counts/expression, parameters, priors, verbose and seed} 20 | 21 | \item{package_required}{The packages that need to be installed before executing the method.} 22 | 23 | \item{package_loaded}{The packages that need to be loaded before executing the method.} 24 | 25 | \item{remotes_package}{Package from which the remote locations of dependencies have to be extracted, eg. \code{dynmethods}.} 26 | 27 | \item{return_function}{Whether to return a function that allows you to override the default parameters, or just return the method meta data as is.} 28 | } 29 | \value{ 30 | A method definition 31 | } 32 | \description{ 33 | Create a TI method from an R function wrapper 34 | } 35 | \examples{ 36 | # define the parameters and other metadata 37 | definition <- definition( 38 | method = def_method( 39 | id = "comp1" 40 | ), 41 | parameters = def_parameters( 42 | dynparam::integer_parameter( 43 | id = "component", 44 | default = 1, 45 | distribution = dynparam::uniform_distribution(1, 10), 46 | description = "The nth component to use" 47 | ) 48 | ), 49 | wrapper = def_wrapper( 50 | input_required = "expression", 51 | input_optional = "start_id" 52 | ) 53 | ) 54 | 55 | # define a wrapper function 56 | run_fun <- function(expression, priors, parameters, seed, verbose) { 57 | pca <- prcomp(expression) 58 | 59 | pseudotime <- pca$x[, parameters$component] 60 | 61 | # flip pseudotimes using start_id 62 | if (!is.null(priors$start_id)) { 63 | if(mean(pseudotime[start_id]) > 0.5) { 64 | pseudotime <- 1-pseudotime 65 | } 66 | } 67 | 68 | wrap_data(cell_ids = rownames(expression)) \%>\% 69 | add_linear_trajectory(pseudotime = pseudotime) 70 | } 71 | 72 | method <- create_ti_method_r(definition, run_fun, package_loaded = "dplyr") 73 | trajectory <- infer_trajectory(example_dataset, method()) 74 | 75 | } 76 | \keyword{create_ti_method} 77 | -------------------------------------------------------------------------------- /man/def_author.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_author} 4 | \alias{def_author} 5 | \title{Meta information on an author} 6 | \usage{ 7 | def_author(given, family, email = NULL, github = NULL, orcid = NULL) 8 | } 9 | \arguments{ 10 | \item{given}{The given name} 11 | 12 | \item{family}{The family name} 13 | 14 | \item{email}{The email address} 15 | 16 | \item{github}{The github handle} 17 | 18 | \item{orcid}{The orcid id} 19 | } 20 | \description{ 21 | Meta information on an author 22 | } 23 | \examples{ 24 | def_author( 25 | given = "Bob", 26 | family = "Dylan", 27 | email = "bob@dylan.com", 28 | github = "bobdylan", 29 | orcid = "0000-0003-1234-5678" 30 | ) 31 | 32 | } 33 | \keyword{create_ti_method} 34 | -------------------------------------------------------------------------------- /man/def_container.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_container} 4 | \alias{def_container} 5 | \title{Meta information on the container in which the wrapper resides} 6 | \usage{ 7 | def_container(docker, url = NULL) 8 | } 9 | \arguments{ 10 | \item{docker}{The handle of the docker container} 11 | 12 | \item{url}{An url of where the docker codebase resides (containing definition.yml, Dockerfile, ...)} 13 | } 14 | \description{ 15 | Meta information on the container in which the wrapper resides 16 | } 17 | \examples{ 18 | def_container( 19 | docker = "bobdylan/ti_some_method", 20 | url = "https://github.com/bobdylan/ti_some_method" 21 | ) 22 | } 23 | \keyword{create_ti_method} 24 | -------------------------------------------------------------------------------- /man/def_manuscript.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_manuscript} 4 | \alias{def_manuscript} 5 | \title{Meta information on the manuscript} 6 | \usage{ 7 | def_manuscript( 8 | doi = NULL, 9 | google_scholar_cluster_id = NULL, 10 | preprint_date = NULL, 11 | publication_date = NULL 12 | ) 13 | } 14 | \arguments{ 15 | \item{doi}{A doi identifier (not an url)} 16 | 17 | \item{google_scholar_cluster_id}{The google cluster id. Finding this id is a bit tricky; 18 | you need to find the manuscript on one of the author pages, and hover over the 'All X versions' button. 19 | Example: \href{https://goo.gl/Y9uLFs}{google scholar page}, \href{https://i.imgur.com/03eLCaO.png}{screenshot}.} 20 | 21 | \item{preprint_date}{Date of publication of the preprint (format: YYYY-MM-DD).} 22 | 23 | \item{publication_date}{Date of publication of the peer-reviewed manuscript (format: YYYY-MM-DD).} 24 | } 25 | \description{ 26 | Meta information on the manuscript 27 | } 28 | \examples{ 29 | def_manuscript( 30 | doi = "101010101/1101010101", 31 | google_scholar_cluster_id = "1010001010101111211", 32 | preprint_date = "1970-01-30", 33 | publication_date = "1970-01-31" 34 | ) 35 | } 36 | \keyword{create_ti_method} 37 | -------------------------------------------------------------------------------- /man/def_method.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_method} 4 | \alias{def_method} 5 | \title{Define meta information on the TI method.} 6 | \usage{ 7 | def_method( 8 | id, 9 | name = id, 10 | source = "tool", 11 | tool_id = NULL, 12 | platform = NULL, 13 | url = NULL, 14 | license = NULL, 15 | authors = list(), 16 | description = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{id}{An id by which to identify a method. Should only contain lowercase letters or underscores.} 21 | 22 | \item{name}{The name of the method.} 23 | 24 | \item{source}{The type of TI method. Options are : 25 | \itemize{ 26 | \item \code{"tool"}: a published TI method (peer-reviewed or preprint) (default), 27 | \item \code{"adaptation"}: an adaptation of a published method, 28 | \item \code{"offtheshelf"}: a method constructed from off-the-shelf algorithms, 29 | \item \code{"control"}: a control TI method (so not actually a TI method). 30 | }} 31 | 32 | \item{tool_id}{If there are multiple TI methods from the same toolkit, the name of the toolkit can be specified here.} 33 | 34 | \item{platform}{The platform the TI method uses (e.g. R, Python, C++, ...).} 35 | 36 | \item{url}{An URL to the codebase of the method.} 37 | 38 | \item{license}{The software license the method uses (e.g. GPL-3, BSD-3, Artistic-2.0, MIT).} 39 | 40 | \item{authors}{A list of authors (see example).} 41 | 42 | \item{description}{Additional information on the method} 43 | } 44 | \description{ 45 | Define meta information on the TI method. 46 | } 47 | \examples{ 48 | def_method( 49 | id = "some_method", 50 | name = "Some method <3", 51 | source = "tool", 52 | tool_id = "bobstoolkit", 53 | platform = "VBA", 54 | url = "https://github.com/bobdylan/singlecellvba", 55 | license = "GPL-3", 56 | authors = list( 57 | def_author( 58 | given = "Bob", 59 | family = "Dylan", 60 | email = "bob@dylan.com", 61 | github = "bobdylan", 62 | orcid = "0000-0003-1234-5678" 63 | ) 64 | ), 65 | description = "I love trajectories!!" 66 | ) 67 | } 68 | \keyword{create_ti_method} 69 | -------------------------------------------------------------------------------- /man/def_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_package} 4 | \alias{def_package} 5 | \title{Meta information on the package in which the TI function resides} 6 | \usage{ 7 | def_package(remote, name, function_name) 8 | } 9 | \arguments{ 10 | \item{remote}{The github repository handle} 11 | 12 | \item{name}{The name of the package} 13 | 14 | \item{function_name}{The name of the function} 15 | } 16 | \description{ 17 | Meta information on the package in which the TI function resides 18 | } 19 | \examples{ 20 | def_package( 21 | remote = "rcannood/SCORPIUS", 22 | name = "SCORPIUS", 23 | function_name = "ti_scorpius" 24 | ) 25 | } 26 | \keyword{create_ti_method} 27 | -------------------------------------------------------------------------------- /man/def_parameters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_parameters} 4 | \alias{def_parameters} 5 | \title{Meta information on the parameters of the TI method} 6 | \usage{ 7 | def_parameters(..., parameters = NULL, forbidden = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{Parameters to wrap in a parameter set.} 11 | 12 | \item{parameters}{A list of parameters to wrap in a parameter set.} 13 | 14 | \item{forbidden}{States forbidden region of parameter via a character vector, which will be turned into an expression.} 15 | } 16 | \description{ 17 | Parameters can be defined using \code{\link[dynparam:dynparam]{dynparam::dynparam()}}. 18 | } 19 | \examples{ 20 | library(dynparam) 21 | def_parameters( 22 | character_parameter(id = "method", default = "one", values = c("one", "two", "three")), 23 | integer_parameter( 24 | id = "ndim", 25 | default = 3L, 26 | distribution = uniform_distribution(lower = 2L, upper = 20L) 27 | ), 28 | numeric_parameter( 29 | id = "beta", 30 | default = 0.005, 31 | distribution = expuniform_distribution(lower = 1e-10, upper = 1) 32 | ) 33 | ) 34 | } 35 | \keyword{create_ti_method} 36 | -------------------------------------------------------------------------------- /man/def_wrapper.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{def_wrapper} 4 | \alias{def_wrapper} 5 | \title{Meta information on the wrapper} 6 | \usage{ 7 | def_wrapper( 8 | input_required, 9 | input_optional = character(), 10 | type = "trajectory", 11 | topology_inference = NULL, 12 | trajectory_types = character() 13 | ) 14 | } 15 | \arguments{ 16 | \item{input_required}{The required inputs for this method. See \code{dynwrap::allowed_inputs()}.} 17 | 18 | \item{input_optional}{Optional inputs for this method. See \code{dynwrap::allowed_inputs()}.} 19 | 20 | \item{type}{Which type of trajectory post-processing is used. Possible values: 21 | \code{"trajectory"} (default), \code{"linear_trajectory"}, \code{"cyclic_trajectory"}, \code{"branch_trajectory"}, 22 | \code{"cluster_graph"}, \code{"dimred_projection"}, \code{"end_state_probabilities"}, \code{"cell_graph"}.} 23 | 24 | \item{topology_inference}{Whether the topology is fixed (\code{"fixed"}), free (\code{"free"}), 25 | or fixed by a parameter provided to the algorithm (\code{"param"}).} 26 | 27 | \item{trajectory_types}{The possible trajectory types this method can return. Must be a subset of 28 | \code{c("cyclic", "linear", "bifurcation", "convergence", "multifurcation", "tree", "graph", "acyclic_graph", "disconnected_graph")}} 29 | } 30 | \description{ 31 | Meta information on the wrapper 32 | } 33 | \examples{ 34 | def_wrapper( 35 | input_required = c("expression", "start_id"), 36 | input_optional = "groups_n", 37 | type = "dimred_projection", 38 | trajectory_types = c("linear", "cyclic"), 39 | topology_inference = "free" 40 | ) 41 | } 42 | \keyword{create_ti_method} 43 | -------------------------------------------------------------------------------- /man/definition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{definition} 4 | \alias{definition} 5 | \alias{is_ti_method} 6 | \title{Create a definition} 7 | \usage{ 8 | definition( 9 | method, 10 | wrapper, 11 | manuscript = NULL, 12 | container = NULL, 13 | package = NULL, 14 | parameters = parameter_set() 15 | ) 16 | 17 | is_ti_method(method) 18 | } 19 | \arguments{ 20 | \item{method}{Meta information on the TI method (see \code{\link[=def_method]{def_method()}}).} 21 | 22 | \item{wrapper}{Meta information on the wrapper itself (see \code{\link[=def_wrapper]{def_wrapper()}}).} 23 | 24 | \item{manuscript}{Meta information on the manuscript, if applicable (see \code{\link[=def_manuscript]{def_manuscript()}}).} 25 | 26 | \item{container}{Meta information on the container in which the wrapper resides, if applicable (see \code{\link[=def_container]{def_container()}}).} 27 | 28 | \item{package}{Meta information on the package in which the wrapper resides, if applicable (see \code{\link[=def_package]{def_package()}}).} 29 | 30 | \item{parameters}{Meta information on the parameters of the TI method (see \code{\link[=def_parameters]{def_parameters()}}).} 31 | } 32 | \value{ 33 | A method definition 34 | } 35 | \description{ 36 | A definition contains meta information on a TI method and various aspects thereof. 37 | For brevity, the example only contains a minimum example, check the documentation 38 | of the \verb{def_*} helper functions for more extensive examples. 39 | } 40 | \examples{ 41 | library(dynparam) 42 | definition( 43 | method = def_method(id = "some_method"), 44 | wrapper = def_wrapper(input_required = "expression"), 45 | parameters = parameter_set( 46 | integer_parameter(id = "k", default = 5L, distribution = uniform_distribution(3L, 20L)) 47 | ) 48 | ) 49 | } 50 | \keyword{create_ti_method} 51 | -------------------------------------------------------------------------------- /man/dot-method_process_definition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{.method_process_definition} 4 | \alias{.method_process_definition} 5 | \title{Method process definition} 6 | \usage{ 7 | .method_process_definition(definition, return_function) 8 | } 9 | \arguments{ 10 | \item{definition}{A definition, see \code{\link[=definition]{definition()}}} 11 | 12 | \item{return_function}{Whether to return a function that allows you to override the default parameters, or just return the method meta data as is.} 13 | } 14 | \description{ 15 | Method process definition 16 | } 17 | \keyword{create_ti_method} 18 | -------------------------------------------------------------------------------- /man/dynwrap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{dynwrap} 5 | \alias{dynwrap} 6 | \title{Inferring and adapting single-cell trajectories} 7 | \description{ 8 | \figure{logo.png} 9 | } 10 | -------------------------------------------------------------------------------- /man/example_dataset.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{example_dataset} 5 | \alias{example_dataset} 6 | \title{Example dataset} 7 | \format{ 8 | An object of class \code{dynwrap::with_dimred} (inherits from \code{dynwrap::with_expression}, \code{dynwrap::data_wrapper}, \code{list}) of length 11. 9 | } 10 | \usage{ 11 | example_dataset 12 | } 13 | \description{ 14 | Example dataset 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/example_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{example_trajectory} 5 | \alias{example_trajectory} 6 | \title{Example trajectory} 7 | \format{ 8 | An object of class \code{dynwrap::with_dimred} (inherits from \code{dynwrap::with_cell_waypoints}, \code{dynwrap::with_prior}, \code{dynwrap::with_trajectory}, \code{dynwrap::with_dimred}, \code{dynwrap::with_expression}, \code{dynwrap::data_wrapper}, \code{list}) of length 21. 9 | } 10 | \usage{ 11 | example_trajectory 12 | } 13 | \description{ 14 | Example trajectory 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/figures/dependencies.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/man/figures/dependencies.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/overview_wrapping_v3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/man/figures/overview_wrapping_v3.png -------------------------------------------------------------------------------- /man/figures/trajectory_model.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/man/figures/trajectory_model.png -------------------------------------------------------------------------------- /man/flip_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adapt_orient_topology.R 3 | \name{flip_edges} 4 | \alias{flip_edges} 5 | \title{Flip a set of edges of the milestone network} 6 | \usage{ 7 | flip_edges(trajectory, milestone_network_toflip) 8 | } 9 | \arguments{ 10 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 11 | 12 | \item{milestone_network_toflip}{A dataframe with a from and to column, containing the subset of the milestone network #'} 13 | } 14 | \value{ 15 | A trajectory object 16 | } 17 | \description{ 18 | Note that this will remove associated roots, reroot the trajectory using \code{\link[=add_root]{add_root()}} 19 | } 20 | \keyword{adapt_trajectory} 21 | -------------------------------------------------------------------------------- /man/gather_cells_at_milestones.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_gather_cells_at_milestones.R 3 | \name{gather_cells_at_milestones} 4 | \alias{gather_cells_at_milestones} 5 | \title{Gather cells to their closest milestones} 6 | \usage{ 7 | gather_cells_at_milestones(trajectory) 8 | } 9 | \arguments{ 10 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 11 | } 12 | \value{ 13 | A trajectory where cells where moved to the closest milestone, the milestone_percentages and progressions will be adapated. 14 | } 15 | \description{ 16 | Cells will be moved to their closest milestones. 17 | } 18 | \examples{ 19 | trajectory <- example_trajectory 20 | trajectory <- gather_cells_at_milestones(trajectory) 21 | head(trajectory$milestone_percentages) 22 | 23 | } 24 | \keyword{adapt_trajectory} 25 | -------------------------------------------------------------------------------- /man/generate_parameter_documentation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_create_ti_method_r.R 3 | \name{generate_parameter_documentation} 4 | \alias{generate_parameter_documentation} 5 | \title{Generate the parameter documentation of a method, use with \verb{@eval}} 6 | \usage{ 7 | generate_parameter_documentation(definition) 8 | } 9 | \arguments{ 10 | \item{definition}{The definition which contain the parameters} 11 | } 12 | \value{ 13 | A character vector containing the roxygen tags 14 | } 15 | \description{ 16 | Generate the parameter documentation of a method, use with \verb{@eval} 17 | } 18 | -------------------------------------------------------------------------------- /man/get_default_parameters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_process_definition.R 3 | \name{get_default_parameters} 4 | \alias{get_default_parameters} 5 | \title{Get the default parameters of a method} 6 | \usage{ 7 | get_default_parameters(definition) 8 | } 9 | \arguments{ 10 | \item{definition}{A TI method description} 11 | } 12 | \description{ 13 | Get the default parameters of a method 14 | } 15 | \keyword{create_ti_method} 16 | -------------------------------------------------------------------------------- /man/get_ti_methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_get_ti_methods.R 3 | \name{get_ti_methods} 4 | \alias{get_ti_methods} 5 | \title{Return all TI that are installed in one or more packages} 6 | \usage{ 7 | get_ti_methods( 8 | method_ids = NULL, 9 | as_tibble = TRUE, 10 | ti_packages = ifelse(is_dynmethods_installed(), "dynmethods", "dynwrap"), 11 | evaluate = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{method_ids}{The method identifiers. NULL if listing all methods} 16 | 17 | \item{as_tibble}{Whether or not to return the ti_methods as a tibble} 18 | 19 | \item{ti_packages}{In which packages to look for TI methods. This will by default look into dynmethods if it is installed, otherwise in dynwrap.} 20 | 21 | \item{evaluate}{Whether to evaluate the functions} 22 | } 23 | \value{ 24 | A dataframe (or list if \code{as_tibble = FALSE}) containing the name (\emph{id}) of the TI method and the function (\emph{fun}) to load in the method. 25 | } 26 | \description{ 27 | Return all TI that are installed in one or more packages 28 | } 29 | \examples{ 30 | head(get_ti_methods()) 31 | 32 | } 33 | \keyword{infer_trajectory} 34 | -------------------------------------------------------------------------------- /man/group_from_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_grouping.R 3 | \name{group_from_trajectory} 4 | \alias{group_from_trajectory} 5 | \alias{group_onto_trajectory_edges} 6 | \alias{group_onto_nearest_milestones} 7 | \title{Create a grouping from a trajectory} 8 | \usage{ 9 | group_onto_trajectory_edges(trajectory, group_template = "{from}->{to}") 10 | 11 | group_onto_nearest_milestones(trajectory) 12 | } 13 | \arguments{ 14 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 15 | 16 | \item{group_template}{Processed by glue::glue to name the group} 17 | } 18 | \description{ 19 | Grouping cells onto their edges, or grouping cells onto their nearest milestones 20 | } 21 | \keyword{derive_trajectory} 22 | -------------------------------------------------------------------------------- /man/label_milestones.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_label_milestones.R 3 | \name{label_milestones} 4 | \alias{label_milestones} 5 | \alias{label_milestones_markers} 6 | \alias{is_wrapper_with_milestone_labelling} 7 | \alias{get_milestone_labelling} 8 | \title{Label milestones either manually (\code{label_milestones}) or using marker genes (\code{label_milestones_markers})} 9 | \usage{ 10 | label_milestones(trajectory, labelling) 11 | 12 | label_milestones_markers( 13 | trajectory, 14 | markers, 15 | expression_source = "expression", 16 | n_nearest_cells = 20 17 | ) 18 | 19 | is_wrapper_with_milestone_labelling(trajectory) 20 | 21 | get_milestone_labelling(trajectory, label_milestones = NULL) 22 | } 23 | \arguments{ 24 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 25 | 26 | \item{labelling}{Named character vector containing for a milestone a new label} 27 | 28 | \item{markers}{List containing for each label a list of marker genes} 29 | 30 | \item{expression_source}{The expression source} 31 | 32 | \item{n_nearest_cells}{The number of nearest cells to use for extracting milestone expression} 33 | 34 | \item{label_milestones}{How to label the milestones. Can be TRUE (in which case the labels within the trajectory will be used), "all" (in which case both given labels and milestone_ids will be used), a named character vector, or FALSE} 35 | } 36 | \value{ 37 | \strong{\code{label_milestones}}: A trajectory object with \emph{milestone_labelling}, a named vector where milestone identifiers are mapped to their labels 38 | 39 | \strong{\code{get_milestone_labelling}}: A named vector giving a mapping between milestones and their labels. If certain milestones were not given a label, this vector will give the identifiers themselves. 40 | } 41 | \description{ 42 | \code{label_milestones} can be used to manually assign labels to a milestone using their identifiers 43 | } 44 | \details{ 45 | \code{label_milestones_markers} will assign a label to a milestone if its marker profile most closely resembles a given profile 46 | } 47 | \examples{ 48 | trajectory <- example_trajectory 49 | 50 | # manual labelling 51 | trajectory <- label_milestones( 52 | trajectory, 53 | labelling = c("milestone_begin" = "Let's go") 54 | ) 55 | get_milestone_labelling(trajectory) 56 | 57 | # marker gene labelling 58 | trajectory <- label_milestones_markers( 59 | trajectory, 60 | markers = list(A_high = "A") 61 | ) 62 | get_milestone_labelling(trajectory) 63 | 64 | is_wrapper_with_milestone_labelling(trajectory) 65 | 66 | } 67 | \keyword{adapt_trajectory} 68 | -------------------------------------------------------------------------------- /man/prior_usages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{prior_usages} 5 | \alias{prior_usages} 6 | \title{Metadata on prior usages} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 3 rows and 2 columns. 9 | } 10 | \usage{ 11 | prior_usages 12 | } 13 | \description{ 14 | Metadata on prior usages 15 | } 16 | \examples{ 17 | prior_usages 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /man/priors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{priors} 5 | \alias{priors} 6 | \title{Metadata on priors} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 13 rows and 6 columns. 9 | } 10 | \usage{ 11 | priors 12 | } 13 | \description{ 14 | Metadata on priors 15 | } 16 | \examples{ 17 | priors 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /man/project_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/project_waypoints.R 3 | \name{project_trajectory} 4 | \alias{project_trajectory} 5 | \alias{project_milestones} 6 | \title{Project a trajectory onto a dimensionality reduction} 7 | \usage{ 8 | project_trajectory( 9 | trajectory, 10 | dimred, 11 | waypoints = select_waypoints(trajectory), 12 | trajectory_projection_sd = sum(trajectory$milestone_network$length) * 0.05 13 | ) 14 | 15 | project_milestones( 16 | trajectory, 17 | dimred, 18 | trajectory_projection_sd = sum(trajectory$milestone_network$length) * 0.05 19 | ) 20 | } 21 | \arguments{ 22 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 23 | 24 | \item{dimred}{The dimensionality reduction of the cells. A matrix with the positions of cells (rows) in the dimensions (columns)} 25 | 26 | \item{waypoints}{A set of waypoints, which can be created by \code{\link[=add_waypoints]{select_waypoints()}}. It is a list containing: 27 | \itemize{ 28 | \item \code{waypoints}: a dataframe containing in the very least the waypoint_id 29 | \item \code{milestone_percentages}: the positions of waypoints withing the trajectory 30 | \item \code{geodesic_distances}: matrix with precalculated geodesic distances between waypoints (rows) and cells (columns), optional 31 | }} 32 | 33 | \item{trajectory_projection_sd}{The standard deviation of the gaussian kernel} 34 | } 35 | \value{ 36 | A list containing 37 | \itemize{ 38 | \item \emph{dimred_segment_points}: The dimensionality reduction of a set of points along the trajectory. A matrix with the position of points (rows) in the dimensions (columns) 39 | \item \emph{dimred_segment_progressions} The progressions of the points. A dataframe containing the \emph{from} and \emph{to} milestones, and their \emph{progression}. Has the same number of rows as \emph{dimred_segment_points} 40 | \item \emph{dimred_milestones}: The dimensionality reduction of the milestones. A matrix with the position of milestones (rows) in the dimensions (columns) 41 | } 42 | 43 | These objects can be given to \code{\link[=add_dimred]{add_dimred()}} 44 | } 45 | \description{ 46 | Project a trajectory onto a dimensionality reduction 47 | } 48 | \seealso{ 49 | \code{\link[=add_dimred]{add_dimred()}} 50 | } 51 | -------------------------------------------------------------------------------- /man/project_waypoints.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/project_waypoints.R 3 | \name{project_waypoints} 4 | \alias{project_waypoints} 5 | \title{Project waypoints of a trajectory (e.g. milestones) into a space defined by cells (e.g. expression or a dimensionality reduction)} 6 | \usage{ 7 | project_waypoints( 8 | trajectory, 9 | space, 10 | waypoints = select_waypoints(trajectory), 11 | trajectory_projection_sd = sum(trajectory$milestone_network$length) * 0.05 12 | ) 13 | } 14 | \arguments{ 15 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 16 | 17 | \item{space}{A matrix with cells in rows and different dimensions in the columns. This is typically an expression matrix or a dimensionality reduction} 18 | 19 | \item{waypoints}{A set of waypoints, which can be created by \code{\link[=add_waypoints]{select_waypoints()}}. It is a list containing: 20 | \itemize{ 21 | \item \code{waypoints}: a dataframe containing in the very least the waypoint_id 22 | \item \code{milestone_percentages}: the positions of waypoints withing the trajectory 23 | \item \code{geodesic_distances}: matrix with precalculated geodesic distances between waypoints (rows) and cells (columns), optional 24 | }} 25 | 26 | \item{trajectory_projection_sd}{The standard deviation of the gaussian kernel} 27 | } 28 | \value{ 29 | A matrix in which the waypoints (rows) were projected into a new space defined by the same number of dimensions (columns) as in the \code{space} argument 30 | } 31 | \description{ 32 | This will first calculate the geodesic distance of each cell to the waypoint. This distance is used as a weight 33 | } 34 | -------------------------------------------------------------------------------- /man/random_seed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method_infer_trajectory.R 3 | \name{random_seed} 4 | \alias{random_seed} 5 | \title{Generate a random seed} 6 | \usage{ 7 | random_seed() 8 | } 9 | \value{ 10 | A random seed 11 | } 12 | \description{ 13 | From the current seed. 14 | } 15 | \examples{ 16 | random_seed() 17 | 18 | } 19 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reexport.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{test_docker_installation} 7 | \alias{test_singularity_installation} 8 | \alias{create_config} 9 | \alias{create_docker_config} 10 | \alias{create_singularity_config} 11 | \alias{get_default_config} 12 | \alias{set_default_config} 13 | \alias{test_h5_installation} 14 | \title{Objects exported from other packages} 15 | \keyword{internal} 16 | \description{ 17 | These objects are imported from other packages. Follow the links 18 | below to see their documentation. 19 | 20 | \describe{ 21 | \item{babelwhale}{\code{\link[babelwhale]{create_config}}, \code{\link[babelwhale:create_config]{create_docker_config}}, \code{\link[babelwhale:create_config]{create_singularity_config}}, \code{\link[babelwhale:create_config]{get_default_config}}, \code{\link[babelwhale:create_config]{set_default_config}}, \code{\link[babelwhale]{test_docker_installation}}, \code{\link[babelwhale]{test_singularity_installation}}} 22 | 23 | \item{dynutils}{\code{\link[dynutils]{test_h5_installation}}} 24 | }} 25 | 26 | -------------------------------------------------------------------------------- /man/simplify_igraph_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simplify_igraph_network.R 3 | \name{simplify_igraph_network} 4 | \alias{simplify_igraph_network} 5 | \title{Simplify an igraph network such that consecutive linear edges are removed} 6 | \usage{ 7 | simplify_igraph_network( 8 | gr, 9 | allow_duplicated_edges = TRUE, 10 | allow_self_loops = TRUE, 11 | force_keep = NULL, 12 | edge_points = NULL 13 | ) 14 | } 15 | \arguments{ 16 | \item{gr}{An igraph object, see \code{\link[igraph:make_graph]{igraph::graph()}}} 17 | 18 | \item{allow_duplicated_edges}{Whether or not to allow duplicated edges between nodes.} 19 | 20 | \item{allow_self_loops}{Whether or not to allow self loops.} 21 | 22 | \item{force_keep}{Nodes that will not be removed under any condition} 23 | 24 | \item{edge_points}{Points that are on edges} 25 | } 26 | \value{ 27 | An igraph object, or a list with an igraph object and a data frame with edge points 28 | } 29 | \description{ 30 | \itemize{ 31 | \item Nodes with degree 2 (or indegree 1 and outdegree 1) are removed: A -> B -> C becomes A -> C 32 | \item Cycles contain at least 3 nodes, ie. A -> B -> A becomes A -> B -> C -> A 33 | \item Loops are converted to a cycle, unless \code{allow_self_loops = TRUE} 34 | \item Duplicated edges are removed, unless \code{allow_duplcated_edges = FALSE} 35 | } 36 | } 37 | \examples{ 38 | net <- data.frame( 39 | from = 1:2, 40 | to = 2:3, 41 | length = 1, 42 | directed = TRUE, 43 | stringsAsFactors = F 44 | ) 45 | gr <- igraph::graph_from_data_frame(net) 46 | simplify_igraph_network(gr) 47 | 48 | net <- data.frame( 49 | from = c(1, 2, 3, 1), 50 | to = c(2, 3, 1, 4), 51 | length = 1, 52 | directed = TRUE, 53 | stringsAsFactors = F 54 | ) 55 | gr <- igraph::graph_from_data_frame(net) 56 | simplify_igraph_network(gr) 57 | 58 | net <- data.frame( 59 | from = c(1, 2, 3, 4), 60 | to = c(2, 3, 1, 5), 61 | length = 1, 62 | directed = TRUE, 63 | stringsAsFactors = F 64 | ) 65 | gr <- igraph::graph_from_data_frame(net) 66 | simplify_igraph_network(gr) 67 | } 68 | -------------------------------------------------------------------------------- /man/simplify_trajectory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simplify_trajectory.R 3 | \name{simplify_trajectory} 4 | \alias{simplify_trajectory} 5 | \title{Simplify a trajectory by removing transient milestones} 6 | \usage{ 7 | simplify_trajectory(trajectory, allow_self_loops = FALSE) 8 | } 9 | \arguments{ 10 | \item{trajectory}{The trajectory as created by \code{\link[=infer_trajectory]{infer_trajectory()}} or \code{\link[=add_trajectory]{add_trajectory()}}} 11 | 12 | \item{allow_self_loops}{Whether or not to allow self loops.} 13 | } 14 | \value{ 15 | A trajectory object 16 | } 17 | \description{ 18 | \itemize{ 19 | \item Milestones that are not a leaf or a branching point are removed: A -> B -> C becomes A -> C 20 | \item Cycles contain at least 3 nodes, ie. A -> B -> A becomes A -> B -> C -> A 21 | \item Loops are converted to a cycle, unless \code{allow_self_loops = TRUE} 22 | } 23 | } 24 | \details{ 25 | The positions of the cells within the trajectory remain the same. 26 | } 27 | \keyword{adapt_trajectory} 28 | -------------------------------------------------------------------------------- /man/trajectory_type_dag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{trajectory_type_dag} 5 | \alias{trajectory_type_dag} 6 | \title{A DAG connecting different trajectory types} 7 | \format{ 8 | An object of class \code{tbl_graph} (inherits from \code{igraph}) of length 9. 9 | } 10 | \usage{ 11 | trajectory_type_dag 12 | } 13 | \description{ 14 | A DAG connecting different trajectory types 15 | } 16 | \examples{ 17 | trajectory_type_dag 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /man/trajectory_types.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{trajectory_types} 5 | \alias{trajectory_types} 6 | \title{Metadata on the trajectory types} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 9 rows and 6 columns. 9 | } 10 | \usage{ 11 | trajectory_types 12 | } 13 | \description{ 14 | Metadata on the trajectory types 15 | } 16 | \examples{ 17 | trajectory_types 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /man/wrap_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_data.R 3 | \name{wrap_data} 4 | \alias{wrap_data} 5 | \alias{is_data_wrapper} 6 | \title{A data wrapper for datasets and trajectories} 7 | \usage{ 8 | wrap_data( 9 | id = NULL, 10 | cell_ids, 11 | cell_info = NULL, 12 | feature_ids = NULL, 13 | feature_info = NULL, 14 | ... 15 | ) 16 | 17 | is_data_wrapper(dataset) 18 | } 19 | \arguments{ 20 | \item{id}{A unique identifier for the data. If \code{NULL}, a random string will be generated.} 21 | 22 | \item{cell_ids}{The identifiers of the cells.} 23 | 24 | \item{cell_info}{Optional meta-information pertaining the cells.} 25 | 26 | \item{feature_ids}{The identifiers of the features.} 27 | 28 | \item{feature_info}{Optional meta-information pertaining the features.} 29 | 30 | \item{...}{Extra information to be stored in the wrapper.} 31 | 32 | \item{dataset}{A dataset created by \code{\link[=wrap_data]{wrap_data()}} or \code{\link[=wrap_expression]{wrap_expression()}}} 33 | } 34 | \value{ 35 | A list containing \emph{id}, \emph{cell_ids} and \emph{cell_info} (if specified) 36 | } 37 | \description{ 38 | A data wrapper for datasets and trajectories 39 | } 40 | \examples{ 41 | dataset <- wrap_data( 42 | cell_ids = c("A", "B", "C") 43 | ) 44 | dataset$cell_ids 45 | } 46 | \keyword{create_trajectory} 47 | -------------------------------------------------------------------------------- /man/wrap_expression.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrap_add_expression.R 3 | \name{wrap_expression} 4 | \alias{wrap_expression} 5 | \title{Create a wrapper object with expression and counts} 6 | \usage{ 7 | wrap_expression( 8 | id = NULL, 9 | expression, 10 | counts, 11 | cell_info = NULL, 12 | feature_info = NULL, 13 | expression_future = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{id}{A unique identifier for the data. If \code{NULL}, a random string will be generated.} 19 | 20 | \item{expression}{The normalised expression values of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 21 | 22 | \item{counts}{The counts values of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 23 | 24 | \item{cell_info}{Optional meta-information pertaining the cells.} 25 | 26 | \item{feature_info}{Optional meta-information of the features, a dataframe with at least \emph{feature_id} as column} 27 | 28 | \item{expression_future}{Projected expression using RNA velocity of genes (columns) within cells (rows). This can be both a dense and sparse matrix.} 29 | 30 | \item{...}{extra information to be stored in the dataset} 31 | } 32 | \description{ 33 | Projected expression based on RNA velocity can also be added to the wrapper through the \code{expression_future} argument 34 | } 35 | \details{ 36 | Information about the cells and/or features can be added through \code{cell_info} and \code{feature_info} 37 | } 38 | \examples{ 39 | dataset <- wrap_expression( 40 | counts = example_dataset$counts, 41 | expression = example_dataset$expression, 42 | expression_future = example_dataset$expression_future 43 | ) 44 | 45 | dataset$counts[1:10, 1:3] 46 | dataset$expression[1:10, 1:3] 47 | dataset$expression_future[1:10, 1:3] 48 | 49 | } 50 | \keyword{infer_trajectory} 51 | -------------------------------------------------------------------------------- /man/wrapper_types.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{wrapper_types} 5 | \alias{wrapper_types} 6 | \title{Metadata on wrapper types} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 7 rows and 4 columns. 9 | } 10 | \usage{ 11 | wrapper_types 12 | } 13 | \description{ 14 | Metadata on wrapper types 15 | } 16 | \examples{ 17 | wrapper_types 18 | 19 | } 20 | \keyword{create_ti_method} 21 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:-----------------------------------------------------------| 5 | |version |R version 4.2.2 (2022-10-31) | 6 | |os |Fedora Linux 37 (Workstation Edition) | 7 | |system |x86_64, linux-gnu | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_GB.UTF-8 | 11 | |ctype |en_GB.UTF-8 | 12 | |tz |Europe/Brussels | 13 | |date |2023-03-01 | 14 | |rstudio |2022.12.0+353 Elsbeth Geranium (desktop) | 15 | |pandoc |2.14.0.3 @ /usr/libexec/rstudio/bin/pandoc/ (via rmarkdown) | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:-------------|:------|:----------|:--| 21 | |dynwrap |1.2.2 |1.2.3 |* | 22 | |babelwhale |1.1.0 |1.1.0 | | 23 | |carrier |0.1.0 |0.1.0 | | 24 | |cli |NA |3.6.0 |* | 25 | |cpp11 |0.4.3 |0.4.3 | | 26 | |digest |NA |0.6.31 |* | 27 | |dplyr |NA |1.1.0 |* | 28 | |dynparam |1.0.2 |1.0.2 | | 29 | |dynutils |1.0.11 |1.0.11 | | 30 | |fansi |NA |1.0.4 |* | 31 | |fs |1.6.1 |1.6.1 | | 32 | |igraph |NA |1.4.1 |* | 33 | |lobstr |1.1.2 |1.1.2 | | 34 | |plyr |1.8.8 |1.8.8 | | 35 | |prettyunits |1.1.1 |1.1.1 | | 36 | |progress |NA |1.2.2 |* | 37 | |pryr |0.1.6 |0.1.6 | | 38 | |purrr |NA |1.0.1 |* | 39 | |Rcpp |NA |1.0.10 |* | 40 | |RcppArmadillo |NA |0.12.0.1.0 |* | 41 | |RcppParallel |NA |5.1.7 |* | 42 | |readr |NA |2.1.4 |* | 43 | |reshape2 |1.4.4 |1.4.4 | | 44 | |stringi |NA |1.7.12 |* | 45 | |stringr |NA |1.5.0 |* | 46 | |tidyr |NA |1.3.0 |* | 47 | |utf8 |NA |1.2.3 |* | 48 | |vctrs |NA |0.5.2 |* | 49 | |vroom |NA |1.6.1 |* | 50 | |yaml |NA |2.3.7 |* | 51 | 52 | # Revdeps 53 | 54 | ## New problems (1) 55 | 56 | |package |version |error |warning |note | 57 | |:----------|:-------|:-----|:-------|:------| 58 | |[dynfeature](problems.md#dynfeature)|1.0.0 |-1 | |__+1__ | 59 | 60 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 4 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 1 new problems 6 | * We failed to check 0 packages 7 | 8 | Issues with CRAN packages are summarised below. 9 | 10 | ### New problems 11 | (This reports the first line of each new failure) 12 | 13 | * dynfeature 14 | checking dependencies in R code ... NOTE 15 | 16 | -------------------------------------------------------------------------------- /revdep/email.yml: -------------------------------------------------------------------------------- 1 | release_date: ??? 2 | rel_release_date: ??? 3 | my_news_url: ??? 4 | release_version: ??? 5 | release_details: ??? 6 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | # dynfeature 2 | 3 |
4 | 5 | * Version: 1.0.0 6 | * GitHub: NA 7 | * Source code: https://github.com/cran/dynfeature 8 | * Date/Publication: 2021-06-14 07:30:12 UTC 9 | * Number of recursive dependencies: 123 10 | 11 | Run `revdepcheck::revdep_details(, "dynfeature")` for more info 12 | 13 |
14 | 15 | ## Newly broken 16 | 17 | * checking dependencies in R code ... NOTE 18 | ``` 19 | Namespace in Imports field not imported from: ‘magrittr’ 20 | All declared Imports should be used. 21 | ``` 22 | 23 | ## Newly fixed 24 | 25 | * checking whether package ‘dynfeature’ can be installed ... ERROR 26 | ``` 27 | Installation failed. 28 | See ‘/home/rcannood/workspace/vib/dynwrap/revdep/checks/dynfeature/old/dynfeature.Rcheck/00install.out’ for details. 29 | ``` 30 | 31 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(dynwrap) 3 | 4 | test_check("dynwrap") 5 | 6 | -------------------------------------------------------------------------------- /tests/testthat/nothelper-methods.R: -------------------------------------------------------------------------------- 1 | root <- pkgload:::shim_system.file("tests/testthat/", package = "dynwrap") 2 | for (file in list.files(root, full.names = TRUE, pattern = "helper-ti_")) { 3 | source(file) 4 | } 5 | -------------------------------------------------------------------------------- /tests/testthat/test-adapt_orient_topology.R: -------------------------------------------------------------------------------- 1 | context("Testing orientation of trajectories") 2 | 3 | test_that("flip_edges works correctly", { 4 | cell_ids <- c("a", "b", "c", "d", "e") 5 | 6 | milestone_network <- tibble::tribble( 7 | ~from, ~to, ~length, ~directed, 8 | "B", "A", 1, TRUE, 9 | "B", "C", 1, TRUE 10 | ) 11 | progressions <- tibble::tribble( 12 | ~cell_id, ~from, ~to, ~percentage, 13 | "a", "B", "A", 1, 14 | "b", "B", "A", 0.5, 15 | "c", "B", "A", 0, 16 | "d", "B", "C", 0.5, 17 | "e", "B", "C", 1 18 | ) 19 | 20 | trajectory <- wrap_data( 21 | cell_ids = cell_ids 22 | ) %>% 23 | add_trajectory(milestone_network = milestone_network, progressions = progressions) 24 | 25 | trajectory$dimred_segment_progressions <- tribble( 26 | ~from, ~to, ~percentage, 27 | "B", "A", 0, 28 | "B", "C", 1 29 | ) 30 | 31 | trajectory_flipped <- flip_edges(trajectory, milestone_network %>% filter(from == "B", to == "A")) 32 | 33 | expect_true(all( 34 | c("A->B", "B->C") %in% 35 | paste0(trajectory_flipped$milestone_network$from, "->", trajectory_flipped$milestone_network$to)) 36 | ) 37 | expect_false(all( 38 | c("B->A", "C->B") %in% 39 | paste0(trajectory_flipped$milestone_network$from, "->", trajectory_flipped$milestone_network$to)) 40 | ) 41 | 42 | expect_true( 43 | all(trajectory_flipped$dimred_segment_progressions$percentage == 1) 44 | ) 45 | }) 46 | 47 | 48 | 49 | 50 | test_that("orient_topology_to_velocity orients a linear trajectory correctly", { 51 | # we'll use a simple linear trajectory 52 | cell_ids <- c("a", "b", "c", "d", "e") 53 | pseudotime <- setNames(seq_along(cell_ids), cell_ids) 54 | expression <- as.matrix(data.frame( 55 | a = pseudotime, 56 | b = pseudotime ** 2, 57 | c = log(pseudotime) 58 | )) 59 | expression_future <- as.matrix(data.frame( 60 | a = (pseudotime + 1), 61 | b = (pseudotime + 1) ** 2, 62 | c = log(pseudotime + 1) 63 | )) 64 | 65 | # the milestone network is "wrong" in the sense that B and A are wrongly oriented 66 | milestone_network <- tibble::tribble( 67 | ~from, ~to, ~length, ~directed, 68 | "B", "A", 1, TRUE, 69 | "B", "C", 1, TRUE 70 | ) 71 | progressions <- tibble::tribble( 72 | ~cell_id, ~from, ~to, ~percentage, 73 | "a", "B", "A", 1, 74 | "b", "B", "A", 0.5, 75 | "c", "B", "A", 0, 76 | "d", "B", "C", 0.5, 77 | "e", "B", "C", 1 78 | ) 79 | 80 | trajectory <- wrap_expression( 81 | counts = expression, 82 | expression = expression, 83 | expression_future = expression_future 84 | ) %>% 85 | add_trajectory(milestone_network = milestone_network, progressions = progressions) 86 | 87 | # TODO: move to scvelo package or re-enable this part of the test? 88 | # # orient the trajectory 89 | # trajectory_oriented <- dynwrap::orient_topology_to_velocity(trajectory) 90 | # 91 | # # make sure the first edge is correctly oriented 92 | # expect_true("A->B" %in% paste0(trajectory_oriented$milestone_network$from, "->", trajectory_oriented$milestone_network$to)) 93 | # expect_false("B->A" %in% paste0(trajectory_oriented$milestone_network$from, "->", trajectory_oriented$milestone_network$to)) 94 | }) 95 | -------------------------------------------------------------------------------- /tests/testthat/test-calculate_average.R: -------------------------------------------------------------------------------- 1 | context("Testing calculate_average_by_group") 2 | 3 | x <- matrix(seq_len(100), ncol = 10) 4 | rownames(x) <- paste0("C", seq_len(nrow(x))) 5 | colnames(x) <- paste0("G", seq_len(ncol(x))) 6 | cell_grouping <- tibble( 7 | cell_id = rownames(x), 8 | group_id = c(rep("M1", 5), rep("M2", 5)) 9 | ) 10 | 11 | group_ids <- c("M1", "M2") 12 | 13 | test_that("Testing function", { 14 | x_grouped <- calculate_average_by_group(x, cell_grouping) 15 | expect_equal(nrow(x_grouped), 2) 16 | expect_equal(ncol(x_grouped), 10) 17 | expect_equal(rownames(x_grouped), group_ids) 18 | expect_equal(colnames(x_grouped), colnames(x)) 19 | expect_equal(as.vector(x_grouped), as.vector(rbind(colMeans(x[1:5,]), colMeans(x[6:10,])))) 20 | }) 21 | 22 | test_that("Testing edge cases", { 23 | x_grouped <- calculate_average_by_group(x["C1", , drop = FALSE], cell_grouping %>% filter(cell_id == "C1")) 24 | expect_equal(nrow(x_grouped), 1) 25 | expect_equal(ncol(x_grouped), 10) 26 | expect_equal(rownames(x_grouped), group_ids[[1]]) 27 | expect_equal(colnames(x_grouped), colnames(x)) 28 | 29 | x_grouped <- calculate_average_by_group(x[, "G1", drop = FALSE], cell_grouping) 30 | expect_equal(nrow(x_grouped), 2) 31 | expect_equal(ncol(x_grouped), 1) 32 | expect_equal(rownames(x_grouped), group_ids) 33 | expect_equal(colnames(x_grouped), colnames(x)[[1]]) 34 | 35 | x_grouped <- calculate_average_by_group(x, tibble(cell_id = rownames(x), group_id = "M1")) 36 | expect_equal(nrow(x_grouped), 1) 37 | expect_equal(ncol(x_grouped), 10) 38 | expect_equal(rownames(x_grouped), "M1") 39 | expect_equal(colnames(x_grouped), colnames(x)) 40 | 41 | x_grouped <- calculate_average_by_group(x["C1", "G1", drop = FALSE], tibble(cell_id = "C1", group_id = "M1")) 42 | expect_equal(nrow(x_grouped), 1) 43 | expect_equal(ncol(x_grouped), 1) 44 | expect_equal(rownames(x_grouped), "M1") 45 | expect_equal(colnames(x_grouped), "G1") 46 | }) 47 | -------------------------------------------------------------------------------- /tests/testthat/test-calculate_trajectory_dimred.R: -------------------------------------------------------------------------------- 1 | context("Testing calculate_trajectory_dimred") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | 6 | milestone_ids <- c("man", "in", "possession", "of", "good", "fortune", "must") 7 | milestone_network <- tribble( 8 | ~from, ~to, ~length, ~directed, 9 | "man", "in", 1, TRUE, 10 | "in", "possession", 2, TRUE, 11 | "in", "of", 3, TRUE, 12 | "possession", "good", 4, TRUE, 13 | "of", "fortune", 5, TRUE, 14 | "good", "must", 6, TRUE, 15 | "fortune", "must", 7, TRUE 16 | ) 17 | milestone_percentages <- tribble( 18 | ~cell_id, ~milestone_id, ~percentage, 19 | "truth", "man", .8, 20 | "truth", "in", .2, 21 | "universally", "in", .3, 22 | "universally", "possession", .2, 23 | "universally", "of", .5, 24 | "acknowledged", "possession", 0, 25 | "acknowledged", "good", 1, 26 | "that", "good", .5, 27 | "that", "must", .5, 28 | "a", "good", .9, 29 | "a", "must", .1, 30 | "single", "fortune", .6, 31 | "single", "must", .4 32 | ) 33 | divergence_regions <- tribble( 34 | ~divergence_id, ~milestone_id, ~is_start, 35 | "be", "in", TRUE, 36 | "be", "possession", FALSE, 37 | "be", "of", FALSE 38 | ) 39 | 40 | trajectory <- wrap_data( 41 | id = id, 42 | cell_ids = cell_ids 43 | ) %>% add_trajectory( 44 | milestone_network = milestone_network, 45 | divergence_regions = divergence_regions, 46 | milestone_percentages = milestone_percentages 47 | ) 48 | 49 | test_that("calculate_trajectory_dimred output format is correct", { 50 | dimred <- calculate_trajectory_dimred(trajectory) 51 | 52 | expect_equal(sort(names(dimred)), c("cell_positions", "divergence_edge_positions", "divergence_polygon_positions", "edge_positions", "milestone_positions")) 53 | 54 | edge_positions <- dimred$edge_positions 55 | expect_equal(colnames(edge_positions), c("from", "to", "length", "directed", "comp_1_from", "comp_2_from", "comp_1_to", "comp_2_to")) 56 | join_check <- edge_positions %>% inner_join(milestone_network, by = c("from", "to")) 57 | expect_equal(join_check$length.x, join_check$length.y) 58 | 59 | milestone_positions <- dimred$milestone_positions 60 | expect_equal(colnames(milestone_positions), c("milestone_id", "comp_1", "comp_2")) 61 | expect_true(all(milestone_ids %in% milestone_positions$milestone_id)) 62 | 63 | cell_positions <- dimred$cell_positions 64 | expect_equal(colnames(cell_positions), c("cell_id", "comp_1", "comp_2")) 65 | expect_true(all(cell_ids %in% cell_positions$cell_id)) 66 | 67 | divergence_edge_positions <- dimred$divergence_edge_positions 68 | expect_equal(colnames(divergence_edge_positions), c("from", "to", "comp_1_from", "comp_2_from", "comp_1_to", "comp_2_to")) 69 | 70 | divergence_polygon_positions <- dimred$divergence_polygon_positions 71 | expect_equal(colnames(divergence_polygon_positions), c("triangle_id", "triangle_part", "milestone_id", "comp_1", "comp_2")) 72 | }) 73 | -------------------------------------------------------------------------------- /tests/testthat/test-method_create_ti_method_container.R: -------------------------------------------------------------------------------- 1 | context("Testing create_ti_method_container") 2 | 3 | skip_on_appveyor() 4 | skip_on_os("mac") 5 | skip_on_cran() 6 | 7 | tags <- c("dynwrapr_tester:latest") # "dynwrappy_tester:v0.1.0" 8 | 9 | # get example dataset 10 | data("example_dataset") 11 | dataset <- example_dataset 12 | dataset_na <- dataset 13 | dataset_na$counts <- dataset_na$expression <- dataset$expression * NA 14 | 15 | for (tag in tags) { 16 | test_that(paste0("Testing create_ti_method_container and infer_trajectory with ", tag), { 17 | container_id <- paste0("dynverse/", tag) 18 | method <- create_ti_method_container(container_id = container_id, return_function = FALSE) 19 | 20 | expect_equal(method$run$backend, "container") 21 | expect_equal(method$run$container_id, container_id) 22 | 23 | trajectory0 <- infer_trajectory(dataset, method, parameters = list()) 24 | expect_true(is_wrapper_with_trajectory(trajectory0)) 25 | 26 | expect_output({ 27 | trajectory1 <- infer_trajectory(dataset, method, parameters = list(verbose = TRUE), verbose = TRUE) 28 | expect_true(is_wrapper_with_trajectory(trajectory1)) 29 | }) 30 | 31 | expect_error( 32 | infer_trajectory(dataset_na, method), 33 | regexp = "Error produced in dynwrap input/output" 34 | ) 35 | }) 36 | } 37 | 38 | -------------------------------------------------------------------------------- /tests/testthat/test-method_create_ti_method_r.R: -------------------------------------------------------------------------------- 1 | context("Testing create_ti_method_r") 2 | 3 | dummy_definition <- definition( 4 | method = def_method( 5 | id = "dummy" 6 | ), 7 | parameters = dynparam::parameter_set( 8 | dynparam::character_parameter( 9 | id = "fruit", 10 | default = "banana", 11 | values = c("apple", "banana", "cherry") 12 | ) 13 | ), 14 | wrapper = def_wrapper( 15 | input_required = "expression", 16 | input_optional = "start_id" 17 | ) 18 | ) 19 | 20 | dummy_run_fun = function(counts, parameters) { 21 | wrap_data( 22 | cell_ids = parameters$fruit 23 | ) %>% 24 | add_linear_trajectory( 25 | pseudotime = set_names(0, parameters$fruit) 26 | ) 27 | } 28 | 29 | 30 | dummy <- create_ti_method_r( 31 | dummy_definition, 32 | dummy_run_fun, 33 | package_loaded = "dynwrap", 34 | package_required = "dplyr", 35 | return_function = TRUE 36 | ) 37 | 38 | dummy_instance <- dummy() 39 | 40 | dataset <- 41 | wrap_data(cell_ids = "a") %>% 42 | add_linear_trajectory(pseudotime = c(a = 1)) %>% 43 | add_expression( 44 | counts = matrix(0:1, ncol = 2, dimnames = list("a", c("A", "B"))), 45 | expression = matrix(0:1, ncol = 2, dimnames = list("a", c("A", "B"))) 46 | ) 47 | 48 | test_that("Testing simple create ti function", { 49 | expect_equal( dummy_instance$method$name, "dummy" ) 50 | expect_equal( dummy_instance$method$id, "dummy" ) 51 | expect_equal( dummy_instance$run$package_loaded, "dynwrap" ) 52 | expect_equal( dummy_instance$run$package_required, "dplyr" ) 53 | expect_is( dummy_instance$parameters, "parameter_set" ) 54 | expect_is( dummy_instance$run$run_fun, "function" ) 55 | 56 | expect_equal(get_default_parameters(dummy_instance)$fruit, "banana") 57 | }) 58 | 59 | test_that("dummy method is able to correctly pass default argument", { 60 | expect_equal( infer_trajectory(dataset, dummy_instance)$cell_ids, "banana" ) 61 | }) 62 | 63 | test_that("user is able to override parameter", { 64 | expect_equal( infer_trajectory(dataset, dummy_instance, parameters = list(fruit = "cherry"))$cell_ids, "cherry" ) 65 | }) 66 | 67 | test_that("user is able to set different default parameter", { 68 | dummy_instance2 <- dummy(fruit = "101010") 69 | expect_equal( infer_trajectory(dataset, dummy_instance2)$cell_ids, "101010" ) 70 | 71 | expect_equal(get_default_parameters(dummy_instance2)$fruit, "101010") 72 | }) 73 | 74 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_branch_trajectory.R: -------------------------------------------------------------------------------- 1 | context("Testing add_trajectory") 2 | 3 | id <- "a" 4 | cell_ids <- letters[1:12] 5 | branch_ids <- c("A", "B", "C", "D", "E") 6 | 7 | branch_network <- tribble( 8 | ~from, ~to, 9 | "A", "B", 10 | "B", "C", 11 | "B", "D" 12 | ) 13 | branch_progressions <- tibble( 14 | cell_id = cell_ids, 15 | branch_id = c("A", "A", "A", "B", "B", "C", "C", "D", "D", "D", "E", "E"), 16 | percentage = c(0, 0.5, 1, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1, 0.1, 0.6) 17 | ) 18 | branches <- tibble( 19 | branch_id = branch_ids, 20 | length = as.numeric(1:5), 21 | directed = TRUE 22 | ) 23 | 24 | wr_orig <- wrap_data( 25 | id = id, 26 | cell_ids = cell_ids 27 | ) 28 | 29 | test_that("Testing add_trajectory with milestone_percentages", { 30 | wr <- 31 | wr_orig %>% 32 | add_branch_trajectory( 33 | branch_ids = branch_ids, 34 | branch_network = branch_network, 35 | branch_progressions = branch_progressions, 36 | branches = branches 37 | ) 38 | 39 | # testing is_ti_data_wrapper 40 | expect_true(is_wrapper_with_trajectory(wr)) 41 | 42 | expect_equivalent(wr$id, id) 43 | expect_equivalent(wr$cell_ids, cell_ids) 44 | expect_equivalent(wr$milestone_network$from, c("1", "2", "3", "3", "4")) 45 | expect_equivalent(wr$milestone_network$to, c("2", "3", "5", "6", "7")) 46 | }) 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | id <- "a" 55 | cell_ids <- letters[1:12] 56 | branch_ids <- c("A", "B", "C") 57 | 58 | branch_network <- tribble( 59 | ~from, ~to, 60 | "A", "B", 61 | "B", "C", 62 | "B", "A", 63 | "A", "C" 64 | ) 65 | branch_progressions <- tibble( 66 | cell_id = cell_ids, 67 | branch_id = c("A", "A", "A", "B", "B", "C", "C", "A", "A", "B", "B", "C"), 68 | percentage = c(0, 0.5, 1, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1, 0.1, 0.6) 69 | ) 70 | branches <- tibble( 71 | branch_id = branch_ids, 72 | length = as.numeric(1:3), 73 | directed = TRUE 74 | ) 75 | 76 | wr_orig <- wrap_data( 77 | id = id, 78 | cell_ids = cell_ids 79 | ) 80 | 81 | test_that("Testing add_trajectory with milestone_percentages", { 82 | wr <- 83 | wr_orig %>% 84 | add_branch_trajectory( 85 | branch_ids = branch_ids, 86 | branch_network = branch_network, 87 | branch_progressions = branch_progressions, 88 | branches = branches 89 | ) 90 | 91 | expect_equivalent(wr$milestone_network$from, c("1", "1", "1", "1-Aa", "1-Ab", "1-Ba", "1-Bb")) 92 | }) 93 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_cell_graph.R: -------------------------------------------------------------------------------- 1 | context("Testing add_cell_graph") 2 | 3 | 4 | # cell data 5 | cell_ids <- c("A", "B", "C", "D", "E", "F", "G", "H", "a", "b", "bb", "c", "cc", "d") 6 | 7 | wr_orig <- wrap_data( 8 | id = "test", 9 | cell_ids = cell_ids 10 | ) 11 | 12 | 13 | test_that("Testing add_cell_graph", { 14 | cell_graph <- tibble::tribble( 15 | ~from, ~to, ~length, ~directed, 16 | "A", "B", .5, F, 17 | "B", "C", .6, F, 18 | "C", "D", .7, F, 19 | "D", "E", .8, F, 20 | "D", "F", .9, F, 21 | "E", "G", 0.5, F, 22 | "F", "G", 0.1, F, 23 | "G", "H", 1, F, 24 | "a", "A", .1, F, 25 | "b", "B", .1, F, 26 | "bb", "B", .08, F, 27 | "c", "C", .05, F, 28 | "cc", "c", .1, F, 29 | "d", "D", .01, F 30 | ) 31 | 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) 32 | 33 | wr <- wr_orig %>% add_cell_graph( 34 | cell_graph = cell_graph, 35 | to_keep = to_keep, 36 | milestone_prefix = "ML_" 37 | ) 38 | 39 | # testing is_ti_data_wrapper 40 | expect_false(is_wrapper_with_trajectory(wr_orig)) 41 | expect_true(is_wrapper_with_trajectory(wr)) 42 | 43 | # testing milestone ids 44 | expect_equal(wr$cell_ids, cell_ids) 45 | expect_equal(length(wr$milestone_ids), 5) 46 | expect_equal(nrow(wr$milestone_network), 5) 47 | expect_equal(nrow(wr$progressions), length(cell_ids)) 48 | 49 | expect_equal(wr$milestone_ids, paste0("ML_", c("A", "D", "F", "G", "H"))) 50 | 51 | test_strs <- wr$milestone_network %>% {paste(.$from, .$to, .$length, .$directed, sep = "|")} %>% sort 52 | expected_strs <- c( 53 | "ML_A|ML_D|1.8|FALSE", 54 | "ML_D|ML_F|0.9|FALSE", 55 | "ML_D|ML_G|1.3|FALSE", 56 | "ML_F|ML_G|0.1|FALSE", 57 | "ML_G|ML_H|1|FALSE" 58 | ) %>% sort 59 | expect_equal(test_strs, expected_strs) 60 | 61 | test_strs <- wr$progressions %>% {paste(.$cell_id, .$from, .$to, round(.$percentage, 2), sep = "|")} %>% sort 62 | expected_strs <- c( 63 | 'a|ML_A|ML_D|0', 64 | 'A|ML_A|ML_D|0', 65 | 'b|ML_A|ML_D|0.28', 66 | 'B|ML_A|ML_D|0.28', 67 | 'bb|ML_A|ML_D|0.28', 68 | 'c|ML_A|ML_D|0.61', 69 | 'C|ML_A|ML_D|0.61', 70 | 'cc|ML_A|ML_D|0.61', 71 | 'd|ML_A|ML_D|1', 72 | 'D|ML_A|ML_D|1', 73 | 'E|ML_D|ML_G|0.62', 74 | 'F|ML_D|ML_F|1', 75 | 'G|ML_D|ML_G|1', 76 | 'H|ML_G|ML_H|1' 77 | ) %>% sort 78 | expect_equal(test_strs, expected_strs) 79 | }) 80 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_cell_waypoints.R: -------------------------------------------------------------------------------- 1 | context("Testing add_cell_waypoints") 2 | 3 | orig_cell_ids <- c("a", "b", "c", "d", "e", "f") 4 | cell_ids <- unlist(map(1:100, ~ paste0(orig_cell_ids, .))) 5 | milestone_ids <- c("W", "X", "Y", "Z", "A") 6 | 7 | milestone_network <- tribble( 8 | ~from, ~to, ~length, ~directed, 9 | "W", "X", 2, TRUE, 10 | "X", "Y", 3, TRUE, 11 | "X", "Z", 4, TRUE, 12 | "Z", "A", 5, TRUE 13 | ) 14 | 15 | divergence_regions <- tribble( 16 | ~divergence_id, ~milestone_id, ~is_start, 17 | "XYZ", "X", TRUE, 18 | "XYZ", "Y", FALSE, 19 | "XYZ", "Z", FALSE 20 | ) 21 | 22 | milestone_percentages <- tribble( 23 | ~cell_id, ~milestone_id, ~percentage, 24 | "a", "W", 1, 25 | "b", "W", .2, 26 | "b", "X", .8, 27 | "c", "X", .8, 28 | "c", "Z", .2, 29 | "d", "Z", 1, 30 | "e", "X", .3, 31 | "e", "Y", .2, 32 | "e", "Z", .5, 33 | "f", "Z", .8, 34 | "f", "A", .2 35 | ) %>% 36 | crossing(i = 1:100) %>% 37 | mutate(cell_id = paste0(cell_id, i)) %>% 38 | select(-i) 39 | 40 | progressions <- convert_milestone_percentages_to_progressions( 41 | cell_ids, milestone_ids, milestone_network, milestone_percentages 42 | ) 43 | 44 | num_samp <- 4 45 | 46 | 47 | test_that("Testing select_waypoint_cells", { 48 | waypoint_cells <- 49 | select_waypoint_cells( 50 | milestone_ids, 51 | milestone_network, 52 | milestone_percentages, 53 | progressions, 54 | divergence_regions, 55 | num_cells_selected = length(orig_cell_ids) * num_samp 56 | ) 57 | 58 | waypoint_cells_table <- 59 | waypoint_cells %>% 60 | gsub("[0-9]+", "", .) %>% 61 | table() 62 | 63 | expect_equal(names(waypoint_cells_table), orig_cell_ids) 64 | expect_true(all(waypoint_cells_table == num_samp)) 65 | }) 66 | 67 | 68 | test_that("Testing add_cell_waypoints", { 69 | trajectory <- 70 | wrap_data( 71 | id = "test", 72 | cell_ids = cell_ids 73 | ) %>% add_trajectory( 74 | milestone_ids = milestone_ids, 75 | milestone_network = milestone_network, 76 | milestone_percentages = milestone_percentages, 77 | divergence_regions = divergence_regions 78 | ) 79 | 80 | trajectory2 <- add_cell_waypoints( 81 | trajectory, 82 | num_cells_selected = length(orig_cell_ids) * num_samp 83 | ) 84 | waypoint_cells <- 85 | trajectory2$waypoint_cells 86 | 87 | waypoint_cells_table <- 88 | waypoint_cells %>% 89 | gsub("[0-9]+", "", .) %>% 90 | table() 91 | 92 | expect_equal(names(waypoint_cells_table), orig_cell_ids) 93 | expect_true(all(waypoint_cells_table == num_samp)) 94 | 95 | expect_false(is_wrapper_with_waypoint_cells(trajectory)) 96 | expect_true(is_wrapper_with_waypoint_cells(trajectory2)) 97 | }) 98 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_cyclic_trajectory.R: -------------------------------------------------------------------------------- 1 | context("Testing add_cyclic_trajectory") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | extras <- list("man") 6 | 7 | pseudotime <- c(0, .1, .4, .5, .8, 1) %>% set_names(cell_ids) 8 | 9 | wr_orig <- wrap_data( 10 | id = id, 11 | cell_ids = cell_ids 12 | ) 13 | 14 | test_that("Testing add_cyclic_trajectory", { 15 | wr <- 16 | wr_orig %>% 17 | add_cyclic_trajectory( 18 | pseudotime = pseudotime, 19 | do_scale_minmax = TRUE, 20 | directed = FALSE, 21 | extras = extras 22 | ) 23 | 24 | # testing is_ti_data_wrapper 25 | expect_true(is_wrapper_with_trajectory(wr)) 26 | 27 | expect_equivalent(wr$id, id) 28 | expect_equivalent(wr$cell_ids, cell_ids) 29 | expect_equivalent(wr$extras, extras) 30 | expect_gt(cor(wr$pseudotime[cell_ids], pseudotime[cell_ids]), .9) 31 | expect_equivalent(length(wr$milestone_ids), 3) 32 | expect_equivalent(nrow(wr$milestone_network), 3) 33 | expect_equivalent(set_names(sort(unique(unlist(wr$milestone_network[,c("from", "to")]))), NULL), sort(wr$milestone_ids)) 34 | expect_true(all(cell_ids %in% wr$progressions$cell_id)) 35 | expect_equivalent(nrow(wr$progressions), length(cell_ids)) 36 | 37 | expect_equivalent(wr$trajectory_type, "cycle") 38 | }) 39 | 40 | 41 | test_that("Testing add_cyclic_trajectory", { 42 | wr <- 43 | wr_orig %>% 44 | add_cyclic_trajectory( 45 | pseudotime = pseudotime, 46 | do_scale_minmax = TRUE, 47 | directed = TRUE, 48 | extras = extras 49 | ) 50 | 51 | expect_equivalent(wr$trajectory_type, "cycle") 52 | }) 53 | 54 | 55 | test_that("Testing add_cyclic_trajectory", { 56 | wr <- 57 | wr_orig %>% 58 | add_cyclic_trajectory( 59 | pseudotime = pseudotime/10 + .45, 60 | do_scale_minmax = FALSE, 61 | directed = TRUE, 62 | extras = extras 63 | ) 64 | 65 | expect_gt(min(wr$pseudotime), .4) 66 | expect_lt(max(wr$pseudotime), .6) 67 | 68 | }) 69 | 70 | 71 | test_that("Testing add_cyclic_trajectory fails when expected", { 72 | expect_error( 73 | wr_orig %>% 74 | add_cyclic_trajectory( 75 | pseudotime = pseudotime %>% set_names(NULL), 76 | do_scale_minmax = TRUE, 77 | directed = FALSE, 78 | extras = extras 79 | ) 80 | ) 81 | }) 82 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_end_state_probabilities.R: -------------------------------------------------------------------------------- 1 | context("Testing add_end_state_probabilities") 2 | 3 | # cell data 4 | id <- "a" 5 | cell_ids <- letters 6 | end_state_ids <- LETTERS[1:5] 7 | end_state_probabilities <- matrix(runif(length(cell_ids) * length(end_state_ids)), nrow = length(cell_ids)) 8 | colnames(end_state_probabilities) <- end_state_ids 9 | end_state_probabilities <- end_state_probabilities %>% as.data.frame() %>% mutate(cell_id = cell_ids) 10 | pseudotime <- runif(length(cell_ids)) %>% set_names(cell_ids) 11 | 12 | wr_orig <- wrap_data( 13 | id = id, 14 | cell_ids = cell_ids 15 | ) 16 | 17 | test_that("Testing add_end_state_probabilities", { 18 | wr <- wr_orig %>% 19 | add_end_state_probabilities( 20 | end_state_probabilities = end_state_probabilities, 21 | pseudotime = pseudotime 22 | ) 23 | 24 | # testing is_ti_data_wrapper 25 | expect_false(is_wrapper_with_trajectory(wr_orig)) 26 | expect_true(is_wrapper_with_trajectory(wr)) 27 | 28 | expect_equivalent(wr$id, id) 29 | expect_equivalent(wr$pseudotime, dynutils::scale_minmax(pseudotime)) 30 | expect_true(all(end_state_ids %in% wr$milestone_ids)) 31 | expect_equivalent(wr$cell_ids, cell_ids) 32 | 33 | # test with only one end states 34 | wr <- wr_orig %>% 35 | add_end_state_probabilities( 36 | end_state_probabilities = end_state_probabilities[, "cell_id", drop=F], 37 | pseudotime = pseudotime 38 | ) 39 | 40 | expect_true(nrow(wr$milestone_network) == 1) 41 | }) 42 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_expression.R: -------------------------------------------------------------------------------- 1 | context("Testing add_expression") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | cell_info <- tibble( 6 | cell_id = cell_ids, 7 | info1 = c("man", "in", "possession", "of", "a", "good"), 8 | info2 = c("fortune", "must", "be", "in", "want", "of"), 9 | info3 = 1:6 10 | ) 11 | extras1 <- list("a wife.") 12 | extras2 <- c("However", "little", "known") 13 | 14 | num_features <- round(runif(1, 100, 120)) 15 | feature_names <- paste0("feature_", seq_len(num_features)) 16 | 17 | expression <- matrix(runif(num_features * length(cell_ids), 8, 12), nrow = length(cell_ids), dimnames = list(cell_ids, feature_names)) 18 | counts <- 2^expression - 1 19 | feature_info <- tibble(feature_id = feature_names, mean = colMeans(expression), var = apply(expression, 2, var)) 20 | 21 | wrapper1 <- 22 | wrap_data( 23 | id = id, 24 | cell_ids = cell_ids, 25 | cell_info = cell_info, 26 | extras1 = extras1 27 | ) %>% 28 | add_expression( 29 | counts = counts, 30 | expression = expression, 31 | feature_info = feature_info, 32 | extras2 = extras2 33 | ) 34 | 35 | test_that("Testing add_expression and get_expression", { 36 | wrapper2 <- 37 | wrap_expression( 38 | id = id, 39 | expression, 40 | counts, 41 | cell_info, 42 | feature_info, 43 | extras1 = extras1, 44 | extras2 = extras2 45 | ) 46 | 47 | wrapper3 <- wrapper2 48 | wrapper3$expression <- function() {wrapper1$expression} 49 | 50 | wrappers <- list(wrapper1, wrapper2, wrapper3) 51 | 52 | for (wr in wrappers) { 53 | # testing is_wrapper_with_expression 54 | expect_true(is_wrapper_with_expression(wr)) 55 | expect_false(is_wrapper_with_expression(list(chvehoie = "jihofrewghifu"))) 56 | 57 | expect_equivalent(wr$id, id) 58 | expect_equivalent(wr$cell_ids, cell_ids) 59 | expect_equivalent(wr$cell_info, cell_info) 60 | expect_equivalent(wr$extras1, extras1) 61 | expect_equivalent(wr$extras2, extras2) 62 | 63 | expect_is(get_expression(wr, "counts"), "dgCMatrix") 64 | expect_is(get_expression(wr, "expression"), "dgCMatrix") 65 | 66 | expect_equivalent(get_expression(wr, "counts") %>% as.matrix, counts) 67 | expect_equivalent(get_expression(wr) %>% as.matrix, expression) 68 | expect_equivalent(get_expression("whatever", wr) %>% as.matrix, expression) 69 | expect_equivalent(get_expression(wr, expression) %>% as.matrix, expression) 70 | expect_equivalent(get_expression(wr, counts) %>% as.matrix, counts) 71 | expect_error(get_expression(wr, "say what")) 72 | expect_error(get_expression("you don't say")) 73 | } 74 | }) 75 | 76 | test_that("Testing add tde_overall", { 77 | tde_overall <- tibble(feature_id = feature_info$feature_id) %>% mutate(differentially_expressed = runif(n()) > 0.5) 78 | wrapper_tde <- wrapper1 %>% add_tde_overall(tde_overall) 79 | 80 | expect_equal(tde_overall, wrapper_tde$tde_overall) 81 | }) 82 | 83 | 84 | 85 | 86 | 87 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_grouping.R: -------------------------------------------------------------------------------- 1 | context("Testing add_grouping") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | cell_info <- tibble( 6 | cell_id = cell_ids, 7 | info1 = c("man", "in", "possession", "of", "a", "good"), 8 | info2 = c("fortune", "must", "be", "in", "want", "of"), 9 | info3 = 1:6 10 | ) 11 | 12 | wrapper1 <- wrap_data(id, cell_ids) %>% add_grouping(cell_info$info1) 13 | wrapper2 <- wrap_data(id, cell_ids) %>% add_grouping(unique(cell_info$info1), cell_info$info1) 14 | wrapper3 <- wrap_data(id, cell_ids) %>% add_grouping(tibble(cell_id = cell_ids, group_id = cell_info$info1)) 15 | wrapper4 <- wrap_data(id, cell_ids) %>% add_prior_information(groups_id = tibble(cell_id = cell_ids, group_id = cell_info$info1)) 16 | wrapper5 <- wrap_data(id, cell_ids, cell_info) 17 | 18 | test_that("Testing add_grouping", { 19 | for (wrapper in list(wrapper1, wrapper2, wrapper3)) { 20 | expect_true(is_wrapper_with_grouping(wrapper)) 21 | expect_true(all(c("grouping", "group_ids") %in% names(wrapper))) 22 | expect_true(all(wrapper$group_ids %in% wrapper$grouping)) 23 | expect_equal(length(wrapper$grouping), length(wrapper$cell_ids)) 24 | expect_equal(names(wrapper$grouping), wrapper$cell_ids) 25 | } 26 | }) 27 | 28 | test_that("Testing get_grouping", { 29 | for (wrapper in list(wrapper1, wrapper2, wrapper3, wrapper4)) { 30 | expect_equal(get_grouping(wrapper), wrapper1$grouping) 31 | expect_equal(names(get_grouping(wrapper)), wrapper$cell_ids) 32 | } 33 | 34 | expect_error(get_grouping(wrapper5)) 35 | 36 | expect_equal(get_grouping(wrapper5, "info1"), wrapper3$grouping) 37 | expect_equal(names(get_grouping(wrapper5, "info1")), wrapper5$cell_ids) 38 | }) 39 | 40 | 41 | milestone_network <- tibble(from = c("A", "B"), to = c("B", "C"), directed = TRUE, length = 1) 42 | 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)) 43 | 44 | trajectory <- wrap_data(id, cell_ids) %>% add_trajectory(milestone_network = milestone_network, progressions = progressions) 45 | 46 | test_that("Testing group_onto_trajectory_edges", { 47 | grouping <- group_onto_trajectory_edges(trajectory) 48 | 49 | expect_equal(length(grouping), length(cell_ids)) 50 | expect_equal(names(grouping), cell_ids) 51 | expect_equal(grouping %>% unname(), c("A->B", "A->B", "A->B", "B->C", "B->C", "B->C")) 52 | }) 53 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_pseudotime.R: -------------------------------------------------------------------------------- 1 | context("Testing add_pseudotime") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | extras <- list("man") 6 | 7 | pseudotime <- c(0, .1, .4, .5, .8, 1) %>% set_names(cell_ids) 8 | 9 | wr_orig <- wrap_data( 10 | id = id, 11 | cell_ids = cell_ids 12 | ) 13 | 14 | test_that("add_pseudotime works as expected", { 15 | trajectory <- wr_orig %>% add_pseudotime(pseudotime = pseudotime) 16 | 17 | expect_equal(trajectory$pseudotime, pseudotime) 18 | 19 | expect_error(add_pseudotime(wr_orig, pseudotime = "whatever")) 20 | }) 21 | 22 | 23 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_root_and_add_pseudotime.R: -------------------------------------------------------------------------------- 1 | context("Testing add_root") 2 | 3 | cell_ids <- c("a", "b", "c", "d", "e", "f") 4 | milestone_ids <- c("W", "X", "Y", "Z", "A") 5 | 6 | milestone_network <- tribble( 7 | ~from, ~to, ~length, ~directed, 8 | "W", "X", 2, TRUE, 9 | "X", "Z", 4, TRUE, 10 | "X", "Y", 3, TRUE, 11 | "Z", "A", 5, TRUE 12 | ) 13 | 14 | divergence_regions <- tribble( 15 | ~divergence_id, ~milestone_id, ~is_start, 16 | "XYZ", "X", TRUE, 17 | "XYZ", "Y", FALSE, 18 | "XYZ", "Z", FALSE 19 | ) 20 | 21 | milestone_percentages <- tribble( 22 | ~cell_id, ~milestone_id, ~percentage, 23 | "a", "W", .9, 24 | "a", "X", .1, 25 | "b", "W", .2, 26 | "b", "X", .8, 27 | "c", "X", .8, 28 | "c", "Z", .2, 29 | "d", "X", .2, 30 | "d", "Y", .7, 31 | "d", "Z", .1, 32 | "e", "X", .3, 33 | "e", "Y", .2, 34 | "e", "Z", .5, 35 | "f", "Z", .8, 36 | "f", "A", .2 37 | ) 38 | 39 | trajectory <- wrap_data( 40 | id = "test", 41 | cell_ids = cell_ids 42 | ) %>% add_trajectory( 43 | milestone_ids = milestone_ids, 44 | milestone_network = milestone_network, 45 | milestone_percentages = milestone_percentages, 46 | divergence_regions = divergence_regions 47 | ) 48 | 49 | # dynplot::plot_graph(trajectory, label_milestones = TRUE) 50 | test_that("Testing add_root on simple linear trajectory", { 51 | rooted <- add_root(trajectory, root_cell_id = "a") 52 | 53 | expect_true(rooted$root_milestone_id == "W") 54 | expect_true(rooted$milestone_network$from[[1]] == "W") 55 | expect_true(all(rooted$milestone_network$from == c("W", "X", "Z", "X"))) 56 | expect_true(all(rooted$milestone_network$to == c("X", "Z", "A", "Y"))) 57 | 58 | rooted <- add_root(trajectory) 59 | 60 | expect_error(add_root(trajectory, root_cell_id = "trajectories are cool")) 61 | expect_error(add_root(trajectory, root_milestone_id = "trajectories are cool")) 62 | }) 63 | 64 | 65 | test_that("Testing add_root on a more complex linear trajectory", { 66 | trajectory2 <- wrap_data(cell_ids = "a") %>% 67 | add_trajectory( 68 | milestone_network = tibble(from = c("2", "1", "4", "3"), to = c("1", "4", "3", "5"), length = 1, directed = TRUE), 69 | progressions = tibble(cell_id = "a", from = "2", to = "1", percentage = 0) 70 | ) 71 | 72 | 73 | trajectory2_rooted <- add_root(trajectory2, root_milestone_id = "5") 74 | 75 | expect_true(all(trajectory2_rooted$milestone_network$from == c("5", "3", "4", "1"))) 76 | }) 77 | 78 | 79 | 80 | test_that("Testing add_root_using_expression",{ 81 | rooted <- add_root_using_expression(dynwrap::example_trajectory, "C") 82 | expect_equal( 83 | rooted$root_milestone_id, 84 | "milestone_begin" 85 | ) 86 | }) 87 | 88 | 89 | test_that("Testing calculate_pseudotime", { 90 | trajectory <- add_root(trajectory) 91 | trajectory <- add_pseudotime(trajectory) 92 | expect_equal(trajectory$pseudotime, c("a" = 0.2, "b" = 1.6, "c" = 2.8, "d" = 4.5, "e" = 4.6, "f" = 7.0)) 93 | }) 94 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_timings.R: -------------------------------------------------------------------------------- 1 | context("Testing add_timings") 2 | 3 | test_that("Testing add_timings", { 4 | id <- "a" 5 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 6 | cell_info <- tibble( 7 | cell_id = cell_ids, 8 | info1 = c("man", "in", "possession", "of", "a", "good"), 9 | info2 = c("fortune", "must", "be", "in", "want", "of"), 10 | info3 = 1:6 11 | ) 12 | extras1 <- list("a wife.") 13 | extras2 <- c("However", "little", "known") 14 | 15 | tl <- add_timing_checkpoint(NULL, "start") 16 | Sys.sleep(1) 17 | tl <- tl %>% add_timing_checkpoint("second") 18 | Sys.sleep(.5) 19 | tl <- tl %>% add_timing_checkpoint("third") 20 | Sys.sleep(.25) 21 | tl <- tl %>% add_timing_checkpoint("stop") 22 | 23 | wr <- 24 | wrap_data( 25 | id = id, 26 | cell_ids = cell_ids, 27 | cell_info = cell_info, 28 | extras1 = extras1, 29 | extras2 = extras2 30 | ) %>% 31 | add_timings( 32 | timings = tl 33 | ) 34 | 35 | # testing is_ti_data_wrapper 36 | expect_true(is_wrapper_with_timings(wr)) 37 | expect_false(is_wrapper_with_timings(list(chvehoie = "jihofrewghifu"))) 38 | 39 | testthat::expect_equivalent(wr$timings, tl) 40 | testthat::expect_equivalent(names(tl), c("start", "second", "third", "stop")) 41 | 42 | diffs <- diff(unlist(wr$timings)) 43 | testthat::expect_true(all(abs(diffs - c(1, .5, .25)) < .1)) 44 | }) 45 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_trajectory.R: -------------------------------------------------------------------------------- 1 | context("Testing add_trajectory") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | 6 | milestone_ids <- c("man", "in", "possession", "of", "good", "fortune", "must") 7 | milestone_network <- tribble( 8 | ~from, ~to, ~length, ~directed, 9 | "man", "in", 1, TRUE, 10 | "in", "possession", 2, TRUE, 11 | "in", "of", 3, TRUE, 12 | "possession", "good", 4, TRUE, 13 | "of", "fortune", 5, TRUE, 14 | "good", "must", 6, TRUE, 15 | "fortune", "must", 7, TRUE 16 | ) 17 | milestone_percentages <- tribble( 18 | ~cell_id, ~milestone_id, ~percentage, 19 | "truth", "man", .8, 20 | "truth", "in", .2, 21 | "universally", "in", .3, 22 | "universally", "possession", .2, 23 | "universally", "of", .5, 24 | "acknowledged", "possession", 0, 25 | "acknowledged", "good", 1, 26 | "that", "good", .5, 27 | "that", "must", .5, 28 | "a", "good", .9, 29 | "a", "must", .1, 30 | "single", "fortune", .6, 31 | "single", "must", .4 32 | ) 33 | divergence_regions <- tribble( 34 | ~divergence_id, ~milestone_id, ~is_start, 35 | "be", "in", TRUE, 36 | "be", "possession", FALSE, 37 | "be", "of", FALSE 38 | ) 39 | 40 | trajectory <- wrap_data( 41 | id = id, 42 | cell_ids = cell_ids 43 | ) %>% add_trajectory( 44 | milestone_network = milestone_network, 45 | divergence_regions = divergence_regions, 46 | milestone_percentages = milestone_percentages 47 | ) 48 | 49 | test_that("Testing add_trajectory with milestone_percentages", { 50 | gathered_trajectory <- gather_cells_at_milestones(trajectory) 51 | 52 | testthat::expect_equal(unique(gathered_trajectory$milestone_percentages$percentage), 1) 53 | testthat::expect_equal(gathered_trajectory$milestone_percentages$milestone_id, c("good", "good", "fortune", "good", "man", "of")) 54 | }) 55 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_add_waypoints.R: -------------------------------------------------------------------------------- 1 | context("Testing waypoints") 2 | 3 | orig_cell_ids <- c("a", "b", "c", "d", "e", "f") 4 | cell_ids <- unlist(map(1:100, ~ paste0(orig_cell_ids, .))) 5 | milestone_ids <- c("W", "X", "Y", "Z", "A") 6 | 7 | milestone_network <- tribble( 8 | ~from, ~to, ~length, ~directed, 9 | "W", "X", 2, TRUE, 10 | "X", "Y", 3, TRUE, 11 | "X", "Z", 4, TRUE, 12 | "Z", "A", 5, TRUE 13 | ) 14 | 15 | divergence_regions <- tribble( 16 | ~divergence_id, ~milestone_id, ~is_start, 17 | "XYZ", "X", TRUE, 18 | "XYZ", "Y", FALSE, 19 | "XYZ", "Z", FALSE 20 | ) 21 | 22 | milestone_percentages <- tribble( 23 | ~cell_id, ~milestone_id, ~percentage, 24 | "a", "W", 1, 25 | "b", "W", .2, 26 | "b", "X", .8, 27 | "c", "X", .8, 28 | "c", "Z", .2, 29 | "d", "Z", 1, 30 | "e", "X", .3, 31 | "e", "Y", .2, 32 | "e", "Z", .5, 33 | "f", "Z", .8, 34 | "f", "A", .2 35 | ) %>% 36 | crossing(i = 1:100) %>% 37 | mutate(cell_id = paste0(cell_id, i)) %>% 38 | select(-i) 39 | 40 | trajectory <- wrap_data("", cell_ids) %>% 41 | add_trajectory(milestone_ids, milestone_network, divergence_regions, milestone_percentages = milestone_percentages) 42 | 43 | 44 | test_that("Testing select_waypoints", { 45 | wp <- 46 | select_waypoints( 47 | trajectory, 48 | n_waypoints = 100 49 | ) 50 | 51 | expect_true(nrow(wp$waypoints) >= 100) 52 | expect_setequal(wp$waypoints$waypoint_id, wp$milestone_percentages$waypoint_id) 53 | expect_setequal(wp$waypoints$waypoint_id, wp$progressions$waypoint_id) 54 | expect_setequal(wp$waypoints$milestone_id, c(milestone_ids, NA)) 55 | expect_setequal(wp$waypoints$waypoint_id, rownames(wp$geodesic_distances)) 56 | expect_setequal(cell_ids, colnames(wp$geodesic_distances)) 57 | expect_setequal(wp$waypoints$waypoint_id, c(wp$waypoint_network$from, wp$waypoint_network$to)) 58 | }) 59 | 60 | 61 | test_that("Testing add_cell_waypoints", { 62 | trajectory <- trajectory %>% add_waypoints() 63 | 64 | expect_true(!is.null(trajectory$waypoints)) 65 | }) 66 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_cell_group.R: -------------------------------------------------------------------------------- 1 | context("Testing add_grouping") 2 | 3 | # cell data 4 | id <- "a" 5 | cell_ids <- letters 6 | group_ids <- LETTERS[1:5] 7 | grouping <- sample(group_ids, length(cell_ids), replace = T) %>% set_names(cell_ids) 8 | extras <- "banana" 9 | 10 | wr_orig <- wrap_data( 11 | id = id, 12 | cell_ids = cell_ids 13 | ) 14 | 15 | test_that("Testing add_grouping", { 16 | wr <- wr_orig %>% 17 | add_grouping( 18 | group_ids = group_ids, 19 | grouping = grouping, 20 | extras = extras 21 | ) 22 | 23 | # testing is_ti_data_wrapper 24 | expect_false(is_wrapper_with_grouping(wr_orig)) 25 | expect_true(is_wrapper_with_grouping(wr)) 26 | expect_false(is_wrapper_with_grouping(list(chvehoie = "jihofrewghifu"))) 27 | 28 | expect_equivalent(wr$id, id) 29 | expect_equivalent(wr$group_ids, group_ids) 30 | expect_equivalent(wr$cell_ids, cell_ids) 31 | expect_equivalent(wr$extras, extras) 32 | expect_equivalent(wr$grouping, grouping) 33 | }) 34 | 35 | 36 | test_that("Testing add_grouping with a subset of cells", { 37 | wr <- wr_orig %>% 38 | add_grouping( 39 | group_ids = group_ids, 40 | grouping = grouping[1:10], 41 | extras = extras 42 | ) 43 | 44 | # testing is_ti_data_wrapper 45 | expect_false(is_wrapper_with_grouping(wr_orig)) 46 | expect_true(is_wrapper_with_grouping(wr)) 47 | expect_false(is_wrapper_with_grouping(list(chvehoie = "jihofrewghifu"))) 48 | 49 | expect_equivalent(wr$id, id) 50 | expect_equivalent(wr$cell_ids, cell_ids) 51 | expect_equivalent(wr$extras, extras) 52 | }) 53 | 54 | 55 | 56 | test_that("Testing add_grouping fails when groupings is not in the correct format", { 57 | expect_error( 58 | wr_orig %>% 59 | add_grouping( 60 | group_ids = group_ids, 61 | grouping = paste0("HUO", grouping), 62 | extras = extras 63 | ) 64 | ) 65 | 66 | expect_error( 67 | wr_orig %>% 68 | add_grouping( 69 | group_ids = group_ids, 70 | grouping = rep(1, length(cell_ids)) %>% set_names(cell_ids), 71 | extras = extras 72 | ) 73 | ) 74 | 75 | expect_error( 76 | wr_orig %>% 77 | add_grouping( 78 | group_ids = group_ids, 79 | grouping = tibble(grouping), 80 | extras = extras 81 | ) 82 | ) 83 | }) 84 | 85 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_cluster_graph.R: -------------------------------------------------------------------------------- 1 | context("Testing add_cluster_graph") 2 | 3 | # cell data 4 | id <- "a" 5 | cell_ids <- letters 6 | group_ids <- LETTERS[1:5] 7 | grouping <- sample(group_ids, length(cell_ids), replace = T) %>% set_names(cell_ids) 8 | extras <- "banana" 9 | 10 | wr_without_grouping <- wrap_data( 11 | id = id, 12 | cell_ids = cell_ids 13 | ) 14 | 15 | wr_orig <- wr_without_grouping %>% add_grouping( 16 | group_ids = group_ids, 17 | grouping = grouping, 18 | extras = extras 19 | ) 20 | 21 | milestone_network <- tibble( 22 | from = group_ids[1:4], 23 | to = group_ids[2:5], 24 | length = c(1, 2, 4, 5), 25 | directed = TRUE 26 | ) 27 | 28 | test_that("Testing add_cluster_graph", { 29 | wr <- wr_orig %>% 30 | add_cluster_graph( 31 | milestone_network = milestone_network 32 | ) 33 | 34 | # testing is_ti_data_wrapper 35 | expect_false(is_wrapper_with_trajectory(wr_orig)) 36 | expect_true(is_wrapper_with_trajectory(wr)) 37 | 38 | expect_equivalent(wr$id, id) 39 | expect_equivalent(wr$group_ids, group_ids) 40 | expect_setequal(wr$milestone_ids, group_ids) 41 | expect_equivalent(wr$cell_ids, cell_ids) 42 | expect_equivalent(wr$extras, extras) 43 | expect_equivalent(wr$grouping, grouping) 44 | expect_equivalent(wr$milestone_network, milestone_network) 45 | 46 | # percentages are either 0 or 1 47 | expect_true(all(abs(abs(wr$milestone_percentages$percentage - .5) - .5) < 1e-6)) 48 | 49 | # test with providing a grouping in cluster_graph 50 | wr <- wr_without_grouping %>% 51 | add_cluster_graph( 52 | milestone_network = milestone_network, 53 | grouping = grouping 54 | ) 55 | 56 | expect_true(is_wrapper_with_trajectory(wr)) 57 | }) 58 | 59 | 60 | 61 | test_that("Testing cluster_graph_add_explicit_splits", { 62 | milestone_network <- tribble( 63 | ~from, ~to, ~length, ~directed, 64 | "A", "B", 1, TRUE, 65 | "A", "C", 1, TRUE, 66 | "C", "D", 2, TRUE, 67 | "E", "F", 3, TRUE, 68 | "B", "G", 1, TRUE, 69 | "C", "G", 10, TRUE 70 | ) 71 | 72 | milestone_network <- cluster_graph_add_explicit_splits(milestone_network) 73 | 74 | expect_true( 75 | all( 76 | c( 77 | "split_A -> B", 78 | "split_A -> C", 79 | "B -> convergence_G", 80 | "C -> convergence_G", 81 | "A -> split_A", 82 | "convergence_G -> G" 83 | ) %in% 84 | paste0(milestone_network$from, " -> ", milestone_network$to) 85 | ) 86 | ) 87 | }) 88 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_data.R: -------------------------------------------------------------------------------- 1 | context("Testing wrap_data") 2 | 3 | test_that("Testing data_wrapper", { 4 | id <- "a" 5 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 6 | cell_info <- tibble( 7 | cell_id = cell_ids, 8 | info1 = c("man", "in", "possession", "of", "a", "good"), 9 | info2 = c("fortune", "must", "be", "in", "want", "of"), 10 | info3 = 1:6 11 | ) 12 | extras1 <- list("a wife.") 13 | extras2 <- c("However", "little", "known") 14 | 15 | wr <- wrap_data( 16 | id = id, 17 | cell_ids = cell_ids, 18 | cell_info = cell_info, 19 | extras1 = extras1, 20 | extras2 = extras2 21 | ) 22 | 23 | # testing is_ti_data_wrapper 24 | expect_true(is_data_wrapper(wr)) 25 | expect_false(is_data_wrapper(list(chvehoie = "jihofrewghifu"))) 26 | 27 | expect_equivalent(wr$id, id) 28 | expect_equivalent(wr$cell_ids, cell_ids) 29 | expect_equivalent(wr$cell_info, cell_info) 30 | expect_equivalent(wr$extras1, extras1) 31 | expect_equivalent(wr$extras2, extras2) 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-wrap_label_milestones.R: -------------------------------------------------------------------------------- 1 | context("Testing add_trajectory") 2 | 3 | id <- "a" 4 | cell_ids <- c("truth", "universally", "acknowledged", "that", "a", "single") 5 | 6 | milestone_ids <- c("one", "two") 7 | milestone_network <- tribble( 8 | ~from, ~to, ~length, ~directed, 9 | "one", "two", 1, TRUE 10 | ) 11 | progressions <- tibble( 12 | cell_id = cell_ids, 13 | from = "one", 14 | to = "two", 15 | percentage = seq(0, 1, length.out = length(cell_ids)) 16 | ) 17 | 18 | expression <- matrix( 19 | c( 20 | progressions$percentage, 21 | 1-progressions$percentage 22 | ), 23 | nrow = length(cell_ids), 24 | dimnames = list(cell_ids, c("G1", "G2")) 25 | ) 26 | 27 | 28 | wr_orig <- wrap_data( 29 | id = id, 30 | cell_ids = cell_ids 31 | ) %>% 32 | add_trajectory(milestone_network = milestone_network, progressions = progressions) 33 | 34 | 35 | test_that("Testing milestone labelling manually", { 36 | wr <- wr_orig %>% label_milestones( 37 | labelling = c( 38 | "one" = "end", 39 | "two" = "begin" 40 | ) 41 | ) 42 | 43 | milestone_labelling <- get_milestone_labelling(wr) 44 | 45 | expect_true(milestone_labelling[["one"]] == "end") 46 | expect_true(milestone_labelling[["two"]] == "begin") 47 | 48 | expect_error(label_milestones(wr_orig)) 49 | expect_error(label_milestones(wr_orig, labelling = "yabbadabbadoo")) 50 | expect_error(label_milestones(wr_orig, labelling = TRUE)) 51 | }) 52 | 53 | test_that("Testing milestone labelling with expression", { 54 | markers <- list( 55 | "begin" = "G1", 56 | "end" = "G2" 57 | ) 58 | wr <- wr_orig %>% label_milestones_markers( 59 | markers = markers, 60 | expression_source = expression, 61 | n_nearest_cells = 2 62 | ) 63 | 64 | milestone_labelling <- get_milestone_labelling(wr) 65 | 66 | expect_true(milestone_labelling[["one"]] == "end") 67 | expect_true(milestone_labelling[["two"]] == "begin") 68 | expect_setequal(names(milestone_labelling), milestone_ids) 69 | 70 | # warning when multiple labels are mapped to the same milestone 71 | expect_warning( 72 | wr_orig %>% label_milestones_markers( 73 | markers = list(begin = "G1"), 74 | expression_source = expression, 75 | n_nearest_cells = 20 76 | ) 77 | ) 78 | }) 79 | 80 | test_that("Testing get milestone labelling with expression", { 81 | expect_true(all(get_milestone_labelling(wr_orig) == wr_orig$milestone_ids)) 82 | expect_true(get_milestone_labelling(wr_orig, label_milestones = c("one" = "begin"))["one"] == "begin") 83 | expect_error(get_milestone_labelling(wr_orig, label_milestones = c("wow" = "so much wow"))) 84 | }) 85 | -------------------------------------------------------------------------------- /vignettes/heatmap.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dynverse/dynwrap/852535635765cfd7db9938c83da96b1e483ec513/vignettes/heatmap.png --------------------------------------------------------------------------------