merge conflicts

Author: tdhock

.gitignore

@@ -5,3 +5,5 @@ Rapp.history
 .Rhistory
 .RData
 Makefile
+.Rproj.user
+*.Rproj

.push_test_table.sh

@@ -0,0 +1,50 @@
+#!/bin/bash
+
+# -----------------------------------------------------------------------
+# When pushing to a pull request on GitHub, Travis does two builds:
+# (1) One for the pull request itself. In this case, $TRAVIS_PULL_REQUEST 
+# is 'false' and $TRAVIS_BRANCH contains the branch name
+# (2) One to *simulate* a merge with master. In this case, $TRAVIS_PULL_REQUEST
+# is the pull ID number and $TRAVIS_BRANCH = 'master'
+# 
+# Read more about Travis environment variables --
+# http://docs.travis-ci.com/user/ci-environment/
+# -----------------------------------------------------------------------
+
+# Only build test table if $TRAVIS_PULL_REQUEST is false
+[ "${TRAVIS_PULL_REQUEST}" != "false" ] && exit 0
+
+git config --global user.name "cpsievert"
+git config --global user.email "[email protected]"
+
+# Since Travis does `git clone --branch=$TRAVIS_BRANCH --depth=50`, 
+# we can't simply `git checkout master`. As far as I can tell, we are
+# forced to re-clone -- https://gist.github.com/cpsievert/698c7f1404f972782e71
+
+cd ..
+rm -rf plotly/
+git clone https://github.com/ropensci/plotly.git
+cd plotly
+echo "user,SHA1,label" >> ../code_commits.csv
+echo "ropensci,`git rev-parse HEAD`,master" >> ../code_commits.csv
+git checkout $TRAVIS_BRANCH
+echo "ropensci,`git rev-parse HEAD`,${TRAVIS_BRANCH}" >> ../code_commits.csv
+Rscript -e "devtools::install()"
+
+cd ..
+git clone https://github.com/ropensci/plotly-test-table.git
+cd plotly-test-table
+git checkout gh-pages
+
+mv ../code_commits.csv .
+cat code_commits.csv
+make
+
+# add, commit, push to gh-pages branch of plotly-test-table
+git add tables/*/*.html data/*/*.png
+git commit -a -m "Travis build number ${TRAVIS_BUILD_NUMBER} of ${TRAVIS_REPO_SLUG}"
+# This post explains how this works -- http://rmflight.github.io/posts/2014/11/travis_ci_gh_pages.html
+GH_REPO="@github.com/ropensci/plotly-test-table.git"
+FULL_REPO="https://${GH_TOKEN}${GH_REPO}"
+git pull $FULL_REPO gh-pages
+git push $FULL_REPO gh-pages

.travis.yml

@@ -1,10 +1,18 @@
 language: c
-script: "./travis-tool.sh run_tests"
+env:
+  global:
+    - secure: "cJ1bDRrAdIRjG+JnsQI9CdA4wQJhJJ2DdCNQ3frl8dotk69z61EiGCFW1Ir1cAY5V/NbHvFHp91HDiSo28ggwqRkEPBOGE44ico5gtVaELu3M/EnkWc2ZwQoN1273Vfdm26QYidqrvWrpLZ0XkFl7Q8xgvBswx30MF7y61+0Hv4="
 before_script:
 - curl -OL http://raw.github.com/craigcitro/r-travis/master/scripts/travis-tool.sh
 - chmod 755 ./travis-tool.sh
-- "./travis-tool.sh bootstrap"
-- "./travis-tool.sh install_deps - ./travis-tool.sh install_r RCurl RJSONIO lattice"
+- chmod 755 ./.push_test_table.sh
+- ./travis-tool.sh bootstrap
+- ./travis-tool.sh install_deps 
+- ./travis-tool.sh install_r RCurl RJSONIO lattice xtable
+script: 
+- ./travis-tool.sh run_tests
+after_success:
+- ./.push_test_table.sh
 notifications:
   slack:
     secure: YvyGtGRFC4HJGD4d2Vx6fHU93EliJCHbcf/k9/Rbpl3wtYFZfWKbKL1FHvPw/g3auVebonz8hScnYzR0uYnR3dHSlmj3QrJ3NOePv5QAZRHy7aY/XKRr5JR1Ji/vX1yfbrJDmiYuGMxJVE8l/kbu0TxwDdLletY5nJpwlkHfaW8=

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: plotly
 Type: Package
 Title: Interactive, publication-quality graphs online.
-Version: 0.5.21
+Version: 0.5.22
 Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
     email = "[email protected]"),
     person("Scott", "Chamberlain", role = "aut",

NEWS

@@ -1,3 +1,7 @@
+0.5.22 -- 2 March 2015.
+
+Fixes for ylim() #171.
+
 0.5.21 -- 23 February 2015.
 
 Fixes for error bars and tick marks.

R/ggplotly.R

@@ -69,6 +69,7 @@ gg2list <- function(p){
   }
   # Always use identity size scale so that plot.ly gets the real
   # units for the size variables.
+  original.p <- p
   p <- tryCatch({
     # this will be an error for discrete variables.
     suppressMessages({
@@ -117,7 +118,8 @@ gg2list <- function(p){
     ggsizemin <- min(unlist(sizerange))
     ggsizemax <- max(unlist(sizerange))
   }
-  
+
+  layer.legends <- list()
   for(i in seq_along(built$plot$layers)){
     # This is the layer from the original ggplot object.
     L <- p$layers[[i]]
@@ -134,14 +136,14 @@ gg2list <- function(p){
     # sent to plotly as characters, not as numeric data (which is
     # what ggplot_build gives us).
     misc <- list()
-    for(a in c("fill", "colour", "x", "y")){
+    for(a in c("fill", "colour", "x", "y", "size")){
       for(data.type in c("continuous", "date", "datetime", "discrete")){
         fun.name <- sprintf("scale_%s_%s", a, data.type)
         misc.name <- paste0("is.", data.type)
         misc[[misc.name]][[a]] <- tryCatch({
           fun <- get(fun.name)
           suppressMessages({
-            with.scale <- p+fun()
+            with.scale <- original.p + fun()
           })
           ggplot_build(with.scale)
           TRUE
@@ -152,13 +154,16 @@ gg2list <- function(p){
     }
 
     # scales are needed for legend ordering.
+    misc$breaks <- list()
     for(sc in p$scales$scales){
-      a <- sc$aesthetics
-      if(length(a) == 1){
+      a.vec <- sc$aesthetics
+      default.breaks <- inherits(sc$breaks, "waiver")
+      if (length(a.vec) == 1 && (!default.breaks) ) {
+        # TODO: generalize for x/y scales too.
         br <- sc$breaks
         ranks <- seq_along(br)
         names(ranks) <- br
-        misc$breaks[[sc$aesthetics]] <- ranks
+        misc$breaks[[a.vec]] <- ranks
       }
       ## store if this is a reverse scale so we can undo that later.
       if(is.character(sc$trans$name)){
@@ -205,6 +210,10 @@ gg2list <- function(p){
 
     # This extracts essential info for this geom/layer.
     traces <- layer2traces(L, df, misc)
+
+    possible.legends <- markLegends[[L$geom$objname]]
+    actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
+    layer.legends[[paste(i)]] <- actual.legends
 
     # Do we really need to coord_transform?
     # g$data <- ggplot2:::coord_transform(built$plot$coord, g$data,
@@ -308,17 +317,33 @@ gg2list <- function(p){
       ax.list$tickangle <- -tick.text$angle
     }
     ax.list$tickfont <- theme2font(tick.text)
+
+    ## determine axis type first, since this information is used later
+    ## (trace.order.list is only used for type=category).
+    title.text <- e(s("axis.title.%s"))
+    ax.list$titlefont <- theme2font(title.text)
+    ax.list$type <- if (misc$is.continuous[[xy]]){
+      "linear"
+    } else if (misc$is.discrete[[xy]]){
+      "category"
+    } else if (misc$is.date[[xy]] || misc$is.datetime[[xy]]){
+      "date"
+    } else {
+      stop("unrecognized data type for ", xy, " axis")
+    }
 
     # Translate axes labels.
     scale.i <- which(p$scales$find(xy))
     ax.list$title <- if(length(scale.i)){
       sc <- p$scales$scales[[scale.i]]
-      trace.order.list[[xy]] <- sc$limits
-      if(is.character(sc$breaks)){
-        if(is.character(sc$labels)){
-          trace.name.map[sc$breaks] <- sc$labels
+      if(ax.list$type == "category"){
+        trace.order.list[[xy]] <- sc$limits
+        if(is.character(sc$breaks)){
+          if(is.character(sc$labels)){
+            trace.name.map[sc$breaks] <- sc$labels
+          }
+          ##TODO: if(is.function(sc$labels)){
         }
-        ##TODO: if(is.function(sc$labels)){
       }
       if (is.null(sc$breaks)) {
         ax.list$showticklabels <- FALSE
@@ -354,18 +379,6 @@ gg2list <- function(p){
       p$labels[[xy]]
     }
 
-    title.text <- e(s("axis.title.%s"))
-    ax.list$titlefont <- theme2font(title.text)
-    ax.list$type <- if(misc$is.continuous[[xy]]){
-      "linear"
-    }else if(misc$is.discrete[[xy]]){
-      "category"
-    }else if(misc$is.date[[xy]] || misc$is.datetime[[xy]]){
-      "date"
-    }else{
-      stop("unrecognized data type for ", xy, " axis")
-    }
-    
     ax.list$zeroline <- FALSE  # ggplot2 plots do not show zero lines
     # Lines drawn around the plot border.
     ax.list$showline <- !is.blank("panel.border", TRUE)
@@ -532,7 +545,27 @@ gg2list <- function(p){
   if (any(names(layer.aes) %in% markUnique[markUnique != "x"]) == FALSE)
     layout$showlegend <- FALSE
 
-  if (layout$showlegend && length(p$data)) {
+  ## Legend hiding when guides(fill="none").
+  legends.present <- unique(unlist(layer.legends))
+  is.false <- function(x){
+    is.logical(x) && length(x) == 1 && x == FALSE
+  }
+  is.none <- function(x){
+    is.character(x) && length(x) == 1 && x == "none"
+  }
+  is.hidden <- function(x){
+    is.false(x) || is.none(x)
+  }
+  for(a in legends.present){
+    if(is.hidden(p$guides[[a]])){
+      layout$showlegend <- FALSE
+    }
+  }
+
+  # Only show a legend title if there is at least 1 trace with
+  # showlegend=TRUE.
+  trace.showlegend <- sapply(trace.list, "[[", "showlegend")
+  if (any(trace.showlegend) && layout$showlegend && length(p$data)) {
     # Retrieve legend title
     legend.elements <- sapply(traces, "[[", "name")
     legend.title <- ""
@@ -691,7 +724,13 @@ gg2list <- function(p){
   }
 
   # Put the traces in correct order, according to any manually
-  # specified scales.
+  # specified scales. This seems to be repetitive with the trace$rank
+  # attribute in layer2traces (which is useful for sorting traces that
+  # get different legend entries but come from the same geom, as in
+  # test-ggplot-legend.R), but in fact this is better since it could
+  # be used for sorting traces that come from different geoms
+  # (currently we don't have a test for this). TODO: write such a
+  # test, delete the trace$rank code, and have it work here instead.
   trace.order <- unlist(trace.order.list)
   ordered.traces <- if(length(trace.order)){
     trace.order.score <- seq_along(trace.order)

R/trace_generation.R

@@ -210,16 +210,24 @@ layer2traces <- function(l, d, misc) {
       }
     }
     name.names <- grep("[.]name$", names(data.params$params), value=TRUE)
-    if (length(name.names)) {
-      for(a.name in name.names){
+    not.group <- grep("group", name.names, value=TRUE, invert=TRUE)
+    if (length(not.group)) {
+      for(a.name in not.group){
         a <- sub("[.]name$", "", a.name)
-        a.value <- as.character(data.params$params[[a.name]])
-        ranks <- misc$breaks[[a]]
-        if(length(ranks)){
-          tr$sort[[a.name]] <- ranks[[a.value]]
+        tr$sort[[a.name]] <- if (a %in% names(misc$breaks)){
+          # Custom breaks were specified.
+          a.value <- as.character(data.params$params[[a.name]])
+          ranks <- misc$breaks[[a]]
+          if (a.value %in% names(ranks)){
+            ranks[[a.value]]
+          } else {
+            Inf # sorts to the end, when there are less breaks than classes.
+          }
+        } else { # custom breaks were not specified.
+          1 # sort them all the same.
         }
       }
-      name.list <- data.params$params[name.names]
+      name.list <- data.params$params[not.group]
       tr$name <- paste(unlist(name.list), collapse=".")
       if (length(unique(name.list)) < 2)
         tr$name <- as.character(name.list[[1]])
@@ -257,14 +265,25 @@ layer2traces <- function(l, d, misc) {
       0
     }
   })
-  
+
   ord <- order(sort.val)
   no.sort <- traces[ord]
   for(tr.i in seq_along(no.sort)){
+    s <- no.sort[[tr.i]]$sort
+    no.sort[[tr.i]]$showlegend <-
+      if (is.numeric(s)) {
+        if (s == Inf){
+          FALSE
+        } else {
+          TRUE
+        }
+      } else { # no legend.
+        FALSE
+      }
     no.sort[[tr.i]]$sort <- NULL
   }
   no.sort
-  }
+}#layer2traces
 
 
 # Preprocess data and params.
@@ -309,7 +328,10 @@ toBasic <- list(
   bar=function(g) {
     if (any(is.na(g$prestats.data$x)))
       g$prestats.data$x <- g$prestats.data$x.name
-    g$prestats.data$fill <- g$data$fill[match(g$prestats.data$group, g$data$group)]
+    for(a in c("fill", "colour")){
+      g$prestats.data[[a]] <-
+        g$data[[a]][match(g$prestats.data$group, g$data$group)]
+    }
     g$params$xstart <- min(g$data$xmin)
     g$params$xend <- max(g$data$xmax)
     g$data <- g$prestats.data

tests/testthat/test-ggplot-abline.R

@@ -11,13 +11,16 @@ test_that("Second trace be the a-b line", {
     geom_abline(intercept=1.1, slope=0.9, colour="red", size=4)
 
   L <- gg2list(gg)
-  
+
   expect_equal(length(L), 3)
   expect_true(L[[2]]$x[1] <= 0)
   expect_true(L[[2]]$x[2] >= 3.5)
   expect_identical(L[[2]]$mode, "lines")
   expect_identical(L[[2]]$line$shape, "linear")
   expect_equal(L[[2]]$line$width, 8)
 
+  expect_identical(L[[1]]$showlegend, FALSE)
+  expect_identical(L[[2]]$showlegend, FALSE)
+
   save_outputs(gg, "abline")
 })