|
a |
|
b/R/addons.R |
|
|
1 |
########################################################### |
|
|
2 |
### ADDITIONAL FUNCTIONS |
|
|
3 |
########################################################### |
|
|
4 |
|
|
|
5 |
# Wide to long format conversion |
|
|
6 |
meltWholeDF = function(df) { |
|
|
7 |
data.frame(X=rep(colnames(df), each=nrow(df)), |
|
|
8 |
Y=rep(rownames(df), times=ncol(df)), |
|
|
9 |
Measure=as.vector(as.matrix(df))) |
|
|
10 |
} |
|
|
11 |
|
|
|
12 |
# Smart unlist - preserves the names of the vectors as they were |
|
|
13 |
smunlist = function(li) { |
|
|
14 |
setNames(unlist(li), |
|
|
15 |
nm=unname(rapply(li, |
|
|
16 |
function(i) |
|
|
17 |
if(!is.null(names(i))) |
|
|
18 |
names(i) |
|
|
19 |
else |
|
|
20 |
rep("", length(i))))) |
|
|
21 |
} |
|
|
22 |
|
|
|
23 |
# Function that gives nice drug names out of IDs (D_001-40 or D_001_5 type) |
|
|
24 |
giveDrugLabel = function(drid, ctab, dtab) { |
|
|
25 |
vapply(strsplit(drid, "-"), function(x) { |
|
|
26 |
if(length(x)==2) { # ID type: D_001-40 |
|
|
27 |
paste0(dtab[x[1],"name"], " ", x[2], " \u00B5", "M") |
|
|
28 |
} else if(length(x)==1) { # ID type: D_001_5 |
|
|
29 |
x = unlist(strsplit(drid, "_")) |
|
|
30 |
k = paste(x[1:2], collapse="_") |
|
|
31 |
paste0(dtab[k, "name"], " ", ctab[k, as.integer(x[3])], " \u00B5","M") |
|
|
32 |
}}, character(1)) |
|
|
33 |
} |
|
|
34 |
|
|
|
35 |
# Round up to the nearest 5 |
|
|
36 |
moround = function(x,base) { |
|
|
37 |
base*ceiling(x/base) |
|
|
38 |
} |
|
|
39 |
|
|
|
40 |
# capitalize the first letter |
|
|
41 |
toCaps = function(word) { |
|
|
42 |
paste0(toupper(substring(word,1,1)), substring(word,2,nchar(word))) |
|
|
43 |
} |
|
|
44 |
|
|
|
45 |
# out of IDs likes D_001_1, strip the trailing '_1' |
|
|
46 |
stripConc <- function(x) |
|
|
47 |
vapply(strsplit(x, "_"), function(x) |
|
|
48 |
paste(x[-length(x)], collapse="_"), character(1)) |
|
|
49 |
|
|
|
50 |
# treshold an array from below and above |
|
|
51 |
deckel <- function(x, lower = -Inf, upper = +Inf) |
|
|
52 |
ifelse(x<lower, lower, ifelse(x>upper, upper, x)) |
|
|
53 |
|
|
|
54 |
# log10 scale labels in ggplot2, use: scale_x_log10(labels=scientific_10) |
|
|
55 |
scientific_10 = function(x) { |
|
|
56 |
x = scientific_format()(x) |
|
|
57 |
parse(text=ifelse(x=="1e+00", "1 ", gsub("1e", "10^", x))) |
|
|
58 |
} |
|
|
59 |
|
|
|
60 |
# labels of volcano x axis scale |
|
|
61 |
percentAxisScale = function(x) { |
|
|
62 |
x*100 |
|
|
63 |
} |
|
|
64 |
|
|
|
65 |
# Function which computes log10 and returns with the sign of the input value |
|
|
66 |
log10div = function(x) { |
|
|
67 |
sign(x)*log10(abs(x)) |
|
|
68 |
} |
|
|
69 |
|
|
|
70 |
# Function for axis labels of p-values going in two directions |
|
|
71 |
# (sensitive/resistant) |
|
|
72 |
exp10div = function(x) { |
|
|
73 |
x = -abs(x) |
|
|
74 |
x = paste0("10^", x) |
|
|
75 |
x = gsub("10^0", "1", x, fixed=TRUE) |
|
|
76 |
parse(text=x) |
|
|
77 |
} |
|
|
78 |
|
|
|
79 |
# change color names to hex with alpha level |
|
|
80 |
col2hex = function(cols, alpha=1, names=NA) { |
|
|
81 |
tmp = col2rgb(cols) |
|
|
82 |
max = 255 |
|
|
83 |
tmp = apply(tmp, 2, function(t) |
|
|
84 |
rgb(red=t[1], green=t[2], blue=t[3], maxColorValue=max, alpha=alpha*max)) |
|
|
85 |
if (all(!is.na(names)) && length(names)==length(tmp)) |
|
|
86 |
tmp = setNames(tmp,nm=names) |
|
|
87 |
tmp |
|
|
88 |
} |
|
|
89 |
|
|
|
90 |
# safe match |
|
|
91 |
safeMatch <- function(x, ...) { |
|
|
92 |
rv <- match(x, ...) |
|
|
93 |
if (any(is.na(rv))) |
|
|
94 |
stop(sprintf("`match` failed to match %s", paste(x[is.na(rv)], |
|
|
95 |
collapse=", "))) |
|
|
96 |
rv |
|
|
97 |
} |
|
|
98 |
|
|
|
99 |
# find out the index of appropriate layer in a grob table |
|
|
100 |
whichInGrob = function(grob, layer) { |
|
|
101 |
match(layer, grob[["layout"]][["name"]]) |
|
|
102 |
} |