Mercurial > repos > bgruening > music_deconvolution
comparison scripts/estimateprops.R @ 0:224721e76869 draft
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/music/ commit 08c6fd3885bdfbf8b5c3f4dcc2d04729b577e3e1"
author | bgruening |
---|---|
date | Sun, 12 Sep 2021 19:48:48 +0000 |
parents | |
children | 3ca0132c182a |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:224721e76869 |
---|---|
1 suppressWarnings(suppressPackageStartupMessages(library(xbioc))) | |
2 suppressWarnings(suppressPackageStartupMessages(library(MuSiC))) | |
3 suppressWarnings(suppressPackageStartupMessages(library(reshape2))) | |
4 suppressWarnings(suppressPackageStartupMessages(library(cowplot))) | |
5 ## We use this script to estimate the effectiveness of proportion methods | |
6 | |
7 ## Load Conf | |
8 args <- commandArgs(trailingOnly = TRUE) | |
9 source(args[1]) | |
10 | |
11 ## Estimate cell type proportions | |
12 est_prop <- music_prop( | |
13 bulk.eset = bulk_eset, sc.eset = scrna_eset, | |
14 clusters = celltypes_label, | |
15 samples = samples_label, select.ct = celltypes, verbose = T) | |
16 | |
17 | |
18 ## Show different in estimation methods | |
19 ## Jitter plot of estimated cell type proportions | |
20 jitter.fig <- Jitter_Est( | |
21 list(data.matrix(est_prop$Est.prop.weighted), | |
22 data.matrix(est_prop$Est.prop.allgene)), | |
23 method.name = methods, title = "Jitter plot of Est Proportions") | |
24 | |
25 | |
26 ## Make a Plot | |
27 ## A more sophisticated jitter plot is provided as below. We separated | |
28 ## the T2D subjects and normal subjects by their HbA1c levels. | |
29 m_prop <- rbind(melt(est_prop$Est.prop.weighted), | |
30 melt(est_prop$Est.prop.allgene)) | |
31 | |
32 colnames(m_prop) <- c("Sub", "CellType", "Prop") | |
33 | |
34 m_prop$CellType <- factor(m_prop$CellType, levels = celltypes) # nolint | |
35 m_prop$Method <- factor(rep(methods, each = 89 * 6), levels = methods) # nolint | |
36 m_prop$HbA1c <- rep(bulk_eset$hba1c, 2 * 6) # nolint | |
37 m_prop <- m_prop[!is.na(m_prop$HbA1c), ] | |
38 m_prop$Disease <- factor(sample_groups[(m_prop$HbA1c > 6.5) + 1], # nolint | |
39 levels = sample_groups) | |
40 | |
41 m_prop$D <- (m_prop$Disease == # nolint | |
42 sample_disease_group) / sample_disease_group_scale | |
43 m_prop <- rbind(subset(m_prop, Disease == healthy_phenotype), | |
44 subset(m_prop, Disease != healthy_phenotype)) | |
45 | |
46 jitter.new <- ggplot(m_prop, aes(Method, Prop)) + | |
47 geom_point(aes(fill = Method, color = Disease, stroke = D, shape = Disease), | |
48 size = 2, alpha = 0.7, | |
49 position = position_jitter(width = 0.25, height = 0)) + | |
50 facet_wrap(~ CellType, scales = "free") + | |
51 scale_colour_manual(values = c("white", "gray20")) + | |
52 scale_shape_manual(values = c(21, 24)) + theme_minimal() | |
53 | |
54 ## Plot to compare method effectiveness | |
55 ## Create dataframe for beta cell proportions and HbA1c levels | |
56 m_prop_ana <- data.frame(pData(bulk_eset)[rep(1:89, 2), phenotype_factors], | |
57 ct.prop = c(est_prop$Est.prop.weighted[, 2], | |
58 est_prop$Est.prop.allgene[, 2]), | |
59 Method = factor(rep(methods, each = 89), | |
60 levels = methods)) | |
61 colnames(m_prop_ana)[1:4] <- phenotype_factors | |
62 m_prop_ana <- subset(m_prop_ana, !is.na(m_prop_ana[phenotype_gene])) | |
63 m_prop_ana$Disease <- factor(sample_groups[( # nolint | |
64 m_prop_ana[phenotype_gene] > 6.5) + 1], sample_groups) | |
65 m_prop_ana$D <- (m_prop_ana$Disease == # nolint | |
66 sample_disease_group) / sample_disease_group_scale | |
67 | |
68 jitt_compare <- ggplot(m_prop_ana, aes_string(phenotype_gene, "ct.prop")) + | |
69 geom_smooth(method = "lm", se = FALSE, col = "black", lwd = 0.25) + | |
70 geom_point(aes(fill = Method, color = Disease, stroke = D, shape = Disease), | |
71 size = 2, alpha = 0.7) + facet_wrap(~ Method) + | |
72 ggtitle(compare_title) + theme_minimal() + | |
73 scale_colour_manual(values = c("white", "gray20")) + | |
74 scale_shape_manual(values = c(21, 24)) | |
75 | |
76 | |
77 pdf(file = outfile_pdf, width = 8, height = 8) | |
78 plot_grid(jitter.fig, jitter.new, labels = "auto", ncol = 1, nrow = 2) | |
79 jitt_compare | |
80 dev.off() | |
81 | |
82 ## Summary table | |
83 for (meth in methods) { | |
84 ##lm_beta_meth = lm(ct.prop ~ age + bmi + hba1c + gender, data = | |
85 ##subset(m_prop_ana, Method == meth)) | |
86 lm_beta_meth <- lm(as.formula( | |
87 paste("ct.prop", paste(phenotype_factors, collapse = " + "), | |
88 sep = " ~ ")), | |
89 data = subset(m_prop_ana, Method == meth)) | |
90 print(paste0("Summary: ", meth)) | |
91 capture.output(summary(lm_beta_meth), | |
92 file = paste0("report_data/summ_", meth, ".txt")) | |
93 } |