Skip to content

Commit 6b8ca78

Browse files
committed
Merge pull request #146 from ropensci/marianne-merge-layersintotraces
Little hack to make layers geom_line + geom_point 1 trace in Plotly
2 parents af5f6e8 + 49de1dc commit 6b8ca78

File tree

4 files changed

+67
-10
lines changed

4 files changed

+67
-10
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.5.13
4+
Version: 0.5.14
55
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
66
email = "[email protected]"),
77
person("Scott", "Chamberlain", role = "aut",

NEWS

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
0.5.14 -- 1 December 2014.
2+
3+
Make layers geom_line + geom_point only one trace in Plotly.
4+
15
0.5.13 -- 27 November 2014.
26

37
Rename translation file and server endpoint parameter to be hip.
@@ -12,7 +16,7 @@ Show legend title.
1216

1317
0.5.10 -- 7 November 2014.
1418

15-
Improve showlegend and fix legend’s ’x’ position.
19+
Improve showlegend and fix legend’s `x` position.
1620

1721
0.5.9 -- 3 November 2014.
1822

R/ggplotly.R

Lines changed: 54 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -612,9 +612,62 @@ gg2list <- function(p){
612612
}
613613

614614
trace.list$kwargs <- list(layout=layout)
615-
if(length(trace.list) < 2){
615+
616+
if (length(trace.list) < 2) {
616617
stop("No exportable traces")
617618
}
618619

620+
if (length(trace.list) > 2) {
621+
# Maybe some traces should be merged.
622+
nr <- length(trace.list) - 1
623+
comp <- data.frame(matrix(ncol=2, nrow=nr))
624+
colnames(comp) <- c("name", "mode")
625+
626+
for (j in 1:nr) {
627+
# Use lapply to be elegant?
628+
for (d in colnames(comp)) {
629+
try(comp[[d]][j] <- trace.list[[j]][[d]], silent=TRUE)
630+
# "names" might be NULL in trace.list
631+
}
632+
}
633+
# Compare the "name"s of the traces (so far naively inherited from layers)
634+
layernames <- unique(comp$name)
635+
if (length(layernames) < nr) {
636+
# Some traces (layers at this stage) have the same "name"s.
637+
for (j in 1:length(layernames)) {
638+
lind <- which(layernames[j] == comp$name)
639+
lmod <- c("lines", "markers") %in% comp$mode[lind]
640+
# Is there one with "mode": "lines" and another with "mode": "markers"?
641+
if (all(lmod)) {
642+
# Data comparison
643+
xcomp <- (trace.list[[lind[1]]]$x == trace.list[[lind[2]]]$x)
644+
ycomp <- (trace.list[[lind[1]]]$y == trace.list[[lind[2]]]$y)
645+
if (all(xcomp) && all(ycomp)) {
646+
# Union of the two traces
647+
keys <- unique(c(names(trace.list[[lind[1]]]),
648+
names(trace.list[[lind[2]]])))
649+
temp <- setNames(mapply(c, trace.list[[lind[1]]][keys],
650+
trace.list[[lind[2]]][keys]), keys)
651+
# Info is duplicated in fields which are in common
652+
temp <- lapply(temp, unique)
653+
# But unique() is detrimental to line or marker sublist
654+
temp$line <- trace.list[[lind[1]]]$line
655+
temp$marker <- trace.list[[lind[2]]]$marker
656+
# Overwrite x and y to be safe
657+
temp$x <- trace.list[[lind[1]]]$x
658+
temp$y <- trace.list[[lind[1]]]$y
659+
# Specify new one mode
660+
temp$mode <- "lines+markers"
661+
# Keep one trace and remove the other one
662+
trace.list[[lind[1]]] <- temp
663+
trace.list <- trace.list[-lind[2]]
664+
# Update comparison table
665+
comp <- comp[-lind[2], ]
666+
}
667+
}
668+
}
669+
}
670+
}
671+
619672
trace.list
620673
}

tests/testthat/test-ggplot-path.R

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -73,14 +73,14 @@ test_that("lines work with aesthetic shape", {
7373
geom_line() +
7474
geom_point()
7575
info <- gg2list(gg)
76-
expect_equal(length(info), 5) # 2 lines and 2 sets of points for each group
77-
expect_identical(info[[3]]$name, "Female")
78-
expect_identical(info[[3]]$marker$symbol, "circle")
79-
expect_identical(info[[4]]$name, "Male")
80-
expect_identical(info[[4]]$marker$symbol, "triangle-up")
76+
expect_equal(length(info), 3) # 2 traces + layout
77+
expect_identical(info[[1]]$name, "Female")
78+
expect_identical(info[[1]]$marker$symbol, "circle")
79+
expect_identical(info[[2]]$name, "Male")
80+
expect_identical(info[[2]]$marker$symbol, "triangle-up")
8181
# Layout
82-
expect_identical(info[[5]]$layout$xaxis$title, "time")
83-
expect_identical(info[[5]]$layout$xaxis$type, "category")
82+
expect_identical(info[[3]]$layout$xaxis$title, "time")
83+
expect_identical(info[[3]]$layout$xaxis$type, "category")
8484

8585
save_outputs(gg, "path-line-symbols")
8686
})

0 commit comments

Comments
 (0)