profiling.R

In joshuamschmidt/multiPermr: What the Package Does in One 'Title Case' Line

f_mclapply <- function(n_perm){
  result <- rbindlist(parallel::mclapply(1:n_perm, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                        features = optimised_blocks[[1]][[3]],
                                                                        feature_set_map = clean_kegg,
                                                                        permutation_n = x,
                                                                        allow_multiple_hits = TRUE),mc.cores = 4))
  return(result)
}

f_lapply <- function(n_perm){
  result <- rbindlist(parallel::lapply(1:n_perm, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                                           features = optimised_blocks[[1]][[3]],
                                                                                           feature_set_map = clean_kegg,
                                                                                           permutation_n = x,
                                                                                           allow_multiple_hits = TRUE)))
  return(result)
}



timing <- microbenchmark(
  f_mclapply = {
    set.seed(44)
    rbindlist(parallel::mclapply(1:1000, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                                   features = optimised_blocks[[1]][[3]],
                                                                                   feature_set_map = clean_kegg,
                                                                                   permutation_n = x,
                                                                                   allow_multiple_hits = TRUE),mc.cores = 4))
  },
  f_lapply = {
    set.seed(44)
    rbindlist(lapply(1:1000, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                                 features = optimised_blocks[[1]][[3]],
                                                                                 feature_set_map = clean_kegg,
                                                                                 permutation_n = x,
                                                                                 allow_multiple_hits = TRUE)))
  }
)


library(profvis)
profvis({
  rbindlist(parallel::mclapply(1:1000, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                               features = optimised_blocks[[1]][[3]],
                                                                               feature_set_map = clean_kegg,
                                                                               permutation_n = x,
                                                                               allow_multiple_hits = TRUE),mc.cores = 4))
})

p2 <- profvis({
  get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                               features = optimised_blocks[[1]][[3]],
                                                                               feature_set_map = clean_kegg,
                                                                               permutation_n = 1,
                                                                               allow_multiple_hits = TRUE)
})


f2 <- function(n_perm, feature_set_map){
  nrows <- n_perm * feature_set_map[,uniqueN(id)]
  result2 <- data.table(id=rep.int("id",times = nrows),
                       stat=rep.int("multi_hits",times = nrows),
                       set_n=rep.int(100,times = nrows),
                       stat_n_gene=rep.int(1000,times = nrows),
                       stat_unique_gene=rep.int(1000,times = nrows),
                       genes=rep.int(NA,times = nrows),
                       set_pr=rep.int(0.0001,times = nrows),
                       perm_n=rep.int(100,times = nrows))
  
  result <- rbindlist(lapply(1:n_perm, function(x) get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                                                                               features = optimised_blocks[[1]][[3]],
                                                                               feature_set_map = clean_kegg,
                                                                               permutation_n = x,
                                                                               allow_multiple_hits = TRUE)))
  return(result)
}


f3 <- function(perm_n){
  get_permutation_multi_stat2(stats = optimised_blocks[[1]][[2]],
                              features = optimised_blocks[[1]][[3]],
                              feature_set_map = clean_kegg,
                              permutation_n = perm_n,
                              allow_multiple_hits = TRUE)
}

d <- 1:10


# checking using statsDT instead of a list passed to lapply
statDT <- rbindlist(optimised_blocks[[1]][[2]],idcol = T)[,.(id, block.relative_start, block.relative_end,stat= .id)]
setkey(statDT, id, block.relative_start, block.relative_end)

timing <- microbenchmark(
  f_DT = { data.table::foverlaps(statDT,optimised_blocks[[1]][[3]],nomatch = NULL)[,.(gene=unique(gene)),by=stat]},
  f_lapply = {
    lapply(optimised_blocks[[1]][[2]],
           function(x) foverlaps(x, optimised_blocks[[1]][[3]],nomatch = NULL))
  },times = 1000)
# timing
# Unit: milliseconds
# expr      min       lq      mean   median       uq      max neval
# f_DT 28.80127 32.35388  38.59087 33.86784  36.9898 139.4598  1000
# f_lapply 76.94008 85.23036 104.76355 90.95546 115.1240 637.7678  1000

# ~ 2.74 speed up!