how_to_use_cpp_stringvec.R

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

go_list <- list()
for (i in clean_kegg[,unique(id)]){
  go_list[[i]] <- clean_kegg[id==i,unique(gene)]
}

candidates <- c("ABL1","ABL2","ACTB","BID","CASP3","CASP8","CASP9","CAV1")
sapply(go_list, function(x) stringVec_intersectLength(candidates,x),simplify = "vector") + sapply(go_list, function(x) stringVec_intersectLength(candidates,x),simplify = "vector")







# permute blocks
out[,unique(gene),by=stat]
annotate_permutation_multi(permDT = out, feature_set_map = clean_kegg, permutation_n = 1, output_genes = FALSE)

n_perms <- 50000
go_perm_list <- rep(list(rep.int(0,times = clean_kegg[,uniqueN(id)])), n_perms)
for(n in 1:n_perms){
  perm <- permute_blocks(features = optimised_blocks[[1]][[3]],blocks = optimised_blocks[[1]][[1]])
  out <- melt_permuation_list(lapply(optimised_blocks[[1]][[2]], function(x) data.table::foverlaps(x, perm, nomatch = 0, by.x = c("id", "block.relative_start", "block.relative_end"))))
  go_perm_list[[n]] <- out[,.(stat,g=gene)][,clean_kegg[,stringVec_intersectLength(gene,g),by=id],by=stat][,sum(V1),by=id]$V1
}

set_count <- function(features, blocks, stats, feature_set_map){
  perm <- permute_blocks(features,blocks)
  out <- melt_permuation_list(
    lapply(stats,
           function(x) data.table::foverlaps(x,
                                             perm,
                                             nomatch = 0,
                                             by.x = c("id", "block.relative_start", "block.relative_end"))))
  count <- out[,.(stat,g=gene)][,feature_set_map[,stringVec_intersectLength(gene,g),by=id],by=stat][,sum(V1),by=id]$V1
  return(count)
}

set_count(features = optimised_blocks[[1]][[3]], blocks = optimised_blocks[[1]][[1]], stats=optimised_blocks[[1]][[2]], feature_set_map = clean_kegg)
system.time(go_perm_list <- parallel::mclapply(
  go_perm_list,
  function(x) set_count(features = optimised_blocks[[1]][[3]],
                        blocks = optimised_blocks[[1]][[1]],
                        stats=optimised_blocks[[1]][[2]],
                        feature_set_map = clean_kegg),
  mc.cores = 4))


{l$b <- 1+l$a ; l}