Mercurial > repos > iuc > raceid_inspecttrajectory

comparison scripts/clusterinspect.R @ 6:45e05fe1d239 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/raceid3 commit 53916f6803b93234f992f5fd4fad61d7013d82af"
author iuc
date Thu, 15 Apr 2021 18:54:52 +0000
parents 2716bab0b544
children 3a33926d9700
comparison
equal deleted inserted replaced
5:4486bd1273bc 6:45e05fe1d239
1 #!/usr/bin/env R 1 #!/usr/bin/env R
2 VERSION = "0.5" 2 VERSION <- "0.5" # nolint
3 3
4 args = commandArgs(trailingOnly = T) 4 args <- commandArgs(trailingOnly = T)
5 5
6 if (length(args) != 1){ 6 if (length(args) != 1) {
7 message(paste("VERSION:", VERSION)) 7 message(paste("VERSION:", VERSION))
8 stop("Please provide the config file") 8 stop("Please provide the config file")
9 } 9 }
10 10
11 suppressWarnings(suppressPackageStartupMessages(require(RaceID))) 11 suppressWarnings(suppressPackageStartupMessages(require(RaceID)))
12 source(args[1]) 12 source(args[1])
13 13
14 ## layout 14 ## layout
15 test <- list() 15 test <- list()
16 test$side = 3 16 test$side <- 3
17 test$line = 3 17 test$line <- 3
18 18
19 do.plotting <- function(sc){ 19 do.plotting <- function(sc) { # nolint
20 20
21 sc.tmp <- sc 21 sc_tmp <- sc
22 22
23 ## If it's a subset, we need to get clever and subset specific parts 23 ## If it's a subset, we need to get clever and subset specific parts
24 if (!(is.null(plotting.cln) || is.na(plotting.cln))){ 24 if (!(is.null(plotting.cln) || is.na(plotting.cln))) {
25 cellstokeep <- names(sc.tmp@cpart[sc.tmp@cpart %in% plotting.cln]) 25 cellstokeep <- names(sc_tmp@cpart[sc_tmp@cpart %in% plotting.cln])
26 26
27 ## Subselect partitions for initial and final clusters 27 ## Subselect partitions for initial and final clusters
28 sc.tmp@cpart <- sc.tmp@cpart[cellstokeep] 28 sc_tmp@cpart <- sc_tmp@cpart[cellstokeep]
29 sc.tmp@cluster$kpart <- sc.tmp@cluster$kpart[cellstokeep] 29 sc_tmp@cluster$kpart <- sc_tmp@cluster$kpart[cellstokeep]
30 30
31 ## Subselect tSNE and FR data 31 ## Subselect tSNE and FR data
32 ## - Note: no names in tsne, so we assume it follows the ndata naming 32 sc_tmp@tsne <- sc_tmp@tsne[colnames(sc_tmp@ndata) %in% cellstokeep, ]
33 sc.tmp@tsne <- sc.tmp@tsne[colnames(sc.tmp@ndata) %in% cellstokeep,] 33 sc_tmp@umap <- sc_tmp@umap[colnames(sc_tmp@ndata) %in% cellstokeep, ]
34 sc.tmp@fr <- sc.tmp@fr[cellstokeep,] 34 sc_tmp@fr <- sc_tmp@fr[cellstokeep, ]
35 } 35 }
36 36
37 print(plotmap(sc.tmp, final = FALSE, fr = FALSE)) 37 print(plotmap(sc_tmp, final = FALSE, fr = FALSE))
38 print(do.call(mtext, c("Initial Clustering tSNE", test))) 38 print(do.call(mtext, c("Initial Clustering tSNE", test)))
39 print(plotmap(sc.tmp, final = TRUE, fr = FALSE)) 39 print(plotmap(sc_tmp, final = TRUE, fr = FALSE))
40 print(do.call(mtext, c("Final Clustering tSNE", test))) 40 print(do.call(mtext, c("Final Clustering tSNE", test)))
41 print(plotmap(sc.tmp, final = FALSE, fr = TRUE)) 41 print(plotmap(sc_tmp, final = FALSE, um = TRUE))
42 print(do.call(mtext, c("Initial Clustering UMAP", test)))
43 print(plotmap(sc_tmp, final = TRUE, um = TRUE))
44 print(do.call(mtext, c("Final Clustering UMAP", test)))
45 print(plotmap(sc_tmp, final = FALSE, fr = TRUE))
42 print(do.call(mtext, c("Initial Clustering Fruchterman-Reingold", test))) 46 print(do.call(mtext, c("Initial Clustering Fruchterman-Reingold", test)))
43 print(plotmap(sc.tmp, final = TRUE, fr = TRUE)) 47 print(plotmap(sc_tmp, final = TRUE, fr = TRUE))
44 print(do.call(mtext, c("Final Clustering Fruchterman-Reingold", test))) 48 print(do.call(mtext, c("Final Clustering Fruchterman-Reingold", test)))
45 } 49 }
46 50
47 51
48 do.inspect.symbolmap <- function(sc){ 52 do.inspect.symbolmap <- function(sc) { # nolint
49 if (!is.null(plotsym.use.typeremoveregex)){ 53 if (!is.null(plotsym.use.typeremoveregex)) {
50 plotsym$types = sub(plotsym.use.typeremoveregex, "", colnames(sc@ndata)) 54 plotsym$types <- sub(plotsym.use.typeremoveregex, "",
55 colnames(sc@ndata))
51 56
52 if (!is.null(plotsym.use.typeremoveregex.subselect)){ 57 if (!is.null(plotsym.use.typeremoveregex.subselect)) {
53 plotsym$subset = plotsym$types[grep(plotsym.use.typeremoveregex.subselect, plotsym$types)] 58 plotsym$subset <- plotsym$types[grep(
59 plotsym.use.typeremoveregex.subselect,
60 plotsym$types)]
54 } 61 }
55 } 62 }
56 plotsym$fr = FALSE 63 plotsym$fr <- FALSE
57 print(do.call(plotsymbolsmap, c(sc, plotsym))) 64 print(do.call(plotsymbolsmap, c(sc, plotsym)))
58 print(do.call(mtext, c("Symbols tSNE", test))) 65 print(do.call(mtext, c("Symbols tSNE", test)))
59 plotsym$fr = TRUE 66 plotsym$fr <- TRUE
60 print(do.call(plotsymbolsmap, c(sc, plotsym))) 67 print(do.call(plotsymbolsmap, c(sc, plotsym)))
61 print(do.call(mtext, c("Symbols FR", test))) 68 print(do.call(mtext, c("Symbols FR", test)))
62 } 69 }
63 70
64 do.inspect.diffgene <- function(sc){ 71 do.inspect.diffgene <- function(sc) { # nolint
65 72
66 getSubNames <- function(lob, sc){ 73 getSubNames <- function(lob, sc) { # nolint
67 use.names <- NULL 74 use_names <- NULL
68 if (!is.null(lob$manual)){ 75 if (!is.null(lob$manual)) {
69 use.names <- lob$manual 76 use_names <- lob$manual
70 } 77 }
71 else if (!is.null(lob$regex)){ 78 else if (!is.null(lob$regex)) {
72 nm <- colnames(sc@ndata) 79 nm <- colnames(sc@ndata)
73 use.names <- nm[grep(lob$regex, nm)] 80 use_names <- nm[grep(lob$regex, nm)]
74 } 81 }
75 else if (!is.null(lob$cln)){ 82 else if (!is.null(lob$cln)) {
76 use.names <- names(sc@cpart)[sc@cpart %in% lob$cln] 83 use_names <- names(sc@cpart)[sc@cpart %in% lob$cln]
77 } 84 }
78 if (is.null(use.names)){ 85 if (is.null(use_names)) {
79 stop("A or B names not given!") 86 stop("A or B names not given!")
80 } 87 }
81 return(use.names) 88 return(use_names)
82 } 89 }
83 90
84 A <- getSubNames(gfdat.A.use, sc) 91 A <- getSubNames(gfdat.A.use, sc) # nolint
85 B <- getSubNames(gfdat.B.use, sc) 92 B <- getSubNames(gfdat.B.use, sc) # nolint
86 93
87 fdat <- getfdata(sc, n=c(A,B)) 94 fdat <- getfdata(sc, n = c(A, B))
88 dexp <- diffexpnb(fdat, A=A, B=B) 95 dexp <- diffexpnb(fdat, A = A, B = B)
89 ## options for diffexpnb are mostly about DESeq, ignore 96 ## options for diffexpnb are mostly about DESeq, ignore
90 plotdiffg$x = dexp 97 plotdiffg$x <- dexp
91 print(do.call(plotdiffgenesnb, c(plotdiffg))) 98 print(do.call(plotdiffgenesnb, c(plotdiffg)))
92 print(do.call(mtext, c("Diff Genes", test))) 99 print(do.call(mtext, c("Diff Genes", test)))
93 } 100 }
94 101
95 102
96 do.inspect.genesofinterest <- function(sc){ 103 do.inspect.genesofinterest <- function(sc) { # nolint
97 if (is.null(plotexp$n)){ ## No title, and one gene? Use gene name 104 if (is.null(plotexp$n)) { ## No title, and one gene? Use gene name
98 if (length(plotexp$g) == 1){ 105 if (length(plotexp$g) == 1) {
99 plotexp$n <- plotexp$g 106 plotexp$n <- plotexp$g
100 } else { 107 } else {
101 plotexp$n <- paste(plotexp$g, collapse=", ") 108 plotexp$n <- paste(plotexp$g, collapse = ", ")
102 } 109 }
103 } 110 }
104 111
105 title <- paste(":", plotexp$n) 112 title <- paste(":", plotexp$n)
106 plotexp$n <- "" 113 plotexp$n <- ""
107 114
108 plotexp$logsc=FALSE; plotexp$fr = FALSE 115 plotexp$logsc <- FALSE; plotexp$fr <- FALSE
109 print(do.call(plotexpmap, c(sc, plotexp))) 116 print(do.call(plotexpmap, c(sc, plotexp)))
110 print(do.call(mtext, c(paste("tSNE", title), test))) 117 print(do.call(mtext, c(paste("tSNE", title), test)))
111 118
112 plotexp$logsc=TRUE; plotexp$fr = FALSE 119 plotexp$logsc <- TRUE; plotexp$fr <- FALSE
113 print(do.call(plotexpmap, c(sc, plotexp))) 120 print(do.call(plotexpmap, c(sc, plotexp)))
114 print(do.call(mtext, c(paste("tSNE (Log)", title), test))) 121 print(do.call(mtext, c(paste("tSNE (Log)", title), test)))
115 122
116 plotexp$logsc=FALSE; plotexp$fr = TRUE 123 plotexp$logsc <- FALSE; plotexp$fr <- TRUE
117 print(do.call(plotexpmap, c(sc, plotexp))) 124 print(do.call(plotexpmap, c(sc, plotexp)))
118 print(do.call(mtext, c(paste("FR", title), test))) 125 print(do.call(mtext, c(paste("FR", title), test)))
119 126
120 plotexp$logsc=TRUE; plotexp$fr = TRUE 127 plotexp$logsc <- TRUE; plotexp$fr <- TRUE
121 print(do.call(plotexpmap, c(sc, plotexp))) 128 print(do.call(plotexpmap, c(sc, plotexp)))
122 print(do.call(mtext, c(paste("FR (Log)", title), test))) 129 print(do.call(mtext, c(paste("FR (Log)", title), test)))
123 130
124 if (!is.null(plotmarkg$samples)){ 131 if (!is.null(plotmarkg$samples)) {
125 reg <- plotmarkg$samples 132 reg <- plotmarkg$samples
126 plotmarkg$samples <- sub("(\\_\\d+)$","", colnames(sc@ndata)) 133 plotmarkg$samples <- sub("(\\_\\d+)$", "", colnames(sc@ndata))
127 } 134 }
128 print(do.call(plotmarkergenes, c(sc, plotmarkg))) 135 print(do.call(plotmarkergenes, c(sc, plotmarkg)))
129 } 136 }
130 137
131 sc <- in.rdat 138 sc <- in.rdat