Adapt stat_sum to use weights. Further work on documentation, includi…

…ng link to online form

NEWS

@@ -6,6 +6,7 @@ New geoms, scales and aesthetics
   * stat_step and geom_step to draw staircase plots (like plot(type="s"))
   * order aesthetic (currently only for lines/paths) allows you to control the drawing order within a group
   * scale_manual makes it easier to let ggplot uses the exact colours/sizes/linetypes that you want
+  * scale_reverse allows you to reverse the scale
 
 
 Improved options handling
@@ -18,6 +19,7 @@ These changes mean that you can modify plot options in the same way that you mod
 Improved documentation
 
   * many tweaks to the online documentation, particular including the actual code you need to run for each object!
+  * every page now has a link to a form where you can submit feedback on exactly you do or don't like about a page
   * required aesthetics now listed in documentation
   * geom_polygon now has a decent example
   * numerous minor corrections suggested by Jörg Beyer

R/aaa-top-level.r

@@ -106,13 +106,15 @@ TopLevel <- proto(expr = {
       .$html_head(),
       .$html_details(),
       .$html_advice(),
+      .$html_feedback(),
       .$html_aesthetics(),
       .$html_outputs(),
       .$html_parameters(),
       # .$html_defaults(),
       .$html_returns(),
       .$html_seealso(),
       .$html_examples(),
+      .$html_feedback(),
       .$html_footer()
     )
   }
@@ -194,6 +196,10 @@ TopLevel <- proto(expr = {
     )
   }
 
+  html_feedback <- function(.) {
+    ps("<p class='feedback'>What do you think of the documentation?  <a href='http://hadley.wufoo.com/forms/documentation-feedback/default/field0/", .$my_name(), "'>Please let me know by filling out this short online survey</a>.</p>")
+  }
+
   html_outputs <- function(.) {
     if (!exists("desc_outputs", .)) return("")
 
@@ -295,13 +301,13 @@ TopLevel <- proto(expr = {
     ps(.$my_name(), ".png")
   }
 
-  html_img_link <- function(., align="left") {
+  html_img_link <- function(., align=NULL) {
     ps("<a href='", .$html_path(), "'>", .$html_img(align), "</a>")
   }
 
-  html_img <- function(., align="left") {
+  html_img <- function(., align=NULL) {
     ps(
-      "<img src='", .$html_img_path(), "' width='50' height='50' alt='' class='icon' />\n"
+      "<img src='", .$html_img_path(), "'", if (!is.null(align)) {ps(" align='", align, "'")}, " width='50' height='50' alt='' class='icon' />\n"
     )
   }
 

R/geom-interval-histogram.r

@@ -2,6 +2,9 @@ GeomHistogram <- proto(GeomBar, {
   objname <- "histogram"
   desc <- "Histogram"
 
+  details <- ""
+  advice <- ""
+
   default_stat <- function(.) StatBin
   default_pos <- function(.) PositionStack
 

R/plot.r

@@ -40,7 +40,7 @@ ggplot.default <- function(data = NULL, mapping=aes(), ...) {
 print.ggplot <- function(x, newpage = is.null(vp), vp = NULL, save=ggopt()$save, ...) {
   if (save) {
     try_require("decumar")
-    img(grid.draw(ggplot_plot(x, ...)), hash=digest(x))
+    img(grid.draw(ggplot_plot(x, ...)), hash=digest.ggplot(x))
     return()
   }
 

R/stat-sum.r

@@ -5,8 +5,10 @@ StatSum <- proto(Stat, {
   icon <- function(.) textGrob(expression(Sigma), gp=gpar(cex=4))
 
   calculate <- function(., data, scales, ...) {
-    counts <- rename(dftable(data[, c("x", "y")]), c("Freq"="n"))
-    counts$prop <- counts$n / sum(counts$n)
+    if (is.null(data$weight)) data$weight <- 1
+
+    counts <- as.data.frame(xtabs(weight ~ x + y, data), responseName="sum")
+    counts$prop <- counts$sum / sum(counts$sum)
     counts$group <- 1
 
     counts
@@ -18,8 +20,9 @@ StatSum <- proto(Stat, {
     "ggfluctuation" = "Fluctuation diagram, which is very similar"
   )
   desc_outputs <- list(
-    "n" = "number of observations at position",
-    "prop" = "percent of points in that panel at that position"
+    "sum" = "number of observations at position",
+    "prop" = "percent of points in that panel at that position",
+    "round_any" = "for rounding continuous observations to desired level of accuracy"
   )
 
   examples <- function(.) {
@@ -31,6 +34,11 @@ StatSum <- proto(Stat, {
     d + stat_sum(aes(group=cut))
     # by clarity
     d + stat_sum(aes(group=clarity))
+
+    # Can also weight by another variable
+    d + stat_sum(aes(group=1, weight = price))
+    d + stat_sum(aes(group=1, weight = price, size = ..sum..))
+
 
     # Or using qplot
     qplot(cut, clarity, data=diamonds)

R/trans-.r

@@ -86,6 +86,7 @@ TransLog2 <- Trans$new("log2", "log2", function(x) 2^x, function(x) bquote(2^.(x
 TransLogit <- ProbabilityTrans$new("logis")
 TransPow10 <- Trans$new("pow10",function(x) 10^x, "log10", function(x) log10(x))
 TransProbit <- ProbabilityTrans$new("norm")
+TransReverse <- Trans$new("reverse", function(x) -x, function(x) -x, function(x) bquote(.(-x)))
 TransSqrt <- Trans$new("sqrt", "sqrt", function(x) x^2, function(x) bquote(.(x)^2))
 
 to_date <- function(x) structure(x, class="Date")

R/trans-scales.r

@@ -7,6 +7,7 @@ ScaleLog2 <-     proto(ScaleContinuous, .tr = Trans$find("log2"),     objname =
 ScaleLog <-      proto(ScaleContinuous, .tr = Trans$find("log"),      objname = "log", doc=FALSE, examples=function(.) {})
 ScaleExp <-      proto(ScaleContinuous, .tr = Trans$find("exp"),      objname = "exp", doc=FALSE, examples=function(.) {})
 ScaleLogit <-    proto(ScaleContinuous, .tr = Trans$find("logit"),    objname = "logit", doc=FALSE, examples=function(.) {})
+ScaleReverse <-    proto(ScaleContinuous, .tr = Trans$find("reverse"),    objname = "reverse", doc=FALSE, examples=function(.) {})
 ScaleAsn <-      proto(ScaleContinuous, .tr = Trans$find("asn"),      objname = "asn", doc=FALSE, examples=function(.) {})
 ScaleProbit <-   proto(ScaleContinuous, .tr = Trans$find("probit"),   objname = "probit", doc=FALSE, examples=function(.) {})
 ScaleAtanh <-    proto(ScaleContinuous, .tr = Trans$find("atanh"),    objname = "atanh", doc=FALSE, examples=function(.) {})

R/xxx.r

@@ -82,6 +82,7 @@ scale_x_pow <- function(...) ScalePower$new(..., variable = "x")
 scale_x_pow10 <- function(...) ScalePow10$new(..., variable = "x")
 scale_x_prob <- function(...) ScaleProbability$new(..., variable = "x")
 scale_x_probit <- function(...) ScaleProbit$new(..., variable = "x")
+scale_x_reverse <- function(...) ScaleReverse$new(..., variable = "x")
 scale_x_sqrt <- function(...) ScaleSqrt$new(..., variable = "x")
 scale_xend_asn <- function(...) ScaleAsn$new(..., variable = "xend")
 scale_xend_atanh <- function(...) ScaleAtanh$new(..., variable = "xend")
@@ -96,6 +97,7 @@ scale_xend_pow <- function(...) ScalePower$new(..., variable = "xend")
 scale_xend_pow10 <- function(...) ScalePow10$new(..., variable = "xend")
 scale_xend_prob <- function(...) ScaleProbability$new(..., variable = "xend")
 scale_xend_probit <- function(...) ScaleProbit$new(..., variable = "xend")
+scale_xend_reverse <- function(...) ScaleReverse$new(..., variable = "xend")
 scale_xend_sqrt <- function(...) ScaleSqrt$new(..., variable = "xend")
 scale_y_asn <- function(...) ScaleAsn$new(..., variable = "y")
 scale_y_atanh <- function(...) ScaleAtanh$new(..., variable = "y")
@@ -112,6 +114,7 @@ scale_y_pow <- function(...) ScalePower$new(..., variable = "y")
 scale_y_pow10 <- function(...) ScalePow10$new(..., variable = "y")
 scale_y_prob <- function(...) ScaleProbability$new(..., variable = "y")
 scale_y_probit <- function(...) ScaleProbit$new(..., variable = "y")
+scale_y_reverse <- function(...) ScaleReverse$new(..., variable = "y")
 scale_y_sqrt <- function(...) ScaleSqrt$new(..., variable = "y")
 scale_yend_asn <- function(...) ScaleAsn$new(..., variable = "yend")
 scale_yend_atanh <- function(...) ScaleAtanh$new(..., variable = "yend")
@@ -126,6 +129,7 @@ scale_yend_pow <- function(...) ScalePower$new(..., variable = "yend")
 scale_yend_pow10 <- function(...) ScalePow10$new(..., variable = "yend")
 scale_yend_prob <- function(...) ScaleProbability$new(..., variable = "yend")
 scale_yend_probit <- function(...) ScaleProbit$new(..., variable = "yend")
+scale_yend_reverse <- function(...) ScaleReverse$new(..., variable = "yend")
 scale_yend_sqrt <- function(...) ScaleSqrt$new(..., variable = "yend")
 scale_z_asn <- function(...) ScaleAsn$new(..., variable = "z")
 scale_z_atanh <- function(...) ScaleAtanh$new(..., variable = "z")
@@ -141,6 +145,7 @@ scale_z_pow <- function(...) ScalePower$new(..., variable = "z")
 scale_z_pow10 <- function(...) ScalePow10$new(..., variable = "z")
 scale_z_prob <- function(...) ScaleProbability$new(..., variable = "z")
 scale_z_probit <- function(...) ScaleProbit$new(..., variable = "z")
+scale_z_reverse <- function(...) ScaleReverse$new(..., variable = "z")
 scale_z_sqrt <- function(...) ScaleSqrt$new(..., variable = "z")
 stat_bin <- StatBin$new
 stat_boxplot <- StatBoxplot$new