biopipen 0.21.0__py3-none-any.whl → 0.34.26__py3-none-any.whl

biopipen/scripts/rnaseq/Simulation-ESCO.R

@@ -0,0 +1,180 @@
+
+library(ESCO)
+library(rlang)
+library(glue)
+library(biopipen.utils)
+
+args <- {{envs.esco_args | r: todot="-"}}
+args <- args %||% list()
+
+save <- args$save
+args$save <- NULL
+
+log <- get_logger()
+
+if (!is.null(seed)) {
+    set.seed(seed)
+    args$seed <- seed
+}
+args$nGenes <- ngenes
+args$nCells <- nsamples
+args$dirname <- paste0(outdir, "/")
+args$verbose <- TRUE
+args$numCores <- ncores
+type <- args$type
+
+log$info("Running simulation ...")
+sim <- do_call(escoSimulate, args)
+attributes(sim) <- c(attributes(sim), c(simulation_tool = "ESCO"))
+save_obj(sim, file.path(outdir, "sim.rds"))
+
+log$info("Plotting ...")
+if (type == "single") {
+    asys <- assays(sim)
+    datalist = list(`simulated-truth` = asys$TrueCounts)
+    if (!is.null(asys$counts)) {
+        datalist$`zero-inflated` = asys$counts
+    }
+    if (!is.null(asys$observedcounts)) {
+        datalist$`down-sampled` = asys$observedcounts
+    }
+
+    log$info("- Plotting the data ...")
+    dataplot <- file.path(outdir, "data.png")
+    png(dataplot, width=length(datalist) * 600, height=1200, res=30)
+    heatdata(datalist, norm = FALSE, size = 2, ncol = 3)
+    dev.off()
+
+    rholist <- metadata(sim)$Params@corr
+    if (length(rholist) > 0) {
+        log$info("- Plotting the GCN ...")
+        corrgenes <- rownames(rholist[[1]])
+        gcnlist = lapply(datalist, function(data)gcn(data, genes = corrgenes))
+        gcnlist = append(gcnlist, list("given truth" = rholist[[1]]), 1)
+
+        gcnplot <- file.path(outdir, "gcn.png")
+        png(gcnplot, width=length(gcnlist) * 600, height=1200, res=30)
+        heatgcn(gcnlist, size = 2, ncol = 4)
+        dev.off()
+    }
+} else if (type == "groups") {
+    asys <- assays(sim)
+    # organize the marker gene info
+    genegroup = paste0("Group", rowData(sim)$GeneGroup)
+    genegroup[which(genegroup=="Group0")] = "None"
+    geneinfo = data.frame(genes = rowData(sim)$Gene,
+                          newcelltype = as.factor(genegroup))
+
+    # organize the cell info
+    cellinfo = data.frame(çells = colData(sim)$Cell,
+                          newcelltype= as.factor(colData(sim)$Group))
+
+    # data
+    datalist = list(`simulated-truth` = asys$TrueCounts)
+    if (!is.null(asys$counts)) {
+        datalist$`zero-inflated` = asys$counts
+    }
+    if (!is.null(asys$observedcounts)) {
+        datalist$`down-sampled` = asys$observedcounts
+    }
+
+    log$info("- Plotting the data ...")
+    dataplot <- file.path(outdir, "data.png")
+    png(dataplot, width=length(datalist) * 600, height=1200, res=30)
+    heatdata(datalist, cellinfo = cellinfo, geneinfo = geneinfo, size = 1, ncol = 3)
+    dev.off()
+
+    log$info("- Plotting the GCN for all marker genes (i.e. DE genes) across all cell groups ...")
+    degeneinfo = geneinfo[which(geneinfo$newcelltype!="None"),]
+    degeneinfo$newcelltype = droplevels(degeneinfo$newcelltype)
+    degcnlist = lapply(datalist, function(data)gcn(data, genes = degeneinfo$genes))
+    gcnplot <- file.path(outdir, "gcn-allgroups.png")
+    png(gcnplot, width=length(degcnlist) * 700, height=1200, res=30)
+    heatgcn(degcnlist, geneinfo = degeneinfo, size = 2, ncol = 3)
+    dev.off()
+
+    log$info("- Plotting the GCN for marker genes within one cell group ...")
+    rholist = metadata(sim)$Params@corr
+    group2_gcnlist = lapply(datalist,
+                            function(data){
+                            gcn(data[,which(colData(sim)$Group=="Group2")],
+                                CPM2 = TRUE,
+                                genes = rownames(rholist[["Group2"]]))})
+    group2_gcnlist = append(group2_gcnlist,
+                            list("given truth" = rholist[["Group2"]]), 1)
+    gcnplot2 <- file.path(outdir, "gcn-onegroup.png")
+    png(gcnplot2, width=length(group2_gcnlist) * 700, height=1200, res=30)
+    heatgcn(group2_gcnlist, size = 3, ncol = 4)
+    dev.off()
+} else if (type == "tree") {
+    # get the data
+    datatrue = assays(sim)$TrueCounts
+
+    # get the cellinfo
+    cellinfo  = data.frame(cell = colData(sim)$Cell,
+                        newcelltype = as.factor(colData(sim)$Group))
+    levels(cellinfo$newcelltype) = tree$tip.label
+
+    # get the geneinfo
+    genegroup = paste0("Group", rowData(sim)$GeneGroup)
+    genegroup[which(genegroup=="Group0")] = "None"
+    geneinfo = data.frame(genes = rowData(sim)$Gene,
+                        newcelltype = as.factor(genegroup))
+    levels(geneinfo$newcelltype)[1:3] = tree$tip.label
+
+    # get the DE geneinfo
+    groups <- colData(sim)$Group
+    group.names <- sort(unique(groups))
+    group.facs.gene <- rowData(sim)[, paste0("DEFac", group.names)]
+    DEgene.name = as.character(rowData(sim)$Gene[which(group.facs.gene[,1]>1)])
+    degeneinfo = geneinfo[match(DEgene.name, geneinfo$genes),]
+
+    log$info("- Plotting the data ...")
+    dataplot <- file.path(outdir, "data.png")
+    png(dataplot, width=2000, height=1200, res=30)
+    # plot the data
+    heatdata(list(datatrue),
+            colv = TRUE,
+            cellinfo = cellinfo,
+            geneinfo = degeneinfo,
+            genes = degeneinfo$genes,
+            size = 1.5, ncol = 1)
+    dev.off()
+} else if (type == "traj") {
+    datatrue = assays(sim)$TrueCounts
+
+    # get the cellinfo
+    cellinfo = data.frame(cell = colData(sim)$Cell,
+                        newcelltype = colData(sim)$Path)
+    # get the pesudo time
+    celltime = data.frame(path = as.numeric(colData(sim)$Path),
+                        step = as.numeric(colData(sim)$Step))
+    celltime = order(celltime[,1], celltime[,2])
+
+    # get the geneinfo
+    degenes = which(metadata(sim)$Params@paths.DEgenes==1)
+
+    log$info("- Plotting the trajectory ...")
+    trajplot <- file.path(outdir, "traj.png")
+    png(trajplot, width=1600, height=1200, res=30)
+    # plot the data
+    umapplot(t(t(datatrue)/colSums(datatrue)),
+            celltype  = colData(sim)$Path,
+            labels = levels(as.factor(colData(sim)$Path)))
+    dev.off()
+
+    log$info("- Plotting the data ...")
+    dataplot <- file.path(outdir, "data.png")
+    heatdata(list("simulated truth" = datatrue[degenes,]),
+         cellinfo = cellinfo,
+         colv = celltime, size = 1, ncol = 1)
+    dev.off()
+}
+
+simulated <- switch(save,
+    `simulated-truth` = assays(sim)$TrueCounts,
+    `zero-inflated` = assays(sim)$counts,
+    `down-sampled` = assays(sim)$observedcounts,
+    { stop(glue("Unknown save option: {save}, expected one of 'simulated-truth', 'zero-inflated', 'down-sampled'")) }
+)
+

biopipen/scripts/rnaseq/Simulation-RUVcorr.R

@@ -0,0 +1,45 @@
+
+library(rlang)
+library(RUVcorr)
+library(biopipen.utils)
+
+log <- get_logger()
+
+args <- {{envs.ruvcorr_args | r: todot="-"}}
+if (!is.null(seed)) { set.seed(seed) }
+
+args$k <- args$k %||% 10
+args$size.alpha <- args$size.alpha %||% 2
+args$corr.strength <- args$corr.strength %||% 3
+args$g <- args$g %||% NULL
+args$Sigma.eps <- args$Sigma.eps %||% 1
+args$nc <- args$nc %||% (ngenes %/% 4)
+args$ne <- args$ne %||% (ngenes %/% 4)
+args$intercept <- args$intercept %||% TRUE
+args$check <- args$check %||% TRUE
+args$n = ngenes
+args$m = nsamples
+
+log$info("Running simulation ...")
+sim <- do_call(simulateGEdata, args)
+attributes(sim) <- c(attributes(sim), c(simulation_tool = "RUVcorr"))
+genes <- paste0("Gene", 1:ngenes)
+samples <- paste0("Sample", 1:nsamples)
+
+colnames(sim$Truth) <- genes
+rownames(sim$Truth) <- samples
+sim$Truth <- t(sim$Truth)
+colnames(sim$Y) <- genes
+rownames(sim$Y) <- samples
+sim$Y <- t(sim$Y)
+colnames(sim$Noise) <- genes
+rownames(sim$Noise) <- samples
+sim$Noise <- t(sim$Noise)
+colnames(sim$Sigma) <- genes
+rownames(sim$Sigma) <- genes
+
+log$info("Saving results ...")
+save_obj(sim, file.path(outdir, "sim.rds"))
+save_obj(sim$Truth, file.path(outdir, "Truth.rds"))
+
+simulated <- sim$Y

biopipen/scripts/rnaseq/Simulation.R

@@ -0,0 +1,21 @@
+ngenes <- {{in.ngenes | r}}
+nsamples <- {{in.nsamples | r}}
+outfile <- {{out.outfile | r}}
+outdir <- {{out.outdir | r}}
+seed <- {{envs.seed | r}}
+ncores <- {{envs.ncores | r}}
+transpose_output <- {{envs.transpose_output | r}}
+index_start <- {{envs.index_start | r}}
+
+{% if envs.tool.lower()  == "ruvcorr" %}
+{% include biopipen_dir + "/scripts/rnaseq/Simulation-RUVcorr.R" %}
+{% elif envs.tool.lower() == "esco" %}
+{% include biopipen_dir + "/scripts/rnaseq/Simulation-ESCO.R" %}
+{% else %}
+stop("Unknown tool: {{envs.tool}}, only 'RUVcorr' and 'ESCO' are supported.")
+{% endif %}
+
+colnames(simulated) <- paste0("Sample", index_start + 0:(nsamples - 1))
+if (transpose_output) { simulated <- t(simulated) }
+
+write.table(simulated, file = outfile, sep = "\t", quote = FALSE, row.names = TRUE, col.names = TRUE)

biopipen/scripts/rnaseq/UnitConversion.R

@@ -1,73 +1,344 @@
-infile = {{in.infile | r}}
-outfile = {{out.outfile | r}}
-infmt = {{envs.infmt | r}}
-inunit = {{envs.inunit | r}}
-outunit = {{envs.outunit | r}}
-refexon = {{envs.refexon | r}}
-inlog2p = {{envs.inlog2p | r}}
-outlog2p = {{envs.outlog2p | r}}
+library(rlang)
+library(glue)
+library(biopipen.utils)
 
-if (infmt == "rds") {
-    indata = readRDS(infile)
-} else if (endsWith(infile, ".gz")) {
-    indata = read.table(infile, header=T, row.names=NULL, sep="\t", check.names = F)
-    genes = make.unique(indata[, 1])
-    indata = indata[, -1]
-    rownames(indata) = genes
+infile <- {{in.infile | r}}
+outfile <- {{out.outfile | r}}
+inunit <- {{envs.inunit | r}}
+outunit <- {{envs.outunit | r}}
+refexon <- {{envs.refexon | r}}
+meanfl <- {{envs.meanfl | r}}
+nreads <- {{envs.nreads | r}}
+
+log <- get_logger()
+
+log$info("Reading input data ...")
+indata = read.table(infile, header = TRUE, sep = "\t", row.names = 1, check.names = F)
+samples = colnames(indata)
+
+# parse the inunit to see if there is any transformation
+parsable <- function(arg) {	is.call(arg) || is_symbol(arg) }
+
+check_call_args <- function(arg1, arg2) {
+    if (parsable(arg1) && parsable(arg2)) {
+        stop(glue("Can't parse the call. Multiple names or calls detected: {arg1}, {arg2}\n"))
+    }
+    if (!parsable(arg1) && !parsable(arg2)) {
+        stop(glue("Can't parse the call. Both arguments are constants: {arg1}, {arg2}. Use the result directly\n"))
+    }
 }
 
+parse_call <- function(call, expr = "indata") {
+    if (!is.call(call)) {
+        call <- match.arg(
+            as_string(call),
+            c(
+                "count", "counts", "rawcount", "rawcounts",
+                "cpm",
+                "fpkm", "rpkm",
+                "fpkmuq", "rpkmuq",
+                "tpm",
+                "tmm"
+            )
+        )
+        return(glue("{as_string(call)} = {expr}"))
+    }
+    cn <- as_string(call_name(call))
+    args <- call_args(call)
+    if (length(args) == 1) {
+        # This should be those supported functions
+        cn <- match.arg(cn, c("log", "log2", "log10", "exp", "sqrt"))
+        if (cn == "log") return(parse_call(args[[1]], glue("e ^ ({expr})")))
+        if (cn == "log2") return(parse_call(args[[1]], glue("2 ^ ({expr})")))
+        if (cn == "log10") return(parse_call(args[[1]], glue("10 ^ ({expr})")))
+        if (cn == "exp") return(parse_call(args[[1]], glue("log({expr})")))
+        if (cn == "sqrt") return(parse_call(args[[1]], glue("({expr}) ^ 2")))
+    } else {
+        check_call_args(args[[1]], args[[2]])
+        if (cn == "+") {
+            if (parsable(args[[1]])) return(parse_call(args[[1]], glue("{expr} - {args[[2]]}")))
+            return(parse_call(args[[2]], glue("{expr} - {args[[1]]}")))
+        }
+        if (cn == "-") {
+            if (parsable(args[[1]])) return(parse_call(args[[1]], glue("{expr} + {args[[2]]}")))
+            return(parse_call(args[[2]], glue("{args[[1]]} - {expr}")))
+        }
+        if (cn == "*") {
+            if (parsable(args[[1]])) return(parse_call(args[[1]], glue("({expr}) / ({args[[2]]})")))
+            return(parse_call(args[[2]], glue("({expr}) / ({args[[1]]})")))
+        }
+        if (cn == "/") {
+            if (parsable(args[[1]])) return(parse_call(args[[1]], glue("({expr}) * ({args[[2]]})")))
+            return(parse_call(args[[2]], glue("({args[[1]]}) / ({expr})")))
+        }
+        if (cn == "^") {
+            if (parsable(args[[1]])) return(parse_call(args[[1]], glue("{expr} * (1 / ({args[[2]]}))")))
+            return(parse_call(args[[2]], glue("log({expr}, {args[[1]]})")))
+        }
+        stop(paste0("Unknown function to parse: {cn}\n"))
+    }
+}
 
-glenFromExon = function(exonfile, x) {
-	gff  = read.table(exonfile, header = F, row.names = NULL)
-	# V4: start, V5: end, V10: gene name
-	glen = aggregate(V5-V4+1 ~ V10, gff, sum)
-	genes = glen[,1]
-	glen = glen[,-1,drop=F]
-	rownames(glen) = genes
+glenFromExon = function(exonfile, data) {
+    gff  = read.table(exonfile, header = F, row.names = NULL)
+    # V4: start, V5: end, V10: gene name
+    glen = aggregate(V5-V4+1 ~ V10, gff, sum)
+    genes = glen[,1]
+    glen = glen[,-1,drop=F]
+    rownames(glen) = genes
 
-	mygenes  = rownames(x)
-	outgenes = intersect(genes, mygenes)
-	if (length(outgenes) < length(mygenes))
-		warning('Genes not found in refexon: ', paste(setdiff(mygenes, outgenes)))
+    mygenes  = rownames(data)
+    outgenes = intersect(genes, mygenes)
+    if (length(outgenes) < length(mygenes))
+        logger('Genes not found in refexon: ', paste(setdiff(mygenes, outgenes), collapse = ','), level = 'WARNING')
 
-	glen[outgenes, , drop = FALSE]
+    glen[outgenes, , drop = FALSE]
 }
 
 meanflFromFile = function(samples, mflfile) {
-	if (is.numeric(mflfile)) {
-		ret = matrix(mflfile, nrow = length(samples), ncol = 1)
-		rownames(ret) = samples
-	} else {
-		ret = read.table(mflfile, header = F, row.names = 1, check.names = F, sep = "\t")
-		ret = ret[samples,,drop = F]
-	}
-	ret
+    if (is.numeric(mflfile)) {
+        ret = matrix(mflfile, nrow = length(samples), ncol = 1)
+        rownames(ret) = samples
+    } else {
+        ret = read.table(mflfile, header = F, row.names = 1, check.names = F, sep = "\t")
+        ret = ret[samples,,drop = F]
+    }
+    ret
 }
 
-count2tpm = function(x) {
-	glen = glenFromExon(refexon, x)
-	x = x[rownames(glen), , drop = F]
-	fld  = meanflFromFile(samples, meanfl)
+nreadsFromFile = function(samples, nreads) {
+    if (is.numeric(nreads)) {
+        ret = matrix(nreads, nrow = length(samples), ncol = 1)
+        rownames(ret) = samples
+    } else {
+        ret = read.table(nreads, header = F, row.names = 1, check.names = F, sep = "\t")
+        ret = ret[samples,,drop = F]
+    }
+    ret
+}
 
-	# see: https://gist.github.com/slowkow/c6ab0348747f86e2748b
-	expr = as.data.frame(sapply(samples, function(s){
-		rate  = log(x[, s]) - log(glen - fld[s, ] + 1)
-		denom = log(sum(exp(rate)))
-		exp(rate - denom + log(1e6))
-	}))
-	colnames(expr) = colnames(x)
-	rownames(expr) = rownames(x)
-	expr
+count2cpm <- function(data) {
+    edgeR::cpm(data)
 }
 
-if (inunit %in% c('count', 'counts', 'rawcount', 'rawcounts')) {
-    inunit = "count"
+count2fpkm = function(data) {
+    # may lose some genes
+    glen = glenFromExon(refexon, data)
+    data = data[rownames(glen), , drop = F]
+    dge  = edgeR::DGEList(counts=data)
+
+    dge$genes$Length = glen
+    edgeR::rpkm(dge)
 }
 
+count2fpkmuq = function(data) {
+    # may lose some genes
+    glen = glenFromExon(refexon, data)
+    data = data[rownames(glen), , drop = FALSE]
+
+    fld  = meanflFromFile(samples, meanfl)
+    expr = sapply(samples, function(s){
+        RC75 = quantile(data[, s], .75)
+        exp( log(data[, s]) + log(1e9) - log(glen - fld[s, ] + 1) - log(RC75) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+count2tpm = function(data) {
+    glen = glenFromExon(refexon, data)
+    data = data[rownames(glen), , drop = F]
+    fld  = meanflFromFile(samples, meanfl)
+
+    # see: https://gist.github.com/slowkow/c6ab0348747f86e2748b
+    expr = as.data.frame(sapply(samples, function(s){
+        rate  = log(data[, s]) - log(glen - fld[s, ] + 1)
+        denom = log(sum(exp(rate)))
+        exp(rate - denom + log(1e6))
+    }))
+    colnames(expr) = colnames(data)
+    rownames(expr) = rownames(data)
+    expr
+}
+
+count2tmm = function(data) {
+    dge = edgeR::DGEList(counts=data)
+    dge = edgeR::calcNormFactors(dge, method = "TMM")
+    edgeR::cpm(dge)
+}
+
+fpkm2count = function(data) {
+    glen    = glenFromExon(refexon, data)
+    data    = data[rownames(glen), , drop = F]
+    fld     = meanflFromFile(samples, meanfl)
+    totalnr = nreadsFromFile(samples, nreads)
+
+    expr    = sapply(samples, function(s){
+        N = totalnr[s, ]
+        exp( log(data[, s]) + log(N) + log(glen - fld[s, ] + 1) - log(1e9) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+fpkm2tpm = function(data) {
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) - log(sum(data[, s])) + log(1e6) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+fpkm2cpm = function(data) {
+    glen = glenFromExon(refexon, data)
+    data = data[rownames(glen), , drop = F]
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) - log(1e3) - log(glen - fld[s, ] + 1) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+tpm2count = function(data) {
+    totalnr = nreadsFromFile(samples, nreads)
+    ngenes  = nrow(data)
+
+    expr     = sapply(samples, function(s){
+        # counts to tpm:
+        # rate <- log(counts) - log(effLen)
+        # denom <- log(sum(exp(rate)))
+        # tpm = exp(rate - denom + log(1e6))
+        # so:
+        # log(tpm) = rate - denom + log(1e6)
+        # rate = log(tpm) + denom - log(1e6)
+        # log(counts) - log(effLen) = log(tpm) + log(sum(exp(rate))) - log(1e6)
+        # log(counts) - log(effLen) = log(tpm) + log(sum(exp(log(counts) - log(effLen)))) - log(1e6)
+        # log(counts) - log(effLen) = log(tpm) + log(sum(exp(log(counts))/exp(log(effLen)))) - log(1e6)
+        # log(counts) - log(effLen) = log(tpm) + log(sum(counts/effLen)) - log(1e6)
+        #                                                ?????????????
+        # ??? estimated by sum(counts)/sum(effLen) * length(effLen)
+        # log(counts) = log(effLen) + log(tpm) + log(sum(counts)) - log(effLen) + log(length(effLen))) - log(1e6)
+        # counts = expr( log(tpm) + log(nreads) + log(length(effLen)) - log(1e6) )
+        exp( log(data[, s]) + log(totalnr[s, ]) + log(ngenes) - log(1e6) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+tpm2fpkm = function(data) {
+    totalnr = nreadsFromFile(samples, nreads)
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) - log(1e6) + log(totalnr[s, ]) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+tpm2cpm = function(data) {
+    glen   = glenFromExon(refexon, data)
+    data   = data[rownames(glen), , drop = F]
+    fld    = meanflFromFile(samples, meanfl)
+    ngenes = length(outgenes)
+
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) + log(glen - fld[s, ] + 1) - log(sum(glen - fld[s, ] + 1)) + log(ngenes) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+cpm2count = function(data) {
+    totalnr = nreadsFromFile(samples, nreads)
+
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) + log(totalnr[s, ]) - log(1e6) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+cpm2fpkm = function(data) {
+    glen = glenFromExon(refexon, data)
+    data = data[rownames(glen), , drop = F]
+    expr = sapply(samples, function(s) {
+        exp( log(data[, s]) + log(1e3) - log(glen - fld[s, ] + 1) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+cpm2tpm = function(data) {
+    glen   = glenFromExon(refexon, data)
+    data   = data[rownames(glen), , drop = F]
+    ngenes = nrow(glen)
+    expr   = sapply(samples, function(s) {
+        exp( log(data[, s]) - log(glen - fld[s, ] + 1) - log(sum(glen - fld[s, ] + 1)) + log(ngenes) )
+    })
+    rownames(expr) = rownames(data)
+    expr
+}
+
+is.count  = function(unit) {unit %in% c('count', 'counts', 'rawcount', 'rawcounts')}
+is.cpm    = function(unit) {unit == 'cpm'}
+is.fpkm   = function(unit) {unit %in% c('fpkm', 'rpkm')}
+is.fpkmuq = function(unit) {unit %in% c('fpkmuq', 'rpkmuq')}
+is.tpm    = function(unit) {unit == 'tpm'}
+is.tmm    = function(unit) {unit == 'tmm'}
+
+# log2(count + 1) -> count = 2 ^ indata - 1
+parsed_transformation <- parse_call(parse_expr(inunit))
+splits <- strsplit(parsed_transformation, " = ")[[1]]
+if (is.count(splits[[1]])) {
+    intype <- "count"
+} else if (is.cpm(splits[[1]])) {
+    intype <- "cpm"
+} else if (is.fpkm(splits[[1]])) {
+    intype <- "fpkm"
+} else if (is.fpkmuq(splits[[1]])) {
+    intype <- "fpkmuq"
+} else if (is.tpm(splits[[1]])) {
+    intype <- "tpm"
+} else if (is.tmm(splits[[1]])) {
+    intype <- "tmm"
+} else {
+    stop(glue("Can't find a supported unit in the inunit: {inunit}\n"))
+}
+splits[1] <- intype
+eval(parse_expr(paste(splits, collapse = " = ")))
+indata <- get(intype)
+
+# find out the outtype
+if (grepl('rawcounts|rawcount|counts|count', outunit)) {
+    outtype <- 'count'
+    outunit <- gsub('rawcounts|rawcount|counts|count', 'count', outunit)
+} else if (grepl('fpkmuq|rpkmuq', outunit)) {
+    outtype <- 'fpkmuq'
+    outunit <- gsub('fpkmuq|rpkmuq', 'fpkmuq', outunit)
+} else if (grepl('fpkm|rpkm', outunit)) {
+    outtype <- 'fpkm'
+    outunit <- gsub('fpkm|rpkm', 'fpkm', outunit)
+} else if (grepl('tpm', outunit)) {
+    outtype <- 'tpm'
+} else if (grepl('cpm', outunit)) {
+    outtype <- 'cpm'
+} else if (grepl('tmm', outunit)) {
+    outtype <- 'tmm'
+} else {
+    stop(glue("Can't find a supported unit in the outunit: {outunit}\n"))
+}
 
-convert = function(data, inunit, outunit) {
-    func = get(paste0(inunit, "2", outunit))
-    func(data)
+log$info("Transforming data by resolving {inunit} ...")
+if (intype == outtype) {
+    fun <- identity
+} else {
+    fun <- glue("{intype}2{outtype}")
+    fun <- tryCatch(
+        { get(fun) },
+        error = function(e) { stop(glue("Unsupported conversion from {intype} to {outunit}\n")) }
+    )
 }
+assign(outtype, fun(indata))
+out <- eval(parse_expr(outunit))
 
-convert(indata, inunit, outunit)
+log$info("Saving output data ...")
+write.table(out, outfile, quote=FALSE, row.names=TRUE, col.names=TRUE, sep="\t")

biopipen/scripts/scrna/AnnData2Seurat.R

@@ -0,0 +1,40 @@
+library(rlang)
+library(Seurat)
+library(scplotter)
+library(biopipen.utils)
+
+adfile <- {{in.adfile | r}}
+outfile <- {{out.outfile | r}}
+dotplot_check <- {{envs.dotplot_check | r}}
+outdir <- dirname(outfile)
+assay <- {{envs.assay | r}}
+ident <- {{envs.ident | r}}
+
+log <- get_logger()
+
+ConvertAnnDataToSeurat(adfile, outfile = outfile, assay = assay, ident = ident, log = log)
+
+if (!isFALSE(dotplot_check)) {
+    log$info("Reading Seurat object ...")
+    sobj <- read_obj(outfile)
+
+    log$info("Checking dotplot ...")
+    dotfig <- file.path(outdir, "dotplot.png")
+    if (isTRUE(dotplot_check)) {
+        vobj <- FindVariableFeatures(
+            sobj, selection.method = "vst", nfeatures = 2000)
+        dotplot_check <- head(VariableFeatures(vobj), 10)
+    } else if (is.character(dotplot_check)) {
+        dotplot_check <- trimws(strsplit(dotplot_check, ",")[[1]])
+    }
+    p <- FeatureStatPlot(
+        sobj, features = dotplot_check, plot_type = "dot",
+        assay = assay
+    )
+    res = 70
+    height <- attr(p, "height") * res
+    width <- attr(p, "width") * res
+    png(dotfig, width = width, height = height, res = res)
+    print(p)
+    dev.off()
+}