Mercurial > repos > bgruening > music_construct_eset

comparison scripts/estimateprops.R @ 0:2cfd0db49bbc draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/music/ commit 08c6fd3885bdfbf8b5c3f4dcc2d04729b577e3e1"
author bgruening
date Sun, 12 Sep 2021 19:49:12 +0000
parents
children be91cb6f48e7
comparison
equal deleted inserted replaced
-1:000000000000 0:2cfd0db49bbc
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 }