Skip to content
Permalink
Browse files

Merge pull request #31 from dynverse/devel

Version number bumping for dyno 1.0.0 release
  • Loading branch information...
rcannood committed Apr 7, 2019
2 parents 74fe868 + bf31db8 commit e16b237e2f541699013d90e971a1ffce2f065599
@@ -15,20 +15,27 @@ git:
submodules: false
before_install:
- source <(curl -sSL https://raw.githubusercontent.com/dynverse/travis_scripts/master/helper.sh)
- install_hdf5
- cd package
install:
- use_dynverse_devel
- install_cran devtools covr
- install_cran covr
- install_withdeps
after_success:
- R -e 'covr::codecov()'

jobs:
include:
- stage: Cache a few packages already
install:
- install_cran devtools covr tidyverse
- install_cran Rcpp RcppArmadillo RcppEigen SingleCellExperiment
script:
- echo Skip
after_success:
- echo Skip
- stage: prepare cache
script:
script:
- echo Skip
after_success:
after_success:
- echo Skip
- stage: test
@@ -1,6 +1,6 @@
Package: dynbenchmark
Title: Package of "A comparison of single-cell trajectory inference methods: towards more accurate and robust tools"
Version: 0.0.0.9000
Version: 0.1.0.9000
Authors@R: c(
person("Yvan", "Saeys", email = "yvan.saeys@ugent.be", role = c("ths")),
person("Robrecht", "Cannoodt", email="rcannood@gmail.com", role="aut"),
@@ -11,11 +11,11 @@ Description: This package contains functions used in the main analyses of the pa
Using code from our other packages such as dyneval, dyngen and dynutils
Depends:
R (>= 3.5.0),
dyneval (>= 0.2.2),
dynmethods,
dynplot,
dynutils (>= 1.0.1.9000),
dynwrap (>= 0.9.9)
dyneval (>= 0.9.9),
dynmethods (>= 1.0.1),
dynplot (>= 1.0.0),
dynutils (>= 1.0.2),
dynwrap (>= 1.0.0)
License: GPL-3
Encoding: UTF-8
LazyData: true
@@ -26,6 +26,7 @@ Imports:
cowplot,
cluster,
dplyr,
dynparam (>= 1.0.0),
extrafont,
fs,
ggraph,
@@ -57,7 +58,6 @@ Imports:
qsub,
xml2
Suggests:
dyngen,
dyntoy,
dynnormaliser,
devtools,
@@ -71,9 +71,9 @@ Suggests:
tidygraph
Remotes:
dynverse/dyneval,
dynverse/dyngen,
dynverse/dynmethods,
dynverse/dynnormaliser,
dynverse/dynparam,
dynverse/dynplot,
dynverse/dynutils,
dynverse/dyntoy,
@@ -64,6 +64,8 @@ export(paramoptim_generate_design)
export(paramoptim_submit)
export(pdf_manuscript)
export(pdf_supplementary_note)
export(platform_from_counts)
export(platform_simple)
export(plot_fig)
export(plot_trajectory_types)
export(print_url)
@@ -105,7 +107,6 @@ import(dynwrap)
import(ggplot2)
importFrom(assertthat,assert_that)
importFrom(cowplot,theme_nothing)
importFrom(dyngen,get_platform_from_counts)
importFrom(dynwrap,create_ti_method_r)
importFrom(dynwrap,generate_prior_information)
importFrom(extrafont,font_import)
@@ -1,3 +1,121 @@
#' Estimate platform parameters from a dataset
#'
#' Altenatively, [platform_simple()] returns a toy platform parameter configuration.
#'
#' @param counts The counts with cells in rows and genes in columns.
#' @param grouping A named vector representing a grouping of the cells.
#' @param subsample The number of cells to subsample.
#'
#' @rdname platform
#'
#' @export
platform_from_counts <- function(counts, grouping, subsample = 500) {
requireNamespace("splatter")

# add a try catch to the splatEstDropout function because it errors too frequently
old_fun <- splatter:::splatEstDropout
new_fun <- function(...) {
tryCatch({
old_fun(...)
}, error = function(e) {
warning("Could not estimate dropout parameters, defaulting to mid = 0.01 and shape = 1.")
splatter::setParams(params, dropout.mid = 0.01, dropout.shape = 1)
})

}
assignInNamespace("splatEstDropout", new_fun, asNamespace("splatter"))
on.exit(assignInNamespace("splatEstDropout", old_fun, asNamespace("splatter")))

# remove genes that are not sufficiently expressed
min_pct <- 0.05
counts <- counts[, apply(counts, 2, function(x) mean(x > 0) > min_pct), drop = FALSE]

# sample the number of
if (!is.null(subsample)) {
ix <- sample.int(nrow(counts), min(nrow(counts), subsample))
} else {
ix <- seq_len(nrow(counts))
}

# estimate splatter params
estimate <- splatter::splatEstimate(t(counts[ix, , drop = FALSE]))
attr(class(estimate), "package") <- NULL # make sure scater won't get loaded when the platform is loaded

# determine how many features change between trajectory stages
group_ids <- unique(dataset_raw$grouping)

# differential expression using wilcox test
diffexp <- map_df(group_ids, function(group_id) {
inside <- dataset_raw$grouping == group_id
outside <- dataset_raw$grouping != group_id

expression_inside <- log2(counts[inside, ] + 1)
expression_outside <- log2(counts[outside, ] + 1)

result <- map_df(colnames(expression_inside), function(feature_id) {
pvalue <- wilcox.test(expression_inside[, feature_id], expression_outside[, feature_id])$p.value
log2fc <- mean(expression_inside[, feature_id]) - mean(expression_outside[, feature_id])

tibble(
pvalue = pvalue,
log2fc = log2fc,
feature_id = feature_id,
group_id = group_id
)
})
}) %>%
mutate(qvalue = p.adjust(pvalue, "fdr"))

qvalue_cutoff <- 0.05
log2fc_cutoff <- 1
diffexp_features <- diffexp %>% filter(
qvalue < qvalue_cutoff,
abs(log2fc) > log2fc_cutoff
) %>%
pull(feature_id) %>%
unique()

pct_main_features <- length(diffexp_features) / ncol(dataset_raw$counts)

# create platform object
lst(
estimate,
pct_main_features,
num_cells = nrow(counts),
num_features = ncol(counts)
)
}

#' @param n_cells The number of cells
#' @param n_features The number of features
#' @param pct_main_features The percentage of features that are being driven by the trajectory (or vice versa)
#' @param dropout_rate The mean rate of dropouts
#' @param dropout_shape The shape of dropouts
#'
#' @rdname platform
#'
#' @export
platform_simple <- function(
n_cells = 100L,
n_features = 1000L,
pct_main_features = 0.5,
dropout_rate = 0.01,
dropout_shape = 1
) {
list(
platform_id = "simple",
estimate = splatter::newSplatParams(mean.rate = dropout_rate, mean.shape = dropout_shape),
num_cells = n_cells,
num_features = n_features,
pct_main_features = pct_main_features
)
}






#' List and load the platforms
#' @export
load_platforms <- function() {
@@ -63,8 +181,7 @@ select_platforms <- function(n_platforms) {

#' Estimate a platform
#' @param dataset_id The dataset_id from which the platform will be estimated, using the files in `datasets_preproc/raw``
#' @inheritParams dyngen::get_platform_from_counts
#' @importFrom dyngen get_platform_from_counts
#' @inheritParams platform_from_counts
#' @export
estimate_platform <- function(dataset_id, subsample = 500) {
platform_location <- derived_file(paste0(dataset_id, ".rds"), experiment_id = "01-platforms")
@@ -78,7 +195,7 @@ estimate_platform <- function(dataset_id, subsample = 500) {
counts <- dataset_raw$counts
grouping <- dataset_raw$grouping

dyngen::get_platform_from_counts(counts, grouping, subsample = subsample)
platform_from_counts(counts, grouping, subsample = subsample)
}
)

@@ -23,7 +23,7 @@ NULL
simulate_splatter <- function(
dataset_id,
topology_model = "linear",
platform = dyngen::load_simple_platform(),
platform = platform_simple(),
n_steps_per_length = 100,
path.skew = runif(1, 0, 1),
path.nonlinearProb = runif(1, 0, 1),
@@ -140,7 +140,7 @@ simulate_splatter <- function(
simulate_prosstt <- function(
dataset_id,
topology_model = "linear",
platform = dyngen::load_simple_platform(),
platform = platform_simple(),
n_steps_per_length = 100,
a = as.integer(round(runif(1, 1, 10))),
intra_branch_tol = runif(1, 0, 0.9),
@@ -300,7 +300,7 @@ simulate_prosstt <- function(
simulate_dyntoy <- function(
dataset_id,
topology_model = "linear",
platform = dyngen::load_simple_platform(),
platform = platform_simple(),
count_mean_shape = runif(1, 1, 10),
count_mean_scale = runif(1, 1, 10),
dropout_probability_factor = runif(1, 10, 200),
@@ -359,7 +359,7 @@ simulate_dyntoy <- function(
# simulate_dyngen <- function(
# dataset_id,
# modulenet_name = "linear",
# platform = dyngen::platform_simple(),
# platform = platform_simple(),
# use_cache = TRUE,
# seed = NULL
# ) {
@@ -90,16 +90,15 @@ benchmark_aggregate <- function(
if (is.character(mean_fun)) {
mean_fun <- switch(
mean_fun,
geometric = dyneval::calculate_geometric_mean,
harmonic = dyneval::calculate_harmonic_mean,
arithmetic = dyneval::calculate_arithmetic_mean
geometric = dynutils::calculate_geometric_mean,
harmonic = dynutils::calculate_harmonic_mean,
arithmetic = dynutils::calculate_arithmetic_mean
)
}

calc_mean <- function(df) {
lis <- df %>% select(!!names(mean_weights)) %>% as.list()
lis$weights <- mean_weights
df$overall <- do.call(mean_fun, lis)
df$overall <- mean_fun(lis, weights = mean_weights)
df
}

@@ -18,6 +18,7 @@
#' @param verbose Whether or not to print extra information.
#' @param local_output_folder A folder in which to output intermediate and final results.
#' @param remote_output_folder A folder in which to store intermediate results in a remote directory when using the qsub package.
#' @param seed A seed for the parameter optimisation
#'
#' @importFrom readr read_rds write_rds
#' @importFrom mlrMBO makeMBOControl setMBOControlTermination setMBOControlInfill makeMBOInfillCritDIB makeMBOInfillCritCB

Some generated files are not rendered by default. Learn more.

Some generated files are not rendered by default. Learn more.

Some generated files are not rendered by default. Learn more.

Some generated files are not rendered by default. Learn more.

0 comments on commit e16b237

Please sign in to comment.
You can’t perform that action at this time.