biopipen 0.33.1__py3-none-any.whl → 0.34.0__py3-none-any.whl

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.

Potentially problematic release.


This version of biopipen might be problematic. Click here for more details.

Files changed (149) hide show
  1. biopipen/__init__.py +1 -1
  2. biopipen/core/filters.py +10 -183
  3. biopipen/core/proc.py +5 -3
  4. biopipen/core/testing.py +8 -1
  5. biopipen/ns/bam.py +40 -4
  6. biopipen/ns/cnv.py +1 -1
  7. biopipen/ns/cnvkit.py +1 -1
  8. biopipen/ns/delim.py +1 -1
  9. biopipen/ns/gsea.py +63 -37
  10. biopipen/ns/misc.py +38 -0
  11. biopipen/ns/plot.py +8 -0
  12. biopipen/ns/scrna.py +290 -288
  13. biopipen/ns/scrna_metabolic_landscape.py +207 -366
  14. biopipen/ns/tcr.py +165 -97
  15. biopipen/reports/bam/CNVpytor.svelte +4 -9
  16. biopipen/reports/cnvkit/CNVkitDiagram.svelte +1 -1
  17. biopipen/reports/cnvkit/CNVkitHeatmap.svelte +1 -1
  18. biopipen/reports/cnvkit/CNVkitScatter.svelte +1 -1
  19. biopipen/reports/{delim/SampleInfo.svelte → common.svelte} +2 -3
  20. biopipen/reports/scrna/DimPlots.svelte +1 -1
  21. biopipen/reports/scrna_metabolic_landscape/MetabolicFeatures.svelte +51 -22
  22. biopipen/reports/scrna_metabolic_landscape/MetabolicPathwayActivity.svelte +46 -42
  23. biopipen/reports/scrna_metabolic_landscape/MetabolicPathwayHeterogeneity.svelte +63 -6
  24. biopipen/reports/snp/PlinkCallRate.svelte +2 -2
  25. biopipen/reports/snp/PlinkFreq.svelte +1 -1
  26. biopipen/reports/snp/PlinkHWE.svelte +1 -1
  27. biopipen/reports/snp/PlinkHet.svelte +1 -1
  28. biopipen/reports/snp/PlinkIBD.svelte +1 -1
  29. biopipen/reports/tcr/CDR3AAPhyschem.svelte +1 -1
  30. biopipen/scripts/bam/CNAClinic.R +41 -6
  31. biopipen/scripts/bam/CNVpytor.py +2 -1
  32. biopipen/scripts/bam/ControlFREEC.py +2 -3
  33. biopipen/scripts/bam/SamtoolsView.py +33 -0
  34. biopipen/scripts/cnv/AneuploidyScore.R +25 -13
  35. biopipen/scripts/cnv/AneuploidyScoreSummary.R +218 -163
  36. biopipen/scripts/cnv/TMADScore.R +4 -4
  37. biopipen/scripts/cnv/TMADScoreSummary.R +51 -84
  38. biopipen/scripts/cnvkit/CNVkitGuessBaits.py +3 -3
  39. biopipen/scripts/cnvkit/CNVkitHeatmap.py +3 -3
  40. biopipen/scripts/cnvkit/CNVkitReference.py +3 -3
  41. biopipen/scripts/delim/RowsBinder.R +1 -1
  42. biopipen/scripts/delim/SampleInfo.R +4 -1
  43. biopipen/scripts/gene/GeneNameConversion.R +14 -12
  44. biopipen/scripts/gsea/Enrichr.R +2 -2
  45. biopipen/scripts/gsea/FGSEA.R +184 -50
  46. biopipen/scripts/gsea/PreRank.R +3 -3
  47. biopipen/scripts/misc/Plot.R +80 -0
  48. biopipen/scripts/plot/VennDiagram.R +2 -2
  49. biopipen/scripts/protein/ProdigySummary.R +34 -27
  50. biopipen/scripts/regulatory/MotifAffinityTest.R +11 -9
  51. biopipen/scripts/regulatory/MotifAffinityTest_AtSNP.R +5 -5
  52. biopipen/scripts/regulatory/MotifAffinityTest_MotifBreakR.R +4 -4
  53. biopipen/scripts/regulatory/VariantMotifPlot.R +10 -8
  54. biopipen/scripts/regulatory/motifs-common.R +10 -9
  55. biopipen/scripts/rnaseq/Simulation-ESCO.R +14 -11
  56. biopipen/scripts/rnaseq/Simulation-RUVcorr.R +7 -4
  57. biopipen/scripts/rnaseq/Simulation.R +0 -2
  58. biopipen/scripts/rnaseq/UnitConversion.R +6 -5
  59. biopipen/scripts/scrna/AnnData2Seurat.R +25 -73
  60. biopipen/scripts/scrna/CellCellCommunication.py +1 -1
  61. biopipen/scripts/scrna/CellCellCommunicationPlots.R +51 -168
  62. biopipen/scripts/scrna/CellTypeAnnotation-celltypist.R +99 -150
  63. biopipen/scripts/scrna/CellTypeAnnotation-direct.R +11 -9
  64. biopipen/scripts/scrna/CellTypeAnnotation-hitype.R +12 -9
  65. biopipen/scripts/scrna/CellTypeAnnotation-sccatch.R +14 -11
  66. biopipen/scripts/scrna/CellTypeAnnotation-sctype.R +19 -16
  67. biopipen/scripts/scrna/CellTypeAnnotation.R +10 -2
  68. biopipen/scripts/scrna/CellsDistribution.R +1 -1
  69. biopipen/scripts/scrna/ExprImputation-alra.R +87 -11
  70. biopipen/scripts/scrna/ExprImputation-rmagic.R +247 -21
  71. biopipen/scripts/scrna/ExprImputation-scimpute.R +8 -5
  72. biopipen/scripts/scrna/MarkersFinder.R +348 -217
  73. biopipen/scripts/scrna/MetaMarkers.R +3 -3
  74. biopipen/scripts/scrna/ModuleScoreCalculator.R +14 -13
  75. biopipen/scripts/scrna/RadarPlots.R +1 -1
  76. biopipen/scripts/scrna/ScFGSEA.R +157 -75
  77. biopipen/scripts/scrna/ScSimulation.R +11 -10
  78. biopipen/scripts/scrna/ScVelo.py +605 -0
  79. biopipen/scripts/scrna/Seurat2AnnData.R +2 -3
  80. biopipen/scripts/scrna/SeuratClusterStats-clustree.R +1 -1
  81. biopipen/scripts/scrna/SeuratClusterStats-features.R +39 -30
  82. biopipen/scripts/scrna/SeuratClusterStats-ngenes.R +56 -65
  83. biopipen/scripts/scrna/SeuratClusterStats-stats.R +4 -4
  84. biopipen/scripts/scrna/SeuratClusterStats.R +9 -6
  85. biopipen/scripts/scrna/SeuratClustering.R +31 -48
  86. biopipen/scripts/scrna/SeuratLoading.R +2 -2
  87. biopipen/scripts/scrna/SeuratMap2Ref.R +66 -367
  88. biopipen/scripts/scrna/SeuratMetadataMutater.R +5 -7
  89. biopipen/scripts/scrna/SeuratPreparing.R +76 -24
  90. biopipen/scripts/scrna/SeuratSubClustering.R +46 -185
  91. biopipen/scripts/scrna/{SlingShot.R → Slingshot.R} +12 -16
  92. biopipen/scripts/scrna/Subset10X.R +2 -2
  93. biopipen/scripts/scrna/TopExpressingGenes.R +141 -184
  94. biopipen/scripts/scrna/celltypist-wrapper.py +6 -4
  95. biopipen/scripts/scrna/seurat_anndata_conversion.py +81 -0
  96. biopipen/scripts/scrna_metabolic_landscape/MetabolicFeatures.R +429 -123
  97. biopipen/scripts/scrna_metabolic_landscape/MetabolicPathwayActivity.R +346 -245
  98. biopipen/scripts/scrna_metabolic_landscape/MetabolicPathwayHeterogeneity.R +182 -173
  99. biopipen/scripts/snp/MatrixEQTL.R +39 -20
  100. biopipen/scripts/snp/PlinkCallRate.R +43 -34
  101. biopipen/scripts/snp/PlinkFreq.R +34 -41
  102. biopipen/scripts/snp/PlinkHWE.R +23 -18
  103. biopipen/scripts/snp/PlinkHet.R +26 -22
  104. biopipen/scripts/snp/PlinkIBD.R +30 -34
  105. biopipen/scripts/stats/ChowTest.R +9 -8
  106. biopipen/scripts/stats/DiffCoexpr.R +13 -11
  107. biopipen/scripts/stats/LiquidAssoc.R +7 -8
  108. biopipen/scripts/stats/Mediation.R +8 -8
  109. biopipen/scripts/stats/MetaPvalue.R +11 -13
  110. biopipen/scripts/stats/MetaPvalue1.R +6 -5
  111. biopipen/scripts/tcr/CDR3AAPhyschem.R +105 -164
  112. biopipen/scripts/tcr/ClonalStats.R +5 -4
  113. biopipen/scripts/tcr/CloneResidency.R +3 -3
  114. biopipen/scripts/tcr/CloneSizeQQPlot.R +2 -2
  115. biopipen/scripts/tcr/Immunarch2VDJtools.R +2 -2
  116. biopipen/scripts/tcr/ImmunarchFilter.R +3 -3
  117. biopipen/scripts/tcr/ImmunarchLoading.R +5 -5
  118. biopipen/scripts/tcr/ScRepCombiningExpression.R +39 -0
  119. biopipen/scripts/tcr/ScRepLoading.R +114 -92
  120. biopipen/scripts/tcr/TCRClusterStats.R +2 -2
  121. biopipen/scripts/tcr/TCRClustering.R +86 -97
  122. biopipen/scripts/tcr/TESSA.R +65 -115
  123. biopipen/scripts/tcr/VJUsage.R +5 -5
  124. biopipen/scripts/vcf/TruvariBenchSummary.R +15 -11
  125. biopipen/utils/common_docstrs.py +66 -63
  126. biopipen/utils/reporter.py +177 -0
  127. {biopipen-0.33.1.dist-info → biopipen-0.34.0.dist-info}/METADATA +2 -1
  128. {biopipen-0.33.1.dist-info → biopipen-0.34.0.dist-info}/RECORD +130 -144
  129. {biopipen-0.33.1.dist-info → biopipen-0.34.0.dist-info}/WHEEL +1 -1
  130. biopipen/reports/scrna/CellCellCommunicationPlots.svelte +0 -14
  131. biopipen/reports/scrna/SeuratClusterStats.svelte +0 -16
  132. biopipen/reports/scrna/SeuratMap2Ref.svelte +0 -37
  133. biopipen/reports/scrna/SeuratPreparing.svelte +0 -15
  134. biopipen/reports/scrna_metabolic_landscape/MetabolicFeaturesIntraSubset.svelte +0 -28
  135. biopipen/reports/utils/gsea.liq +0 -110
  136. biopipen/scripts/scrna/CellTypeAnnotation-common.R +0 -10
  137. biopipen/scripts/scrna/SeuratClustering-common.R +0 -213
  138. biopipen/scripts/scrna_metabolic_landscape/MetabolicFeaturesIntraSubset.R +0 -193
  139. biopipen/utils/caching.R +0 -44
  140. biopipen/utils/gene.R +0 -95
  141. biopipen/utils/gsea.R +0 -329
  142. biopipen/utils/io.R +0 -20
  143. biopipen/utils/misc.R +0 -602
  144. biopipen/utils/mutate_helpers.R +0 -581
  145. biopipen/utils/plot.R +0 -209
  146. biopipen/utils/repr.R +0 -146
  147. biopipen/utils/rnaseq.R +0 -48
  148. biopipen/utils/single_cell.R +0 -207
  149. {biopipen-0.33.1.dist-info → biopipen-0.34.0.dist-info}/entry_points.txt +0 -0
@@ -7,34 +7,33 @@ library(biopipen.utils)
7
7
  log <- get_logger()
8
8
  reporter <- get_reporter()
9
9
 
10
- srtfile <- {{ in.srtobj | quote }}
11
- outdir <- {{ out.outdir | quote }}
12
- joboutdir <- {{ job.outdir | quote }}
10
+ srtfile <- {{ in.srtobj | r }}
11
+ outdir <- {{ out.outdir | r }}
12
+ joboutdir <- {{ job.outdir | r }}
13
+
13
14
  ncores <- {{ envs.ncores | int }}
14
15
  mutaters <- {{ envs.mutaters | r }}
16
+ group.by <- {{ envs["group-by"] | r }}
15
17
  ident.1 <- {{ envs["ident-1"] | r }}
16
18
  ident.2 <- {{ envs["ident-2"] | r }}
17
- group.by <- {{ envs["group-by"] | r }}
18
19
  each <- {{ envs.each | r }}
19
- prefix_each <- {{ envs.prefix_each | r }}
20
- prefix_group <- {{ envs.prefix_group | r }}
21
- assay <- {{ envs.assay | r }}
22
- subset <- {{ envs.subset | r }}
23
- error <- {{ envs.error | r }}
24
- site <- {{ envs.site | r }}
25
- rest <- {{ envs.rest | r: todot="-" }}
26
20
  dbs <- {{ envs.dbs | r }}
27
21
  sigmarkers <- {{ envs.sigmarkers | r }}
22
+ enrich_style <- {{ envs.enrich_style | r }}
23
+ assay <- {{ envs.assay | r }}
24
+ error <- {{ envs.error | r }}
25
+ subset <- {{ envs.subset | r }}
28
26
  cache <- {{ envs.cache | r }}
27
+ rest <- {{ envs.rest | r: todot="-" }}
29
28
  allmarker_plots_defaults <- {{ envs.allmarker_plots_defaults | r }}
30
29
  allmarker_plots <- {{ envs.allmarker_plots | r }}
31
30
  marker_plots_defaults <- {{ envs.marker_plots_defaults | r }}
32
31
  marker_plots <- {{ envs.marker_plots | r }}
33
32
  enrich_plots_defaults <- {{ envs.enrich_plots_defaults | r }}
34
33
  enrich_plots <- {{ envs.enrich_plots | r }}
35
- cases <- {{ envs.cases | r: todot="-", skip=1 }}
36
34
  overlaps_defaults <- {{ envs.overlaps_defaults | r }}
37
35
  overlaps <- {{ envs.overlaps | r }}
36
+ cases <- {{ envs.cases | r: todot="-", skip=1 }}
38
37
 
39
38
  if (isTRUE(cache)) { cache <- joboutdir }
40
39
 
@@ -45,7 +44,11 @@ if (ncores > 1) {
45
44
  }
46
45
 
47
46
  log$info("Reading Seurat object ...")
48
- srtobj <- readRDS(srtfile)
47
+ srtobj <- read_obj(srtfile)
48
+ if (!"Identity" %in% colnames(srtobj@meta.data)) {
49
+ srtobj@meta.data$Identity <- Idents(srtobj)
50
+ }
51
+
49
52
 
50
53
  if (!is.null(mutaters) && length(mutaters) > 0) {
51
54
  log$info("Mutating meta data ...")
@@ -53,22 +56,38 @@ if (!is.null(mutaters) && length(mutaters) > 0) {
53
56
  mutate(!!!lapply(mutaters, parse_expr))
54
57
  }
55
58
 
59
+ allmarker_plots <- lapply(allmarker_plots, function(x) {
60
+ list_update(allmarker_plots_defaults, x)
61
+ })
62
+ marker_plots <- lapply(marker_plots, function(x) {
63
+ list_update(marker_plots_defaults, x)
64
+ })
65
+ enrich_plots <- lapply(enrich_plots, function(x) {
66
+ list_update(enrich_plots_defaults, x)
67
+ })
68
+ overlaps <- lapply(overlaps, function(x) {
69
+ list_update(overlaps_defaults, x)
70
+ })
71
+
56
72
  defaults <- list(
73
+ group.by = group.by,
57
74
  ident.1 = ident.1,
58
75
  ident.2 = ident.2,
59
- group.by = group.by,
60
- each = each,
61
- prefix_each = prefix_each,
62
- prefix_group = prefix_group,
63
76
  dbs = dbs,
77
+ sigmarkers = sigmarkers,
78
+ enrich_style = enrich_style,
64
79
  assay = assay %||% DefaultAssay(srtobj),
65
- subset = subset,
80
+ each = each,
66
81
  error = error,
67
- site = site,
68
- sigmarkers = sigmarkers,
82
+ subset = subset,
83
+ allmarker_plots_defaults = allmarker_plots_defaults,
69
84
  allmarker_plots = allmarker_plots,
85
+ marker_plots_defaults = marker_plots_defaults,
70
86
  marker_plots = marker_plots,
87
+ enrich_plots_defaults = enrich_plots_defaults,
71
88
  enrich_plots = enrich_plots,
89
+ overlaps_defaults = overlaps_defaults,
90
+ overlaps = overlaps,
72
91
  cache = cache,
73
92
  rest = rest
74
93
  )
@@ -77,107 +96,151 @@ log$info("Expanding cases ...")
77
96
 
78
97
  post_casing <- function(name, case) {
79
98
  outcases <- list()
80
- no_each <- is.null(case$each) || is.na(case$each) || nchar(case$each) == 0
81
99
 
82
- if (no_each) {
100
+ case$group.by <- case$group.by %||% "Identity"
101
+
102
+ if (is.null(case$each) || is.na(case$each) || nchar(case$each) == 0 || isFALSE(each)) {
83
103
  # single cases, no need to expand
104
+ if (length(case$ident.1) > 0 && length(case$overlaps) > 0) {
105
+ stop("Cannot perform 'overlaps' with a single comparison (ident-1 is set) in case '", name, "'")
106
+ }
107
+ if (length(case$ident.1) > 0 && length(case$allmarker_plots) > 0) {
108
+ stop("Cannot perform 'allmarker_plots' with a single comparison (ident-1 is set) in case '", name, "'")
109
+ }
110
+
84
111
  case$allmarker_plots <- lapply(
85
112
  case$allmarker_plots,
86
- function(x) { list_update(allmarker_plots_defaults, x) }
113
+ function(x) { list_update(case$allmarker_plots_defaults, x) }
87
114
  )
115
+ case$allmarker_plots_defaults <- NULL
116
+
88
117
  case$marker_plots <- lapply(
89
118
  case$marker_plots,
90
- function(x) { list_update(marker_plots_defaults, x) }
119
+ function(x) { list_update(case$marker_plots_defaults, x) }
91
120
  )
121
+ case$marker_plots_defaults <- NULL
122
+
92
123
  case$enrich_plots <- lapply(
93
124
  case$enrich_plots,
94
- function(x) { list_update(enrich_plots_defaults, x) }
125
+ function(x) { list_update(case$enrich_plots_defaults, x) }
95
126
  )
127
+ case$enrich_plots_defaults <- NULL
128
+
129
+ case$overlaps <- lapply(
130
+ case$overlaps,
131
+ function(x) { list_update(case$overlaps_defaults, x) }
132
+ )
133
+ case$overlaps_defaults <- NULL
134
+
96
135
  outcases[[name]] <- case
97
136
  } else { # !no_each
98
- if (!is.null(case$subset)) {
99
- sobj <- srtobj %>% filter(!!parse_expr(case$subset))
137
+ eachs <- if (!is.null(case$subset)) {
138
+ srtobj@meta.data %>%
139
+ filter(!!parse_expr(case$subset)) %>%
140
+ pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
100
141
  } else {
101
- sobj <- srtobj
142
+ srtobj@meta.data %>%
143
+ pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
144
+ }
145
+ if (length(case$overlaps) > 0 && is.null(case$ident.1)) {
146
+ stop("Cannot perform 'overlaps' analysis with 'each' and without 'ident.1' in case '", name, "'")
147
+ }
148
+
149
+ if (length(cases) == 0 && name == "Marker Discovery") {
150
+ name <- case$each
102
151
  }
103
152
 
104
- eachs <- sobj@meta.data %>% pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
105
- case_1 <- case
106
153
  for (each in eachs) {
107
- each_name <- ifelse(case_1$prefix_each, paste0(case_1$each, " - ", each), each)
108
- if (!is.null(case_1$ident.1)) {
109
- # Make name a section
110
- key <- paste0(name, "::", each_name)
111
- } else {
112
- key <- paste0(name, ": ", each_name)
113
- }
154
+ newname <- paste0(name, " - ", each)
155
+ newcase <- case
156
+
157
+ newcase$original_case <- name
158
+ newcase$each_name <- case$each
159
+ newcase$each <- each
160
+
114
161
  if (!is.null(case$subset)) {
115
- case_1$subset <- paste0(case$subset, " & `", case_1$each, "` == '", each, "'")
162
+ newcase$subset <- paste0(case$subset, " & ", bQuote(case$each), " == '", each, "'")
116
163
  } else {
117
- case_1$subset <- paste0("`", case_1$each, "` == '", each, "'")
164
+ newcase$subset <- paste0(bQuote(case$each), " == '", each, "'")
118
165
  }
119
- case_1$allmarker_plots <- lapply(
120
- case_1$allmarker_plots,
121
- function(x) { list_update(allmarker_plots_defaults, x) }
166
+
167
+ newcase$marker_plots <- lapply(
168
+ case$marker_plots,
169
+ function(x) { list_update(case$marker_plots_defaults, x) }
122
170
  )
123
- case_1$marker_plots <- lapply(
124
- case_1$marker_plots,
125
- function(x) { list_update(marker_plots_defaults, x) }
171
+ newcase$marker_plots_defaults <- NULL
172
+
173
+ newcase$enrich_plots <- lapply(
174
+ case$enrich_plots,
175
+ function(x) { list_update(case$enrich_plots_defaults, x) }
126
176
  )
127
- case_1$enrich_plots <- lapply(
128
- case_1$enrich_plots,
129
- function(x) { list_update(enrich_plots_defaults, x) }
177
+ newcase$enrich_plots_defaults <- NULL
178
+
179
+ # Will be processed by the case itself, which collects the markers
180
+ newcase$allmarker_plots <- NULL
181
+ newcase$allmarker_plots_defaults <- NULL
182
+ newcase$overlaps <- NULL
183
+ newcase$overlaps_defaults <- NULL
184
+
185
+ outcases[[newname]] <- newcase
186
+ }
187
+
188
+ if (length(case$overlaps) > 0 || length(case$allmarker_plots) > 0) {
189
+ ovcase <- case
190
+ ovcase$markers <- list()
191
+ ovcase$allmarker_plots <- lapply(
192
+ ovcase$allmarker_plots,
193
+ function(x) { list_update(ovcase$allmarker_plots_defaults, x) }
130
194
  )
131
- outcases[[key]] <- case_1
195
+ ovcase$allmarker_plots_defaults <- NULL
196
+ ovcase$overlaps <- lapply(
197
+ ovcase$overlaps,
198
+ function(x) { list_update(ovcase$overlaps_defaults, x) }
199
+ )
200
+ ovcase$overlaps_defaults <- NULL
201
+ outcases[[name]] <- ovcase
132
202
  }
133
203
  }
134
204
  outcases
135
205
  }
136
- cases <- expand_cases(cases, defaults, post_casing)
137
-
138
- # Checking the overlapping cases
139
- case_markers <- list()
140
- if (length(overlaps) > 0) {
141
- log$info("Checking overlapping cases ...")
142
- overlaps <- expand_cases(overlaps, overlaps_defaults)
143
- for (ovname in names(overlaps)) {
144
- ov <- overlaps[[ovname]]
145
- # check the existence of the cases
146
- for (case in ov$cases) {
147
- if (is.null(cases[[case]])) {
148
- stop(paste0("Case '", case, "' not found in the cases for overlapping case '", ovname, "'"))
149
- }
150
- }
151
- if (length(ov$cases) < 2) {
152
- stop("Overlapping cases must have at least 2 cases for overlapping case '", ovname, "'")
153
- }
154
- for (case in ov$cases) {
155
- case_markers[[case]] <- TRUE
156
- }
157
- if (identical(ov$venn$enabled, "auto")) {
158
- overlaps[[ovname]]$venn$enabled <- length(ov$cases) <= 5
159
- }
160
- }
161
- }
206
+ cases <- expand_cases(cases, defaults, post_casing, default_case = "Marker Discovery")
162
207
 
163
208
  log$info("Running cases ...")
164
209
 
165
210
  process_markers <- function(markers, info, case) {
211
+ ## Attributes lost
212
+ # markers <- markers %>%
213
+ # mutate(gene = as.character(gene)) %>%
214
+ # arrange(p_val_adj, desc(abs(avg_log2FC)))
215
+ markers$gene <- as.character(markers$gene)
216
+ markers <- markers[order(markers$p_val_adj, -abs(markers$avg_log2FC)), ]
217
+
166
218
  # Save markers
167
219
  write.table(markers, file.path(info$prefix, "markers.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
220
+
221
+ sigmarkers <- markers %>% filter(!!parse_expr(case$sigmarkers))
222
+ write.table(sigmarkers, file.path(info$prefix, "sigmarkers.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
168
223
  reporter$add2(
169
224
  list(
170
225
  name = "Table",
171
- contents = list(list(kind = "table", src = file.path(info$prefix, "markers.tsv"), data = list(nrows = 100)))
226
+ contents = list(
227
+ list(kind = "descr", content = paste0(
228
+ "Showing top 100 markers ordered by p_val_adj ascendingly, then abs(avg_log2FC) descendingly. ",
229
+ "Use 'Download the entire data' button to download all significant markers by '",
230
+ html_escape(case$sigmarkers), "'."
231
+ )),
232
+ list(kind = "table", src = file.path(info$prefix, "sigmarkers.tsv"), data = list(nrows = 100))
233
+ )
172
234
  ),
173
235
  hs = c(info$section, info$name),
174
- hs2 = "Markers",
236
+ hs2 = ifelse(is.null(case$ident), "Markers", paste0("Markers (", case$ident, ")")),
175
237
  ui = "tabs"
176
238
  )
177
239
 
178
240
  for (plotname in names(case$marker_plots)) {
179
241
  plotargs <- case$marker_plots[[plotname]]
180
242
  plotargs$degs <- markers
243
+ rownames(plotargs$degs) <- make.unique(markers$gene)
181
244
  plotargs$outprefix <- file.path(info$prefix, paste0("markers.", slugify(plotname)))
182
245
  do_call(VizDEGs, plotargs)
183
246
  reporter$add2(
@@ -185,192 +248,260 @@ process_markers <- function(markers, info, case) {
185
248
  name = plotname,
186
249
  contents = list(reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code))),
187
250
  hs = c(info$section, info$name),
188
- hs2 = "Markers",
251
+ hs2 = ifelse(is.null(case$ident), "Markers", paste0("Markers (", case$ident, ")")),
189
252
  ui = "tabs"
190
253
  )
191
254
  }
192
255
 
193
256
  # Do enrichment analysis
194
- tryCatch({
195
- enrich <- RunEnrichment(
196
- markers, deg = case$sigmarkers, dbs = case$dbs, cache = case$cache,
197
- error = TRUE, site = case$site)
198
-
199
- write.table(enrich, file.path(info$prefix, "enrich.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
200
- reporter$add2(
201
- list(
202
- name = "Table",
203
- contents = list(list(kind = "table", src = file.path(info$prefix, "enrich.tsv"), data = list(nrows = 100)))
204
- ),
205
- hs = c(info$section, info$name),
206
- hs2 = "Enrichment Analysis",
207
- ui = "tabs"
208
- )
257
+ significant_markers <- unique(sigmarkers$gene)
209
258
 
210
- # Visualize enriched terms
211
- if (length(case$enrich_plots) > 0) {
212
- for (db in case$dbs) {
213
- plots <- list()
214
- for (plotname in names(case$enrich_plots)) {
215
- plotargs <- case$enrich_plots[[plotname]]
216
- plotargs$enrich <- enrich[enrich$db == db, , drop = FALSE]
217
- plotargs$outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
218
-
219
- do_call(VizEnrich, plotargs)
220
-
221
- plots[[length(plots) + 1]] <- reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code)
222
- }
223
- reporter$add2(
224
- list(name = db, contents = plots),
225
- hs = c(info$section, info$name),
226
- hs2 = "Enrichment Analysis",
227
- ui = "tabs"
228
- )
229
- }
230
- }
231
- }, error = function(e) {
259
+ if (length(significant_markers) < 5) {
232
260
  if (case$error) {
233
- stop("Error: ", e$message)
261
+ stop("Error: Not enough significant markers with '", case$sigmarkers, "' in case '", info$name, "' found (< 5) for enrichment analysis.")
234
262
  } else {
235
- log$warn(" ! Error: {e$message}")
263
+ message <- paste0("Not enough significant markers with '", case$sigmarkers, "' found (< 5) for enrichment analysis.")
264
+ log$warn(" ! Error: {message}")
236
265
  reporter$add2(
237
266
  list(
238
267
  name = "Warning",
239
- contents = list(list(kind = "error", content = e$message, kind_ = "warning"))),
268
+ contents = list(list(kind = "error", content = message, kind_ = "warning"))),
240
269
  hs = c(info$section, info$name),
241
270
  hs2 = "Enrichment Analysis",
242
271
  ui = "tabs"
243
272
  )
244
273
  }
245
- })
246
- }
274
+ } else {
275
+ tryCatch({
276
+ enrich <- RunEnrichment(
277
+ significant_markers,
278
+ dbs = case$dbs, style = case$enrich_style)
247
279
 
248
- run_case <- function(name) {
249
- case <- cases[[name]]
250
- log$info("- Case: {name} ...")
251
-
252
- args <- case$rest %||% list()
253
- args$object <- srtobj
254
- args$group.by <- case$group.by
255
- args$ident.1 <- case$ident.1
256
- args$ident.2 <- case$ident.2
257
- args$cache <- case$cache
258
- args$assay <- case$assay
259
- args$error <- case$error
260
- args$subset <- case$subset
261
-
262
- markers <- do_call(RunSeuratDEAnalysis, args)
263
- if (isTRUE(case_markers[[name]])) {
264
- case_markers[[name]] <<- markers
265
- }
266
- if (is.null(case$ident.1)) {
267
- if (!is.null(case_markers[[name]])) {
268
- stop("Case '", name, "' for overlapping analysis must have 'ident.1' defined")
269
- }
270
- all_idents <- unique(markers[[case$group.by]])
271
- # Visualize all markers
272
- if (length(case$allmarker_plots) > 0) {
273
- log$info(" Visualizing all markers ...")
274
- casename <- paste0(name, "::", ifelse(case$prefix_group, paste0(case$group.by, " - All Markers"), "All Markers"))
275
- info <- case_info(casename, outdir, create = TRUE)
276
- for (plotname in names(case$allmarker_plots)) {
277
- plotargs <- case$allmarker_plots[[plotname]]
278
- plotargs$degs <- markers
279
- plotargs$outprefix <- file.path(info$prefix, slugify(plotname))
280
- do_call(VizDEGs, plotargs)
280
+ write.table(enrich, file.path(info$prefix, "enrich.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
281
+ reporter$add2(
282
+ list(
283
+ name = "Table",
284
+ contents = list(list(kind = "table", src = file.path(info$prefix, "enrich.tsv"), data = list(nrows = 100)))
285
+ ),
286
+ hs = c(info$section, info$name),
287
+ hs2 = "Enrichment Analysis",
288
+ ui = "tabs"
289
+ )
290
+
291
+ # Visualize enriched terms
292
+ if (length(case$enrich_plots) > 0) {
293
+ for (db in case$dbs) {
294
+ plots <- list()
295
+ for (plotname in names(case$enrich_plots)) {
296
+ plotargs <- case$enrich_plots[[plotname]]
297
+ plotargs$data <- enrich[enrich$Database == db, , drop = FALSE]
298
+
299
+ p <- do_call(VizEnrichment, plotargs)
300
+
301
+ attr(p, "height") <- attr(p, "height") / 1.5
302
+ outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
303
+ save_plot(p, outprefix, plotargs$devpars, formats = "png")
304
+ plots[[length(plots) + 1]] <- reporter$image(outprefix, c(), FALSE)
305
+ }
306
+ reporter$add2(
307
+ list(name = db, contents = plots),
308
+ hs = c(info$section, info$name),
309
+ hs2 = "Enrichment Analysis",
310
+ ui = "tabs"
311
+ )
312
+ }
313
+ }
314
+ }, error = function(e) {
315
+ if (case$error) {
316
+ stop("Error: ", e$message)
317
+ } else {
318
+ log$warn(" ! Error: {e$message}")
281
319
  reporter$add2(
282
320
  list(
283
- name = plotname,
284
- contents = list(reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code))
285
- ),
321
+ name = "Warning",
322
+ contents = list(list(kind = "error", content = e$message, kind_ = "warning"))),
286
323
  hs = c(info$section, info$name),
324
+ hs2 = "Enrichment Analysis",
287
325
  ui = "tabs"
288
326
  )
289
327
  }
290
- }
291
- for (ident in all_idents) {
292
- log$info(" {case$group.by}: {ident} ...")
293
- ident_markers <- markers[markers[[case$group.by]] == ident, , drop = TRUE]
294
- casename <- paste0(name, "::", ifelse(case$prefix_group, paste0(case$group.by, " - ", ident), ident))
295
- info <- case_info(casename, outdir, create = TRUE)
328
+ })
329
+ }
330
+ }
296
331
 
297
- process_markers(ident_markers, info = info, case = case)
298
- }
299
- } else {
300
- info <- case_info(name, outdir, create = TRUE)
301
- process_markers(markers, info = info, case = case)
332
+ process_allmarkers <- function(markers, plotcases, casename, groupname) {
333
+ name <- paste0(casename, "::", paste0(groupname, " (All Markers)"))
334
+ info <- case_info(name, outdir, create = TRUE)
335
+ for (plotname in names(plotcases)) {
336
+ plotargs <- plotcases[[plotname]]
337
+ plotargs$degs <- markers
338
+ plotargs$outprefix <- file.path(info$prefix, slugify(plotname))
339
+ do_call(VizDEGs, plotargs)
340
+ reporter$add2(
341
+ list(
342
+ name = plotname,
343
+ contents = list(reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code))
344
+ ),
345
+ hs = c(info$section, info$name),
346
+ ui = "tabs"
347
+ )
302
348
  }
303
349
  }
304
350
 
305
- sapply(names(cases), run_case)
351
+ process_overlaps <- function(markers, ovcases, casename, groupname) {
352
+ name <- paste0(casename, "::", paste0(groupname, ": Overlaps"))
353
+ info <- case_info(name, outdir, create = TRUE)
306
354
 
307
- if (length(overlaps) > 0) {
308
- log$info("Running overlapping cases ...")
355
+ for (plotname in names(ovcases)) {
356
+ args <- extract_vars(
357
+ ovcases[[plotname]],
358
+ sigm = "sigmarkers", "more_formats", "save_code", "devpars", "plot_type",
359
+ allow_nonexisting = TRUE
360
+ )
309
361
 
310
- run_overlap <- function(ovname) {
311
- ov <- overlaps[[ovname]]
312
- ov$sigmarkers <- ov$sigmarkers %||% sigmarkers
313
- log$info("- Overlapping case: {ovname} ...")
314
- markers <- lapply(ov$cases, function(case) {
315
- case_markers[[case]] %>% filter(!!parse_expr(ov$sigmarkers)) %>%
362
+ sigm <- sigm %||% sigmarkers
363
+ ugroups <- unique(markers[[groupname]])
364
+ m <- lapply(ugroups, function(g) {
365
+ markers[markers[[groupname]] == g, , drop = FALSE] %>%
366
+ filter(!!parse_expr(sigm)) %>%
316
367
  pull("gene") %>% unique()
317
368
  })
318
- names(markers) <- ov$cases
319
- info <- case_info(paste0("OVERLAPPING::", ovname), outdir, create = TRUE)
320
-
321
- if (ov$venn$enabled) {
322
- venn <- extract_vars(ov$venn, "enabled", "more_formats", "save_code", "devpars")
323
- venn$data <- markers
324
- venn$in_form <- "list"
325
- prefix <- file.path(info$prefix, "venn")
326
- p <- do_call(gglogger::register(VennDiagram), venn)
369
+ names(m) <- ugroups
370
+
371
+ if (plot_type == "venn") {
372
+ args$data <- m
373
+ args$in_form <- "list"
374
+ prefix <- file.path(info$prefix, slugify(plotname))
375
+ p <- do_call(gglogger::register(VennDiagram), args)
327
376
  save_plot(p, prefix, devpars, formats = c("png", more_formats))
328
377
  if (save_code) {
329
378
  save_plotcode(
330
379
  p, prefix,
331
- c("library(plotthis)", "load('data.RData')", "invisible(list2env(venn, .GlobalEnv))"),
332
- "venn",
333
- auto_data_setup = FALSE)
380
+ c("library(plotthis)", "load('data.RData')", "invisible(list2env(args, .GlobalEnv))"),
381
+ "args",
382
+ auto_data_setup = FALSE
383
+ )
334
384
  }
335
-
336
- reporter$add2(
337
- list(
338
- name = "Venn Diagram",
339
- contents = list(reporter$image(prefix, more_formats, save_code))
340
- ),
341
- hs = c(info$section, info$name),
342
- ui = "tabs"
343
- )
344
- }
345
-
346
- if (ov$upset$enabled) {
347
- upset <- extract_vars(ov$upset, "enabled", "more_formats", "save_code", "devpars")
348
- upset$data <- markers
349
- upset$in_form <- "list"
350
- prefix <- file.path(info$prefix, "upset")
351
- p <- do_call(gglogger::register(UpsetPlot), upset)
385
+ } else {
386
+ args$data <- m
387
+ args$in_form <- "list"
388
+ prefix <- file.path(info$prefix, slugify(plotname))
389
+ p <- do_call(gglogger::register(UpsetPlot), args)
352
390
  save_plot(p, prefix, devpars, formats = c("png", more_formats))
353
391
  if (save_code) {
354
392
  save_plotcode(
355
393
  p, prefix,
356
- c("library(plotthis)", "load('data.RData')", "invisible(list2env(upset, .GlobalEnv))"),
357
- "upset",
358
- auto_data_setup = FALSE)
394
+ c("library(plotthis)", "load('data.RData')", "invisible(list2env(args, .GlobalEnv))"),
395
+ "args",
396
+ auto_data_setup = FALSE
397
+ )
359
398
  }
399
+ }
360
400
 
361
- reporter$add2(
362
- list(
363
- name = "UpSet Plot",
364
- contents = list(reporter$image(prefix, more_formats, save_code))
365
- ),
366
- hs = c(info$section, info$name),
367
- ui = "tabs"
368
- )
401
+ reporter$add2(
402
+ list(
403
+ name = plotname,
404
+ contents = list(reporter$image(prefix, more_formats, save_code))
405
+ ),
406
+ hs = c(info$section, info$name),
407
+ ui = "tabs"
408
+ )
409
+ }
410
+ }
411
+
412
+ run_case <- function(name) {
413
+ case <- cases[[name]]
414
+ log$info("Case: {name} ...")
415
+
416
+ case <- extract_vars(
417
+ case,
418
+ "dbs", "sigmarkers", "allmarker_plots", "marker_plots", "enrich_plots", "overlaps",
419
+ "original_case", "markers", "each_name", "each", "enrich_style",
420
+ allow_nonexisting = TRUE
421
+ )
422
+ if (!is.null(markers)) { # It is the overlap/allmarker case
423
+ log$info("- Summarizing markers in subcases (by each: {each}) ...")
424
+ # handle the overlaps / allmarkers analysis here
425
+ if (!is.data.frame(markers)) {
426
+ markers <- do_call(rbind, lapply(names(markers), function(x) {
427
+ markers_df <- markers[[x]]
428
+ markers_df[[each]] <- x
429
+ markers_df
430
+ }))
431
+ }
432
+ # gene, p_val, avg_log2FC, pct.1, pct.2, p_val_adj, diff_pct, <each>
433
+
434
+ if (length(allmarker_plots) > 0) {
435
+ log$info("- Visualizing all markers together ...")
436
+ attr(markers, "object") <- srtobj
437
+ attr(markers, "group.by") <- each
438
+ attr(markers, "ident.1") <- NULL
439
+ attr(markers, "ident.2") <- NULL
440
+ process_allmarkers(markers, allmarker_plots, name, each)
441
+ }
442
+
443
+ if (length(overlaps) > 0) {
444
+ log$info("- Visualizing overlaps between subcases ...")
445
+ process_overlaps(markers, overlaps, name, each)
369
446
  }
370
447
 
448
+ return(invisible())
371
449
  }
450
+ case$object <- srtobj
451
+ markers <- do_call(RunSeuratDEAnalysis, case)
452
+ case$object <- NULL
453
+ gc()
454
+
455
+ if (is.null(case$ident.1)) {
456
+ all_idents <- unique(as.character(markers[[case$group.by]]))
457
+ for (ident in all_idents) {
458
+ log$info("- {case$group.by}: {ident} ...")
459
+ ident_markers <- markers[markers[[case$group.by]] == ident, , drop = TRUE]
460
+ casename <- paste0(name, "::", paste0(case$group.by, ": ", ident))
461
+ info <- case_info(casename, outdir, create = TRUE)
462
+
463
+ attr(ident_markers, "ident.1") <- ident
464
+ process_markers(ident_markers, info = info, case = list(
465
+ dbs = dbs,
466
+ sigmarkers = sigmarkers,
467
+ enrich_style = enrich_style,
468
+ marker_plots = marker_plots,
469
+ enrich_plots = enrich_plots,
470
+ error = case$error,
471
+ ident = NULL
472
+ ))
473
+ }
372
474
 
373
- sapply(names(overlaps), run_overlap)
475
+ if (length(allmarker_plots) > 0) {
476
+ log$info("- Visualizing all markers together ...")
477
+ process_allmarkers(markers, allmarker_plots, name, case$group.by)
478
+ }
479
+
480
+ if (length(overlaps) > 0) {
481
+ log$info("- Visualizing overlaps between subcases ...")
482
+ process_overlaps(markers, overlaps, name, case$group.by)
483
+ }
484
+ } else {
485
+ info <- case_info(name, outdir, create = TRUE)
486
+ process_markers(markers, info = info, case = list(
487
+ dbs = dbs,
488
+ sigmarkers = sigmarkers,
489
+ enrich_style = enrich_style,
490
+ marker_plots = marker_plots,
491
+ enrich_plots = enrich_plots,
492
+ error = case$error,
493
+ ident = if (is.null(case$ident.2)) case$ident.1 else paste0(case$ident.1, " vs ", case$ident.2)
494
+ ))
495
+
496
+ if (!is.null(original_case)) {
497
+ markers[[each_name]] <- each
498
+ cases[[original_case]]$markers[[each]] <<- markers
499
+ }
500
+ }
501
+
502
+ invisible()
374
503
  }
375
504
 
505
+ sapply(names(cases), run_case)
506
+
376
507
  reporter$save(joboutdir)