Resolve merge conflicts with master

Author: cpsievert

.push_test_table.sh

@@ -12,10 +12,10 @@ r_packages:
   - httr 
 
 before_script:
-  - chmod 755 ./.push_test_table.sh
+  - chmod 755 inst/testscripts/.push_test_table.sh
 
 after_success:
-  - ./.push_test_table.sh
+  - inst/testscripts/.push_test_table.sh
 
 notifications:
   slack:

.travis.yml

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

DESCRIPTION

@@ -1,7 +1,15 @@
-0.5.28 -- 15 Apr 2015
+0.5.30 -- 5 May 2015
 
 Add test-cookbook-lines.R and fix bugs that showed up in those tests.
 
+0.5.29 -- 16 April 2015
+
+geom_density() as filled area chart #202 
+
+0.5.28 -- 15 April 2015
+
+Let ggplot handle histogram binning. Fix #198
+
 0.5.27 -- 19 Mar 2015
 
 Reimplement geom_ribbon as a basic polygon. Fix #191. Fix #192.

NEWS

@@ -264,6 +264,41 @@ gg2list <- function(p){
     if (!all(barmodes == barmodes[1]))
       warning(paste0("You have multiple barcharts or histograms with different positions; ",
                      "Plotly's layout barmode will be '", layout$barmode, "'."))
+    # for stacked bar charts, plotly cumulates bar heights, but ggplot doesn't
+    if (layout$barmode == "stack") {
+      # could speed up this function with environments or C/C++
+      unStack <- function(vec) {
+        n <- length(vec)
+        if (n == 1) return(vec)
+        seq.n <- seq_len(n)
+        names(vec) <- seq.n
+        vec <- sort(vec)
+        for (k in seq(2, n)) {
+          vec[k] <- vec[k] - sum(vec[seq(1, k-1)])
+        }
+        as.numeric(vec[as.character(seq.n)])
+      }
+      ys <- lapply(trace.list, "[[", "y")
+      xs <- lapply(trace.list, "[[", "x")
+      x.vals <- unique(unlist(xs))
+      # if there are two or more y-values (for a particular x value),
+      # then modify those y-values so they *add up* to the correct value(s)
+      for (val in x.vals) {
+        zs <- lapply(xs, function(x) which(x == val))
+        ys.given.x <- Map(function(x, y) y[x], zs, ys)
+        if (length(unlist(ys.given.x)) < 2) next
+        st <- unStack(unlist(ys.given.x))
+        lens <- sapply(ys.given.x, length)
+        trace.seq <- seq_along(trace.list)
+        ws <- split(st, rep(trace.seq, lens))
+        for (tr in seq_along(ws)) {
+          idx <- zs[[tr]]
+          replacement <- ws[[tr]]
+          if (length(idx) > 0  && length(replacement) > 0) 
+            trace.list[[tr]]$y[idx] <- replacement
+        }
+      }
+    }
   }
 
   # Bar Gap for histograms should be 0

R/ggplotly.R

@@ -41,25 +41,9 @@ layer2traces <- function(l, d, misc) {
       g$geom <- "smoothLine"
     }
   }
-  # Barmode and bargap
-  barmode <- "group"
-  if (g$geom == "bar" || g$geom == "histogram") {
-    if (l$stat$objname == "bin") {
-      if (g$geom != "histogram") {
-        warning("You may want to use geom_histogram.")
-      }
-    } else {
-      bargap <- "default"
-    }
-    g$geom <- "bar"  # histogram is just an alias for geom_bar + stat_bin
-    pos <- l$position$.super$objname
-    if (pos == "identity") {
-      barmode <- "overlay"
-    } else if (pos == "stack") {
-      barmode <- "stack"
-    }
-  }
-  if (g$geom == "density") {
+  # histogram is essentially a bar chart with no gaps (after stats are computed)
+  if (g$geom == "histogram") {
+    g$geom <- "bar"
     bargap <- 0
   }
 
@@ -187,15 +171,14 @@ layer2traces <- function(l, d, misc) {
       lapply(df.list, function(df){
         params <- basic$params
         params[invariable.names] <- if (ncol(x <- df[1, invariable.names]) > 0) x else NULL
-        list(data=df[other.names],
+        list(data=df[other.names], 
              params=params)
       })
     }
   }
-
   # Split hline and vline when multiple panels or intercepts:
   # Need multiple traces accordingly.
-  if (g$geom == "hline" || g$geom == "vline") {
+  if (g$geom %in% c("hline", "vline")) {
     intercept <- paste0(ifelse(g$geom == "hline", "y", "x"), "intercept")
     vec.list <- basic$data[c("PANEL", intercept)]
     df.list <- split(basic$data, vec.list, drop=TRUE)
@@ -221,7 +204,6 @@ layer2traces <- function(l, d, misc) {
   }
   traces <- NULL
   names.in.legend <- NULL
-  
   for (data.i in seq_along(data.list)) {
     data.params <- data.list[[data.i]]
     data.params$params$stat.type <- l$stat$objname
@@ -265,18 +247,19 @@ layer2traces <- function(l, d, misc) {
     if (is.null(tr$name) || tr$name %in% names.in.legend)
       tr$showlegend <- FALSE
     names.in.legend <- c(names.in.legend, tr$name)
-    
-    if (g$geom == "bar")
-      tr$barmode <- barmode
-    
-    # Bar Gap
-    if (exists("bargap")) {
-      tr$bargap <- bargap
+
+    # special handling for bars
+    if (g$geom == "bar") {
+      tr$bargap <- if (exists("bargap")) bargap else "default"
+      pos <- l$position$.super$objname
+      tr$barmode <- if (pos %in% c("identity", "stack", "fill")) {
+        "stack"
+      } else "group"
     }
+    
     traces <- c(traces, list(tr))
   }
 
-  
   sort.val <- sapply(traces, function(tr){
     rank.val <- unlist(tr$sort)
     if(is.null(rank.val)){
@@ -362,25 +345,19 @@ toBasic <- list(
     g$data <- g$prestats.data
     g
   },
-  bar=function(g) {
-    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
+  bar=function(g){
+    g <- group2NA(g, "bar")
+    g$data <- g$data[!is.na(g$data$y), ]
     g
   },
   contour=function(g) {
     g$data <- g$prestats.data
     g
   },
   density=function(g) {
-    g$params$xstart <- min(g$data$x)
-    g$params$xend <- max(g$data$x)
-    g$params$binwidth <- (max(g$data$x) - min(g$data$x))/30
-    g$data <- g$prestats.data
+    g$geom <- "area"
+    if (is.null(g$data$fill) && is.null(g$params$alpha)) g$params$alpha <- 0
+    if (is.null(g$data$colour)) g$params$colour <- "black"
     g
   },
   density2d=function(g) {
@@ -594,40 +571,25 @@ geom2trace <- list(
     L
   },
   bar=function(data, params) {
-    L <- list(x=data$x,
+    x <- if ("x.name" %in% names(data)) data$x.name else data$x
+    if (inherits(x, "POSIXt")) {
+      # Convert seconds into milliseconds
+      x <- as.numeric(x) * 1000
+    } else if (inherits(x, "Date")) {
+      # Convert days into milliseconds
+      x <- as.numeric(x) * 24 * 60 * 60 * 1000
+    }
+    L <- list(x=x,
+              y=data$y,
+              type="bar",
               name=params$name,
               text=data$text,
               marker=list(color=toRGB(params$fill)))
-    
     if (!is.null(params$colour)) {
       L$marker$line <- list(color=toRGB(params$colour))
       L$marker$line$width <- if (is.null(params$size)) 1 else params$size
     }
-    
-    if (!is.null(params$alpha))
-      L$opacity <- params$alpha
-    
-    if (params$stat.type == "bin") {
-      L$type <- "histogram"
-      if (is.null(params$binwidth)) {
-        L$autobinx <- TRUE
-      } else {
-        L$autobinx <- FALSE
-        L$xbins=list(start=params$xstart,
-                     end=params$xend,
-                     size=params$binwidth)
-        if (inherits(data$x.name, "POSIXt")) {
-          # Convert seconds into milliseconds
-          L$xbins <- lapply(L$xbins, function(x) x * 1000)
-        } else if (inherits(data$x.name, "Date")) {
-          # Convert days into milliseconds
-          L$xbins <- lapply(L$xbins, function(x) x * 24 * 60 * 60 * 1000)
-        }
-      }
-    } else {
-      L$y <- data$y
-      L$type <- "bar"
-    }
+    if (!is.null(params$alpha)) L$opacity <- params$alpha
     L
   },
   step=function(data, params) {
@@ -666,15 +628,6 @@ geom2trace <- list(
     L$contours=list(coloring="lines")
     L
   },
-  density=function(data, params) {
-    L <- list(x=data$x,
-              name=params$name,
-              text=data$text,
-              marker=list(color=toRGB(params$fill)),
-              type="histogram",
-              autobinx=TRUE,
-              histnorm="probability density")
-  },
   density2d=function(data, params) {
     L <- list(x=data$x,
               y=data$y,

R/trace_generation.R

@@ -0,0 +1,29 @@
+#!/bin/bash
+
+# exit on error
+set -e
+
+# -----------------------------------------------------------------------
+# Travis does two types of builds:
+#
+# (1) A so-called "push". This essentially does a checkout on the most 
+# recent commit of the pull request, but *doesn't* merge with master.
+# In this case, $TRAVIS_PULL_REQUEST = "false"
+# (2) A so-called "pr" (pull request). This *does* merge with master.
+# In this case, $TRAVIS_PULL_REQUEST contains the pull request number.
+# -----------------------------------------------------------------------
+
+# We need the pull request number to talk to the GitHub API, make comments, etc. 
+[ "${TRAVIS_PULL_REQUEST}" = "false" ] && exit 0
+
+git config --global user.name "cpsievert"
+git config --global user.email "[email protected]"
+
+cd ..
+git clone https://github.com/ropensci/plotly-test-table.git
+cd plotly-test-table
+git checkout gh-pages
+
+# Read more about Travis environment variables --
+# http://docs.travis-ci.com/user/ci-environment/
+Rscript ../plotly/inst/testscripts/comment.R $TRAVIS_PULL_REQUEST $TRAVIS_BUILD_ID $TRAVIS_COMMIT $GH_TOKEN