Mercurial > repos > iuc > raceid_inspecttrajectory
comparison scripts/clusterinspect.R @ 0:e0e9b24d76aa draft
planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/raceid3 commit f880060c478d42202df5b78a81329f8af56b1138
author | iuc |
---|---|
date | Thu, 22 Nov 2018 04:42:18 -0500 |
parents | |
children | 86e2358cf273 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:e0e9b24d76aa |
---|---|
1 #!/usr/bin/env R | |
2 VERSION = "0.2" | |
3 | |
4 args = commandArgs(trailingOnly = T) | |
5 | |
6 if (length(args) != 1){ | |
7 message(paste("VERSION:", VERSION)) | |
8 stop("Please provide the config file") | |
9 } | |
10 | |
11 suppressWarnings(suppressPackageStartupMessages(require(RaceID))) | |
12 source(args[1]) | |
13 | |
14 ## layout | |
15 test <- list() | |
16 test$side = 3 | |
17 test$line = 3 | |
18 | |
19 do.plotting <- function(sc){ | |
20 print(plotmap(sc, final = FALSE, fr = FALSE)) | |
21 print(do.call(mtext, c("Initial Clustering tSNE", test))) | |
22 print(plotmap(sc, final = TRUE, fr = FALSE)) | |
23 print(do.call(mtext, c("Final Clustering tSNE", test))) | |
24 print(plotmap(sc, final = FALSE, fr = TRUE)) | |
25 print(do.call(mtext, c("Initial Clustering Fruchterman-Reingold", test))) | |
26 print(plotmap(sc, final = TRUE, fr = TRUE)) | |
27 print(do.call(mtext, c("Final Clustering Fruchterman-Reingold", test))) | |
28 } | |
29 | |
30 | |
31 do.inspect.symbolmap <- function(sc){ | |
32 if (!is.null(plotsym.use.typeremoveregex)){ | |
33 plotsym$types = sub(plotsym.use.typeremoveregex, "", colnames(sc@ndata)) | |
34 | |
35 if (!is.null(plotsym.use.typeremoveregex.subselect)){ | |
36 plotsym$subset = plotsym$types[grep(plotsym.use.typeremoveregex.subselect, plotsym$types)] | |
37 } | |
38 } | |
39 plotsym$fr = FALSE | |
40 print(do.call(plotsymbolsmap, c(sc, plotsym))) | |
41 print(do.call(mtext, c("Symbols tSNE", test))) | |
42 plotsym$fr = TRUE | |
43 print(do.call(plotsymbolsmap, c(sc, plotsym))) | |
44 print(do.call(mtext, c("Symbols FR", test))) | |
45 } | |
46 | |
47 do.inspect.diffgene <- function(sc){ | |
48 | |
49 getSubNames <- function(lob, sc){ | |
50 use.names <- NULL | |
51 if (!is.null(lob$manual)){ | |
52 use.names <- lob$manual | |
53 } | |
54 else if (!is.null(lob$regex)){ | |
55 nm <- colnames(sc@ndata) | |
56 use.names <- nm[grep(lob$regex, nm)] | |
57 } | |
58 else if (!is.null(lob$cln)){ | |
59 use.names <- names(sc@cpart)[sc@cpart %in% lob$cln] | |
60 } | |
61 if (is.null(use.names)){ | |
62 stop("A or B names not given!") | |
63 } | |
64 return(use.names) | |
65 } | |
66 | |
67 A <- getSubNames(gfdat.A.use, sc) | |
68 B <- getSubNames(gfdat.B.use, sc) | |
69 | |
70 fdat <- getfdata(sc, n=c(A,B)) | |
71 dexp <- diffexpnb(fdat, A=A, B=B) | |
72 ## options for diffexpnb are mostly about DESeq, ignore | |
73 plotdiffg$x = dexp | |
74 print(do.call(plotdiffgenesnb, c(plotdiffg))) | |
75 print(do.call(mtext, c("Diff Genes", test))) | |
76 } | |
77 | |
78 | |
79 do.inspect.genesofinterest <- function(sc){ | |
80 if (is.null(plotexp$n)){ ## No title, and one gene? Use gene name | |
81 if (length(plotexp$g) == 1){ | |
82 plotexp$n <- plotexp$g | |
83 } else { | |
84 plotexp$n <- paste(plotexp$g, collapse=", ") | |
85 } | |
86 } | |
87 | |
88 title <- paste(":", plotexp$n) | |
89 plotexp$n <- "" | |
90 | |
91 plotexp$logsc=FALSE; plotexp$fr = FALSE | |
92 print(do.call(plotexpmap, c(sc, plotexp))) | |
93 print(do.call(mtext, c(paste("tSNE", title), test))) | |
94 | |
95 plotexp$logsc=TRUE; plotexp$fr = FALSE | |
96 print(do.call(plotexpmap, c(sc, plotexp))) | |
97 print(do.call(mtext, c(paste("tSNE (Log)", title), test))) | |
98 | |
99 plotexp$logsc=FALSE; plotexp$fr = TRUE | |
100 print(do.call(plotexpmap, c(sc, plotexp))) | |
101 print(do.call(mtext, c(paste("FR", title), test))) | |
102 | |
103 plotexp$logsc=TRUE; plotexp$fr = TRUE | |
104 print(do.call(plotexpmap, c(sc, plotexp))) | |
105 print(do.call(mtext, c(paste("FR (Log)", title), test))) | |
106 | |
107 if (!is.null(plotmarkg$samples)){ | |
108 reg <- plotmarkg$samples | |
109 plotmarkg$samples <- sub("(\\_\\d+)$","", colnames(sc@ndata)) | |
110 } | |
111 print(do.call(plotmarkergenes, c(sc, plotmarkg))) | |
112 } | |
113 | |
114 sc <- in.rdat | |
115 | |
116 pdf(out.pdf) | |
117 if (perform.plotting) do.plotting(sc) | |
118 if (perform.symbolmap) do.inspect.symbolmap(sc) | |
119 if (perform.genesofinterest) do.inspect.genesofinterest(sc) | |
120 if (perform.diffgene) do.inspect.diffgene(sc) | |
121 dev.off() |