Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#theme for plots
plaintheme <- theme_bw() +
theme(plot.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank() ) +
theme(axis.line.x = element_line(color="black", size = 1),
axis.line.y = element_line(color="black", size = 1))+
theme(legend.position = "none")
#axis theme for plots
axistheme <- theme(plot.title = element_text(hjust = 0.5, color = "black", face = "bold", size=20)) +
theme(axis.title = element_text(color = "black", size = 16)) +
theme(axis.text.x = element_text(size = 14, color = "black")) +
theme(axis.text.y = element_text(size = 14, color = "black"))
#determines the number of decimal places of a number
decimalcount<-function(x){stopifnot(class(x)=="character")
x<-gsub("(.*)(\\.)|([0]*$)","",x)
as.numeric(nchar(x))
}
# create dotplot locations from data x
dotplot_locs <- function(x, n, cutoff, cutoff.color, dot.fill.color, inequality, Mean){
counts <- table(x)
x.locs <- as.numeric(names(counts))
# find minimum difference between points, with an exeption for a single point
if (length(names(counts)) == 1){
point_dist <- min(diff(c(0, as.numeric(names(counts)))))/(n+2)
} else {
point_dist <- min(diff(as.numeric(names(counts))))/(n+2)
}
# define the standard x coordinates to be used
x.coord <- sapply(x.locs, function(x) x + ((1:n)-(n+1)/2)*point_dist)
x.coords <- vector()
y.coords <- vector()
to.color <- vector()
names.counts <- as.numeric(names(counts))
# loop through each count, defining new x and y coordinates for "dotplot"
for (i in 1:length(counts)){
if (n == 1){
x.coords <- c(x.coords, rep(x.coord[i], counts[i]/n))
} else {
x.coords <- c(x.coords, rep(x.coord[, i], counts[i]/n),
x.coord[0:(counts[i] %% n), i])
}
if (counts[i] > n){
y.coords <- c(y.coords, sort(rep(1:(counts[i]/n), n)),
rep(ceiling(counts[i]/n), counts[i] %% n))
} else {
y.coords <- c(y.coords, sort(rep(1:(counts[i]/n), counts[i])))
}
# defines color of dots when cutoff defined
if(!is.na(as.numeric(cutoff))){
num.decimals <- decimalcount(as.character(cutoff))
# error term for rounded cutoff values
error <- ifelse(num.decimals <= 2, 0, 0.1^num.decimals/2)
if (inequality == "greater than"){
if (names.counts[i] >= as.numeric(cutoff)-error){
to.color <- c(to.color, rep(cutoff.color, counts[i]))
} else {
to.color <- c(to.color, rep(dot.fill.color, counts[i]))
}
} else if (inequality == "less than") {
if (names.counts[i] <= as.numeric(cutoff)+error){
to.color <- c(to.color, rep(cutoff.color, counts[i]))
} else {
to.color <- c(to.color, rep(dot.fill.color, counts[i]))
}
} else {
dist <- abs(Mean - (abs(as.numeric(cutoff))-error))
if ((names.counts[i] <= Mean - dist) |
(names.counts[i] >= Mean + dist)){
to.color <- c(to.color, rep(cutoff.color, counts[i]))
} else {
to.color <- c(to.color, rep(dot.fill.color, counts[i]))
}
}
} else {
to.color <- c(to.color, rep(dot.fill.color, counts[i]))
}
}
return(data.frame("x" = x.coords, "y" = y.coords*n,
"fill.color" = to.color))
}