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
# HTML code for editable table
html_table <- HTML("<script type='text/javascript'>
/*<![CDATA[*/
function Expand1(){
if (!R1N.savesize) R1N.savesize=R1N.size;
if (!R2N.savesize) R2N.savesize=R2N.size;
var isChrome = !!window.chrome && (!!window.chrome.webstore || !!window.chrome.runtime);
var isSafari = /constructor/i.test(window.HTMLElement) || (function (p) { return p.toString() === '[object SafariRemoteNotification]'; })(!window['safari'] || (typeof safari !== 'undefined' && safari.pushNotification));
var isIE = /*@cc_on!@*/false || !!document.documentMode;
offset = 0;
if (isSafari) offset = 3;
R1N.size=Math.max(R1N.savesize,R1N.value.length,R2N.value.length)-offset;
R2N.size=Math.max(R2N.savesize,R1N.value.length,R2N.value.length)-offset;
}
function Expand2(){
if (!C1N.savesize) C1N.savesize=C1N.size;
if (!TL.savesize) TL.savesize=TL.size;
if (!BL.savesize) BL.savesize=BL.size;
var isChrome = !!window.chrome && (!!window.chrome.webstore || !!window.chrome.runtime);
var isSafari = /constructor/i.test(window.HTMLElement) || (function (p) { return p.toString() === '[object SafariRemoteNotification]'; })(!window['safari'] || (typeof safari !== 'undefined' && safari.pushNotification));
var isIE = /*@cc_on!@*/false || !!document.documentMode;
offset = 0;
if (isSafari) offset = 3;
C1N.size=Math.max(C1N.savesize,C1N.value.length,TL.value.length,BL.value.length)-offset;
TL.size=Math.max(TL.savesize,C1N.value.length,TL.value.length,BL.value.length)-offset;
BL.size=Math.max(BL.savesize,C1N.value.length,TL.value.length,BL.value.length)-offset;
}
function Expand3(){
if (!C2N.savesize) C2N.savesize=C2N.size;
if (!TR.savesize) TR.savesize=TR.size;
if (!BR.savesize) BR.savesize=BR.size;
var isChrome = !!window.chrome && (!!window.chrome.webstore || !!window.chrome.runtime);
var isSafari = /constructor/i.test(window.HTMLElement) || (function (p) { return p.toString() === '[object SafariRemoteNotification]'; })(!window['safari'] || (typeof safari !== 'undefined' && safari.pushNotification));
var isIE = /*@cc_on!@*/false || !!document.documentMode;
offset = 0;
if (isSafari) offset = 3;
C2N.size=Math.max(C2N.savesize,C2N.value.length,TR.value.length,BR.value.length)-offset;
TR.size=Math.max(TR.savesize,C2N.value.length,TR.value.length,BR.value.length)-offset;
BR.size=Math.max(BR.savesize,C2N.value.length,TR.value.length,BR.value.length)-offset;
}
/*]]>*/
</script><style>
table{
border-color: #f3f7fb;
display: block;
overflow-x: auto;
}
th, td {
border: 1px solid black;
border-collapse: collapse;
padding: 6px;
}
input {
border: 0;
width: auto;
padding: 1px 8px;
background-color: #f5f5f5;
font-size: 1em;
}
</style>
<table id = 'mytable'>
<tbody>
<tr>
<td></td>
<td><input size='10' id='C1N'type = 'text' onchange='Expand2();' oninput='Expand2();' value='Column A'></td>
<td><input size='10' id='C2N'type = 'text' onchange='Expand3();' oninput='Expand3();' value='Column B'></td>
<td><div style='padding: 1px 8px'>Total</div></td>
</tr>
<tr>
<td><input size='6' id='R1N'type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 1'></td>
<td><input size='1' id='TL' type='text' onchange='Expand2();' oninput='Expand2();' value='0'></td>
<td><input size='1' id='TR' type = 'text' onchange='Expand3();' oninput='Expand3();' value='0'></td>
<td><div size='1' style='padding: 1px 8px' id='TRT' class='shiny-text-output'></div></td>
</tr>
<tr>
<td><input size='6' id='R2N' type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 2'></td>
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
<td><input size='1' id='BL' type = 'text' onchange='Expand2();' oninput='Expand2();' value='0'></td>
<td><input size='1' id='BR' type = 'text' onchange='Expand3();' oninput='Expand3();' value='0'></td>
<td><div size='1' style='padding: 1px 8px' id='TRB' class='shiny-text-output'></div></td>
</tr>
<tr>
<td><div style='padding: 1px 8px'>Total</div></td>
<td><div size='1' style='padding: 1px 8px' id='TBL' class='shiny-text-output'></div></td>
<td><div size='1' style='padding: 1px 8px' id='TBR' class='shiny-text-output'></div></td>
<td><div size='1' style='padding: 1px 8px' id='Total' class='shiny-text-output'></div></td>
</tr>
</tbody>
</table>")
# 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){
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 {
if ((names.counts[i] <= -1*abs(as.numeric(cutoff))+error) |
(names.counts[i] >= abs(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 {
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))
}
# 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", plot.margin = margin(10, 10, 10, 10))
# 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"))