Fixed coordinates

NEWS

@@ -1,3 +1,11 @@
+NEW FEATURE:
+
+Fixed coordinates (i.e., coord_fixed()/coord_equal()) are now supported.
+
+BUGFIX:
+
+Long legend titles will no longer run off the screen, and legend titles with line breaks (\n) are now translated correctly.
+
 3.4.13 -- 6 Apr 2016
 
 BUGFIX:

R/subplots.R

@@ -139,17 +139,25 @@ subplot <- function(..., nrows = 1, which_layout = "merge", margin = 0.02) {
   hash_plot(data.frame(), p)
 }
 
-
-get_domains <- function(nplots = 1, nrows = 1, margins = 0.01) {
+# aspect ratio (y / x)
+get_domains <- function(nplots = 1, nrows = 1, margins = 0.01, aspect = NULL) {
   if (length(margins) == 1) margins <- rep(margins, 4)
   if (length(margins) != 4) stop("margins must be length 1 or 4", call. = FALSE)
   ncols <- ceiling(nplots / nrows)
 
+  cushion <- list(x = 0, y = 0)
+  if (!is.null(aspect) && aspect < 1) {
+    cushion <- list(x = 0, y = (1 - aspect) / 2)
+  }
+  if (!is.null(aspect) && aspect >= 1) {
+    cushion <- list(x = (1 - 1 / aspect) / 2, y = 0)
+  }
+
   xs <- vector("list", ncols)
   for (i in seq_len(ncols)) {
     xs[[i]] <- c(
-      xstart = ((i - 1) / ncols) + ifelse(i == 1, 0, margins[1]),
-      xend = (i / ncols) - ifelse(i == ncols, 0, margins[2])
+      xstart = ((i - 1) / ncols) + ifelse(i == 1, 0 + cushion$x, margins[1]),
+      xend = (i / ncols) - ifelse(i == ncols, 0 + cushion$x, margins[2])
     )
   }
   xz <- rep_len(xs, nplots)
@@ -158,8 +166,8 @@ get_domains <- function(nplots = 1, nrows = 1, margins = 0.01) {
   for (i in seq_len(nplots)) {
     j <- ceiling(i / ncols)
     ys[[i]] <- c(
-      ystart = 1 - ((j - 1) / nrows) - ifelse(j == 1, 0, margins[3]),
-      yend = 1 - (j / nrows) + ifelse(j == nrows, 0, margins[4])
+      ystart = 1 - ((j - 1) / nrows) - ifelse(j == 1, 0 + cushion$y, margins[3]),
+      yend = 1 - (j / nrows) + ifelse(j == nrows, 0 + cushion$y, margins[4])
     )
   }
   list2df(Map(c, xz, ys))

tests/testthat/test-ggplot-bar.R

@@ -48,7 +48,7 @@ test_that("dates work well with bar charts", {
   info <- expect_traces(gd, 2, "dates")
   trs <- info$data
   # plotly likes time in milliseconds
-  t <- as.numeric(unique(researchers$month)) * 24 * 60 * 60 * 1000
+  t <- as.numeric(unique(researchers$month))
   expect_equal(trs[[1]]$x, t)
 })
 

tests/testthat/test-ggplot-coord.R

@@ -0,0 +1,50 @@
+context("coord")
+
+base <- qplot(mpg, wt, data = mtcars) 
+p <- base + coord_fixed()
+
+test_that("simple fixed coordinates", {
+  l <- save_outputs(p, "coord-fixed")
+  # I don't think there's a good way to test ratios explictly...
+  # we'll rely on visual testing for now
+})
+
+base2 <- qplot(wt, mpg, data = mtcars)
+p <- base2 + coord_fixed()
+
+test_that("simple fixed coordinates", {
+  l <- save_outputs(p, "coord-fixed2")
+  # I don't think there's a good way to test ratios explictly...
+  # we'll rely on visual testing for now
+})
+
+
+p <- base +
+  facet_grid(vs ~ am, labeller = label_both) + 
+  coord_fixed() + ylim(0, 5)
+
+test_that("fixed coordinates with facets", {
+  l <- save_outputs(p, "coord-fixed-facet")
+})
+
+p <- base2 +
+  facet_grid(vs ~ am, labeller = label_both) + 
+  coord_fixed()
+
+test_that("fixed coordinates with facets", {
+  l <- save_outputs(p, "coord-fixed-facet2")
+})
+
+p <- qplot(1:10, rep(1:2, 5), colour = sapply(11:20, function(x) paste(rep("a", x), collapse = ""))) + 
+  coord_fixed() + scale_color_discrete("aslk")
+
+test_that("fixed coordinates with long legend entries", {
+  l <- save_outputs(p, "coord-fixed-long-entries")
+})
+
+p <- qplot(1:10, rep(1:2, 5), colour = factor(1:10)) + 
+  coord_fixed() + scale_color_discrete("aslkdsadklnasn\nsa;mkdas;dm")
+
+test_that("fixed coordinates with long legend title", {
+  l <- save_outputs(p, "coord-fixed-long-title")
+})

tests/testthat/test-ggplot-density.R

@@ -68,7 +68,7 @@ p <- ggplot(data = mtcars, aes(x = mpg, fill = factor(cyl))) +
 
 test_that("traces are ordered correctly in geom_density", {
   info <- expect_traces(p, 3, "traces_order")
-  nms <- as.character(sapply(info$data, "[[", "name"))
+  nms <- sub("\\s+$", "", as.character(sapply(info$data, "[[", "name")))
   expect_identical(nms, c("4", "6", "8"))
 })
 

tests/testthat/test-ggplot-density2d.R

@@ -60,13 +60,5 @@ test_that("StatDensity2d with GeomPolygon translates to filled path(s)", {
   #test some properties that shouldn't be sensitive to ggplot2 defaults
   expect_true(colorbar$marker$colorbar$title == "level")
 
-  # are the hidden colorbar markers on the correct range?
-  for (xy in c("x", "y")) {
-    rng <- L$layout[[paste0(xy, "axis")]]$range
-    expect_true(
-      all(min(rng) <= colorbar[[xy]] & colorbar[[xy]] <= max(rng))
-    )
-  }
-
 })
 

tests/testthat/test-ggplot-legend.R

@@ -23,16 +23,16 @@ test_that("Discrete colour and shape get merged into one legend", {
   # 5 legend entries
   expect_equal(sum(sapply(info$data, "[[", "showlegend")), 5)
   # verify entries are sorted correctly
-  nms <- sapply(info$data, "[[", "name")
+  nms <- sub("\\s+$", "", sapply(info$data, "[[", "name"))
   d <- unique(mtcars[c("vs", "cyl")])
   d <- d[order(d$vs, d$cyl), ]
   expect_identical(
     nms, paste0("(", d$vs, ",", d$cyl, ")")
   )
   a <- info$layout$annotations
-  expect_match(a[[3]]$text, "^factor\\(vs\\)")
-  expect_match(a[[3]]$text, "factor\\(cyl\\)$")
-  expect_true(a[[3]]$y > info$layout$legend$y)
+  expect_match(a[[1]]$text, "^factor\\(vs\\)")
+  expect_match(a[[1]]$text, "factor\\(cyl\\)$")
+  expect_true(a[[1]]$y > info$layout$legend$y)
 })
 
 

vignettes/Untitled.Rmd

@@ -0,0 +1,88 @@
+---
+title: "ggplotly: various examples"
+author: "Carson Sievert"
+output: 
+  flexdashboard::flex_dashboard:
+    orientation: rows
+    social: menu
+    source_code: embed
+---
+
+```{r setup, include=FALSE}
+library(plotly)
+library(maps)
+knitr::opts_chunk$set(message = FALSE)
+```
+
+Row {data-height=600}
+------------------------------------------------------------------------------
+
+### Unemployment
+
+```{r}
+# This example modifies code from Hadley Wickham (https://gist.github.com/hadley/233134)
+# It also uses data from Nathan Yau's flowingdata site (http://flowingdata.com/)
+unemp <- read.csv("http://datasets.flowingdata.com/unemployment09.csv")
+names(unemp) <- c("id", "state_fips", "county_fips", "name", "year", 
+                  "?", "?", "?", "rate")
+unemp$county <- tolower(gsub(" County, [A-Z]{2}", "", unemp$name))
+unemp$state <- gsub("^.*([A-Z]{2}).*$", "\\1", unemp$name)
+county_df <- map_data("county")
+names(county_df) <- c("long", "lat", "group", "order", "state_name", "county")
+county_df$state <- state.abb[match(county_df$state_name, tolower(state.name))]
+county_df$state_name <- NULL
+state_df <- map_data("state")
+choropleth <- merge(county_df, unemp, by = c("state", "county"))
+choropleth <- choropleth[order(choropleth$order), ]
+choropleth$rate_d <- cut(choropleth$rate, breaks = c(seq(0, 10, by = 2), 35))
+
+# provide a custom tooltip to plotly with the county name and actual rate
+choropleth$text <- with(choropleth, paste0("County: ", name, "<br>Rate: ", rate))
+p <- ggplot(choropleth, aes(long, lat, group = group)) +
+  geom_polygon(aes(fill = rate_d, text = text), 
+               colour = alpha("white", 1/2), size = 0.2) + 
+  geom_polygon(data = state_df, colour = "white", fill = NA) +
+  scale_fill_brewer(palette = "PuRd") + theme_void()
+# just show the text aesthetic in the tooltip
+ggplotly(p, tooltip = "text")
+```
+
+### Crimes
+
+```{r}
+crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
+crimesm <- tidyr::gather(crimes, variable, value, -state)
+states_map <- map_data("state")
+g <- ggplot(crimesm, aes(map_id = state)) +
+  geom_map(aes(fill = value), map = states_map) +
+  expand_limits(x = states_map$long, y = states_map$lat) +
+  facet_wrap( ~ variable) + theme_void()
+ggplotly(g)
+```
+
+Row {data-height=400}
+------------------------------------------------------------------------------
+
+### Faithful Eruptions
+
+```{r}
+m <- ggplot(faithful, aes(x = eruptions, y = waiting)) +
+  stat_density_2d() + xlim(0.5, 6) + ylim(40, 110)
+ggplotly(m)
+```
+
+### Faithful Eruptions (polygon)
+
+```{r}
+m <- ggplot(faithful, aes(x = eruptions, y = waiting)) +
+  stat_density_2d(aes(fill = ..level..), geom = "polygon") + 
+  xlim(0.5, 6) + ylim(40, 110)
+ggplotly(m)
+```
+
+### Faithful Eruptions (hex)
+
+```{r}
+m <- ggplot(faithful, aes(x = eruptions, y = waiting)) + geom_hex() 
+ggplotly(m)
+```

vignettes/intro.Rmd

@@ -36,15 +36,15 @@ You can manually add a trace to an existing plot with `add_trace()`. In that cas
 ```{r}
 m <- loess(unemploy / pop ~ as.numeric(date), data = economics)
 p <- plot_ly(economics, x = date, y = unemploy / pop, name = "raw") 
-add_trace(p, y = fitted(m), name = "loess")
+add_trace(p, x = date, y = fitted(m), name = "loess")
 ```
 
 __plotly__ was designed with a [pure, predictable, and pipeable interface](https://dl.dropboxusercontent.com/u/41902/pipe-dsls.pdf) in mind, so you can also use the `%>%` operator to create a visualization pipeline:
 
 ```{r}
 economics %>%
   plot_ly(x = date, y = unemploy / pop) %>% 
-  add_trace(y = fitted(m)) %>%
+  add_trace(x = date, y = fitted(m)) %>%
   layout(showlegend = F)
 ```