/
generate_plotly.R
239 lines (204 loc) · 10.5 KB
/
generate_plotly.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
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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
#' @title A helper function that takes simulation results and produces plotly plots
#'
#' @description This function generates plots to be displayed in the Shiny UI.
#' This is a helper function. This function processes results returned from the simulation, supplied as a list.
#' @param res A list structure containing all simulation results that are to be plotted.
#' The length of the main list indicates the number of separate plots to make.
#' Each list entry is itself a list, and corresponds to one plot and
#' needs to contain the following information/elements: \cr
#' 1. A data frame list element called "dat" or "ts". If the data frame is "ts" it is assumed to be
#' a time series and by default a line plot will be produced and labeled Time/Numbers.
#' For plotting, the data needs to be in a format with one column called xvals, one column yvals,
#' one column called varnames that contains names for different variables.
#' Varnames needs to be a factor variable or will be converted to one.
#' If a column 'varnames' exist, it is assumed the data is in the right format. Otherwise it will be transformed.
#' An optional column called IDvar can be provided for further grouping (i.e. multiple lines for stochastic simulations).
#' If plottype is 'mixedplot' an additional column called 'style' indicating line or point plot
#' for each variable is needed. \cr
#' 2. Meta-data for the plot, provided in the following variables: \cr
#' optional: plottype - One of "Lineplot" (default is nothing is provided),"Scatterplot","Boxplot", "Mixedplot". \cr
#' optional: xlab, ylab - Strings to label axes. \cr
#' optional: xscale, yscale - Scaling of axes, valid ggplot2 expression, e.g. "identity" or "log10". \cr
#' optional: xmin, xmax, ymin, ymax - Manual min and max for axes. \cr
#' optional: makelegend - TRUE/FALSE, add legend to plot. Assume true if not provided. \cr
#' optional: legendtitle - Legend title, if NULL/not supplied, default is used \cr
#' optional: legendlocation - if "left" is specified, top left. Otherwise top right. \cr
#' optional: linesize - Width of line, numeric, i.e. 1.5, 2, etc. set to 1.5 if not supplied. \cr
#' optional: title - A title for each plot. \cr
#' optional: for multiple plots, specify res[[1]]$ncols to define number of columns \cr
#'
#' @return A plotly plot structure for display in a Shiny UI.
#' @details This function can be called to produce plots, i.e. those displayed for each app.
#' The input needed by this function is produced by either calling the run_model() function (as done when going through the UI)
#' or manually transforming the output from a simulate_ function into the correct list structure explained below.
#' @import plotly
#' @importFrom stats reshape
#' @importFrom rlang .data
#' @author Yang Ge, Andreas Handel
#' @export
generate_plotly <- function(res)
{
# change ggplot color palette to color-blind friendly
# http://www.cookbook-r.com/Graphs/Colors_(ggplot2)/#a-colorblind-friendly-palette
# I added more colors at the end to have 12, enough for all simulations
# the ones I added are likely not color-blind friendly but rarely used in the app
# ****************
# this is currently not used, unclear how to get plotly to use this color palette
# needs addressing. See generate_ggplot for how to do it with ggplot2
# ****************
cbfpalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#00523B","#D5C711","#0019B2","#cc0000")
#nplots contains the number of plots to be produced.
nplots = length(res) #length of list
allplots=list() #will hold all plots
#lower and upper bounds for plots, these are used if none are provided by calling function
lb = 1e-10;
ub = 1e20;
for (n in 1:nplots) #loop to create each plot
{
resnow = res[[n]]
#if a data frame called 'ts' exists, assume that this one is the data to be plotted
#otherwise use the data frame called 'dat'
#one of the 2 must exist, otherwise the function will not work
if (!is.null(resnow$ts))
{
rawdat = resnow$ts #if a timeseries is sent in and no x- and y-labels provided, we set default 'Time' and 'Numbers'
if (is.null(resnow$ylab)) {resnow$ylab = 'Numbers'}
if (is.null(resnow$xlab)) {resnow$xlab = 'Time'}
}
else {
rawdat = resnow$dat
}
plottype <- if( is.null(resnow$plottype) ){'Lineplot'} else { resnow$plottype } #if nothing is provided, we assume a line plot. That could lead to silly plots.
#if the first column is called 'Time' (as returned from several of the simulators)
#rename to xvals for consistency and so the code below will work
if ( colnames(rawdat)[1] == 'Time' | colnames(rawdat)[1] == 'time' ) {colnames(rawdat)[1] <- 'xvals'}
#for the plotting below, the data need to be in the form xvals/yvals/varnames
#if the data is instead in xvals/var1/var2/var3/etc. - which is what the simulator functions produce
#we need to re-format
#if the data frame already has a column called 'varnames', we assume it's already properly formatted as xvals/yvals/varnames
if ('varnames' %in% colnames(rawdat))
{
dat = rawdat
}
else
{
#using basic reshape function to reformat data
dat = stats::reshape(rawdat, varying = colnames(rawdat)[-1], v.names = 'yvals', timevar = "varnames", times = colnames(rawdat)[-1], direction = 'long', new.row.names = NULL)
dat$id <- NULL
}
#code variable names as factor and level them so they show up right in plot - factor is needed for plotting and text
mylevels = unique(dat$varnames)
dat$varnames = factor(dat$varnames, levels = mylevels)
#see if user/calling function supplied x- and y-axis transformation information
xscaletrans <- ifelse(is.null(resnow$xscale), 'identity',resnow$xscale)
yscaletrans <- ifelse(is.null(resnow$yscale), 'identity',resnow$yscale)
#if exist, apply user-supplied x- and y-axis limits
#if min/max axes values are not supplied
#we'll set them here to make sure they are not crazy high or low
xmin <- if(is.null(resnow$xmin)) {max(lb,min(dat$xvals))} else {resnow$xmin}
ymin <- if(is.null(resnow$ymin)) {max(lb,min(dat$yvals))} else {resnow$ymin}
xmax <- if(is.null(resnow$xmax)) {min(ub,max(dat$xvals))} else {resnow$xmax}
ymax <- if(is.null(resnow$ymax)) {min(ub,max(dat$yvals))} else {resnow$ymax}
#if we want a plot on log scale, set any value in the data at or below 0 to some small number
#also re-scale min and max and rename from log10 (used for ggplot) to log
if (xscaletrans !='identity')
{
dat$xvals[dat$xvals<=0]=lb
xscaletrans = "log"
xmin = log10(xmin); xmax=log10(xmax)
}
if (yscaletrans !='identity')
{
dat$yvals[dat$yvals<=0]=lb
yscaletrans = "log"
ymin = log10(ymin); ymax=log10(ymax)
}
#default palette is set, overwritten if user provided
#this is currently not used, unclear how to get plotly to use this color palette
#needs addressing
plotpalette = cbfpalette
if (!is.null(resnow$palette)) {plotpalette = resnow$palette }
#set line size as given by app or to some default
linesize = ifelse(is.null(resnow$linesize), 3, resnow$linesize)
#if the IDvar variable exists, use it for further stratification, otherwise just stratify on varnames
if ( is.null(dat$IDvar) )
{
py1 <- plotly::plot_ly(dat)
}
else
{
py1 <- plotly::plot_ly(dplyr::group_by(dat, .data$IDvar), x = ~xvals)
}
###choose between different types of plots
if (plottype == 'Scatterplot')
{
py2 <- plotly::add_markers(py1, x = ~xvals , y = ~yvals, color = ~varnames, colors = "Set1", symbol = ~varnames)
}
if (plottype == 'Boxplot')
{
py2 <- plotly::add_boxplot(py1, y = ~yvals, name = ~varnames)
}
if (plottype == 'Lineplot')
{
if (length(unique(dat$varnames))<7) #plotly can only do 6 different line types
{
py2 <- plotly::add_trace(py1, x = ~xvals ,y = ~yvals, type = 'scatter', mode = 'lines', linetype = ~varnames,
line = list(color = ~varnames, width = linesize))
}
else
{
py2 <- plotly::add_trace(py1, x = ~xvals ,y = ~yvals, type = 'scatter', mode = 'lines', color = ~varnames, colors = "Set1", line = list( width = linesize))
}
}
###
if (plottype == 'Mixedplot')
{
py1a <- plotly::add_trace(py1, data = dplyr::filter(dat,style == 'line'),
x = ~xvals, y = ~yvals,
type = 'scatter', mode = 'lines', linetype = ~varnames,
line = list(color = ~varnames, width = linesize))
py2 <- plotly::add_markers(py1a, data = dplyr::filter(dat,style == 'point'),
x = ~xvals, y = ~yvals, color = ~varnames,
marker = list(size = linesize*3))
}
#set x-axis. no numbering/labels on x-axis for boxplots
if (plottype == 'Boxplot')
{
py3 <- plotly::layout(py2, xaxis = list(showticklabels = F))
}
else
{
py3 <- plotly::layout(py2, xaxis = list(range = c(xmin,xmax), type = xscaletrans ))
if (!is.null(resnow$xlab)) {
py3 <- plotly::layout(py3, xaxis = list(title=resnow$xlab, size = 18))
}
}
#apply y-axis and if provided, label
py4 = plotly::layout(py3, yaxis = list(range = c(ymin,ymax), type = yscaletrans) )
if (!is.null(resnow$ylab)) {
py4 <- plotly::layout(py4, yaxis = list(title=resnow$ylab, size = 18))
}
#apply title if provided
if (!is.null(resnow$title))
{
py4 = plotly::layout(py4, title = resnow$title)
}
#do legend if TRUE or not provided
if (!is.null(resnow$makelegend) && resnow$makelegend == FALSE)
{
py4 = plotly::layout(py4, showlegend = FALSE)
}
pfinal = py4
allplots[[n]] = pfinal
} #end loop over individual plots
if (n>1)
{
resultplot <- plotly::subplot(allplots, titleY = TRUE, titleX = TRUE)
}
if (n==1)
{
resultplot <- pfinal
}
#browser()
return(resultplot)
}