-
Notifications
You must be signed in to change notification settings - Fork 0
/
threeD.R
82 lines (75 loc) · 2.87 KB
/
threeD.R
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
# Set up environment -----------------------------------------------------------
## Libraries
"plotly" %>=>% libInstall %!=>% library(.., char = T)
"reshape2" %>=>% libInstall %!=>% library(.., char = T)
"lme4" %>=>% libInstall %!=>% library(.., char = T)
"ggplot2" %>=>% libInstall %!=>% library(.., char = T)
"extrafont" %>=>% libInstall %!=>% library(.., char = T)
## Import fonts for plots
if (!"Open Sans" %in% fonts()) {
font_import(
path = "FONT_PATH",
pattern = "OpenSans",
prompt = F
)
}
# Functions for generating 3d plot ---------------------------------------------
## Plotly plotting function
surfaceplot = function(.data, spp = "bacteria", gene = "gene", ...) {
cols = c("forestgreen","yellowgreen","orange","red")
f = list(family = "Open Sans",size = 18)
levels = levels(.data$gene)
genes = c("wt" = paste0(gene, "+"), "mut" = paste0(gene, "-"))[levels]
split(.data, .data$gene) %=>>%
acast(.., week ~ dis, mean, value.var = "pred") %=>%
lapply(seq_along(..), x ->> layout(
plot_ly(
z = ..[[x]],
type = "surface",
scene = paste0("scene", x),
colors = cols,
showscale = F,
width = 1100,
height = 600
),
margin = 50,
annotations = list(
text = unname(genes[x]),
font = list(family = "Open Sans",size = 18),
xref = "paper", yref = "paper", x = 0.5, y = 0.95,
xanchor = "center", yanchor = "bottom", align = "center",
showarrow = F
)
)) %=>%
subplot(..) %=>%
layout(..,
annotations = list(
text = paste0("Spread of <i>", spp, "</i>"),
font = list(family = "Open Sans", size = 24),
xref = "paper", yref = "paper", x = 0.5, y = 1.05,
xanchor = "center", yanchor = "bottom",
align = "center",
showarrow = F
),
autosize = F,
margin = 50,
scene = list(
xaxis = list(title = "Distance", font = f),
yaxis = list(title = "Week", font = f),
zaxis = list(title = "Probability", font = f)
)
)
}
## Wrapper function for data transformation
plot3d = function(.model, .data = NULL, ...) {
if (is.null(.data)) .data = model.frame(.model)
if (nrow(.data) == 1) stop("At least 2 data points required for plotting.")
colnames(model.frame(.model)) %=>%
..[!.. %in% colnames(.data)] %=>%
lapply(.., x ->> setNames(data.frame(0), x)) %=>%
do.call(cbind.data.frame, c(list(.data), ..)) %=>%
data.frame(..,
pred = predict(.model, .., re.form = NA, type = "resp")
) %=>%
surfaceplot(.., ...)
}