Massive rewrite to better deal with xmin, xmax, xend etc

R/aaa-html.r

@@ -11,8 +11,8 @@
   "intercept"= "x/y intercept", 
   "label"= "text label", 
   "linetype"= "line type", 
-  "max"= "maximum of interval", 
-  "min"= "minimum of interval", 
+  "ymax"= "maximum of interval", 
+  "ymin"= "minimum of interval", 
   "angle"= "angle", 
   "shape"= "shape of point", 
   "size"= "size", 

R/aes.r

@@ -1,6 +1,6 @@
 # dput(c(names(.base_to_ggplot), "group","order", "z",  sort(unique(unlist(sapply(Geom$find_all(), function(y) c(names(y$default_aes()), y$required_aes)))))))
 .all_aesthetics <-  c("col", "color", "pch", "cex", "lty", "lwd", "srt", "adj", "bg", "fg", "group", "order", "z", "angle", "colour", "fill", "height", 
-"hjust", "intercept", "label", "linetype", "max", "min", "shape", "size", "slope", "vjust", "weight", "width", "x", "xend", "xmax", "xmin", "y", "yend", "ymax", "ymin")
+"hjust", "intercept", "label", "linetype", "shape", "size", "slope", "vjust", "weight", "width", "x", "xend", "xmax", "xmin", "y", "yend", "ymax", "ymin")
 
 .base_to_ggplot <- c(
   "col"   = "colour",
@@ -12,7 +12,9 @@
   "srt"   = "angle",
   "adj"   = "hjust",
   "bg"    = "fill",
-  "fg"    = "colour"
+  "fg"    = "colour",
+  "min"   = "ymin", 
+  "max"   = "ymax"
 )
 
 # Generate aesthetic mappings
@@ -48,6 +50,14 @@ rename_aes <- function(x) {
   rename(x, .base_to_ggplot)
 }
 
+aes_to_scale <- function(var) {
+  if (var %in% c("x", "xmin", "xmax", "xend")) return("x")
+  if (var %in% c("y", "ymin", "ymay", "yend")) return("y")
+
+  var
+}
+
+
 # Generate aesthetic mappings from a string
 # Aesthetic mappings describe how variables in the data are mapped to visual properties (aesthetics) of geoms.  Compared to aes this function operates on strings rather than expressions.
 # 

R/coordinates-cartesian-.r

@@ -8,18 +8,8 @@ CoordCartesian <- proto(Coord, expr={
   y <- function(.) .$.scales$get_scales("y")
 
   transform <- function(., data) {
-    data <- base::transform(data,
-      x = .$transform_x(x),
-      y = .$transform_y(y)
-    )
-    if (!is.null(data$max)) data$max <- .$transform_y(data$max)
-    if (!is.null(data$min)) data$min <- .$transform_y(data$min)
-    if (!is.null(data$xmax)) data$xmax <- .$transform_x(data$xmax)
-    if (!is.null(data$xmin)) data$xmin <- .$transform_x(data$xmin)
-
-    data
+    transform_position(data, .$transform_x, .$transform_y)
   }
-
   transform_x <- function(., data) {
     rescale(data, 0:1, .$output_set()$x)
   }

R/coordinates-cartesian-flipped.r

@@ -2,8 +2,15 @@ CoordFlip <- proto(CoordCartesian, expr={
   x <- function(.) .$.scales$get_scales("y")
   y <- function(.) .$.scales$get_scales("x")
 
-  muncher <- function(.) TRUE
-  transform <- function(., data) rename(data, c(x="y", y="x", xend="yend", yend="xend"))
+  muncher <- function(.) FALSE
+  transform <- function(., data) {
+    rename(data, c(
+      x = "y",       y = "x", 
+      xend = "yend", yend = "xend", 
+      xmin = "ymin", ymin = "xmin",
+      xmax = "ymax", ymax = "ymax")
+    )
+  }
   munch <- function(., data) .$transform(data)
 
   # Documentation -----------------------------------------------

R/geom-.r

@@ -29,8 +29,6 @@ Geom <- proto(TopLevel, expr={
     ))
   }
 
-  adjust_scales_data <- function(., scales, data) data
-
   new <- function(., mapping=NULL, data=NULL, stat=NULL, position=NULL, ...){
     do.call("layer", list(mapping=mapping, data=data, stat=stat, geom=., position=position, ...))
   }
@@ -40,6 +38,8 @@ Geom <- proto(TopLevel, expr={
     if (newline) cat("\n")
   }
 
+  add_defaults <- function(., data) data
+
   # Html documentation ----------------------------------
 
 

R/geom-interval-histogram.r → R/geom-bar-histogram.r

@@ -8,6 +8,7 @@ GeomHistogram <- proto(GeomBar, {
 
   default_stat <- function(.) StatBin
   default_pos <- function(.) PositionStack
+  required_aes <- c("x")
 
   icon <- function(.) {
     y <- c(0.2, 0.3, 0.5, 0.6,0.2, 0.8, 0.5, 0.3)

R/geom-interval-bar.r → R/geom-bar.r

@@ -2,16 +2,21 @@ GeomBar <- proto(GeomInterval, {
 
   default_stat <- function(.) StatBin
   default_pos <- function(.) PositionStack
-  default_aes <- function(.) aes(colour=NA, fill="grey60", min=0, size=1, linetype=1, max=y)
+  default_aes <- function(.) aes(colour=NA, fill="grey60", size=1, linetype=1, width = resolution(x) * 0.9, )
+
+  required_aes <- c("x", "y")
 
-  draw <- function(., data, scales, coordinates, width = NULL, ...) {
-    width <- nulldefault(width, resolution(data$x) * 0.9)    
-
-    data <- transform(data, 
-      xmin = x - width/2, 
-      xmax = x + width/2
+  add_defaults <- function(., df) {
+    transform(df,
+      ymin = 0,
+      ymax = y,
+      xmin = as.numeric(x) - width / 2, 
+      xmax = as.numeric(x) + width / 2,
+      width = NULL
     )
-
+  }
+
+  draw <- function(., data, scales, coordinates, width = NULL, ...) {
     if (coordinates$muncher()) {
       data <- transform(data, top=max, bottom=min, left=x - width/2, right=x + width/2)
       ggname("bar",gTree(children=do.call("gList", lapply(1:nrow(data), function(i) {
@@ -27,7 +32,7 @@ GeomBar <- proto(GeomInterval, {
       }))))
     } else {
     with(coordinates$transform(data), 
-      ggname(.$my_name(), rectGrob(xmin, max, width=xmax-xmin, height=max-min, default.units="native", just=c("left", "top"), 
+      ggname(.$my_name(), rectGrob(xmin, ymax, width=xmax-xmin, height=ymax-ymin, default.units="native", just=c("left", "top"), 
       gp=gpar(col=colour, fill=fill, lwd=size * .pt, lty=linetype, lineend="butt"))
     ))
     }

R/geom-interval-boxplot.r → R/geom-boxplot.r

@@ -1,17 +1,16 @@
-GeomBoxplot <- proto(GeomInterval, {
+GeomBoxplot <- proto(Geom, {
   draw <- function(., data, ..., outlier.colour = "black", outlier.shape = 19, outlier.size = 1) {    
     defaults <- with(data, data.frame(x=x, colour=colour, size=size, linetype=1, group=1, xend=x,  width=width, fill=fill, stringsAsFactors=FALSE))
     defaults2 <- defaults[c(1,1), ]
 
     with(data, ggname(.$my_name(), gTree(children = gList(
       if(length(outliers[[1]]) > 1) GeomPoint$draw(data.frame(y = outliers[[1]], x = x[rep(1, length(outliers[[1]]))], colour=I(outlier.colour), shape=outlier.shape, size=outlier.size, fill = NA), ...),
-      GeomPath$draw(data.frame(y=c(upper, max), defaults2), ...),
-      GeomPath$draw(data.frame(y=c(lower, min), defaults2), ...),
+      GeomPath$draw(data.frame(y=c(upper, ymax), defaults2), ...),
+      GeomPath$draw(data.frame(y=c(lower, ymin), defaults2), ...),
       GeomBar$draw(data.frame(max = upper, min = lower, defaults), ...),
       GeomBar$draw(data.frame(max = middle, min = middle, defaults), ...)
     ))))
   }
-  adjust_scales_data <- function(., scales, data) data
 
   objname <- "boxplot"
   desc <- "Box and whiskers plot"
@@ -38,6 +37,7 @@ GeomBoxplot <- proto(GeomInterval, {
   default_stat <- function(.) StatBoxplot
   default_pos <- function(.) PositionDodge
   default_aes <- function(.) aes(weight=1, colour="grey50", fill="white", size=0.5)
+  required_aes <- c("x", "y")
   seealso <- list(
     stat_quantile = "View quantiles conditioned on a continuous variable",
     geom_jitter = "Another way to look at conditional distributions"

R/geom-interval-crossbar.r → R/geom-crossbar.r

@@ -1,4 +1,4 @@
-GeomCrossbar <- proto(GeomInterval, {
+GeomCrossbar <- proto(Geom, {
   objname <- "crossbar"
   desc <- "Hollow bar with middle indicated by horizontal line"
   desc_params <- list(
@@ -22,7 +22,8 @@ GeomCrossbar <- proto(GeomInterval, {
 
   default_stat <- function(.) StatIdentity
   default_pos <- function(.) PositionIdentity
-  default_aes = function(.) aes(colour="black", fill="NA", width=resolution(x) * 0.9, size=0.5, linetype=1, min=y, max=y)
+  default_aes = function(.) aes(colour="black", fill="NA", width=resolution(x) * 0.9, size=0.5, linetype=1, ymin=y, ymax=y)
+  required_aes <- c("x", "y", "ymin", "ymax")
   guide_geom <- function(.) "path"
 
   draw <- function(., data, scales, coordinates, fatten = 2, ...) {

R/geom-interval-error.r → R/geom-error.r

@@ -12,6 +12,7 @@ GeomErrorbar <- proto(GeomInterval, {
   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour = "black", size=0.5, linetype=1)
   guide_geom <- function(.) "path"
+  required_aes <- c("x", "ymin", "ymax")
 
 
   seealso <- list(
@@ -29,7 +30,7 @@ GeomErrorbar <- proto(GeomInterval, {
 
     GeomPath$draw(with(data, data.frame( 
       x = as.vector(rbind(l, r, x, x, r, l)), 
-      y = as.vector(rbind(max, max, max, min, min, min)),
+      y = as.vector(rbind(ymax, ymax, ymax, ymin, ymin, ymin)),
       colour = rep(colour, each = 6),
       size = rep(size, each = 6),
       linetype = rep(linetype, each = 6),
@@ -50,7 +51,7 @@ GeomErrorbar <- proto(GeomInterval, {
     df2 <- df[c(1,3),]
 
     # Define the top and bottom of the errorbars
-    limits <- aes(max = resp + se, min=resp - se)
+    limits <- aes(ymax = resp + se, ymin=resp - se)
 
     p <- ggplot(df, aes(fill=group, y=resp, x=trt))
     p + geom_bar(position="dodge", stat="identity")

R/geom-interval-line.r → R/geom-linerange.r

@@ -1,4 +1,4 @@
-GeomLinerange <- proto(GeomInterval, {
+GeomLinerange <- proto(Geom, {
   objname <- "linerange"
   desc <- "An interval represented by a vertical line"
 
@@ -13,11 +13,12 @@ GeomLinerange <- proto(GeomInterval, {
   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour = "black", size=0.5, linetype=1)
   guide_geom <- function(.) "path"
+  required_aes <- c("x", "ymin", "ymax")
 
   draw <- function(., data, scales, coordinates, ...) {
     munched <- coordinates$transform(data)
 
-    ggname(.$my_name(), GeomSegment$draw(transform(data, xend=x, y=min, yend=max), scales, coordinates, ...))
+    ggname(.$my_name(), GeomSegment$draw(transform(data, xend=x, y=ymin, yend=ymax), scales, coordinates, ...))
   }
 
   icon <- function(.) segmentsGrob(c(0.3, 0.7), c(0.1, 0.2), c(0.3, 0.7), c(0.7, 0.95))
@@ -34,7 +35,7 @@ GeomLinerange <- proto(GeomInterval, {
     qplot(cut, fit, data=cuts, geom="bar")
 
     # Display estimates and standard errors in various ways
-    se <- ggplot(cuts, aes(x = cut, min=fit - se.fit, max=fit + se.fit, y=fit))
+    se <- ggplot(cuts, aes(x = cut, ymin=fit - se.fit, ymax=fit + se.fit, y=fit))
     se + geom_linerange()
     se + geom_pointrange()
     se + geom_errorbar(width = 0.5)

R/geom-interval-point.r → R/geom-pointrange.r

@@ -1,4 +1,4 @@
-GeomPointrange <- proto(GeomInterval, {
+GeomPointrange <- proto(Geom, {
   objname <- "pointrange"
   desc <- "An interval represented by a vertical line, with a point in the middle"
   icon <- function(.) {
@@ -18,6 +18,7 @@ GeomPointrange <- proto(GeomInterval, {
   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour = "black", size=1, linetype=1, shape=19, fill=NA)
   guide_geom <- function(.) "pointrange"
+  required_aes <- c("x", "y", "ymin", "ymax")
 
   draw <- function(., data, scales, coordinates, ...) {
     if (is.null(data$y)) return(GeomLinerange$draw(data, scales, coordinates, ...))

R/geom-ribbon-.r

@@ -1,20 +1,9 @@
 GeomRibbon <- proto(GeomInterval, {
   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour="grey60", fill="grey80", size=0.5, linetype=1)
-  required_aes <- c("x", "min", "max")
+  required_aes <- c("x", "ymin", "ymax")
   guide_geom <- function(.) "ribbon"
 
-  adjust_scales_data <- function(., scales, data) {
-    if (!"y" %in% scales$input()) {
-      scales$add(ScaleContinuous$new(variable="y"))  
-    }
-
-    y <- scales$get_scales("y")
-    y$train(data$min)
-    y$train(data$y)
-    y$train(data$max)
-  }
-
   draw_legend <- function(., data, ...)  {
     data <- aesdefaults(data, .$default_aes(), list(...))
 
@@ -62,12 +51,12 @@ GeomRibbon <- proto(GeomInterval, {
 
     h <- ggplot(huron, aes(x=year))
 
-    h + geom_ribbon(aes(min=0, max=level))
+    h + geom_ribbon(aes(ymin=0, ymax=level))
     h + geom_area(aes(y = level))
 
     # Add aesthetic mappings
-    h + geom_ribbon(aes(min=level-1, max=level+1))
-    h + geom_ribbon(aes(min=level-1, max=level+1)) + geom_line(aes(y=level))
+    h + geom_ribbon(aes(ymin=level-1, ymax=level+1))
+    h + geom_ribbon(aes(ymin=level-1, ymax=level+1)) + geom_line(aes(y=level))
 
     # Another data set, with multiple y's for each x
     m <- ggplot(movies, aes(y=votes, x=year)) 
@@ -89,7 +78,7 @@ GeomArea <- proto(GeomRibbon,{
 
   draw_groups <- function(., data, scales, coordinates, ...) {
     data <- transform(data, 
-      min = 0,
+      ymin = 0,
       max = y
     )
     GeomRibbon$draw_groups(data, scales, coordinates)

R/geom-segment.r

@@ -16,13 +16,7 @@ GeomSegment <- proto(Geom, {
 
     GeomPath$draw_groups(pieces, scales, coordinates, ...)
   }
-
-  adjust_scales_data <- function(., scales, data) {
-    scales$get_scales("x")$train(range(data$xend))
-    scales$get_scales("y")$train(range(data$yend))
-
-    data
-  }
+
 
   objname <- "segment"
   desc <- "Single line segments"

R/geom-smooth.r

@@ -16,7 +16,6 @@ GeomSmooth <- proto(GeomInterval, {
     ))
   }
 
-  adjust_scales_data <- function(., scales, data) data
   guide_geom <- function(.) "smooth"
 
   default_stat <- function(.) StatSmooth