Permalink
Browse files

Change from dotclusterGrob to dotstackGrob.

Also add many other simplifications and generalizations.
  • Loading branch information...
wch committed Dec 10, 2011
1 parent ab5e104 commit 5a5fefc439ad6181536ad0884ce6fc0e31d135db
Showing with 62 additions and 94 deletions.
  1. +1 −1 DESCRIPTION
  2. +1 −1 NAMESPACE
  3. +13 −21 R/geom-dotplot.r
  4. +0 −71 R/grob-dotcluster.r
  5. +47 −0 R/grob-dotstack.r
View
@@ -104,7 +104,7 @@ Collate:
'geom-vline.r'
'ggplot2.r'
'grob-absolute.r'
- 'grob-dotcluster.r'
+ 'grob-dotstack.r'
'grob-null.r'
'guide-colorbar.r'
'guide-legend.r'
View
@@ -243,7 +243,7 @@ S3method(cweave,list)
S3method(cweave,matrix)
S3method(dim,gtable)
S3method(drawDetails,zeroGrob)
-S3method(drawDetails,dotclustergrob)
+S3method(drawDetails,dotstackgrob)
S3method(facet_map_layout,grid)
S3method(facet_map_layout,null)
S3method(facet_map_layout,wrap)
View
@@ -13,13 +13,11 @@ stackratio = 1, dotsize = 1, ...) {
# Option to vertically align points on grid - do without stretching
# Legend appearance
# Icon
+# npc seems to refer to the entire window. What does native refer to?
GeomDotplot <- proto(Geom, {
objname <- "dotplot"
-# Is draw_groups needed?
-# draw_groups <- function(., ...) .$draw(...)
-
reparameterise <- function(., df, params) {
df$width <- df$width %||%
params$width %||% (resolution(df$x, FALSE) * 0.9)
@@ -92,40 +90,34 @@ GeomDotplot <- proto(Geom, {
c("x", "y", "size", "shape"), name = "geom_dotplot")
if (empty(data)) return(zeroGrob())
-
# Transform the data to the new coordinates
tdata <- coord_transform(coordinates, data, scales)
-
# Is there a better way of generalizing over x and y?
if (binaxis=="x") {
- dotwidthnpc <- tdata$binwidth[1] / (max(scales$x.range) - min(scales$x.range))
+ stackaxis = "y"
+ dotdianpc <- dotsize * tdata$binwidth[1] / (max(scales$x.range) - min(scales$x.range))
- # A little hack-y way to get the x=0 and y=0 in npc coordinates
+ # Get y=0 in npc coordinates
zeronpc <- coord_transform(coordinates, data.frame(y=0), scales)
- stackbaselinenpc <- zeronpc$y
- binpositions <- tdata$x
+ ynpc <- zeronpc$y
stackpositions <- data$y
} else if (binaxis=="y") {
- dotwidthnpc <- tdata$binwidth[1] / (max(scales$y.range) - min(scales$y.range))
- stackbaselinenpc <- tdata$x
- binpositions <- tdata$y
+ stackaxis = "x"
+ dotdianpc <- dotsize * tdata$binwidth[1] / (max(scales$y.range) - min(scales$y.range))
+ ynpc <- tdata$y
# This is handled differently from y because x can be grouped in factors
stackpositions <- data$xoffset
}
-
ggname(.$my_name(),
- grobTree(
- dotclusterGrob(binaxis, binpositions, stackpos=stackpositions, bintotals=tdata$count,
- baseline=stackbaselinenpc, binwidth=dotwidthnpc,
- stackdir=stackdir, stackratio=stackratio, dotsize=dotsize,
- default.units="npc",
- gp=gpar(col=alpha(tdata$colour, tdata$alpha),
- fill=alpha(tdata$fill, tdata$alpha))))
+ dotstackGrob(stackaxis, x=tdata$x, y=ynpc, dotdia=dotdianpc,
+ stackposition=stackpositions, stackratio=stackratio,
+ default.units="npc",
+ gp=gpar(col=alpha(tdata$colour, tdata$alpha),
+ fill=alpha(tdata$fill, tdata$alpha)))
)
-
}
draw_legend <- function(., data, ...) {
View
@@ -1,71 +0,0 @@
-# TODO: make sure params are correct units, etc.
-dotclusterGrob <- function (
- binaxis = "x",
- binpositions = unit(0.5, "npc"),
- stackpos = 0,
- bintotals = 0,
- baseline = unit(0.5, "npc"),
- binwidth = unit(1, "npc"),
- stackdir = "up",
- stackratio = 1,
- dotsize =1,
- default.units = "npc", name = NULL, gp = gpar(),
- vp = NULL)
-{
- if (!is.unit(binpositions))
- x <- unit(binpositions, default.units)
- if (!is.unit(baseline))
- baseline <- unit(baseline, default.units)
- if (!is.unit(binwidth))
- binwidth <- unit(binwidth, default.units)
-
- grob(binaxis = binaxis, binpositions = binpositions, stackpos = stackpos, bintotals = bintotals,
- baseline = baseline, binwidth = binwidth,
- stackdir = stackdir, stackratio = stackratio, dotsize = dotsize,
- name = name, gp = gp, vp = vp, cl = "dotclustergrob")
-}
-
-drawDetails.dotclustergrob <- function(x, recording=TRUE) {
-
- # There's a binning axis and a stacking axis. If the binning axis is x, then the
- # stacking axis is y, and vice versa.
- if(x$binaxis == "x") {
- convert_binaxis <- convertX
- convert_stackaxis <- convertY
- } else if (x$binaxis == "y") {
- convert_binaxis <- convertY
- convert_stackaxis <- convertX
- }
-
- # Some conversions to absolute coordinates are needed because in npc coordinates,
- # x and y aren't necessarily square.
- # Some of these conversions are needed so we can do arithmetic on the units
- binwidthnpc <- convert_binaxis(x$binwidth, "npc", valueOnly=TRUE)
- binwidthmm <- convert_binaxis(x$binwidth, "mm", valueOnly=TRUE)
- dotdiamm <- binwidthmm * x$dotsize
- dotheightnpc <- convert_stackaxis(unit(dotdiamm, "mm"), "npc", valueOnly=TRUE)
- stackheightnpc <- dotheightnpc * x$stackratio
-
- baselinenpc <- convert_binaxis(x$baseline, "npc", valueOnly=TRUE)
-
- # Center position of the first dot in each stack, in npc coordinates
- firstdotcenternpc <- baselinenpc
-
- # Start from 0
- bincounts <- x$bincounts-1
-
-
- if(x$binaxis == "x") {
- xpos <- x$binpositions
- ypos <- firstdotcenternpc + x$stackpos * dotheightnpc * x$stackratio
- } else if(x$binaxis == "y") {
- xpos <- firstdotcenternpc + x$stackpos * dotheightnpc * x$stackratio
- ypos <- x$binpositions
- }
-
- grid.draw(
- circleGrob(x=xpos, y=ypos,
- r=unit(dotdiamm/2, "mm"), # Need absolute measurement because if you use npc coordinates, r is relative to the smaller direction of x and y
- name=x$name, gp=x$gp, vp=x$vp),
- )
-}
View
@@ -0,0 +1,47 @@
+dotstackGrob <- function (
+ x = unit(0.5, "npc"), # x pos of the dotstack's origin
+ y = unit(0.5, "npc"), # y pos of the dotstack's origin
+ stackaxis = "y",
+ dotdia = unit(1, "npc"), # Dot diameter in the non-stack axis, should be in npc
+ stackposition = 0, # Position of each dot in the stack, relative to origin
+ stackratio = 1, # Stacking height of dots (.75 means 25% dot overlap)
+ default.units = "npc", name = NULL, gp = gpar(),
+ vp = NULL)
+{
+ if (!is.unit(x))
+ x <- unit(x, default.units)
+ if (!is.unit(y))
+ y <- unit(y, default.units)
+ if (!is.unit(dotdia))
+ dotdia <- unit(dotdia, default.units)
+ if (attr(dotdia,"unit") != "npc")
+ warning("Unit type of dotdia should be 'npc'")
+
+ grob(x = x, y = y, stackaxis = stackaxis, dotdia = dotdia,
+ stackposition = stackposition, stackratio = stackratio,
+ name = name, gp = gp, vp = vp, cl = "dotstackgrob")
+}
+
+drawDetails.dotstackgrob <- function(x, recording=TRUE) {
+
+ # Need absolute coordinates because when using npc coords with circleGrob,
+ # the radius is in the _smaller_ of the two axes. We need the radius
+ # to be defined in terms of the non-stack axis.
+ xmm <- convertX(x$x, "mm", valueOnly=TRUE)
+ ymm <- convertY(x$y, "mm", valueOnly=TRUE)
+
+ if(x$stackaxis == "x") {
+ dotdiamm <- convertY(x$dotdia, "mm", valueOnly=TRUE)
+ xpos <- xmm + x$stackposition * dotdiamm * x$stackratio
+ ypos <- ymm
+ } else if(x$stackaxis == "y") {
+ dotdiamm <- convertX(x$dotdia, "mm", valueOnly=TRUE)
+ xpos <- xmm
+ ypos <- ymm + x$stackposition * dotdiamm * x$stackratio
+ }
+
+ grid.draw(
+ circleGrob(x=xpos, y=ypos, r=dotdiamm/2, default.unit="mm",
+ name=x$name, gp=x$gp, vp=x$vp),
+ )
+}

0 comments on commit 5a5fefc

Please sign in to comment.