Skip to content

Commit 789e1ec

Browse files
mkcormkcor
committed
Merge pull request #196 from ropensci/toby-cookbook-lines
Toby cookbook lines
2 parents ae947fc + 4cfedf9 commit 789e1ec

File tree

11 files changed

+461
-124
lines changed

11 files changed

+461
-124
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: plotly
22
Type: Package
33
Title: Interactive, publication-quality graphs online.
4-
Version: 0.6
4+
Version: 0.6.1
55
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
66
email = "[email protected]"),
77
person("Scott", "Chamberlain", role = "aut",

‎NEWS‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
0.6.1 -- 5 May 2015
2+
3+
Add test-cookbook-lines.R and fix bugs that showed up in those tests.
4+
15
0.6 -- 4 May 2015
26

37
Let gg2list() return a figure object (backwards incompatible change).

‎R/ggplotly.R‎

Lines changed: 114 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -62,11 +62,12 @@ markLegends <-
6262
errorbarh=c("colour", "linetype"),
6363
area=c("colour", "fill"),
6464
step=c("linetype", "size", "colour"),
65-
boxplot=c("x"),
6665
text=c("colour"))
6766

6867
markUnique <- as.character(unique(unlist(markLegends)))
6968

69+
markSplit <- c(markLegends,list(boxplot=c("x")))
70+
7071
#' Convert a ggplot to a list.
7172
#' @import ggplot2
7273
#' @param p ggplot2 plot.
@@ -97,9 +98,11 @@ gg2list <- function(p) {
9798
# worry about combining global and layer-specific aes/data later.
9899
for(layer.i in seq_along(p$layers)) {
99100
layer.aes <- p$layers[[layer.i]]$mapping
100-
to.copy <- names(p$mapping)[!names(p$mapping) %in% names(layer.aes)]
101-
layer.aes[to.copy] <- p$mapping[to.copy]
102-
mark.names <- markUnique[markUnique %in% names(layer.aes)]
101+
if(p$layers[[layer.i]]$inherit.aes){
102+
to.copy <- names(p$mapping)[!names(p$mapping) %in% names(layer.aes)]
103+
layer.aes[to.copy] <- p$mapping[to.copy]
104+
}
105+
mark.names <- names(layer.aes) # make aes.name for all aes.
103106
name.names <- sprintf("%s.name", mark.names)
104107
layer.aes[name.names] <- layer.aes[mark.names]
105108
p$layers[[layer.i]]$mapping <- layer.aes
@@ -108,78 +111,94 @@ gg2list <- function(p) {
108111
}
109112
}
110113

114+
# Test fill and color to see if they encode a quantitative
115+
# variable. This may be useful for several reasons: (1) it is
116+
# sometimes possible to plot several different colors in the same
117+
# trace (e.g. points), and that is faster for large numbers of
118+
# data points and colors; (2) factors on x or y axes should be
119+
# sent to plotly as characters, not as numeric data (which is
120+
# what ggplot_build gives us).
121+
misc <- list()
122+
for(a in c("fill", "colour", "x", "y", "size")){
123+
for(data.type in c("continuous", "date", "datetime", "discrete")){
124+
fun.name <- sprintf("scale_%s_%s", a, data.type)
125+
misc.name <- paste0("is.", data.type)
126+
misc[[misc.name]][[a]] <- tryCatch({
127+
fun <- get(fun.name)
128+
suppressMessages({
129+
with.scale <- original.p + fun()
130+
})
131+
ggplot_build(with.scale)
132+
TRUE
133+
}, error=function(e){
134+
FALSE
135+
})
136+
}
137+
}
138+
139+
## scales are needed for legend ordering.
140+
misc$breaks <- list()
141+
for(sc in p$scales$scales){
142+
a.vec <- sc$aesthetics
143+
default.breaks <- inherits(sc$breaks, "waiver")
144+
if (length(a.vec) == 1 && (!default.breaks) ) {
145+
## TODO: generalize for x/y scales too.
146+
br <- sc$breaks
147+
ranks <- seq_along(br)
148+
names(ranks) <- br
149+
misc$breaks[[a.vec]] <- ranks
150+
}
151+
## store if this is a reverse scale so we can undo that later.
152+
if(is.character(sc$trans$name)){
153+
misc$trans[sc$aesthetics] <- sc$trans$name
154+
}
155+
}
156+
reverse.aes <- names(misc$trans)[misc$trans=="reverse"]
157+
111158
# Extract data from built ggplots
112159
built <- ggplot_build2(p)
113-
# Get global x-range now because we need some of its info in layer2traces
114-
ggranges <- built$panel$ranges
115-
# Extract x.range
116-
xrange <- sapply(ggranges, `[[`, "x.range", simplify=FALSE, USE.NAMES=FALSE)
117-
ggxmin <- min(sapply(xrange, min))
118-
ggxmax <- max(sapply(xrange, max))
119-
# Extract y.range
120-
yrange <- sapply(ggranges, `[[`, "y.range", simplify=FALSE, USE.NAMES=FALSE)
121-
ggymin <- min(sapply(yrange, min))
122-
ggymax <- max(sapply(yrange, max))
160+
# Get global ranges now because we need some of its info in layer2traces
161+
ranges.list <- list()
162+
for(xy in c("x", "y")){
163+
use.ranges <-
164+
misc$is.continuous[[xy]] ||
165+
misc$is.date[[xy]] ||
166+
misc$is.datetime[[xy]]
167+
range.values <- if(use.ranges){
168+
range.name <- paste0(xy, ".range")
169+
sapply(built$panel$ranges, "[[", range.name)
170+
}else{
171+
## for categorical variables on the axes, panel$ranges info is
172+
## meaningless.
173+
name.name <- paste0(xy, ".name")
174+
sapply(built$data, function(df){
175+
if(name.name %in% names(df)){
176+
## usually for discrete data there is a .name column.
177+
paste(df[[name.name]])
178+
}else{
179+
## for heatmaps there may not be.
180+
df[[xy]]
181+
}
182+
})
183+
}
184+
ranges.list[[xy]] <- range(range.values)
185+
}
123186

124187
# Get global size range because we need some of its info in layer2traces
125188
if ("size.name" %in% name.names) {
126189
sizerange <- sapply(built$prestats.data, `[[`, "size")
127190
ggsizemin <- min(unlist(sizerange))
128191
ggsizemax <- max(unlist(sizerange))
129192
}
130-
193+
131194
layer.legends <- list()
132195
for(i in seq_along(built$plot$layers)){
133196
# This is the layer from the original ggplot object.
134197
L <- p$layers[[i]]
135198

136199
# for each layer, there is a correpsonding data.frame which
137200
# evaluates the aesthetic mapping.
138-
df <- built$data[[i]]
139-
140-
# Test fill and color to see if they encode a quantitative
141-
# variable. This may be useful for several reasons: (1) it is
142-
# sometimes possible to plot several different colors in the same
143-
# trace (e.g. points), and that is faster for large numbers of
144-
# data points and colors; (2) factors on x or y axes should be
145-
# sent to plotly as characters, not as numeric data (which is
146-
# what ggplot_build gives us).
147-
misc <- list()
148-
for(a in c("fill", "colour", "x", "y", "size")){
149-
for(data.type in c("continuous", "date", "datetime", "discrete")){
150-
fun.name <- sprintf("scale_%s_%s", a, data.type)
151-
misc.name <- paste0("is.", data.type)
152-
misc[[misc.name]][[a]] <- tryCatch({
153-
fun <- get(fun.name)
154-
suppressMessages({
155-
with.scale <- original.p + fun()
156-
})
157-
ggplot_build(with.scale)
158-
TRUE
159-
}, error=function(e){
160-
FALSE
161-
})
162-
}
163-
}
164-
165-
# scales are needed for legend ordering.
166-
misc$breaks <- list()
167-
for(sc in p$scales$scales){
168-
a.vec <- sc$aesthetics
169-
default.breaks <- inherits(sc$breaks, "waiver")
170-
if (length(a.vec) == 1 && (!default.breaks) ) {
171-
# TODO: generalize for x/y scales too.
172-
br <- sc$breaks
173-
ranks <- seq_along(br)
174-
names(ranks) <- br
175-
misc$breaks[[a.vec]] <- ranks
176-
}
177-
## store if this is a reverse scale so we can undo that later.
178-
if(is.character(sc$trans$name)){
179-
misc$trans[sc$aesthetics] <- sc$trans$name
180-
}
181-
}
182-
reverse.aes <- names(misc$trans)[misc$trans=="reverse"]
201+
df <- built$data[[i]]
183202

184203
# get gglayout now because we need some of its info in layer2traces
185204
gglayout <- built$panel$layout
@@ -203,21 +222,24 @@ gg2list <- function(p) {
203222
for (a in replace.aes) {
204223
prestats[[a]] <- -1 * prestats[[a]]
205224
}
206-
misc$prestats.data <-
225+
L$prestats.data <-
207226
merge(prestats,
208227
gglayout[, c("PANEL", "plotly.row", "COL")])
209228

210-
# Add global x-range info
211-
misc$prestats.data$globxmin <- ggxmin
212-
misc$prestats.data$globxmax <- ggxmax
213-
# Add global y-range info
214-
misc$prestats.data$globymin <- ggymin
215-
misc$prestats.data$globymax <- ggymax
229+
# Add global range info.
230+
for(xy in names(ranges.list)){
231+
range.vec <- ranges.list[[xy]]
232+
names(range.vec) <- c("min", "max")
233+
for(range.name in names(range.vec)){
234+
glob.name <- paste0("glob", xy, range.name)
235+
L$prestats.data[[glob.name]] <- range.vec[[range.name]]
236+
}
237+
}
216238

217239
# Add global size info if relevant
218240
if ("size.name" %in% name.names) {
219-
misc$prestats.data$globsizemin <- ggsizemin
220-
misc$prestats.data$globsizemax <- ggsizemax
241+
L$prestats.data$globsizemin <- ggsizemin
242+
L$prestats.data$globsizemax <- ggsizemax
221243
}
222244

223245
# This extracts essential info for this geom/layer.
@@ -334,7 +356,7 @@ gg2list <- function(p) {
334356
grid <- theme.pars$panel.grid
335357
grid.major <- theme.pars$panel.grid.major
336358
if ((!is.null(grid$linetype) || !is.null(grid.major$linetype)) &&
337-
c(grid$linetype, grid.major$linetype) %in% c(2, 3, "dashed", "dotted")) {
359+
c(grid$linetype, grid.major$linetype) %in% c(2, 3, "dashed", "dotted")) {
338360
ax.list$gridcolor <- ifelse(is.null(grid.major$colour),
339361
toRGB(grid$colour, 0.1),
340362
toRGB(grid.major$colour, 0.1))
@@ -370,7 +392,7 @@ gg2list <- function(p) {
370392
ax.list$tickangle <- -tick.text$angle
371393
}
372394
ax.list$tickfont <- theme2font(tick.text)
373-
395+
374396
## determine axis type first, since this information is used later
375397
## (trace.order.list is only used for type=category).
376398
title.text <- e(s("axis.title.%s"))
@@ -415,7 +437,7 @@ gg2list <- function(p) {
415437
sc$limits
416438
}else{
417439
if(misc$is.continuous[[xy]]){
418-
ggranges[[1]][[s("%s.range")]] #TODO: facets!
440+
built$panel$ranges[[1]][[s("%s.range")]] #TODO: facets!
419441
}else{ # for a discrete scale, range should be NULL.
420442
NULL
421443
}
@@ -431,7 +453,7 @@ gg2list <- function(p) {
431453
}else{
432454
p$labels[[xy]]
433455
}
434-
456+
435457
ax.list$zeroline <- FALSE # ggplot2 plots do not show zero lines
436458
# Lines drawn around the plot border.
437459
ax.list$showline <- !is.blank("panel.border", TRUE)
@@ -581,22 +603,19 @@ gg2list <- function(p) {
581603
nann <- nann + 1
582604
}
583605
}
584-
# axes titles
585-
annotations[[nann]] <- make.label(xaxis.title,
586-
0.5,
587-
-outer.margin,
588-
yanchor="top")
589-
nann <- nann + 1
590-
annotations[[nann]] <- make.label(yaxis.title,
591-
-outer.margin,
592-
0.5,
593-
textangle=-90)
606+
# axes titles
607+
annotations[[nann]] <- make.label(xaxis.title,
608+
0.5,
609+
-outer.margin,
610+
yanchor="top")
611+
nann <- nann + 1
612+
annotations[[nann]] <- make.label(yaxis.title,
613+
-outer.margin,
614+
0.5,
615+
textangle=-90)
594616
layout$annotations <- annotations
595617
}
596618

597-
# Remove legend if theme has no legend position
598-
layout$showlegend <- !(theme.pars$legend.position=="none")
599-
600619
# Main plot title.
601620
layout$title <- built$plot$labels$title
602621

@@ -612,11 +631,7 @@ gg2list <- function(p) {
612631
layout$legend <- list(bordercolor="transparent",
613632
x=1.05, y=1/2,
614633
xanchor="center", yanchor="top")
615-
# Workaround for removing unnecessary legends.
616-
# [markUnique != "x"] is for boxplot's particular case.
617-
if (any(names(layer.aes) %in% markUnique[markUnique != "x"]) == FALSE)
618-
layout$showlegend <- FALSE
619-
634+
620635
## Legend hiding when guides(fill="none").
621636
legends.present <- unique(unlist(layer.legends))
622637
is.false <- function(x){
@@ -628,11 +643,16 @@ gg2list <- function(p) {
628643
is.hidden <- function(x){
629644
is.false(x) || is.none(x)
630645
}
646+
layout$showlegend <- if(length(legends.present) == 0) FALSE else TRUE
631647
for(a in legends.present){
632648
if(is.hidden(p$guides[[a]])){
633649
layout$showlegend <- FALSE
634650
}
635651
}
652+
# Legend hiding from theme.
653+
if(theme.pars$legend.position=="none"){
654+
layout$showlegend <- FALSE
655+
}
636656

637657
# Only show a legend title if there is at least 1 trace with
638658
# showlegend=TRUE.
@@ -817,6 +837,7 @@ gg2list <- function(p) {
817837
fill_set <- unlist(lapply(merged.traces, entries, "fillcolor"))
818838
line_set <- unlist(lapply(merged.traces, entries, c("line", "color")))
819839
mark_set <- unlist(lapply(merged.traces, entries, c("marker", "color")))
840+
mode_set <- lapply(merged.traces, "[[", "mode")
820841
legend_intersect <- function(x, y) {
821842
i <- intersect(x, y)
822843
# restrict intersection to valid legend entries
@@ -825,7 +846,7 @@ gg2list <- function(p) {
825846
# if there is a mark & line legend, get rid of line
826847
t1 <- line_set %in% legend_intersect(mark_set, line_set)
827848
# that is, unless the mode is 'lines+markers'...
828-
t1 <- t1 & !(unlist(lapply(merged.traces, "[[", "mode")) %in% "lines+markers")
849+
t1 <- t1 & !(mode_set %in% "lines+markers")
829850
# if there is a mark & fill legend, get rid of fill
830851
t2 <- fill_set %in% legend_intersect(mark_set, fill_set)
831852
# if there is a line & fill legend, get rid of fill
@@ -887,7 +908,7 @@ gg2list <- function(p) {
887908
}
888909

889910
fig <- list(data=flipped.traces, layout=flipped.layout)
890-
911+
891912
fig
892913

893914
}

‎R/plotly-package.r‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#' \itemize{
88
#' \item Package: plotly
99
#' \item Type: Package
10-
#' \item Version: 0.6
10+
#' \item Version: 0.6.1
1111
#' \item Date: 2014-03-07
1212
#' \item License: MIT
1313
#' }

‎R/plotly.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ For more help, see https://plot.ly/R or contact <[email protected]>.")
8282

8383
# public attributes/methods that the user has access to
8484
pub <- list(username=username, key=key, filename="from api", fileopt=NULL,
85-
version="0.6")
85+
version="0.6.1")
8686
priv <- list()
8787

8888
pub$makecall <- function(args, kwargs, origin) {

0 commit comments

Comments
 (0)