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

biopipen/scripts/snp/PlinkIBD.R

@@ -0,0 +1,196 @@
+suppressPackageStartupMessages({
+    library(dplyr)
+    library(tidyr)
+    library(tibble)
+	library(plotthis)
+	library(biopipen.utils)
+})
+
+indir    <- {{in.indir | r}}
+outdir   <- {{out.outdir | r}}
+plink    <- {{envs.plink | r}}
+indep    <- {{envs.indep | r}}
+highld   <- {{envs.highld | r}}
+devpars  <- {{envs.devpars | r}}
+pihat    <- {{envs.pihat | r}}
+samid    <- {{envs.samid | r}}
+annofile <- {{envs.anno | r}}
+doplot   <- {{envs.plot | r}}
+seed     <- {{envs.seed | r}}
+ncores   <- {{envs.ncores | r}}
+
+log <- get_logger()
+
+bedfile <- Sys.glob(file.path(indir, '*.bed'))
+if (length(bedfile) == 0)
+    stop("No bed files found in the input directory.")
+if (length(bedfile) > 1) {
+    log$warn("Multiple bed files found in the input directory. Using the first one.")
+    bedfile <- bedfile[1]
+}
+input  <- tools::file_path_sans_ext(bedfile)
+output <- file.path(outdir, basename(input))
+
+cmd <- c(
+    plink,
+    "--threads", ncores,
+    "--bfile", input,
+    "--indep-pairwise", indep,
+	"--keep-allele-order",
+	# One should be mindful of running this with < 50 samples
+	# "--bad-ld",
+    "--out", output
+)
+if (!is.null(highld) && !isFALSE(highld)) {
+    cmd <- c(cmd, "--range", "--exclude", highld)
+}
+run_command(cmd, fg = TRUE)
+
+prunein <- paste0(output, '.prune.in')
+cmd <- c(
+    plink,
+    "--threads", ncores,
+    "--bfile", input,
+    "--extract", prunein,
+	"--keep-allele-order",
+    "--genome",
+    "--out", output
+)
+run_command(cmd, fg = TRUE)
+
+genome <- read.table(
+    paste0(output, '.genome'),
+    row.names = NULL,
+    header = TRUE,
+    check.names = FALSE
+)
+# "unmelt" it
+# FID1 IID1 FID2 IID2 RT EZ Z0     Z1     Z2     PI_HAT PHE DST      PPC    RATIO
+# s1   s1   s2   s2   UN NA 1.0000 0.0000 0.0000 0.0000 -1  0.866584 0.0000 0.9194
+# s1   s1   s2   s2   UN NA 0.4846 0.3724 0.1431 0.3293 -1  0.913945 0.7236 2.0375
+# s1   s1   s3   s3   UN NA 1.0000 0.0000 0.0000 0.0000 -1  0.867186 0.0000 1.0791
+genome$SAMPLE1 <- paste(genome$FID1, genome$IID1, sep = "\t")
+genome$SAMPLE2 <- paste(genome$FID2, genome$IID2, sep = "\t")
+
+
+# get all samples
+samples <- unique(c(genome$SAMPLE1, genome$SAMPLE2))
+# make paired into a distance-like matrix
+similarity <- genome %>%
+    select(SAMPLE1, SAMPLE2, PI_HAT) %>%
+    pivot_wider(names_from = SAMPLE2, values_from = PI_HAT, values_fill = NA) %>%
+    as.data.frame() %>%
+    column_to_rownames("SAMPLE1")
+rm(genome)
+# get the rownames back
+samids <- rownames(similarity)
+# get samples that didn't involved
+missedrow <- setdiff(samples, rownames(similarity))
+missedcol <- setdiff(samples, colnames(similarity))
+similarity[missedrow, ] <- NA
+similarity[, missedcol] <- NA
+# order the matrix
+similarity <- similarity[samples, samples, drop = FALSE]
+# transpose the matrix to get the symmetric values
+sim2 <- t(similarity)
+isna <- is.na(similarity)
+# fill the na's with their symmetric values
+similarity[isna] <- sim2[isna]
+rm(sim2)
+# still missing: keep them
+similarity[is.na(similarity)] <- 0
+# get the marks (samples that fail the pihat cutoff)
+nsams <- length(samples)
+fails <- which(similarity > pihat)
+marks <- data.frame(x = (fails - 1)%%nsams + 1, y = ceiling(fails/nsams))
+diag(similarity) <- 1
+
+failflags <- rep(F, nrow(marks))
+freqs <- as.data.frame(table(factor(as.matrix(marks))))
+freqs <- freqs[order(freqs$Freq, decreasing = T), 'Var1', drop = T]
+ibd.fail <- c()
+while (sum(failflags) < nrow(marks)) {
+	samidx <- freqs[1]
+	ibd.fail <- c(ibd.fail, samples[samidx])
+	freqs <- freqs[-1]
+	sapply(1:nrow(marks), function(i) {
+		if (samidx %in% marks[i,])
+			failflags[i] <<- TRUE
+	})
+}
+
+ibd_fail_file <- paste0(output, '.ibd.fail')
+writeLines(ibd.fail, ibd_fail_file)
+cmd <- c(
+    plink,
+    "--threads", ncores,
+    "--bfile", input,
+    "--remove", ibd_fail_file,
+	"--keep-allele-order",
+	"--make-bed",
+    "--out", output
+)
+run_command(cmd, fg = TRUE)
+
+if (doplot) {
+	set.seed(seed)
+	library(ComplexHeatmap)
+	fontsize8 <- gpar(fontsize = 8)
+	fontsize9 <- gpar(fontsize = 9)
+	ht_opt$heatmap_row_names_gp <- fontsize8
+	ht_opt$heatmap_column_names_gp <- fontsize8
+	ht_opt$legend_title_gp <- fontsize9
+	ht_opt$legend_labels_gp <- fontsize8
+	ht_opt$simple_anno_size <- unit(3, "mm")
+
+	samids <- sapply(samples, function(sid) {
+		fidiid <- unlist(strsplit(sid, "\t", fixed = TRUE))
+		gsub(
+            "{fid}",
+            fidiid[1],
+            gsub("{iid}", fidiid[2], samid, fixed = TRUE),
+            fixed = TRUE
+        )
+	})
+	rownames(similarity) <- samids
+	colnames(similarity) <- samids
+
+	andata <- NULL
+	column_annotation <- NULL
+	if (!is.null(annofile) && !isFALSE(annofile)) {
+		options(stringsAsFactors = TRUE)
+		andata <- read.table(annofile, header = TRUE, row.names = 1, sep = "\t", check.names = FALSE)
+		andata <- andata[samids, , drop = FALSE]
+		for (anname in colnames(andata)) {
+			column_annotation <- c(column_annotation, anname)
+		}
+	}
+
+	p <- plotthis::Heatmap(
+		similarity,
+		name = "PI_HAT",
+        in_form = "matrix",
+        cell_type = "label",
+		rows_data = andata,
+		label = function(x) ifelse (x > pihat, '*', NA),
+        title = paste0("(*) PI_HAT > ", pihat),
+		clustering_distance_rows = function(m) as.dist(1-m),
+		clustering_distance_columns = function(m) as.dist(1-m),
+        show_row_names = TRUE,
+        show_column_names = TRUE,
+		column_annotation = column_annotation
+	)
+
+	res <- 100
+	height <- attr(p, "height") * res
+	width <- attr(p, "width") * res
+	png(
+		filename = paste0(output, '.ibd.png'),
+		width = width,
+		height = height,
+		res = res
+	)
+	print(p)
+	dev.off()
+
+}

biopipen/scripts/snp/PlinkSimulation.py

@@ -0,0 +1,124 @@
+from pathlib import Path
+from multiprocessing import Pool
+from slugify import slugify
+from simpleconf import Config
+from biopipen.utils.misc import logger, run_command, dict_to_cli_args
+
+configfile: str = {{in.configfile | quote}}  # pyright: ignore # noqa: E999
+outdir: str = {{out.outdir | quote}}  # pyright: ignore
+gtmatfile: str = {{out.gtmat | quote}}  # pyright: ignore
+config = Config.load(configfile)
+
+default_nsnps = {{envs.nsnps | repr}}  # pyright: ignore
+default_ncases = {{envs.ncases | repr}}  # pyright: ignore
+default_nctrls = {{envs.nctrls | repr}}  # pyright: ignore
+default_plink = {{envs.plink | repr}}  # pyright: ignore
+default_seed = {{envs.seed | repr}}  # pyright: ignore
+default_label = {{envs.label | repr}}  # pyright: ignore
+default_prevalence = {{envs.prevalence | repr}}  # pyright: ignore
+default_minfreq = {{envs.minfreq | repr}}  # pyright: ignore
+default_maxfreq = {{envs.maxfreq | repr}}  # pyright: ignore
+default_hetodds = {{envs.hetodds | repr}}  # pyright: ignore
+default_homodds = {{envs.homodds | repr}}  # pyright: ignore
+default_missing = {{envs.missing | repr}}  # pyright: ignore
+default_args: dict = {{envs.args | repr}}  # pyright: ignore
+default_transpose_gtmat = {{envs.transpose_gtmat | repr}}  # pyright: ignore
+default_sample_prefix = {{envs.sample_prefix | repr}}  # pyright: ignore
+
+defaults = {
+    "nsnps": default_nsnps,
+    "ncases": default_ncases,
+    "nctrls": default_nctrls,
+    "plink": default_plink,
+    "seed": default_seed,
+    "label": default_label,
+    "prevalence": default_prevalence,
+    "minfreq": default_minfreq,
+    "maxfreq": default_maxfreq,
+    "hetodds": default_hetodds,
+    "homodds": default_homodds,
+    "missing": default_missing,
+    # "args": default_args,
+    "transpose_gtmat": default_transpose_gtmat,
+    "sample_prefix": default_sample_prefix,
+}
+
+def do_one_simulation(confitems):
+    args = default_args.copy()
+    args.update(confitems.pop("args", {}))
+    confs = defaults.copy()
+    confs.update(confitems)
+    transpose_gtmat = confs.pop("transpose_gtmat")
+    sample_prefix = confs.pop("sample_prefix")
+
+
+    logger.debug("  Generating parameters file")
+    params_file = Path(outdir) / "params.txt"
+    params_file.write_text(
+        f"{confs['nsnps']}\t{confs['label']}\t{confs['minfreq']}\t"
+        f"{confs['maxfreq']}\t{confs['hetodds']}\t{confs['homodds']}\n"
+    )
+
+    if confs.get('seed') is not None:
+        args["seed"] = confs['seed']
+
+    args["simulate"] = params_file
+    args["out"] = Path(outdir) / "sim_snps"
+    args["simulate-ncases"] = confs['ncases']
+    args["simulate-ncontrols"] = confs['nctrls']
+    args["simulate-prevalence"] = confs['prevalence']
+    args["simulate-missing"] = confs['missing']
+
+    cmd = [confs['plink']] + dict_to_cli_args(args)
+
+    logger.debug("  Running PLINK simulation ...")
+    run_command(cmd, fg=True)
+
+    # Transpose the genotype matrix
+    # CHR	SNP	(C)M	POS	COUNTED	ALT	per0_per0	per1_per1	per2_per2
+    # 1	SNP_0	0	1	D	d	1	0	1
+    # 1	SNP_1	0	2	d	D	0	1	0
+    # 1	SNP_2	0	3	d	D	0	0	0
+    # 1	SNP_3	0	4	d	D	0	0	0
+    # 1	SNP_4	0	5	D	d	1	2	1
+    cmd = [
+        confs['plink'],
+        "--recode",
+        "A" if transpose_gtmat else "A-transpose",
+        "tab",
+        "--bfile",
+        args["out"],
+        "--out",
+        gtmatfile + ".plink.recoded",
+    ]
+    logger.debug("- Recoding into genotype matrix ...")
+    run_command(cmd, fg=True)
+
+    logger.debug("  Saving genotype matrix ...")
+    ## transpose_gtmat = False
+    # SNP_COUNTED	per0_per0	per1_per1	per2_per2
+    # SNP_0_D	1	0	1
+    # SNP_1_d	0	1	0
+    # SNP_2_d	0	0	0
+    # SNP_3_d	0	0	0
+    # SNP_4_D	1	2	1
+    ## transpose_gtmat = True
+    # FID_IID SNP_0_D SNP_1_D SNP_2_D
+    # per0_per0 0 1 1
+    # per1_per1 0 2 0
+    # per2_per2 0 0 0
+    # per3_per3 1 1 0
+    # per4_per4 0 0 0
+    if transpose_gtmat:
+        cmd = f"cut -f1,2,7- {gtmatfile}.plink.recoded.raw | sed 's/\\t/_/'"
+    else:
+        cmd = f"cut -f2,5,7- {gtmatfile}.plink.recoded.traw | sed 's/\\t/_/'"
+
+    if sample_prefix:
+        cmd = f"{cmd} | sed 's/per[0-9]\\+_per/{sample_prefix}/g'"
+
+    cmd = f"{cmd} > {gtmatfile}"
+    run_command(cmd, fg=True)
+
+
+do_one_simulation(config)

biopipen/scripts/snp/PlinkUpdateName.py

@@ -0,0 +1,124 @@
+from pathlib import Path
+from biopipen.utils.misc import run_command, dict_to_cli_args, logger
+
+indir: str = {{in.indir | quote}}  # pyright: ignore # noqa: #999
+namefile: str = {{in.namefile | quote}}  # pyright: ignore
+outdir: str = {{out.outdir | quote}}  # pyright: ignore
+plink = {{envs.plink | repr}}  # pyright: ignore
+bcftools = {{envs.bcftools | repr}}  # pyright: ignore
+ncores = {{envs.ncores | repr}}  # pyright: ignore
+match_alt = {{envs.match_alt | repr}}  # pyright: ignore
+
+bedfile = list(Path(indir).glob("*.bed"))
+if len(bedfile) == 0:
+    raise FileNotFoundError(f"No .bed file found in `in.indir`")
+elif len(bedfile) > 1:
+    logger.warning(f"Multiple .bed files found in `in.indir`, using the first one.")
+
+bedfile = bedfile[0]
+input = bedfile.with_suffix("")
+output = Path(outdir) / bedfile.stem
+
+if namefile.endswith(".vcf") or namefile.endswith(".vcf.gz"):
+    logger.info("VCF file received, extracting names")
+    def alt_matched(bim_alt, vcf_alt, match_alt):
+        if match_alt == "none":
+            return True
+        if match_alt == "exact":
+            return bim_alt == vcf_alt
+
+        bim_alts = bim_alt.split(",")
+        vcf_alts = vcf_alt.split(",")
+        if match_alt == "all":
+            return set(bim_alts) == set(vcf_alts)
+        if match_alt == "any":
+            return bool(set(bim_alts) & set(vcf_alts))
+        if match_alt == "first_included":
+            return bim_alts[0] in vcf_alts
+        if match_alt == "first":
+            return bim_alts[0] == vcf_alts[0]
+
+        raise ValueError(f"Unknown match_alt: {match_alt}")
+
+    def readline(f):
+        line = f.readline().strip()
+        return line.split("\t") if line else None
+
+    namefile_tmp = Path(outdir) / "_namefile_from_vcf.txt"
+    infofile = Path(outdir) / "_information_from_vcf_unsorted.txt"
+    sorted_infofile = Path(outdir) / "_information_from_vcf_sorted.txt"
+    sorted_bim = Path(outdir) / "_sorted_bim.txt"
+    bt_cmd = [
+        bcftools, "query",
+        "-f", "%CHROM\\t%ID\\t0\\t%POS\\t%ALT\\t%REF\\n",
+        "-o", infofile,
+        namefile,
+    ]
+    ## infofile
+    # 1	rs10492	0	10492	T	C
+    logger.info("- Extracting information from VCF file ...")
+    run_command(bt_cmd, fg=True)
+    # sort infofile
+    logger.info("- Sorting the information from VCF file ...")
+    run_command(
+        [
+            "sort",
+            "-k1,1", "-k4,4n", "-k6,6",
+            infofile,
+            "--parallel", ncores,
+            "-o", sorted_infofile
+        ],
+        env={"LC_ALL": "C"},
+        fg=True,
+    )
+
+    ## .bim file
+    # 1	1_10492	0	10492	T	C
+    # sort .bim file
+    logger.info("- Sorting the .bim file ...")
+    run_command(
+        [
+            "sort",
+            "-k1,1", "-k4,4n", "-k6,6",
+            input.with_suffix(".bim"),
+            "--parallel", ncores,
+            "-o", sorted_bim
+        ],
+        env={"LC_ALL": "C"},
+        fg=True,
+    )
+    # query namefile for records in sorted bim file
+    logger.info("- Matching and generating the name file ...")
+    with sorted_bim.open() as fbim, sorted_infofile.open() as finfo, namefile_tmp.open("w") as fout:  # noqa: E501
+        bim = readline(fbim)
+        info = readline(finfo)
+        while bim and info:
+            if (
+                bim[0] == info[0]
+                and bim[3] == info[3]
+                and bim[5] == info[5]
+                and alt_matched(bim[4], info[4], match_alt)
+            ):
+                fout.write(f"{bim[1]}\t{info[1]}\n")
+                bim = readline(fbim)
+                info = readline(finfo)
+            elif (
+                bim[0] < info[0]
+                or (bim[0] == info[0] and bim[3] < info[3])
+                or (bim[0] == info[0] and bim[3] == info[3] and bim[5] < info[5])
+            ):
+                bim = readline(fbim)
+            else:
+                info = readline(finfo)
+
+    namefile = str(namefile_tmp)
+
+args = {
+    "": plink,
+    "bfile": input,
+    "out": output,
+    "make_bed": True,
+    "update_name": namefile,
+}
+
+run_command(dict_to_cli_args(args, dashify=True), fg=True)

biopipen/scripts/stats/ChowTest.R

@@ -0,0 +1,146 @@
+library(rlang)
+library(dplyr)
+library(biopipen.utils)
+
+infile <- {{in.infile | r}}
+groupfile <- {{in.groupfile | r}}
+fmlfile <- {{in.fmlfile | r}}
+outfile <- {{out.outfile | r}}
+padj <- {{envs.padj | r}}
+transpose_input <- {{envs.transpose_input | r}}
+transpose_group <- {{envs.transpose_group | r}}
+
+log <- get_logger()
+
+log$info("Reading input files ...")
+indata <- read.table(infile, header = TRUE, sep = "\t", row.names = 1, check.names = FALSE)
+if (transpose_input) {
+	indata <- t(indata)
+}
+groupdata <- read.table(groupfile, header = TRUE, sep = "\t", row.names = 1, check.names = FALSE)
+if (transpose_group) {
+	groupdata <- t(groupdata)
+}
+allgroups = na.omit(unique(unlist(groupdata)))
+
+fmldata <- read.table(fmlfile, header = TRUE, sep = "\t", row.names = NULL, check.names = FALSE)
+colnames(fmldata)[1:2] <- c("Group", "Formula")
+
+chow.test <- function(fml, grouping) {
+    formula <- as.formula(fml)
+    pooled_lm <- tryCatch(lm(formula, data = indata), error = function(e) NULL)
+    if (is.null(pooled_lm)) {
+        return(list(
+            pooled.lm  = NA,
+            group.lms  = NULL,
+            Fstat      = NA,
+            group      = grouping,
+            pooled.ssr = NA,
+            group.ssr  = NA,
+            Pval       = NA
+        ))
+    }
+
+    splitdata <- split(indata, groupdata[rownames(indata), grouping])
+    group_lms <- lapply(names(splitdata), function(g) {
+        tryCatch(lm(formula, data = splitdata[[g]]), error = function(e) NULL)
+    })
+	names(group_lms) <- names(splitdata)
+
+    fmvars     <- all.vars(formula)
+	pooled.ssr <- sum(pooled_lm$residuals ^ 2)
+	subssr     <- ifelse(any(is.null(group_lms)), NA, sum(sapply(group_lms, function(x) sum(x$residuals ^ 2))))
+	ngroups    <- length(splitdata)
+	K          <- ifelse(fmvars[2] == ".", ncol(indata), length(fmvars))
+	J          <- (ngroups - 1) * K
+	DF         <- nrow(indata) - ngroups * K
+	FS         <- (pooled.ssr - subssr) * DF / subssr / J
+	list(
+		pooled.lm  = pooled_lm,
+		group.lms  = group_lms,
+		Fstat      = FS,
+		group      = grouping,
+		pooled.ssr = pooled.ssr,
+		group.ssr  = subssr,
+		Pval       = pf(FS, J, DF, lower.tail = FALSE)
+	)
+}
+
+formatlm <- function(m, g = NULL, type = "coeff") {
+	if (is.null(g)) {
+		vars <- all.vars(m$terms)
+		if (type == "pval") {
+			df <- as.data.frame(summary(m)$coefficients)
+			terms <- unlist(sapply(na.omit(c(vars[2:length(vars)], '(Intercept)', 'N')), function(x) {
+				pv <- df[x, 4] %||% df[bQuote(x), 4]
+				if (x == 'N') {
+					paste0('N=', nrow(m$model))
+				} else if (is.null(pv)) {
+					NULL
+				} else {
+					l <- ifelse(x == '(Intercept)', '_', x)
+					paste0(l, '=', signif(pv, digits = 4))
+				}
+			}))
+		} else {
+			coeff <- as.list(m$coefficients)
+			terms <- unlist(sapply(na.omit(c(vars[2:length(vars)], '(Intercept)', 'N')), function(x) {
+				ce <- coeff[[x]] %||% coeff[[bQuote(x)]]
+				if (x == 'N') {
+					paste0('N=', nrow(m$model))
+				} else if (is.null(ce)) {
+					NULL
+				} else {
+					l <- ifelse(x == '(Intercept)', '_', x)
+					paste0(l, '=', round(ce, 3))
+				}
+			}))
+		}
+		paste(terms[!is.null(terms)], collapse = ', ')
+	} else {
+		gm <- m[[as.character(g)]]
+		if (is.null(gm)) {
+			return(NA)
+		}
+		formatlm(gm, type = type)
+	}
+}
+
+log$info("Running Chow tests ...")
+ncases <- nrow(fmldata)
+results <- do_call(rbind, lapply(
+    seq_len(ncases),
+    function(i) {
+		fmlrow <- fmldata[i, , drop=TRUE]
+        if (i %% 100 == 0) {
+            log$info("- {i} / {ncases} ...")
+        }
+        log$debug("  Running Chow test for formula: {fmlrow$Formula} (grouping = {fmlrow$Group})")
+
+        res <- chow.test(fmlrow$Formula, fmlrow$Group)
+		fmlrow$Pooled_Coef <- formatlm(res$pooled.lm)
+		for (g in allgroups) {
+			fmlrow[[paste0("Group_", g, "_Coef")]] <- formatlm(res$group.lms, g)
+		}
+		# fmlrow$Groups <- formatlm(res$group.lms)
+		fmlrow$Pooled_Pval <- formatlm(res$pooled.lm, type="pval")
+		for (g in allgroups) {
+			fmlrow[[paste0("Group_", g, "_Pval")]] <- formatlm(res$group.lms, g, type="pval")
+		}
+		fmlrow$SSR <- res$group.ssr
+		fmlrow$SumSSR <- res$pooled.ssr
+		fmlrow$Fstat <- res$Fstat
+		fmlrow$Pval <- res$Pval
+		fmlrow
+    }
+)) %>% as.data.frame()
+
+if (padj != "none") {
+    log$info("Adjusting p-values ...")
+    results$Padj <- p.adjust(results$Pval, method = padj)
+}
+
+log$info("Writing output ...")
+# unimplemented type 'list' in 'EncodeElement'
+results <- apply(results, 2, as.character)
+write.table(results, file = outfile, sep = "\t", quote = FALSE, row.names = FALSE)