Skip to content

Commit 786f8e6

Browse files
cpsievertcpsievert
committed
Merge pull request #269 from ropensci/fix-ggplot2
Bug fixes for ggplot2 (> 1.0.1)
2 parents 9aa4b1d + 20cfea7 commit 786f8e6

37 files changed

+798
-784
lines changed

‎.gitignore

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,4 +6,3 @@ Rapp.history
66
.RData
77
Makefile
88
.Rproj.user
9-
*.Rproj

‎DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ Description: Easily translate ggplot2 graphs to an interactive web-based version
2020
URL: https://plot.ly/r, https://github.com/ropensci/plotly
2121
BugReports: https://github.com/ropensci/plotly/issues
2222
Depends:
23-
ggplot2
23+
ggplot2 (>= 2.0.0)
2424
Imports:
2525
scales,
2626
httr,

‎R/build_function.R

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -16,13 +16,10 @@ ggplot_build2 <- local({
1616
g_b <- as.list(body(ggplot_build2))
1717

1818
# Find line where we want to insert new code
19-
line_after <- quote(data <- calculate_stats(panel, data, layers))
20-
idx <- vapply(g_b, identical, line_after, FUN.VALUE=TRUE)
21-
idx <- which(idx)
22-
19+
idx <- grep("compute_statistic", as.character(g_b))
2320
if (length(idx) != 1) {
24-
warning("ggplotly() is not compatible with this version of ggplot2", call. = F)
25-
} else {
21+
warning("Unexpected ggplot2::ggplot_build() definition", call. = FALSE)
22+
} else{
2623
# Insert new code before that line
2724
new_line <- quote(prestats.data <- data)
2825
return_value <- quote(list(data=data, panel=panel, plot=plot,

‎R/colour_conversion.R

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,12 @@
33
#' @param alpha transparency alpha
44
#' @return hexadecimal colour value (if is.na(x), return "transparent" for compatibility with Plotly)
55
#' @export
6-
toRGB <- function(x, alpha=1) {
7-
if(is.null(x))return(x)
8-
if (alpha!=1) {
6+
toRGB <- function(x, alpha = 1) {
7+
if (is.null(x)) return(x)
8+
if (identical(x, "NA")) x <- NA
9+
# as of ggplot2 version 1.1, an NA alpha is treated as though it's 1
10+
if (is.na(alpha)) alpha <- 1
11+
if (alpha != 1) {
912
rgb.matrix <- col2rgb(x, TRUE)
1013
rgb.matrix["alpha", 1] <- alpha
1114
ch.vector <- "rgba(%s)"

‎R/corresp_one_one.R

Lines changed: 93 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -1,92 +1,107 @@
11
# Convert R pch point codes to plotly "symbol" codes.
2-
pch2symbol <- c("0"="square-open",
3-
"1"="circle-open",
4-
"2"="triangle-up-open",
5-
"3"="cross-thin-open",
6-
"4"="x-thin-open",
7-
"5"="diamond-open",
8-
"6"="triangle-down-open",
9-
"7"="square-x-open",
10-
"8"="asterisk-open",
11-
"9"="diamond-x-open",
12-
"10"="circle-cross-open",
13-
"11"="hexagram-open",
14-
"12"="square-cross-open",
15-
"13"="circle-x-open",
16-
"14"="square-open-dot",
17-
"15"="square",
18-
"16"="circle",
19-
"17"="triangle-up",
20-
"18"="diamond",
21-
"19"="circle",
22-
"20"="circle",
23-
"21"="circle",
24-
"22"="square",
25-
"23"="diamond",
26-
"24"="triangle-up",
27-
"25"="triangle-down",
28-
"32"="circle",
29-
"35"="hash-open",
30-
"42"="asterisk-open",
31-
"43"="cross-thin-open",
32-
"45"="line-ew-open",
33-
"47"="line-ne-open",
34-
"48"="circle-open",
35-
"79"="circle-open",
36-
"88"="x-thin-open",
37-
"92"="line-nw-open",
38-
"95"="line-ew-open",
39-
"111"="circle-open",
40-
"o"="circle-open",
41-
"O"="circle-open",
42-
"+"="cross-thin-open")
2+
pch2symbol <- c(
3+
"0" = "square-open",
4+
"1" = "circle-open",
5+
"2" = "triangle-up-open",
6+
"3" = "cross-thin-open",
7+
"4" = "x-thin-open",
8+
"5" = "diamond-open",
9+
"6" = "triangle-down-open",
10+
"7" = "square-x-open",
11+
"8" = "asterisk-open",
12+
"9" = "diamond-x-open",
13+
"10" = "circle-cross-open",
14+
"11" = "hexagram-open",
15+
"12" = "square-cross-open",
16+
"13" = "circle-x-open",
17+
"14" = "square-open-dot",
18+
"15" = "square",
19+
"16" = "circle",
20+
"17" = "triangle-up",
21+
"18" = "diamond",
22+
"19" = "circle",
23+
"20" = "circle",
24+
"21" = "circle",
25+
"22" = "square",
26+
"23" = "diamond",
27+
"24" = "triangle-up",
28+
"25" = "triangle-down",
29+
"32" = "circle",
30+
"35" = "hash-open",
31+
"42" = "asterisk-open",
32+
"43" = "cross-thin-open",
33+
"45" = "line-ew-open",
34+
"47" = "line-ne-open",
35+
"48" = "circle-open",
36+
"79" = "circle-open",
37+
"88" = "x-thin-open",
38+
"92" = "line-nw-open",
39+
"95" = "line-ew-open",
40+
"111" = "circle-open",
41+
"o" = "circle-open",
42+
"O" = "circle-open",
43+
"+" = "cross-thin-open"
44+
)
4345

44-
# Convert ggplot2 aes to plotly "marker" codes.
45-
aes2marker <- c(alpha="opacity",
46-
colour="color",
47-
size="size",
48-
sizeref="sizeref",
49-
sizemode="sizemode",
50-
shape="symbol")
5146

5247
# Convert numeric line type.
53-
numeric.lty <- c("0"="none",
54-
"1"="solid",
55-
"2"="dash",
56-
"3"="dot",
57-
"4"="dashdot",
58-
"5"="longdash",
59-
"6"="longdashdot")
48+
numeric.lty <- c(
49+
"0" = "none",
50+
"1" = "solid",
51+
"2" = "dash",
52+
"3" = "dot",
53+
"4" = "dashdot",
54+
"5" = "longdash",
55+
"6" = "longdashdot"
56+
)
6057

6158
# Convert named line type.
62-
named.lty <- c("blank"="none",
63-
"solid"="solid",
64-
"dashed"="dash",
65-
"dotted"="dot",
66-
"dotdash"="dashdot",
67-
"longdash"="longdash",
68-
"twodash"="longdashdot")
59+
named.lty <- c(
60+
"blank" = "none",
61+
"solid" = "solid",
62+
"dashed" = "dash",
63+
"dotted" = "dot",
64+
"dotdash" = "dashdot",
65+
"longdash" = "longdash",
66+
"twodash" = "longdashdot"
67+
)
6968

7069
# Convert coded line type.
71-
coded.lty <- c("22"="dash",
72-
"42"="dot",
73-
"44"="dashdot",
74-
"13"="longdash",
75-
"1343"="longdashdot",
76-
"73"="dash",
77-
"2262"="dotdash",
78-
"12223242"="dotdash",
79-
"F282"="dash",
80-
"F4448444"="dash",
81-
"224282F2"="dash",
82-
"F1"="dash")
70+
coded.lty <- c(
71+
"22" = "dash",
72+
"42" = "dot",
73+
"44" = "dashdot",
74+
"13" = "longdash",
75+
"1343" = "longdashdot",
76+
"73" = "dash",
77+
"2262" = "dotdash",
78+
"12223242" = "dotdash",
79+
"F282" = "dash",
80+
"F4448444" = "dash",
81+
"224282F2" = "dash",
82+
"F1" = "dash"
83+
)
8384

8485
# Convert R lty line type codes to plotly "dash" codes.
8586
lty2dash <- c(numeric.lty, named.lty, coded.lty)
8687

8788
# Convert ggplot2 aes to line parameters.
88-
aes2line <- c(linetype="dash",
89-
colour="color",
90-
size="width",
91-
direction="shape")
89+
aes2line <- c(
90+
linetype = "dash",
91+
colour = "color",
92+
size = "width"
93+
)
94+
95+
aes2step <- c(
96+
aes2line,
97+
direction = "shape"
98+
)
99+
100+
# Convert ggplot2 aes to plotly "marker" codes.
101+
aes2marker <- c(
102+
alpha = "opacity",
103+
colour = "color",
104+
size = "size",
105+
shape = "symbol"
106+
)
92107

‎R/ggplotly.R

Lines changed: 24 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -50,41 +50,19 @@ ggplotly <- function(p = ggplot2::last_plot(), filename, fileopt,
5050
now <- Sys.time()
5151
the.epoch <- now - as.numeric(now)
5252

53-
default.marker.sizeref <- 1
54-
marker.size.mult <- 10
55-
56-
marker.defaults <- list(alpha=1,
57-
shape="16",
58-
size=marker.size.mult,
59-
sizeref=default.marker.sizeref,
60-
sizemode="area",
61-
colour="black")
62-
63-
line.defaults <- list(linetype="solid",
64-
colour="black",
65-
size=1,
66-
direction="linear")
67-
68-
boxplot.defaults <- line.defaults
69-
boxplot.defaults$colour <- "grey20"
70-
71-
ribbon.line.defaults <- line.defaults
72-
ribbon.line.defaults$colour <- NA
73-
74-
polygon.line.defaults <- line.defaults
75-
polygon.line.defaults$colour <- NA
76-
77-
# Convert R lty line type codes to plotly "dash" codes.
78-
lty2dash <- c(numeric.lty, named.lty, coded.lty)
79-
8053
aesConverters <- list(
8154
linetype=function(lty) {
8255
lty2dash[as.character(lty)]
8356
},
8457
colour=function(col) {
8558
toRGB(col)
8659
},
87-
size=identity,
60+
# ggplot2 size is in millimeters. plotly is in pixels. To do this correctly,
61+
# we need to know PPI/DPI of the display. I'm not sure of a decent way to do that
62+
# from R, but it seems 96 is a reasonable assumption.
63+
size=function(mm) {
64+
(mm * 96) / 25.4
65+
},
8866
sizeref=identity,
8967
sizemode=identity,
9068
alpha=identity,
@@ -119,6 +97,11 @@ markUnique <- as.character(unique(unlist(markLegends)))
11997
markSplit <- markLegends
12098
markSplit$boxplot <- "x"
12199

100+
# obtain the "type" of geom/position/etc.
101+
type <- function(x, y) {
102+
sub(y, "", tolower(class(x[[y]])[[1]]))
103+
}
104+
122105
guide_names <- function(p, aes = c("shape", "fill", "alpha", "area",
123106
"color", "colour", "size", "linetype")) {
124107
sc <- as.list(p$scales)$scales
@@ -136,21 +119,8 @@ guide_names <- function(p, aes = c("shape", "fill", "alpha", "area",
136119
#' @return figure object (list with names "data" and "layout").
137120
#' @export
138121
gg2list <- function(p) {
139-
if(length(p$layers) == 0) {
140-
stop("No layers in plot")
141-
}
142-
# Always use identity size scale so that plot.ly gets the real
143-
# units for the size variables.
144-
original.p <- p
145-
p <- tryCatch({
146-
# this will be an error for discrete variables.
147-
suppressMessages({
148-
ggplot_build(p+scale_size_continuous())
149-
p+scale_size_identity()
150-
})
151-
},error=function(e){
152-
p
153-
})
122+
# ggplot now applies geom_blank() (instead of erroring) when no layers exist
123+
if (length(p$layers) == 0) p <- p + geom_blank()
154124
layout <- list()
155125
trace.list <- list()
156126

@@ -188,7 +158,7 @@ gg2list <- function(p) {
188158
misc[[misc.name]][[a]] <- tryCatch({
189159
fun <- get(fun.name)
190160
suppressMessages({
191-
with.scale <- original.p + fun()
161+
with.scale <- p + fun()
192162
})
193163
ggplot_build(with.scale)
194164
TRUE
@@ -307,7 +277,7 @@ gg2list <- function(p) {
307277
# This extracts essential info for this geom/layer.
308278
traces <- layer2traces(L, df, misc)
309279

310-
possible.legends <- markLegends[[L$geom$objname]]
280+
possible.legends <- markLegends[[type(L, "geom")]]
311281
actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
312282
layer.legends[[paste(i)]] <- actual.legends
313283

@@ -405,7 +375,7 @@ gg2list <- function(p) {
405375
trace.name.map <- c()
406376
for(xy in c("x","y")){
407377
ax.list <- list()
408-
coord.lim <- p$coord$limits[[xy]]
378+
coord.lim <- p$coordinates$limits[[xy]] %||% p$scales$get_scales(xy)$limits
409379
if(is.numeric(coord.lim)){
410380
## TODO: maybe test for more exotic coord specification types
411381
## involving NA, Inf, etc?
@@ -525,6 +495,10 @@ gg2list <- function(p) {
525495
# translate to plotly:
526496
!is.blank(s("axis.line.%s"))
527497
layout[[s("%saxis")]] <- ax.list
498+
# remove traces that are outside the range of (discrete) scales
499+
nms <- unlist(lapply(traces, "[[", "name"))
500+
if (is.discrete(ax.list$range) && !is.null(nms))
501+
trace.list <- trace.list[nms %in% ax.list$range]
528502
}
529503
# copy [x/y]axis to [x/y]axisN and set domain, range, etc. for each
530504
xaxis.title <- layout$xaxis$title
@@ -955,7 +929,8 @@ gg2list <- function(p) {
955929
# each axis.
956930
flipped.traces <- named.traces
957931
flipped.layout <- layout
958-
if("flip" %in% attr(built$plot$coordinates, "class")){
932+
coord_cl <- sub("coord", "", tolower(class(built$plot$coordinates)))
933+
if("flip" %in% coord_cl){
959934
if(!inherits(p$facet, "null")){
960935
stop("coord_flip + facet conversion not supported")
961936
}
@@ -974,25 +949,6 @@ gg2list <- function(p) {
974949
}
975950

976951
l <- list(data = flipped.traces, layout = flipped.layout)
977-
978-
for (i in seq_along(l$data)) {
979-
d <- l$data[[i]]
980-
# jsonlite converts NULL to {} and NA to null (plotly prefers null to {})
981-
# https://github.com/jeroenooms/jsonlite/issues/29
982-
d[sapply(d, is.null)] <- NA
983-
# When auto_unbox is T in jsonlite::toJSON() it doesn't unbox objects of
984-
# class AsIs. We use this in plotly::to_JSON() and tag special fields such as
985-
# x/y/etc so that they don't get unboxed when they are of length 1.
986-
# unfortunately, this conflicts when using I() in qplot. For example,
987-
# qplot(1:10, 1:10, size = I(10))
988-
idx <- sapply(d, inherits, "AsIs")
989-
for (j in which(idx)) l$data[[i]][[j]] <- unclass(l$data[[i]][[j]])
990-
# some object keys require an array, even if length one
991-
# one way to ensure atomic vectors of length 1 are not automatically unboxed,
992-
# by to_JSON(), is to attach a class of AsIs (via I())
993-
idx <- names(d) %in% get_boxed() & sapply(d, length) == 1
994-
if (any(idx)) l$data[[i]][idx] <- lapply(d[idx], I)
995-
}
996-
structure(l, class = "plotly")
997-
952+
953+
structure(add_boxed(rm_asis(l)), class = "plotly")
998954
}

0 commit comments

Comments
 (0)