rbbt-dm 1.1.18 → 1.1.19
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.
- checksums.yaml +4 -4
- data/lib/rbbt/matrix/differential.rb +1 -1
- data/share/R/MA.R +545 -0
- data/share/R/barcode.R +41 -0
- data/share/R/heatmap.3.R +516 -0
- metadata +5 -2
checksums.yaml
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
---
|
|
2
2
|
SHA1:
|
|
3
|
-
metadata.gz:
|
|
4
|
-
data.tar.gz:
|
|
3
|
+
metadata.gz: 27188d3dbc9c8d88409655bea507f70bfd14e9e5
|
|
4
|
+
data.tar.gz: 69bc8947fb0f736721eff76d58ec6502f4cfb840
|
|
5
5
|
SHA512:
|
|
6
|
-
metadata.gz:
|
|
7
|
-
data.tar.gz:
|
|
6
|
+
metadata.gz: bcd2fa58747a8373cc7cf1ccdfd2f5a27e2ed55f40152e9eb72c0ca15130db40d24fc92c554ddb6f6c1ad42cf4640b04fd8f93a605134692f9a761a7cc447da6
|
|
7
|
+
data.tar.gz: e807c21ef69d7a7aebbccb5f1710b199fe2a573c485cd2d04adddf42aff2042762aca332c54a2550ad514fd2a9816f3c2288b82bc3d49ac229eac301240a3fb3
|
data/share/R/MA.R
ADDED
|
@@ -0,0 +1,545 @@
|
|
|
1
|
+
library(limma)
|
|
2
|
+
|
|
3
|
+
#########################################################################
|
|
4
|
+
# Model processing
|
|
5
|
+
|
|
6
|
+
# Ratio
|
|
7
|
+
rbbt.dm.matrix.differential.ratio.oneside <- function(expr){
|
|
8
|
+
ratio = apply(expr, 1 ,function(x){mean(x, na.rm = TRUE)})
|
|
9
|
+
names(ratio) <- rownames(expr);
|
|
10
|
+
return(ratio);
|
|
11
|
+
}
|
|
12
|
+
|
|
13
|
+
rbbt.dm.matrix.differential.ratio.twoside <- function(expr, contrast){
|
|
14
|
+
ratio = rbbt.dm.matrix.differential.ratio.oneside(expr) - rbbt.dm.matrix.differential.ratio.oneside(contrast)
|
|
15
|
+
names(ratio) <- rownames(expr);
|
|
16
|
+
return(ratio);
|
|
17
|
+
}
|
|
18
|
+
|
|
19
|
+
# Limma
|
|
20
|
+
rbbt.dm.matrix.differential.limma.oneside <- function(expr, subset = NULL, eBayes.trend=FALSE){
|
|
21
|
+
|
|
22
|
+
if (is.null(subset)){
|
|
23
|
+
fit <- lmFit(expr);
|
|
24
|
+
}else{
|
|
25
|
+
design = rep(0, dim(expr)[2]);
|
|
26
|
+
design[names(expr) %in% subset] = 1;
|
|
27
|
+
}
|
|
28
|
+
|
|
29
|
+
fit <- lmFit(expr, design);
|
|
30
|
+
|
|
31
|
+
fit <- eBayes(fit, trend=eBayes.trend);
|
|
32
|
+
|
|
33
|
+
sign = fit$t < 0;
|
|
34
|
+
sign[is.na(sign)] = FALSE;
|
|
35
|
+
fit$p.value[sign] = - fit$p.value[sign];
|
|
36
|
+
|
|
37
|
+
return(list(t= fit$t, p.values= fit$p.value));
|
|
38
|
+
}
|
|
39
|
+
|
|
40
|
+
rbbt.dm.matrix.differential.limma.twoside <- function(expr, subset.main, subset.contrast, eBayes.trend=FALSE){
|
|
41
|
+
names.expr = dimnames(expr)[[2]]
|
|
42
|
+
|
|
43
|
+
design = cbind(rep(1,dim(expr)[2]), rep(0,dim(expr)[2]));
|
|
44
|
+
colnames(design) <-c('intercept', 'expr');
|
|
45
|
+
design[names.expr %in% subset.main,] = 1;
|
|
46
|
+
design[names.expr %in% subset.contrast,'intercept'] = 1;
|
|
47
|
+
|
|
48
|
+
|
|
49
|
+
fit <- lmFit(expr, design);
|
|
50
|
+
|
|
51
|
+
fit <- eBayes(fit,trend=eBayes.trend);
|
|
52
|
+
|
|
53
|
+
sign = fit$t[,2] < 0;
|
|
54
|
+
sign[is.na(sign)] = FALSE;
|
|
55
|
+
fit$p.value[sign,2] = - fit$p.value[sign,2];
|
|
56
|
+
|
|
57
|
+
return(list(t= fit$t[,2], p.values= fit$p.value[,2]));
|
|
58
|
+
}
|
|
59
|
+
|
|
60
|
+
|
|
61
|
+
rbbt.dm.matrix.guess.log2 <- function(m, two.channel){
|
|
62
|
+
if (two.channel){
|
|
63
|
+
return (sum(m < 0, na.rm = TRUE) == 0);
|
|
64
|
+
}else{
|
|
65
|
+
return (max(m, na.rm = TRUE) > 100);
|
|
66
|
+
}
|
|
67
|
+
}
|
|
68
|
+
|
|
69
|
+
rbbt.dm.matrix.differential <- function(file, main, contrast = NULL, log2 = FALSE, outfile = NULL, key.field = NULL, two.channel = NULL, namespace = NULL, eBayes.trend = FALSE){
|
|
70
|
+
if (is.null(namespace)) namespace = rbbt.default_code("Hsa")
|
|
71
|
+
data = data.matrix(rbbt.tsv(file));
|
|
72
|
+
dimnames = dimnames(data)
|
|
73
|
+
original.dimnames = dimnames;
|
|
74
|
+
|
|
75
|
+
dimnames[[1]] = make.names(dimnames[[1]])
|
|
76
|
+
dimnames[[2]] = make.names(dimnames[[2]])
|
|
77
|
+
|
|
78
|
+
dimnames(data) <- dimnames
|
|
79
|
+
main <- make.names(main);
|
|
80
|
+
contrast <- make.names(contrast);
|
|
81
|
+
|
|
82
|
+
ids = rownames(data);
|
|
83
|
+
if (is.null(key.field)){ key.field = "ID" }
|
|
84
|
+
|
|
85
|
+
if (is.null(log2)){
|
|
86
|
+
log2 = rbbt.dm.matrix.guess.log2(data, two.channel)
|
|
87
|
+
}
|
|
88
|
+
|
|
89
|
+
if (log2){
|
|
90
|
+
data = log2(data);
|
|
91
|
+
min = min(data[data != -Inf])
|
|
92
|
+
data[data == -Inf] = min
|
|
93
|
+
}
|
|
94
|
+
|
|
95
|
+
if (is.null(contrast)){
|
|
96
|
+
ratio = rbbt.dm.matrix.differential.ratio.oneside(subset(data, select=main));
|
|
97
|
+
}else{
|
|
98
|
+
ratio = rbbt.dm.matrix.differential.ratio.twoside(subset(data, select=main), subset(data, select=contrast));
|
|
99
|
+
}
|
|
100
|
+
|
|
101
|
+
if (is.null(contrast)){
|
|
102
|
+
limma = NULL;
|
|
103
|
+
tryCatch({
|
|
104
|
+
limma = rbbt.dm.matrix.differential.limma.oneside(data, main, eBayes.trend=eBayes.trend);
|
|
105
|
+
}, error=function(x){
|
|
106
|
+
cat("Limma failed for complete dataset. Trying just subset.\n", file=stderr());
|
|
107
|
+
print(x, file=stderr());
|
|
108
|
+
tryCatch({
|
|
109
|
+
limma = rbbt.dm.matrix.differential.limma.oneside(subset(data, select=main), eBayes.trend=eBayes.trend);
|
|
110
|
+
}, error=function(x){
|
|
111
|
+
cat("Limma failed for subset dataset.\n", file=stderr());
|
|
112
|
+
print(x, file=stderr());
|
|
113
|
+
});
|
|
114
|
+
})
|
|
115
|
+
}else{
|
|
116
|
+
limma = NULL;
|
|
117
|
+
tryCatch({
|
|
118
|
+
limma = rbbt.dm.matrix.differential.limma.twoside(data, main, contrast, eBayes.trend=eBayes.trend);
|
|
119
|
+
}, error=function(x){
|
|
120
|
+
cat("Limma failed for complete dataset. Trying just subset.\n", file=stderr());
|
|
121
|
+
print(x, file=stderr());
|
|
122
|
+
tryCatch({
|
|
123
|
+
limma = rbbt.dm.matrix.differential.limma.twoside(subset(data, select=c(main, contrast)), main, contrast, eBayes.trend=eBayes.trend);
|
|
124
|
+
}, error=function(x){
|
|
125
|
+
cat("Limma failed for subset dataset.\n", file=stderr());
|
|
126
|
+
print(x, file=stderr());
|
|
127
|
+
});
|
|
128
|
+
})
|
|
129
|
+
|
|
130
|
+
}
|
|
131
|
+
|
|
132
|
+
|
|
133
|
+
if (! is.null(limma) && sum(is.na(limma$t)) != length(limma$t)){
|
|
134
|
+
result = data.frame(ratio = ratio[ids], t.values = limma$t[ids], p.values = limma$p.values[ids])
|
|
135
|
+
result["adjusted.p.values"] = p.adjust(abs(result$p.values), "fdr") * sign(result$p.values)
|
|
136
|
+
}else{
|
|
137
|
+
result = data.frame(ratio = ratio)
|
|
138
|
+
}
|
|
139
|
+
|
|
140
|
+
rownames(result) <- original.dimnames[[1]]
|
|
141
|
+
|
|
142
|
+
if (is.null(outfile)){
|
|
143
|
+
return(result);
|
|
144
|
+
}else{
|
|
145
|
+
rbbt.tsv.write(outfile, result, key.field, paste(":type=:list#:cast=:to_f#:namespace=", namespace, "#comment=Negative values mark downregulation", sep=""));
|
|
146
|
+
return(NULL);
|
|
147
|
+
}
|
|
148
|
+
}
|
|
149
|
+
|
|
150
|
+
|
|
151
|
+
|
|
152
|
+
############################################################################
|
|
153
|
+
############################################################################
|
|
154
|
+
############################################################################
|
|
155
|
+
############################################################################
|
|
156
|
+
############################################################################
|
|
157
|
+
# OLD STUFF
|
|
158
|
+
|
|
159
|
+
|
|
160
|
+
#MA.get_order <- function(values){
|
|
161
|
+
# orders = values;
|
|
162
|
+
# orders[,] = NA;
|
|
163
|
+
#
|
|
164
|
+
# for (i in 1:dim(values)[2]){
|
|
165
|
+
# positions = names(sort(values[,i],decreasing=T,na.last=NA));
|
|
166
|
+
# orders[,i] = NA;
|
|
167
|
+
# orders[positions,i] = 1:length(positions)
|
|
168
|
+
# }
|
|
169
|
+
# orders
|
|
170
|
+
#}
|
|
171
|
+
#
|
|
172
|
+
#MA.guess.do.log2 <- function(m, two.channel){
|
|
173
|
+
# if (two.channel){
|
|
174
|
+
# return (sum(m < 0, na.rm = TRUE) == 0);
|
|
175
|
+
# }else{
|
|
176
|
+
# return (max(m, na.rm = TRUE) > 100);
|
|
177
|
+
# }
|
|
178
|
+
#}
|
|
179
|
+
#
|
|
180
|
+
#MA.translate <- function(m, trans){
|
|
181
|
+
# trans[trans==""] = NA;
|
|
182
|
+
# trans[trans=="NO MATCH"] = NA;
|
|
183
|
+
#
|
|
184
|
+
# missing = length(trans) - dim(m)[1];
|
|
185
|
+
#
|
|
186
|
+
## If extra genes
|
|
187
|
+
# if (missing < 0){
|
|
188
|
+
# trans = c(trans,rep(NA, - missing));
|
|
189
|
+
# missing = 0;
|
|
190
|
+
# }
|
|
191
|
+
# n = apply(m,2,function(x){
|
|
192
|
+
## Complete data with missing genes
|
|
193
|
+
# x.complete = c(x,rep(NA, missing));
|
|
194
|
+
# tapply(x.complete, factor(trans), median)
|
|
195
|
+
# });
|
|
196
|
+
# n[sort(rownames(n),index.return=T)$ix,]
|
|
197
|
+
#}
|
|
198
|
+
#
|
|
199
|
+
## Conditions
|
|
200
|
+
#
|
|
201
|
+
#MA.conditions.has_control <- function(x){
|
|
202
|
+
# keywords = c('none', 'control', 'normal', 'wild', 'baseline', 'untreat', 'uninfected', 'universal', 'reference', 'vehicle', 'w.t.','wt');
|
|
203
|
+
# for(keyword in keywords){
|
|
204
|
+
# control = grep(keyword, x, ignore.case = TRUE);
|
|
205
|
+
# if (any(control)){
|
|
206
|
+
# return(x[control[1]]);
|
|
207
|
+
# }
|
|
208
|
+
# }
|
|
209
|
+
# return(NULL)
|
|
210
|
+
#}
|
|
211
|
+
#
|
|
212
|
+
#MA.condition.values <- function(values){
|
|
213
|
+
# control = MA.conditions.has_control(values);
|
|
214
|
+
#
|
|
215
|
+
# values.factor = factor(values);
|
|
216
|
+
# values.levels = levels(values.factor);
|
|
217
|
+
#
|
|
218
|
+
## If there is a control state remove it from sorting
|
|
219
|
+
# if (!is.null(control))
|
|
220
|
+
# values.levels = values.levels[values.levels != control];
|
|
221
|
+
#
|
|
222
|
+
#
|
|
223
|
+
## Use numeric sort if they all have numbers
|
|
224
|
+
# if (length(grep('^ *[0-9]+',values.levels,perl=TRUE)) == length(values.levels)){
|
|
225
|
+
# ix = sort(as.numeric(sub('^ *([0-9]+).*',"\\1",values.levels)), decreasing = T, index.return = TRUE)$ix
|
|
226
|
+
# }else{
|
|
227
|
+
# ix = sort(values.levels, decreasing = T, index.return = TRUE)$ix
|
|
228
|
+
# }
|
|
229
|
+
#
|
|
230
|
+
# return(list(values = values.levels[ix], control = control));
|
|
231
|
+
#}
|
|
232
|
+
#
|
|
233
|
+
#
|
|
234
|
+
##########################################################################
|
|
235
|
+
## Model processing
|
|
236
|
+
#
|
|
237
|
+
## Ratio
|
|
238
|
+
#MA.ratio.two_channel <- function(m, conditions, main){
|
|
239
|
+
# main = m[,conditions==main];
|
|
240
|
+
# if (!is.null(dim(main))){
|
|
241
|
+
# main = apply(main, 1 ,function(x){mean(x, na.rm = TRUE)});
|
|
242
|
+
# }
|
|
243
|
+
# return(main);
|
|
244
|
+
#}
|
|
245
|
+
#
|
|
246
|
+
#MA.ratio.contrast <- function(m, conditions, main, contrast){
|
|
247
|
+
# main = m[,conditions==main];
|
|
248
|
+
# if (!is.null(dim(main))){
|
|
249
|
+
# main = apply(main, 1 ,function(x){mean(x, na.rm = TRUE)});
|
|
250
|
+
# }
|
|
251
|
+
#
|
|
252
|
+
# contrast = m[,conditions==contrast];
|
|
253
|
+
# if (!is.null(dim(contrast))){
|
|
254
|
+
# contrast = apply(contrast, 1 ,function(x){mean(x, na.rm = TRUE)});
|
|
255
|
+
# }
|
|
256
|
+
#
|
|
257
|
+
# return (main - contrast);
|
|
258
|
+
#}
|
|
259
|
+
#
|
|
260
|
+
#
|
|
261
|
+
## Limma
|
|
262
|
+
#
|
|
263
|
+
#MA.limma.two_channel <- function(m, conditions, main){
|
|
264
|
+
# if (sum(conditions == main) < 3){
|
|
265
|
+
# return(NULL);
|
|
266
|
+
# }
|
|
267
|
+
#
|
|
268
|
+
# design = rep(0,dim(m)[2]);
|
|
269
|
+
# design[conditions == main] = 1;
|
|
270
|
+
#
|
|
271
|
+
## We need to subset the columns because of a problem with NA values. This
|
|
272
|
+
## might affect eBayes variance estimations, thats my guess anyway...
|
|
273
|
+
#
|
|
274
|
+
# fit <- lmFit(m[,design == 1],rep(1, sum(design)));
|
|
275
|
+
#
|
|
276
|
+
# tryCatch({
|
|
277
|
+
# fit <- eBayes(fit);
|
|
278
|
+
# sign = fit$t < 0;
|
|
279
|
+
# sign[is.na(sign)] = FALSE;
|
|
280
|
+
# fit$p.value[sign] = - fit$p.value[sign];
|
|
281
|
+
# return(list(t= fit$t, p.values= fit$p.value));
|
|
282
|
+
# }, error=function(x){
|
|
283
|
+
# print("Exception caught in eBayes", file=stderr);
|
|
284
|
+
# print(x, file=stderr);
|
|
285
|
+
# })
|
|
286
|
+
#
|
|
287
|
+
# return(NULL);
|
|
288
|
+
#}
|
|
289
|
+
#
|
|
290
|
+
#MA.limma.contrast <- function(m, conditions, main, contrast){
|
|
291
|
+
# if (sum(conditions == main) + sum(conditions == contrast) < 3){
|
|
292
|
+
# return(NULL);
|
|
293
|
+
# }
|
|
294
|
+
# m = cbind(m[,conditions == main],m[,conditions == contrast]);
|
|
295
|
+
#
|
|
296
|
+
# design = cbind(rep(1,dim(m)[2]), rep(0,dim(m)[2]));
|
|
297
|
+
# colnames(design) <-c('intercept', 'main');
|
|
298
|
+
# design[1:sum(conditions==main),2] = 1;
|
|
299
|
+
#
|
|
300
|
+
#
|
|
301
|
+
# fit <- lmFit(m,design);
|
|
302
|
+
# tryCatch({
|
|
303
|
+
# fit <- eBayes(fit);
|
|
304
|
+
# sign = fit$t[,2] < 0;
|
|
305
|
+
# sign[is.na(sign)] = FALSE;
|
|
306
|
+
# fit$p.value[sign,2] = - fit$p.value[sign,2]
|
|
307
|
+
# return(list(t= fit$t[,2], p.values= fit$p.value[,2] ));
|
|
308
|
+
# }, error=function(x){
|
|
309
|
+
# print("Exception caught in eBayes", file=stderr);
|
|
310
|
+
# print(x, file=stderr);
|
|
311
|
+
# })
|
|
312
|
+
#
|
|
313
|
+
# return(NULL);
|
|
314
|
+
#}
|
|
315
|
+
#
|
|
316
|
+
#
|
|
317
|
+
##########################################################################
|
|
318
|
+
## Process conditions
|
|
319
|
+
#
|
|
320
|
+
#MA.strip_blanks <- function(text){
|
|
321
|
+
# text = sub(' *$', '' ,text);
|
|
322
|
+
# text = sub('^ *', '' ,text);
|
|
323
|
+
#
|
|
324
|
+
# return(text);
|
|
325
|
+
#}
|
|
326
|
+
#
|
|
327
|
+
#MA.orders <- function(ratios, t){
|
|
328
|
+
# best = vector();
|
|
329
|
+
# names = vector();
|
|
330
|
+
# for (name in colnames(ratios)){
|
|
331
|
+
# if (sum(colnames(t) == name) > 0){
|
|
332
|
+
# best = cbind(best, t[,name]);
|
|
333
|
+
# names = c(names, name);
|
|
334
|
+
# }else{
|
|
335
|
+
# best = cbind(best, ratios[,name]);
|
|
336
|
+
# names = c(names, paste(name,'[ratio]', sep=" "));
|
|
337
|
+
# }
|
|
338
|
+
# }
|
|
339
|
+
# rownames(best) <- rownames(ratios);
|
|
340
|
+
# orders <- as.data.frame(MA.get_order(best));
|
|
341
|
+
# colnames(orders) <- names;
|
|
342
|
+
#
|
|
343
|
+
# return(orders);
|
|
344
|
+
#}
|
|
345
|
+
#
|
|
346
|
+
#MA.process_conditions.contrasts <- function(m, conditions, two.channel){
|
|
347
|
+
# max_levels = 10;
|
|
348
|
+
# max_levels_control = 1;
|
|
349
|
+
#
|
|
350
|
+
#
|
|
351
|
+
# values = MA.condition.values(conditions);
|
|
352
|
+
#
|
|
353
|
+
#
|
|
354
|
+
# ratios = vector();
|
|
355
|
+
# t = vector();
|
|
356
|
+
# p.values = vector();
|
|
357
|
+
#
|
|
358
|
+
# ratio_names = vector();
|
|
359
|
+
# t_names = vector();
|
|
360
|
+
#
|
|
361
|
+
# if (!is.null(values$control)){
|
|
362
|
+
# contrast = values$control;
|
|
363
|
+
# for (main in values$values){
|
|
364
|
+
# name = paste(main, contrast, sep = " <=> ")
|
|
365
|
+
#
|
|
366
|
+
# ratio = MA.ratio.contrast(m, conditions, main, contrast);
|
|
367
|
+
# ratio_names = c(ratio_names, name);
|
|
368
|
+
# ratios = cbind(ratios, ratio);
|
|
369
|
+
#
|
|
370
|
+
# res = MA.limma.contrast(m, conditions, main, contrast);
|
|
371
|
+
# if (!is.null(res)){
|
|
372
|
+
# t_names = c(t_names, name);
|
|
373
|
+
# t = cbind(t, res$t);
|
|
374
|
+
# p.values = cbind(p.values, res$p.values);
|
|
375
|
+
# }
|
|
376
|
+
# }
|
|
377
|
+
# }
|
|
378
|
+
#
|
|
379
|
+
#
|
|
380
|
+
# if (length(values$values) <= max_levels_control || (is.null(values$control) && !two.channel && length(values$values) <= max_levels )){
|
|
381
|
+
#
|
|
382
|
+
# remaining = values$values;
|
|
383
|
+
# for (main in values$values){
|
|
384
|
+
# remaining = remaining[remaining != main];
|
|
385
|
+
# for (contrast in remaining){
|
|
386
|
+
# name = paste(main, contrast, sep = " <=> ");
|
|
387
|
+
#
|
|
388
|
+
# ratio = MA.ratio.contrast(m, conditions, main, contrast);
|
|
389
|
+
# ratio_names = c(ratio_names, name);
|
|
390
|
+
# ratios = cbind(ratios, ratio);
|
|
391
|
+
#
|
|
392
|
+
# res = MA.limma.contrast(m, conditions, main, contrast);
|
|
393
|
+
# if (!is.null(res)){
|
|
394
|
+
# t_names = c(t_names, name);
|
|
395
|
+
# t = cbind(t, res$t);
|
|
396
|
+
# p.values = cbind(p.values, res$p.values);
|
|
397
|
+
# }
|
|
398
|
+
# }
|
|
399
|
+
# }
|
|
400
|
+
# }
|
|
401
|
+
#
|
|
402
|
+
#
|
|
403
|
+
# if (length(ratio_names) != 0){
|
|
404
|
+
# ratio_names = as.vector(sapply(ratio_names, MA.strip_blanks));
|
|
405
|
+
# colnames(ratios) <- ratio_names
|
|
406
|
+
# }
|
|
407
|
+
#
|
|
408
|
+
# if (length(t_names) != 0){
|
|
409
|
+
# t_names = as.vector(sapply(t_names, MA.strip_blanks));
|
|
410
|
+
# colnames(t) <- t_names;
|
|
411
|
+
# colnames(p.values) <- t_names;
|
|
412
|
+
# }
|
|
413
|
+
#
|
|
414
|
+
#
|
|
415
|
+
# return(list(ratios = ratios, t=t, p.values = p.values));
|
|
416
|
+
#}
|
|
417
|
+
#
|
|
418
|
+
#MA.process_conditions.two_channel <- function(m, conditions){
|
|
419
|
+
# values = MA.condition.values(conditions);
|
|
420
|
+
#
|
|
421
|
+
# all_values = values$values;
|
|
422
|
+
# if (!is.null(values$control)){
|
|
423
|
+
# all_values = c(all_values, values$control);
|
|
424
|
+
# }
|
|
425
|
+
#
|
|
426
|
+
#
|
|
427
|
+
# ratios = vector();
|
|
428
|
+
# t = vector();
|
|
429
|
+
# p.values = vector();
|
|
430
|
+
#
|
|
431
|
+
# ratio_names = vector();
|
|
432
|
+
# t_names = vector();
|
|
433
|
+
#
|
|
434
|
+
#
|
|
435
|
+
# for (main in all_values){
|
|
436
|
+
# name = main;
|
|
437
|
+
#
|
|
438
|
+
# ratio = MA.ratio.two_channel(m, conditions, main);
|
|
439
|
+
# ratio_names = c(ratio_names, name);
|
|
440
|
+
# ratios = cbind(ratios, ratio);
|
|
441
|
+
#
|
|
442
|
+
# res = MA.limma.two_channel(m, conditions, main);
|
|
443
|
+
# if (!is.null(res)){
|
|
444
|
+
# t_names = c(t_names, name);
|
|
445
|
+
# t = cbind(t, res$t);
|
|
446
|
+
# p.values = cbind(p.values, res$p.values);
|
|
447
|
+
# }
|
|
448
|
+
# }
|
|
449
|
+
#
|
|
450
|
+
# if (length(ratio_names) != 0){
|
|
451
|
+
# ratio_names = as.vector(sapply(ratio_names, MA.strip_blanks));
|
|
452
|
+
# colnames(ratios) <- ratio_names
|
|
453
|
+
# }
|
|
454
|
+
#
|
|
455
|
+
# if (length(t_names) != 0){
|
|
456
|
+
# t_names = as.vector(sapply(t_names, MA.strip_blanks));
|
|
457
|
+
# colnames(t) <- t_names;
|
|
458
|
+
# colnames(p.values) <- t_names;
|
|
459
|
+
# }
|
|
460
|
+
#
|
|
461
|
+
# return(list(ratios = ratios, t=t, p.values = p.values));
|
|
462
|
+
#}
|
|
463
|
+
#
|
|
464
|
+
#
|
|
465
|
+
#
|
|
466
|
+
## Process microarray matrix
|
|
467
|
+
#
|
|
468
|
+
#MA.process <- function(m, conditions_list, two.channel = FALSE){
|
|
469
|
+
#
|
|
470
|
+
# ratios = vector();
|
|
471
|
+
# t = vector();
|
|
472
|
+
# p.values = vector();
|
|
473
|
+
#
|
|
474
|
+
# for(type in colnames(conditions_list)){
|
|
475
|
+
# conditions = conditions_list[,type]
|
|
476
|
+
#
|
|
477
|
+
# if (two.channel){
|
|
478
|
+
# res = MA.process_conditions.two_channel(m, conditions);
|
|
479
|
+
# if (length(res$ratios) != 0){ colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")}); ratios = cbind(ratios,res$ratios);}
|
|
480
|
+
# if (length(res$t) != 0){ colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")}); t = cbind(t,res$t);}
|
|
481
|
+
# if (length(res$p.values) != 0){ colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
|
|
482
|
+
# }
|
|
483
|
+
#
|
|
484
|
+
# res = MA.process_conditions.contrasts(m, conditions, two.channel);
|
|
485
|
+
# if (length(res$ratios) != 0){ colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")}); ratios = cbind(ratios,res$ratios);}
|
|
486
|
+
# if (length(res$t) != 0){ colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")}); t = cbind(t,res$t);}
|
|
487
|
+
# if (length(res$p.values) != 0){ colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
|
|
488
|
+
# }
|
|
489
|
+
#
|
|
490
|
+
# orders <- MA.orders(ratios,t);
|
|
491
|
+
# return(list(ratios = ratios, t=t, p.values = p.values, orders=orders));
|
|
492
|
+
#}
|
|
493
|
+
#
|
|
494
|
+
#
|
|
495
|
+
#MA.save <- function(prefix, orders, ratios, t , p.values, experiments, description = NULL) {
|
|
496
|
+
# if (is.null(orders)){
|
|
497
|
+
# cat("No suitable samples for analysis\n")
|
|
498
|
+
# write(file=paste(prefix,'skip',sep="."), "No suitable samples for analysis" );
|
|
499
|
+
# } else {
|
|
500
|
+
# write.table(file=paste(prefix,'orders',sep="."), orders, sep="\t", row.names=F, col.names=F, quote=F);
|
|
501
|
+
# write.table(file=paste(prefix,'codes',sep="."), rownames(orders), sep="\t", row.names=F, col.names=F, quote=F);
|
|
502
|
+
# write.table(file=paste(prefix,'logratios',sep="."), ratios, sep="\t", row.names=F, col.names=F, quote=F);
|
|
503
|
+
# write.table(file=paste(prefix,'t',sep="."), t, sep="\t", row.names=F, col.names=F, quote=F);
|
|
504
|
+
# write.table(file=paste(prefix,'pvalues',sep="."), p.values, sep="\t", row.names=F, col.names=F, quote=F);
|
|
505
|
+
# write.table(file=paste(prefix,'experiments',sep="."), experiments, sep="\t", row.names=F, col.names=F, quote=F);
|
|
506
|
+
#
|
|
507
|
+
# write(file=paste(prefix,'description',sep="."), description)
|
|
508
|
+
# }
|
|
509
|
+
#}
|
|
510
|
+
#
|
|
511
|
+
#MA.load <- function(prefix, orders = TRUE, logratios = TRUE, t = TRUE, p.values = TRUE){
|
|
512
|
+
# data = list();
|
|
513
|
+
# genes <- scan(file=paste(prefix,'codes',sep="."),sep="\n",quiet=T,what=character());
|
|
514
|
+
# experiments <- scan(file=paste(prefix,'experiments',sep="."),sep="\n",quiet=T,what=character());
|
|
515
|
+
#
|
|
516
|
+
# experiments.no.ratio = experiments[- grep('ratio', experiments)];
|
|
517
|
+
#
|
|
518
|
+
# if (orders){
|
|
519
|
+
# orders <- read.table(file=paste(prefix,'orders',sep="."),sep="\t");
|
|
520
|
+
# rownames(orders) <- genes;
|
|
521
|
+
# colnames(orders) <- experiments;
|
|
522
|
+
# data$orders=orders;
|
|
523
|
+
# }
|
|
524
|
+
# if (logratios){
|
|
525
|
+
# logratios <- read.table(file=paste(prefix,'logratios',sep="."),sep="\t");
|
|
526
|
+
# rownames(logratios) <- genes;
|
|
527
|
+
# colnames(logratios) <- experiments;
|
|
528
|
+
# data$logratios=logratios;
|
|
529
|
+
# }
|
|
530
|
+
# if (t){
|
|
531
|
+
# t <- read.table(file=paste(prefix,'t',sep="."),sep="\t");
|
|
532
|
+
# rownames(t) <- genes;
|
|
533
|
+
# colnames(t) <- experiments.no.ratio;
|
|
534
|
+
# data$t=t;
|
|
535
|
+
# }
|
|
536
|
+
# if (p.values){
|
|
537
|
+
# p.values <- read.table(file=paste(prefix,'pvalues',sep="."),sep="\t");
|
|
538
|
+
# rownames(p.values) <- genes;
|
|
539
|
+
# colnames(p.values) <- experiments.no.ratio;
|
|
540
|
+
# data$p.values=p.values;
|
|
541
|
+
# }
|
|
542
|
+
#
|
|
543
|
+
#
|
|
544
|
+
# return(data);
|
|
545
|
+
#}
|
data/share/R/barcode.R
ADDED
|
@@ -0,0 +1,41 @@
|
|
|
1
|
+
rbbt.GE.barcode <- function(matrix_file, output_file, sd.factor = 2, key.field = "Ensembl Gene ID"){
|
|
2
|
+
data = rbbt.tsv(matrix_file)
|
|
3
|
+
data.mean = rowMeans(data, na.rm=T)
|
|
4
|
+
data.sd = apply(data, 1, sd, na.rm=T)
|
|
5
|
+
data.threshold = as.matrix(data.mean) + sd.factor * as.matrix(data.sd)
|
|
6
|
+
names(data.threshold) = names(data.mean)
|
|
7
|
+
rm(data.mean)
|
|
8
|
+
rm(data.sd)
|
|
9
|
+
|
|
10
|
+
file.barcode = file(output_file, 'w')
|
|
11
|
+
|
|
12
|
+
cat("#", file = file.barcode)
|
|
13
|
+
cat(key.field, file = file.barcode)
|
|
14
|
+
cat("\t", file = file.barcode)
|
|
15
|
+
cat(colnames(data), file = file.barcode, sep="\t")
|
|
16
|
+
cat("\n", file = file.barcode)
|
|
17
|
+
|
|
18
|
+
for (gene in rownames(data)){
|
|
19
|
+
barcode = (data[gene,] - data.threshold[gene]) > 0
|
|
20
|
+
|
|
21
|
+
cat(gene, file = file.barcode)
|
|
22
|
+
cat("\t", file = file.barcode)
|
|
23
|
+
cat(barcode, file = file.barcode, sep = "\t")
|
|
24
|
+
cat("\n", file = file.barcode)
|
|
25
|
+
}
|
|
26
|
+
close(file.barcode)
|
|
27
|
+
}
|
|
28
|
+
|
|
29
|
+
|
|
30
|
+
rbbt.GE.activity_cluster <- function(matrix_file, output_file, key.field = "ID"){
|
|
31
|
+
|
|
32
|
+
library(mclust)
|
|
33
|
+
|
|
34
|
+
data = rbbt.tsv(matrix_file)
|
|
35
|
+
classes = apply(data,2,function(row){Mclust(row)$classification})
|
|
36
|
+
|
|
37
|
+
rownames(classes) <- rownames(data)
|
|
38
|
+
names(classes) <- c("Cluster")
|
|
39
|
+
|
|
40
|
+
rbbt.tsv.write(output_file, classes, key.field)
|
|
41
|
+
}
|
data/share/R/heatmap.3.R
ADDED
|
@@ -0,0 +1,516 @@
|
|
|
1
|
+
# FROM: https://gist.github.com/nachocab/3853004
|
|
2
|
+
#
|
|
3
|
+
# EXAMPLE USAGE
|
|
4
|
+
|
|
5
|
+
# example of colsidecolors rowsidecolors (single column, single row)
|
|
6
|
+
#mat <- matrix(1:100, byrow=T, nrow=10)
|
|
7
|
+
#column_annotation <- sample(c("red", "blue", "green"), 10, replace=T)
|
|
8
|
+
#column_annotation <- as.matrix(column_annotation)
|
|
9
|
+
#colnames(column_annotation) <- c("Variable X")
|
|
10
|
+
#
|
|
11
|
+
#row_annotation <- sample(c("red", "blue", "green"), 10, replace=T)
|
|
12
|
+
#row_annotation <- as.matrix(t(row_annotation))
|
|
13
|
+
#rownames(row_annotation) <- c("Variable Y")
|
|
14
|
+
#
|
|
15
|
+
#heatmap.3(mat, RowSideColors=row_annotation, ColSideColors=column_annotation)
|
|
16
|
+
#
|
|
17
|
+
## multiple column and row
|
|
18
|
+
#mat <- matrix(1:100, byrow=T, nrow=10)
|
|
19
|
+
#column_annotation <- matrix(sample(c("red", "blue", "green"), 20, replace=T), ncol=2)
|
|
20
|
+
#colnames(column_annotation) <- c("Variable X1", "Variable X2")
|
|
21
|
+
#
|
|
22
|
+
#row_annotation <- matrix(sample(c("red", "blue", "green"), 20, replace=T), nrow=2)
|
|
23
|
+
#rownames(row_annotation) <- c("Variable Y1", "Variable Y2")
|
|
24
|
+
#
|
|
25
|
+
#heatmap.3(mat, RowSideColors=row_annotation, ColSideColors=column_annotation)
|
|
26
|
+
#
|
|
27
|
+
|
|
28
|
+
# CODE
|
|
29
|
+
|
|
30
|
+
heatmap.3 <- function(x,
|
|
31
|
+
Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE,
|
|
32
|
+
distfun = dist,
|
|
33
|
+
hclustfun = hclust,
|
|
34
|
+
dendrogram = c("both","row", "column", "none"),
|
|
35
|
+
symm = FALSE,
|
|
36
|
+
scale = c("none","row", "column"),
|
|
37
|
+
na.rm = TRUE,
|
|
38
|
+
revC = identical(Colv,"Rowv"),
|
|
39
|
+
add.expr,
|
|
40
|
+
breaks,
|
|
41
|
+
symbreaks = max(x < 0, na.rm = TRUE) || scale != "none",
|
|
42
|
+
col = "heat.colors",
|
|
43
|
+
colsep,
|
|
44
|
+
rowsep,
|
|
45
|
+
sepcolor = "white",
|
|
46
|
+
sepwidth = c(0.05, 0.05),
|
|
47
|
+
cellnote,
|
|
48
|
+
notecex = 1,
|
|
49
|
+
notecol = "cyan",
|
|
50
|
+
na.color = par("bg"),
|
|
51
|
+
trace = c("none", "column","row", "both"),
|
|
52
|
+
tracecol = "cyan",
|
|
53
|
+
hline = median(breaks),
|
|
54
|
+
vline = median(breaks),
|
|
55
|
+
linecol = tracecol,
|
|
56
|
+
margins = c(5,5),
|
|
57
|
+
ColSideColors,
|
|
58
|
+
RowSideColors,
|
|
59
|
+
side.height.fraction=0.3,
|
|
60
|
+
cexRow = 0.2 + 1/log10(nr),
|
|
61
|
+
cexCol = 0.2 + 1/log10(nc),
|
|
62
|
+
labRow = NULL,
|
|
63
|
+
labCol = NULL,
|
|
64
|
+
key = TRUE,
|
|
65
|
+
keysize = 1.5,
|
|
66
|
+
density.info = c("none", "histogram", "density"),
|
|
67
|
+
denscol = tracecol,
|
|
68
|
+
symkey = max(x < 0, na.rm = TRUE) || symbreaks,
|
|
69
|
+
densadj = 0.25,
|
|
70
|
+
main = NULL,
|
|
71
|
+
xlab = NULL,
|
|
72
|
+
ylab = NULL,
|
|
73
|
+
lmat = NULL,
|
|
74
|
+
lhei = NULL,
|
|
75
|
+
lwid = NULL,
|
|
76
|
+
NumColSideColors = 1,
|
|
77
|
+
NumRowSideColors = 1,
|
|
78
|
+
KeyValueName="Value",...){
|
|
79
|
+
|
|
80
|
+
invalid <- function (x) {
|
|
81
|
+
if (missing(x) || is.null(x) || length(x) == 0)
|
|
82
|
+
return(TRUE)
|
|
83
|
+
if (is.list(x))
|
|
84
|
+
return(all(sapply(x, invalid)))
|
|
85
|
+
else if (is.vector(x))
|
|
86
|
+
return(all(is.na(x)))
|
|
87
|
+
else return(FALSE)
|
|
88
|
+
}
|
|
89
|
+
|
|
90
|
+
x <- as.matrix(x)
|
|
91
|
+
scale01 <- function(x, low = min(x), high = max(x)) {
|
|
92
|
+
x <- (x - low)/(high - low)
|
|
93
|
+
x
|
|
94
|
+
}
|
|
95
|
+
retval <- list()
|
|
96
|
+
scale <- if (symm && missing(scale))
|
|
97
|
+
"none"
|
|
98
|
+
else match.arg(scale)
|
|
99
|
+
dendrogram <- match.arg(dendrogram)
|
|
100
|
+
trace <- match.arg(trace)
|
|
101
|
+
density.info <- match.arg(density.info)
|
|
102
|
+
if (length(col) == 1 && is.character(col))
|
|
103
|
+
col <- get(col, mode = "function")
|
|
104
|
+
if (!missing(breaks) && (scale != "none"))
|
|
105
|
+
warning("Using scale=\"row\" or scale=\"column\" when breaks are",
|
|
106
|
+
"specified can produce unpredictable results.", "Please consider using only one or the other.")
|
|
107
|
+
if (is.null(Rowv) || is.na(Rowv))
|
|
108
|
+
Rowv <- FALSE
|
|
109
|
+
if (is.null(Colv) || is.na(Colv))
|
|
110
|
+
Colv <- FALSE
|
|
111
|
+
else if (Colv == "Rowv" && !isTRUE(Rowv))
|
|
112
|
+
Colv <- FALSE
|
|
113
|
+
if (length(di <- dim(x)) != 2 || !is.numeric(x))
|
|
114
|
+
stop("`x' must be a numeric matrix")
|
|
115
|
+
nr <- di[1]
|
|
116
|
+
nc <- di[2]
|
|
117
|
+
if (nr <= 1 || nc <= 1)
|
|
118
|
+
stop("`x' must have at least 2 rows and 2 columns")
|
|
119
|
+
if (!is.numeric(margins) || length(margins) != 2)
|
|
120
|
+
stop("`margins' must be a numeric vector of length 2")
|
|
121
|
+
if (missing(cellnote))
|
|
122
|
+
cellnote <- matrix("", ncol = ncol(x), nrow = nrow(x))
|
|
123
|
+
if (!inherits(Rowv, "dendrogram")) {
|
|
124
|
+
if (((!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in%
|
|
125
|
+
c("both", "row"))) {
|
|
126
|
+
if (is.logical(Colv) && (Colv))
|
|
127
|
+
dendrogram <- "column"
|
|
128
|
+
else dedrogram <- "none"
|
|
129
|
+
warning("Discrepancy: Rowv is FALSE, while dendrogram is `",
|
|
130
|
+
dendrogram, "'. Omitting row dendogram.")
|
|
131
|
+
}
|
|
132
|
+
}
|
|
133
|
+
if (!inherits(Colv, "dendrogram")) {
|
|
134
|
+
if (((!isTRUE(Colv)) || (is.null(Colv))) && (dendrogram %in%
|
|
135
|
+
c("both", "column"))) {
|
|
136
|
+
if (is.logical(Rowv) && (Rowv))
|
|
137
|
+
dendrogram <- "row"
|
|
138
|
+
else dendrogram <- "none"
|
|
139
|
+
warning("Discrepancy: Colv is FALSE, while dendrogram is `",
|
|
140
|
+
dendrogram, "'. Omitting column dendogram.")
|
|
141
|
+
}
|
|
142
|
+
}
|
|
143
|
+
if (inherits(Rowv, "dendrogram")) {
|
|
144
|
+
ddr <- Rowv
|
|
145
|
+
rowInd <- order.dendrogram(ddr)
|
|
146
|
+
}
|
|
147
|
+
else if (is.integer(Rowv)) {
|
|
148
|
+
hcr <- hclustfun(distfun(x))
|
|
149
|
+
ddr <- as.dendrogram(hcr)
|
|
150
|
+
ddr <- reorder(ddr, Rowv)
|
|
151
|
+
rowInd <- order.dendrogram(ddr)
|
|
152
|
+
if (nr != length(rowInd))
|
|
153
|
+
stop("row dendrogram ordering gave index of wrong length")
|
|
154
|
+
}
|
|
155
|
+
else if (isTRUE(Rowv)) {
|
|
156
|
+
Rowv <- rowMeans(x, na.rm = na.rm)
|
|
157
|
+
hcr <- hclustfun(distfun(x))
|
|
158
|
+
ddr <- as.dendrogram(hcr)
|
|
159
|
+
ddr <- reorder(ddr, Rowv)
|
|
160
|
+
rowInd <- order.dendrogram(ddr)
|
|
161
|
+
if (nr != length(rowInd))
|
|
162
|
+
stop("row dendrogram ordering gave index of wrong length")
|
|
163
|
+
}
|
|
164
|
+
else {
|
|
165
|
+
rowInd <- nr:1
|
|
166
|
+
}
|
|
167
|
+
if (inherits(Colv, "dendrogram")) {
|
|
168
|
+
ddc <- Colv
|
|
169
|
+
colInd <- order.dendrogram(ddc)
|
|
170
|
+
}
|
|
171
|
+
else if (identical(Colv, "Rowv")) {
|
|
172
|
+
if (nr != nc)
|
|
173
|
+
stop("Colv = \"Rowv\" but nrow(x) != ncol(x)")
|
|
174
|
+
if (exists("ddr")) {
|
|
175
|
+
ddc <- ddr
|
|
176
|
+
colInd <- order.dendrogram(ddc)
|
|
177
|
+
}
|
|
178
|
+
else colInd <- rowInd
|
|
179
|
+
}
|
|
180
|
+
else if (is.integer(Colv)) {
|
|
181
|
+
hcc <- hclustfun(distfun(if (symm)
|
|
182
|
+
x
|
|
183
|
+
else t(x)))
|
|
184
|
+
ddc <- as.dendrogram(hcc)
|
|
185
|
+
ddc <- reorder(ddc, Colv)
|
|
186
|
+
colInd <- order.dendrogram(ddc)
|
|
187
|
+
if (nc != length(colInd))
|
|
188
|
+
stop("column dendrogram ordering gave index of wrong length")
|
|
189
|
+
}
|
|
190
|
+
else if (isTRUE(Colv)) {
|
|
191
|
+
Colv <- colMeans(x, na.rm = na.rm)
|
|
192
|
+
hcc <- hclustfun(distfun(if (symm)
|
|
193
|
+
x
|
|
194
|
+
else t(x)))
|
|
195
|
+
ddc <- as.dendrogram(hcc)
|
|
196
|
+
ddc <- reorder(ddc, Colv)
|
|
197
|
+
colInd <- order.dendrogram(ddc)
|
|
198
|
+
if (nc != length(colInd))
|
|
199
|
+
stop("column dendrogram ordering gave index of wrong length")
|
|
200
|
+
}
|
|
201
|
+
else {
|
|
202
|
+
colInd <- 1:nc
|
|
203
|
+
}
|
|
204
|
+
retval$rowInd <- rowInd
|
|
205
|
+
retval$colInd <- colInd
|
|
206
|
+
retval$call <- match.call()
|
|
207
|
+
x <- x[rowInd, colInd]
|
|
208
|
+
x.unscaled <- x
|
|
209
|
+
cellnote <- cellnote[rowInd, colInd]
|
|
210
|
+
if (is.null(labRow))
|
|
211
|
+
labRow <- if (is.null(rownames(x)))
|
|
212
|
+
(1:nr)[rowInd]
|
|
213
|
+
else rownames(x)
|
|
214
|
+
else labRow <- labRow[rowInd]
|
|
215
|
+
if (is.null(labCol))
|
|
216
|
+
labCol <- if (is.null(colnames(x)))
|
|
217
|
+
(1:nc)[colInd]
|
|
218
|
+
else colnames(x)
|
|
219
|
+
else labCol <- labCol[colInd]
|
|
220
|
+
if (scale == "row") {
|
|
221
|
+
retval$rowMeans <- rm <- rowMeans(x, na.rm = na.rm)
|
|
222
|
+
x <- sweep(x, 1, rm)
|
|
223
|
+
retval$rowSDs <- sx <- apply(x, 1, sd, na.rm = na.rm)
|
|
224
|
+
x <- sweep(x, 1, sx, "/")
|
|
225
|
+
}
|
|
226
|
+
else if (scale == "column") {
|
|
227
|
+
retval$colMeans <- rm <- colMeans(x, na.rm = na.rm)
|
|
228
|
+
x <- sweep(x, 2, rm)
|
|
229
|
+
retval$colSDs <- sx <- apply(x, 2, sd, na.rm = na.rm)
|
|
230
|
+
x <- sweep(x, 2, sx, "/")
|
|
231
|
+
}
|
|
232
|
+
if (missing(breaks) || is.null(breaks) || length(breaks) < 1) {
|
|
233
|
+
if (missing(col) || is.function(col))
|
|
234
|
+
breaks <- 16
|
|
235
|
+
else breaks <- length(col) + 1
|
|
236
|
+
}
|
|
237
|
+
if (length(breaks) == 1) {
|
|
238
|
+
if (!symbreaks)
|
|
239
|
+
breaks <- seq(min(x, na.rm = na.rm), max(x, na.rm = na.rm),
|
|
240
|
+
length = breaks)
|
|
241
|
+
else {
|
|
242
|
+
extreme <- max(abs(x), na.rm = TRUE)
|
|
243
|
+
breaks <- seq(-extreme, extreme, length = breaks)
|
|
244
|
+
}
|
|
245
|
+
}
|
|
246
|
+
nbr <- length(breaks)
|
|
247
|
+
ncol <- length(breaks) - 1
|
|
248
|
+
if (class(col) == "function")
|
|
249
|
+
col <- col(ncol)
|
|
250
|
+
min.breaks <- min(breaks)
|
|
251
|
+
max.breaks <- max(breaks)
|
|
252
|
+
x[x < min.breaks] <- min.breaks
|
|
253
|
+
x[x > max.breaks] <- max.breaks
|
|
254
|
+
if (missing(lhei) || is.null(lhei))
|
|
255
|
+
lhei <- c(keysize, 4)
|
|
256
|
+
if (missing(lwid) || is.null(lwid))
|
|
257
|
+
lwid <- c(keysize, 4)
|
|
258
|
+
if (missing(lmat) || is.null(lmat)) {
|
|
259
|
+
lmat <- rbind(4:3, 2:1)
|
|
260
|
+
|
|
261
|
+
if (!missing(ColSideColors)) {
|
|
262
|
+
#if (!is.matrix(ColSideColors))
|
|
263
|
+
#stop("'ColSideColors' must be a matrix")
|
|
264
|
+
if (!is.character(ColSideColors) || nrow(ColSideColors) != nc)
|
|
265
|
+
stop("'ColSideColors' must be a matrix of nrow(x) rows")
|
|
266
|
+
lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1)
|
|
267
|
+
#lhei <- c(lhei[1], 0.2, lhei[2])
|
|
268
|
+
lhei=c(lhei[1], side.height.fraction*NumColSideColors, lhei[2])
|
|
269
|
+
}
|
|
270
|
+
|
|
271
|
+
if (!missing(RowSideColors)) {
|
|
272
|
+
#if (!is.matrix(RowSideColors))
|
|
273
|
+
#stop("'RowSideColors' must be a matrix")
|
|
274
|
+
if (!is.character(RowSideColors) || ncol(RowSideColors) != nr)
|
|
275
|
+
stop("'RowSideColors' must be a matrix of ncol(x) columns")
|
|
276
|
+
lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1), 1), lmat[,2] + 1)
|
|
277
|
+
#lwid <- c(lwid[1], 0.2, lwid[2])
|
|
278
|
+
lwid <- c(lwid[1], side.height.fraction*NumRowSideColors, lwid[2])
|
|
279
|
+
}
|
|
280
|
+
lmat[is.na(lmat)] <- 0
|
|
281
|
+
}
|
|
282
|
+
|
|
283
|
+
if (length(lhei) != nrow(lmat))
|
|
284
|
+
stop("lhei must have length = nrow(lmat) = ", nrow(lmat))
|
|
285
|
+
if (length(lwid) != ncol(lmat))
|
|
286
|
+
stop("lwid must have length = ncol(lmat) =", ncol(lmat))
|
|
287
|
+
op <- par(no.readonly = TRUE)
|
|
288
|
+
on.exit(par(op))
|
|
289
|
+
|
|
290
|
+
layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
|
|
291
|
+
|
|
292
|
+
if (!missing(RowSideColors)) {
|
|
293
|
+
if (!is.matrix(RowSideColors)){
|
|
294
|
+
par(mar = c(margins[1], 0, 0, 0.5))
|
|
295
|
+
image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE)
|
|
296
|
+
} else {
|
|
297
|
+
par(mar = c(margins[1], 0, 0, 0.5))
|
|
298
|
+
rsc = t(RowSideColors[,rowInd, drop=F])
|
|
299
|
+
rsc.colors = matrix()
|
|
300
|
+
rsc.names = names(table(rsc))
|
|
301
|
+
rsc.i = 1
|
|
302
|
+
for (rsc.name in rsc.names) {
|
|
303
|
+
rsc.colors[rsc.i] = rsc.name
|
|
304
|
+
rsc[rsc == rsc.name] = rsc.i
|
|
305
|
+
rsc.i = rsc.i + 1
|
|
306
|
+
}
|
|
307
|
+
rsc = matrix(as.numeric(rsc), nrow = dim(rsc)[1])
|
|
308
|
+
image(t(rsc), col = as.vector(rsc.colors), axes = FALSE)
|
|
309
|
+
if (length(colnames(RowSideColors)) > 0) {
|
|
310
|
+
axis(1, 0:(dim(rsc)[2] - 1)/(dim(rsc)[2] - 1), colnames(RowSideColors), las = 2, tick = FALSE)
|
|
311
|
+
}
|
|
312
|
+
}
|
|
313
|
+
}
|
|
314
|
+
|
|
315
|
+
if (!missing(ColSideColors)) {
|
|
316
|
+
|
|
317
|
+
if (!is.matrix(ColSideColors)){
|
|
318
|
+
par(mar = c(0.5, 0, 0, margins[2]))
|
|
319
|
+
image(cbind(1:nc), col = ColSideColors[colInd], axes = FALSE)
|
|
320
|
+
} else {
|
|
321
|
+
par(mar = c(0.5, 0, 0, margins[2]))
|
|
322
|
+
csc = ColSideColors[colInd, , drop=F]
|
|
323
|
+
csc.colors = matrix()
|
|
324
|
+
csc.names = names(table(csc))
|
|
325
|
+
csc.i = 1
|
|
326
|
+
for (csc.name in csc.names) {
|
|
327
|
+
csc.colors[csc.i] = csc.name
|
|
328
|
+
csc[csc == csc.name] = csc.i
|
|
329
|
+
csc.i = csc.i + 1
|
|
330
|
+
}
|
|
331
|
+
csc = matrix(as.numeric(csc), nrow = dim(csc)[1])
|
|
332
|
+
image(csc, col = as.vector(csc.colors), axes = FALSE)
|
|
333
|
+
if (length(colnames(ColSideColors)) > 0) {
|
|
334
|
+
axis(2, 0:(dim(csc)[2] - 1)/max(1,(dim(csc)[2] - 1)), colnames(ColSideColors), las = 2, tick = FALSE)
|
|
335
|
+
}
|
|
336
|
+
}
|
|
337
|
+
}
|
|
338
|
+
|
|
339
|
+
par(mar = c(margins[1], 0, 0, margins[2]))
|
|
340
|
+
x <- t(x)
|
|
341
|
+
cellnote <- t(cellnote)
|
|
342
|
+
if (revC) {
|
|
343
|
+
iy <- nr:1
|
|
344
|
+
if (exists("ddr"))
|
|
345
|
+
ddr <- rev(ddr)
|
|
346
|
+
x <- x[, iy]
|
|
347
|
+
cellnote <- cellnote[, iy]
|
|
348
|
+
}
|
|
349
|
+
else iy <- 1:nr
|
|
350
|
+
image(1:nc, 1:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 + c(0, nr), axes = FALSE, xlab = "", ylab = "", col = col, breaks = breaks, ...)
|
|
351
|
+
retval$carpet <- x
|
|
352
|
+
if (exists("ddr"))
|
|
353
|
+
retval$rowDendrogram <- ddr
|
|
354
|
+
if (exists("ddc"))
|
|
355
|
+
retval$colDendrogram <- ddc
|
|
356
|
+
retval$breaks <- breaks
|
|
357
|
+
retval$col <- col
|
|
358
|
+
if (!invalid(na.color) & any(is.na(x))) { # load library(gplots)
|
|
359
|
+
mmat <- ifelse(is.na(x), 1, NA)
|
|
360
|
+
image(1:nc, 1:nr, mmat, axes = FALSE, xlab = "", ylab = "",
|
|
361
|
+
col = na.color, add = TRUE)
|
|
362
|
+
}
|
|
363
|
+
axis(1, 1:nc, labels = labCol, las = 2, line = -0.5, tick = 0,
|
|
364
|
+
cex.axis = cexCol)
|
|
365
|
+
if (!is.null(xlab))
|
|
366
|
+
mtext(xlab, side = 1, line = margins[1] - 1.25)
|
|
367
|
+
axis(4, iy, labels = labRow, las = 2, line = -0.5, tick = 0,
|
|
368
|
+
cex.axis = cexRow)
|
|
369
|
+
if (!is.null(ylab))
|
|
370
|
+
mtext(ylab, side = 4, line = margins[2] - 1.25)
|
|
371
|
+
if (!missing(add.expr))
|
|
372
|
+
eval(substitute(add.expr))
|
|
373
|
+
if (!missing(colsep))
|
|
374
|
+
for (csep in colsep) rect(xleft = csep + 0.5, ybottom = rep(0, length(csep)), xright = csep + 0.5 + sepwidth[1], ytop = rep(ncol(x) + 1, csep), lty = 1, lwd = 1, col = sepcolor, border = sepcolor)
|
|
375
|
+
if (!missing(rowsep))
|
|
376
|
+
for (rsep in rowsep) rect(xleft = 0, ybottom = (ncol(x) + 1 - rsep) - 0.5, xright = nrow(x) + 1, ytop = (ncol(x) + 1 - rsep) - 0.5 - sepwidth[2], lty = 1, lwd = 1, col = sepcolor, border = sepcolor)
|
|
377
|
+
min.scale <- min(breaks)
|
|
378
|
+
max.scale <- max(breaks)
|
|
379
|
+
x.scaled <- scale01(t(x), min.scale, max.scale)
|
|
380
|
+
if (trace %in% c("both", "column")) {
|
|
381
|
+
retval$vline <- vline
|
|
382
|
+
vline.vals <- scale01(vline, min.scale, max.scale)
|
|
383
|
+
for (i in colInd) {
|
|
384
|
+
if (!is.null(vline)) {
|
|
385
|
+
abline(v = i - 0.5 + vline.vals, col = linecol,
|
|
386
|
+
lty = 2)
|
|
387
|
+
}
|
|
388
|
+
xv <- rep(i, nrow(x.scaled)) + x.scaled[, i] - 0.5
|
|
389
|
+
xv <- c(xv[1], xv)
|
|
390
|
+
yv <- 1:length(xv) - 0.5
|
|
391
|
+
lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s")
|
|
392
|
+
}
|
|
393
|
+
}
|
|
394
|
+
if (trace %in% c("both", "row")) {
|
|
395
|
+
retval$hline <- hline
|
|
396
|
+
hline.vals <- scale01(hline, min.scale, max.scale)
|
|
397
|
+
for (i in rowInd) {
|
|
398
|
+
if (!is.null(hline)) {
|
|
399
|
+
abline(h = i + hline, col = linecol, lty = 2)
|
|
400
|
+
}
|
|
401
|
+
yv <- rep(i, ncol(x.scaled)) + x.scaled[i, ] - 0.5
|
|
402
|
+
yv <- rev(c(yv[1], yv))
|
|
403
|
+
xv <- length(yv):1 - 0.5
|
|
404
|
+
lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s")
|
|
405
|
+
}
|
|
406
|
+
}
|
|
407
|
+
if (!missing(cellnote))
|
|
408
|
+
text(x = c(row(cellnote)), y = c(col(cellnote)), labels = c(cellnote),
|
|
409
|
+
col = notecol, cex = notecex)
|
|
410
|
+
par(mar = c(margins[1], 0, 0, 0))
|
|
411
|
+
if (dendrogram %in% c("both", "row")) {
|
|
412
|
+
plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none")
|
|
413
|
+
}
|
|
414
|
+
else plot.new()
|
|
415
|
+
par(mar = c(0, 0, if (!is.null(main)) 5 else 0, margins[2]))
|
|
416
|
+
if (dendrogram %in% c("both", "column")) {
|
|
417
|
+
plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none")
|
|
418
|
+
}
|
|
419
|
+
else plot.new()
|
|
420
|
+
if (!is.null(main))
|
|
421
|
+
title(main, cex.main = 1.5 * op[["cex.main"]])
|
|
422
|
+
if (key) {
|
|
423
|
+
par(mar = c(5, 4, 2, 1), cex = 0.75)
|
|
424
|
+
tmpbreaks <- breaks
|
|
425
|
+
if (symkey) {
|
|
426
|
+
max.raw <- max(abs(c(x, breaks)), na.rm = TRUE)
|
|
427
|
+
min.raw <- -max.raw
|
|
428
|
+
tmpbreaks[1] <- -max(abs(x), na.rm = TRUE)
|
|
429
|
+
tmpbreaks[length(tmpbreaks)] <- max(abs(x), na.rm = TRUE)
|
|
430
|
+
}
|
|
431
|
+
else {
|
|
432
|
+
min.raw <- min(x, na.rm = TRUE)
|
|
433
|
+
max.raw <- max(x, na.rm = TRUE)
|
|
434
|
+
}
|
|
435
|
+
|
|
436
|
+
z <- seq(min.raw, max.raw, length = length(col))
|
|
437
|
+
image(z = matrix(z, ncol = 1), col = col, breaks = tmpbreaks,
|
|
438
|
+
xaxt = "n", yaxt = "n")
|
|
439
|
+
par(usr = c(0, 1, 0, 1))
|
|
440
|
+
lv <- pretty(breaks)
|
|
441
|
+
xv <- scale01(as.numeric(lv), min.raw, max.raw)
|
|
442
|
+
axis(1, at = xv, labels = lv)
|
|
443
|
+
if (scale == "row")
|
|
444
|
+
mtext(side = 1, "Row Z-Score", line = 2)
|
|
445
|
+
else if (scale == "column")
|
|
446
|
+
mtext(side = 1, "Column Z-Score", line = 2)
|
|
447
|
+
else mtext(side = 1, KeyValueName, line = 2)
|
|
448
|
+
if (density.info == "density") {
|
|
449
|
+
dens <- density(x, adjust = densadj, na.rm = TRUE)
|
|
450
|
+
omit <- dens$x < min(breaks) | dens$x > max(breaks)
|
|
451
|
+
dens$x <- dens$x[-omit]
|
|
452
|
+
dens$y <- dens$y[-omit]
|
|
453
|
+
dens$x <- scale01(dens$x, min.raw, max.raw)
|
|
454
|
+
lines(dens$x, dens$y/max(dens$y) * 0.95, col = denscol,
|
|
455
|
+
lwd = 1)
|
|
456
|
+
axis(2, at = pretty(dens$y)/max(dens$y) * 0.95, pretty(dens$y))
|
|
457
|
+
title("Color Key\nand Density Plot")
|
|
458
|
+
par(cex = 0.5)
|
|
459
|
+
mtext(side = 2, "Density", line = 2)
|
|
460
|
+
}
|
|
461
|
+
else if (density.info == "histogram") {
|
|
462
|
+
h <- hist(x, plot = FALSE, breaks = breaks)
|
|
463
|
+
hx <- scale01(breaks, min.raw, max.raw)
|
|
464
|
+
hy <- c(h$counts, h$counts[length(h$counts)])
|
|
465
|
+
lines(hx, hy/max(hy) * 0.95, lwd = 1, type = "s",
|
|
466
|
+
col = denscol)
|
|
467
|
+
axis(2, at = pretty(hy)/max(hy) * 0.95, pretty(hy))
|
|
468
|
+
title("Color Key\nand Histogram")
|
|
469
|
+
par(cex = 0.5)
|
|
470
|
+
mtext(side = 2, "Count", line = 2)
|
|
471
|
+
}
|
|
472
|
+
else title("Color Key")
|
|
473
|
+
}
|
|
474
|
+
else plot.new()
|
|
475
|
+
retval$colorTable <- data.frame(low = retval$breaks[-length(retval$breaks)],
|
|
476
|
+
high = retval$breaks[-1], color = retval$col)
|
|
477
|
+
invisible(retval)
|
|
478
|
+
}
|
|
479
|
+
|
|
480
|
+
rbbt.heatmap.3 <- function(filename, width, height, data, take_log=FALSE, keys=NULL, colors=NULL, ...){
|
|
481
|
+
# Quieted by MV
|
|
482
|
+
require(gplots, quietly = TRUE, warn.conflicts = FALSE)
|
|
483
|
+
library(pls, quietly = TRUE, warn.conflicts = FALSE)
|
|
484
|
+
opar = par()
|
|
485
|
+
png(filename=filename, width=width, height=height);
|
|
486
|
+
|
|
487
|
+
#par(cex.lab=0.5, cex=0.5, ...)
|
|
488
|
+
|
|
489
|
+
data = as.matrix(data)
|
|
490
|
+
data[is.nan(data)] = NA
|
|
491
|
+
|
|
492
|
+
|
|
493
|
+
data = data[rowSums(!is.na(data))!=0, colSums(!is.na(data))!=0]
|
|
494
|
+
|
|
495
|
+
data = data[rowSums(is.na(data))==0, ]
|
|
496
|
+
if (take_log){
|
|
497
|
+
for (study in colnames(data)){
|
|
498
|
+
skip = sum(data[, study] <= 0) != 0
|
|
499
|
+
if (!skip){
|
|
500
|
+
data[, study] = log(data[, study])
|
|
501
|
+
}
|
|
502
|
+
}
|
|
503
|
+
data = data[, colSums(is.na(data))==0]
|
|
504
|
+
}
|
|
505
|
+
|
|
506
|
+
#data = stdize(data)
|
|
507
|
+
|
|
508
|
+
heatmap.3(data, margins = c(20,5), scale='column', na.rm=TRUE, ...)
|
|
509
|
+
if (!is.null(keys)){
|
|
510
|
+
legend("bottomleft",legend=keys, fill=colors, border=FALSE, bty="n", y.intersp = 1.7, cex=1.7)
|
|
511
|
+
}
|
|
512
|
+
|
|
513
|
+
dev.off();
|
|
514
|
+
par(opar)
|
|
515
|
+
}
|
|
516
|
+
|
metadata
CHANGED
|
@@ -1,14 +1,14 @@
|
|
|
1
1
|
--- !ruby/object:Gem::Specification
|
|
2
2
|
name: rbbt-dm
|
|
3
3
|
version: !ruby/object:Gem::Version
|
|
4
|
-
version: 1.1.
|
|
4
|
+
version: 1.1.19
|
|
5
5
|
platform: ruby
|
|
6
6
|
authors:
|
|
7
7
|
- Miguel Vazquez
|
|
8
8
|
autorequire:
|
|
9
9
|
bindir: bin
|
|
10
10
|
cert_chain: []
|
|
11
|
-
date: 2015-
|
|
11
|
+
date: 2015-12-10 00:00:00.000000000 Z
|
|
12
12
|
dependencies:
|
|
13
13
|
- !ruby/object:Gem::Dependency
|
|
14
14
|
name: rbbt-util
|
|
@@ -104,6 +104,9 @@ files:
|
|
|
104
104
|
- lib/rbbt/statistics/rank_product.rb
|
|
105
105
|
- lib/rbbt/vector/model.rb
|
|
106
106
|
- lib/rbbt/vector/model/svm.rb
|
|
107
|
+
- share/R/MA.R
|
|
108
|
+
- share/R/barcode.R
|
|
109
|
+
- share/R/heatmap.3.R
|
|
107
110
|
- test/rbbt/network/test_paths.rb
|
|
108
111
|
- test/rbbt/statistics/test_fdr.rb
|
|
109
112
|
- test/rbbt/statistics/test_hypergeometric.rb
|