Mercurial > repos > iuc > raceid_clustering

comparison scripts/cluster.R @ 9:0bff0ee0683a 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 82a18e57158136e265a26f27feb40f8dc13437bf
author iuc
date Wed, 24 Aug 2022 18:09:06 +0000
parents a4b734cd253b
children 49776718ae90
comparison
equal deleted inserted replaced
8:f911a64454fb 9:0bff0ee0683a
1 #!/usr/bin/env R 1 #!/usr/bin/env R
2 VERSION <- "0.5" # nolint 2 VERSION <- "0.5" # nolint
3 3
4 args <- commandArgs(trailingOnly = T) 4 args <- commandArgs(trailingOnly = TRUE)
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 }
50 } 50 }
51 51
52 if (filt.use.ccorrect) { 52 if (filt.use.ccorrect) {
53 par(mfrow = c(2, 2)) 53 par(mfrow = c(2, 2))
54 sc <- do.call(CCcorrect, c(sc, filt.ccc)) 54 sc <- do.call(CCcorrect, c(sc, filt.ccc))
55 print(plotdimsat(sc, change = T)) 55 print(plotdimsat(sc, change = TRUE))
56 print(plotdimsat(sc, change = F)) 56 print(plotdimsat(sc, change = FALSE))
57 } 57 }
58 return(sc) 58 return(sc)
59 } 59 }
60 60
61 do.cluster <- function(sc) { # nolint 61 do.cluster <- function(sc) { # nolint
62 sc <- do.call(compdist, c(sc, clust.compdist)) 62 sc <- do.call(compdist, c(sc, clust.compdist))
63 sc <- do.call(clustexp, c(sc, clust.clustexp)) 63 sc <- do.call(clustexp, c(sc, clust.clustexp))
64 if (clust.clustexp$sat) { 64 if (clust.clustexp$sat) {
65 print(plotsaturation(sc, disp = F)) 65 print(plotsaturation(sc, disp = FALSE))
66 print(plotsaturation(sc, disp = T)) 66 print(plotsaturation(sc, disp = TRUE))
67 } 67 }
68 print(plotjaccard(sc)) 68 print(plotjaccard(sc))
69 return(sc) 69 return(sc)
70 } 70 }
71 71
123 print(do.call(mtext, c(paste(buffer, "Sig. Genes"), test))) 123 print(do.call(mtext, c(paste(buffer, "Sig. Genes"), test)))
124 test$line <- 0 124 test$line <- 0
125 print(do.call(mtext, c(paste(buffer, "(fc > ", 125 print(do.call(mtext, c(paste(buffer, "(fc > ",
126 genelist.foldchange, ")"), test))) 126 genelist.foldchange, ")"), test)))
127 }) 127 })
128 write.table(df, file = out.genelist, sep = "\t", quote = F) 128 write.table(df, file = out.genelist, sep = "\t", quote = FALSE)
129 } 129 }
130 130
131 131
132 writecellassignments <- function(sc) { 132 writecellassignments <- function(sc) {
133 dat <- sc@cluster$kpart 133 dat <- sc@cluster$kpart
136 cluster.initial = dat, 136 cluster.initial = dat,
137 cluster.final = sc@cpart, 137 cluster.final = sc@cpart,
138 is.outlier = names(dat) %in% sc@out$out) 138 is.outlier = names(dat) %in% sc@out$out)
139 139
140 write.table(tab, file = out.assignments, sep = "\t", 140 write.table(tab, file = out.assignments, sep = "\t",
141 quote = F, row.names = F) 141 quote = FALSE, row.names = FALSE)
142 } 142 }
143 143
144 144
145 pdf(out.pdf) 145 pdf(out.pdf)
146 146
156 "% of genes remain,", 156 "% of genes remain,",
157 sprintf("%.1f", 100 * ncol(as.matrix( 157 sprintf("%.1f", 100 * ncol(as.matrix(
158 getfdata(sc))) / ncol(sc@expdata)), 158 getfdata(sc))) / ncol(sc@expdata)),
159 "% of cells remain")) 159 "% of cells remain"))
160 write.table(as.matrix(sc@ndata), file = out.table, col.names = NA, 160 write.table(as.matrix(sc@ndata), file = out.table, col.names = NA,
161 row.names = T, sep = "\t", quote = F) 161 row.names = TRUE, sep = "\t", quote = FALSE)
162 } 162 }
163 163
164 if (use.cluster) { 164 if (use.cluster) {
165 par(mfrow = c(2, 2)) 165 par(mfrow = c(2, 2))
166 sc <- do.cluster(sc) 166 sc <- do.cluster(sc)