[med-svn] [r-cran-hexbin] 06/08: New upstream version 1.27.1
Andreas Tille
tille at debian.org
Thu Oct 19 16:40:16 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-hexbin.
commit 11aaf5242e972bb859c50698aff8c318eb203da4
Author: Andreas Tille <tille at debian.org>
Date: Thu Oct 19 18:36:26 2017 +0200
New upstream version 1.27.1
---
ChangeLog | 65 ++++
DESCRIPTION | 25 ++
MD5 | 77 +++++
NAMESPACE | 93 +++++
R/BTC.R | 268 +++++++++++++++
R/BTY.R | 266 +++++++++++++++
R/HO.R | 267 +++++++++++++++
R/LINGRAY.R | 111 ++++++
R/LOCS.R | 266 +++++++++++++++
R/MAG.R | 266 +++++++++++++++
R/RB.R | 266 +++++++++++++++
R/grid.hexagons.R | 366 ++++++++++++++++++++
R/grid.hexlegend.R | 157 +++++++++
R/hbox.R | 83 +++++
R/hdiffplot.R | 331 ++++++++++++++++++
R/hexPlotMA.R | 196 +++++++++++
R/hexViewport.R | 253 ++++++++++++++
R/hexbin.s4.R | 355 +++++++++++++++++++
R/hexbinList.R | 106 ++++++
R/hexbinplot.R | 777 ++++++++++++++++++++++++++++++++++++++++++
R/hexpanel.R | 37 ++
R/hexplom.R | 352 +++++++++++++++++++
R/hexutil.R | 122 +++++++
R/lattice.R | 744 ++++++++++++++++++++++++++++++++++++++++
R/smoothHexbin.R | 46 +++
README.md | 5 +
TODO | 36 ++
build/vignette.rds | Bin 0 -> 267 bytes
data/NHANES.rda | Bin 0 -> 162590 bytes
debian/README.test | 8 -
debian/changelog | 11 -
debian/compat | 1 -
debian/control | 24 --
debian/copyright | 36 --
debian/docs | 1 -
debian/examples | 1 -
debian/rules | 6 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 18 -
debian/watch | 2 -
inst/doc/hexagon_binning.R | 233 +++++++++++++
inst/doc/hexagon_binning.Rnw | 498 +++++++++++++++++++++++++++
inst/doc/hexagon_binning.pdf | Bin 0 -> 386701 bytes
man/NHANES.Rd | 52 +++
man/colramp.Rd | 60 ++++
man/erode.hexbin.Rd | 86 +++++
man/getHMedian.Rd | 34 ++
man/gplot.hexbin.Rd | 145 ++++++++
man/grid.hexagons.Rd | 199 +++++++++++
man/grid.hexlegend.Rd | 81 +++++
man/hboxplot.Rd | 98 ++++++
man/hcell2xy.Rd | 63 ++++
man/hcell2xyInt.Rd | 47 +++
man/hdiffplot.Rd | 134 ++++++++
man/hexGraphPaper.Rd | 66 ++++
man/hexList.Rd | 46 +++
man/hexMA.loess.Rd | 42 +++
man/hexTapply.Rd | 58 ++++
man/hexVP-class.Rd | 76 +++++
man/hexVP.abline.Rd | 44 +++
man/hexViewport.Rd | 55 +++
man/hexbin.Rd | 110 ++++++
man/hexbinplot.Rd | 222 ++++++++++++
man/hexplom.Rd | 96 ++++++
man/hexpolygon.Rd | 78 +++++
man/hsmooth-methods.Rd | 28 ++
man/inout.hex.Rd | 31 ++
man/list2hexList.Rd | 25 ++
man/old-classes.Rd | 24 ++
man/optShape.Rd | 50 +++
man/panel.hexboxplot.Rd | 49 +++
man/panel.hexgrid.Rd | 21 ++
man/panel.hexloess.Rd | 41 +++
man/plotMAhex.Rd | 133 ++++++++
man/pushHexport.Rd | 29 ++
man/smooth.hexbin.Rd | 84 +++++
src/hbin.f | 88 +++++
src/hcell.f | 62 ++++
src/herode.f | 245 +++++++++++++
src/hsm.f | 114 +++++++
tests/hdiffplot.R | 36 ++
tests/hdiffplot.Rout.save | 155 +++++++++
tests/hray.R | 31 ++
tests/hray.Rout.save | 52 +++
tests/large.R | 39 +++
tests/large.Rout.save | 60 ++++
tests/viewp-ex.R | 21 ++
tests/viewp-ex.Rout.save | 42 +++
vignettes/hexagon_binning.Rnw | 502 +++++++++++++++++++++++++++
90 files changed, 10521 insertions(+), 112 deletions(-)
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..c87ce2f
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,65 @@
+2009-08-09 Nicholas Lewin-Koh <nikko at hailmail.net>
+ * R/grid.hexagons.R removed break statements, switch fails. Cow
+ lattice and centroid can ramp colors. Bug submitted by Ricardo
+ DeLemos" <lemos at soe.ucsc.edu>
+ * man/hexVP-class.Rd Shape slot was not documented
+
+2009-02-26 Nicholas Lewin-Koh <nikko at hailmail.net>
+ * R/grid.hexagons.R fixed bad if construct
+ * R/hexbin.s4.R changed xlab and ylab signatures in class hexbin
+ from character to vector, patch submitted by Don Armstrong <don at donarmstrong.com>
+
+2008-04-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.13.4
+
+ * man/*.Rd: fixes to several man pages;
+ note that gplot.hexbin() now is *deprecated* !
+
+2008-03-18 Patrick Aboyoun <paboyoun at fhcrc.org>
+
+ * man/panel.hexboxplot, man/panel.hexgrid, man/panel.hexloess: Added more information to man files.
+ * R/hexbinplot.R (panel.hexboxplot): removed unused singles argument.
+
+2008-03-12 Patrick Aboyoun <paboyoun at fhcrc.org>
+
+ * R/hexViewport.R (hexVP.abline): Fixed the handling of non-model objects as input.
+
+2008-02-28 Patrick Aboyoun <paboyoun at fhcrc.org>
+
+ * R/hexPlotMA.R (plotMAhex): Require users to specify status explicitly
+ rather than as the component MA$genes$Status
+ * R/hexPlotMA.R (plotMAhex): Replaced support of Biobase class exprSet with
+ ExpressionSet
+
+2006-09-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * NAMESPACE: add full list of colorspace dependencies
+
+2005-07-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/hexViewport.R (smartBnds): some rationalization
+ * R/hexViewport.R (rname): dito
+
+2005-07-19 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.3.1 (not to confuse with the previous one).
+
+ * man/gplot.hexbin.Rd: fix typo and usage for S4method
+
+ * R/hexPlotMA.R (hexMA.loess): add argument 'n'
+
+ * R/hexViewport.R (hexVP.loess): add argument 'n'; other "white
+ space cosmetic" in file
+
+2005-10-21 Nicholas Lewin-Koh <nikko at hailmail.net>
+
+ * added Deepayan Sarkar's hexbinplot.R function for lattice hexbin
+ plots
+
+ * Added my Hexplom function based on Deepayan's code
+
+2005-10-27 Nicholas Lewin-Koh <nikko at hailmail.net>
+
+ * Added more panel functions, for hexboxplots and hdiffplots.
+
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..8fd91b5
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,25 @@
+Package: hexbin
+Version: 1.27.1
+Date: 2015-08-19
+Title: Hexagonal Binning Routines
+Author: Dan Carr <dcarr at voxel.galaxy.gmu.edu>, ported by Nicholas
+ Lewin-Koh and Martin Maechler <maechler at stat.math.ethz.ch>,
+ contains copies of lattice functions written by Deepayan Sarkar
+ <deepayan.sarkar at r-project.org>
+Maintainer: Edzer Pebesma <edzer.pebesma at uni-muenster.de>
+Depends: R (>= 2.0.1), methods
+Imports: lattice, grid, graphics, grDevices, stats, utils
+Suggests: marray, affy, Biobase, limma
+Description: Binning and plotting functions for hexagonal bins. Now
+ uses and relies on grid graphics and formal (S4) classes and
+ methods.
+Collate: lattice.R BTC.R BTY.R grid.hexagons.R grid.hexlegend.R hbox.R
+ hdiffplot.R hexbinList.R hexbinplot.R hexbin.s4.R hexpanel.R
+ hexplom.R hexPlotMA.R hexutil.R hexViewport.R HO.R LINGRAY.R
+ LOCS.R MAG.R RB.R smoothHexbin.R
+License: GPL-2
+NeedsCompilation: yes
+URL: http://github.com/edzer/hexbin
+Packaged: 2015-08-19 15:11:53 UTC; edzer
+Repository: CRAN
+Date/Publication: 2015-08-19 17:28:20
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..fdd6c73
--- /dev/null
+++ b/MD5
@@ -0,0 +1,77 @@
+b8c6e7f6b0230cdf61f0976d387c7a44 *ChangeLog
+58f0420f8288b4faae52aba21669bc3d *DESCRIPTION
+9129a733a21f780d50b1c3bb85da0047 *NAMESPACE
+98a77d0235bb074f09aa7675358b8650 *R/BTC.R
+b8083617bec9ef2a20bf2fb31d1f50cb *R/BTY.R
+def8a3ae791d6214f8093069780971a3 *R/HO.R
+e54503901b17f4b00ab192bef093ff18 *R/LINGRAY.R
+9220834650597d3f9a3c2f5a38fb2fc6 *R/LOCS.R
+47006284b4bc42824409e49cd3ebb6e7 *R/MAG.R
+c25363a22b3f824d1f25997179b74434 *R/RB.R
+97262cc9f616661bf71e4686225f6c17 *R/grid.hexagons.R
+cd88d10aa75a6666b296efff0ac1f355 *R/grid.hexlegend.R
+503b110bf985d5c12a0d514c333dc81e *R/hbox.R
+ad4a901fb8fc48deb4f76ad3d797ecd9 *R/hdiffplot.R
+d53fcb4dabb71c0154e881648c6b13da *R/hexPlotMA.R
+e5cb8c5f3ba8f183d4c69e50f153f845 *R/hexViewport.R
+48ab7518d22b3310dab41acae327c743 *R/hexbin.s4.R
+5d66d35fa92d45957684ee3375513e28 *R/hexbinList.R
+ae5724baa7c3661621ed0018287fc6ca *R/hexbinplot.R
+53e8c6ea014e06b21e56b8e447a0dad5 *R/hexpanel.R
+249d47000fdc8b641cf6ed2ee6f640bb *R/hexplom.R
+0b7181a5ae4cbc780f46041886fc80e8 *R/hexutil.R
+acf4489ea175f01eb1659a420183e155 *R/lattice.R
+449d6bbfb6927f39383b586ffce19eb1 *R/smoothHexbin.R
+408e6e0599f15c991715933ddd85400f *README.md
+53e586900ba0c452c12ec7aed3d20295 *TODO
+dd1765c586720d0a4c7c5064fce7da74 *build/vignette.rds
+cfa9343134507d8eaf7386167ea1243d *data/NHANES.rda
+a6e0f6f67abc1c4d94ad6b2d33860fe2 *inst/doc/hexagon_binning.R
+ed9dbcabcbb9240445d6dac2de22ba5f *inst/doc/hexagon_binning.Rnw
+4550e584d1ad491edcb547bd4ec28845 *inst/doc/hexagon_binning.pdf
+3b3cb098160c79abc4d739397d315ff3 *man/NHANES.Rd
+bfc5169b22c653bb5912e9c3e92f3207 *man/colramp.Rd
+94a1639600897389f489b6b836362d82 *man/erode.hexbin.Rd
+47a11326b5056014da626fe8c3c5b8e8 *man/getHMedian.Rd
+651ab732e881463b6516824c162e35ac *man/gplot.hexbin.Rd
+4f14ff188dcc89ced1434511b0da5dc0 *man/grid.hexagons.Rd
+6e12f30832b4d71515a91bb8c448049d *man/grid.hexlegend.Rd
+5f2695c8af33d84b154a61e3463859e9 *man/hboxplot.Rd
+eb4f91c7c9c4482122d7c9ee209e93b6 *man/hcell2xy.Rd
+9a215a3b0ff1077d865688a5d9a40921 *man/hcell2xyInt.Rd
+29e7649124c53711586904d9c556f53e *man/hdiffplot.Rd
+f49d784dfab4e373b90f6399c511235f *man/hexGraphPaper.Rd
+cbc932856dc584b571a425fe4b7ec414 *man/hexList.Rd
+e674cd78f6a724d5613ddc81c6983b10 *man/hexMA.loess.Rd
+15c9da95418b954cc0feeec69eff71cb *man/hexTapply.Rd
+18c065f4f0c331f17604d467cf00b305 *man/hexVP-class.Rd
+9c7707d15c10f959d35a0714dc65b667 *man/hexVP.abline.Rd
+1f4b3a61121669b0bccb6fdc4e5cd836 *man/hexViewport.Rd
+92c69549ef7b876c66bd362e17216c44 *man/hexbin.Rd
+22b3b2d3c0f376d10a284f34eb647229 *man/hexbinplot.Rd
+37d121666c32d6396a680761b201162d *man/hexplom.Rd
+13241d553371e3923f6647b3a7deea77 *man/hexpolygon.Rd
+85e71d3e73900af44b7e88ead81c033c *man/hsmooth-methods.Rd
+7ea0b41a11cca81d2093012166c35101 *man/inout.hex.Rd
+fe9d76fede0a6c4727a6efb5c2e3c861 *man/list2hexList.Rd
+087875e158137bd1494533ffc2078ebd *man/old-classes.Rd
+6ed5394a980386786a41eaffd7dd5c8a *man/optShape.Rd
+9f23953a55209099110283ec98343438 *man/panel.hexboxplot.Rd
+3d36abbaab3ec18876e2288151da11f1 *man/panel.hexgrid.Rd
+d62970352d19f6785e76d6c68f3ba79e *man/panel.hexloess.Rd
+9da0d7245fb3f734cc0f07cb4f2aa123 *man/plotMAhex.Rd
+fc017f52b40dc804a41ea45305c840d8 *man/pushHexport.Rd
+febf2f7e1ad56316da2058e260732d7a *man/smooth.hexbin.Rd
+886e2efe62994815b8acfcc78c7ad81b *src/hbin.f
+470ef863da306fb9d0955b3cdb0b2ce0 *src/hcell.f
+f8fb4b9ec5a1dbc174102d40377ce885 *src/herode.f
+719cbe239d3f98da12bd7f489ab6c197 *src/hsm.f
+ddcf0653ed6863dd0260e1f58349356a *tests/hdiffplot.R
+66fb0e8391d2b94fbdb2633ac4d70e21 *tests/hdiffplot.Rout.save
+efe67770786c28cc2bfceef357376f7a *tests/hray.R
+24021c6251d46ad71065e3705e04479d *tests/hray.Rout.save
+6dca74e0501c54cede56d657a1c0c632 *tests/large.R
+98321f01b4ed346aa059aec1aa3c637a *tests/large.Rout.save
+f94ffad94528308a3483bf6f4088fa70 *tests/viewp-ex.R
+53478aa4cafb6fb935b12b7c982a667d *tests/viewp-ex.Rout.save
+d6c9a9e05a1165a6e0da8b309303082b *vignettes/hexagon_binning.Rnw
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..152789f
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,93 @@
+useDynLib(hexbin)
+
+
+import(methods)
+import(grid) ## too many things from grid
+import(lattice) ## too many things from lattice
+importFrom(graphics, plot, polygon)
+importFrom(grDevices, col2rgb, gray, grey, hsv, rgb, rgb2hsv,
+ xy.coords)
+importFrom(stats, coef, density, IQR, loess, loess.control, median,
+ predict, update)
+importFrom(utils, modifyList, str)
+
+
+## Generics and functions defined in this package
+export(
+ "erode",
+ "erode.hexbin",
+ "getHMedian",
+## document those; the method aliases are there:
+## "getFig", "getMargins", "getPlt", "getXscale", "getYscale",
+ "gplot.hexbin",
+ "grid.hexagons",
+ "grid.hexlegend",
+ "hboxplot",
+ "hcell2xy",
+ "hexbin",
+ "hexcoords",
+ "hexList",
+ "hexpolygon",
+ "hexViewport",
+ "hexVP.abline",
+ "plotMAhex",
+ "hexVP.loess",
+ "hexMA.loess",
+ "hsmooth",
+ "list2hexList",
+ "pushHexport",
+ "smooth.hexbin",
+ "hdiffplot", # but not all the helpers in ./R/hdiffplot.R
+ ## Stuff in hexutils
+ "hcell2xyInt",
+ "hgridcent",
+ "hexGraphPaper",
+ "hexTapply",
+ "optShape",
+ "inout.hex",
+ ## color stuff
+ "BTC", "BTY", "LinGray", "LinOCS", "heat.ob", "magent","plinrain",
+
+ ## Lattice stuff:
+
+ ## high-level functions
+ "hexbinplot", "hexplom",
+
+ ## panel functions
+ "panel.hexbinplot", "panel.hexplom", "panel.hexboxplot",
+ "panel.hexgrid","panel.hexloess",
+
+ ## utilities
+ "hexlegendGrob")
+
+
+## S3 methods for lattice-type functions
+
+S3method("hexbinplot", "formula")
+S3method("hexplom", "formula")
+S3method("hexplom", "matrix")
+S3method("hexplom", "data.frame")
+
+
+
+exportClasses("hexbin",
+ "erodebin",
+ "smoothbin",
+ "hexVP",
+ # could/should we keep this 'private' (?) :
+ "integer or NULL",
+ "hexbinList"
+ )
+
+exportMethods(
+ "erode",
+## undocumented: "getFig", "getMargins", "getPlt", "getXscale", "getYscale",
+ "hsmooth",
+
+ "plot",
+ "summary",
+ "show",
+ "coerce"
+ )
+
+
diff --git a/R/BTC.R b/R/BTC.R
new file mode 100644
index 0000000..5457fd8
--- /dev/null
+++ b/R/BTC.R
@@ -0,0 +1,268 @@
+BTC <- function(n, beg = 1, end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(0,0,0),
+ c(0,0,40),
+ c(0,4,56),
+ c(0,9,61),
+ c(0,12,64),
+ c(0,14,66),
+ c(0,17,69),
+ c(0,20,73),
+ c(0,22,74),
+ c(0,25,78),
+ c(0,27,79),
+ c(0,30,83),
+ c(0,31,85),
+ c(0,33,86),
+ c(0,36,90),
+ c(0,38,91),
+ c(0,39,93),
+ c(0,41,95),
+ c(0,43,96),
+ c(0,46,100),
+ c(0,47,102),
+ c(0,49,103),
+ c(0,51,105),
+ c(0,52,107),
+ c(0,54,108),
+ c(0,55,110),
+ c(0,57,112),
+ c(0,57,112),
+ c(0,58,113),
+ c(0,60,115),
+ c(0,62,117),
+ c(0,63,119),
+ c(0,65,120),
+ c(0,66,122),
+ c(0,68,124),
+ c(0,70,125),
+ c(0,71,127),
+ c(0,73,129),
+ c(0,73,129),
+ c(0,74,130),
+ c(0,76,132),
+ c(0,78,134),
+ c(0,79,136),
+ c(0,81,137),
+ c(0,82,139),
+ c(0,84,141),
+ c(0,86,142),
+ c(0,87,144),
+ c(0,89,146),
+ c(0,90,147),
+ c(0,92,149),
+ c(0,94,151),
+ c(0,94,151),
+ c(0,95,153),
+ c(0,97,154),
+ c(0,98,156),
+ c(0,100,158),
+ c(0,102,159),
+ c(0,103,161),
+ c(0,105,163),
+ c(0,106,164),
+ c(0,108,166),
+ c(0,109,168),
+ c(0,111,170),
+ c(0,113,171),
+ c(0,114,173),
+ c(0,116,175),
+ c(0,117,176),
+ c(0,119,178),
+ c(0,121,180),
+ c(0,121,180),
+ c(0,122,181),
+ c(0,124,183),
+ c(0,125,185),
+ c(0,127,187),
+ c(0,129,188),
+ c(0,130,190),
+ c(0,132,192),
+ c(0,133,193),
+ c(0,135,195),
+ c(0,137,197),
+ c(0,138,198),
+ c(0,140,200),
+ c(0,141,202),
+ c(0,143,204),
+ c(0,143,204),
+ c(0,145,205),
+ c(0,146,207),
+ c(0,148,209),
+ c(0,149,210),
+ c(0,151,212),
+ c(0,153,214),
+ c(0,154,215),
+ c(0,156,217),
+ c(0,157,219),
+ c(0,159,221),
+ c(0,160,222),
+ c(0,160,222),
+ c(0,162,224),
+ c(0,164,226),
+ c(0,165,227),
+ c(0,167,229),
+ c(0,168,231),
+ c(0,170,232),
+ c(0,172,234),
+ c(0,173,236),
+ c(0,175,238),
+ c(0,175,238),
+ c(0,176,239),
+ c(0,178,241),
+ c(0,180,243),
+ c(0,181,244),
+ c(0,183,246),
+ c(2,184,248),
+ c(4,186,249),
+ c(4,186,249),
+ c(4,186,249),
+ c(6,188,251),
+ c(6,188,251),
+ c(9,189,253),
+ c(9,189,253),
+ c( 11,191,255),
+ c( 11,191,255),
+ c( 13,192,255),
+ c( 13,192,255),
+ c( 13,192,255),
+ c( 16,194,255),
+ c( 18,196,255),
+ c( 20,197,255),
+ c( 20,197,255),
+ c( 23,199,255),
+ c( 25,200,255),
+ c( 27,202,255),
+ c( 30,204,255),
+ c( 32,205,255),
+ c( 34,207,255),
+ c( 37,208,255),
+ c( 37,208,255),
+ c( 39,210,255),
+ c( 41,211,255),
+ c( 44,213,255),
+ c( 46,215,255),
+ c( 48,216,255),
+ c( 51,218,255),
+ c( 53,219,255),
+ c( 53,219,255),
+ c( 55,221,255),
+ c( 57,223,255),
+ c( 60,224,255),
+ c( 62,226,255),
+ c( 64,227,255),
+ c( 67,229,255),
+ c( 67,229,255),
+ c( 69,231,255),
+ c( 71,232,255),
+ c( 74,234,255),
+ c( 76,235,255),
+ c( 78,237,255),
+ c( 81,239,255),
+ c( 81,239,255),
+ c( 83,240,255),
+ c( 85,242,255),
+ c( 88,243,255),
+ c( 90,245,255),
+ c( 92,247,255),
+ c( 95,248,255),
+ c( 95,248,255),
+ c( 97,250,255),
+ c( 99,251,255),
+ c(102,253,255),
+ c(104,255,255),
+ c(106,255,255),
+ c(106,255,255),
+ c(108,255,255),
+ c(111,255,255),
+ c(113,255,255),
+ c(115,255,255),
+ c(115,255,255),
+ c(118,255,255),
+ c(120,255,255),
+ c(122,255,255),
+ c(122,255,255),
+ c(125,255,255),
+ c(127,255,255),
+ c(129,255,255),
+ c(129,255,255),
+ c(132,255,255),
+ c(134,255,255),
+ c(136,255,255),
+ c(136,255,255),
+ c(139,255,255),
+ c(141,255,255),
+ c(143,255,255),
+ c(143,255,255),
+ c(146,255,255),
+ c(148,255,255),
+ c(150,255,255),
+ c(150,255,255),
+ c(153,255,255),
+ c(155,255,255),
+ c(155,255,255),
+ c(157,255,255),
+ c(159,255,255),
+ c(159,255,255),
+ c(162,255,255),
+ c(164,255,255),
+ c(164,255,255),
+ c(166,255,255),
+ c(169,255,255),
+ c(171,255,255),
+ c(171,255,255),
+ c(173,255,255),
+ c(176,255,255),
+ c(176,255,255),
+ c(178,255,255),
+ c(180,255,255),
+ c(180,255,255),
+ c(183,255,255),
+ c(185,255,255),
+ c(185,255,255),
+ c(187,255,255),
+ c(190,255,255),
+ c(190,255,255),
+ c(192,255,255),
+ c(194,255,255),
+ c(197,255,255),
+ c(197,255,255),
+ c(199,255,255),
+ c(201,255,255),
+ c(204,255,255),
+ c(204,255,255),
+ c(206,255,255),
+ c(208,255,255),
+ c(210,255,255),
+ c(210,255,255),
+ c(213,255,255),
+ c(215,255,255),
+ c(217,255,255),
+ c(217,255,255),
+ c(220,255,255),
+ c(222,255,255),
+ c(224,255,255),
+ c(227,255,255),
+ c(229,255,255),
+ c(229,255,255),
+ c(231,255,255),
+ c(234,255,255),
+ c(236,255,255),
+ c(238,255,255),
+ c(241,255,255),
+ c(243,255,255),
+ c(243,255,255),
+ c(245,255,255),
+ c(248,255,255),
+ c(250,255,255),
+ c(255,255,255))[ round(seq(beg,end, length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
+
+
diff --git a/R/BTY.R b/R/BTY.R
new file mode 100644
index 0000000..954c2a3
--- /dev/null
+++ b/R/BTY.R
@@ -0,0 +1,266 @@
+BTY <- function(n, beg = 1, end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(7,7,254),
+ c(23,23,252),
+ c(30,30,250),
+ c(36,36,248),
+ c(40,40,247),
+ c(44,44,245),
+ c(47,47,243),
+ c(50,50,242),
+ c(52,52,240),
+ c(55,55,239),
+ c(57,57,238),
+ c(59,59,236),
+ c(61,61,235),
+ c(63,63,234),
+ c(65,65,233),
+ c(66,66,231),
+ c(68,68,230),
+ c(69,69,229),
+ c(71,71,228),
+ c(72,72,227),
+ c(74,74,226),
+ c(75,75,225),
+ c(76,76,225),
+ c(78,78,224),
+ c(79,79,223),
+ c(80,80,222),
+ c(81,81,221),
+ c(82,82,221),
+ c(84,84,220),
+ c(85,85,219),
+ c(86,86,218),
+ c(87,87,218),
+ c(88,88,217),
+ c(89,89,216),
+ c(90,90,216),
+ c(91,91,215),
+ c(92,92,214),
+ c(93,93,214),
+ c(94,94,213),
+ c(95,95,213),
+ c(96,96,212),
+ c(97,97,212),
+ c(98,98,211),
+ c(98,98,210),
+ c(99,99,210),
+ c(100,100,209),
+ c(101,101,209),
+ c(102,102,208),
+ c(103,103,208),
+ c(104,104,208),
+ c(105,105,207),
+ c(105,105,207),
+ c(106,106,206),
+ c(107,107,206),
+ c(108,108,205),
+ c(109,109,205),
+ c(110,110,204),
+ c(110,110,204),
+ c(111,111,204),
+ c(112,112,203),
+ c(113,113,203),
+ c(114,114,202),
+ c(114,114,202),
+ c(115,115,202),
+ c(116,116,201),
+ c(117,117,201),
+ c(118,118,200),
+ c(118,118,200),
+ c(119,119,200),
+ c(120,120,199),
+ c(121,121,199),
+ c(121,121,199),
+ c(122,122,198),
+ c(123,123,198),
+ c(124,124,198),
+ c(124,124,197),
+ c(125,125,197),
+ c(126,126,197),
+ c(127,127,196),
+ c(128,128,196),
+ c(128,128,195),
+ c(129,129,195),
+ c(130,130,195),
+ c(130,130,194),
+ c(131,131,194),
+ c(132,132,194),
+ c(133,133,193),
+ c(133,133,193),
+ c(134,134,193),
+ c(135,135,192),
+ c(136,136,192),
+ c(136,136,192),
+ c(137,137,191),
+ c(138,138,191),
+ c(139,139,191),
+ c(139,139,190),
+ c(140,140,190),
+ c(141,141,190),
+ c(142,142,189),
+ c(142,142,189),
+ c(143,143,189),
+ c(144,144,188),
+ c(144,144,188),
+ c(145,145,188),
+ c(146,146,187),
+ c(147,147,187),
+ c(147,147,187),
+ c(148,148,186),
+ c(149,149,186),
+ c(149,149,186),
+ c(150,150,185),
+ c(151,151,185),
+ c(152,152,185),
+ c(152,152,184),
+ c(153,153,184),
+ c(154,154,184),
+ c(154,154,183),
+ c(155,155,183),
+ c(156,156,182),
+ c(157,157,182),
+ c(157,157,182),
+ c(158,158,181),
+ c(159,159,181),
+ c(159,159,181),
+ c(160,160,180),
+ c(161,161,180),
+ c(162,162,180),
+ c(162,162,179),
+ c(163,163,179),
+ c(164,164,178),
+ c(164,164,178),
+ c(165,165,178),
+ c(166,166,177),
+ c(167,167,177),
+ c(167,167,176),
+ c(168,168,176),
+ c(169,169,176),
+ c(169,169,175),
+ c(170,170,175),
+ c(171,171,174),
+ c(172,172,174),
+ c(172,172,173),
+ c(173,173,173),
+ c(174,174,173),
+ c(174,174,172),
+ c(175,175,172),
+ c(176,176,171),
+ c(177,177,171),
+ c(177,177,170),
+ c(178,178,170),
+ c(179,179,169),
+ c(179,179,169),
+ c(180,180,168),
+ c(181,181,168),
+ c(181,181,167),
+ c(182,182,167),
+ c(183,183,166),
+ c(184,184,166),
+ c(184,184,165),
+ c(185,185,165),
+ c(186,186,164),
+ c(186,186,164),
+ c(187,187,163),
+ c(188,188,163),
+ c(189,189,162),
+ c(189,189,162),
+ c(190,190,161),
+ c(191,191,161),
+ c(191,191,160),
+ c(192,192,159),
+ c(193,193,159),
+ c(194,194,158),
+ c(194,194,158),
+ c(195,195,157),
+ c(196,196,157),
+ c(196,196,156),
+ c(197,197,155),
+ c(198,198,155),
+ c(199,199,154),
+ c(199,199,153),
+ c(200,200,153),
+ c(201,201,152),
+ c(201,201,151),
+ c(202,202,151),
+ c(203,203,150),
+ c(204,204,149),
+ c(204,204,149),
+ c(205,205,148),
+ c(206,206,147),
+ c(206,206,146),
+ c(207,207,146),
+ c(208,208,145),
+ c(209,209,144),
+ c(209,209,143),
+ c(210,210,143),
+ c(211,211,142),
+ c(211,211,141),
+ c(212,212,140),
+ c(213,213,139),
+ c(214,214,138),
+ c(214,214,138),
+ c(215,215,137),
+ c(216,216,136),
+ c(216,216,135),
+ c(217,217,134),
+ c(218,218,133),
+ c(219,219,132),
+ c(219,219,131),
+ c(220,220,130),
+ c(221,221,129),
+ c(221,221,128),
+ c(222,222,127),
+ c(223,223,126),
+ c(224,224,125),
+ c(224,224,124),
+ c(225,225,123),
+ c(226,226,122),
+ c(226,226,121),
+ c(227,227,119),
+ c(228,228,118),
+ c(229,229,117),
+ c(229,229,116),
+ c(230,230,114),
+ c(231,231,113),
+ c(232,232,112),
+ c(232,232,110),
+ c(233,233,109),
+ c(234,234,107),
+ c(234,234,106),
+ c(235,235,104),
+ c(236,236,103),
+ c(237,237,101),
+ c(237,237,100),
+ c(238,238,98),
+ c(239,239,96),
+ c(239,239,94),
+ c(240,240,92),
+ c(241,241,91),
+ c(242,242,89),
+ c(242,242,86),
+ c(243,243,84),
+ c(244,244,82),
+ c(245,245,80),
+ c(245,245,77),
+ c(246,246,74),
+ c(247,247,72),
+ c(247,247,69),
+ c(248,248,65),
+ c(249,249,62),
+ c(250,250,58),
+ c(250,250,54),
+ c(251,251,49),
+ c(252,252,44),
+ c(253,253,37),
+ c(253,253,28),
+ c(254,254,13))[ round(seq(beg,end, length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
diff --git a/R/HO.R b/R/HO.R
new file mode 100644
index 0000000..c73a470
--- /dev/null
+++ b/R/HO.R
@@ -0,0 +1,267 @@
+heat.ob <- function(n,beg = 1,end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(0, 0, 0),
+ c(35, 0, 0),
+ c(52, 0, 0),
+ c(60, 0, 0),
+ c(63, 1, 0),
+ c(64, 2, 0),
+ c(68, 5, 0),
+ c(69, 6, 0),
+ c(72, 8, 0),
+ c(74,10, 0),
+ c(77,12, 0),
+ c(78,14, 0),
+ c(81,16, 0),
+ c(83,17, 0),
+ c(85,19, 0),
+ c(86,20, 0),
+ c(89,22, 0),
+ c(91,24, 0),
+ c(92,25, 0),
+ c(94,26, 0),
+ c(95,28, 0),
+ c(98,30, 0),
+ c(100,31, 0),
+ c(102,33, 0),
+ c(103,34, 0),
+ c(105,35, 0),
+ c(106,36, 0),
+ c(108,38, 0),
+ c(109,39, 0),
+ c(111,40, 0),
+ c(112,42, 0),
+ c(114,43, 0),
+ c(115,44, 0),
+ c(117,45, 0),
+ c(119,47, 0),
+ c(119,47, 0),
+ c(120,48, 0),
+ c(122,49, 0),
+ c(123,51, 0),
+ c(125,52, 0),
+ c(125,52, 0),
+ c(126,53, 0),
+ c(128,54, 0),
+ c(129,56, 0),
+ c(129,56, 0),
+ c(131,57, 0),
+ c(132,58, 0),
+ c(134,59, 0),
+ c(134,59, 0),
+ c(136,61, 0),
+ c(137,62, 0),
+ c(137,62, 0),
+ c(139,63, 0),
+ c(139,63, 0),
+ c(140,65, 0),
+ c(142,66, 0),
+ c(142,66, 0),
+ c(143,67, 0),
+ c(143,67, 0),
+ c(145,68, 0),
+ c(145,68, 0),
+ c(146,70, 0),
+ c(146,70, 0),
+ c(148,71, 0),
+ c(148,71, 0),
+ c(149,72, 0),
+ c(149,72, 0),
+ c(151,73, 0),
+ c(151,73, 0),
+ c(153,75, 0),
+ c(153,75, 0),
+ c(154,76, 0),
+ c(154,76, 0),
+ c(154,76, 0),
+ c(156,77, 0),
+ c(156,77, 0),
+ c(157,79, 0),
+ c(157,79, 0),
+ c(159,80, 0),
+ c(159,80, 0),
+ c(159,80, 0),
+ c(160,81, 0),
+ c(160,81, 0),
+ c(162,82, 0),
+ c(162,82, 0),
+ c(163,84, 0),
+ c(163,84, 0),
+ c(165,85, 0),
+ c(165,85, 0),
+ c(166,86, 0),
+ c(166,86, 0),
+ c(166,86, 0),
+ c(168,87, 0),
+ c(168,87, 0),
+ c(170,89, 0),
+ c(170,89, 0),
+ c(171,90, 0),
+ c(171,90, 0),
+ c(173,91, 0),
+ c(173,91, 0),
+ c(174,93, 0),
+ c(174,93, 0),
+ c(176,94, 0),
+ c(176,94, 0),
+ c(177,95, 0),
+ c(177,95, 0),
+ c(179,96, 0),
+ c(179,96, 0),
+ c(180,98, 0),
+ c(182,99, 0),
+ c(182,99, 0),
+ c(183,100, 0),
+ c(183,100, 0),
+ c(185,102, 0),
+ c(185,102, 0),
+ c(187,103, 0),
+ c(187,103, 0),
+ c(188,104, 0),
+ c(188,104, 0),
+ c(190,105, 0),
+ c(191,107, 0),
+ c(191,107, 0),
+ c(193,108, 0),
+ c(193,108, 0),
+ c(194,109, 0),
+ c(196,110, 0),
+ c(196,110, 0),
+ c(197,112, 0),
+ c(197,112, 0),
+ c(199,113, 0),
+ c(200,114, 0),
+ c(200,114, 0),
+ c(202,116, 0),
+ c(202,116, 0),
+ c(204,117, 0),
+ c(205,118, 0),
+ c(205,118, 0),
+ c(207,119, 0),
+ c(208,121, 0),
+ c(208,121, 0),
+ c(210,122, 0),
+ c(211,123, 0),
+ c(211,123, 0),
+ c(213,124, 0),
+ c(214,126, 0),
+ c(214,126, 0),
+ c(216,127, 0),
+ c(217,128, 0),
+ c(217,128, 0),
+ c(219,130, 0),
+ c(221,131, 0),
+ c(221,131, 0),
+ c(222,132, 0),
+ c(224,133, 0),
+ c(224,133, 0),
+ c(225,135, 0),
+ c(227,136, 0),
+ c(227,136, 0),
+ c(228,137, 0),
+ c(230,138, 0),
+ c(230,138, 0),
+ c(231,140, 0),
+ c(233,141, 0),
+ c(233,141, 0),
+ c(234,142, 0),
+ c(236,144, 0),
+ c(236,144, 0),
+ c(238,145, 0),
+ c(239,146, 0),
+ c(241,147, 0),
+ c(241,147, 0),
+ c(242,149, 0),
+ c(244,150, 0),
+ c(244,150, 0),
+ c(245,151, 0),
+ c(247,153, 0),
+ c(247,153, 0),
+ c(248,154, 0),
+ c(250,155, 0),
+ c(251,156, 0),
+ c(251,156, 0),
+ c(253,158, 0),
+ c(255,159, 0),
+ c(255,159, 0),
+ c(255,160, 0),
+ c(255,161, 0),
+ c(255,163, 0),
+ c(255,163, 0),
+ c(255,164, 0),
+ c(255,165, 0),
+ c(255,167, 0),
+ c(255,167, 0),
+ c(255,168, 0),
+ c(255,169, 0),
+ c(255,169, 0),
+ c(255,170, 0),
+ c(255,172, 0),
+ c(255,173, 0),
+ c(255,173, 0),
+ c(255,174, 0),
+ c(255,175, 0),
+ c(255,177, 0),
+ c(255,178, 0),
+ c(255,179, 0),
+ c(255,181, 0),
+ c(255,181, 0),
+ c(255,182, 0),
+ c(255,183, 0),
+ c(255,184, 0),
+ c(255,187, 7),
+ c(255,188,10),
+ c(255,189,14),
+ c(255,191,18),
+ c(255,192,21),
+ c(255,193,25),
+ c(255,195,29),
+ c(255,197,36),
+ c(255,198,40),
+ c(255,200,43),
+ c(255,202,51),
+ c(255,204,54),
+ c(255,206,61),
+ c(255,207,65),
+ c(255,210,72),
+ c(255,211,76),
+ c(255,214,83),
+ c(255,216,91),
+ c(255,219,98),
+ c(255,221,105),
+ c(255,223,109),
+ c(255,225,116),
+ c(255,228,123),
+ c(255,232,134),
+ c(255,234,142),
+ c(255,237,149),
+ c(255,239,156),
+ c(255,240,160),
+ c(255,243,167),
+ c(255,246,174),
+ c(255,248,182),
+ c(255,249,185),
+ c(255,252,193),
+ c(255,253,196),
+ c(255,255,204),
+ c(255,255,207),
+ c(255,255,211),
+ c(255,255,218),
+ c(255,255,222),
+ c(255,255,225),
+ c(255,255,229),
+ c(255,255,233),
+ c(255,255,236),
+ c(255,255,240),
+ c(255,255,244),
+ c(255,255,247),
+ c(255,255,255))[ round(seq(beg,end,length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+
+}
diff --git a/R/LINGRAY.R b/R/LINGRAY.R
new file mode 100644
index 0000000..a448734
--- /dev/null
+++ b/R/LINGRAY.R
@@ -0,0 +1,111 @@
+LinGray <- function(n,beg = 1,end = 92)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(0,0,0),
+ c(0,0,0),
+ c(1,1,1),
+ c(1,1,1),
+ c(2,2,2),
+ c(3,3,3),
+ c(4,4,4),
+ c(5,5,5),
+ c(6,6,6),
+ c(7,7,7),
+ c(8,8,8),
+ c(9,9,9),
+ c(10,10,10),
+ c(11,11,11),
+ c(12,12,12),
+ c(13,13,13),
+ c(14,14,14),
+ c(15,15,15),
+ c(16,16,16),
+ c(17,17,17),
+ c(18,18,18),
+ c(19,19,19),
+ c(20,20,20),
+ c(21,21,21),
+ c(22,22,22),
+ c(23,23,23),
+ c(24,24,24),
+ c(25,25,25),
+ c(26,26,26),
+ c(27,27,27),
+ c(28,28,28),
+ c(29,29,29),
+ c(30,30,30),
+ c(32,32,32),
+ c(34,34,34),
+ c(35,35,35),
+ c(37,37,37),
+ c(39,39,39),
+ c(41,41,41),
+ c(43,43,43),
+ c(45,45,45),
+ c(46,46,46),
+ c(47,47,47),
+ c(49,49,49),
+ c(51,51,51),
+ c(52,52,52),
+ c(54,54,54),
+ c(56,56,56),
+ c(59,59,59),
+ c(61,61,61),
+ c(64,64,64),
+ c(67,67,67),
+ c(69,69,69),
+ c(72,72,72),
+ c(75,75,75),
+ c(76,76,76),
+ c(78,78,78),
+ c(81,81,81),
+ c(84,84,84),
+ c(87,87,87),
+ c(91,91,91),
+ c(94,94,94),
+ c(97,97,97),
+ c(101,101,101),
+ c(104,104,104),
+ c(107,107,107),
+ c(108,108,108),
+ c(112,112,112),
+ c(116,116,116),
+ c(120,120,120),
+ c(124,124,124),
+ c(128,128,128),
+ c(132,132,132),
+ c(136,136,136),
+ c(141,141,141),
+ c(145,145,145),
+ c(147,147,147),
+ c(150,150,150),
+ c(154,154,154),
+ c(159,159,159),
+ c(164,164,164),
+ c(169,169,169),
+ c(174,174,174),
+ c(179,179,179),
+ c(185,185,185),
+ c(190,190,190),
+ c(195,195,195),
+ c(201,201,201),
+ c(207,207,207),
+ c(212,212,212),
+ c(216,216,216),
+ c(218,218,218),
+ c(224,224,224),
+ c(226,226,226),
+ c(230,230,230),
+ c(237,237,237),
+ c(243,243,243),
+ c(245,245,245),
+ c(252,252,252),
+ c(255,255,255),
+ c(255,255,255))[round(seq(beg,end,length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
diff --git a/R/LOCS.R b/R/LOCS.R
new file mode 100644
index 0000000..fd73ae7
--- /dev/null
+++ b/R/LOCS.R
@@ -0,0 +1,266 @@
+LinOCS <- function(n,beg = 1,end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(0,0,0),
+ c(0,0,0),
+ c(0,0,0),
+ c(1,0,0),
+ c(2,0,0),
+ c(2,0,0),
+ c(3,0,0),
+ c(3,0,0),
+ c(4,0,0),
+ c(5,0,0),
+ c(5,0,0),
+ c(6,0,0),
+ c(7,0,0),
+ c(7,0,0),
+ c(8,0,0),
+ c(9,0,0),
+ c(9,0,0),
+ c(10,0,0),
+ c(11,0,0),
+ c(12,0,0),
+ c(13,0,0),
+ c(14,0,0),
+ c(15,0,0),
+ c(16,0,0),
+ c(17,0,0),
+ c(18,0,0),
+ c(19,0,0),
+ c(20,0,0),
+ c(21,0,0),
+ c(22,0,0),
+ c(23,0,0),
+ c(25,0,0),
+ c(26,0,0),
+ c(27,0,0),
+ c(28,0,0),
+ c(30,0,0),
+ c(31,0,0),
+ c(33,0,0),
+ c(34,0,0),
+ c(35,0,0),
+ c(37,0,0),
+ c(39,0,0),
+ c(40,0,0),
+ c(43,0,0),
+ c(45,0,0),
+ c(46,0,0),
+ c(49,0,0),
+ c(51,0,0),
+ c(53,0,0),
+ c(54,0,0),
+ c(56,0,0),
+ c(58,0,0),
+ c(60,0,0),
+ c(62,0,0),
+ c(64,0,0),
+ c(67,0,0),
+ c(69,0,0),
+ c(71,0,0),
+ c(74,0,0),
+ c(76,0,0),
+ c(80,0,0),
+ c(81,0,0),
+ c(84,0,0),
+ c(86,0,0),
+ c(89,0,0),
+ c(92,0,0),
+ c(94,0,0),
+ c(97,0,0),
+ c(100,0,0),
+ c(103,0,0),
+ c(106,0,0),
+ c(109,0,0),
+ c(112,0,0),
+ c(115,0,0),
+ c(117,0,0),
+ c(122,0,0),
+ c(126,0,0),
+ c(128,0,0),
+ c(131,0,0),
+ c(135,0,0),
+ c(135,0,0),
+ c(135,1,0),
+ c(135,2,0),
+ c(135,3,0),
+ c(135,4,0),
+ c(135,6,0),
+ c(135,6,0),
+ c(135,8,0),
+ c(135,9,0),
+ c(135,10,0),
+ c(135,11,0),
+ c(135,13,0),
+ c(135,13,0),
+ c(135,15,0),
+ c(135,17,0),
+ c(135,17,0),
+ c(135,19,0),
+ c(135,21,0),
+ c(135,22,0),
+ c(135,23,0),
+ c(135,25,0),
+ c(135,26,0),
+ c(135,27,0),
+ c(135,29,0),
+ c(135,31,0),
+ c(135,32,0),
+ c(135,33,0),
+ c(135,35,0),
+ c(135,36,0),
+ c(135,38,0),
+ c(135,40,0),
+ c(135,42,0),
+ c(135,44,0),
+ c(135,46,0),
+ c(135,47,0),
+ c(135,49,0),
+ c(135,51,0),
+ c(135,52,0),
+ c(135,54,0),
+ c(135,56,0),
+ c(135,57,0),
+ c(135,59,0),
+ c(135,62,0),
+ c(135,63,0),
+ c(135,65,0),
+ c(135,67,0),
+ c(135,69,0),
+ c(135,72,0),
+ c(135,73,0),
+ c(135,76,0),
+ c(135,78,0),
+ c(135,80,0),
+ c(135,82,0),
+ c(135,84,0),
+ c(135,87,0),
+ c(135,88,0),
+ c(135,90,0),
+ c(135,93,0),
+ c(135,95,0),
+ c(135,98,0),
+ c(135,101,0),
+ c(135,103,0),
+ c(135,106,0),
+ c(135,107,0),
+ c(135,110,0),
+ c(135,113,0),
+ c(135,115,0),
+ c(135,118,0),
+ c(135,121,0),
+ c(135,124,0),
+ c(135,127,0),
+ c(135,129,0),
+ c(135,133,0),
+ c(135,135,0),
+ c(135,138,0),
+ c(135,141,0),
+ c(135,144,0),
+ c(135,148,0),
+ c(135,150,0),
+ c(135,155,0),
+ c(135,157,0),
+ c(135,160,0),
+ c(135,163,0),
+ c(135,166,0),
+ c(135,170,0),
+ c(135,174,0),
+ c(135,177,0),
+ c(135,180,0),
+ c(135,184,0),
+ c(135,188,0),
+ c(135,192,0),
+ c(135,195,0),
+ c(135,200,0),
+ c(135,203,0),
+ c(135,205,0),
+ c(135,210,0),
+ c(135,214,0),
+ c(135,218,0),
+ c(135,222,0),
+ c(135,226,0),
+ c(135,231,0),
+ c(135,236,0),
+ c(135,239,0),
+ c(135,244,0),
+ c(135,249,0),
+ c(135,254,0),
+ c(135,255,1),
+ c(135,255,5),
+ c(135,255,10),
+ c(135,255,15),
+ c(135,255,20),
+ c(135,255,23),
+ c(135,255,28),
+ c(135,255,33),
+ c(135,255,38),
+ c(135,255,43),
+ c(135,255,45),
+ c(135,255,49),
+ c(135,255,54),
+ c(135,255,59),
+ c(135,255,65),
+ c(135,255,70),
+ c(135,255,74),
+ c(135,255,80),
+ c(135,255,84),
+ c(135,255,90),
+ c(135,255,95),
+ c(135,255,98),
+ c(135,255,104),
+ c(135,255,110),
+ c(135,255,116),
+ c(135,255,120),
+ c(135,255,125),
+ c(135,255,131),
+ c(135,255,137),
+ c(135,255,144),
+ c(135,255,149),
+ c(135,255,154),
+ c(135,255,158),
+ c(135,255,165),
+ c(135,255,172),
+ c(135,255,179),
+ c(135,255,186),
+ c(135,255,191),
+ c(135,255,198),
+ c(135,255,203),
+ c(135,255,211),
+ c(135,255,216),
+ c(135,255,224),
+ c(135,255,232),
+ c(135,255,240),
+ c(135,255,248),
+ c(135,255,254),
+ c(135,255,255),
+ c(140,255,255),
+ c(146,255,255),
+ c(153,255,255),
+ c(156,255,255),
+ c(161,255,255),
+ c(168,255,255),
+ c(172,255,255),
+ c(177,255,255),
+ c(182,255,255),
+ c(189,255,255),
+ c(192,255,255),
+ c(199,255,255),
+ c(204,255,255),
+ c(210,255,255),
+ c(215,255,255),
+ c(220,255,255),
+ c(225,255,255),
+ c(232,255,255),
+ c(236,255,255),
+ c(240,255,255),
+ c(248,255,255),
+ c(255,255,255))[ round(seq(beg,end,length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
diff --git a/R/MAG.R b/R/MAG.R
new file mode 100644
index 0000000..5721749
--- /dev/null
+++ b/R/MAG.R
@@ -0,0 +1,266 @@
+magent <- function(n, beg = 1, end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c(0, 0, 0),
+ c( 40, 0, 0),
+ c( 56, 0, 4),
+ c( 61, 0, 9),
+ c( 64, 0, 12),
+ c( 66, 0, 14),
+ c( 69, 0, 17),
+ c( 73, 0, 20),
+ c( 74, 0, 22),
+ c( 78, 0, 25),
+ c( 79, 0, 27),
+ c( 83, 0, 30),
+ c( 85, 0, 31),
+ c( 86, 0, 33),
+ c( 90, 0, 36),
+ c( 91, 0, 38),
+ c( 93, 0, 39),
+ c( 95, 0, 41),
+ c( 96, 0, 43),
+ c(100, 0, 46),
+ c(102, 0, 47),
+ c(103, 0, 49),
+ c(105, 0, 51),
+ c(107, 0, 52),
+ c(108, 0, 54),
+ c(110, 0, 55),
+ c(112, 0, 57),
+ c(112, 0, 57),
+ c(113, 0, 58),
+ c(115, 0, 60),
+ c(117, 0, 62),
+ c(119, 0, 63),
+ c(120, 0, 65),
+ c(122, 0, 66),
+ c(124, 0, 68),
+ c(125, 0, 70),
+ c(127, 0, 71),
+ c(129, 0, 73),
+ c(129, 0, 73),
+ c(130, 0, 74),
+ c(132, 0, 76),
+ c(134, 0, 78),
+ c(136, 0, 79),
+ c(137, 0, 81),
+ c(139, 0, 82),
+ c(141, 0, 84),
+ c(142, 0, 86),
+ c(144, 0, 87),
+ c(146, 0, 89),
+ c(147, 0, 90),
+ c(149, 0, 92),
+ c(151, 0, 94),
+ c(151, 0, 94),
+ c(153, 0, 95),
+ c(154, 0, 97),
+ c(156, 0, 98),
+ c(158, 0,100),
+ c(159, 0,102),
+ c(161, 0,103),
+ c(163, 0,105),
+ c(164, 0,106),
+ c(166, 0,108),
+ c(168, 0,109),
+ c(170, 0,111),
+ c(171, 0,113),
+ c(173, 0,114),
+ c(175, 0,116),
+ c(176, 0,117),
+ c(178, 0,119),
+ c(180, 0,121),
+ c(180, 0,121),
+ c(181, 0,122),
+ c(183, 0,124),
+ c(185, 0,125),
+ c(187, 0,127),
+ c(188, 0,129),
+ c(190, 0,130),
+ c(192, 0,132),
+ c(193, 0,133),
+ c(195, 0,135),
+ c(197, 0,137),
+ c(198, 0,138),
+ c(200, 0,140),
+ c(202, 0,141),
+ c(204, 0,143),
+ c(204, 0,143),
+ c(205, 0,145),
+ c(207, 0,146),
+ c(209, 0,148),
+ c(210, 0,149),
+ c(212, 0,151),
+ c(214, 0,153),
+ c(215, 0,154),
+ c(217, 0,156),
+ c(219, 0,157),
+ c(221, 0,159),
+ c(222, 0,160),
+ c(222, 0,160),
+ c(224, 0,162),
+ c(226, 0,164),
+ c(227, 0,165),
+ c(229, 0,167),
+ c(231, 0,168),
+ c(232, 0,170),
+ c(234, 0,172),
+ c(236, 0,173),
+ c(238, 0,175),
+ c(238, 0,175),
+ c(239, 0,176),
+ c(241, 0,178),
+ c(243, 0,180),
+ c(244, 0,181),
+ c(246, 0,183),
+ c(248, 2,184),
+ c(249, 4,186),
+ c(249, 4,186),
+ c(249, 4,186),
+ c(251, 6,188),
+ c(251, 6,188),
+ c(253, 9,189),
+ c(253, 9,189),
+ c(255, 11,191),
+ c(255, 11,191),
+ c(255, 13,192),
+ c(255, 13,192),
+ c(255, 13,192),
+ c(255, 16,194),
+ c(255, 18,196),
+ c(255, 20,197),
+ c(255, 20,197),
+ c(255, 23,199),
+ c(255, 25,200),
+ c(255, 27,202),
+ c(255, 30,204),
+ c(255, 32,205),
+ c(255, 34,207),
+ c(255, 37,208),
+ c(255, 37,208),
+ c(255, 39,210),
+ c(255, 41,211),
+ c(255, 44,213),
+ c(255, 46,215),
+ c(255, 48,216),
+ c(255, 51,218),
+ c(255, 53,219),
+ c(255, 53,219),
+ c(255, 55,221),
+ c(255, 57,223),
+ c(255, 60,224),
+ c(255, 62,226),
+ c(255, 64,227),
+ c(255, 67,229),
+ c(255, 67,229),
+ c(255, 69,231),
+ c(255, 71,232),
+ c(255, 74,234),
+ c(255, 76,235),
+ c(255, 78,237),
+ c(255, 81,239),
+ c(255, 81,239),
+ c(255, 83,240),
+ c(255, 85,242),
+ c(255, 88,243),
+ c(255, 90,245),
+ c(255, 92,247),
+ c(255, 95,248),
+ c(255, 95,248),
+ c(255, 97,250),
+ c(255, 99,251),
+ c(255,102,253),
+ c(255,104,255),
+ c(255,106,255),
+ c(255,106,255),
+ c(255,108,255),
+ c(255,111,255),
+ c(255,113,255),
+ c(255,115,255),
+ c(255,115,255),
+ c(255,118,255),
+ c(255,120,255),
+ c(255,122,255),
+ c(255,122,255),
+ c(255,125,255),
+ c(255,127,255),
+ c(255,129,255),
+ c(255,129,255),
+ c(255,132,255),
+ c(255,134,255),
+ c(255,136,255),
+ c(255,136,255),
+ c(255,139,255),
+ c(255,141,255),
+ c(255,143,255),
+ c(255,143,255),
+ c(255,146,255),
+ c(255,148,255),
+ c(255,150,255),
+ c(255,150,255),
+ c(255,153,255),
+ c(255,155,255),
+ c(255,155,255),
+ c(255,157,255),
+ c(255,159,255),
+ c(255,159,255),
+ c(255,162,255),
+ c(255,164,255),
+ c(255,164,255),
+ c(255,166,255),
+ c(255,169,255),
+ c(255,171,255),
+ c(255,171,255),
+ c(255,173,255),
+ c(255,176,255),
+ c(255,176,255),
+ c(255,178,255),
+ c(255,180,255),
+ c(255,180,255),
+ c(255,183,255),
+ c(255,185,255),
+ c(255,185,255),
+ c(255,187,255),
+ c(255,190,255),
+ c(255,190,255),
+ c(255,192,255),
+ c(255,194,255),
+ c(255,197,255),
+ c(255,197,255),
+ c(255,199,255),
+ c(255,201,255),
+ c(255,204,255),
+ c(255,204,255),
+ c(255,206,255),
+ c(255,208,255),
+ c(255,210,255),
+ c(255,210,255),
+ c(255,213,255),
+ c(255,215,255),
+ c(255,217,255),
+ c(255,217,255),
+ c(255,220,255),
+ c(255,222,255),
+ c(255,224,255),
+ c(255,227,255),
+ c(255,229,255),
+ c(255,229,255),
+ c(255,231,255),
+ c(255,234,255),
+ c(255,236,255),
+ c(255,238,255),
+ c(255,241,255),
+ c(255,243,255),
+ c(255,243,255),
+ c(255,245,255),
+ c(255,248,255),
+ c(255,250,255),
+ c(255,255,255)) [ round(seq(beg,end,length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
diff --git a/R/RB.R b/R/RB.R
new file mode 100644
index 0000000..6e92aaa
--- /dev/null
+++ b/R/RB.R
@@ -0,0 +1,266 @@
+plinrain <- function(n, beg = 1, end = 256)
+{
+ if(beg < 1 || end < 1 || beg > 256 || end > 256)
+ stop("`beg' and `end' must be numbers in the interval [1,256]")
+
+ M <- rbind(c( 0, 0, 0),
+ c( 45, 0, 36),
+ c( 56, 0, 46),
+ c( 60, 0, 49),
+ c( 67, 0, 54),
+ c( 70, 0, 59),
+ c( 71, 0, 61),
+ c( 75, 0, 68),
+ c( 74, 0, 73),
+ c( 74, 0, 77),
+ c( 73, 0, 81),
+ c( 71, 0, 87),
+ c( 69, 1, 90),
+ c( 68, 2, 94),
+ c( 66, 3, 97),
+ c( 63, 6,102),
+ c( 61, 7,106),
+ c( 58, 10,109),
+ c( 56, 12,113),
+ c( 53, 15,116),
+ c( 48, 18,119),
+ c( 47, 20,121),
+ c( 44, 23,124),
+ c( 41, 27,128),
+ c( 40, 28,129),
+ c( 37, 32,132),
+ c( 34, 36,134),
+ c( 29, 43,137),
+ c( 25, 52,138),
+ c( 24, 57,139),
+ c( 24, 62,141),
+ c( 24, 64,142),
+ c( 23, 65,142),
+ c( 23, 69,143),
+ c( 23, 71,142),
+ c( 23, 71,142),
+ c( 23, 73,142),
+ c( 23, 75,142),
+ c( 23, 75,142),
+ c( 23, 78,142),
+ c( 23, 80,142),
+ c( 23, 80,142),
+ c( 23, 82,141),
+ c( 23, 85,141),
+ c( 23, 85,141),
+ c( 23, 87,140),
+ c( 23, 87,140),
+ c( 24, 90,140),
+ c( 24, 90,140),
+ c( 24, 93,139),
+ c( 24, 93,139),
+ c( 24, 93,139),
+ c( 24, 93,139),
+ c( 24, 97,139),
+ c( 24, 97,139),
+ c( 25,101,138),
+ c( 25,101,138),
+ c( 25,104,137),
+ c( 25,104,137),
+ c( 25,104,137),
+ c( 26,108,137),
+ c( 26,108,137),
+ c( 27,111,136),
+ c( 27,111,136),
+ c( 27,111,136),
+ c( 27,115,135),
+ c( 27,115,135),
+ c( 28,118,134),
+ c( 28,118,134),
+ c( 29,122,133),
+ c( 29,122,133),
+ c( 29,122,133),
+ c( 29,122,133),
+ c( 29,125,132),
+ c( 29,125,132),
+ c( 30,128,131),
+ c( 30,128,131),
+ c( 31,131,130),
+ c( 31,131,130),
+ c( 31,131,130),
+ c( 32,134,128),
+ c( 32,134,128),
+ c( 33,137,127),
+ c( 33,137,127),
+ c( 33,137,127),
+ c( 34,140,125),
+ c( 34,140,125),
+ c( 35,142,123),
+ c( 35,142,123),
+ c( 36,145,121),
+ c( 36,145,121),
+ c( 36,145,121),
+ c( 37,147,118),
+ c( 37,147,118),
+ c( 38,150,116),
+ c( 38,150,116),
+ c( 40,152,113),
+ c( 40,152,113),
+ c( 41,154,111),
+ c( 41,154,111),
+ c( 42,156,108),
+ c( 42,156,108),
+ c( 43,158,106),
+ c( 43,158,106),
+ c( 43,158,106),
+ c( 45,160,104),
+ c( 45,160,104),
+ c( 46,162,101),
+ c( 46,162,101),
+ c( 48,164, 99),
+ c( 48,164, 99),
+ c( 50,166, 97),
+ c( 50,166, 97),
+ c( 51,168, 95),
+ c( 53,170, 93),
+ c( 53,170, 93),
+ c( 53,170, 93),
+ c( 55,172, 91),
+ c( 55,172, 91),
+ c( 57,174, 88),
+ c( 57,174, 88),
+ c( 59,175, 86),
+ c( 62,177, 84),
+ c( 64,178, 82),
+ c( 64,178, 82),
+ c( 67,180, 80),
+ c( 67,180, 80),
+ c( 69,181, 79),
+ c( 72,183, 77),
+ c( 72,183, 77),
+ c( 72,183, 77),
+ c( 75,184, 76),
+ c( 77,186, 74),
+ c( 80,187, 73),
+ c( 83,189, 72),
+ c( 87,190, 72),
+ c( 91,191, 71),
+ c( 95,192, 70),
+ c( 99,193, 70),
+ c(103,194, 70),
+ c(107,195, 70),
+ c(111,196, 70),
+ c(111,196, 70),
+ c(115,196, 70),
+ c(119,197, 70),
+ c(123,197, 70),
+ c(130,198, 71),
+ c(133,199, 71),
+ c(137,199, 72),
+ c(140,199, 72),
+ c(143,199, 73),
+ c(143,199, 73),
+ c(147,199, 73),
+ c(150,199, 74),
+ c(153,199, 74),
+ c(156,199, 75),
+ c(160,200, 76),
+ c(167,200, 78),
+ c(170,200, 79),
+ c(173,200, 79),
+ c(173,200, 79),
+ c(177,200, 80),
+ c(180,200, 81),
+ c(183,199, 82),
+ c(186,199, 82),
+ c(190,199, 83),
+ c(196,199, 85),
+ c(199,198, 85),
+ c(199,198, 85),
+ c(203,198, 86),
+ c(206,197, 87),
+ c(212,197, 89),
+ c(215,196, 90),
+ c(218,195, 91),
+ c(224,194, 94),
+ c(224,194, 94),
+ c(230,193, 96),
+ c(233,192, 98),
+ c(236,190,100),
+ c(238,189,104),
+ c(240,188,106),
+ c(240,188,106),
+ c(242,187,110),
+ c(244,185,114),
+ c(245,184,116),
+ c(247,183,120),
+ c(248,182,123),
+ c(248,182,123),
+ c(250,181,125),
+ c(251,180,128),
+ c(252,180,130),
+ c(253,180,133),
+ c(253,180,133),
+ c(254,180,134),
+ c(254,179,138),
+ c(255,179,142),
+ c(255,179,145),
+ c(255,179,145),
+ c(255,179,152),
+ c(255,180,161),
+ c(255,180,164),
+ c(255,180,167),
+ c(255,180,167),
+ c(255,181,169),
+ c(255,181,170),
+ c(255,182,173),
+ c(255,183,176),
+ c(255,183,176),
+ c(255,184,179),
+ c(255,185,179),
+ c(255,185,182),
+ c(255,186,182),
+ c(255,186,182),
+ c(255,187,185),
+ c(255,188,185),
+ c(255,189,188),
+ c(255,189,188),
+ c(255,190,188),
+ c(255,191,191),
+ c(255,192,191),
+ c(255,194,194),
+ c(255,194,194),
+ c(255,197,197),
+ c(255,198,198),
+ c(255,200,200),
+ c(255,201,201),
+ c(255,201,201),
+ c(255,202,202),
+ c(255,203,203),
+ c(255,205,205),
+ c(255,206,206),
+ c(255,206,206),
+ c(255,208,208),
+ c(255,209,209),
+ c(255,211,211),
+ c(255,215,215),
+ c(255,216,216),
+ c(255,216,216),
+ c(255,218,218),
+ c(255,219,219),
+ c(255,221,221),
+ c(255,223,223),
+ c(255,226,226),
+ c(255,228,228),
+ c(255,230,230),
+ c(255,230,230),
+ c(255,232,232),
+ c(255,235,235),
+ c(255,237,237),
+ c(255,240,240),
+ c(255,243,243),
+ c(255,246,246),
+ c(255,249,249),
+ c(255,251,251),
+ c(255,253,253),
+ c(255,255,255))[ round(seq(beg,end, length = n)), ]
+
+ rgb(M[,1]/255,
+ M[,2]/255,
+ M[,3]/255)
+}
diff --git a/R/grid.hexagons.R b/R/grid.hexagons.R
new file mode 100644
index 0000000..fcc45a2
--- /dev/null
+++ b/R/grid.hexagons.R
@@ -0,0 +1,366 @@
+
+hexcoords <- function(dx, dy = NULL, n = 1, sep = NULL)
+{
+ stopifnot(length(dx) == 1)
+ if(is.null(dy)) dy <- dx/sqrt(3)
+ if(is.null(sep))
+ list(x = rep.int(c(dx, dx, 0, -dx, -dx, 0), n),
+ y = rep.int(c(dy,-dy, -2*dy, -dy, dy, 2*dy), n),
+ no.sep = TRUE)
+ else
+ list(x = rep.int(c(dx, dx, 0, -dx, -dx, 0, sep), n),
+ y = rep.int(c(dy,-dy, -2*dy, -dy, dy, 2*dy, sep), n),
+ no.sep = FALSE)
+}
+
+hexpolygon <-
+function(x, y, hexC = hexcoords(dx, dy, n = 1), dx, dy=NULL,
+ fill = 1, border = 0, hUnit = "native", ...)
+{
+ ## Purpose: draw hexagon [grid.]polygon()'s around (x[i], y[i])_i
+ ## Author: Martin Maechler, Jul 2004; Nicholas for grid
+
+ n <- length(x)
+ stopifnot(length(y) == n)
+ stopifnot(is.list(hexC) && is.numeric(hexC$x) && is.numeric(hexC$y))
+ if(hexC$no.sep) {
+ n6 <- rep.int(6:6, n)
+ if(!is.null(hUnit)) {
+ grid.polygon(x = unit(rep.int(hexC$x, n) + rep.int(x, n6),hUnit),
+ y = unit(rep.int(hexC$y, n) + rep.int(y, n6),hUnit),
+ id.lengths = n6,
+ gp = gpar(col= border, fill= fill))
+ }
+ else {
+ grid.polygon(x = rep.int(hexC$x, n) + rep.int(x, n6),
+ y = rep.int(hexC$y, n) + rep.int(y, n6),
+ id.lengths = n6,
+ gp = gpar(col= border, fill= fill))
+ }
+ }
+ else{ ## traditional graphics polygons: must be closed explicitly (+ 1 pt)
+ n7 <- rep.int(7:7, n)
+ polygon(x = rep.int(hexC$x, n) + rep.int(x, n7),
+ y = rep.int(hexC$y, n) + rep.int(y, n7), ...)
+ }
+}
+
+grid.hexagons <-
+function(dat, style = c("colorscale", "centroids", "lattice",
+ "nested.lattice", "nested.centroids", "constant.col"),
+ use.count=TRUE, cell.at=NULL,
+ minarea = 0.05, maxarea = 0.8, check.erosion = TRUE,
+ mincnt = 1, maxcnt = max(dat at count), trans = NULL,
+ colorcut = seq(0, 1, length = 17),
+ density = NULL, border = NULL, pen = NULL,
+ colramp = function(n){ LinGray(n,beg = 90, end = 15) },
+ def.unit = "native",
+ verbose = getOption("verbose"))
+{
+ ## Warning: presumes the plot has the right shape and scales
+ ## See plot.hexbin()
+ ## Arguments:
+ ## dat = hexbin object
+ ## style = type of plotting
+ ## 'centroids' = symbol area is a function of the count,
+ ## approximate location near cell center of
+ ## mass without overplotting
+ ## 'lattice' = symbol area is a function of the count,
+ ## plot at lattice points
+ ## 'colorscale' = gray scale plot,
+ ## color number determined by
+ ## transformation and colorcut,
+ ## area = full hexagons.
+ ## 'nested.lattice'= plots two hexagons
+ ## background hexagon
+ ## area=full size
+ ## color number by count in powers of 10 starting at pen 2
+ ## foreground hexagon
+ ## area by log10(cnt)-floor(log10(cnt))
+ ## color number by count in powers of 10 starting at pen 12
+ ## 'nested.centroids' = like nested.lattice
+ ## but counts < 10 are plotted
+ ##
+ ## minarea = minimum symbol area as fraction of the binning cell
+ ## maxarea = maximum symbol area as fraction of the binning cell
+ ## mincnt = minimum count accepted in plot
+ ## maxcnt = maximum count accepted in plot
+ ## trans = a transformation scaling counts into [0,1] to be applied
+ ## to the counts for options 'centroids','lattice','colorscale':
+ ## default=(cnt-mincnt)/(maxcnt-mincnt)
+ ## colorcut= breaks for translating values between 0 and 1 into
+ ## color classes. Default= seq(0,1,17),
+ ## density = for hexagon graph paper
+ ## border plot the border of the hexagon, use TRUE for
+ ## hexagon graph paper
+ ## Symbol size encoding:
+ ## Area= minarea + scaled.count*(maxarea-minarea)
+ ## When maxarea==1 and scaled.count==1, the hexagon cell
+ ## is completely filled.
+ ##
+ ## If small hexagons are hard to see increase minarea.
+ ## For gray scale encoding
+ ## Uses the counts scaled into [0,1]
+ ## Default gray cutpoints seq(0,1,17) yields 16 color classes
+ ## The color number for the first class starts at 2.
+ ## motif coding: black 15 white puts the first of the
+ ## color class above the background black
+ ## The function subtracts 1.e-6 from the lower cutpoint to include
+ ## the boundary
+ ## For nested scaling see the code
+ ## Count scaling alternatives
+ ##
+ ## log 10 and Poisson transformations
+ ## trans <- function(cnt) log10(cnt)
+ ## min inv <- function(y) 10^y
+ ##
+ ## trans <- function(cnt) sqrt(4*cnt+2)
+ ## inv <- function(y) (y^2-2)/4
+ ## Perceptual considerations.
+ ## Visual response to relative symbol area is not linear and varies from
+ ## person to person. A fractional power transformation
+ ## to make the interpretation nearly linear for more people
+ ## might be considered. With areas bounded between minarea
+ ## and 1 the situation is complicated.
+ ##
+ ## The local background influences color interpretation.
+ ## Having defined color breaks to focus attention on
+ ## specific countours can help.
+ ##
+ ## Plotting the symbols near the center of mass is not only more accurate,
+ ## it helps to reduce the visual dominance of the lattice structure. Of
+ ## course higher resolution binning reduces the possible distance between
+ ## the center of mass for a bin and the bin center. When symbols
+ ## nearly fill their bin, the plot appears to vibrate. This can be
+ ## partially controlled by reducing maxarea or by reducing
+ ## contrast.
+
+
+ ##____________________Initial checks_______________________
+ if(!is(dat,"hexbin"))
+ stop("first argument must be a hexbin object")
+ style <- match.arg(style) # so user can abbreviate
+ if(minarea <= 0)
+ stop("hexagons cannot have a zero area, change minarea")
+ if(maxarea > 1)
+ warning("maxarea > 1, hexagons may overplot")
+ ##_______________ Collect computing constants______________
+
+ if(use.count){
+ cnt <- dat at count
+ }
+ else{
+ cnt <- cell.at
+ if(is.null(cnt)){
+ if(is.null(dat at cAtt)) stop("Cell attribute cAtt is null")
+ else cnt <- dat at cAtt
+ }
+ }
+ xbins <- dat at xbins
+ shape <- dat at shape
+ tmp <- hcell2xy(dat, check.erosion = check.erosion)
+ good <- mincnt <= cnt & cnt <= maxcnt
+ xnew <- tmp$x[good]
+ ynew <- tmp$y[good]
+ cnt <- cnt[good]
+ sx <- xbins/diff(dat at xbnds)
+ sy <- (xbins * shape)/diff(dat at ybnds)
+
+ ##___________Transform Counts to Radius_____________________
+ switch(style,
+ "centroids" = ,
+ "lattice" = ,
+ "constant.col" =,
+ "colorscale" = {
+ if(is.null(trans)) {
+ if( min(cnt,na.rm=TRUE)< 0){
+ pcnt<- cnt + min(cnt)
+ rcnt <- {
+ if(maxcnt == mincnt) rep.int(1, length(cnt))
+ else (pcnt - mincnt)/(maxcnt - mincnt)
+ }
+ }
+ else rcnt <- {
+ if(maxcnt == mincnt) rep.int(1, length(cnt))
+ else (cnt - mincnt)/(maxcnt - mincnt)
+ }
+ }
+ else {
+ rcnt <- (trans(cnt) - trans(mincnt)) /
+ (trans(maxcnt) - trans(mincnt))
+ if(any(is.na(rcnt)))
+ stop("bad count transformation")
+ }
+ area <- minarea + rcnt * (maxarea - minarea)
+ },
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ diffarea <- maxarea - minarea
+ step <- 10^floor(log10(cnt))
+ f <- (cnt/step - 1)/9
+ area <- minarea + f * diffarea
+ area <- pmax(area, minarea)
+ }
+ )
+ area <- pmin(area, maxarea)
+ radius <- sqrt(area)
+
+ ##______________Set Colors_____________________________
+ switch(style,
+ "centroids" = ,
+ "constant.col" = ,
+ "lattice" = {
+ if(length(pen)!= length(cnt)){
+ if(is.null(pen)) pen <- rep.int(1, length(cnt))
+ ##else if(length(pen)== length(cnt)) break
+ else if(length(pen)== 1) pen <- rep.int(pen,length(cnt))
+ else stop("'pen' has wrong length")
+ }
+ },
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ if(!is.null(pen) && length(dim(pen)) == 2) {
+ dp <- dim(pen)
+ lgMcnt <- ceiling(log10(max(cnt)))
+ if(dp[1] != length(cnt) && dp[1] != lgMcnt ) {
+ stop ("pen is not of right dimension")
+ }
+ if( dp[1] == lgMcnt ) {
+ ind <- ceiling(log10(dat at count)) ## DS: 'dat' was 'bin' (??)
+ ind[ind == 0] <- 1
+ pen <- pen[ind,]
+ }
+ ##else break
+ }
+ else {
+ pen <- floor(log10(cnt)) + 2
+ pen <- cbind(pen, pen+10)
+ }
+ },
+ "colorscale" = {
+ ## MM: Following is quite different from bin2d's
+ nc <- length(colorcut)
+ if(colorcut[1] > colorcut[nc]){
+ colorcut[1] <- colorcut[1] + 1e-06
+ colorcut[nc] <- colorcut[nc] - 1e-06
+ } else {
+ colorcut[1] <- colorcut[1] - 1e-06
+ colorcut[nc] <- colorcut[nc] + 1e-06
+ }
+ colgrp <- cut(rcnt, colorcut,labels = FALSE)
+ if(any(is.na(colgrp))) colgrp <- ifelse(is.na(colgrp),0,colgrp)
+ ##NL: colramp must be a function accepting an integer n
+ ## and returning n colors
+ clrs <- colramp(length(colorcut) - 1)
+ pen <- clrs[colgrp]
+ }
+ )
+
+ ##__________________ Construct a hexagon___________________
+ ## The inner and outer radius for hexagon in the scaled plot
+ inner <- 0.5
+ outer <- (2 * inner)/sqrt(3)
+ ## Now construct a point up hexagon symbol in data units
+ dx <- inner/sx
+ dy <- outer/(2 * sy)
+ rad <- sqrt(dx^2 + dy^2)
+ hexC <- hexcoords(dx, dy, sep=NULL)
+ ##_______________ Full Cell Plotting_____________________
+ switch(style,
+ "constant.col" = ,
+ "colorscale" = {
+ hexpolygon(xnew, ynew, hexC,
+ density = density, fill = pen,
+ border = if(!is.null(border)) border else pen)
+
+ ## and that's been all for these styles
+ return(invisible(paste("done", sQuote(style))))
+ },
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ hexpolygon(xnew, ynew, hexC,
+ density = density,
+ fill = if (is.null(border) || border) 1 else pen[,1],
+ border = pen[,1])
+ }
+ )
+
+ ##__________________ Symbol Center adjustments_______________
+ if(style == "centroids" || style == "nested.centroids") {
+ xcm <- dat at xcm[good]
+ ycm <- dat at ycm[good]
+ ## Store 12 angles around a circle and the replicate the first
+ ## The actual length for these vectors is determined by using
+ ## factor use below
+ k <- sqrt(3)/2
+ cosx <- c(1, k, .5, 0, -.5, -k, -1, -k, -.5, 0, .5, k, 1)/sx
+ siny <- c(0, .5, k, 1, k, .5, 0, -.5, -k, -1, -k, -.5, 0)/sy
+ ## Compute distances for differences after scaling into
+ ## [0,size] x [0,aspect*size]
+ ## Then there are size hexagons on the x axis
+ dx <- sx * (xcm - xnew)
+ dy <- sy * (ycm - ynew)
+ dlen <- sqrt(dx^2 + dy^2)
+ ## Find the closest approximating direction of the 12 vectors above
+ cost <- ifelse(dlen > 0, dx/dlen, 0)
+ tk <- (6 * acos(cost))/pi
+ tk <- round(ifelse(dy < 0, 12 - tk, tk)) + 1
+ ## Select the available length for the approximating vector
+ hrad <- ifelse(tk %% 2 == 1, inner, outer)
+ ## Rad is either an inner or outer approximating radius.
+ ## If dlen + hrad*radius <= hrad, move the center dlen units.
+ ## Else move as much of dlen as possible without overplotting.
+ fr <- pmin(hrad * (1 - radius), dlen) # Compute the symbol centers
+ ## fr is the distance for the plot [0,xbins] x [0,aspect*xbins]
+
+ ## cosx and siny give the x and y components of this distance
+ ## in data units
+ xnew <- xnew + fr * cosx[tk]
+ ynew <- ynew + fr * siny[tk]
+ }
+ ## ________________Sized Hexagon Plotting__________________
+ ## scale the symbol by radius and add to the new center
+ n <- length(radius)
+ if(verbose)
+ cat('length = ',length(pen),"\n", 'pen = ', pen+1,"\n")
+ ##switch(style,
+ ## centroids = ,
+ ## lattice = {if(is.null(pen))pen <- rep.int(1, n)
+ ## else pen <- rep.int(pen, n)},
+ ## nested.lattice = ,
+ ## nested.centroids ={
+ ## if(
+ ## pen[,2] <- pen[,1] + 10
+ ## } )
+
+ ## grid.polygon() closes automatically: now '6' where we had '7':
+ n6 <- rep.int(6:6, n)
+ pltx <- rep.int(hexC$x, n) * rep.int(radius, n6) + rep.int(xnew, n6)
+ plty <- rep.int(hexC$y, n) * rep.int(radius, n6) + rep.int(ynew, n6)
+ switch(style,
+ "centroids" = ,
+ "lattice" = {
+ grid.polygon(pltx, plty, default.units=def.unit, id=NULL,
+ ## density = density,
+ id.lengths= n6,
+ gp=gpar(fill = pen, col = border))
+ },
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ grid.polygon(pltx, plty, default.units=def.unit, id=NULL,
+ id.lengths= n6,
+ gp=gpar(fill = pen[,2],
+ ## density = density,
+ col=if(!is.null(border)) border else pen[,2]))
+
+ })
+
+}
+
+if(FALSE){ ## considering 'hexagons' object
+ setMethod("hexagons", signature(dat="hexbin"), grid.hexagons)
+
+ erode.hexagons <- function(ebin,pen="black",border="red"){
+ print("Blank for now")
+ }
+}
diff --git a/R/grid.hexlegend.R b/R/grid.hexlegend.R
new file mode 100644
index 0000000..2692a31
--- /dev/null
+++ b/R/grid.hexlegend.R
@@ -0,0 +1,157 @@
+grid.hexlegend <-
+function(legend, ysize, lcex, inner,
+ style = "colorscale",
+ minarea = 0.05, maxarea = 0.8, mincnt = 1, maxcnt, trans = NULL,
+ inv = NULL, colorcut, density = NULL, border = NULL, pen = NULL,
+ colramp = function(n) { LinGray(n,beg = 90,end = 15) },
+ leg.unit="native")
+{
+ ## the formal arg matching should happen
+ style <- match.arg(style, eval(formals(grid.hexagons)[["style"]]))
+
+ if (style %in% c("centroids", "lattice", "colorscale")) {
+ ## _______________tranformations_______________________
+ if(is.null(trans)) {
+ sc <- maxcnt - mincnt
+ bnds <- round(mincnt + sc * colorcut)
+ }
+
+ else {
+ if(!is.function(trans) && !is.function(inv))
+ stop("'trans' and 'inv' must both be functions if 'trans' is not NULL")
+ con <- trans(mincnt)
+ sc <- trans(maxcnt) - con
+ bnds <- round(inv(con + sc * colorcut))
+ }
+ }
+
+ if(style == "colorscale") { ## use own 'inner'
+ n <- length(bnds)
+ spacing <- ysize/(n + 3)
+ inner <- min(legend/3.5, (sqrt(3) * spacing)/2)
+ }
+ dx <- inner/2
+ dy <- dx/sqrt(3)
+ hexC <- hexcoords(dx, dy, n = 1,sep=NULL)
+
+ ## _______________Plotting______________________________
+ switch(style,
+ "colorscale" = {
+ midx <- legend/3
+ textx <- (2 * legend)/3
+ tx <- hexC$x + midx
+ pen <- colramp(n)
+ for(i in seq(length = n-1)) {
+ grid.polygon(tx,hexC$y + i * spacing,
+ default.units=leg.unit,id=NULL,id.lengths=6,
+ gp=gpar(fill = pen[i], col = border))
+ grid.text(as.character(bnds[i]), textx, (i - 0.5) * spacing,
+ default.units=leg.unit, gp=gpar(cex = lcex))
+ }
+ grid.text(as.character(bnds[n]), textx, (n - 0.5) * spacing,
+ default.units=leg.unit, gp=gpar(cex = lcex))
+ grid.text("Counts", legend/2, (n + 1.5) * spacing,
+ default.units=leg.unit, gp=gpar(cex = 1.7 * lcex))
+ },
+
+ "centroids" = ,
+ "lattice" = {
+ ## NL Solved hex overlap problem on legend
+ ## Need to tackle too many categories
+ radius <- sqrt(minarea + (maxarea - minarea) * colorcut)
+ n <- length(radius)
+ shift <- c(0, 2*dy*radius)
+ shift <- shift[1:n] + shift[2:(n+1)]
+ #labht <- max(strheight(as.character(bnds), cex = lcex))
+ labht <- convertY(unit(get.gpar(names = "fontsize")[[1]]*lcex,
+ "points"),"native",valueOnly = TRUE)
+ shift <- pmax(labht, shift)
+ six <- rep.int(6:6, n)
+ xmid <- legend/3
+ inc <- ysize/(n+3)
+ if(inc > max(shift)) y <- inc * 1:n
+ else {
+ y <- cumsum(shift)
+ extra.slop <- (n * inc) - y[n] # FIXME? y[n] == sum(shift)
+ shift[-1] <- shift[-1] + extra.slop/(n-1)
+ y <- cumsum(shift)
+ ## (y+(1/n)*extra.slop)-y[1]
+ ## delta <- max(log(shift))-min(log(shift))
+ ## fudge <- extra.slop*(diff(log(shift))/delta)
+ ## y<- c(y[1], y[-1]+ fudge )
+ }
+ textx <- rep.int((2 * legend)/3, n)
+ ## ____________________plotting______________________
+ if(is.null(pen)) pen <- 1
+ if(is.null(border)) border <- pen
+ grid.polygon(x = rep.int(hexC$x,n)*
+ rep.int(radius, six) + rep.int(xmid, 6 * n),
+ y = rep.int(hexC$y,n)*
+ rep.int(radius, six) + rep.int(y, six),
+ default.units=leg.unit, id=NULL,
+ id.lengths=rep.int(6,n),
+ gp=gpar(fill = pen, col = border))
+
+ grid.text(as.character(bnds), textx, y,
+ default.units=leg.unit, gp=gpar(cex = lcex))
+ grid.text("Counts", legend/2, (n + 2) * inc,
+ default.units=leg.unit, gp=gpar(cex =1.7 * lcex))
+ },
+
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ ## _____________x scaling_____________________________
+ numb <- cut(floor(legend/inner), breaks = c(-1, 0, 2,4))
+ ## Note: In old code
+ ## top breaks=c(-1,0,2,4,8), numb<- 5 and size=1:9
+ if(is.na(numb))
+ numb <- 4
+ switch(numb,
+ {warning("not enough space for legend"); return()},
+ size <- 5,
+ size <- c(1, 5, 9),
+ size <- c(1, 3, 5, 7, 9))
+ xmax <- length(size)
+ radius <- sqrt(minarea + (maxarea - minarea) * (size - 1)/9)
+ txt <- as.character(size)
+ ##___________________y scaling_____________________
+ lab <- c("Ones", "Tens", "Hundreds",
+ "Thousands", "10 Thousands", "100 Thousands",
+ "Millions", "10 Millions",
+ "100 Millions", "Billions")
+ power <- floor(log10(maxcnt)) + 1
+ yinc <- 16 * dy
+ if(ysize/power < yinc)
+ {warning("Not enough height for legend"); return()}
+ xmid <- legend/10
+ x <- inner * (1:xmax - (1 + xmax)/2) + xmid
+ n <- length(x)
+ tx <- rep.int(hexC$x, n)
+ ty <- rep.int(hexC$y, n)
+ six <- rep.int(6:6, n)
+ y <- rep.int(3 * dy - yinc, xmax)
+ ## ____________________plotting______________________
+ if(is.null(pen)) {
+ pen <- 1:power +1
+ pen <- cbind(pen, pen +10)
+ }
+ if(is.null(border)) border <- FALSE
+ for(i in 1:power) {
+ y <- y + yinc
+ hexpolygon(x, y, hexC,
+ col = pen[i,1], border = border)
+ grid.polygon(x= tx * rep.int(radius, six) + rep.int(x, six),
+ y= ty * rep.int(radius, six) + rep.int(y, six),
+ default.units=leg.unit, id=NULL,
+ id.lengths=rep(6,n),
+ gp=gpar(fill = pen[i,2], col = border))
+
+ grid.text(txt, x, y - 4.5 * dy,
+ default.units=leg.unit, gp=gpar(cex = lcex))
+ ##adj= 0.5, cex = lcex)
+ grid.text(lab[i], xmid, y[1] + 4.5 * dy,
+ default.units=leg.unit, gp=gpar(cex = 1.7*lcex))
+ ##adj= 0.5, cex = 1.7*lcex)
+ }
+ })## switch(style = *)
+}## hex.legend()
diff --git a/R/hbox.R b/R/hbox.R
new file mode 100644
index 0000000..46913e3
--- /dev/null
+++ b/R/hbox.R
@@ -0,0 +1,83 @@
+hboxplot <- function(bin, xbnds = NULL, ybnds = NULL,
+ density, border = c(0,grey(.7)),
+ pen = c(2, 3), unzoom = 1.1, clip="off", reshape = FALSE,
+ xlab = NULL, ylab = NULL, main = "")
+{
+
+ ##_______________ Collect computing constants______________
+
+ if(!is(bin,"hexbin"))
+ stop("first argument must be a hexbin object")
+ h.xy <- hcell2xy(bin,check.erosion=TRUE)
+ ##___zoom in scaling with expanding to avoid hexagons outside plot frame___
+
+ if(is(bin,"erodebin")) {
+ h.xy$x <- h.xy$x
+ h.xy$y <- h.xy$y
+ nxbnds <- if(is.null(xbnds)) range(h.xy$x) else xbnds
+ nybnds <- if(is.null(ybnds)) range(h.xy$y) else ybnds
+ ratiox <- diff(nxbnds)/diff(bin at xbnds)
+ ratioy <- diff(nybnds)/diff(bin at ybnds)
+
+ ratio <- max(ratioy, ratiox)
+ nxbnds <- mean(nxbnds) + c(-1,1)*(unzoom * ratio * diff(bin at xbnds))/2
+ nybnds <- mean(nybnds) + c(-1,1)*(unzoom * ratio * diff(bin at ybnds))/2
+ }
+ else {
+ nxbnds <- if(is.null(xbnds)) bin at xbnds else xbnds
+ nybnds <- if(is.null(ybnds)) bin at ybnds else ybnds
+ }
+ margins <- unit(0.1 + c(5,4,4,3),"lines")
+ plot.vp <- hexViewport(bin, xbnds = nxbnds, ybnds = nybnds,
+ mar=margins, newpage = TRUE)
+ pushHexport(plot.vp)
+ grid.rect()
+ grid.xaxis()
+ grid.yaxis()
+ ## xlab, ylab, main :
+ if(is.null(xlab)) xlab <- bin at xlab
+ if(is.null(ylab)) ylab <- bin at ylab
+ if(nchar(xlab) > 0)
+ grid.text(xlab, y = unit(-2, "lines"), gp= gpar(fontsize= 16))
+ if(nchar(ylab) > 0)
+ grid.text(ylab, x = unit(-2, "lines"), gp= gpar(fontsize= 16), rot = 90)
+ if(nchar(main) > 0)
+ grid.text(main, y = unit(1, "npc") + unit(1.5, "lines"),
+ gp = gpar(fontsize = 18))
+ if(clip=="on") {
+ popViewport()
+ pushHexport(plot.vp, clip="on")
+ }
+
+ cnt <- if(is(bin,"erodebin")) bin at count[bin at eroded] else bin at count
+
+ xbins <- bin at xbins
+ shape <- bin at shape
+ xnew <- h.xy$x
+ ynew <- h.xy$y
+
+ ##__________________ Construct a hexagon___________________
+ dx <- (0.5 * diff(bin at xbnds))/xbins
+ dy <- (0.5 * diff(bin at ybnds))/(xbins * shape * sqrt(3))
+ hexC <- hexcoords(dx, dy, sep = NULL)
+
+ ##_______________ Full Cell Plotting_____________________
+ hexpolygon(xnew, ynew, hexC, density = density,
+ fill = pen[2], border = border[2])
+
+ ##______________Plotting median___________________________
+
+ if(!is(bin,"erodebin")) {
+ ## No warning here, allow non-erode above! warning("No erode component")
+ }
+ else {
+ med <- which.max(bin at erode)
+ xnew <- xnew[med]
+ ynew <- ynew[med]
+ hexpolygon(xnew, ynew, hexC, density = density,
+ fill = pen[1], border = border[1])
+ }
+ popViewport()
+ invisible(plot.vp)
+
+}# hboxplot()
diff --git a/R/hdiffplot.R b/R/hdiffplot.R
new file mode 100644
index 0000000..8dcdca4
--- /dev/null
+++ b/R/hdiffplot.R
@@ -0,0 +1,331 @@
+
+### FIXME: Need to check for bin erosion
+### or fix hcell2xy so that it checks for bin erosion.
+### --- Fixed hcell2xy, probably should do the same to other accessor functions
+### NL
+
+get.xrange <- function(xy.lst, xbnds)
+{
+ range(unlist(lapply(xy.lst,
+ function(xy, bnd)
+ xy$x[(xy$x < max(bnd)) & (xy$x > min(bnd))],
+ xbnds)))
+}
+
+get.yrange <- function(xy.lst, ybnds)
+{
+ range(unlist(lapply(xy.lst,
+ function(xy, bnd)
+ xy$y[(xy$y < max(bnd)) & (xy$y > min(bnd))],
+ ybnds)))
+}
+
+make.bnds <- function(binlst, xy.lst, xbnds = NULL, ybnds = NULL)
+{
+ if(inherits(binlst,"hexbinList")) binlst <- binlst at hbins
+ if(is.null(xbnds)) xbnds <- binlst[[1]]@xbnds
+ if(is.null(ybnds)) ybnds <- binlst[[1]]@ybnds
+
+ nxbnds <- get.xrange(xy.lst, xbnds)
+ nybnds <- get.yrange(xy.lst, ybnds)
+
+ list(xbnds = xbnds, ybnds = ybnds, nxbnds = nxbnds, nybnds = nybnds)
+}
+
+all.intersect <- function(binlist)
+{
+ ## This will not work if all the grids are not the same
+ ## Will have to rethink this if we move to non-aligned
+ ## hexagon bins. NL
+ if(inherits(binlist,"hexbinList")) binlist <- binlist at hbins
+ ans <- matrix(FALSE, nrow = binlist[[1]]@dimen[1]*binlist[[1]]@dimen[2],
+ ncol = length(binlist))
+ for(i in 1:length(binlist)) {
+ if(is(binlist[[i]], "erodebin"))
+ ans[binlist[[i]]@cell[binlist[[i]]@eroded], i] <- TRUE
+ else ans[binlist[[i]]@cell, i] <- TRUE
+ }
+ ans
+}
+
+## colordist <- function() {
+## }
+
+## MM: FIXME : `` get(where) '' is a kludge!
+# EJP: outcomment, seems obsolete?
+#mixcolors <- function (alpha, color1, where = class(color1))
+#{
+# alpha <- as.numeric(alpha)
+# c1 <- coords(as(color1, where))
+# na <- length(alpha)
+# n1 <- nrow(c1)
+# if(na == 1)
+# alpha <- rep(alpha, n1)
+# stopifnot(sum(alpha) == 1)
+# get(where)(t(apply(c1, 2, function(cols, alpha) alpha%*%cols, alpha)))
+#
+#}
+
+mixcolors2 <- function (colors, alpha, where="hsv")
+{
+ # colors: an n x 3 matrix of colors
+ # alpha: an n x 1 vector of color mixing coefficents
+ # sum(alpha)==1 should be a restriction?
+ # where: the color space to mix in (not implemented yet)
+ # The reurn value is a single hex color forming the mixture
+ # This function is purely linear mixing, nolinear mixing
+ # would be quite interesting since the colorspaces are not really
+ # linear, ie mixing alonga manifold in LUV space.
+ alpha <- as.numeric(alpha)
+ na <- length(alpha)
+ n1 <- nrow(colors)
+ if (n1 < 2) {
+ warning("need more than two colors to mix")
+ colors
+ }
+ if(na == 1)
+ alpha <- rep(alpha, n1)
+ stopifnot(abs(sum(alpha)-1) <= 0.01)
+ #colors <- convertColor(colors,from="sRGB",to="Lab",scale.in=1)
+ mix <- t(apply(colors, 2, function(cols, alpha) alpha%*%cols, alpha))
+ #convertColor(mix,from="hsv",to="hex",scale.out=1,clip=TRUE)
+ hsv(mix[1],mix[2],mix[3])
+}
+
+hdiffplot <-
+ function(bin1, bin2 = NULL, xbnds = NULL, ybnds = NULL,
+ focus = NULL,
+ col.control = list(medhex = "white", med.bord = "black",
+ focus = NULL, focus.border = NULL,
+ back.col = "grey"),
+ arrows = TRUE, size = unit(0.1, "inches"), lwd = 2,
+ eps = 1e-6, unzoom = 1.08, clip ="off", xlab = "", ylab = "",
+ main = deparse(mycall), ...)
+{
+ ## Arguments:
+ ## bin1 : hexagon bin object or a list of bin objects
+ ## bin2 : hexagon bin object or NULL
+ ## bin objects must have the same plotting bounds and shape
+ ## border : plot the border of the hexagon, use TRUE for
+ ## hexagon graph paper
+
+ ## Having all the same parameters ensures that all hexbin
+ ## objects have the same hexagon grid, and there will be no
+ ## problems intersecting them. When we have a suitable solution to
+ ## the hexagon interpolation/intersection problem this will be relaxed.
+ fixx <- xbnds
+ fixy <- ybnds
+
+ if(!inherits(bin1,"hexbinList")){
+ if(is.null(bin2) & is.list(bin1)) {
+ bin1 <- as(bin1,"hexbinList")
+ }
+ else if(is.null(bin2) & (!is.list(bin1)))
+ stop(" need at least 2 hex bin objects, or a hexbinList")
+ else {
+ if(bin1 at shape != bin2 at shape)
+ stop("bin objects must have same shape parameter")
+ if(all(bin1 at xbnds == bin2 at xbnds) & all(bin1 at ybnds == bin2 at ybnds))
+ equal.bounds <- TRUE
+ else stop("Bin objects need the same xbnds and ybnds")
+ if(bin1 at xbins != bin2 at xbins)
+ stop("Bin objects need the same number of bins")
+ nhb <- 2
+ ## Need to make a binlist class, then can do as(bin1, bin2, "binlist")
+ ## or something similar (NL)
+ bin1 <- list(bin1 = bin1, bin2 = bin2)
+ bin1 <- as(bin1,"hexbinList")
+ }
+ }
+ mycall <- sys.call()
+ if(length(mycall) >= 4) {
+ mycall[4] <- as.call(quote(.....()))
+ if(length(mycall) > 4) mycall <- mycall[1:4]
+ }
+ if(is.null(focus)) focus <- 1:bin1 at n
+ ##_______________ Collect computing constants______________
+ tmph.xy <- lapply(bin1 at hbins, hcell2xy, check.erosion = TRUE)
+
+ ## Check for erode bins
+ eroded <- unlist(lapply(bin1 at hbins, is, "erodebin"))
+ shape <- bin1 at Shape
+ xbins <- bin1 at Xbins
+ bnds <- make.bnds(bin1 at hbins, tmph.xy, xbnds = fixx, ybnds = fixy)
+ ratiox <- diff(bnds$nxbnds)/diff(bnds$xbnds)
+ ratioy <- diff(bnds$nybnds)/diff(bnds$ybnds)
+ ratio <- max(ratioy, ratiox)
+
+ nxbnds <- mean(bnds$nxbnds) + c(-1, 1)*(unzoom * ratio * diff(bnds$xbnds))/2
+ nybnds <- mean(bnds$nybnds) + c(-1, 1)*(unzoom * ratio * diff(bnds$ybnds))/2
+
+ ##__________________ Construct plot region___________________
+ hvp <- hexViewport(bin1 at hbins[[1]], xbnds = nxbnds, ybnds = nybnds,
+ newpage = TRUE)
+ pushHexport(hvp)
+ grid.rect()
+ grid.xaxis()
+ grid.yaxis()
+ if(nchar(xlab) > 0)
+ grid.text(xlab, y = unit(-2, "lines"), gp = gpar(fontsize = 16))
+ if(nchar(ylab) > 0)
+ grid.text(ylab, x = unit(-2, "lines"), gp = gpar(fontsize = 16), rot = 90)
+ if(sum(nchar(main)) > 0)
+ grid.text(main, y = unit(1, "npc") + unit(1.5, "lines"),
+ gp = gpar(fontsize = 18))
+
+ if(clip=='on'){
+ popViewport()
+ pushHexport(hvp,clip="on")
+ }
+ ##__________________ Construct hexagon___________________
+ dx <- (0.5 * diff(bin1 at Xbnds))/xbins
+ dy <- (0.5 * diff(bin1 at Ybnds))/(xbins * shape * sqrt(3))
+ hexC <- hexcoords(dx = dx, dy = dy)
+
+ ##__________________ Set up intersections and colors___________________
+ if(length(focus) < bin1 at n) {
+ bin1 at hbins <- c(bin1 at hbins[focus], bin1 at hbins[-focus])
+ bin1 at Bnames <- c(bin1 at Bnames[focus], bin1 at Bnames[-focus])
+ }
+ cell.stat <- all.intersect(bin1 at hbins)
+ cell.stat.n <- apply(cell.stat, 1, sum)
+ i.depth <- max(cell.stat.n)
+
+### I will do this as a recursive function once I get
+### The colors worked out! In fact for more than three
+### bin objects there is no other way to do this but recursively!!!
+### NL. -- Well this solution is like recursion :)
+ diff.cols <- vector(mode = "list", length = i.depth)
+ levcells <- which(cell.stat.n == 1)
+ whichbin <- apply(cell.stat[levcells, ], 1, which)
+
+ ## Set all the focal colors for the unique bin cells
+ ## if not specified make them equally spaced on the color wheel
+ ## with high saturation and set the background bins to gray
+ nfcol <- length(focus)
+ nhb <- bin1 at n
+ nbcol <- nhb-nfcol
+ fills <-
+ if(is.null(col.control$focus)) {
+ if(nbcol > 0)
+ matrix(c(seq(0, 360, length = nfcol+1)[1:nfcol]/360, rep(0, nbcol),
+ rep(1, nfcol), rep(0, nbcol),rep(1, nfcol), rep(.9, nbcol)),
+ ncol = 3)
+ ## V = c(rep(1, nfcol), seq(.9, .1, length=nbcol))
+
+ else #matrix(c(seq(0, 360, length = nhb+1), s=1, v=1)[1:nfcol]
+ matrix(c(seq(0, 360, length = nhb+1)/360,
+ rep(1,nhb+1),
+ rep(1,nhb+1)), ncol = 3)[1:nhb,]
+ }
+ else {
+ foc.col <- t(rgb2hsv(col2rgb(col.control$focus)))
+ if(nbcol > 0) {
+ bcol <- matrix(c(rep(0, 2*nbcol), rep(.9, nbcol)), ncol = 3)
+ rbind(foc.col, bcol)
+ }
+ else foc.col
+ }
+ colnames(fills) <- c("h","s","v")
+ diff.cols[[1]] <- list(fill = fills, border = gray(.8))
+
+ ##_______________ Full Cell Plotting for Unique Bin1 Cells_________________
+
+ if(length(levcells) > 0) {
+ for(i in unique(whichbin)) {
+ pcells <-
+ if(eroded[i])
+ bin1 at hbins[[i]]@cell[bin1 at hbins[[i]]@eroded]
+ else bin1 at hbins[[i]]@cell
+ pcells <- which(pcells %in% levcells[whichbin == i])
+ pfill <- diff.cols[[1]]$fill[i,]
+ pfill <- hsv(pfill[1],pfill[2],pfill[3])
+ hexpolygon(x = tmph.xy[[i]]$x[pcells],
+ y = tmph.xy[[i]]$y[pcells], hexC,
+ border = diff.cols[[1]]$border ,
+ fill = pfill)
+ }
+ }
+
+ ## Now do the intersections. All intersections are convex
+ ## combinations of the colors of the overlapping unique bins in
+ ## the CIEluv colorspace. so if the binlist is of length 2 and
+ ## the focal hbins are "blue" and "yellow" respectively the
+ ## intersection would be green. First I need to get this to work
+ ## and then I can think about how to override this with an option
+ ## in color.control. -NL
+
+ if(i.depth > 1) {
+ for(dl in 2:(i.depth)) {
+ levcells <- which(cell.stat.n == dl)
+ if(length(levcells) == 0) next
+
+ whichbin <- apply(cell.stat[levcells, ], 1,
+ function(x) paste(which(x), sep = "", collapse = ":"))
+ inter.nm <- unique(whichbin)
+ #fills <- matrix(0, length(inter.nm), 3)
+ fills <- rep(hsv(1), length(inter.nm))
+ i <- 1
+ for(bn in inter.nm) {
+ who <- as.integer(unlist(strsplit(bn, ":")))
+ fills[i] <- mixcolors2(diff.cols[[1]]$fill[who,],
+ 1/length(who),where = "LUV")
+ i <- i+1
+ }
+ #fills <- LUV(fills)
+ diff.cols[[dl]] <- list(fill = fills,
+ border = gray((i.depth-dl)/i.depth))
+ ##____Full Cell Plotting for Intersecting Cells at Intersection Depth i____
+ i <- 1
+ for(ints in inter.nm) {
+ bin.i <- as.integer(unlist(strsplit(ints, ":"))[1])
+ pcells <-
+ if(eroded[bin.i])
+ bin1 at hbins[[bin.i]]@cell[bin1 at hbins[[bin.i]]@eroded]
+ else bin1 at hbins[[bin.i]]@cell
+ pcells <- which(pcells %in% levcells[whichbin == ints])
+ hexpolygon(x = tmph.xy[[bin.i]]$x[pcells],
+ y = tmph.xy[[bin.i]]$y[pcells], hexC,
+ border = diff.cols[[dl]]$border ,
+ fill = diff.cols[[dl]]$fill[i] )
+ i <- i+1
+ }
+ }
+
+ }
+
+ ##_____________________________Plot Median Cells___________________________
+
+ ## With all these colors floating around I think it would be worth
+ ## porting the 3d hexagon stuff to grid. Then it would be easier
+ ## to distinguish the medians because they would stand out like
+ ## little volcanoes :) NL
+ if(any(eroded)) {
+ hmeds <- matrix(unlist(lapply(bin1 at hbins[eroded],
+ function(x) unlist(getHMedian(x)))),
+ ncol = 2, byrow = TRUE)
+ hexpolygon(x = hmeds[, 1], y = hmeds[, 2], hexC,
+ border = col.control$med.b, fill = col.control$medhex)
+ if(arrows) {
+ for(i in focus) {
+ for(j in focus[focus < i]) {
+ if(abs(hmeds[i, 1] - hmeds[j, 1]) +
+ abs(hmeds[i, 2] - hmeds[j, 2]) > eps)
+ grid.lines(c(hmeds[i, 1],hmeds[j, 1]),
+ c(hmeds[i, 2], hmeds[j, 2]),
+ default.units = "native",
+ arrow=arrow(length=size))
+ #grid.arrows(c(hmeds[i, 1], hmeds[j, 1]),
+ # c(hmeds[i, 2], hmeds[j, 2]),
+ # default.units = "native",
+ # length = size, gp = gpar(lwd = lwd))
+ }
+ }
+ }
+ }
+
+ ##________________Clean Up_______________________________________________
+
+ popViewport()
+ invisible(hvp)
+} ## hdiffplot()
diff --git a/R/hexPlotMA.R b/R/hexPlotMA.R
new file mode 100644
index 0000000..20ed2ba
--- /dev/null
+++ b/R/hexPlotMA.R
@@ -0,0 +1,196 @@
+plotMAhex <- function (MA, array = 1, xlab = "A", ylab = "M",
+ main = colnames(MA)[array],
+ xlim = NULL, ylim = NULL, status = NULL,
+ values, pch, col, cex, nbin=40,
+ zero.weights = FALSE,
+ style = "colorscale", legend = 1.2, lcex = 1,
+ minarea = 0.04, maxarea = 0.8, mincnt = 2,
+ maxcnt = NULL, trans = NULL, inv = NULL,
+ colorcut = NULL,
+ border = NULL, density = NULL, pen = NULL,
+ colramp = function(n){ LinGray(n,beg = 90,end = 15) },
+ newpage = TRUE, type = c("p", "l", "n"),
+ xaxt = c("s", "n"), yaxt = c("s", "n"),
+ verbose = getOption("verbose"))
+{
+ if (!requireNamespace("marray", quietly = TRUE))
+ stop("cannot process objects without package marray")
+ if (!requireNamespace("limma", quietly = TRUE))
+ stop("cannot process objects without package limma")
+ if(is.null(main))main <- ""
+ switch(class(MA),marrayRaw={
+ x <- marray::maA(MA[,array])
+ y <- marray::maM(MA[,array])
+ w <- marray::maW(MA[,array])
+ },RGList = {
+ MA <- limma::MA.RG(MA[, array])
+ array <- 1
+ x <- MA$A
+ y <- MA$M
+ w <- MA$w
+ }, MAList = {
+ x <- as.matrix(MA$A)[, array]
+ y <- as.matrix(MA$M)[, array]
+ if (is.null(MA$weights))
+ w <- NULL
+ else
+ w <- as.matrix(MA$weights)[, array]
+ }, list = {
+ if (is.null(MA$A) || is.null(MA$M))
+ stop("No data to plot")
+ x <- as.matrix(MA$A)[, array]
+ y <- as.matrix(MA$M)[, array]
+ if (is.null(MA$weights))
+ w <- NULL
+ else
+ w <- as.matrix(MA$weights)[, array]
+ }, MArrayLM = {
+ x <- MA$Amean
+ y <- as.matrix(MA$coefficients)[, array]
+ if (is.null(MA$weights))
+ w <- NULL
+ else
+ w <- as.matrix(MA$weights)[, array]
+ }, matrix = {
+ narrays <- ncol(MA)
+ if (narrays < 2)
+ stop("Need at least two arrays")
+ if (narrays > 5)
+ x <- apply(MA, 1, median, na.rm = TRUE)
+ else
+ x <- rowMeans(MA, na.rm = TRUE)
+ y <- MA[, array] - x
+ w <- NULL
+ }, ExpressionSet = {
+ if (!requireNamespace("Biobase", quietly = TRUE))
+ stop("cannot process ExpressionSet objects without package Biobase")
+ narrays <- ncol(Biobase::exprs(MA))
+ if (narrays < 2)
+ stop("Need at least two arrays")
+ if (narrays > 5)
+ x <- apply(Biobase::exprs(MA), 1, median, na.rm = TRUE)
+ else
+ x <- rowMeans(Biobase::exprs(MA), na.rm = TRUE)
+ y <- Biobase::exprs(MA)[, array] - x
+ w <- NULL
+ if (missing(main))
+ main <- colnames(Biobase::exprs(MA))[array]
+ }, AffyBatch = {
+ if (!requireNamespace("Biobase", quietly = TRUE) ||
+ !requireNamespace("affy", quietly = TRUE))
+ stop("cannot process AffyBatch objects without package Biobase and affy")
+ narrays <- ncol(Biobase::exprs(MA))
+ if (narrays < 2)
+ stop("Need at least two arrays")
+ if (narrays > 5)
+ x <- apply(log2(Biobase::exprs(MA)), 1, median, na.rm = TRUE)
+ else
+ x <- rowMeans(log2(Biobase::exprs(MA)), na.rm = TRUE)
+ y <- log2(Biobase::exprs(MA)[, array]) - x
+ w <- NULL
+ if (missing(main))
+ main <- colnames(Biobase::exprs(MA))[array]
+ }, stop("MA is invalid object"))
+ if (!is.null(w) && !zero.weights) {
+ i <- is.na(w) | (w <= 0)
+ y[i] <- NA
+ }
+ if (is.null(xlim))
+ xlim <- range(x, na.rm = TRUE)
+ if (is.null(ylim))
+ ylim <- range(y, na.rm = TRUE)
+
+ hbin <- hexbin(x,y,xbins=nbin,xbnds=xlim,ybnds=ylim, IDs = TRUE)
+ hp <- plot(hbin, legend=legend, xlab = xlab, ylab = ylab, main = main,
+ type='n', newpage=newpage)
+ ## plot the hexagons
+ pushHexport(hp$plot.vp)
+ if(is.null(maxcnt)) maxcnt <- max(hbin at count)
+ if(is.null(colorcut)) colorcut<-seq(0, 1, length = min(17, maxcnt))
+ grid.hexagons(hbin, style=style, minarea = minarea, maxarea = maxarea,
+ mincnt = mincnt, maxcnt= maxcnt, trans = trans,
+ colorcut = colorcut, density = density, border = border,
+ pen = pen, colramp = colramp)
+ if (is.null(status) || all(is.na(status))) {
+ if (missing(pch))
+ pch <- 16
+ if (missing(cex))
+ cex <- 0.3
+ if (missing(col)) {
+ clrs <- colramp(length(colorcut)-1)
+ col <- clrs[1]
+ }
+ pp <- inout.hex(hbin,mincnt)
+ grid.points(x[pp], y[pp], pch = pch[[1]],
+ gp=gpar(cex = cex[1], col=col, fill=col))
+ }
+ else {
+ if (missing(values)) {
+ if (is.null(attr(status, "values")))
+ values <- names(sort(table(status), decreasing = TRUE))
+ else
+ values <- attr(status, "values")
+ }
+ sel <- !(status %in% values)
+ nonhi <- any(sel)
+ if (nonhi) grid.points(x[sel], y[sel], pch = 16, gp=gpar(cex = 0.3))
+ nvalues <- length(values)
+ if (missing(pch)) {
+ if (is.null(attr(status, "pch")))
+ pch <- rep(16, nvalues)
+ else
+ pch <- attr(status, "pch")
+ }
+ if (missing(cex)) {
+ if (is.null(attr(status, "cex"))) {
+ cex <- rep(1, nvalues)
+ if (!nonhi)
+ cex[1] <- 0.3
+ }
+ else
+ cex <- attr(status, "cex")
+ }
+ if (missing(col)) {
+ if (is.null(attr(status, "col"))) {
+ col <- nonhi + 1:nvalues
+ }
+ else
+ col <- attr(status, "col")
+ }
+ pch <- rep(pch, length = nvalues)
+ col <- rep(col, length = nvalues)
+ cex <- rep(cex, length = nvalues)
+ for (i in 1:nvalues) {
+ sel <- status == values[i]
+ grid.points(x[sel], y[sel], pch = pch[[i]], gp=gpar(cex = cex[i], col = col[i]))
+ }
+ }
+ popViewport()
+ if (legend > 0) {
+ inner <- getPlt(hp$plot.vp, ret.unit="inches", numeric=TRUE)[1]
+ inner <- inner/hbin at xbins
+ ysize <- getPlt(hp$plot.vp, ret.unit="inches", numeric=TRUE)[2]
+ pushViewport(hp$legend.vp)
+ grid.hexlegend(legend, ysize=ysize, lcex = lcex, inner = inner,
+ style= style, minarea= minarea, maxarea= maxarea,
+ mincnt= mincnt, maxcnt= maxcnt,
+ trans=trans, inv=inv,
+ colorcut = colorcut,
+ density = density, border = border, pen = pen,
+ colramp = colramp)
+
+ #if (is.list(pch))
+ # legend(x = xlim[1], y = ylim[2], legend = values,
+ # fill = col, col = col, cex = 0.9)
+ #else legend(x = xlim[1], y = ylim[2], legend = values,
+ # pch = pch, , col = col, cex = 0.9)
+ popViewport()
+ }
+ invisible(list(hbin = hbin, plot.vp = hp$plot.vp, legend.vp = hp$legend.vp))
+}
+
+hexMA.loess <- function(pMA, span = .4, col = 'red', n = 200)
+{
+ fit <- hexVP.loess(pMA$hbin, pMA$plot.vp, span = span, col = col, n = n)
+ invisible(fit)
+}
diff --git a/R/hexViewport.R b/R/hexViewport.R
new file mode 100644
index 0000000..2adb1b4
--- /dev/null
+++ b/R/hexViewport.R
@@ -0,0 +1,253 @@
+setOldClass("unit")
+setOldClass("viewport")
+
+smartBnds <- function(hbin, eps=.05)
+{
+ hxy <- hcell2xy(hbin)
+ xr <- range(hxy$x)
+ yr <- range(hxy$y)
+ dx <- diff(xr)
+ dy <- diff(yr)
+ lambda <- function(a) pmax(log(a), 1)
+ epsx <- c(-1,1)*(dx*eps/lambda(dx))
+ epsy <- c(-1,1)*(dy*eps/lambda(dy))
+ sx <- hbin at xbins/diff(hbin at xbnds)
+ sy <- (hbin at xbins * hbin at shape)/diff(hbin at ybnds)
+ inner <- 0.5
+ outer <- 1/sqrt(3)
+ dx <- inner/sx
+ dy <- outer/sy
+ #xb <- dx/(hbin at xbins+1)
+ #yb <- dy/((1/sqrt(3))*(hbin at xbins+1)*hbin at shape)
+ list(xr = xr+ c(-dx,dx)+ epsx,
+ yr = yr+ c(-dy,dy)+ epsy)
+}
+
+rname <- function(n, chars = letters)
+{
+ ## random name with n characters
+ paste(sample(chars, size = n, replace = TRUE), collapse="")
+}
+
+setClass("hexVP",
+ representation(hexVp.on = "viewport", hexVp.off = "viewport",
+ mar = "unit", fig = "unit", plt = "unit",
+ xscale = "numeric", yscale = "numeric",shape="numeric",
+ hp.name="character")
+ )
+
+hexViewport <-
+function(x, offset = unit(0,"inches"), mar = NULL,
+ xbnds = NULL, ybnds = NULL, newpage = FALSE,
+ clip ="off", vp.name=NULL)
+{
+ if(!is(x,"hexbin"))
+ stop("first argument must be a hexbin object.")
+ stopifnot(is.unit(offset))
+
+ hvp <- new("hexVP")
+ if (newpage)
+ grid.newpage()
+
+ if(is.null(mar)) {
+ mar <- unit(0.1 + c(5,4,4,2),"lines")
+ }
+ else {
+ if(!is.unit(mar)) stop("'mar' must be specified in unit()s")
+ if(length(mar) == 1)
+ mar <- rep(mar, 4)
+ else if(length(mar) != 4)
+ stop("'mar' must have length 1 or 4")
+ }
+ ## in both cases
+ mai <- as.numeric(convertUnit(mar, "inches"))
+ vpin <- c(convertWidth (unit(1,"npc"),"inches"), convertHeight(unit(1,"npc"),"inches"))
+ fig <- c(as.numeric(convertUnit(unit(vpin[1],"inches") - offset,"inches")), as.numeric(vpin[2]))
+ pin <- c(fig[1]-mai[2]-mai[4], fig[2]-mai[1]-mai[3])
+ xsize <- pin[1]
+ ysize <- pin[2]
+
+ ## The point is to optimize the placement
+ ## and plotting area of the plotting window with
+ ## the constraint that the margins are preserved
+ ## to within some epsilon. This is going to get even
+ ## harder for cases where the complex layouts are
+ ## being constructed. NL -- I think it is fixed now (NL --3/22/2005)
+
+ ## Now find the maximum rectangle in fig that
+ ## has the correct aspect ratio and does not spill over epsilon into
+ ## the margins, i.e. ysize/xsize - aspect.ratio < eps and
+ ## xsize < fig[1], ysize < fig[2]
+
+ if(x at shape * xsize <= ysize) {
+ ##center <- (ysize - x at shape * xsize)/2
+ center <- (ysize - x at shape * xsize)/2
+ mai[1] <- mai[1] + center
+ mai[3] <- mai[3] + center
+ ysize <- x at shape * xsize
+ } else {
+ center <- (xsize - ysize/x at shape)/2
+ mai[2] <- mai[2] + center
+ mai[4] <- mai[4] + center
+ xsize <- ysize/x at shape
+ }
+ ##fig <- c(pin[1]+mai[2]+ mai[4],fig[2])
+ pin <- c(xsize,ysize)
+ mar <- c(convertUnit(unit(mai[1],"inches"),"lines"),
+ convertUnit(unit(mai[2],"inches"),"lines"),
+ convertUnit(unit(mai[3],"inches"),"lines"),
+ convertUnit(unit(mai[4],"inches"),"lines"))
+ ##pin <- c(fig[1]-(mai[2] + mai[4]),
+ ## fig[2]-(mai[1] + mai[3]))
+ margins <- rep(as.numeric(mar), length.out = 4)
+ wd <- convertUnit(unit(pin[1],"inches"),"npc")
+ ## (unit(sum(margins[c(2, 4)]), "lines") +
+ ## convertUnit(unit(legend,"inches"),"lines"))
+ ## Oy, mi stupido! This is the problem, need to get the bounds right
+ ## here. Fixed, do we need to guard against others stupidity and put some
+ ## checks on xbnds and ybnds? (NL,4/1/2005)
+ if(is.null(vp.name))
+ vp.name <- rname(5)
+ xyb <- smartBnds(x)
+ hvp at xscale <- xs <- if(is.null(xbnds)) xyb$xr else xbnds
+ hvp at yscale <- ys <- if(is.null(ybnds)) xyb$yr else ybnds
+ ht <- unit(1, "npc") - unit(sum(margins[c(1,3)]), "lines")
+ hvp at hexVp.off <-
+ viewport(x = unit(margins[2], "lines"),
+ y = unit(margins[1], "lines"),
+ width = wd, height = ht, xscale = xs, yscale = ys,
+ just = c("left", "bottom"), default.units = "native",
+ clip = "off", name = paste(vp.name,".off",sep=""))
+ hvp at hexVp.on <-
+ viewport(x = unit(margins[2], "lines"),
+ y = unit(margins[1], "lines"),
+ width = wd, height = ht, xscale = xs, yscale = ys,
+ just = c("left", "bottom"), default.units = "native",
+ clip = "on", name = paste(vp.name,".on",sep=""))
+ hvp at mar <- unit(mar,"lines")
+ hvp at fig <- convertUnit(unit(fig,"inches"),"npc")
+ hvp at plt <- convertUnit(unit(pin,"inches"),"npc")
+ hvp at shape <- x at shape
+ ##hvp at leg <-convertUnit(offset,"npc")
+ hvp
+}
+
+## Potentially:
+## setGeneric("grid:::pushViewport")
+## setMethod("pushViewport", signature(x="hexVP"),
+## function(hvp) { pushViewport(hvp at hexVp) })
+
+pushHexport <- function(hvp, clip="off")
+{
+ if(!is(hvp, "hexVP"))
+ stop("1st argument must be 'hexVP' object")
+ pushViewport(if(clip=="on") hvp at hexVp.on else hvp at hexVp.off)
+}
+
+## maybe in the future
+## setMethod("push",signature("hexVP"), pushHexport)
+
+setGeneric("getMargins", function(x, ret.unit = "npc", numeric = FALSE)
+ standardGeneric("getMargins"))
+setMethod("getMargins", "hexVP",
+ function(x, ret.unit = "npc", numeric = FALSE){
+ mar <- convertUnit(x at mar,ret.unit)
+ if(numeric) as.numeric(mar) else mar
+ })
+
+setGeneric("getPlt", function(x, ret.unit = "npc", numeric = FALSE)
+ standardGeneric("getPlt"))
+setMethod("getPlt", "hexVP",
+ function(x, ret.unit = "npc", numeric = FALSE){
+ plt <- convertUnit(x at plt,ret.unit)
+ if(numeric) as.numeric(plt) else plt
+ })
+
+setGeneric("getFig", function(x, ret.unit = "npc", numeric = FALSE)
+ standardGeneric("getFig"))
+setMethod("getFig", "hexVP",
+ function(x, ret.unit = "npc", numeric = FALSE){
+ fig <- convertUnit(x at fig,ret.unit)
+ if(numeric) as.numeric(fig) else fig
+ })
+
+## MM doesn't think it's ok to "pollute" the generic-space
+## just for basic slot accessors :
+
+## setGeneric("getXscale", function(x)standardGeneric("getXscale"))
+## setMethod("getXscale", "hexVP", function(x){ x at xscale })
+
+## setGeneric("getYscale", function(x)standardGeneric("getYscale"))
+## setMethod("getYscale", "hexVP", function(x){ x at yscale })
+
+hexVP.abline <- function(hvp, a = NULL, b = NULL, h = numeric(0),
+ v = numeric(0), col = 'black',
+ lty = 1, lwd = 2, ...)
+{
+ pushHexport(hvp, clip = 'on')
+ col.line <- col
+ if (!is.null(a)) {
+ if (inherits(a, "lm")) {
+ coeff <- coef(a)
+ }
+ else if (!is.null(tryCatch(coef(a), error = function(e) NULL)))
+ coeff <- coef(a)
+ else coeff <- c(a, b)
+ if (length(coeff) == 1)
+ coeff <- c(0, coeff)
+ if (coeff[2] == 0)
+ h <- c(h, coeff[1])
+ else if (!any(is.null(coeff))) {
+ xx <- current.viewport()$xscale
+ yy <- current.viewport()$yscale
+ x <- numeric(0)
+ y <- numeric(0)
+ ll <- function(i, j, k, l)
+ (yy[j] - coeff[1] - coeff[2] * xx[i]) * (yy[l] - coeff[1] - coeff[2] * xx[k])
+ if (ll(1, 1, 2, 1) <= 0) {
+ y <- c(y, yy[1])
+ x <- c(x, (yy[1] - coeff[1])/coeff[2])
+ }
+ if (ll(2, 1, 2, 2) <= 0) {
+ x <- c(x, xx[2])
+ y <- c(y, coeff[1] + coeff[2] * xx[2])
+ }
+ if (ll(2, 2, 1, 2) <= 0) {
+ y <- c(y, yy[2])
+ x <- c(x, (yy[2] - coeff[1])/coeff[2])
+ }
+ if (ll(1, 2, 1, 1) <= 0) {
+ x <- c(x, xx[1])
+ y <- c(y, coeff[1] + coeff[2] * xx[1])
+ }
+ if (length(x) > 0)
+ grid.lines(x = x, y = y, default.units = "native",
+ gp = gpar(col = col.line, lty = lty, lwd = lwd))
+ }
+ }
+ h <- as.numeric(h)
+ v <- as.numeric(v)
+ for (i in seq(along = h))
+ grid.lines(y = rep(h[i], 2), default.units = "native",
+ gp = gpar(col = col.line, lty = lty, lwd = lwd))
+ for (i in seq(along = v))
+ grid.lines(x = rep(v[i], 2), default.units = "native",
+ gp = gpar(col = col.line, lty = lty, lwd = lwd))
+ popViewport()
+}
+
+hexVP.loess <- function(hbin, hvp = NULL, span = 0.4, col = 'red', n = 200)
+{
+ fit <- loess(hbin at ycm ~ hbin at xcm, weights = hbin at count, span = span)
+ if(!is.null(hvp)) {
+ pushHexport(hvp, clip = 'on')
+# grid.lines(seq(0,16, length = n),
+# predict(fit,seq(0,16, length = n)),
+# gp = gpar(col = col), default.units = 'native')
+ grid.lines(seq(hbin at xbnds[1], hbin at xbnds[2], length = n),
+ predict(fit,seq(hbin at xbnds[1], hbin at xbnds[2], length = n)),
+ gp = gpar(col = col), default.units = 'native')
+ popViewport()
+ }
+ invisible(fit)
+}
diff --git a/R/hexbin.s4.R b/R/hexbin.s4.R
new file mode 100644
index 0000000..634a442
--- /dev/null
+++ b/R/hexbin.s4.R
@@ -0,0 +1,355 @@
+## namespace *internal* function:
+addBit <- function(bnds, f = 0.05) bnds + c(-f, f) * diff(bnds)
+hexbin <-
+ function(x, y = NULL, xbins = 30, shape = 1,
+ xbnds = range(x), ybnds = range(y),
+ xlab = NULL, ylab = NULL, IDs = FALSE)
+{
+ call <- match.call()
+ ## (x,y, xlab, ylab) dealing
+ xl <- if (!missing(x)) deparse(substitute(x))
+ yl <- if (!missing(y)) deparse(substitute(y))
+ xy <- xy.coords(x, y, xl, yl)
+ ch0 <- function(u) if(is.null(u)) "" else u
+ xlab <- if (is.null(xlab)) ch0(xy$xlab) else xlab
+ ylab <- if (is.null(ylab)) ch0(xy$ylab) else ylab
+ if(! (is.character(xlab) || is.expression(xlab)))
+ stop("xlab must be a character or expression")
+ if(! (is.character(ylab) || is.expression(ylab)))
+ stop("ylab must be a character or expression")
+
+ x <- xy$x
+ y <- xy$y
+ n <- length(x)
+ na <- is.na(x) | is.na(y)
+ has.na <- any(na)
+ if (has.na) {
+ ok <- !na
+ x <- x[ok]
+ y <- y[ok]
+ n0 <- n
+ na.pos <- which(na)
+ n <- length(x)
+ }
+ if(diff(xbnds) <= 0)
+ stop("xbnds[1] < xbnds[2] is not fulfilled")
+ if(!missing(xbnds) && any(sign(xbnds - range(x)) == c(1,-1)))
+ stop("'xbnds' must encompass range(x)")
+ if(diff(ybnds) <= 0)
+ stop("ybnds[1] < ybnds[2] is not fulfilled")
+ if(!missing(ybnds) && any(sign(ybnds - range(y)) == c(1,-1)))
+ stop("'ybnds' must encompass range(y)")
+ jmax <- floor(xbins + 1.5001)
+ #imax <- 2 * floor((xbins * shape)/sqrt(3) + 1.5001)
+ c1 <- 2 * floor((xbins *shape)/sqrt(3) + 1.5001)
+ imax <- trunc((jmax*c1 -1)/jmax + 1)
+ lmax <- jmax * imax
+ ans <- .Fortran("hbin",
+ x = as.double(x),
+ y = as.double(y),
+ cell = integer(lmax),
+ cnt = integer(lmax),
+ xcm = double(lmax),
+ ycm = double(lmax),
+ xbins = as.double(xbins),
+ shape = as.double(shape),
+ xbnds = as.double(xbnds),
+ ybnds = as.double(ybnds),
+ dim = as.integer(c(imax, jmax)),
+ n = as.integer(n),
+ cID = if(IDs) integer(n) else as.integer(-1),
+ PACKAGE = "hexbin")[-(1:2)]
+
+ ## cut off extraneous stuff
+ if(!IDs) ans$cID <- NULL
+ if(IDs && has.na) {
+ ok <- as.integer(ok)
+ ok[!na] <- ans$cID
+ ok[na] <- NA
+ ans$cID <- ok
+ }
+ nc <- ans$n
+ length(ans$cell) <- nc
+ length(ans$cnt) <- nc
+ length(ans$xcm) <- nc
+ length(ans$ycm) <- nc
+ if(sum(ans$cnt) != n) warning("Lost counts in binning")
+ new("hexbin",
+ cell = ans$cell, count = ans$cnt,
+ xcm = ans$xcm, ycm = ans$ycm, xbins = ans$xbins,
+ shape = ans$shape, xbnds = ans$xbnds , ybnds = ans$ybnds,
+ dimen = c(imax, jmax), n = n, ncells = ans$n,
+ call = call, xlab = xlab, ylab = ylab, cID = ans$cID, cAtt = integer(0))
+ #dimen = ans$dim
+}## hexbin
+
+setClassUnion("integer or NULL",# < virtual class, used in 'cID' slot
+ members = c("integer","NULL"))
+## MM: I've learned that we should think twice before defining such
+## "or NULL" classes:
+## setClassUnion("vector or NULL",# < virtual class, used in 'cAtt' slot
+## members = c("vector","NULL"))
+
+setClass("hexbin",
+ representation(cell = "integer", count = "numeric",##count = "integer",
+ xcm = "numeric", ycm = "numeric", xbins = "numeric",
+ shape = "numeric", xbnds = "numeric",
+ ybnds = "numeric", dimen = "numeric",
+ n = "integer", ncells = "integer", call = "call",
+ xlab = "vector", ylab = "vector",
+ #xlab = "character", ylab = "character",
+ cID = "integer or NULL", cAtt = "vector")## "or NULL"
+ )
+
+
+#setIs("hexbin", function(hbin) class(hbin)=="hexbin")
+
+## FIXME: add 'validity checking method!
+
+setGeneric("hcell2xy", function(hbin, check.erosion = TRUE)
+ standardGeneric("hcell2xy"))
+setMethod("hcell2xy", "hexbin", function(hbin, check.erosion = TRUE)
+{
+ xbins <- hbin at xbins
+ xbnds <- hbin at xbnds
+ c3 <- diff(xbnds)/xbins
+ ybnds <- hbin at ybnds
+ c4 <- (diff(ybnds) * sqrt(3))/(2 * hbin at shape * xbins)
+ jmax <- hbin at dimen[2]
+ cell <- hbin at cell - 1
+ i <- cell %/% jmax
+ j <- cell %% jmax
+ y <- c4 * i + ybnds[1]
+ x <- c3 * ifelse(i %% 2 == 0, j, j + 0.5) + xbnds[1]
+ if(check.erosion && inherits(hbin,"erodebin"))
+ list(x = x[hbin at eroded], y = y[hbin at eroded])
+ else
+ list(x = x, y = y)
+})
+
+setGeneric("getHexDxy", function(hbin) standardGeneric("getHexDxy"))
+setMethod("getHexDxy", "hexbin", function(hbin){
+ sx <- hbin at xbins/diff(hbin at xbnds)
+ sy <- (hbin at xbins * hbin at shape)/diff(hbin at ybnds)
+ list(dx=.5/sx, dy=(1/sqrt(3))/(2*sy))
+})
+
+
+setClass("erodebin", representation("hexbin",
+ eroded = "logical",
+ cdfcut = "numeric",
+ erode = "integer"))
+
+setGeneric("erode", function(hbin, cdfcut = 0.5) standardGeneric("erode"))
+
+## currently define the 'hexbin' method (also) as standalone function:
+erode.hexbin <- function(hbin, cdfcut = 0.5)
+{
+ if(!is(hbin,"hexbin")) stop("first argument must be a hexbin object")
+ #bin.att <- attributes(hbin)
+ cell <- hbin at cell
+ cnt <- hbin at count
+ tmp <- sort(cnt)
+ cdf <- cumsum(tmp)/sum(cnt)
+ good <- cdfcut <= cdf
+ if(!any(good))
+ return("no cells selected")
+ crit <- min(tmp[good])
+ good <- crit <= cnt
+ cell <- cell[good]
+ cnt <- cnt[good]
+ #hbin at cell <- cell
+ #hbin at count <- cnt
+ n <- length(cell)
+ bdim <- hbin at dimen
+ L <- bdim[1] * bdim[2]
+ ans <- .Fortran("herode",
+ cell = as.integer(cell),
+ cnt = as.integer(cnt),
+ n = n,
+ bdim = as.integer(bdim),
+ erode = integer(L),
+ ncnt = integer(L),
+ ncell = integer(L),
+ sides = integer(L),
+ neib = integer(6 * L),
+ exist = logical(L + 1),
+ PACKAGE = "hexbin") $ erode
+ length(ans) <- n
+ ehbin <- new("erodebin", hbin, cdfcut = cdfcut, eroded = good, erode = ans)
+ #hbin at erode <- ans
+ #class(hbin) <- c(class(hbin),"erodebin")
+ ehbin
+}
+setMethod("erode", "hexbin", erode.hexbin)
+
+setGeneric("getHMedian", function(ebin) standardGeneric("getHMedian"))
+setMethod("getHMedian", "erodebin", function(ebin)
+ {
+ xy <- hcell2xy(ebin)
+ stopifnot(1 == length(med <- which.max(ebin at erode)))
+ med.x <- xy$x[med]
+ med.y <- xy$y[med]
+
+ list(x = med.x, y = med.y)
+ })
+
+## Still define the 'hexbin' plot method (also) as standalone function:
+## This is deprecated!
+gplot.hexbin <-
+ function(x, style = "colorscale",
+ legend = 1.2, lcex = 1,
+ minarea = 0.04, maxarea = 0.8, mincnt = 1, maxcnt = max(x at count),
+ trans = NULL, inv = NULL,
+ colorcut = seq(0, 1, length = min(17, maxcnt)),
+ border = NULL, density = NULL, pen = NULL,
+ colramp = function(n) LinGray(n, beg = 90, end = 15),
+ xlab = NULL, ylab = NULL, main = "", newpage = TRUE,
+ type = c("p", "l", "n"), xaxt = c("s", "n"), yaxt = c("s", "n"),
+ clip="on", verbose = getOption("verbose"))
+{
+ if(!is(x,"hexbin"))
+ stop("first argument must be a hexbin object")
+ if(minarea < 0)
+ stop("Minimum area must be non-negative")
+ if(maxarea > 1)
+ warning("Maximum area should be <= 1 this leads to overlapping hexagons")
+ if(minarea > maxarea)
+ stop("Minarea must be <= maxarea")
+ if (length(colorcut) > 1) { # a sequence 0,...,1
+ if(colorcut[1] != 0)
+ stop("Colorcut lower boundary must be 0")
+ if(colorcut[length(colorcut)] != 1)
+ stop("Colorcut upper boundary must be 1")
+ }
+ else {
+ colorcut <-
+ if(colorcut > 1) seq(0, 1, length = min(c(17, colorcut, maxcnt)))
+ else 1
+ }
+
+ if(is.logical(legend)) {
+ if(legend)
+ stop("Give the legend width")
+ else legend <- 0
+ } else stopifnot(is.numeric(legend) && length(legend) == 1)
+
+ type <- match.arg(type)
+ xaxt <- match.arg(xaxt)
+ yaxt <- match.arg(yaxt)
+
+ ## ----- plotting starts ------------------------
+ if (newpage) grid.newpage()
+ hv.ob <- hexViewport(x, offset = unit(legend,"inches"))
+ pushViewport(hv.ob at hexVp.off)
+ grid.rect()
+ if(xaxt != "n") grid.xaxis()
+ if(yaxt != "n") grid.yaxis()
+ ## xlab, ylab, main :
+ if(is.null(xlab)) xlab <- x at xlab
+ if(is.null(ylab)) ylab <- x at ylab
+ if(nchar(xlab) > 0)
+ grid.text(xlab, y = unit(-2, "lines"), gp = gpar(fontsize = 16))
+ if(nchar(ylab) > 0)
+ grid.text(ylab, x = unit(-2, "lines"), gp = gpar(fontsize = 16), rot = 90)
+ if(nchar(main) > 0)
+ grid.text(main, y = unit(1, "npc") + unit(1.5, "lines"),
+ gp = gpar(fontsize = 18))
+ if(type != "n") {
+ if(clip == "on") {
+ popViewport()
+ pushViewport(hv.ob at hexVp.on)
+ }
+ grid.hexagons(x, style = style, minarea = minarea, maxarea = maxarea,
+ mincnt = mincnt, maxcnt = maxcnt, check.erosion = FALSE,
+ trans = trans, colorcut = colorcut, density = density,
+ border = border, pen = pen,
+ colramp = colramp, verbose = verbose)
+ }
+
+ popViewport()# plot
+ #popViewport()# fig
+ ## ----- Legend ------------------------
+ if(legend > 0) {
+ if(!is.null(trans) && is.null(inv))
+ stop("Must supply the inverse transformation")
+ if(verbose)
+ cat("plot.hexbin( legend > 0): ... hex.legend()\n")
+ inner <- getPlt(hv.ob, ret.unit = "inches", numeric = TRUE)[1]/x at xbins
+ ##inner <- as.numeric(convertUnit(hv.ob at plt[1],"inches"))/x at xbins
+ ##outer <- (inner * sqrt(3))/2
+ ##switch(style,
+ ## lattice = ,
+ ## centroids = {
+ ## if(length(colorcut) * outer > ysize - 1) {
+ ## warning("Colorcut is being shortened")
+ ## colorcut <- seq(0, 1,
+ ## max(1, floor((ysize - 1)/outer)))
+ ## }
+ ## }
+ ## )
+ ysize <- getPlt(hv.ob, ret.unit = "inches", numeric = TRUE)[2]
+ #as.numeric(convertUnit(hv.ob at plt[2],"inches"))
+ legVp <- viewport(x = unit(1,"npc") -
+ convertX(unit(legend,"inches"), "npc"),
+ #y = convertY(unit(mai[1],"inches"),"npc"),
+ y = hv.ob at mar[1],
+ #height = unit(1,"npc") -
+ #convertY(unit(mai[3]+mai[1],"inches"),"npc"),
+ height = unit(1,"npc")-(hv.ob at mar[1]+ hv.ob at mar[3]),
+ width = convertUnit(unit(legend,"inches"),"npc"),
+ default.units = "native",
+ just = c("left","bottom"),
+ xscale = c(0, legend),
+ yscale = c(0, ysize))
+ if(type != "n") {
+ pushViewport(legVp)
+ grid.hexlegend(legend, ysize = ysize, lcex = lcex, inner = inner,
+ style = style, minarea = minarea, maxarea = maxarea,
+ mincnt = mincnt, maxcnt = maxcnt,
+ trans = trans, inv = inv, colorcut = colorcut,
+ density = density, border = border, pen = pen,
+ colramp = colramp)
+ popViewport()
+ }
+ }
+
+ invisible(list(plot.vp = hv.ob, legend.vp = if(legend) legVp))
+} ## gplot.hexbin()
+
+setMethod("plot", signature(x = "hexbin", y = "missing"), gplot.hexbin)
+
+setMethod("show", "hexbin",
+ function(object) {
+ cat("'hexbin' object from call:", deparse(object at call), "\n")
+ dm <- object at dimen
+ cat("n =", object at n, " points in nc =", object at ncells,
+ " hexagon cells in grid dimensions ", dm[1], "by", dm[2],"\n")
+ invisible(object)
+ })
+
+setMethod("summary", "hexbin",
+ function(object, ...) {
+ show(object, ...)
+ print(summary(data.frame(cell = object at cell, count = object at count,
+ xcm = object at xcm, ycm = object at ycm),
+ ...))
+ if(!is.null(object at cID)) {
+ cat("IDs: "); str(object at cID)
+ }
+ })
+
+
+
+if(FALSE) { ##-- todo --
+#setMethod("identify"
+identify.hexbin <- function(x, labels = x$cnt, offset = 0, ...)
+{
+ if(length(labels) != x$n)
+ stop("labels not the same length as number of cells")
+ ##NL: Should this be a warning?
+
+ ## -> typically default method:
+ identify(hcell2xy(x), labels = labels, offset = offset, ...)
+}
+}#not yet
diff --git a/R/hexbinList.R b/R/hexbinList.R
new file mode 100644
index 0000000..7938ab6
--- /dev/null
+++ b/R/hexbinList.R
@@ -0,0 +1,106 @@
+hexList <- function(x,y=NULL,given=NULL,xbins=30,shape=1,
+ xbnds = NULL, ybnds = NULL,
+ xlab = NULL, ylab = NULL)
+{
+ xl <- if (!missing(x)) deparse(substitute(x))
+ yl <- if (!missing(y)) deparse(substitute(y))
+ xy <- xy.coords(x, y, xl, yl)
+ if(length(given)!=length(xy$x) | is.null(given))
+ stop("Given is is different length from x and y")
+ if(is.factor(given))
+ given <- as.character(given)
+ clss <- unique(given)
+ if(is.null(xbnds))
+ xbnds <- range(xy$x)
+ if(is.null(ybnds))
+ ybnds <- range(xy$y)
+ hbins <- vector(mode = "list",length=length(clss))
+ i <- 1
+ for(g in clss){
+ hbins[[i]] <- hexbin(xy$x[given==g],xy$y[given==g],
+ xbins=xbins,shape=shape,xbnds=xbnds,ybnds=ybnds)
+ i <- i+1
+ }
+ mx <- max(unlist(lapply(hbins,function(h)max(h at count))))
+ mn <- min(unlist(lapply(hbins,function(h)min(h at count))))
+ hl <- new("hexbinList",n=length(hbins),hbins=hbins, Xbnds=xbnds,
+ Ybnds=ybnds, Xbins=integer(xbins), Shape=shape, Bnames=clss,
+ CntBnds=c(mn,mx))
+ hl
+}
+
+
+setClass("hexbinList",
+ representation(n="integer", hbins="vector",
+ Xbnds="numeric", Ybnds="numeric",
+ Xbins="numeric", Shape="numeric",
+ Bnames="character", CntBnds="numeric")
+
+ )
+
+
+bnds.check <- function(binlst, xb = TRUE, yb = TRUE)
+{
+ xb <-
+ if(xb) {
+ b <- binlst[[1]]@xbnds
+ all(unlist(lapply(binlst, function(x, bnd) all(x at xbnds == bnd), b)))
+ } else TRUE
+ yb <-
+ if(yb) {
+ b <- binlst[[1]]@ybnds
+ all(unlist(lapply(binlst, function(y, bnd) all(y at ybnds == bnd), b)))
+ } else TRUE
+ xb & yb
+}
+
+xbins.check <- function(binlst)
+{
+ xb <- binlst[[1]]@xbins
+ all(unlist(lapply(binlst, function(y, xbin)all(y at xbins == xbin), xb)))
+}
+
+shape.check <- function(binlst)
+{
+ xs <- binlst[[1]]@shape
+ all(unlist(lapply(binlst, function(y, xsh)all(y at shape == xsh), xs)))
+}
+
+list2hexList <- function(binlst)
+{
+ if(length(binlst) < 2)
+ stop(" need at least 2 hex bin objects")
+ if(!all(unlist(lapply(binlst, is, "hexbin"))))
+ stop("All Elements of list must be hexbin objects")
+ if(!bnds.check(binlst))
+ stop("All bin objects in list need the same xbnds and ybnds")
+ if(!xbins.check(binlst))
+ stop("All bin objects in list need the same number of bins")
+ if(!shape.check(binlst))
+ stop("All bin objects in list need the same shape parameter")
+ mx <- max(unlist(lapply(binlst,function(h)max(h at count))))
+ mn <- min(unlist(lapply(binlst,function(h)min(h at count))))
+ xbins <- binlst[[1]]@xbins
+ xbnds <- binlst[[1]]@xbnds
+ ybnds <- binlst[[1]]@ybnds
+ shape <- binlst[[1]]@shape
+ hl <- new("hexbinList",n=length(binlst),hbins=binlst, Xbnds=xbnds,
+ Ybnds=ybnds, Xbins=xbins, Shape=shape,
+ Bnames=names(binlst), CntBnds=c(mn,mx))
+ hl
+}
+
+setAs("list","hexbinList",function(from)list2hexList(from))
+
+#setMethod("[", "hexbinList", function(hbl,i,...)
+#{
+# if( length(list(...)) > 0 )
+# stop("extra subscripts cannot be handled")
+# if(missing(i)) hbl
+# hbl at hbins[i]
+#})
+
+##setMethod("[[", "hexbinList", function(hbl)
+##{
+
+##})
diff --git a/R/hexbinplot.R b/R/hexbinplot.R
new file mode 100644
index 0000000..e8ede8c
--- /dev/null
+++ b/R/hexbinplot.R
@@ -0,0 +1,777 @@
+## lattice version of gplot.hexbin
+
+## There are two major problems. (1) For comparability across panels,
+## we want the same mincnt and maxcnt in all panels. However, a
+## suitable default can really only be determined at printing time,
+## since it would depend on the physical dimensions of the panel. (2)
+## there is no proper way to communicate the mincnt and maxcnt to the
+## legend.
+
+## Tentative solution: the counts can be calculated once enough things
+## are known, namely the aspect ratio, xbins and [xy]bnds. An
+## important question then is whether [xy]bnds should be [xy]lim or
+## range([xy]). Both should be allowed, since [xy]lim makes them
+## comparable, range([xy]) potentially shows more detail. For
+## relation != "same", both are more or less similar. An important
+## observation is that with range([xy]), 'shape = aspect ratio of
+## panel' does not guarantee symmetric hexagons, so shape has to be
+## different for each panel.
+
+## Only feasible approach I can think of is to produce the trellis
+## object first (with known aspect, so aspect="fill" is absolutely
+## no-no), then analyze the limits and relevant panel arguments to get
+## 'maxcnt' (essentially doing a dry run of the panel calculations).
+## This needs undocumented knowledge of the trellis object, which is
+## kinda not good, but at least it gets the job done. Once we know
+## maxcnt, we can also set up a suitable legend function.
+
+## Unfortunately, this has the potential to screw up update calls that
+## modify certain things. Is there any way to capture those? Maybe
+## make a new class that inherits from "trellis". For now, we'll
+## pretend that the problem doesn't exist.
+
+
+## tool borrowed from lattice
+updateList <- function (x, val)
+{
+ if (is.null(x)) x <- list()
+ modifyList(x, val)
+}
+
+
+prepanel.hexbinplot <-
+ function(x, y, type = character(0),...)
+{
+ if('tmd'%in%type){
+ tmp <- x
+ x <- (y + x)/sqrt(2)
+ y <- (y - tmp)/sqrt(2)
+ }
+ ans <-
+ list(xlim = range(x, finite = TRUE),
+ ylim = range(y, finite = TRUE),
+ dx = IQR(x,na.rm=TRUE),
+ dy = IQR(y,na.rm=TRUE))
+}
+
+
+panel.hexbinplot <-
+ function(x, y, ..., groups = NULL)
+{
+ if (is.null(groups)) panel.hexbin(x, y, ...)
+ else panel.hexpose(x, y, ..., groups = groups)
+}
+
+
+panel.hexbin <-
+ function(x, y,
+ xbins = 30,
+ xbnds = c("data", "panel"), # was: xbnds = c("panel", "data"),
+ ybnds = c("data", "panel"), # was: ybnds = c("panel", "data"),
+
+ ## special args
+ .prelim = FALSE,
+ .cpl = current.panel.limits(),
+ .xlim = .cpl$xlim,
+ .ylim = .cpl$ylim,
+ .aspect.ratio = 1, # default useful with splom(, panel = panel.hexbin)
+
+ type = character(0),
+ ...,
+ check.erosion = FALSE)
+{
+ if ("tmd" %in% type) {
+ tmp <- x
+ x <- (y + x)/sqrt(2)
+ y <- (y - tmp)/sqrt(2)
+ }
+ if (is.character(xbnds))
+ xbnds <-
+ switch(match.arg(xbnds),
+ panel = .xlim,
+ data = range(x, finite = TRUE))
+ if (is.character(ybnds))
+ ybnds <-
+ switch(match.arg(ybnds),
+ panel = .ylim,
+ data = range(y, finite = TRUE))
+ shape <-
+ .aspect.ratio * (diff(ybnds) / diff(.ylim)) /
+ (diff(xbnds) / diff(.xlim))
+ if (!missing(check.erosion))
+ warning("explicit 'check.erosion' specification ignored")
+ h <- hexbin(x = x, y = y,
+ xbins = xbins, shape = shape,
+ xbnds = xbnds, ybnds = ybnds)
+ if (.prelim)
+ return(max(h at count))
+
+ ## have to do this because grid.hexagons croaks with unrecognized
+ ## arguments:
+ args <- list(dat = h, check.erosion = FALSE, ...)
+ keep <- names(args) %in% names(formals(grid.hexagons))
+
+ if ('g' %in% type) panel.grid(h = -1, v = -1)
+ if ('hg' %in% type) panel.hexgrid(h)
+
+ do.call("grid.hexagons", args[keep])
+
+ if ("r" %in% type) panel.lmline(x, y, ...)
+ if ("smooth" %in% type) panel.hexloess(h,...)
+ invisible()
+}
+
+panel.hexboxplot <-
+ function(x, y,
+ xbins = 30,
+ xbnds = c("data", "panel"), # was: xbnds = c("panel", "data"),
+ ybnds = c("data", "panel"), # was: ybnds = c("panel", "data"),
+
+ ## special args
+ .prelim = FALSE,
+ .cpl = current.panel.limits(),
+ .xlim = .cpl$xlim,
+ .ylim = .cpl$ylim,
+ .aspect.ratio = 1,
+
+ type = character(0),
+ cdfcut=.25,
+ shadow=.05,
+ ...,
+ check.erosion = TRUE)
+{
+ if (is.character(xbnds))
+ xbnds <-
+ switch(match.arg(xbnds),
+ panel = .xlim,
+ data = range(x, finite = TRUE))
+ if (is.character(ybnds))
+ ybnds <-
+ switch(match.arg(ybnds),
+ panel = .ylim,
+ data = range(y, finite = TRUE))
+ shape <-
+ .aspect.ratio * (diff(ybnds) / diff(.ylim)) /
+ (diff(xbnds) / diff(.xlim))
+ if (!missing(check.erosion))
+ warning("explicit 'check.erosion' specification ignored")
+ h <-hexbin(x = x, y = y,
+ xbins = xbins, shape = shape,
+ xbnds = xbnds, ybnds = ybnds,IDs=TRUE)
+
+ if (.prelim)
+ return(max(h at count))
+
+ ## have to do this because grid.hexagons croaks with unrecognized
+ ## arguments:
+ args <- list(dat = h, check.erosion = FALSE, ...)
+ keep <- names(args) %in% names(formals(grid.hexagons))
+ if ('hg' %in% type) panel.hexgrid(h)
+ if ('g' %in% type) panel.grid(h = -1, v = -1)
+ if(shadow) {
+ eh <- erode(h,cdfcut=shadow)
+ h.xy <- hcell2xy(eh,check.erosion=TRUE)
+ dx <- (0.5 * diff(eh at xbnds))/eh at xbins
+ dy <- (0.5 * diff(eh at ybnds))/(eh at xbins * h at shape * sqrt(3))
+ hexC <- hexcoords(dx, dy, sep = NULL)
+ hexpolygon(h.xy$x,h.xy$y, hexC, density = density,
+ fill = NA, border = gray(.75))
+ }
+ eh <- erode(h,cdfcut=cdfcut)
+ h.xy <- hcell2xy(eh,check.erosion=TRUE)
+ dx <- (0.5 * diff(eh at xbnds))/eh at xbins
+ dy <- (0.5 * diff(eh at ybnds))/(eh at xbins * h at shape * sqrt(3))
+ hexC <- hexcoords(dx, dy, sep = NULL)
+ hexpolygon(h.xy$x,h.xy$y, hexC, density = density,
+ fill = "green", border = gray(.75))
+ med <- which.max(eh at erode)
+ xnew <- h.xy$x[med]
+ ynew <- h.xy$y[med]
+ hexpolygon(xnew, ynew, hexC, density = density,
+ fill = "red", border =gray(.25))
+ invisible()
+}
+
+panel.hexpose <-
+ function(x, y, groups, subscripts,
+ xbins = 30,
+ xbnds = c("data", "panel"), # was: xbnds = c("panel", "data"),
+ ybnds = c("data", "panel"), # was: ybnds = c("panel", "data"),
+
+ ## special args
+ .prelim = FALSE,
+ .cpl = current.panel.limits(),
+ .xlim = .cpl$xlim,
+ .ylim = .cpl$ylim,
+ .aspect.ratio = 1,
+ #erode Args
+ cdfcut=.05,
+ #hdiff Args
+ hexpose.focus=c(1,2),
+ hexpose.focus.colors=c("yellow","blue"),
+ hexpose.focus.border=c("cyan","orange"),
+ hexpose.median.color="red",
+ hexpose.median.border="black",
+ arrows = TRUE,
+ size = unit(0.1, "inches"),
+ arrow.lwd = 2,
+ eps = 1e-6,
+ type = character(0),
+ ...,
+ check.erosion = TRUE)
+{
+ if (is.character(xbnds))
+ xbnds <-
+ switch(match.arg(xbnds),
+ panel = .xlim,
+ data = range(x, finite = TRUE))
+ if (is.character(ybnds))
+ ybnds <-
+ switch(match.arg(ybnds),
+ panel = .ylim,
+ data = range(y, finite = TRUE))
+ shape <-
+ .aspect.ratio * (diff(ybnds) / diff(.ylim)) /
+ (diff(xbnds) / diff(.xlim))
+ if (is.numeric(groups)) groups <- as.character(groups[subscripts])
+ else groups <- groups[subscripts]
+ binL <- hexList(x, y, given=groups, xbins=xbins, shape=shape,
+ xbnds=xbnds, ybnds=ybnds)
+ if ('hs' %in% type) lapply(binL at hbins,smooth.hexbin)
+ binL at hbins <- lapply(binL at hbins,erode,cdfcut=cdfcut)
+ if ('hg' %in% type) panel.hexgrid(binL at hbins[[1]]) ## ???
+ if ('g' %in% type) panel.grid(h = -1, v = -1)
+ eroded <- unlist(lapply(binL at hbins, is, "erodebin"))
+ tmph.xy <- lapply(binL at hbins, hcell2xy, check.erosion = TRUE)
+
+ ##__________________ Construct hexagon___________________
+ dx <- (0.5 * diff(binL at Xbnds))/xbins
+ dy <- (0.5 * diff(binL at Ybnds))/(xbins * binL at Shape * sqrt(3))
+ hexC <- hexcoords(dx = dx, dy = dy)
+
+ ##__________________ Set up intersections and colors___________________
+ ## Reorder so that the focus bin objects are at the top of the list
+ if(length(hexpose.focus) < binL at n) {
+ binL at hbins <- c(binL at hbins[hexpose.focus], binL at hbins[-hexpose.focus])
+ binL at Bnames <- c(binL at Bnames[hexpose.focus], binL at Bnames[-hexpose.focus])
+ }
+ cell.stat <- all.intersect(binL at hbins)
+ cell.stat.n <- apply(cell.stat, 1, sum)
+ i.depth <- max(cell.stat.n)
+
+ diff.cols <- vector(mode = "list", length = i.depth)
+ levcells <- which(cell.stat.n == 1)
+ whichbin <- apply(cell.stat[levcells, ], 1, which)
+ ## Set all the focal colors for the unique bin cells
+ ## if not specified make them equally spaced on the color wheel
+ ## with high saturation and set the background bins to gray
+ nfcol <- length(hexpose.focus)
+ nhb <- binL at n
+ nbcol <- nhb-nfcol
+ fills <-
+ if(is.null(hexpose.focus.colors)) {
+ if(nbcol > 0)
+ hsv(h = c(seq(0, 1, length = nfcol+1)[1:nfcol],rep(0, nbcol)),
+ s = c(rep(1, nfcol), rep(0, nbcol)),
+ ## V = c(rep(1, nfcol), seq(.9, .1, length=nbcol))
+ v = c(rep(1, nfcol), rep(.9, nbcol)))
+ else hsv(h=seq(0, 1, length = nhb+1))[1:nfcol]
+ }
+ else {
+ foc.col <- t(col2rgb(hexpose.focus.colors))/255
+ if(nbcol > 0) {
+ bcol <- t(col2rgb(rep(grey(.6),nbcol)))/255
+ rbind(foc.col, bcol)
+ }
+ else foc.col
+ }
+ diff.cols[[1]] <- list(fill = fills, border = gray(.8))
+
+ ##_______________ Full Cell Plotting for Unique BinL Cells_________________
+
+ if(length(levcells) > 0) {
+ for(i in unique(whichbin)) {
+ pcells <-
+ if(eroded[i])
+ binL at hbins[[i]]@cell[binL at hbins[[i]]@eroded]
+ else binL at hbins[[i]]@cell
+ pcells <- which(pcells %in% levcells[whichbin == i])
+
+ hexpolygon(x = tmph.xy[[i]]$x[pcells],
+ y = tmph.xy[[i]]$y[pcells], hexC,
+ border = hexpose.focus.border[i] ,
+ fill = hexpose.focus.colors[i] )
+ }
+ }
+
+ ## Now do the intersections. All intersections are convex
+ ## combinations of the colors of the overlapping unique bins in
+ ## the CIEluv colorspace. so if the binlist is of length 2 and
+ ## the focal hbins are "blue" and "yellow" respectively the
+ ## intersection would be green. First I need to get this to work
+ ## and then I can think about how to override this with an option
+ ## in color.control. -NL
+
+ if(i.depth > 1) {
+ for(dl in 2:(i.depth)) {
+ levcells <- which(cell.stat.n == dl)
+ if(length(levcells) == 0) next
+
+ whichbin <- apply(cell.stat[levcells, ], 1,
+ function(x)paste(which(x), sep = "", collapse = ":"))
+ inter.nm <- unique(whichbin)
+ fills <- matrix(0, length(inter.nm), 3)
+ i <- 1
+ for(bn in inter.nm) {
+ who <- as.integer(unlist(strsplit(bn, ":")))
+ ## FIXME (DS): this doesn't work
+ fills[i, ] <- mixcolors2(1/length(who),
+ diff.cols[[1]]$fill[who,])
+ i <- i+1
+ }
+ fills <- rgb(fills[,1],fills[,2],fills[,3])
+ diff.cols[[dl]] <- list(fill = fills,
+ border = gray((i.depth-dl)/i.depth))
+ ##____Full Cell Plotting for Intersecting Cells at Intersection Depth i____
+ i <- 1
+ for(ints in inter.nm) {
+ bin.i <- as.integer(unlist(strsplit(ints, ":"))[1])
+ pcells <-
+ if(eroded[bin.i])
+ binL at hbins[[bin.i]]@cell[binL at hbins[[bin.i]]@eroded]
+ else binL at hbins[[bin.i]]@cell
+ pcells <- which(pcells %in% levcells[whichbin == ints])
+ hexpolygon(x = tmph.xy[[bin.i]]$x[pcells],
+ y = tmph.xy[[bin.i]]$y[pcells], hexC,
+ border = diff.cols[[dl]]$border ,
+ fill = diff.cols[[dl]]$fill[i] )
+ i <- i+1
+ }
+ }
+ }
+
+ if(any(eroded)) {
+ hmeds <- matrix(unlist(lapply(binL at hbins[eroded],
+ function(x)unlist(getHMedian(x)))),
+ ncol = 2, byrow = TRUE)
+ hexpolygon(x = hmeds[, 1], y = hmeds[, 2], hexC,
+ border = hexpose.median.border,
+ fill = hexpose.median.color)
+ if(arrows) {
+ for(i in hexpose.focus) {
+ for(j in hexpose.focus[hexpose.focus < i]) {
+ if(abs(hmeds[i, 1] - hmeds[j, 1]) +
+ abs(hmeds[i, 2] - hmeds[j, 2]) > eps)
+ grid.arrows(c(hmeds[i, 1], hmeds[j, 1]),
+ c(hmeds[i, 2], hmeds[j, 2]),
+ default.units = "native",
+ length = size, gp = gpar(lwd = arrow.lwd))
+ }
+ }
+ }
+ }
+ invisible()
+}
+
+
+hexbinplot <- function(x, data, ...) UseMethod("hexbinplot")
+
+
+hexbinplot.formula <-
+ function(x, data = NULL,
+ prepanel = prepanel.hexbinplot,
+ panel = panel.hexbinplot,
+ groups = NULL,
+ aspect = "xy",
+ trans = NULL,
+ inv = NULL,
+ colorkey = TRUE,
+ ...,
+ maxcnt,
+ legend = NULL,
+ legend.width = TRUE,
+ subset = TRUE)
+{
+ ocall <- sys.call(sys.parent())
+ ocall[[1]] <- quote(hexbinplot)
+ ccall <- match.call()
+ if (is.logical(legend.width)) legend.width <- 1.2 * as.numeric(legend.width)
+ if (is.character(aspect) && aspect == "fill")
+ stop("aspect = 'fill' not permitted")
+ if (!is.null(trans) && is.null(inv))
+ stop("Must supply the inverse transformation 'inv'")
+ ccall$data <- data
+ ccall$prepanel <- prepanel
+ ccall$panel <- panel
+ ccall$aspect <- aspect
+ ccall$trans <- trans
+ ccall$inv <- inv
+ ccall$legend <- legend
+ ccall[[1]] <- quote(lattice::xyplot)
+ ans <- eval(ccall, parent.frame())
+
+ ## panel needs to know aspect ratio to calculate shape
+ ans <- update(ans, .aspect.ratio = ans$aspect.ratio)
+
+ ## also need maxcnt, o.w. can't draw legend, panels not comparable
+ ## either
+ if (missing(maxcnt))
+ maxcnt <-
+ max(mapply(panel.hexbinplot, ## note: not 'panel'
+ x = lapply(ans$panel.args, "[[", "x"),
+ y = lapply(ans$panel.args, "[[", "y"),
+ .xlim =
+ if (is.list(ans$x.limits)) ans$x.limits
+ else rep(list(ans$x.limits), length(ans$panel.args)),
+ .ylim =
+ if (is.list(ans$y.limits)) ans$y.limits
+ else rep(list(ans$y.limits), length(ans$panel.args)),
+ MoreArgs =
+ c(ans$panel.args.common,
+ list(.prelim = TRUE, .cpl = NA))))
+ ans <- update(ans, maxcnt = maxcnt)
+ if (colorkey)
+ ans <-
+ update(ans,
+ legend = updateList(ans$legend,
+ list(right =
+ list(fun = hexlegendGrob,
+ args =
+ list(maxcnt = maxcnt,
+ trans = trans,
+ inv = inv,
+ legend = legend.width,
+ ...)))))
+ ans$call <- ocall
+ ans
+}
+
+
+
+old.hexbinplot.formula <-
+ function(x, data = parent.frame(),
+ prepanel = prepanel.hexbinplot,
+ panel = if (is.null(groups)) panel.hexbinplot
+ else panel.hexpose,
+ groups=NULL,
+ aspect = "xy",
+ trans = NULL,
+ inv = NULL,
+ colorkey = TRUE,
+ ...,
+ maxcnt,
+ legend = NULL,
+ legend.width = TRUE)
+{
+ if (is.logical(legend.width))
+ legend.width <- 1.2 * as.numeric(legend.width)
+ if (is.character(aspect) && aspect == "fill")
+ stop("aspect = 'fill' not permitted")
+ if (!is.null(trans) && is.null(inv))
+ stop("Must supply the inverse transformation 'inv'")
+ groups <- eval(substitute(groups), data, parent.frame())
+ ## There must be a better way to handle this, ugh.
+ ans <-
+ if(is.null(groups))
+ {
+ xyplot(x, data = data,
+ prepanel = prepanel,
+ panel = panel,
+ aspect = aspect,
+ trans = trans,
+ inv = inv,
+ legend = legend,
+ ...)
+ }
+ else
+ {
+ xyplot(x, data = data,
+ prepanel = prepanel,
+ panel = panel,
+ groups=groups,
+ aspect = aspect,
+ trans = trans,
+ inv = inv,
+ legend = legend,
+ ...)
+ }
+ ## panel needs to know aspect ratio to calculate shape
+ ans <- update(ans, .aspect.ratio = ans$aspect.ratio)
+
+ ## also need maxcnt, o.w. can't draw legend, panels not comparable
+ ## either
+ if (missing(maxcnt))
+ maxcnt <-
+ max(mapply(panel.hexbinplot, ## note: not 'panel'
+ x = lapply(ans$panel.args, "[[", "x"),
+ y = lapply(ans$panel.args, "[[", "y"),
+ .xlim =
+ if (is.list(ans$x.limits)) ans$x.limits
+ else rep(list(ans$x.limits), length(ans$panel.args)),
+ .ylim =
+ if (is.list(ans$y.limits)) ans$y.limits
+ else rep(list(ans$y.limits), length(ans$panel.args)),
+ MoreArgs =
+ c(ans$panel.args.common,
+ list(.prelim = TRUE, .cpl = NA))))
+ ans <- update(ans, maxcnt = maxcnt)
+ if (colorkey)
+ ans <-
+ update(ans,
+ legend = updateList(ans$legend,
+ list(right =
+ list(fun = hexlegendGrob,
+ args =
+ list(maxcnt = maxcnt,
+ trans = trans,
+ inv = inv,
+ legend = legend.width,
+ ...)))))
+ ans
+}
+
+
+## want a grob instead of actual plotting
+
+hexlegendGrob <-
+ function(legend = 1.2,
+ inner = legend / 5,
+ cex.labels = 1,
+ cex.title = 1.2,
+ style = "colorscale",
+ minarea = 0.05, maxarea = 0.8,
+ mincnt = 1, maxcnt,
+ trans = NULL, inv = NULL,
+ colorcut = seq(0, 1, length = 17),
+ density = NULL, border = NULL, pen = NULL,
+ colramp = function(n) { LinGray(n,beg = 90,end = 15) },
+ ...,
+ vp = NULL,
+ draw = FALSE)
+{
+ ## the formal arg matching should happen
+ style <- match.arg(style, eval(formals(grid.hexagons)[["style"]]))
+ if (style %in% c("centroids", "lattice", "colorscale")) {
+ ## _______________tranformations_______________________
+ if(is.null(trans))
+ {
+ sc <- maxcnt - mincnt
+ bnds <- round(mincnt + sc * colorcut)
+ }
+ else
+ {
+ if(!is.function(trans) && !is.function(inv))
+ stop("'trans' and 'inv' must both be functions if 'trans' is not NULL")
+ con <- trans(mincnt)
+ sc <- trans(maxcnt) - con
+ bnds <- round(inv(con + sc * colorcut))
+ }
+ }
+
+ ## grob
+ ans <-
+ switch(style,
+ "colorscale" = {
+
+ n <- length(bnds)
+ pen <- colramp(n-1)
+
+ ## rectangles instead of polygons
+ ## pol <-
+ ## rectGrob(x = 0.5, y = 1:(n-1)/n,
+ ## height = 1/n,
+ ## default.units = "npc",
+ ## gp = gpar(fill = pen, col = border))
+
+ hexxy <- hexcoords(dx = 1, n = 1)[c("x", "y")]
+ maxxy <- max(abs(unlist(hexxy)))
+ hexxy <- lapply(hexxy, function(x) 0.5 * x/ maxxy)
+
+ pol <-
+ polygonGrob(x = 0.5 + rep(hexxy$x, n-1),
+ y = (rep(1:(n-1), each = 6) + hexxy$y) / n,
+ id.lengths = rep(6, n-1),
+ gp = gpar(fill = pen, col = border),
+ default.units = "npc")
+ txt <-
+ textGrob(as.character(bnds),
+ x = 0.5,
+ y = (0:(n-1) + 0.5) / n,
+ gp = gpar(cex = cex.labels),
+ default.units = "npc")
+ ttl <- textGrob("Counts", gp = gpar(cex = cex.title))
+
+ key.layout <-
+ grid.layout(nrow = 2, ncol = 2,
+ heights =
+ unit(c(1.5, 1),
+ c("grobheight", "grobheight"),
+ data = list(ttl, txt)),
+ widths =
+ unit(c(1/n, 1),
+ c("grobheight", "grobwidth"),
+ data = list(pol, txt)),
+ respect = TRUE)
+ key.gf <- frameGrob(layout = key.layout, vp = vp)
+ key.gf <- placeGrob(key.gf, ttl, row = 1, col = 1:2)
+ key.gf <- placeGrob(key.gf, pol, row = 2, col = 1)
+ key.gf <- placeGrob(key.gf, txt, row = 2, col = 2)
+ key.gf
+ },
+ "centroids" = ,
+ "lattice" = {
+ warning("legend shows relative sizes")
+
+ ## Note: it may not be impossible to get absolute
+ ## sizes. The bigger problem is that when
+ ## [xy]bnds="data", the sizes (for the same count) may
+ ## not be the same across panels. IMO, that's a more
+ ## useful feature than getting the absolute sizes
+ ## right.
+
+ radius <- sqrt(minarea + (maxarea - minarea) * colorcut)
+ n <- length(radius)
+ if(is.null(pen)) pen <- 1
+ if(is.null(border)) border <- pen
+
+ hexxy <- hexcoords(dx = 1, n = 1)[c("x", "y")]
+ maxxy <- max(abs(unlist(hexxy)))
+ hexxy <- lapply(hexxy, function(x) 0.5 * x/ maxxy)
+
+ pol <-
+ polygonGrob(x = 0.5 + rep(radius, each = 6) * rep(hexxy$x, n),
+ y = (rep(0.5 + 1:n, each = 6) +
+ rep(radius, each = 6) * hexxy$y - 1) / n,
+ id.lengths = rep(6, n),
+ gp = gpar(fill = pen, col = border),
+ default.units = "npc")
+ txt <-
+ textGrob(as.character(bnds),
+ x = 0.5,
+ y = (1:n - 0.5) / n,
+ gp = gpar(cex = cex.labels),
+ default.units = "npc")
+ ttl <- textGrob("Counts", gp = gpar(cex = cex.title))
+
+ key.layout <-
+ grid.layout(nrow = 2, ncol = 2,
+ heights =
+ unit(c(1.5, 1),
+ c("grobheight", "grobheight"),
+ data = list(ttl, txt)),
+ widths =
+ unit(c(1/n, 1),
+ c("grobheight", "grobwidth"),
+ data = list(pol, txt)),
+ respect = TRUE)
+ key.gf <- frameGrob(layout = key.layout, vp = vp)
+
+ key.gf <- placeGrob(key.gf, ttl, row = 1, col = 1:2)
+ key.gf <- placeGrob(key.gf, pol, row = 2, col = 1)
+ key.gf <- placeGrob(key.gf, txt, row = 2, col = 2)
+ key.gf
+ },
+ "nested.lattice" = ,
+ "nested.centroids" = {
+ dx <- inner/2
+ dy <- dx/sqrt(3)
+ hexC <- hexcoords(dx, dy, n = 1, sep = NULL)
+
+ ## _____________x scaling_____________________________
+ numb <- cut(floor(legend/inner), breaks = c(-1, 0, 2,4))
+ ## Note: In old code
+ ## top breaks=c(-1,0,2,4,8), numb<- 5 and size=1:9
+ if (is.na(numb)) numb <- 4
+ switch(numb,
+ {
+ warning("not enough space for legend")
+ return(textGrob(""))
+ },
+ size <- 5,
+ size <- c(1, 5, 9),
+ size <- c(1, 3, 5, 7, 9))
+ xmax <- length(size)
+ radius <- sqrt(minarea + (maxarea - minarea) * (size - 1)/9)
+ txt <- as.character(size)
+ ##___________________y scaling_____________________
+ lab <- c("Ones", "Tens", "Hundreds",
+ "Thousands", "10 Thousands", "100 Thousands",
+ "Millions", "10 Millions",
+ "100 Millions", "Billions")
+ power <- floor(log10(maxcnt)) + 1
+ yinc <- 16 * dy
+ ysize <- yinc * power
+ xmid <- 0
+ x <- inner * (1:xmax - (1 + xmax)/2) + xmid
+ n <- length(x)
+ tx <- rep.int(hexC$x, n)
+ ty <- rep.int(hexC$y, n)
+ six <- rep.int(6:6, n)
+ ## y <- rep.int(3 * dy - yinc, xmax)
+ y <- rep.int(3 * dy - 0.75 * yinc, xmax)
+
+ if (is.null(pen)) {
+ pen <- 1:power +1
+ pen <- cbind(pen, pen +10)
+ }
+ if (is.null(border)) border <- TRUE
+
+ key.layout <-
+ grid.layout(nrow = 1, ncol = 1,
+ heights = unit(ysize, "inches"),
+ widths = unit(legend, "inches"),
+ respect = TRUE)
+ key.gf <- frameGrob(layout = key.layout, vp = vp)
+
+ ## for debugging
+ ## key.gf <-
+ ## placeGrob(key.gf, rectGrob(gp = gpar(fill = "transparent")))
+
+ n6 <- rep.int(6, n)
+ for(i in 1:power) {
+ y <- y + yinc
+ key.gf <-
+ placeGrob(key.gf,
+ polygonGrob(x = unit(legend / 2 + rep.int(hexC$x, n) + rep.int(x, n6), "inches"),
+ y = unit(rep.int(hexC$y, n) + rep.int(y, n6), "inches"),
+ id.lengths = n6,
+ gp =
+ gpar(col = pen[i, 1],
+ fill = if (border) 1 else pen[i, 1])),
+ row = 1, col = 1)
+
+ key.gf <-
+ placeGrob(key.gf,
+ polygonGrob(x = legend / 2 + tx * rep.int(radius, six) + rep.int(x, six),
+ y = ty * rep.int(radius, six) + rep.int(y, six),
+ default.units = "inches", id=NULL,
+ id.lengths=rep(6,n),
+ gp = gpar(fill = pen[i,2], col = border)),
+ row = 1, col = 1)
+
+ key.gf <-
+ placeGrob(key.gf,
+ textGrob(txt,
+ x = legend / 2 + x,
+ y = y - 4.5 * dy,
+ default.units = "inches",
+ gp = gpar(cex = cex.labels)),
+ row = 1, col = 1)
+ key.gf <-
+ placeGrob(key.gf,
+ textGrob(lab[i],
+ x = legend / 2 + xmid,
+ y = y[1] + 4.5 * dy,
+ default.units = "inches",
+ gp = gpar(cex = 1.3 * cex.title)),
+ row = 1, col = 1)
+ }
+ key.gf
+ })
+ if (draw)
+ {
+ grid.draw(ans)
+ invisible(ans)
+ }
+ else ans
+}
diff --git a/R/hexpanel.R b/R/hexpanel.R
new file mode 100644
index 0000000..a0d9f15
--- /dev/null
+++ b/R/hexpanel.R
@@ -0,0 +1,37 @@
+panel.hexloess <-
+function(bin, w=NULL, span = 2/3, degree = 1, family = c("symmetric",
+ "gaussian"), evaluation = 50, lwd = add.line$lwd, lty = add.line$lty,
+ col, col.line = add.line$col, ...)
+{
+ stop("panel.hexloess is no longer available")
+ add.line <- trellis.par.get("add.line")
+
+## x <- bin at xcm
+## y <- bin at ycm
+## if(is.null(w))w <- bin at count
+## control <- loess.control(...)
+## notna <- !(is.na(x) | is.na(y))
+## new.x <- seq(min(x[notna]), max(x[notna]), length = evaluation)
+## family <- match.arg(family)
+## iterations <- if (family == "gaussian") 1 else control$iterations
+## fit <- stats:::simpleLoess(y, x, w, span, degree, FALSE, FALSE,
+## normalize = FALSE, "none", "interpolate",
+## control$cell, iterations, control$trace.hat)
+## kd <- fit$kd
+## z <- .C("loess_ifit", as.integer(kd$parameter), as.integer(kd$a),
+## as.double(kd$xi), as.double(kd$vert), as.double(kd$vval),
+## as.integer(evaluation), as.double(x), fit = double(evaluation),
+## PACKAGE = "stats")$fit
+## if (length(x) > 0) {
+## if (!missing(col) && missing(col.line)) {
+## col.line <- col
+## }
+## add.line <- trellis.par.get("add.line")
+## panel.lines(new.x, z, col = col.line, lty = lty, lwd = lwd)
+## }
+}
+
+panel.hexgrid <- function(h, border=grey(.85))
+{
+ hexGraphPaper(h,border=border)
+}
diff --git a/R/hexplom.R b/R/hexplom.R
new file mode 100644
index 0000000..fdf8f6a
--- /dev/null
+++ b/R/hexplom.R
@@ -0,0 +1,352 @@
+panel.hexplom <-
+ function(...)
+ panel.hexbinplot(...)
+
+
+hexplom <- function(x, data, ...)
+{
+ UseMethod("hexplom")
+}
+
+
+
+
+
+hexplom.data.frame <-
+ function (x, data = NULL, ..., groups = NULL, subset = TRUE)
+{
+ ocall <- sys.call(sys.parent())
+ ocall[[1]] <- quote(hexplom)
+ ccall <- match.call()
+ if (!is.null(ccall$data))
+ warning("explicit 'data' specification ignored")
+ ccall$data <- list(x = x, groups = groups, subset = subset)
+ ccall$x <- ~x
+ ccall$groups <- groups
+ ccall$subset <- subset
+ ccall[[1]] <- quote(hexbin::hexplom)
+ ans <- eval.parent(ccall)
+ ans$call <- ocall
+ ans
+}
+
+hexplom.matrix <-
+ function (x, data = NULL, ..., groups = NULL, subset = TRUE)
+{
+ ocall <- sys.call(sys.parent())
+ ocall[[1]] <- quote(hexplom)
+ ccall <- match.call()
+ if (!is.null(ccall$data))
+ warning("explicit 'data' specification ignored")
+ ccall$data <- list(x = x, groups = groups, subset = subset)
+ ccall$x <- ~x
+ ccall$groups <- groups
+ ccall$subset <- subset
+ ccall[[1]] <- quote(hexbin::hexplom)
+ ans <- eval.parent(ccall)
+ ans$call <- ocall
+ ans
+}
+
+
+hexplom.formula <-
+ function(x, data = NULL, ...)
+{
+ ocall <- sys.call(sys.parent())
+ ocall[[1]] <- quote(hexplom)
+ ccall <- match.call()
+ ccall[[1]] <- quote(lattice::splom)
+ if (is.null(ccall$panel)) ccall$panel <- panel.hexplom
+ ans <- eval.parent(ccall)
+ ans$call <- ocall
+ ans
+}
+
+
+
+
+old.hexplom.formula <-
+ function(x,
+ data = parent.frame(),
+ auto.key = FALSE,
+ aspect = 1,
+ between = list(x = 0.5, y = 0.5),
+ #panel = if (is.null(groups)) "panel.hexplom"
+ #else "panel.superpose",
+ panel = panel.hexplom,
+ prepanel = NULL,
+ scales = list(),
+ strip = TRUE,
+ groups = NULL,
+ xlab = "Scatter Plot Matrix",
+ xlim,
+ ylab = NULL,
+ ylim,
+ superpanel = "panel.pairs",
+ pscales = 5,
+ varnames,
+ drop.unused.levels = lattice.getOption("drop.unused.levels"),
+ ...,
+ default.scales = list(draw = FALSE, relation = "same", axs = "i"),
+ subset = TRUE)
+{
+ ## dots <- eval(substitute(list(...)), data, parent.frame())
+ dots <- list(...)
+
+ #groups <- eval(substitute(groups), data, parent.frame())
+ if(!is.null(groups))stop("groups not implemented yet")
+ subset <- eval(substitute(subset), data, parent.frame())
+
+ ## Step 1: Evaluate x, y, etc. and do some preprocessing
+
+ ## right.name <- deparse(substitute(formula))
+ ## formula <- eval(substitute(formula), data, parent.frame())
+ form <-
+ ## if (inherits(formula, "formula"))
+ latticeParseFormula(x, data,
+ subset = subset, groups = groups,
+ multiple = FALSE,
+ outer = FALSE, subscripts = TRUE,
+ drop = drop.unused.levels)
+## else {
+## if (is.matrix(formula)) {
+## list(left = NULL,
+## right = as.data.frame(formula)[subset,],
+## condition = NULL,
+## left.name = "",
+## right.name = right.name,
+## groups = groups,
+## subscr = seq(length = nrow(formula))[subset])
+## }
+## else if (is.data.frame(formula)) {
+## list(left = NULL,
+## right = formula[subset,],
+## condition = NULL,
+## left.name = "",
+## right.name = right.name,
+## groups = groups,
+## subscr = seq(length = nrow(formula))[subset])
+## }
+## else stop("invalid formula")
+## }
+
+
+ ## We need to be careful with subscripts here. It HAS to be there,
+ ## and it's to be used to index x, y, z (and not only groups,
+ ## unlike in xyplot etc). This means we have to subset groups as
+ ## well, which is about the only use for the subscripts calculated
+ ## in latticeParseFormula, after which subscripts is regenerated
+ ## as a straight sequence indexing the variables
+
+ if (!is.null(form$groups)) groups <- form$groups[form$subscr]
+ subscr <- seq(length = nrow(form$right))
+
+ if (!is.function(panel)) panel <- eval(panel)
+ if (!is.function(strip)) strip <- eval(strip)
+
+ prepanel <-
+ if (is.function(prepanel)) prepanel
+ else if (is.character(prepanel)) get(prepanel)
+ else eval(prepanel)
+
+ cond <- form$condition
+ number.of.cond <- length(cond)
+ x <- as.data.frame(form$right)
+
+ if (number.of.cond == 0) {
+ strip <- FALSE
+ cond <- list(as.factor(rep(1, nrow(x))))
+ number.of.cond <- 1
+ }
+
+ if (!missing(varnames)) colnames(x) <-
+ eval(substitute(varnames), data, parent.frame())
+
+ ## create a skeleton trellis object with the
+ ## less complicated components:
+
+ #foo <- do.call(lattice:::trellis.skeleton,
+ foo <- do.call(trellis.skeleton,
+ c(list(cond = cond,
+ aspect = aspect,
+ between = between,
+ panel = superpanel,
+ strip = strip,
+ xlab = xlab,
+ ylab = ylab,
+ xlab.default = "Scatter Plot Matrix"), dots))
+
+ dots <- foo$dots # arguments not processed by trellis.skeleton
+ foo <- foo$foo
+ foo$call <- match.call()
+
+ ## Step 2: Compute scales.common (leaving out limits for now)
+
+ ## FIXME: It is not very clear exactly what effect scales is
+ ## supposed to have. Not much in Trellis (probably), but there are
+ ## certain components which are definitely relevant, and certain
+ ## others (like log) which can be used in innovative
+ ## ways. However, I'm postponing all that to later, if at all
+
+ if (!is.list(scales)) scales <- list()
+
+ ## some defaults for scales
+
+# if (is.null(scales$draw)) scales$draw <- FALSE
+# if (is.null(scales$relation)) scales$relation <- "same"
+# if (is.null(scales$axs)) scales$axs <- "i"
+
+ scales <- updateList(default.scales, scales)
+ foo <- c(foo,
+ #do.call(lattice:::construct.scales, scales))
+ do.call(construct.scales, scales))
+
+
+ ## Step 3: Decide if limits were specified in call:
+
+ have.xlim <- !missing(xlim)
+ if (!is.null(foo$x.scales$limit)) {
+ have.xlim <- TRUE
+ xlim <- foo$x.scales$limit
+ }
+ have.ylim <- !missing(ylim)
+ if (!is.null(foo$y.scales$limit)) {
+ have.ylim <- TRUE
+ ylim <- foo$y.scales$limit
+ }
+
+ ## Step 4: Decide if log scales are being used (has to be NO):
+
+ have.xlog <- !is.logical(foo$x.scales$log) || foo$x.scales$log
+ have.ylog <- !is.logical(foo$y.scales$log) || foo$y.scales$log
+
+ ## immaterial, since scales has no effect.
+
+# if (have.xlog) {
+# xlog <- foo$x.scales$log
+# xbase <-
+# if (is.logical(xlog)) 10
+# else if (is.numeric(xlog)) xlog
+# else if (xlog == "e") exp(1)
+#
+# x <- log(x, xbase)
+# if (have.xlim) xlim <- log(xlim, xbase)
+# }
+# if (have.ylog) {
+# ylog <- foo$y.scales$log
+# ybase <-
+# if (is.logical(ylog)) 10
+# else if (is.numeric(ylog)) ylog
+# else if (ylog == "e") exp(1)
+#
+# y <- log(y, ybase)
+# if (have.ylim) ylim <- log(ylim, ybase)
+# }
+
+ ## Step 5: Process cond
+
+ cond.max.level <- unlist(lapply(cond, nlevels))
+
+ ## id.na used only to see if any plotting is needed. Not used
+ ## subsequently, unlike other functions
+
+ id.na <- FALSE
+ for (j in 1:ncol(x))
+ id.na <- id.na | is.na(x[,j])
+ for (var in cond)
+ id.na <- id.na | is.na(var)
+ if (!any(!id.na)) stop("nothing to draw")
+ ## Nothing simpler ?
+
+
+ ## Step 6: Evaluate layout, panel.args.common and panel.args
+
+
+ foo$panel.args.common <-
+ c(list(z = x,
+ panel = panel,
+ panel.subscripts = TRUE,
+ groups = groups, # xscales = foo$x.scales, yscales =foo$y.scales,
+ .aspect.ratio=aspect,
+ pscales = pscales),
+ dots)
+
+ nplots <- prod(cond.max.level)
+ if (nplots != prod(sapply(foo$condlevels, length))) stop("mismatch")
+ foo$panel.args <- vector(mode = "list", length = nplots)
+
+
+ cond.current.level <- rep(1, number.of.cond)
+
+
+ for (panel.number in seq(length = nplots))
+ {
+
+ ##id <- !id.na WHY ?
+ for(i in 1:number.of.cond)
+ {
+ var <- cond[[i]]
+ id <- if (is.shingle(var))
+ ((var >=
+ levels(var)[[cond.current.level[i]]][1])
+ & (var <=
+ levels(var)[[cond.current.level[i]]][2]))
+ else (as.numeric(var) == cond.current.level[i])
+ }
+
+ foo$panel.args[[panel.number]] <-
+ list(subscripts = subscr[id])
+
+ cond.current.level <-
+ #lattice:::cupdate(cond.current.level, cond.max.level)
+ cupdate(cond.current.level, cond.max.level)
+ }
+
+
+ #more.comp <- c(lattice:::limits.and.aspect(
+ more.comp <- c(limits.and.aspect(
+ lattice::prepanel.default.splom,
+ prepanel = prepanel,
+ have.xlim = have.xlim, xlim = xlim,
+ have.ylim = have.ylim, ylim = ylim,
+ x.relation = foo$x.scales$relation,
+ y.relation = foo$y.scales$relation,
+ panel.args.common = foo$panel.args.common,
+ panel.args = foo$panel.args,
+ aspect = aspect,
+ nplots = nplots,
+ x.axs = foo$x.scales$axs,
+ y.axs = foo$y.scales$axs),
+ #lattice::: cond.orders(foo))
+ cond.orders(foo))
+ foo[names(more.comp)] <- more.comp
+
+
+
+ if (is.null(foo$legend) && !is.null(groups) &&
+ (is.list(auto.key) || (is.logical(auto.key) && auto.key)))
+ {
+ foo$legend <-
+ list(list(fun = "drawSimpleKey",
+ args =
+ updateList(list(text = levels(as.factor(groups)),
+ points = TRUE,
+ rectangles = FALSE,
+ lines = FALSE),
+ if (is.list(auto.key)) auto.key else list())))
+ foo$legend[[1]]$x <- foo$legend[[1]]$args$x
+ foo$legend[[1]]$y <- foo$legend[[1]]$args$y
+ foo$legend[[1]]$corner <- foo$legend[[1]]$args$corner
+
+ names(foo$legend) <-
+ if (any(c("x", "y", "corner") %in% names(foo$legend[[1]]$args)))
+ "inside"
+ else
+ "top"
+ if (!is.null(foo$legend[[1]]$args$space))
+ names(foo$legend) <- foo$legend[[1]]$args$space
+ }
+
+ class(foo) <- "trellis"
+ foo
+}
diff --git a/R/hexutil.R b/R/hexutil.R
new file mode 100644
index 0000000..a605481
--- /dev/null
+++ b/R/hexutil.R
@@ -0,0 +1,122 @@
+hcell2xyInt <- function(hbin, xbins=NULL, xbnds=NULL, ybnds=NULL, shape=NULL)
+{
+ if(missing(hbin) && (is.null(xbnds) || is.null(ybnds)))
+ stop("Need a hexbin object or boundaries to make lattice")
+ if(missing(hbin) && (is.null(xbins) || is.null(shape)))
+ stop("Need xbins and shape to make a lattice")
+ if(!missing(hbin)) {
+ xbins <- hbin at xbins
+ shape <- hbin at shape
+ xbnds <- if(is.null(xbnds)) hbin at xbnds else xbnds
+ ybnds <- if(is.null(ybnds)) hbin at ybnds else ybnds
+ dimen <- hbin at dimen
+
+ }
+ if(missing(hbin)) {
+ jmax <- floor(xbins + 1.5001)
+ imax <- 2 * floor((xbins *shape)/sqrt(3) + 1.5001)
+ dimen <- c(imax, jmax)
+ }
+ cell <- 1:(dimen[1]*dimen[2])-1
+ i <- cell %/% dimen[2]
+ j <- cell %% dimen[2]
+ list(i=i+1, j=j+1)
+}
+
+hgridcent <- function(xbins, xbnds, ybnds, shape, edge.add=0)
+{
+ ## auxiliary for hexGraphPaper():
+ jmax <- floor(xbins + 1.5001)
+ c1 <- 2 * floor((xbins *shape)/sqrt(3) + 1.5001)
+ imax <- (jmax*c1 -1)/jmax + 1
+ dimen <- c(imax, jmax)
+ c3 <- diff(xbnds)/xbins
+ c4 <- (diff(ybnds) * sqrt(3))/(2 * shape * xbins)
+ if(edge.add > 0) {
+ xbnds <- xbnds + 1.5*c(-edge.add*c3, edge.add*c3)
+ ybnds <- ybnds + c(-edge.add*c4, edge.add*c4)
+ dimen <- dimen + rep.int(2*edge.add, 2)
+ }
+ jmax <- dimen[2]
+ cell <- 1:(dimen[1]*dimen[2])
+ i <- cell %/% jmax
+ j <- cell %% jmax
+ y <- c4 * i + ybnds[1]
+ x <- c3 * ifelse(i %% 2 == 0, j, j + 0.5) + xbnds[1]
+ list(x = x, y = y, dimen = dimen, dx=c3, dy=c4)
+}
+
+hexGraphPaper <-
+ function(hb, xbnds=NULL, ybnds=NULL, xbins=30, shape=1,
+ add=TRUE, fill.edges=1, fill=0, border=1)
+{
+ if(missing(hb) && (is.null(xbnds) || is.null(ybnds)))
+ stop("Need a hexbin object or boundaries to make lattice")
+ if(!missing(hb)) {
+ xbins <- hb at xbins
+ shape <- hb at shape
+ xbnds <- if(is.null(xbnds)) hb at xbnds else xbnds
+ ybnds <- if(is.null(ybnds)) hb at ybnds else ybnds
+ dimen <- hb at dimen
+ }
+ xy <- hgridcent(xbins, xbnds, ybnds, shape, edge.add=fill.edges)
+ if(add){
+ sx <- xbins/diff(xbnds)
+ sy <- (xbins * shape)/diff(ybnds)
+ inner <- 0.5
+ outer <- (2 * inner)/sqrt(3)
+ dx <- inner/sx
+ dy <- outer/(2 * sy)
+ if(add){
+ hexC <- hexcoords(dx, dy, sep=NULL)
+ hexpolygon (xy$x, xy$y, hexC, dx, dy,
+ fill = fill, border = border, hUnit = "native")
+ }
+ }
+ invisible(xy)
+}
+
+hexTapply <- function(hbin,dat,FUN=sum,...,simplify=TRUE)
+{
+ if(is.null(hbin at cID))
+ stop("Must have cell ID's to do this operation \n
+ please re-bin data using IDs = TRUE")
+ if((length(dat)> 0) && (length(dat) != length(hbin at cID)))
+ stop("Length of IDs does not match the length of the data")
+ tapply(dat,hbin at cID,FUN,...,simplify=simplify)
+}
+
+optShape <- function(vp, height=NULL, width=NULL, mar=NULL)
+{
+ if(missing(vp) && (is.null(height) || is.null(width)))
+ stop("Need a viewport object or height and width of the plotting region.")
+ if(!missing(vp)) {
+ if("hexVP" %in% class(vp)) {
+ height <- vp at plt[2]
+ width <- vp at plt[1]
+ }
+ else if("viewport"%in%class(vp)) {
+ #height <- convertHeight(unit(1,"npc"),"inches")
+ #width <- convertWidth (unit(1,"npc"),"inches")
+ height <- convertUnit(vp$height,"inches")
+ width <- convertUnit(vp$width,"inches")
+ }
+ else
+ stop("need valid viewport or hexViewport")
+ }
+ if(!is.null(mar)){
+ height <- height - mar[1] - mar[3]
+ width <- width - mar[2] - mar[4]
+ }
+
+ shape <- as.numeric(height)/as.numeric(width)
+ shape
+}
+
+inout.hex <- function(hbin,mincnt)
+{
+ if(is.null(hbin at cID))
+ stop("bin object must have a cID slot, \n try re-binning with ID = TRUE")
+ tI <- table(hbin at cID)
+ which(hbin at cID%in%(names(tI)[tI<mincnt]))
+}
diff --git a/R/lattice.R b/R/lattice.R
new file mode 100644
index 0000000..bfae156
--- /dev/null
+++ b/R/lattice.R
@@ -0,0 +1,744 @@
+# the functions in this file are verbatim copies from those in package
+# lattice, http://cran.r-project.org/src/contrib/lattice_0.20-29.tar.gz
+# copied on Aug 8, 2014, by Edzer Pebesma.
+
+# reason for copying is that hexbin 1.26-3 generates
+# the following NOTE on CRAN:
+#
+# checking dependencies in R code ... NOTE
+# Unexported objects imported by ':::' calls:
+# lattice:::cond.orders lattice:::construct.scales
+# lattice:::cupdate lattice:::limits.and.aspect
+# lattice:::trellis.skeleton
+# See the note in ?::: about the use of this operator.
+# See the information on DESCRIPTION files in the chapter Creating R
+# packages of the Writing R Extensions manual.
+
+# the files in lattice carry the following copyright notice:
+
+### Copyright (C) 2001-2006 Deepayan Sarkar <Deepayan.Sarkar at R-project.org>
+### Copyright (C) 2001-2005 Saikat DebRoy <saikat at stat.wisc.edu>
+###
+### This file is part of the lattice package for R.
+### It is made available under the terms of the GNU General Public
+### License, version 2, or at your option, any later version,
+### incorporated herein by reference.
+###
+### This program is distributed in the hope that it will be
+### useful, but WITHOUT ANY WARRANTY; without even the implied
+### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+### PURPOSE. See the GNU General Public License for more
+### details.
+###
+### You should have received a copy of the GNU General Public
+### License along with this program; if not, write to the Free
+### Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+### MA 02110-1301, USA
+
+construct.legend <-
+ function(legend = NULL, key = NULL, fun = "draw.key")
+{
+ if (is.null(legend) && is.null(key)) return(NULL)
+ if (is.null(legend)) legend <- list()
+ if (!is.null(key))
+ {
+ space <- key$space
+ x <- y <- corner <- NULL
+
+ if (is.null(space))
+ {
+ if (any(c("x", "y", "corner") %in% names(key)))
+ {
+ stopifnot(is.null(x) || (length(x) == 1 && x >= 0 && x <= 1))
+ stopifnot(is.null(y) || (length(y) == 1 && y >= 0 && y <= 1))
+ stopifnot(is.null(corner) ||
+ (length(corner) == 2 &&
+ all(corner %in% c(0, 1))))
+ space <- "inside"
+ x <- key$x
+ y <- key$y
+ corner <- key$corner
+ ## check for valid values
+ }
+ else
+ space <- "top"
+ }
+ if (space != "inside" && space %in% names(legend))
+ stop(gettextf("component '%s' duplicated in key and legend", space))
+
+ key.legend <- list(fun = fun, args = list(key = key, draw = FALSE))
+ key.legend$x <- x
+ key.legend$y <- y
+ key.legend$corner <- corner
+
+ legend <- c(list(key.legend), legend)
+ names(legend)[1] <- space
+ }
+ legend
+}
+
+extend.limits <-
+ function(lim, length = 1, axs = "r",
+ prop =
+ if (axs == "i") 0
+ else lattice.getOption("axis.padding")$numeric)
+{
+ ## if (!is.numeric(lim)) NA
+ if (all(is.na(lim))) NA_real_ # or lim?
+ else if (is.character(lim) )
+ {
+ c(1, length(lim)) + c(-1, 1) * if (axs == "i") 0.5 else lattice.getOption("axis.padding")$factor
+ }
+ else if (length(lim) == 2)
+ {
+ if (lim[1] > lim[2])
+ {
+ ccall <- match.call()
+ ccall$lim <- rev(lim)
+ ans <- eval.parent(ccall)
+ return (rev(ans))
+ }
+ if (!missing(length) && !missing(prop))
+ stop("'length' and 'prop' cannot both be specified")
+ if (length <= 0) stop("'length' must be positive")
+ if (!missing(length))
+ {
+ prop <- (as.numeric(length) - as.numeric(diff(lim))) / (2 * as.numeric(diff(lim)))
+ }
+ if (lim[1]==lim[2]) lim + 0.5 * c(-length,length)
+ else
+ {
+ d <- diff(as.numeric(lim))
+ lim + prop * d * c(-1,1)
+ }
+ }
+ else
+ {
+ print(lim)
+ stop("improper length of 'lim'")
+ }
+}
+
+limitsFromLimitlist <-
+ function(have.lim,
+ lim,
+ relation,
+ limitlist,
+ used.at,
+ numlimitlist,
+ axs,
+ npackets)
+ ## have.lim: logical, whether xlim/ylim was explicitly specified
+ ## lim: the specified limit if have.lim = TRUE
+ ## relation: same/free/sliced
+ ## limitlist: list of limits from prepanel calculations, one for each panel
+ ## numlimitlist: (optional) numeric locations for factors (lim
+ ## will be levels including unused ones)
+ ## axs: "r", "i" etc, passed on to extend.limits
+
+ ## return value depends on relation. (See limits.and.aspect below,
+ ## where this is used, for partial enlightenment.)
+{
+
+ if (relation == "same")
+ {
+ ## The problem here is that we need to figure out the overall
+ ## limit required from the limits of each panel. This could be
+ ## a problem for two reasons. First, some panels could have no
+ ## data in them, in which case the corresponding limits would
+ ## be NA. Secondly, the limits could be either numeric or
+ ## character vectors (the latter for factors). When relation =
+ ## same, the type should be same across panels. When numeric,
+ ## we just take range, leaving out NAs. But what about
+ ## factors? Is it OK to assume that all the non-NA vectors
+ ## would be exactly the same ? They should be, since levels(x)
+ ## would not change even if not all levels are
+ ## represented. So, I'm just taking unique of all the vectors
+ ## concatenated, excluding NA's
+
+ ## Additional complication: Need to preserve class of limits,
+ ## to be used later in tick location/label calculation. Not a
+ ## problem in other cases, but here unlist-ing loses the
+ ## class.
+
+
+ #if (!have.lim)
+ ## always calculate the limits from prepanel first:
+
+ ## should check that all classes are the same. How ? What
+ ## about NA's ? Arrgh!
+
+ ## to handle NA's, how about:
+
+ all.na <- unlist(lapply(limitlist, function(x) all(is.na(x))))
+ class.lim <- ## retain non-NA limitlists only
+ lapply(limitlist[!all.na], class)
+ ## class.lim is a list now, may be length 0
+ limits <- unlist(limitlist) ## loses the class attribute
+
+ ## if (length(limits) > 0)
+ if (sum(!is.na(limits)) > 0)
+ {
+ if (is.character(limits))
+ {
+ limits <- unique(limits[!is.na(limits)])
+ slicelen <- diff(extend.limits(limits, axs = axs))
+ }
+ else ## if (is.numeric(limits)) # or dates etc
+ {
+ limits <-
+ extend.limits(range(as.numeric(limits), finite = TRUE),
+ axs = axs)
+ slicelen <- diff(range(limits, finite = TRUE))
+ }
+
+ ## hopefully put back appropriate class of limits:
+ ## FIXME: date changes may have messed this up
+
+ if (length(class.lim) > 0)
+ class(limits) <-
+ if (all(class.lim[[1]] == "integer"))
+ "numeric" else class.lim[[1]]
+
+ ## (have to handle "integer" specially, since variable
+ ## specifications like 1:10 are rather common, and
+ ## class() <- "integer" would turn the limits into
+ ## integers)
+ }
+ else
+ {
+ limits <- c(0,1)
+ slicelen <- 1
+ }
+
+ if (have.lim)
+ {
+ if (is.list(lim))
+ stop("limits cannot be a list when relation = same")
+ old.limits <- limits
+ limits <- lim
+ ## lim overrides prepanel except NAs
+ if (!is.character(limits) && !is.character(old.limits)) {
+ limits[is.na(limits)] <- old.limits[is.na(limits)]
+ }
+ slicelen <-
+ ## this no longer works for dates (R 2.6)
+## if (is.numeric(lim)) diff(range(lim))
+## else length(lim) + 2
+ if (is.character(limits)) length(limits) + 2
+ else diff(range(as.numeric(limits)))
+ }
+ ans <- list(limits = limits, slicelen = slicelen)
+ }
+ else if (relation == "sliced")
+ {
+ if (have.lim)
+ {
+ if (is.list(lim))
+ {
+ limits <- rep(lim, length.out = npackets)
+ }
+ else warning("Explicitly specified limits ignored")
+ }
+ slicelen <- limitlist
+ for (i in seq_along(limitlist))
+ {
+ slicelen[[i]] <-
+ ## if (is.numeric(limitlist[[i]]))
+ if (!is.character(limitlist[[i]]))
+ {
+ if (any(is.finite(limitlist[[i]])))
+ ## range unnecessary, but...
+ diff(range(as.numeric(limitlist[[i]]), finite = TRUE))
+ else NA_real_
+ }
+ else if (!any(is.na(numlimitlist[[i]])))
+ diff(range(as.numeric(numlimitlist[[i]])))
+ else NA_real_
+ }
+ slicelen <-
+ (if (axs == "i") 1 else 1 + 2 * lattice.getOption("axis.padding")$numeric) *
+ max(unlist(slicelen), na.rm = TRUE)
+ for (i in seq_along(limitlist))
+ {
+ if (is.numeric(limitlist[[i]]))
+ limitlist[[i]] <-
+ extend.limits(limitlist[[i]], length = slicelen)
+ }
+ for (i in seq_along(numlimitlist))
+ {
+ if (!all(is.na(numlimitlist[[i]])))
+ numlimitlist[[i]] <-
+ extend.limits(as.numeric(numlimitlist[[i]]), length = slicelen)
+ }
+ ans <-
+ list(limits = limitlist,
+ used.at = used.at,
+ numlimitlist = numlimitlist,
+ slicelen = slicelen)
+ }
+ else if (relation == "free")
+ {
+ if (have.lim)
+ {
+ ## This is the only situation where limits can be a list
+ ## (doesn't make sense when relation="same", ignored when
+ ## relation="sliced"). Even if limits is not a list (but
+ ## is specified), it will be treated as a list, and
+ ## repeated as necessary (see further comments below).
+
+ if (!is.list(lim)) lim <- list(lim)
+
+ ## There's a subtle consideration here. It is possible
+ ## for some panels to have nothing in them (or only NA's).
+ ## Such panels usually have their prepanel functions
+ ## return NA. When 'limits' is specified as a list, this
+ ## will be interpreted as the limit specification for the
+ ## non-empty panels only (this is an arbitrary choice, but
+ ## it usually makes more sense, even though it's less
+ ## general than the other choice).
+
+ ## which ones are non-NA?
+ id <- which(sapply(limitlist, function(x) !all(is.na(x))))
+
+ ## replace these with the limits supplied, except if the
+ ## supplied limits are NULL, in which case retain limits
+ ## calculated by prepanel.
+
+ old.limitlist <- limitlist
+ limitlist[id] <- lim
+ which.null <- sapply(limitlist, is.null)
+ limitlist[which.null] <- old.limitlist[which.null]
+
+ ## lim overrides prepanel except NAs
+ for (i in seq_along(limitlist))
+ {
+ if (!is.character(limitlist[[i]]) &&
+ !is.character(old.limitlist[[i]]))
+ {
+ isna <- is.na(limitlist[[i]])
+ limitlist[[i]][isna] <- old.limitlist[[i]][isna]
+ }
+ }
+ }
+ for (i in seq_along(limitlist))
+ {
+ if (!all(is.na(limitlist[[i]])) && !is.character(limitlist[[i]]))
+ limitlist[[i]] <- ## preserves class
+ extend.limits(limitlist[[i]], axs = axs)
+ ## o.w., keep it as it is
+ }
+ slicelen <- numeric(length(limitlist))
+ for (i in seq_along(limitlist))
+ slicelen[i] <-
+ if (!is.character(limitlist[[i]]))
+ diff(range(as.numeric(limitlist[[i]])))
+ else if (!any(is.na(numlimitlist[[i]])))
+ diff(range(numlimitlist[[i]]))
+ else NA_real_
+ ans <-
+ list(limits = limitlist,
+ used.at = used.at,
+ numlimitlist = numlimitlist,
+ slicelen = slicelen)
+ }
+ ans
+}
+
+complete_names <- function(x, template, allow.invalid = FALSE)
+{
+ pid <- pmatch(names(x), names(template), duplicates.ok = TRUE)
+ if (allow.invalid) {
+ x <- x[!is.na(pid)]
+ pid <- pid[!is.na(pid)]
+ } else {
+ if (any(is.na(pid)))
+ warning("Invalid or ambiguous component names: ",
+ paste(names(x)[which(is.na(pid))], collapse = ", ") )
+ }
+ if (any(duplicated(pid))) stop("Multiple matches to component name")
+ names(x) <- names(template)[pid]
+ x
+}
+
+getFunctionOrName <- function(FUN)
+ ## Try lattice namespace first? Does that happen automatically?
+{
+ if (is.function(FUN)) FUN
+ else if (is.character(FUN)) get(FUN)
+ else eval(FUN)
+}
+
+trellis.skeleton <-
+ function(formula = NULL,
+ cond,
+ aspect = default.args$aspect, # argument in xyplot
+ as.table = default.args$as.table,
+ between = default.args$between,
+ key = NULL,
+ legend = NULL,
+ page = default.args$page,
+ main = default.args$main,
+ sub = default.args$sub,
+ par.strip.text = default.args$par.strip.text,
+ layout = default.args$layout,
+ skip = default.args$skip,
+ strip = default.args$strip.default, # argument in xyplot
+ strip.left = FALSE,
+ xlab.default = NULL,
+ ylab.default = NULL,
+ xlab = NULL, # argument in xyplot
+ ylab = NULL, # argument in xyplot
+ xlab.top = NULL,
+ ylab.right = NULL,
+
+ panel, # argument in xyplot
+
+ xscale.components = default.args$xscale.components,
+ yscale.components = default.args$yscale.components,
+ axis = default.args$axis,
+
+ subscripts = TRUE, # ignored, for reasons given above
+
+ index.cond = NULL,
+ perm.cond = NULL,
+ ...,
+ par.settings = NULL,
+ plot.args = NULL,
+ lattice.options = NULL)
+{
+ default.args <- lattice.getOption("default.args")
+ if (is.null(skip)) skip <- FALSE
+ foo <-
+ list(formula = formula,
+ as.table = as.table,
+ aspect.fill = (aspect == "fill"),
+ ## key = key,
+ legend = construct.legend(legend = legend, key = key),
+ panel = panel,
+ page = page,
+ layout = layout,
+ skip = skip,
+ strip = if (is.logical(strip) && strip) "strip.default"
+ else strip,
+ strip.left = if (is.logical(strip.left) && strip.left) strip.custom(horizontal = FALSE)
+ else strip.left,
+ xscale.components = xscale.components,
+ yscale.components = yscale.components,
+ axis = axis,
+ xlab = xlab,
+ ylab = ylab,
+ xlab.default = xlab.default,
+ ylab.default = ylab.default,
+ xlab.top = xlab.top,
+ ylab.right = ylab.right,
+ main = main,
+ sub = sub,
+ x.between = 0,
+ y.between = 0,
+ par.settings = par.settings,
+ plot.args = plot.args,
+ lattice.options = lattice.options,
+ par.strip.text = par.strip.text,
+ index.cond = index.cond,
+ perm.cond = perm.cond)
+
+ if (!is.null(between$x)) foo$x.between <- between$x
+ if (!is.null(between$y)) foo$y.between <- between$y
+
+ foo$condlevels <- lapply(cond, levels)
+
+ list(foo = foo, dots = list(...))
+}
+
+
+
+
+
+
+
+
+cond.orders <- function(foo, ...)
+ ## function to determine order of panels within a cond. variable
+ ## foo: trellis object-to-be
+
+ ## calculate actual values for index.cond and perm.cond.
+ ## index.cond can be a function, in which case it would be used to
+ ## determing order of levels within conditioning variables
+
+ ## Question: should these be determined at run-time? Wouldn't be
+ ## impossible, but has the disadvantage that looking at the
+ ## trellis object will be totally uninformative in the default
+ ## case (when both would be NULL). In a sense, this is fine, since
+ ## having index.cond be a function is similar to having a prepanel
+ ## function. After all, the results depend only on the panel
+ ## contents, and those cannot be changed via update.
+
+{
+
+ ## the following to be used for changing order of conditioning
+ ## variables and indexing their levels. The object foo already has
+ ## components index.cond and perm.cond as whatever was passed to
+ ## the original function call. If these are NULL, suitable
+ ## defaults need to be computed. If foo$index.cond is a function,
+ ## index.cond has to be computed appropriately.
+
+ index.cond <-
+ vector(mode = "list",
+ length = length(foo$condlevels))
+
+ for (i in seq_along(foo$condlevels))
+ index.cond[[i]] <- seq_along(foo$condlevels[[i]])
+ perm.cond <- seq_len(length(foo$condlevels))
+
+ if (!is.null(foo$perm.cond))
+ {
+ if (all(sort(foo$perm.cond) == perm.cond))
+ perm.cond <- foo$perm.cond
+ else stop("Invalid value of perm.cond")
+ }
+ if (!is.null(foo$index.cond))
+ {
+ if (is.list(foo$index.cond) && length(foo$index.cond) == length(index.cond))
+ {
+ for (i in seq_along(foo$condlevels))
+ index.cond[[i]] <- index.cond[[i]][foo$index.cond[[i]]]
+ }
+ else if (is.function(foo$index.cond))
+ {
+ FUN <- foo$index.cond
+ nplots <- length(foo$panel.args)
+ panel.order <- numeric(nplots)
+ for (count in seq_len(nplots))
+ {
+ if (is.list(foo$panel.args[[count]]))
+ {
+ pargs <- c(foo$panel.args.common, foo$panel.args[[count]], list(...))
+ prenames <- names(formals(FUN))
+ if (!("..." %in% prenames)) pargs <- pargs[intersect(names(pargs), prenames)]
+ panel.order[count] <- do.call("FUN", pargs)
+ }
+ else ## this happens for empty panels
+ {
+ is.na(panel.order) <- count # panel.order[count] <- NA
+ }
+ }
+ dim(panel.order) <- sapply(foo$condlevels, length)
+ for (i in seq_along(foo$condlevels))
+ index.cond[[i]] <-
+ order(apply(panel.order, i, mean, na.rm = TRUE))
+ }
+ else stop("Invalid value of index.cond")
+ }
+ list(index.cond = index.cond, perm.cond = perm.cond)
+}
+
+
+construct.scales <-
+ function(draw = TRUE, axs = "r", tck = 1, tick.number = 5,
+ at = FALSE, labels = FALSE, log = FALSE,
+ alternating = TRUE, relation = "same",
+ abbreviate = FALSE, minlength = 4,
+ limits = NULL, format = NULL,
+ equispaced.log = TRUE,
+
+ lty = FALSE, lwd = FALSE, cex = FALSE, rot = FALSE,
+ col = FALSE, col.line = col, alpha = FALSE, alpha.line = alpha,
+ font = FALSE, fontfamily = FALSE, fontface = FALSE, lineheight = FALSE,
+
+ ..., ## NOTE: ... is currently ignored
+ x = NULL, y = NULL)
+{
+ ## top-level values
+ x.scales <- y.scales <-
+ list(draw = draw, axs = axs, tck = tck, tick.number = tick.number,
+ at = at, labels = labels, log = log,
+ alternating = alternating, relation = relation,
+ abbreviate = abbreviate, minlength = minlength,
+ limits = limits, format = format, equispaced.log = equispaced.log,
+ lty = lty, lwd = lwd, cex = cex, rot = rot,
+ col = col, col.line = col.line, alpha = alpha, alpha.line = alpha.line,
+ font = font, fontfamily = fontfamily, fontface = fontface, lineheight = lineheight)
+ ## override by component-specific values
+ if (!is.null(x))
+ {
+ if (is.character(x)) x <- list(relation = x)
+ x <- complete_names(x, x.scales)
+ x.scales[names(x)] <- x
+ }
+ if (!is.null(y))
+ {
+ if (is.character(y)) y <- list(relation = y)
+ y <- complete_names(y, y.scales)
+ y.scales[names(y)] <- y
+ }
+ if (is.logical(x.scales$alternating))
+ x.scales$alternating <-
+ if (x.scales$alternating) c(1,2)
+ else 1
+ if (is.logical(y.scales$alternating))
+ y.scales$alternating <-
+ if (y.scales$alternating) c(1,2)
+ else 1
+ for (nm in c("tck", "cex", "rot")) {
+ x.scales[[nm]] <- rep(x.scales[[nm]], length.out = 2)
+ y.scales[[nm]] <- rep(y.scales[[nm]], length.out = 2)
+ }
+ if (x.scales$relation == "same" && (is.list(x.scales$at) || is.list(x.scales$labels)))
+ stop("the 'at' and 'labels' components of 'scales' may not be lists when 'relation = \"same\"'")
+ if (y.scales$relation == "same" && (is.list(y.scales$at) || is.list(y.scales$labels)))
+ stop("the 'at' and 'labels' components of 'scales' may not be lists when 'relation = \"same\"'")
+ list(x.scales = x.scales, y.scales = y.scales)
+}
+
+cupdate <- function(index, maxim)
+{
+
+ ## This unexported function is used to handle arbitrary number of
+ ## conditioning variables : every time it is called, it increments
+ ## the "current" level of the conditioning variables suitably,
+ ## i.e., it tries to increment the level of the 1st conditining
+ ## variable (the one which varies fastest along panel order) and
+ ## if it happens to be at its maximum (last) value, it sets it to
+ ## the first value AND increments the "current" level of the 2nd
+ ## (next) conditioning variable recursively.
+
+ if(length(index)!=length(maxim)||length(maxim)<=0)
+ stop("Inappropriate arguments")
+ index[1] <- index[1] + 1
+ if (index[1] > maxim[1] && length(maxim) > 1)
+ c(1, cupdate(index[-1], maxim[-1]))
+ else index
+}
+limits.and.aspect <-
+ function(prepanel.default,
+ prepanel = NULL,
+ have.xlim = FALSE, xlim = NULL,
+ have.ylim = FALSE, ylim = NULL,
+ x.relation, y.relation,
+ panel.args.common = list(),
+ panel.args = list(),
+ aspect,
+ banking = lattice.getOption("banking"),
+ npackets = length(panel.args),
+ x.axs = "r", y.axs = "r",
+ ...) ## extra arguments for prepanel (for qqmathline)
+{
+ prepanel.default.function <- getFunctionOrName(prepanel.default)
+ prepanel <- getFunctionOrName(prepanel)
+ if (npackets<1) stop("need at least one panel")
+ x.limits <- vector("list", npackets)
+ y.limits <- vector("list", npackets)
+ x.used.at <- vector("list", npackets)
+ y.used.at <- vector("list", npackets)
+ x.num.limit <- vector("list", npackets)
+ y.num.limit <- vector("list", npackets)
+ dxdy <- vector("list", npackets)
+
+ for (count in seq_len(npackets))
+ {
+ if (is.list(panel.args[[count]]))
+ {
+ pargs <- c(panel.args.common, panel.args[[count]], list(...))
+ tem <- do.call("prepanel.default.function", pargs)
+ if (is.function(prepanel)) ## results will 'overwrite' defaults
+ {
+ prenames <- names(formals(prepanel))
+ if (!("..." %in% prenames)) pargs <- pargs[intersect(names(pargs), prenames)]
+ pretem <- do.call("prepanel", pargs)
+ ## prepanel() over-rides defaults except NAs - e.g. ylim = c(0, NA)
+ if (!is.null(pretem$xlim) && !is.character(pretem$xlim))
+ if (any(isna <- is.na(pretem$xlim)))
+ pretem$xlim[isna] <- tem$xlim[isna]
+ if (!is.null(pretem$ylim) && !is.character(pretem$ylim))
+ if (any(isna <- is.na(pretem$ylim)))
+ pretem$ylim[isna] <- tem$ylim[isna]
+ tem <- updateList(tem, pretem)
+ ## tem[names(pretem)] <- pretem
+ }
+ x.limits[[count]] <- tem$xlim
+ y.limits[[count]] <- tem$ylim
+ x.used.at[[count]] <- if (is.null(tem$xat)) NA else tem$xat
+ y.used.at[[count]] <- if (is.null(tem$yat)) NA else tem$yat
+ x.num.limit[[count]] <- if (is.null(tem$xat)) NA else range(tem$xat)
+ y.num.limit[[count]] <- if (is.null(tem$yat)) NA else range(tem$yat)
+ dxdy[[count]] <- list(dx = tem$dx, dy = tem$dy)
+ }
+ else ## this happens for empty panels
+ {
+ x.limits[[count]] <- c(NA_real_, NA_real_)
+ y.limits[[count]] <- c(NA_real_, NA_real_)
+ x.used.at[[count]] <- NA_real_
+ y.used.at[[count]] <- NA_real_
+ x.num.limit[[count]] <- NA_real_
+ y.num.limit[[count]] <- NA_real_
+ dxdy[[count]] <- list(dx = NA_real_, dy = NA_real_)
+ }
+ }
+
+ ## Some explanation might be helpful here. The for loop above
+ ## creates a list of xlims/ylims. Each of these might be either
+ ## numeric (when x/y is numeric, shingle or POSIXt etc), or levels
+ ## of a factor (that's how prepanel.default.functions are set
+ ## up). However, at this point, all x.limits[[i]] must be of the
+ ## same type. Returned limits must be in accordance with this
+ ## type. The only exception is when relation = "free", in which
+ ## case they may be different. This could happen if [xy]lim or
+ ## limits is supplied as a list in the high level function.
+
+ x.limits <-
+ limitsFromLimitlist(have.lim = have.xlim,
+ lim = xlim,
+ relation = x.relation,
+ limitlist = x.limits,
+ used.at = x.used.at,
+ numlimitlist = x.num.limit,
+ axs = x.axs,
+ npackets = npackets)
+ y.limits <-
+ limitsFromLimitlist(have.lim = have.ylim,
+ lim = ylim,
+ relation = y.relation,
+ limitlist = y.limits,
+ used.at = y.used.at,
+ numlimitlist = y.num.limit,
+ axs = y.axs,
+ npackets = npackets)
+
+ if (is.character(aspect))
+ {
+ if (aspect == "xy")
+ {
+ aspect <-
+ median(sapply(dxdy, banking) *
+ y.limits$slicelen /
+ x.limits$slicelen,
+ na.rm = TRUE)
+### old aspect calculation
+## aspect <- median(unlist(lapply(dxdy, banking)),
+## na.rm = TRUE) * y.limits$slicelen /
+## x.limits$slicelen
+## if (y.relation == "free" || x.relation == "free")
+## warning("'aspect=xy' when 'relation=free' is not sensible")
+ }
+ else if (aspect == "iso")
+ {
+ aspect <-
+ median(y.limits$slicelen / x.limits$slicelen,
+ na.rm = TRUE)
+ if (y.relation == "free" || x.relation == "free")
+ warning("'aspect=\"iso\"' approximate since 'relation=\"free\"'")
+ }
+ else aspect <- 1
+ }
+ list(x.limits = x.limits$limits,
+ y.limits = y.limits$limits,
+ x.used.at = x.limits$used.at,
+ y.used.at = y.limits$used.at,
+ x.num.limit = x.limits$numlimitlist,
+ y.num.limit = y.limits$numlimitlist,
+ aspect.ratio = aspect,
+ prepanel.default = prepanel.default,
+ prepanel = prepanel)
+}
+
diff --git a/R/smoothHexbin.R b/R/smoothHexbin.R
new file mode 100644
index 0000000..890e1ed
--- /dev/null
+++ b/R/smoothHexbin.R
@@ -0,0 +1,46 @@
+setClass("smoothbin",
+ representation("hexbin", wts="numeric"))
+
+setGeneric("hsmooth", function(bin, wts) standardGeneric("hsmooth"))
+
+smooth.hexbin <- function(bin, wts = c(48, 4, 1))
+{
+ if(!is(bin,"hexbin"))
+ stop("first argument must be a hexbin object")
+ cell <- bin at cell - 1
+ n <- as.integer(length(cell))
+ cnt <- bin at count
+ xbins <- bin at xbins
+ bdim <- bin at dimen
+ row <- bdim[1]
+ col <- bdim[2]
+ ncol <- col + 4
+ nrow <- row + 4
+ nmax <- ncol * nrow
+ sm <- rep.int(0:0, nmax)
+ nr <- cell %/% col + 2
+ nc <- cell %% col + 3
+ pad <- rep.int(0:0, nmax - n)
+ cell <- c(nr * ncol + nc, pad)
+ cnt <- c(cnt, pad)
+ ans <- .Fortran("hsm",
+ cell = as.integer(cell),
+ cnt = as.integer(cnt),
+ n = n,
+ nmax = as.integer(nmax),
+ sm = as.integer(sm),
+ ncol = as.integer(ncol),
+ wts = as.integer(wts),
+ PACKAGE = "hexbin")[c("cell","cnt","n")]
+ n <- ans$n
+ length(ans$cell) <- length(ans$cnt) <- n
+ bin at xbins <- xbins + 4
+ bin at xbnds <- addBit(bin at xbnds, f = 2/xbins)
+ bin at ybnds <- addBit(bin at ybnds, f = 2/xbins)
+ bin at dimen <- c(nrow, ncol)
+ bin at cell <- ans$cell
+ bin at count <- ans$cnt
+ new("smoothbin", bin, wts=wts)
+}
+
+setMethod("hsmooth", "hexbin", smooth.hexbin)
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..d87cb7a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,5 @@
+hexbin
+======
+[](https://travis-ci.org/edzer/hexbin)
+
+An R Package with binning and plotting functions for hexagonal bins.
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..eddd7c7
--- /dev/null
+++ b/TODO
@@ -0,0 +1,36 @@
+--------------
+Aug 10, 2014
+o get rid of functions in lattice.R, which were copied from lattice
+
+--------------
+o The new 3D plots -- should rather make the new functions "internal"
+ and choosable with *arguments* from given functions !
+
+o hexbin *class* {as mentioned by man/hexbin.Rd } -- done
+
+o find the references (on paper) and read !
+ --> "References" in ./Biocore-notes
+
+ ftp://www.galaxy.gmu.edu/pub/faculty/dcarr/eda/bin2d/
+ ftp://www.galaxy.gmu.edu/pub/faculty/dcarr/software/bin2d.rev/
+
+
+o example(hmatplot) is still doing many pages instead of one
+
+
+------------
+March 5, 2005
+o Implement conversions between different hexagon coordinate systems
+
+o Smoothing on a hexagonal basis using tensor products
+ + smoothing histograms
+ + smoothing the intensity of a Poisson process
+
+o Family of hex apply functions
+
+o Hbin list class and constructors
+
+---
+
+o Use standard convertColor() function more and
+ and try to get rid of dependency on 'colorspace'
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..44c1e0f
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/NHANES.rda b/data/NHANES.rda
new file mode 100644
index 0000000..6540520
Binary files /dev/null and b/data/NHANES.rda differ
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 55a9142..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-To run the unit tests provided by the package you can do
-
- sh run-unit-test
-
-in this directory.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index b3d3ab4..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,11 +0,0 @@
-r-cran-hexbin (1.27.1-2) UNRELEASED; urgency=medium
-
- * Added missing copyright statement
-
- -- Andreas Tille <tille at debian.org> Sun, 15 May 2016 12:05:02 +0200
-
-r-cran-hexbin (1.27.1-1) unstable; urgency=medium
-
- * Initial upload (Closes: #824360)
-
- -- Andreas Tille <tille at debian.org> Sun, 15 May 2016 01:01:21 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index 9984338..0000000
--- a/debian/control
+++ /dev/null
@@ -1,24 +0,0 @@
-Source: r-cran-hexbin
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9),
- r-base-dev,
- r-cran-lattice,
- cdbs
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-hexbin/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-hexbin/
-Homepage: http://cran.r-project.org/web/packages/hexbin
-
-Package: r-cran-hexbin
-Architecture: any
-Depends: ${shlibs:Depends},
- ${misc:Depends},
- ${R:Depends},
- r-cran-lattice
-Description: GNU R hexagonal binning routines
- This GNU R package contains binning and plotting functions for hexagonal
- bins. Now uses and relies on grid graphics and formal (S4) classes and
- methods.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 4f0142e..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,36 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Edzer Pebesma <edzer.pebesma at uni-muenster.de>
-Upstream-Name: hexbin
-Source: http://cran.r-project.org/web/packages/hexbin/
-
-Files: *
-Copyright: 2012-2014 Edzer Pebesma <edzer.pebesma at uni-muenster.de>
-License: GPL-2+
-
-Files: src/*.f
-Copyright: 1991-1994 Dan Carr
- 2004 Nicholas Lewin-Koh and Martin Maechler
-License: GPL-2+
-
-Files: R/lattice.R
-Copyright: 2001-2006 Deepayan Sarkar <Deepayan.Sarkar at R-project.org>
- 2001-2005 Saikat DebRoy <saikat at stat.wisc.edu>
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2015 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- On Debian systems, the complete text of the GNU General Public
- License version 2 can be found in ‘/usr/share/common-licenses/GPL-2’.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 50f6656..0000000
--- a/debian/docs
+++ /dev/null
@@ -1 +0,0 @@
-debian/README.test
diff --git a/debian/examples b/debian/examples
deleted file mode 100644
index 18244c8..0000000
--- a/debian/examples
+++ /dev/null
@@ -1 +0,0 @@
-vignettes
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 04a2c2a..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/usr/bin/make -f
-
-include /usr/share/R/debian/r-cran.mk
-
-install/$(package)::
- find debian/$(package)/ -type f -exec chmod 644 {} +
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index a0a0edc..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-survival
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index abf88ff..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/bin/sh -e
-oname=hexbin
-pkg=r-cran-`echo $oname | tr [A-Z] [a-z]`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp /usr/share/doc/$pkg/examples/vignettes/* $ADTTMP
-gunzip *.gz
-for rnw in `ls *.[rR]nw` ; do
-rfile=`echo $rnw | sed 's/\.[rR]nw/.R/'`
-R --no-save <<EOT
- Stangle("$rnw")
- source("$rfile", echo=TRUE)
-EOT
-done
-rm -rf *
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index b6c573a..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,2 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/hexbin_([\d.-]*)\.tar.gz
diff --git a/inst/doc/hexagon_binning.R b/inst/doc/hexagon_binning.R
new file mode 100644
index 0000000..7c08d1d
--- /dev/null
+++ b/inst/doc/hexagon_binning.R
@@ -0,0 +1,233 @@
+### R code from vignette source 'hexagon_binning.Rnw'
+
+###################################################
+### code chunk number 1: comphexsq
+###################################################
+library("hexbin")#,lib.loc="/home/nikko/R-devel/hex.devel/tst")
+x <- rnorm(1000)
+y <- rnorm(1000)
+##-- Hexagon Bins: --
+hbin <- hexbin(x,y, xbins = 25)
+grid.newpage()
+pushViewport(viewport(layout=grid.layout(1, 2)))
+pushViewport(viewport(layout.pos.col=1,layout.pos.row=1))
+plot(hbin, style="lattice", legend=0, xlab = "X", ylab = "Y", newpage=FALSE)
+popViewport()
+
+##-- Manual "square" binning: --
+## grid
+rx <- range(x); bx <- seq(rx[1],rx[2], length=29)
+ry <- range(y); by <- seq(ry[1],ry[2], length=29)
+## midpoints
+mx <- (bx[-1]+bx[-29])/2
+my <- (by[-1]+by[-29])/2
+gg <- as.matrix(expand.grid(mx,my))# dim = (28^2, 2)
+zz <- unname(table(cut(x, b = bx), cut(y, b = by)))# 28 x 28
+ind <- zz > 0
+if(FALSE) ## ASCII image:
+ symnum(unname(ind))
+sq.size <- zz[ind]^(1/3) / max(zz)
+## if we used base graphics:
+## symbols(gg[ind,], squares = sq.size, inches = FALSE, fg = 2, bg = 2)
+pushViewport(viewport(layout.pos.col=2, layout.pos.row=1))
+vp <- plot(hbin, style="lattice", legend=0,
+ xlab = "X", ylab = "Y", newpage=FALSE, type="n")
+pushHexport(vp$plot, clip="on")
+grid.rect(x= gg[ind,1], y=gg[ind,2], width = sq.size, height= sq.size,
+ default.units = "native", gp = gpar(col="black",fill="black"))
+popViewport()
+
+
+###################################################
+### code chunk number 2: nearNeighbor
+###################################################
+x <- -2:2
+sq <- expand.grid(list(x = x, y = c(-1,0,1)))
+fc.sq <- rbind(sq,sq+.5) # face centered squares
+fc.sq$y <- sqrt(3)*fc.sq$y # stretch y by the sqrt(3)
+nr <- length(fc.sq$x)/2
+
+
+###################################################
+### code chunk number 3: hexagon_binning.Rnw:138-170
+###################################################
+par(mfrow = c(3,1))
+par(mai = c(.1667,0.2680,0.1667,0.2680)) ##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+points(-.25,.15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1)+1
+py <- sqrt(3)*(c(0,0,-1,-1)+1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1) + 1
+py <- sqrt(3)*(c(0,0,-1,-1) + 1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+px <- c(-.5,-.5,0,.5, .5, 0)
+py <- c(-.5, .5,1,.5,-.5,-1) /sqrt(3)
+polygon(px, py, col = gray(.5), density = 0)
+polygon(px-.5, py+sqrt(3)/2, density = 0, col = 4)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+plot.new()
+arrows(-.25, .15, 0, 0, angle = 10, length = .05)
+
+
+###################################################
+### code chunk number 4: basic
+###################################################
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40)
+plot(hbin)
+
+
+###################################################
+### code chunk number 5: showcol
+###################################################
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"),"inches"),
+ convertHeight(unit(1,"npc"),"inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40, shape = shape)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y", newpage = FALSE)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = terrain.colors)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = BTY)
+popViewport()
+
+
+###################################################
+### code chunk number 6: showsmth
+###################################################
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+x <- rnorm(10000)
+y <- rnorm(10000)
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+ convertHeight(unit(1,"npc"), "inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+hbin <- hexbin(x,y, xbins = 30,shape = shape)
+hsmbin1 <- hsmooth(hbin, c( 1, 0,0))
+hsmbin2 <- hsmooth(hbin, c(24,12,0))
+hsmbin2 at count <- as.integer(ceiling(hsmbin2 at count/sum(hsmbin2 at wts)))
+hsmbin3 <- hsmooth(hbin,c(48,24,12))
+hsmbin3 at count <- as.integer(ceiling(hsmbin3 at count/sum(hsmbin3 at wts)))
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
+plot(hsmbin1, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hsmbin2, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hsmbin3, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+
+
+###################################################
+### code chunk number 7: hbox
+###################################################
+data(NHANES)
+#grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+#vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+# convertHeight(unit(1,"npc"), "inches"))
+vpin <- c(unit(6,"inches"),unit(4, "inches"))
+shape <- optShape(height = vpin[2], width = vpin[1], mar = mai)
+hb <- hexbin(NHANES$Transferin, NHANES$Hemoglobin, shape = shape)
+hbhp <- hboxplot(erode(hb,cdfcut = .05),unzoom = 1.3)
+pushHexport(hbhp,clip = 'on')
+hexGraphPaper(hb,fill.edges = 3)
+popViewport()
+
+
+###################################################
+### code chunk number 8: hdiff
+###################################################
+#grid.newpage()
+shape <- optShape(height = vpin[2],width = vpin[1],mar = mai)
+xbnds <- range(NHANES$Transferin,na.rm = TRUE)
+ybnds <- range(NHANES$Hemoglobin,na.rm = TRUE)
+hbF <- hexbin(NHANES$Transferin[NHANES$Sex == "F"],
+ NHANES$Hemoglobin[NHANES$Sex == "F"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+hbM <- hexbin(NHANES$Transferin[NHANES$Sex == "M"],
+ NHANES$Hemoglobin[NHANES$Sex == "M"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+plot.new()
+hdiffplot(erode(hbF,cdfcut = .25),erode(hbM,cdfcut = .25),unzoom = 1.3)
+
+
+###################################################
+### code chunk number 9: marray1
+###################################################
+### Need to redo this part.
+library("marray")
+data(swirl, package = "marray") ## use swirl dataset
+
+hb1 <- hexbin(maA(swirl[,1]), maM(swirl[,1]), xbins = 40)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 2)))
+
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+nb <- plot(hb1, type = 'n', xlab = 'A', ylab = 'M',
+ main = "M vs A plot with points", legend = 0, newpage = FALSE)
+pushHexport(nb$plot.vp)
+grid.points(maA(swirl[,1]), maM(swirl[,1]),pch = 16,gp = gpar(cex = .4))
+popViewport()
+nb$hbin <- hb1
+hexVP.abline(nb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(nb)
+popViewport()
+
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+hb <- plotMAhex(swirl[,1], newpage = FALSE,
+ main = "M vs A plot with hexagons", legend = 0)
+hexVP.abline(hb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(hb)
+popViewport()
+
+
+###################################################
+### code chunk number 10: addto
+###################################################
+hplt <- plot(hb1,style = 'centroid',border = gray(.65))
+pushHexport(hplt$plot.vp)
+ll.fit <- loess(hb1 at ycm ~ hb1 at xcm, weights = hb1 at count, span = .4)
+pseq <- seq(hb1 at xbnds[1]+1, hb1 at xbnds[2]-1, length = 100)
+grid.lines(pseq, predict(ll.fit,pseq),
+ gp = gpar(col = 2), default.units = "native")
+
+
diff --git a/inst/doc/hexagon_binning.Rnw b/inst/doc/hexagon_binning.Rnw
new file mode 100644
index 0000000..898c739
--- /dev/null
+++ b/inst/doc/hexagon_binning.Rnw
@@ -0,0 +1,498 @@
+%% Emacs: use Rnw-mode if available, else noweb
+%% NOTE -- ONLY EDIT THE .Rnw FILE !
+
+%\VignetteIndexEntry{Hexagon Binning}
+%\VignetteDepends{hexbin, grid, marray}
+%\VignetteKeywords{Over plotting, Large data set, Visualization}
+%\VignettePackage{hexbin}
+
+\documentclass[]{article}
+
+\usepackage[authoryear,round]{natbib}
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+
+\author{Nicholas Lewin-Koh\footnote{with minor assistance by Martin M\"achler}}
+
+\begin{document}
+
+\title{Hexagon Binning: an Overview}
+\maketitle{}
+
+\section{Overview}
+Hexagon binning is a form of bivariate histogram useful for visualizing
+the structure in datasets with large $n$. The underlying concept of
+hexagon binning is extremely simple;
+\begin{enumerate}
+\item the $xy$ plane over the set (range($x$), range($y$)) is tessellated
+by a regular grid of hexagons.
+
+\item the number of points falling in each hexagon are counted and
+stored in a data structure
+
+\item the hexagons with count $ > 0$ are plotted using a color ramp or
+varying the radius of the hexagon in proportion to the counts.
+\end{enumerate}
+
+The underlying algorithm is extremely fast and effective for displaying
+the structure of datasets with $n \ge 10^6$.
+If the size of the grid and the cuts in the color ramp are chosen in a
+clever fashion than the structure inherent in the data should emerge
+in the binned plots. The same caveats apply to hexagon binning as
+apply to histograms and care should be exercised in choosing the
+binning parameters.
+
+The hexbin package is a set of function for creating, manipulating and
+plotting hexagon bins. The package extends the basic hexagon binning
+ideas with several functions for doing bivariate smoothing, finding an
+approximate bivariate median, and looking at the difference between
+two sets of bins on the same scale. The basic functions can be
+incorporated into many types of plots. This package is based on the
+original package for S-PLUS by Dan Carr at George Mason University and
+is mostly the fruit of his graphical genius and intuition.
+
+\section{Theory and Algorithm}
+Why hexagons? There are many reasons for using hexagons, at least over
+squares. Hexagons have symmetry of nearest neighbors which is lacking
+in square bins. Hexagons are the maximum number of sides a polygon can
+have for a regular tesselation of the plane, so in terms of packing a
+hexagon is 13\% more efficient for covering the plane than
+squares. This property translates into better sampling efficiency at
+least for elliptical shapes. Lastly hexagons are visually less biased
+for displaying densities than other regular tesselations. For instance
+with squares our eyes are drawn to the horizontal and vertical lines
+of the grid. The following figure adapted from \cite[]{carretal}shows
+this effectively.
+
+\begin{figure}[H]
+ \centering
+<<comphexsq, fig=TRUE, width=7, height=4, echo=FALSE>>=
+library("hexbin")#,lib.loc="/home/nikko/R-devel/hex.devel/tst")
+x <- rnorm(1000)
+y <- rnorm(1000)
+##-- Hexagon Bins: --
+hbin <- hexbin(x,y, xbins = 25)
+grid.newpage()
+pushViewport(viewport(layout=grid.layout(1, 2)))
+pushViewport(viewport(layout.pos.col=1,layout.pos.row=1))
+plot(hbin, style="lattice", legend=0, xlab = "X", ylab = "Y", newpage=FALSE)
+popViewport()
+
+##-- Manual "square" binning: --
+## grid
+rx <- range(x); bx <- seq(rx[1],rx[2], length=29)
+ry <- range(y); by <- seq(ry[1],ry[2], length=29)
+## midpoints
+mx <- (bx[-1]+bx[-29])/2
+my <- (by[-1]+by[-29])/2
+gg <- as.matrix(expand.grid(mx,my))# dim = (28^2, 2)
+zz <- unname(table(cut(x, b = bx), cut(y, b = by)))# 28 x 28
+ind <- zz > 0
+if(FALSE) ## ASCII image:
+ symnum(unname(ind))
+sq.size <- zz[ind]^(1/3) / max(zz)
+## if we used base graphics:
+## symbols(gg[ind,], squares = sq.size, inches = FALSE, fg = 2, bg = 2)
+pushViewport(viewport(layout.pos.col=2, layout.pos.row=1))
+vp <- plot(hbin, style="lattice", legend=0,
+ xlab = "X", ylab = "Y", newpage=FALSE, type="n")
+pushHexport(vp$plot, clip="on")
+grid.rect(x= gg[ind,1], y=gg[ind,2], width = sq.size, height= sq.size,
+ default.units = "native", gp = gpar(col="black",fill="black"))
+popViewport()
+@
+ \caption[bivariate: squares and hexagons]{A bivariate point set binned
+ into squares and hexagons. Bins are
+ scaled approximately equal, and the size of the glyph is proportional
+ to the count in that bin.}
+ \label{fig:compHexSq}
+\end{figure}
+
+
+We can see in Figure~\ref{fig:compHexSq} that when the data are plotted
+as squares centered on a regular lattice our eye is drawn to the regular lines
+which are parallel to the underlying grid. Hexagons tend to break up
+the lines.
+
+How does does the hexagon binning algorithm work?
+
+\begin{enumerate}
+\item Squash $Y$ by $\sqrt{3}$
+\item Create a dual lattice
+\item Bin each point into pair of near neighbor rectangles
+\item Pick closest of the rectangle centers (adjusting for $\sqrt{3}$)
+\end{enumerate}
+
+
+<< nearNeighbor, echo = false, results = hide >>=
+x <- -2:2
+sq <- expand.grid(list(x = x, y = c(-1,0,1)))
+fc.sq <- rbind(sq,sq+.5) # face centered squares
+fc.sq$y <- sqrt(3)*fc.sq$y # stretch y by the sqrt(3)
+nr <- length(fc.sq$x)/2
+@
+
+\begin{figure}[H]
+ \centering
+<< fig = TRUE,width = 4,height = 8,echo = FALSE >>=
+par(mfrow = c(3,1))
+par(mai = c(.1667,0.2680,0.1667,0.2680)) ##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+points(-.25,.15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1)+1
+py <- sqrt(3)*(c(0,0,-1,-1)+1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1) + 1
+py <- sqrt(3)*(c(0,0,-1,-1) + 1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+px <- c(-.5,-.5,0,.5, .5, 0)
+py <- c(-.5, .5,1,.5,-.5,-1) /sqrt(3)
+polygon(px, py, col = gray(.5), density = 0)
+polygon(px-.5, py+sqrt(3)/2, density = 0, col = 4)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+plot.new()
+arrows(-.25, .15, 0, 0, angle = 10, length = .05)
+@
+\caption[Near Neighbor Rectangles]{}
+\label{fig:binalg}
+\end{figure}
+
+Figure~\ref{fig:binalg} shows graphically how the algorithm works. In
+the first panel we see the the dual lattice laid out in black and blue
+points. The red point is an arbitrary point to be binned. The second
+panel shows the near neigbor rectangles for each lattice around the
+point to be binned, the intersection of the rectangles contains the
+point. The last panel shows the simple test for locating the point in
+the hexagon, the closest of the two corners which are not
+intersections is the center of the hexagon to which the point should
+be allocated. The binning can be calculated in one pass through the
+data, and is clearly $O(n)$ with a small constant. Storage is vastly
+reduced compared to the original data.
+
+\section{Basic Hexagon Binning Functions}
+Using the basic hexagon binning functions are not much more involved
+than using the basic plotting functions. The following little example
+shows the basic features of the basic plot and binning functions.
+We start by loading the package and generating a toy example data set.
+
+<< basic, fig = TRUE, results = hide >>=
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40)
+plot(hbin)
+@
+There are two things to note here. The first is that the function
+\texttt{gplot.hexbin} is defined as a \texttt{plot} method for the S4 class
+\texttt{hexbin}. The second is that the default color scheme for the
+hexplot is a gray scale. However, there is an argument to plot,
+\texttt{colramp}, that allows the use of any function that excepts an
+argument \texttt{n} and returns $n$ colors. Several functions are supplied
+that provide alternative color-ramps to R's built in color ramp functions,
+see \texttt{help(ColorRamps)}.
+
+<< showcol, fig = TRUE, width = 7, height = 4, echo = FALSE >>=
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"),"inches"),
+ convertHeight(unit(1,"npc"),"inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40, shape = shape)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y", newpage = FALSE)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = terrain.colors)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = BTY)
+popViewport()
+@
+
+The figure shows three examples of using hexagons in a plot for large $n$ with
+different color schemes. Upper left: the default gray scale, upper right: the
+R base \texttt{terrain.colors()}, and lower middle: \texttt{BTY()}, a
+blue to yellow color ramp supplied with hexbin on a perceptually linear
+scale.
+
+The hexbin package supplies a plotting method for the hexbin data
+structure. The plotting method \texttt{gplot.hexbin} accepts all the
+parameters for the hexagon function and supplies a legend as well, for
+easy interpretation of the plot. Figure~2 shows a hex binned plot with
+a legend. A function \texttt{grid.hexlegend} is supplied for creating user
+specified hexagon legends.
+
+\section{Extended Hexagon Functions}
+So far we have looked at the basic hexagon plot. The hexbin package
+supplies several extensions to the basic hexbin, and the associated
+hexplot. The extensions discussed in this section will be smoothing
+hexbin objects using the hsmooth function, approximating a bivariate
+median with hexagons and a version of a bivariate boxplot, and using
+eroded hexbin objects to look at the overlap of two bivariate populations.
+
+\subsection{Smoothing with \texttt{hsmooth}}
+At this point the hexbin package only provides a single option for
+smoothing using a discrete kernel. Several improvements are in
+development including an apply function over neighborhoods and spline
+functions using a hexagonal basis or tensor products. The apply
+function should facilitate constructing more sophisticated kernel
+smoothers. The hexagon splines will provide an alternative to
+smoothing on a square grid and allow interpolation of hexagons to
+finer grids.
+
+The current implementation uses the center cell, immediate
+neighbors and second neighbors to smooth the counts. The counts for
+each resulting cell is a linear combination of the counts in the
+defined neighborhood, including the center cell and weights. The
+counts are blurred over the the domain, and the domain increases
+because of shifting. Generally the dimension of the occupied cells of
+the lattice increases by one, sometimes two.
+
+Some examples of using the hsmooth function are given below. Notice in
+the plots that the first plot is with no smoothing, weights are
+\texttt{c(1,0,0)} meaning that only the center cell is used with
+identity weights. The second plot shows a first order kernel using
+weights \texttt{c(24,12,0)}, while the third plot uses weights for
+first and second order neighbors specified as \texttt{c(48,24,12)}.
+The code segment generating these plots rescales the smoothed counts
+so that they are on the original scale.
+
+<< showsmth, fig = TRUE, width = 8, height = 4, echo = FALSE >>=
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+x <- rnorm(10000)
+y <- rnorm(10000)
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+ convertHeight(unit(1,"npc"), "inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+hbin <- hexbin(x,y, xbins = 30,shape = shape)
+hsmbin1 <- hsmooth(hbin, c( 1, 0,0))
+hsmbin2 <- hsmooth(hbin, c(24,12,0))
+hsmbin2 at count <- as.integer(ceiling(hsmbin2 at count/sum(hsmbin2 at wts)))
+hsmbin3 <- hsmooth(hbin,c(48,24,12))
+hsmbin3 at count <- as.integer(ceiling(hsmbin3 at count/sum(hsmbin3 at wts)))
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
+plot(hsmbin1, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hsmbin2, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hsmbin3, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+@
+\subsection{Bin Erosion and the \texttt{hboxplot}}
+The next tool to introduce, gray level erosion, extends the idea of
+the boxplot. The idea is to extract cells in a way that the most
+exposed cells are removed first, ie cells with fewer neighbors, but
+cells with lower counts are removed preferentially to cells with
+higher counts. The algorithm works as follows:
+Mark the high count cells containing a given fraction, cdfcut, of
+the total counts. Mark all the cells if cdfcut is zero.
+The algorithm then performs gray-level erosion on the
+marked cells. Each erosion cycle removes counts from cells. The
+counts removed from each cell are a multiple of the cell's exposed-face
+count. The algorithm chooses the multiple so at least one cell will be
+empty or have a count deficit on each erosion cycle. The erode vector
+contains an erosion number for each cell. The value of erode is
+
+\begin{center}
+ $6\times$(The erosion cycle at cell removal) $ - $
+ (The cell deficit at removal)
+\end{center}
+
+The cell with the highest erosion number is a candidate bivariate
+median. A few ties in the erosion order are common.
+
+The notion of an ordering to the median is nice because it allows us
+to create a version of a bivariate box plot built on hexagons. The
+following example comes from a portion of the ''National Health and Nutrition
+Examination Survey'' included in \texttt{hexbin} as the sample data
+set NHANES. The data consist of 9575 persons and mesures various
+clinical factors. Here in Figure~\ref{hbox} we show the levels of
+transferin, a measure of iron binding against hemoglobin for all
+
+\begin{figure}[H]
+ \centering
+
+<< hbox, fig = TRUE, width = 6, height = 4, echo = FALSE >>=
+data(NHANES)
+#grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+#vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+# convertHeight(unit(1,"npc"), "inches"))
+vpin <- c(unit(6,"inches"),unit(4, "inches"))
+shape <- optShape(height = vpin[2], width = vpin[1], mar = mai)
+hb <- hexbin(NHANES$Transferin, NHANES$Hemoglobin, shape = shape)
+hbhp <- hboxplot(erode(hb,cdfcut = .05),unzoom = 1.3)
+pushHexport(hbhp,clip = 'on')
+hexGraphPaper(hb,fill.edges = 3)
+popViewport()
+@
+\caption{Hexagon "boxplots" showing the top 95 percent of the data for
+ males and females. The red hexagons are an estimate of the bivariate median.}
+\label{hbox}
+\end{figure}
+
+Note that we have added ``hexagon graph paper'' to the plot. This can
+be done for any hexbin plot, using the command
+\texttt{hexGraphPaper()} where the main argument is the hexbin object.
+
+\subsection{Comparing Distributions and the \texttt{hdiffplot}}
+With univariate data, if there are multiple groups, one often uses a
+density estimate to overlay densities, and compare two or more
+distributions. The hdiffplot is the bivariate analog. The idea behind
+the hdiff plot is to plot one or more bin objects representing
+multiple groups to compare the distributions. The following example
+uses the National Health data supplied in the hexbin package,
+(\texttt{NHANES}). Below we show a comparison of males and females,
+the bivariate relationship is transferin, which is a derived measure
+of the ability of blood to bind oxygen, vs the level of hemoglobin.
+Note that in the call to \texttt{hdiffplot} we erode the bins to
+calculate the bivariate medians, and only display the upper 75\% of
+the data.
+\begin{figure}[H]
+ \centering
+<< hdiff, fig = TRUE, width = 6, height = 4, echo = TRUE >>=
+#grid.newpage()
+shape <- optShape(height = vpin[2],width = vpin[1],mar = mai)
+xbnds <- range(NHANES$Transferin,na.rm = TRUE)
+ybnds <- range(NHANES$Hemoglobin,na.rm = TRUE)
+hbF <- hexbin(NHANES$Transferin[NHANES$Sex == "F"],
+ NHANES$Hemoglobin[NHANES$Sex == "F"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+hbM <- hexbin(NHANES$Transferin[NHANES$Sex == "M"],
+ NHANES$Hemoglobin[NHANES$Sex == "M"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+plot.new()
+hdiffplot(erode(hbF,cdfcut = .25),erode(hbM,cdfcut = .25),unzoom = 1.3)
+@
+\caption{A difference plot of transferin vs hemoglobin for males and females.}
+\label{hdiffplot}
+\end{figure}
+
+
+
+\subsection{Plotting a Third Concomitant Variable}
+In many cases, such as with spatial data, one may want to plot the
+levels of a third variable in each hexagon. The grid.hexagons function
+has a pair of arguments, \texttt{use.count} and \texttt{cell.at}. If
+\texttt{use.count = FALSE} and \texttt{cell.at} is a numeric vector of
+the same length as \texttt{hexbin at count} then the attribute vector
+will be used instead of the counts. \texttt{hexTapply} will
+summarize values for each hexagon according to the supplied function
+and return the table in the right order to use as an attribute
+vector. Another alternative is to set the \texttt{cAtt} slot of the
+hexbin object and grid.hexagons will automatically plot the attribute
+if \texttt{use.count = FALSE} and \texttt{cell.at = NULL}.
+
+Here is an example using spatial data. Often cartographers use
+graduated symbols to display varying numerical quantities across a region.
+
+
+
+\section{Example: cDNA Chip Normalization}
+This example is taken from the marray package, which
+supplies methods and classes for the normalization and diagnostic
+plots of cDNA microarrays. In this example the goal is not to make any
+comments about the normalization methodology, but rather to show how
+the diagnostic plots can be enhanced using hexagon binning due to the
+large number of points ($n = 8,448$ cDNA probes per chip).
+
+We look at the diagnostic plot $M$ vs $A$, where $M$ is the
+log--ratio, $M = \log <- 2 \frac{R}{G}$ and $A$ is the overall intensity,
+$A = \log <- 2\sqrt{RG}$. Figure~3 shows the plot using points and on the
+right hexagons. The hexagon binned plot shows that most of the pairs
+are well below zero, and that the overall shape is more like a comet
+with most of the mass at the bottom of the curve, rather than a thick
+bar of points curving below the line.
+
+<< marray1, fig = TRUE, results = hide >>=
+### Need to redo this part.
+library("marray")
+data(swirl, package = "marray") ## use swirl dataset
+
+hb1 <- hexbin(maA(swirl[,1]), maM(swirl[,1]), xbins = 40)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 2)))
+
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+nb <- plot(hb1, type = 'n', xlab = 'A', ylab = 'M',
+ main = "M vs A plot with points", legend = 0, newpage = FALSE)
+pushHexport(nb$plot.vp)
+grid.points(maA(swirl[,1]), maM(swirl[,1]),pch = 16,gp = gpar(cex = .4))
+popViewport()
+nb$hbin <- hb1
+hexVP.abline(nb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(nb)
+popViewport()
+
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+hb <- plotMAhex(swirl[,1], newpage = FALSE,
+ main = "M vs A plot with hexagons", legend = 0)
+hexVP.abline(hb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(hb)
+popViewport()
+@
+
+
+
+\section{Manipulating Hexbins}
+The underlying functions for hexbin have been rewritten and now depend
+on the grid graphics system. The support unit for all hexagon plots is
+the hexViewport. The function \texttt{hexViewport()} takes a hexbin
+object as input and creates a viewport scaled to the current device or
+viewport so that the aspect ratio is scaled appropriately for the
+hexagons. Unlike in the base graphic functions where the aspect ratio
+is maintained by shifting the range of the axes, here the extra space
+is shifted into the margins. Currently hexViewport returns a
+hexViewport object that has information on the margins and
+its own pushViewport method. In the next example we will 1st show how
+to manipulate an existing plot using grid commands and second show how to
+create a custom plotting function using \texttt{hexViewport} and grid.
+
+\subsection{Adding to an existing plot}
+Adding to an existing plot requires the use of grid
+functions. For instance, in the following code,
+<< addto,fig = TRUE,echo = TRUE >>=
+hplt <- plot(hb1,style = 'centroid',border = gray(.65))
+pushHexport(hplt$plot.vp)
+ll.fit <- loess(hb1 at ycm ~ hb1 at xcm, weights = hb1 at count, span = .4)
+pseq <- seq(hb1 at xbnds[1]+1, hb1 at xbnds[2]-1, length = 100)
+grid.lines(pseq, predict(ll.fit,pseq),
+ gp = gpar(col = 2), default.units = "native")
+@
+we have to use \texttt{grid.lines()}, as opposed to \texttt{lines()}.
+
+
+\end{document}
diff --git a/inst/doc/hexagon_binning.pdf b/inst/doc/hexagon_binning.pdf
new file mode 100644
index 0000000..73af27f
Binary files /dev/null and b/inst/doc/hexagon_binning.pdf differ
diff --git a/man/NHANES.Rd b/man/NHANES.Rd
new file mode 100644
index 0000000..f064fa4
--- /dev/null
+++ b/man/NHANES.Rd
@@ -0,0 +1,52 @@
+\name{NHANES}
+\alias{NHANES}
+\docType{data}
+\title{NHANES Data : National Health and Nutrition Examination Survey}
+\usage{data(NHANES)}
+\description{
+ This is a somewhat large interesting dataset, a data frame of 15
+ variables (columns) on 9575 persons (rows).
+}
+\format{
+ This data frame contains the following columns:
+ \describe{
+ \item{Cancer.Incidence}{binary factor with levels \code{No} and \code{Yes}.}
+ \item{Cancer.Death}{binary factor with levels \code{No} and \code{Yes}.}
+ \item{Age}{numeric vector giving age of the person in years.}
+ \item{Smoke}{a factor with levels \code{Current}, \code{Past},
+ \code{Nonsmoker}, and \code{Unknown}.}
+ \item{Ed}{numeric vector of \eqn{\{0,1\}} codes giving the education level.}
+ \item{Race}{numeric vector of \eqn{\{0,1\}} codes giving the
+ person's race.%% FIXME : 0 = ? 1 = ?
+ }
+ \item{Weight}{numeric vector giving the weight in kilograms}
+ \item{BMI}{numeric vector giving Body Mass Index, i.e.,
+ \code{Weight/Height^2} where Height is in meters, and missings
+ (61\% !) are coded as \code{0} originally.}%% rather FIXME?
+ \item{Diet.Iron}{numeric giving Dietary iron.}
+ \item{Albumin}{numeric giving albumin level in g/l.}
+ \item{Serum.Iron}{numeric giving Serum iron in \eqn{\mu}{u}g/l.}
+ \item{TIBC}{numeric giving Total Iron Binding Capacity in \eqn{\mu}{u}g/l.}
+ \item{Transferin}{numeric giving Transferin Saturation which is just
+ \code{100*serum.iron/TIBC}.}
+ \item{Hemoglobin}{numeric giving Hemoglobin level.}
+ \item{Sex}{a factor with levels \code{F} (female) and \code{M} (male).}
+ }
+}
+\examples{
+data(NHANES)
+summary(NHANES)
+## Missing Data overview :
+nNA <- sapply(NHANES, function(x)sum(is.na(x)))
+cbind(nNA[nNA > 0])
+# Which are just these 6 :
+\dontrun{
+Diet.Iron 141
+Albumin 252
+Serum.Iron 1008
+TIBC 853
+Transferin 1019
+Hemoglobin 759
+}%dont
+}
+\keyword{datasets}
diff --git a/man/colramp.Rd b/man/colramp.Rd
new file mode 100644
index 0000000..3ca5627
--- /dev/null
+++ b/man/colramp.Rd
@@ -0,0 +1,60 @@
+\name{ColorRamps}
+\title{Color Ramps on Perceptually Linear Scales}
+\alias{ColorRamps}
+\alias{LinGray}
+\alias{BTC}
+\alias{BTY}
+\alias{LinOCS}
+\alias{heat.ob}
+\alias{magent}
+\alias{plinrain}
+\description{
+ Functions for returning colors on perceptually linear scales,
+ where steps correspond to \sQuote{just detectable differences}.
+}
+\usage{
+LinGray (n, beg=1, end=92)
+BTC (n, beg=1, end=256)
+LinOCS (n, beg=1, end=256)
+heat.ob (n, beg=1, end=256)
+magent (n, beg=1, end=256)
+plinrain(n, beg=1, end=256)
+}
+\arguments{
+ \item{n}{number of colors to return from the ramp}
+ \item{beg}{begining of ramp, integer from 1-255}
+ \item{end}{end of ramp, integer from 1-255}
+}
+\value{
+ returns an array of colors
+}
+\details{
+ Several precalulated color ramps, that are on a perceptually linear
+ color scale. A perceptually linear color scale is a scale where each
+ jump corresponds to a \dQuote{just detectable difference} in color and the
+ scale is percieved as linear by the human eye (emprically determined).
+
+ When using the ramps, if \code{beg} is less than \code{end} the ramp
+ will be reversed.
+}
+\references{
+ Haim Levkowitz (1997)
+ \emph{Color Theory and Modeling for Computer Graphics,
+ Visualization, and Multimedia Applications}.
+ Kluwer Academic Publishers, Boston/London/Dordrecht.
+ \url{http://www.cs.uml.edu/~haim/ColorCenter/}
+}
+\seealso{
+ \code{\link[grDevices:palettes]{rainbow}},
+ \code{\link[grDevices:palettes]{terrain.colors}},
+ \code{\link[grDevices]{rgb}},
+ \code{\link[grDevices]{hsv}}
+}
+\examples{
+h <- hexbin(rnorm(10000),rnorm(10000))
+plot(h, colramp= BTY)
+## looks better if you shave the tails:
+plot(h, colramp= function(n){LinOCS(n,beg=15,end=225)})
+}
+\author{Nicholas Lewin-Koh}
+\keyword{color}
diff --git a/man/erode.hexbin.Rd b/man/erode.hexbin.Rd
new file mode 100644
index 0000000..79d2c90
--- /dev/null
+++ b/man/erode.hexbin.Rd
@@ -0,0 +1,86 @@
+\name{erode.hexbin}
+\alias{erode}
+\alias{erode.hexbin}
+\alias{erode,hexbin-method}
+\alias{erodebin-class}
+
+\title{Erosion of a Hexagon Count Image}
+\description{
+ This erosion algorithm removes counts from hexagon cells at a rate
+ proportional to the cells' exposed surface area. When a cell becomes
+ empty, algorithm removes the emptied cell and notes the removal
+ order. Cell removal increases the exposure of any neighboring cells.
+ The last cell removed is a type of bivariate median.
+}
+
+\usage{
+erode(hbin, cdfcut = 0.5)
+erode.hexbin(hbin, cdfcut = 0.5)
+}
+
+\arguments{
+ \item{hbin}{an object of class \code{\link{hexbin}}.}
+ \item{cdfcut}{number in (0,1) indicating the confidence level for the
+ limits.}
+}
+
+\value{
+ An \code{"erodebin"} object (with all the slots from \code{hbin}) and
+ additionally with
+ high count cells and a component \code{erode} that gives the erosion order.
+}
+
+\details{
+ The algorithm extracts high count cells with containing a given
+ fraction (cdfcut) of the total counts. The algorithm extracts all
+ cells if cdfcut=0. The algorithm performs gray-level erosion on the
+ extracted cells. Each erosion cycle removes counts from cells. The
+ counts removed for each cell are a multiple of the cell's exposed-face
+ count. The algorithm choses the multiple so at least one cell will be
+ empty or have a count deficit on each erosion cycle. The erode vector
+ contain an erosion number for each cell. The value of erode is
+
+ 6*erosion\_cycle\_ at\_ cell\_ removal - cell\_deficit\_at\_removal
+
+ Cells with low values are eroded first. The cell with the highest
+ erosion number is a candidate bivariate median. A few ties in erode
+ are common.
+}
+
+\seealso{
+ \code{\link{hexbin}}, \code{\link{smooth.hexbin}},
+ \code{\link{hcell2xy}}, %%FIXME\code{\link{hcell}},
+ %% \code{\link{hboxplot}}, \code{\link{hdiffplot}},
+ %% \code{\link{hmatplot}},
+ \code{\link{gplot.hexbin}},
+ \code{\link{grid.hexagons}}, \code{\link{grid.hexlegend}}
+}
+
+\examples{
+set.seed(153)
+x <- rnorm(10000)
+y <- rnorm(10000)
+bin <- hexbin(x,y)
+
+smbin <- smooth.hexbin(bin)
+erodebin <- erode.hexbin(smbin, cdfcut=.5)
+plot(erodebin)
+
+## bivariate boxplot
+hboxplot(erodebin, main = "hboxplot(erodebin)")
+
+
+%% MM: This looks wrong -- both the graphic and the logic in "par" here :
+# show erosion order
+plot(bin,style= "lat", minarea=1, maxarea=1,
+ legend=FALSE, border=gray(.7))
+
+%% FIXME: {compare with example in "hexbin0"}
+grid.hexagons(erodebin,style= "lat", minarea=1, maxarea=1,pen="green")
+xy <- hcell2xy(erodebin)
+library("grid")
+grid.text(lab = as.character(erodebin at erode), xy$x, xy$y,
+ gp = gpar(col="white", cex=0.65))
+
+}
+\keyword{hplot}
diff --git a/man/getHMedian.Rd b/man/getHMedian.Rd
new file mode 100644
index 0000000..447511d
--- /dev/null
+++ b/man/getHMedian.Rd
@@ -0,0 +1,34 @@
+\name{getHMedian}
+\alias{getHMedian}
+\alias{getHMedian,erodebin-method}
+\title{Get coordiantes of the median cell after the erode operation}
+\description{
+ A method for a eroded hexbin object to extract the coordinates of the
+ median cell. The median is simply the cell with the highest erosion
+ number or the last cell to be eroded.
+}
+\usage{
+getHMedian(ebin)
+}
+\arguments{
+ \item{ebin}{result of \code{\link{erode.hexbin}()}.}
+}
+\section{Methods}{
+ \describe{
+ \item{ebin = "erodebin"}{...}
+ }
+}
+\seealso{\code{\link{erode.hexbin}}
+}
+\examples{
+set.seed(153)
+x <- rnorm(10000)
+y <- rnorm(10000)
+bin <- hexbin(x,y)
+
+smbin <- smooth.hexbin(bin)
+erodebin <- erode.hexbin(smbin, cdfcut=.5)
+getHMedian(erodebin)
+}
+\keyword{methods}
+
diff --git a/man/gplot.hexbin.Rd b/man/gplot.hexbin.Rd
new file mode 100644
index 0000000..9db2325
--- /dev/null
+++ b/man/gplot.hexbin.Rd
@@ -0,0 +1,145 @@
+\name{gplot.hexbin}
+\alias{gplot.hexbin}
+\alias{plot,hexbin,missing-method}
+\title{Plotting Hexagon Cells with a Legend}
+\description{
+ Plots Hexagons visualizing the counts in an hexbin object. Different
+ styles are availables. Provides a legend indicating the count
+ representations.
+}
+\usage{
+%% In future: No longer export gplot.hexbin() !
+gplot.hexbin(x, style = "colorscale", legend = 1.2, lcex = 1,
+ minarea = 0.04, maxarea = 0.8, mincnt = 1, maxcnt = max(x at count),
+ trans = NULL, inv = NULL, colorcut = seq(0, 1, length = min(17, maxcnt)),
+ border = NULL, density = NULL, pen = NULL,
+ colramp = function(n) LinGray(n,beg = 90,end = 15),
+ xlab = "", ylab = "", main = "", newpage = TRUE,
+ type = c("p", "l", "n"), xaxt = c("s", "n"), yaxt = c("s", "n"),
+ clip = "on", verbose = getOption("verbose"))
+%% FIXME: This is the S4 plot method for 'hexbin'
+%% currently also exported "standalone" - for testing,debugging..
+%% we'd really don't want to repeat the argument list; use \synopsis{.} ?
+\S4method{plot}{hexbin,missing}(x, style = "colorscale", legend = 1.2, lcex = 1,
+ minarea = 0.04, maxarea = 0.8, mincnt = 1, maxcnt = max(x at count),
+ trans = NULL, inv = NULL, colorcut = seq(0, 1, length = min(17, maxcnt)),
+ border = NULL, density = NULL, pen = NULL,
+ colramp = function(n) LinGray(n,beg = 90,end = 15),
+ xlab = "", ylab = "", main = "", newpage = TRUE,
+ type = c("p", "l", "n"), xaxt = c("s", "n"), yaxt = c("s", "n"),
+ clip = "on", verbose = getOption("verbose"))
+}
+\arguments{
+ \item{x}{an object of class \code{\link{hexbin}}.}
+% \item{y}{(required by the S4 method for \code{\link{plot}} but unused
+% here; must be missing)}
+ \item{style}{string specifying the style of hexagon plot,
+ see \code{\link{grid.hexagons}} for the possibilities.}
+ \item{legend}{numeric width of the legend in inches of \code{FALSE}.
+ In the latter case, or when \code{0}, no legend is not produced.}
+ \item{lcex}{characters expansion size for the text in the legend}
+ \item{minarea}{fraction of cell area for the lowest count}
+ \item{maxarea}{fraction of the cell area for the largest count}
+ \item{mincnt}{cells with fewer counts are ignored.}
+ \item{maxcnt}{cells with more counts are ignored.}
+ \item{trans}{\code{\link{function}} specifying a transformation for
+ the counts such as \code{sqrt}.}
+% FIXME: use better description of these in hexagons() -- or use same
+% ---- help page ?!
+ \item{inv}{the inverse transformation of \code{trans}.}
+ \item{colorcut}{vector of values covering [0, 1] that determine
+ hexagon color class boundaries and hexagon legend size boundaries.
+ Alternatively, an integer (\code{<= maxcnt}) specifying the
+ \emph{number} of equispaced colorcut values in [0,1].}
+ \item{border, density, pen}{color for polygon borders and filling of
+ each hexagon drawn, passed to \code{\link{grid.hexagons}}.}
+ \item{colramp}{function accepting an integer \code{n} as an argument and
+ returning n colors.}
+ \item{xlab, ylab}{x- and y-axis label.}
+ \item{main}{main title.}
+ \item{newpage}{should a new page start?.}
+ \item{type, xaxt, yaxt}{strings to be used (when set to \code{"n"}) for
+ suppressing the plotting of hexagon symbols, or the x- or y-axis,
+ respectively.}
+ \item{clip}{either 'on' or 'off' are the allowed arguments, when on
+ everything is clipped to the plotting region.}
+ \item{verbose}{logical indicating if some diagnostic output should happen.}
+ \item{\dots}{all arguments of \code{gplot.hexbin} can also be used for
+ the S4 \code{\link{plot}} method.}
+}
+\details{
+ This is the (S4) \code{\link{plot}} method for \code{\link{hexbin}} (and
+ \code{erodebin}) objects (\link{erodebin-class}).
+
+ To use the standalone function
+ \code{gplot.hexbin()} is \bold{\emph{deprecated}}.
+ For \code{style}, \code{minarea} etc, see the \bold{Details} section of
+ \code{\link{grid.hexagons}}'s help page.
+
+ The legend functionality is somewhat preliminary. Later versions may
+ include refinements and handle extreme cases (small and large) for
+ cell size and counts.
+}
+\value{
+ invisibly, a list with components
+ \item{plot.vp}{the \code{\link{hexViewport}} constructed and used.}
+ \item{legend.vp}{if a legend has been produced, its
+ \code{\link[grid]{viewport}}.}
+}
+
+\references{ see in \code{\link{grid.hexagons}}.}
+\author{
+ Dan Carr \email{dcarr at voxel.galaxy.gmu.edu},
+ ported by Nicholas Lewin-Koh \email{kohnicho at comp.nus.edu.sg} and
+ Martin Maechler.
+}
+\seealso{\code{\link{hexbin}}, \code{\link{hexViewport}},
+ \code{\link{smooth.hexbin}},
+ \code{\link{erode.hexbin}},
+ \code{\link{hcell2xy}}, \code{\link{hboxplot}},
+ \code{\link{hdiffplot}}. %%, \code{\link{hmatplot}}.
+}
+\examples{
+## 1) simple binning of spherical normal:
+x <- rnorm(10000)
+y <- rnorm(10000)
+bin <- hexbin(x,y)
+
+## Plot method for hexbin !
+## ---- ------ --------
+plot(bin)
+# nested lattice
+plot(bin, style= "nested.lattice")
+
+# controlling the colorscheme
+plot(bin, colramp=BTY, colorcut=c(0,.1,.2,.3,.4,.6,1))
+
+## 2) A mixture distribution
+x <- c(rnorm(5000),rnorm(5000,4,1.5))
+y <- c(rnorm(5000),rnorm(5000,2,3))
+bin <- hexbin(x,y)
+
+pens <- cbind(c("#ECE2F0","#A6BDDB","#1C9099"),
+ c("#FFF7BC","#FEC44F","#D95F0E"))
+plot(bin, style = "nested.lattice", pen=pens)
+# now really crazy
+plot(bin, style = "nested.lattice", pen=pens,border=2,density=35)
+
+# lower resolution binning and overplotting with counts
+bin <- hexbin(x,y,xbins=25)
+P <- plot(bin, style="lattice", legend=FALSE,
+ minarea=1, maxarea=1, border="white")
+##
+%% FIXME!
+library("grid")
+pushHexport(P$plot.vp)
+xy <- hcell2xy(bin)
+ # to show points rather than counts :
+grid.points(x,y,pch=18,gp=gpar(cex=.3,col="green"))
+grid.text(as.character(bin at count), xy$x,xy$y,
+ gp=gpar(cex=0.3, col="red"),default.units="native")
+popViewport()
+
+# Be creative, have fun!
+}
+\keyword{hplot}
diff --git a/man/grid.hexagons.Rd b/man/grid.hexagons.Rd
new file mode 100644
index 0000000..ab9f753
--- /dev/null
+++ b/man/grid.hexagons.Rd
@@ -0,0 +1,199 @@
+\name{grid.hexagons}
+\alias{grid.hexagons}
+\title{Add Hexagon Cells to Plot}
+\description{
+ Plots cells in an hexbin object. The function distinquishes among
+ counts using 5 different styles. This function is the hexagon
+ plotting engine from the \code{plot} method for \code{\link{hexbin}}
+ objects.
+}
+\usage{
+grid.hexagons(dat, style = c("colorscale", "centroids", "lattice",
+ "nested.lattice", "nested.centroids", "constant.col"),
+ use.count=TRUE, cell.at=NULL,
+ minarea = 0.05, maxarea = 0.8, check.erosion = TRUE,
+ mincnt = 1, maxcnt = max(dat at count), trans = NULL,
+ colorcut = seq(0, 1, length = 17),
+ density = NULL, border = NULL, pen = NULL,
+ colramp = function(n){ LinGray(n,beg = 90, end = 15) },
+ def.unit= "native",
+ verbose = getOption("verbose"))
+}
+\arguments{
+ \item{dat}{an object of class \code{hexbin}, see \code{\link{hexbin}}.}
+ \item{style}{character string specifying the type of plotting; must be (a
+ unique abbrevation) of the values given in \sQuote{Usage} above.}
+ \item{use.count}{logical specifying if counts should be used.}
+ \item{cell.at}{numeric vector to be plotted instead of counts, must
+ besame length as the number of cells.}
+ \item{minarea}{numeric, the fraction of cell area for the lowest count.}
+ \item{maxarea}{the fraction of the cell area for the largest count.}
+ \item{check.erosion}{logical indicating only eroded points should be
+ used for \code{"erodebin"} objects; simply passed to
+ \code{\link{hcell2xy}}, see its documentation.}
+ \item{mincnt}{numeric; cells with counts smaller than \code{mincnt}
+ are not shown.}
+ \item{maxcnt}{cells with counts larger than this are not shown.}
+ \item{trans}{a transformation function (or \code{NULL}) for the counts,
+ e.g., \code{\link{sqrt}}.}
+ \item{colorcut}{a vector of values covering [0, 1] which determine
+ hexagon color class boundaries or hexagon size boundaries -- for
+ \code{style = "colorscale"} only.}
+ \item{density}{\code{\link[grid]{grid.polygon}} argument for shading. 0 causes
+ the polygon not to be filled. \emph{This is not implemented (for
+ \code{\link[grid]{grid.polygon}}) yet}.}
+ \item{border}{\code{\link[grid]{grid.polygon}()} argument. Draw the border for
+ each hexagon.}
+ \item{pen}{colors for \code{\link[grid]{grid.polygon}()}. Determines the color
+ with which the polygon will be filled.}
+ \item{colramp}{function of an integer argument \code{n} returning n
+ colors. \code{n} is determined }%% how? FIXME
+ \item{def.unit}{default \code{\link[grid]{unit}} to be used.}% FIXME
+ \item{verbose}{logical indicating if some diagnostic output should happen.}
+}
+\section{SIDE EFFECTS}{Adds hexagons to the plot.}
+
+\details{
+ The six plotting styles have the following effect:
+ \describe{
+ \item{\code{style="lattice"} or \code{"centroids"}:}{
+
+ Plots the hexagons in different sizes based on counts. The
+ \code{"lattice"} version centers the hexagons at the cell centers
+ whereas \code{"centroids"} moves the hexagon centers close to the
+ center of mass for the cells. In all cases the hexagons will not
+ plot outside the cell unless \code{maxarea > 1}. Counts are rescaled
+ into the interval [0,1] and colorcuts determine the class
+ boundaries for sizes and counts. The pen argument for this style
+ should be a single color or a vector of colors of
+ \code{length(bin at count)}.}
+
+ \item{\code{style="colorscale"}:}{
+ Counts are rescaled into the interval [0,1] and colorcuts determines
+ the class boundaries for the color classes. For this style, the
+ function passed as \code{colramp} is used to define the n colors for
+ the n+1 color cuts. The pen argument is ignored.
+ %% S-plus: In motif color options try polygon: black 16 white
+ See \code{\link{LinGray}} for the default \code{colramp} and
+ alternative \dQuote{color ramp} functions.
+ }
+ \item{\code{style="constant.col"}:}{
+ This is an even simpler alternative to \code{"colorscale"},
+ using constant colors (determined \code{pen} optionally).
+ }
+
+ \item{\code{style="nested.lattice"} and \code{"nested.centroids"}:}{
+ Counts are partitioned into classes by power of 10. The encoding
+ nests hexagon size within powers of 10 color contours.
+
+ If the pen argument is used it should be a matrix of colors with 2
+ columns and either \code{ceiling(log10(max(bin at count)))} or
+ \code{length(bin at count)} rows. The default uses the \R color palatte
+ so that pens numbers 2-11 determine colors for completely filled
+ cell Pen 2 is the color for 1's, Pen 3 is the color for 10's, etc.
+ Pens numbers 12-21 determine the color of the foreground hexagons. The
+ hexagon size shows the relative count for the power of 10. Different
+ color schemes give different effects including 3-D illusions
+ %% S-plus :
+ %% One motif color option for the first 4 powers is black \#BBB \#36F
+ %% \#0E3 \#F206 \#FFF4 \#FFF
+ %%
+ %% A second option is for the first 5 power is black \#FFF \#08F \#192
+ %% \#F11 \#FF04 \#000 \#999 \#5CF \#AFA \#FAAF \#000
+ }
+ }
+
+ \emph{Hexagon size encoding \code{minarea} and \code{maxarea}}
+ determine the area of the smallest and largest hexagons
+ plotted. Both are expressed fractions of the bin cell size. Typical
+ values might be .04 and 1. When both values are 1, all plotted
+ hexagons are bin cell size, if \code{maxarea} is greater than 1 than
+ hexagons will overlap. This is sometimes interesting with the lattice
+ and centroid styles.
+
+ \emph{Count scaling}
+
+ \code{relcnt <- (trans(cnt)-trans(mincnt)) / (trans(maxcnt)-trans(mincnt))}
+ \cr
+ \code{area <- minarea + relcnt*maxarea}
+
+ By default the transformation \code{trans()} is the identity
+ function. The legend routine requires the transformation inverse
+ for some options.
+
+ \emph{Count windowing \code{mincnt} and \code{maxcnt}}
+ Only routine only plots cells with cnts in [mincnts, maxcnts]
+}
+\references{
+ Carr, D. B. (1991)
+ Looking at Large Data Sets Using Binned Data Plots,
+ pp. 7--39 in \emph{Computing and Graphics in Statistics};
+ Eds. A. Buja and P. Tukey, Springer-Verlag, New York.
+}
+\author{
+ Dan Carr <dcarr at voxel.galaxy.gmu.edu>;
+ ported and extended by Nicholas Lewin-Koh \email{nikko at hailmail.net}.
+}
+\seealso{\code{\link{hexbin}}, \code{\link{smooth.hexbin}},
+ \code{\link{erode.hexbin}}, \code{\link{hcell2xy}},% \code{\link{hcell}},
+ \code{\link{gplot.hexbin}}, \code{\link{hboxplot}}, \code{\link{hdiffplot}},
+ \code{\link{grid.hexlegend}}% \code{\link{hmatplot}}
+}
+
+\examples{
+set.seed(506)
+x <- rnorm(10000)
+y <- rnorm(10000)
+
+# bin the points
+bin <- hexbin(x,y)
+
+# Typical approach uses plot( <hexbin> ) which controls the plot shape :
+plot(bin, main = "Bivariate rnorm(10000)")
+
+## but we can have more manual control:
+
+# A mixture distribution
+x <- c(rnorm(5000),rnorm(5000,4,1.5))
+y <- c(rnorm(5000),rnorm(5000,2,3))
+hb2 <- hexbin(x,y)
+
+# Show color control and overplotting of hexagons
+## 1) setup coordinate system:
+P <- plot(hb2, type="n", main = "Bivariate mixture (10000)")# asp=1
+
+## 2) add hexagons (in the proper viewport):
+pushHexport(P$plot.vp)
+grid.hexagons(hb2, style= "lattice", border = gray(.1), pen = gray(.6),
+ minarea = .1, maxarea = 1.5)
+library("grid")
+popViewport()
+
+## How to treat 'singletons' specially:
+P <- plot(hb2, type="n", main = "Bivariate mixture (10000)")# asp=1
+pushHexport(P$plot.vp)
+grid.hexagons(hb2, style= "nested.centroids", mincnt = 2)# not the single ones
+grid.hexagons(hb2, style= "centroids", maxcnt = 1, maxarea=0.04)# single points
+popViewport()
+
+
+%% FIXME --- this would mix grid- and traditional-graphics
+%% ----- would need grid-graphics for 'gpclib' -- aaargs...
+% # And if we had all the information...
+% if(require(gpclib)){
+% h1 <- chull(x[1:5000], y[1:5000])
+% h2 <- chull(x[5001:10000], y[5001:10000])
+% h2 <- h2+5000
+% h1 <- as(cbind(x[1:5000],y [1:5000])[h1, ], "gpc.poly")
+% h2 <- as(cbind(x,y)[h2, ], "gpc.poly")
+% plot(hb2, type="n", main = "Bivariate mixture (10000)")# asp=1
+%
+% plot(h1,poly.args = list(col ="#CCEBC5"),add = TRUE)
+% plot(h2,poly.args = list(col ="#FBB4AE"),add = TRUE)
+% plot(intersect(h1, h2), poly.args = list(col = 2), add = TRUE)
+% grid.hexagons(hb2, style= "centroids", border = gray(.1), pen = gray(.6),
+% minarea = .1, maxarea = 1.5)
+% }
+
+}
+\keyword{aplot}
diff --git a/man/grid.hexlegend.Rd b/man/grid.hexlegend.Rd
new file mode 100644
index 0000000..991d005
--- /dev/null
+++ b/man/grid.hexlegend.Rd
@@ -0,0 +1,81 @@
+\name{grid.hexlegend}
+\alias{grid.hexlegend}
+\title{Add a Legend to a Hexbin Plot}
+\description{
+ Plots the legend for the \code{plot} method of \code{\link{hexbin}}.
+ Provides a legend indicating the count representations.
+}
+\usage{
+grid.hexlegend(legend, ysize, lcex, inner, style = ,
+ minarea = 0.05, maxarea = 0.8, mincnt = 1, maxcnt, trans = NULL,
+ inv = NULL, colorcut, density = NULL, border = NULL, pen = NULL,
+ colramp = function(n) { LinGray(n,beg = 90,end = 15) },
+ leg.unit = "native")
+}
+\arguments{
+ \item{legend}{positive number giving width of the legend in inches.}
+ \item{ysize}{height of legend in inches}
+ \item{lcex}{the characters expansion size for the text in the legend,
+ see \code{\link{par}(cex=)}.}
+ \item{inner}{the inner diameter of a hexagon in inches.}
+ \item{style}{the hexagon style; see \code{\link{grid.hexagons}}.}
+ \item{minarea, maxarea}{fraction of the cell area for the lowest and largest
+ count, respectively.}
+ \item{mincnt, maxcnt}{minimum and maximum count accepted in \code{plot}.}
+ \item{trans}{a transformation function for the counts such as
+ \code{\link{sqrt}}.}
+ \item{inv}{the inverse transformation function.}
+ \item{colorcut}{numeric vector of values covering [0, 1] the determine
+ hexagon color classes boundaries and hexagon legend size boundaries.}
+ \item{border}{argument for \code{\link{polygon}()}. Draw the border
+ for each hexagon.}
+ \item{density}{argument for \code{\link{polygon}()} filling. A
+ \code{0} causes the polygon not to be filled.}
+ \item{pen}{color argument used for \code{\link{polygon}(col = .)}.
+ Determines the color with which the polygon will be filled.}
+ \item{colramp}{function accepting an integer \code{n} as an argument and
+ returning n colors.}
+ \item{leg.unit}{unit to use}%FIXME
+
+}
+\details{
+ The \code{plot} method for \code{\link{hexbin}} objects calls this function
+ to produce a legend
+ by setting the graphics parameters, so \code{hex.legend} itself is not a
+ standalone function.
+
+ The legend function is \bold{preliminary}. Later version will include
+ refinements and handle extreme cases (small and large) for cell size
+ and counts.
+
+ See the \bold{Details} section of \code{\link{grid.hexagons}}'s help page.
+}
+\value{
+ This function does not return any value.
+}
+\references{ see in \code{\link{grid.hexagons}}.}
+\author{
+ Dan Carr <dcarr at voxel.galaxy.gmu.edu>
+
+ ported by Nicholas Lewin-Koh <kohnicho at comp.nus.edu.sg>
+}
+
+\seealso{\code{\link{hexbin}}, \code{\link{grid.hexagons}},
+% FIXME
+ \code{\link{smooth.hexbin}}, \code{\link{erode.hexbin}},
+% \code{\link{hcell}},
+ \code{\link{hcell2xy}},
+ \code{\link{gplot.hexbin}},% \code{\link{hboxplot}},% \code{\link{hdiffplot}},
+% \code{\link{hmatplot}}
+}
+
+\examples{
+## Not a stand alone function; typically only called from plot.hexbin()
+%% Hence we should not run it here!
+%% FIXME: Improve hex.legend() such that it *can* be added to plots !!!
+\dontrun{
+ grid.hexlegend(legend = 2, ysize = 1,lcex=8,inner=0.2,
+ maxcnt = 100, colorcut = c(0.5,0.5))
+}
+}
+\keyword{aplot}
diff --git a/man/hboxplot.Rd b/man/hboxplot.Rd
new file mode 100644
index 0000000..1454601
--- /dev/null
+++ b/man/hboxplot.Rd
@@ -0,0 +1,98 @@
+\name{hboxplot}
+\alias{hboxplot}
+\title{2-D Generalization of Boxplot}
+
+\description{
+ If \code{bin} is an \emph{eroded} \code{\link{hexbin}} object, i.e.,
+ an \code{erodebin} object, \code{hboxplot()} plots the high counts cells
+ selected by \code{\link{erode}()}. By default, the high counts
+ cells contain 50 percent of the counts so analagous to the
+ interquartile \dQuote{range}. The function distinguishes the last
+ cells eroded using color. These cells correspond to one definition of the
+ bivariate median.
+%% FIXME ^^ (bad style, content +- ok)
+}
+
+\usage{
+hboxplot(bin, xbnds = NULL, ybnds = NULL,
+ density, border = c(0, grey(0.7)), pen = c(2, 3),
+ unzoom = 1.1, clip ="off", reshape = FALSE,
+ xlab = NULL, ylab = NULL, main = "")
+}
+\arguments{
+ \item{bin}{an object of class \code{\link{hexbin}}.}
+ \item{xbnds,ybnds}{global x- and y-axis plotting limits for multiple
+ plots.}
+ \item{density, border}{arguments for \code{\link{polygon}()} each of
+ length two, the first for the median, the second for the other cells.}
+ \item{pen}{colors (\dQuote{pen numbers}) for \code{polygon()}.}
+ \item{unzoom}{plot limit expansion factor when \code{xbnds} is
+ missing.}
+ \item{clip}{either 'on' or 'off' are the allowed arguments, when on
+ everything is clipped to the plotting region.}
+ \item{reshape}{logical value to reshape the plot although \code{xbnds}
+ and \code{ybnds} are present.}
+ \item{xlab, ylab, main}{x- and y- axis labels and main title}
+}
+
+\value{
+ invisibly, the \code{\link{hexViewport}()} used internally.
+ Used to add to the plot afterwards.
+}
+
+\references{ see in \code{\link{grid.hexagons}}.}
+
+\details{
+ The \code{density}, \code{border}, and \code{pen} arguments correspond
+ to the \code{\link{polygon}} function calls for plotting two types of
+ cells. The cell types, pen numbers and suggested colors are\cr
+ \tabular{lll}{
+ TYPE \tab PEN \tab COLOR \cr
+ cells of bin \tab 2 \tab light gray \cr
+ last eroded cells of bin (median cells)\tab 1 \tab black \cr
+ }
+
+ The erode components of the hexbin objects must be present for the
+ medians cells to plot.
+
+ When \code{xbnds} is missing or \code{reshape} is true, the plot
+ changes graphics parameters and resets them. When \code{xbnds} is
+ missing the function also zooms in based on the available data to
+ provide increased resolution.
+
+ The zoom used the hexagon cell centers. The unzoom argument backs off
+ a bit so the whole hexagon will fit in the plot.
+
+ \code{Hboxplot()} is used as a stand alone function, for producing separate
+ legends .....%%FIXME for \code{\link{hmatplot}()} and for panels in
+ %% \code{\link{hmatplot}()}.
+}
+
+\seealso{
+ \code{\link{hexbin}}, \code{\link{erode}},
+ %\code{\link{smooth.hexbin}},
+ \code{\link{hcell2xy}},% \code{\link{hcell}},
+ \code{\link{gplot.hexbin}},
+% \code{\link{hmatplot}},
+ \code{\link{grid.hexagons}}, \code{\link{grid.hexlegend}}
+}
+
+\examples{
+\dontshow{set.seed(753)}
+## boxplot of smoothed counts
+x <- rnorm(10000)
+y <- rnorm(10000)
+
+bin <- hexbin(x,y)
+erodebin <- erode(smooth.hexbin(bin))
+
+hboxplot(erodebin)
+hboxplot(erodebin, density = c(32,7), border = c(2,4))
+hp <- hboxplot(erodebin, density = c(-1,17),
+ main = "hboxplot(erode*(smooth*(.)))")
+pushHexport(hp)
+library("grid")
+grid.points(x[1:10], y[1:10])# just non-sense to show the principle
+popViewport()
+}
+\keyword{hplot}
diff --git a/man/hcell2xy.Rd b/man/hcell2xy.Rd
new file mode 100644
index 0000000..83c926b
--- /dev/null
+++ b/man/hcell2xy.Rd
@@ -0,0 +1,63 @@
+\name{hcell2xy}
+\alias{hcell2xy}
+\alias{hcell2xy,hexbin-method}
+
+\title{Compute X and Y Coordinates for Hexagon Cells}
+
+\description{
+ Computes x and y coordinates from hexagon cell id's.
+}
+\usage{
+hcell2xy(hbin, check.erosion = TRUE)
+}
+\arguments{
+ \item{hbin}{a object of class \code{"hexbin"}, typically produced by
+ \code{\link{hexbin}(*)}.}
+ \item{check.erosion}{logical indicating if only the eroded points
+ should be returned in the case where \code{hbin} inherits from
+ \code{"erodebin"} (see \code{\link{erodebin-class}}); is \code{TRUE}
+ by default.}
+}
+\value{
+ A list with two components of the same length as \code{bin$cell},
+ \item{x}{}
+ \item{y}{}
+}
+
+%%FIXME \references{see in \code{\link{hcell}}.}
+
+\details{
+ The hexbin object \code{hbin} contains all the needed information.
+ The purpose of this function is to reduce storage. The cost is
+ additional calculation.
+}
+
+\seealso{%%FIXME \code{\link{hcell}}, \code{\link{hray}},
+ \code{\link{hexbin}}.
+}
+
+\examples{
+x <- rnorm(10000)
+y <- rnorm(10000)
+plot(x,y, pch=".")
+hbin <- hexbin(x,y)
+str(xys <- hcell2xy(hbin))
+points(xys, cex=1.5, col=2) ; title("hcell2xy( hexbin(..) )", col.main=2)
+
+%% __________ FIXME ________
+\dontshow{
+## Temporal trends with confidence bounds plotted on a map:
+## <NOT YET> Illustration only pending access to user functions
+## mtapply() # like tapply but for matrices
+## sens.season.slope() # computes sen's seasonal slope
+
+## This part does not work and commented out
+#hbin <- hcell(dat$x,dat$y) # x and y are in map projection units
+#newdat < dat[,c('month','year','value')] # extract columns
+#stats <- mtapply(newdat,bin$cell,sens.season.slope,season=12)
+#plot(mymap,type='l') # map boundaries in map projection units
+#xy <- hcell2xy(hbin) # x and y coordinates for hexagon cell centers
+#hray(xy$x, xy$y,val=stat[,1],lower= stat[,2],upper=stat[,3])
+}
+}
+\keyword{manip}
diff --git a/man/hcell2xyInt.Rd b/man/hcell2xyInt.Rd
new file mode 100644
index 0000000..93ac7e0
--- /dev/null
+++ b/man/hcell2xyInt.Rd
@@ -0,0 +1,47 @@
+\name{hcell2xyInt}
+\alias{hcell2xyInt}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Change cell ids to 2d integer coordinate system}
+\description{
+ Transforms the cell representation of a a lattice into a 2d integer
+ coordinate system.
+}
+\usage{
+ hcell2xyInt(hbin, xbins=NULL, xbnds=NULL, ybnds=NULL, shape=NULL)
+}
+
+\arguments{
+ \item{hbin}{a object of class \code{"hexbin"}, typically produced by
+ \code{\link{hexbin}(*)}.}
+ \item{xbins}{the number of bins partitioning the range of xbnds.}
+ \item{xbnds, ybnds}{horizontal and vertical limits of the binning
+ region in x or y units respectively; must be numeric vector of
+ length 2.}
+ \item{shape}{the \emph{shape} = yheight/xwidth of the plotting regions.}
+
+}
+\details{
+ Takes a grid defined by either the hexbin parameters or dimen in a
+ hexbin object and translates the cell ids for the grid into 2d integer
+ coordinates.
+}
+\value{
+ An integer matrix with two columns, i and j representing the integer
+ xy coordinates of the hexagon grid.
+ \item{i}{Integer coordiante of the rows, increases from bottom to top}
+ \item{j}{Integer coordiante of the columns, increases from left to right}
+}
+
+\author{Nicholas Lewin-Koh }
+
+
+\seealso{\code{\link{hcell2xy}}}
+\examples{
+ x<-rnorm(10000)
+ y<-rnorm(10000)
+ hbin<-hexbin(x,y)
+ ijInt<-hcell2xyInt(hbin)
+}
+
+\keyword{dplot}
+\keyword{misc}
diff --git a/man/hdiffplot.Rd b/man/hdiffplot.Rd
new file mode 100644
index 0000000..3461019
--- /dev/null
+++ b/man/hdiffplot.Rd
@@ -0,0 +1,134 @@
+\name{hdiffplot}
+\alias{hdiffplot}
+\title{Plot of Domain and Median Differences of Two "hexbin" Objects}
+\description{
+ Let \code{bin1} and \code{bin2} represent two \code{\link{hexbin}}
+ objects with scaling, plot shapes, and bin sizes. This plot
+ distinguishes cells unique to \code{bin1}, cells in common, and cells
+ unique to \code{bin2} using color. When the erode components are
+ present, color also distinguishes the two erosion medians. An arrow
+ shows the vector from the median of \code{bin1} to the median of
+ \code{bin2}.
+}
+\usage{
+hdiffplot(bin1, bin2 = NULL, xbnds, ybnds,
+ focus = NULL,% if(is.null(bin2)) 1:length(bin1) else c(1, 2),
+ col.control = list(medhex = "white", med.bord = "black",
+ focus = NULL, focus.border = NULL, back.col = "grey"),
+ arrows = TRUE, size = unit(0.1, "inches"), lwd = 2,
+ eps = 1e-6, unzoom = 1.08, clip="off", xlab = "", ylab = "",
+ main = deparse(mycall), \dots)
+}
+
+\arguments{
+ \item{bin1, bin2}{two objects of class \code{\link{hexbin}}.}
+ \item{xbnds,ybnds}{global x- and y-axis plotting limits. Used
+ primarily for multiple comparison plots.}
+%%%------- FIXME --------
+ \item{focus}{a vector of integers specifying which hexbin objects
+ should be treated as focal. Excluded hexbins are treated as background.}
+ \item{col.control}{a list for detailed color control.}%% <<< FIXME
+ \item{arrows}{a logical indicating wheter or not to draw arrows
+ between the focal hexbin objects median cells.}
+%not yet \item{density}{fill arguments to polygon}
+%not yet \item{pen}{pen numbers for polgyon}
+ \item{border}{border arguments to polygon}
+ \item{size}{arrow type size in inches.}
+ \item{eps}{distance criteria for distinct medians}
+ \item{unzoom}{plot limit expansion factor when xbnds is missing}
+ \item{clip}{either 'on' or 'off' are the allowed arguments, when on
+ everything is clipped to the plotting region.}
+ \item{lwd}{Line width for arrows, ignored when \code{arrows=FALSE} or
+ when bins have no erosion component}
+ \item{xlab}{label for x-axis}
+ \item{ylab}{label for y-axis}
+ \item{main}{main title for the plot; automatically constructed by default.}
+ \item{\dots}{...............}
+}
+
+% \value{
+% ((currently unspecified --- proposals are welcome))%% FIXME
+% }
+
+\details{
+ The hexbin objects for comparison, \code{bin1} and \code{bin2}, must
+ have the same plotting limits and cell size. The plot produces a
+ comparison overlay of the cells in the two objects. If external
+ global scaling is not supplied, the algorithm determines plotting
+ limits to increase resolution. For example, the objects may be the
+ result of the \code{\link{erode.hexbin}()} and include only high count cells
+ containing 50 of the counts. The density, border, and pen arguments
+ correspond to the polygon function calls for plotting six types of
+ cells. The cell types are respectively:
+ \tabular{l}{
+ unique cells of bin1,\cr
+ joint cells,\cr
+ unique cells of bin2,\cr
+ median cell of bin1,\cr
+ median cell of bin2,\cr
+ median cell if identical.\cr
+ }
+
+ The \code{erode} components of the hexbin objects must be present for the
+ medians to plot. The algorithm select a single cell for the median if
+ there are algorithmic ties.
+
+%% FIXME: no 'pen' argument anymore .. (?)
+ The \code{pen} numbers for types of cells start at Pen 2. Pen 1 is
+ presumed black. The suggested six additional colors are light blue,
+ light gray, light red, blue, red, and black. Carr (1991) shows an
+ example for black and white printing. That plot changes the six
+ colors to light gray, dark gray, white, black, black, and black. It
+ changes the 4th, 5th, and 6th argument of border to TRUE. It also
+ changes 4th, 5th and 6th argument of density to 0. In other words
+ cells in common do not show and medians cells appear as outlines.
+
+ When \code{xbnds} is missing, the plot changes graphics parameters and
+ resets them. The function also zooms in based on the available data
+ to provide increased resolution.
+}
+
+\references{ see in \code{\link{grid.hexagons}}.}%>> ./hexagons.Rd
+
+\seealso{
+ \code{\link{hexbin}}, \code{\link{smooth.hexbin}}, \code{\link{erode.hexbin}},
+ % MISSING: hthin,
+ \code{\link{hcell2xy}}, % \code{\link{hcell}},
+ \code{\link{gplot.hexbin}},
+ \code{\link{hboxplot}}, % \code{\link{hmatplot}},
+ \code{\link{grid.hexagons}}, \code{\link{grid.hexlegend}}.
+}
+\examples{
+## Comparison of two bivariate boxplots
+x1 <- rnorm(10000)
+y1 <- rnorm(10000)
+x2 <- rnorm(10000,mean=.5)
+y2 <- rnorm(10000,mean=.5)
+xbnds <- range(x1,x2)
+ybnds <- range(y1,y2)
+
+bin1 <- hexbin(x1,y1,xbnds=xbnds,ybnds=ybnds)
+bin2 <- hexbin(x2,y2,xbnds=xbnds,ybnds=ybnds)
+erodebin1 <- erode.hexbin(smooth.hexbin(bin1))
+erodebin2 <- erode.hexbin(smooth.hexbin(bin2))
+
+hdiffplot(erodebin1,erodebin2)
+
+## Compare *three* of them: --------------------
+
+x3 <- rnorm(10000,mean=-1)
+y3 <- rnorm(10000,mean=-.5)
+xbnds <- range(x1,x2,x3)
+ybnds <- range(y1,y2,y3)
+
+bin1 <- hexbin(x1,y1,xbnds=xbnds,ybnds=ybnds)
+bin2 <- hexbin(x2,y2,xbnds=xbnds,ybnds=ybnds)
+bin3 <- hexbin(x3,y3,xbnds=xbnds,ybnds=ybnds)
+erodebin1 <- erode.hexbin(smooth.hexbin(bin1))
+erodebin2 <- erode.hexbin(smooth.hexbin(bin2))
+erodebin3 <- erode.hexbin(smooth.hexbin(bin3))
+
+bnlst <- list(b1=erodebin1, b2=erodebin2, b3=erodebin3)
+hdiffplot(bnlst)
+}
+\keyword{hplot}
diff --git a/man/hexGraphPaper.Rd b/man/hexGraphPaper.Rd
new file mode 100644
index 0000000..3da2c0c
--- /dev/null
+++ b/man/hexGraphPaper.Rd
@@ -0,0 +1,66 @@
+\name{hexGraphPaper}
+\alias{hexGraphPaper}
+\alias{hgridcent}
+\title{Create a Hexgon Grid}
+\description{
+ Creates a hexagon grid that can be added to a plot created with grid
+ graphics.
+}
+\usage{
+hexGraphPaper(hb, xbnds = NULL, ybnds = NULL, xbins = 30, shape = 1,
+ add = TRUE, fill.edges = 1, fill = 0, border = 1)
+
+hgridcent(xbins, xbnds, ybnds, shape, edge.add = 0)
+}
+\arguments{
+ \item{hb}{a object of class \code{"hexbin"}, typically produced by
+ \code{\link{hexbin}(*)}.}
+ \item{xbnds, ybnds}{horizontal and vertical limits of the binning
+ region in x or y units respectively; must be numeric vector of
+ length 2.}
+ \item{xbins}{the number of bins partitioning the range of xbnds.}
+ \item{shape}{the \emph{shape} = yheight/xwidth of the plotting regions.}
+ \item{add}{a logical value indicating whether or not to add the grid
+ to the current plot.}
+ \item{fill.edges}{integer number of hexagons to add around the border}
+ \item{fill}{the fill color for the hexagons}
+ \item{border}{the color of the border of the hexagons}
+ \item{edge.add}{offset (typically \code{fill.edges} above) used in
+ \code{hgridcent}.}
+}
+\details{
+ If a hexbin object is given then the parameters xbins and shape are
+ ignored. Different bounds can still be specified. The \code{fill.edges}
+ parameter should be an integer. \code{fill.edges} takes the current
+ grid and adds a layer of hexagons around the grid for each level of
+ fill. So for example if \code{fill.edges= 2} than the dimensions of
+ the grid would be \code{(i,j)+4}.
+
+ \code{hgridcent()} is the utility function computing the resulting
+ list (see section \dQuote{Value}).
+
+ \strong{WARNING! If using a hexVP be sure to set clip to "on", otherwise the
+ hexagon grid will bleed over the plot edges.}
+}
+\value{
+ Invisibly returns a list with th following components
+ \item{x}{The x coordinates of the grid}
+ \item{y}{the y coordinates of the grid}
+ \item{dimen}{a vector of length 2 gining the rows and columns of the grid}
+ \item{dx}{the horizontal diameter of the hexagons}
+ \item{dy}{the vertical diameter of the hexagons}
+}
+\author{Nicholas Lewin-Koh}
+\seealso{\code{\link{hcell2xy}}, \code{\link{hexpolygon}},
+ \code{\link{grid.hexagons}}}
+\examples{
+ x <- rnorm(10000)
+ y <- rnorm(10000,x,x)
+ hbin <- hexbin(x,y)
+ hvp <- plot(hbin,type="n")
+ pushHexport(hvp$plot,clip="on")
+ hexGraphPaper(hbin,border=grey(.8))
+ grid.hexagons(hbin)
+}
+\keyword{aplot}
+\keyword{dplot}
diff --git a/man/hexList.Rd b/man/hexList.Rd
new file mode 100644
index 0000000..7add00f
--- /dev/null
+++ b/man/hexList.Rd
@@ -0,0 +1,46 @@
+\name{hexList}
+\alias{hexList}
+\alias{hexbinList-class}
+\alias{coerce,list,hexbinList-method}
+\title{Conditional Bivariate Binning into Hexagon Cells }
+\description{
+ Creates a list of \code{\link{hexbin}} objects. Basic components are
+ a cell id and a count of points falling in each occupied cell.
+ Basic methods are \code{\link[methods]{show}()}, \code{plot()} %(\link{plot.hexbin})
+ and \code{\link{summary}()}, but also \code{\link{erode}}.
+ % .. \code{\link{smooth.hexbin}}
+}
+\usage{
+hexList(x, y = NULL, given = NULL, xbins = 30, shape = 1,
+ xbnds = NULL, ybnds = NULL, xlab = NULL, ylab = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{ x coordinate to be binned }
+ \item{y}{ y coordinate to be binned }
+ \item{given}{ ..}
+ \item{xbins}{ number of bins partitioning the range of xbnds}
+ \item{shape}{ the \emph{shape} = yheight/xwidth of the plotting regions }
+ \item{xbnds}{ horizontal limits of binning }
+ \item{ybnds}{ vertical limits of binning }
+ \item{xlab}{ character strings used as labels for \code{x} }
+ \item{ylab}{ character strings used as labels for \code{y}}
+}
+\details{
+ There is also a \code{\link[methods:as]{coerce}} method to produce
+ \code{hexbinList} objects from \code{\link{list}}s.
+ %% i.e., \code{as(list(....), "hexbinList")} should work
+}
+\value{
+
+ If it is a LIST, use
+ \item{comp1 }{Description of 'comp1'}
+ \item{comp2 }{Description of 'comp2'}
+ ...
+}
+
+\author{Nicholas Lewin-Koh}
+
+\seealso{\code{\link{hexbin}}, \code{\link{hdiffplot}} }
+\keyword{dplot}
+\keyword{misc}
diff --git a/man/hexMA.loess.Rd b/man/hexMA.loess.Rd
new file mode 100644
index 0000000..4f25d19
--- /dev/null
+++ b/man/hexMA.loess.Rd
@@ -0,0 +1,42 @@
+\name{hexMA.loess}
+\alias{hexVP.loess}
+\alias{hexMA.loess}
+\title{Add Loess Fit to Hexplot }
+\description{
+ Fit a loess line using the hexagon centers of mass as the x and y
+ coordinates and the cell counts as weights.
+}
+\usage{
+hexMA.loess(pMA, span = 0.4, col = "red", n = 200)
+hexVP.loess(hbin, hvp = NULL, span = 0.4, col = "red", n = 200)
+}
+
+\arguments{
+ \item{hbin}{an object of class \code{hexbin}, see \code{\link{hexbin}}.}
+ \item{hvp}{A \code{hexViewport} object.}
+ \item{pMA}{the list returned by \code{\link{plotMAhex}}.}
+ \item{span}{the parameter alpha which controls the degree of smoothing.}
+ \item{col}{line color for the loess fit.}
+ \item{n}{number of points at which the fit should be evaluated.}
+}
+\value{
+ Returns invisibly the object associated with the loess fit.
+}
+
+\author{Nicholas Lewin-Koh }
+
+\seealso{ \code{\link{hexVP.abline}}, \code{\link{plotMAhex}},
+ \code{\link{gplot.hexbin}}, \code{\link{hexViewport}};
+ \code{\link{loess}}
+}
+\examples{
+ if(require(marray)){
+ data(swirl)
+ %% the following had 'newpage = FALSE, ' -- why ??
+ hb <- plotMAhex(swirl[,1], main = "M vs A plot with hexagons", legend=0)
+ hexVP.abline(hb$plot, h=0, col= gray(.6))
+ hexMA.loess(hb)
+ }
+}
+\keyword{aplot}
+
diff --git a/man/hexTapply.Rd b/man/hexTapply.Rd
new file mode 100644
index 0000000..159b624
--- /dev/null
+++ b/man/hexTapply.Rd
@@ -0,0 +1,58 @@
+\name{hexTapply}
+\alias{hexTapply}
+
+\title{Apply function to data from each hexagon bin.}
+
+\description{
+ A wrapper for tapply except that it operates with each hexagon bin
+ being the category. The function operates on the data associated on
+ the points from each bin.
+}
+
+\usage{
+hexTapply(hbin, dat, FUN = sum, ..., simplify=TRUE)
+}
+\arguments{
+ \item{hbin}{a object of class \code{"hexbin"}, typically produced by
+ \code{\link{hexbin}(*)}.}
+ \item{dat}{A vector of data the same length as \code{hbin at cID}}
+ \item{FUN}{the function to be applied. In the case of functions like
+ \code{+}, \code{\%*\%}, etc., the function name must be quoted. If
+ \code{FUN} is \code{NULL}, tapply returns a vector which can be used
+ to subscript the multi-way array \code{tapply} normally produces.}
+ \item{\dots}{optional arguments to \code{FUN}.}
+ \item{simplify}{If \code{FALSE}, \code{tapply} always returns an array
+ of mode \code{"list"}. If \code{TRUE} (the default), then if
+ \code{FUN} always returns a scalar, \code{tapply} returns an array
+ with the mode of the scalar.}
+}
+\details{
+ This function is a wrapper for tapply, except that the cell id is
+ always the categorical variable. This function is specifically good for
+ adding variables to the cAtt slot of a hexbin object or for plotting
+ a third variable in a hexagon plot. See below for examples.
+}
+
+\value{
+ Returns a vector of the result of 'FUN' as in
+ \code{\link{tapply}}. See \code{\link{tapply}} for detailed
+ description of output.
+}
+
+\author{Nicholas Lewin-Koh}
+\seealso{ \code{\link{tapply}},\code{\link{hexbin}} }
+\examples{
+ data(NHANES)
+ hbin<-hexbin(log(NHANES$Diet.Iron+1),log(NHANES$BMI),xbins=25,IDs=TRUE)
+ hvp<-plot(hbin)
+ mtrans<-hexTapply(hbin,NHANES$Transferin,median,na.rm=TRUE)
+ pushHexport(hvp$plot.vp)
+ grid.hexagons(hbin,style='lattice',pen=0,border='red',use.count=FALSE,
+cell.at=mtrans)
+
+
+
+}
+\keyword{dplot}
+\keyword{utilities}% at least one, from doc/KEYWORDS
+
diff --git a/man/hexVP-class.Rd b/man/hexVP-class.Rd
new file mode 100644
index 0000000..306c6d5
--- /dev/null
+++ b/man/hexVP-class.Rd
@@ -0,0 +1,76 @@
+\name{hexVP-class}
+\docType{class}
+\alias{hexVP-class}
+\alias{getFig,hexVP-method}
+\alias{getMargins,hexVP-method}
+\alias{getPlt,hexVP-method}
+\alias{getXscale,hexVP-method}
+\alias{getYscale,hexVP-method}
+
+\title{Formal class "hexVP" of a Hexagon Viewport}
+\description{
+ Hexagon Viewports are \dQuote{value-added} grid viewports (see
+ \code{\link[grid]{viewport}}) where the extra slots contain scaling and
+ \dQuote{embedding} information. A hexViewport is created my taking the
+ available area in the cuurent viewport on the graphics device and
+ maximizing the amount of area with a fied aspect ratio. The default
+ when the shape parameter is 1, is a 1:1 aspect ratio in terms of the
+ size of the viewport, not the scale of the x and y axis. The plotting
+ area is centered within the existing margins and the maximum size
+ determined. Extra area is then allocated to the margins. This viewport
+ is replicated twice, once with clipping set to "on" and once with
+ clipping "off". This feature can be used for toggling clipping on and
+ off while editing the plot.
+}
+\section{Objects from the Class}{
+ Objects are typically created by calls to \code{\link{hexViewport}()}
+ or by low level calls of the form \code{new("hexVP", ...)}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{hexVp.off}:}{Object of class \code{"viewport"} with
+ clipping set to off, see \code{\link[grid]{viewport}}.}
+ \item{\code{hexVp.on}:}{Object of class \code{"viewport"}, with the same
+ dimensions and parameters as hexVp.off, but with
+ clipping set to on, see \code{\link[grid]{viewport}}.}
+ \item{\code{hp.name}:}{The name of the viewport for searching a vptree}.
+ \item{\code{mar}:}{\code{\link[grid]{unit}} vector of four margins
+ (typically in \code{"lines"}).}
+ \item{\code{fig}:}{\code{\link[grid]{unit}} vector of two figure sizes
+ (typically in \code{"npc"}).}
+ \item{\code{plt}:}{\code{\link[grid]{unit}} vector of two figure sizes
+ (typically in \code{"npc"}).}
+ %% MM {FIXME?}: Is n't this simply ``xlim'' - then call it so!
+ %% NL, yes it is, but xscale and yscale is the parameters used by
+ %% grid.
+ \item{\code{shape}:}{The shape parameter from the plotted
+ \code{\link[hexbin]{hexbin}} object.}
+ \item{\code{xscale}:}{numeric of length two specifying x-range.}
+ \item{\code{yscale}:}{numeric of length two specifying y-range.}
+ }
+}
+\section{Methods}{
+ These are methods accessing the slots of corresponding name.
+ \describe{
+ \item{getFig}{\code{signature(hvp = "hexVP")}: ... }
+ \item{getMargins}{\code{signature(hvp = "hexVP")}: ... }
+ \item{getPlt}{\code{signature(hvp = "hexVP")}: ... }
+ \item{getXscale}{\code{signature(hvp = "hexVP")}: ... }
+ \item{getYscale}{\code{signature(hvp = "hexVP")}: ... }
+ }
+}
+\author{
+ Nicholas Lewin-Koh \email{kohnicho at comp.nus.edu.sg}.
+}
+\seealso{
+ The constructor function \code{\link{hexViewport}}.
+ \code{\link{hexbin}}, and its S4 plotting method,
+ \code{\link{gplot.hexbin}}.
+}
+\examples{
+ library("grid")
+ example(hexViewport, echo=FALSE)
+ ## continued:
+ str(P$plot.vp)
+}
+\keyword{classes}
diff --git a/man/hexVP.abline.Rd b/man/hexVP.abline.Rd
new file mode 100644
index 0000000..3d9abf2
--- /dev/null
+++ b/man/hexVP.abline.Rd
@@ -0,0 +1,44 @@
+\name{hexVP.abline}
+\alias{hexVP.abline}
+\title{Add a Straight Line to a HexPlot}
+\description{
+ This function adds one or more straight lines through the current
+ plot; it is the hexbin version of \code{\link[graphics]{abline}()}.
+}
+\usage{
+hexVP.abline(hvp, a = NULL, b = NULL, h = numeric(0), v = numeric(0),
+ col = "black", lty = 1, lwd = 2, \dots)
+}
+\arguments{
+ \item{hvp}{A hexViewport object that is currently on the active device}
+ \item{a,b}{the intercept and slope or if \code{b} is \code{NULL},
+ an \code{lm} object or a vector of length 2 with
+ \code{c(intercept,slope)}}
+ \item{h}{the y-value for a horizontal line.}
+ \item{v}{the x-value for a vertical line.}
+ \item{col, lty, lwd}{line color, type and width.}
+ \item{\dots}{further graphical parameters.}
+}
+\details{
+ The first form specifies the line in intercept/slope form
+ (alternatively \code{a} can be specified on its own and is taken to
+ contain the slope and intercept in vector form).
+
+ The \code{h=} and \code{v=} forms draw horizontal and vertical
+ lines at the specified coordinates.
+
+ The \code{coef} form specifies the line by a vector containing the
+ slope and intercept.
+
+ \code{lm} is a regression object which contains \code{reg$coef}. If it is
+ of length 1 then the value is taken to be the slope of a line
+ through the origin, otherwise, the first 2 values are taken to be
+ the intercept and slope.
+}
+\author{Nicholas Lewin-Koh}
+
+\seealso{\code{\link{gplot.hexbin}}, \code{\link{hexViewport}},
+ \code{\link{hexMA.loess}}
+}
+\keyword{aplot}
+
diff --git a/man/hexViewport.Rd b/man/hexViewport.Rd
new file mode 100644
index 0000000..ccb5b8d
--- /dev/null
+++ b/man/hexViewport.Rd
@@ -0,0 +1,55 @@
+\name{hexViewport}
+\alias{hexViewport}
+\title{Compute a Grid Viewport for Hexagon / Hexbin Graphics}
+\description{
+ Builds a \code{grid} viewport for hexagon or \code{\link{hexbin}}
+ graphics. This builds on the concepts of the \pkg{grid} package,
+ see \code{\link[grid]{viewport}}.
+}
+\usage{% see ../R/hexViewport.R
+hexViewport(x, offset = unit(0,"inches"), mar = NULL,
+ xbnds = NULL, ybnds = NULL, newpage = FALSE,
+ clip = "off", vp.name = NULL)
+}
+\arguments{
+ \item{x}{a \code{\link{hexbin}} object.}
+ \item{offset}{a \code{\link[grid]{unit}} object.}
+ \item{mar}{margins as \code{\link[grid]{unit}}s, of length 4 or 1.}
+ \item{xbnds, ybnds}{bounds for x- and y- plotting range; these default
+ to the corresponding slots of \code{x}.}
+ \item{newpage}{logical indicating if a new graphics page should be
+ openend, i.e., \code{\link[grid]{grid.newpage}()}.}
+ \item{clip}{simply passed to \code{\link[grid]{viewport}()}.}
+ \item{vp.name}{name of viewport; defaults to random name.}
+}
+\value{
+ an S4 object of class \code{"hexVP"}, see \link{hexVP-class} for more,
+ with its main slot \code{hexVp} a \code{\link[grid]{viewport}} for
+ grid graphics.
+}
+
+\seealso{\code{\link[grid]{viewport}} and the main
+ \emph{\dQuote{handlers}} \code{\link{pushHexport}} and
+ \code{\link[grid:viewports]{popViewport}}; further
+ \code{\link{gplot.hexbin}} and \code{\link{hboxplot}} which build on
+ \code{hexViewport}.
+}
+\examples{
+set.seed(131)
+x <- rnorm(7777)
+y <- rt (7777, df=3)
+
+## lower resolution binning and overplotting with counts
+bin <- hexbin(x,y,xbins=25)
+P <- plot(bin)
+xy <- hcell2xy(bin)
+pushHexport(P$plot.vp)
+i <- bin at count <= 3
+library("grid")
+grid.text(as.character(bin at count[i]), xy$x[i], xy$y[i],
+ default.units = "native")
+grid.points(x[1:20],y[1:20]) # to show some points rather than counts
+popViewport()
+}
+\keyword{hplot}% ?
+\keyword{aplot}
diff --git a/man/hexbin.Rd b/man/hexbin.Rd
new file mode 100644
index 0000000..293abe6
--- /dev/null
+++ b/man/hexbin.Rd
@@ -0,0 +1,110 @@
+\name{hexbin}
+\title{Bivariate Binning into Hexagon Cells}
+\alias{hexbin}
+\alias{hexbin-class}
+\alias{integer or NULL-class}
+\alias{show,hexbin-method}
+\alias{summary,hexbin-method}
+\description{
+ Creates a \code{"hexbin"} object. Basic components are a cell id and
+ a count of points falling in each occupied cell.
+
+ Basic methods are \code{\link[methods]{show}()}, \code{plot()} %(\link{plot.hexbin})
+ and \code{\link{summary}()}, but also \code{\link{erode}}.
+ % .. \code{\link{smooth.hexbin}}
+}
+\usage{
+hexbin(x, y, xbins = 30, shape = 1,
+ xbnds = range(x), ybnds = range(y),
+ xlab = NULL, ylab = NULL, IDs = FALSE)
+}
+\arguments{
+ \item{x, y}{vectors giving the coordinates of the bivariate data
+ points to be binned. Alternatively a single plotting structure can
+ be specified: see \code{\link[grDevices]{xy.coords}}. \code{\link{NA}}'s are
+ allowed and silently omitted.}
+ \item{xbins}{the number of bins partitioning the range of xbnds.}
+ \item{shape}{the \emph{shape} = yheight/xwidth of the plotting regions.}
+ \item{xbnds, ybnds}{horizontal and vertical limits of the binning
+ region in x or y units respectively; must be numeric vector of length 2.}
+ \item{xlab, ylab}{optional character strings used as labels for
+ \code{x} and \code{y}. If \code{NULL}, sensible defaults are used.}
+ \item{IDs}{logical indicating if the individual cell \dQuote{IDs}
+ should be returned, see also below.}
+}
+\value{
+ an S4 object of class \code{"hexbin"}.
+ It has the following slots:
+ \item{cell}{vector of cell ids that can be mapped into the (x,y)
+ bin centers in data units.}
+ \item{count}{vector of counts in the cells.}
+ \item{xcm}{The x center of mass (average of x values) for the cell.}
+ \item{ycm}{The y center of mass (average of y values) for the cell.}
+ \item{xbins}{ number of hexagons across the x axis. hexagon inner
+ diameter =diff(xbnds)/xbins in x units}
+ \item{shape}{plot shape which is yheight(inches) / xwidth(inches)}
+ \item{xbnds}{x coordinate bounds for binning and plotting}
+ \item{ybnds}{y coordinate bounds for binning and plotting}
+ \item{dimen}{The i and j limits of cnt treated as a matrix cnt[i,j]}
+ \item{n}{number of (non NA) (x,y) points, i.e., \code{sum(* @count)}.}
+ \item{ncells}{number of cells, i.e., \code{length(* @count)}, etc}
+ \item{call}{the function call.}
+ \item{xlab, ylab}{character strings to be used as axis labels.}
+ \item{cID}{of class, \code{"integer or NULL"}, only if \code{IDs}
+ was true, an integer vector of length \code{n} where
+ \code{cID[i]} is the cell number of the i-th original point
+ \code{(x[i], y[i])}. Consequently, the \code{cell} and \code{count}
+ slots are the same as the \code{\link{names}} and entries of
+ \code{table(cID)}, see the example.}
+}
+
+\seealso{
+ \code{\link{hcell2xy}}%, \code{\link{hcell}},
+% FIXME
+ \code{\link{gplot.hexbin}},% \code{\link{hboxplot}},
+% \code{\link{hdiffplot}}, \code{\link{hmatplot}},
+ \code{\link{grid.hexagons}}, \code{\link{grid.hexlegend}}.
+}
+
+\references{
+ Carr, D. B. et al. (1987)
+ Scatterplot Matrix Techniques for Large \eqn{N}.
+ \emph{JASA} \bold{83}, 398, 424--436.
+}
+
+\details{
+ Returns counts for non-empty cells only. The plot shape must be maintained for
+ hexagons to appear with equal sides. Some calculations are in single
+ precision.
+
+ Note that when plotting a \code{hexbin} object, the
+ \pkg{grid} package is used.
+ You must use its graphics (or those from package \pkg{lattice} if you
+ know how) to add to such plots.
+}
+
+\examples{
+set.seed(101)
+x <- rnorm(10000)
+y <- rnorm(10000)
+(bin <- hexbin(x, y))
+## or
+plot(hexbin(x, y + x*(x+1)/4),
+ main = "(X, X(X+1)/4 + Y) where X,Y ~ rnorm(10000)")
+
+## Using plot method for hexbin objects:
+plot(bin, style = "nested.lattice")
+
+hbi <- hexbin(y ~ x, xbins = 80, IDs= TRUE)
+str(hbi)
+tI <- table(hbi at cID)
+stopifnot(names(tI) == hbi at cell,
+ tI == hbi at count)
+
+## NA's now work too:
+x[runif(6, 0, length(x))] <- NA
+y[runif(7, 0, length(y))] <- NA
+hbN <- hexbin(x,y)
+summary(hbN)
+}
+\keyword{dplot}
diff --git a/man/hexbinplot.Rd b/man/hexbinplot.Rd
new file mode 100644
index 0000000..0233a76
--- /dev/null
+++ b/man/hexbinplot.Rd
@@ -0,0 +1,222 @@
+\name{hexbinplot}
+\alias{hexbinplot}
+\alias{hexbinplot.formula}
+\alias{panel.hexbinplot}
+\alias{prepanel.hexbinplot}
+\alias{hexlegendGrob}
+\title{Trellis Hexbin Displays}
+\description{
+
+ Display of hexagonally binned data, as implemented in the
+ \code{hexbin} packge, under the Trellis framework, with associated
+ utilities. \code{hexbinplot} is the high level generic function, with
+ the \code{"formula"} method doing the actual work.
+ \code{prepanel.hexbinplot} and \code{panel.hexbinplot} are associated
+ prepanel and panel functions. \code{hexlegendGrob} produces a
+ suitable legend.
+
+}
+\usage{
+
+hexbinplot(x, data, \dots)
+
+\method{hexbinplot}{formula}(x, data = NULL,
+ prepanel = prepanel.hexbinplot,
+ panel = panel.hexbinplot,
+ groups = NULL,
+ aspect = "xy",
+ trans = NULL,
+ inv = NULL,
+ colorkey = TRUE,
+ \dots,
+ maxcnt,
+ legend = NULL,
+ legend.width = TRUE,
+ subset)
+
+prepanel.hexbinplot(x, y, type = character(0), \dots)
+
+panel.hexbinplot(x, y, ..., groups = NULL)
+
+hexlegendGrob(legend = 1.2,
+ inner = legend / 5,
+ cex.labels = 1,
+ cex.title = 1.2,
+ style = "colorscale",
+ minarea = 0.05, maxarea = 0.8,
+ mincnt = 1, maxcnt,
+ trans = NULL, inv = NULL,
+ colorcut = seq(0, 1, length = 17),
+ density = NULL, border = NULL, pen = NULL,
+ colramp = function(n) { LinGray(n,beg = 90,end = 15) },
+ \dots,
+ vp = NULL,
+ draw = FALSE)
+
+
+}
+\arguments{
+ \item{x}{ For \code{hexbinplot}, the object on which method dispatch
+ is carried out.
+
+ For the \code{"formula"} methods, a formula describing the form of
+ conditioning plot. Formulas that are valid for \code{xyplot} are
+ acceptable.
+
+ In \code{panel.hexbinplot}, the x variable.
+ }
+ \item{y}{ In \code{panel.hexbinplot}, the y variable. }
+
+ \item{data}{For the \code{formula} method, a data frame containing
+ values for any variables in the formula, as well as \code{groups}
+ and \code{subset} if applicable (using \code{groups} currently
+ causes an error with the default panel function). By default, the
+ environment where the function was called from is used. }
+
+ \item{minarea, maxarea, mincnt, maxcnt, trans, inv, colorcut, density,
+ border, pen, colramp, style}{ see
+ \code{\link[hexbin:gplot.hexbin]{gplot.hexbin}} }
+
+ \item{prepanel, panel, aspect}{ See
+ \code{\link[lattice]{xyplot}}. \code{aspect="fill"} is not
+ allowed. The current default of \code{"xy"} may not always be the
+ best choice, often \code{aspect=1} will be more reasonable. }
+
+ \item{colorkey}{logical, whether a legend should be drawn. Currently
+ a legend can be drawn only on the right. }
+
+ \item{legend.width, legend}{ width of the legend in inches when
+ \code{style} is \code{"nested.lattice"} or
+ \code{"nested.centroids"}. The name \code{legend.width} is used to
+ avoid conflict with the standard trellis argument \code{legend}. It
+ is possible to specify additional legends using the \code{legend} or
+ \code{key} arguments as long as they do not conflict with the
+ hexbin legend (i.e., are not on the right). }
+
+ \item{inner}{ Inner radius in inches of hexagons in the legend when
+ \code{style} is \code{"nested.lattice"} or
+ \code{"nested.centroids"}. }
+
+ \item{cex.labels, cex.title}{ in the legend, multiplier for numeric
+ labels and text annotation respectively }
+
+ \item{type}{ character vector controlling additional augmentation of
+ the display. A \code{"g"} in \code{type} adds a reference grid,
+ \code{"r"} adds a regression line (y on x), \code{"smooth"} adds a
+ loess smooth }
+ \item{draw}{ logical, whether to draw the legend grob. Useful when
+ \code{hexlegendGrob} is used separately }
+ \item{vp}{ grid viewport to draw the legend in }
+
+ \item{\dots}{ extra arguments, passed on as appropriate. Arguments to
+ \code{\link[hexbin:gplot.hexbin]{gplot.hexbin}},
+ \code{\link[lattice]{xyplot}}, \code{panel.hexbinplot} and
+ \code{hexlegendGrob} can be supplied to the high level
+ \code{hexbinplot} call.
+
+ \code{panel.hexbinplot} calls one of two (unexported) low-level
+ functions depending on whether \code{groups} is supplied (although
+ specifying \code{groups} currently leads to an error). Arguments of
+ the appropriate function can be supplied; some important ones are
+
+ \describe{
+
+ \item{\code{xbins}:}{ number of hexagons covering x values. The
+ number of y-bins depends on this, the aspect ratio, and
+ \code{xbnds} and \code{ybnds}}
+
+ \item{\code{xbnds, ybnds}:}{ Numeric vector specifying range of
+ values that should be covered by the binning. In a multi-panel
+ display, it is not necessarily a good idea to use the same
+ bounds (which along with \code{xbins} and the aspect ratio
+ determine the size of the hexagons) for all panels. For
+ example, when data is concentrated in small subregions of
+ different panels, more detail will be shown by using smaller
+ hexagons covering those regions. To control this, \code{xbnds}
+ and \code{ybnds} can also be character strings \code{"panel"} or
+ \code{"data"} (which are not very good names and may be changed
+ in future). In the first case, the bounds are taken to be the
+ limits of the panel, in the second case, the limits of the data
+ (packet) in that panel. Note that all panels will have the same
+ limits (enough to cover all the data) by default if
+ \code{relation="free"} in the standard trellis argument
+ \code{scales}, but not otherwise.}
+
+ }
+
+ }
+
+ \item{groups}{ in \code{hexbinplot}, a grouping variable that is
+ evaluated in \code{data}, and passed on to the panel function. }
+
+ \item{subset}{ an expression that is evaluated in evaluated in
+ \code{data} to produce a logical vector that is used to subset the
+ data before being used in the plot. }
+
+}
+\details{
+
+ The panel function \code{panel.hexbinplot} creates a hexbin object
+ from data supplied to it and plots it using
+ \code{\link[hexbin:grid.hexagons]{grid.hexagons}}. To make panels
+ comparable, all panels have the same \code{maxcnt} value, by default
+ the maximum count over all panels. This default value can be
+ calculated only if the aspect ratio is known, and so
+ \code{aspect="fill"} is not allowed. The default choice of aspect
+ ratio is different from the choice in \code{hexbin} (namely,
+ \code{1}), which may sometimes give better results for multi-panel
+ displays. \code{xbnds} and \code{ybnds} can be numeric range vectors
+ as in \code{hexbin}, but they can also be character strings specifying
+ whether all panels should have the same bins. If they are not, then
+ bins in different panels could be of different sizes, in which case
+ \code{style="lattice"} and \code{style="centroids"} should be
+ interpreted carefully.
+
+
+ The dimensions of the legend and the size of the hexagons therein are
+ given in absolute units (inches) by \code{legend.width} and
+ \code{inner} only when \code{style} is \code{"nested.lattice"} or
+ \code{"nested.centroids"}. For other styles, the dimensions of the
+ legend are determined relative to the plot. Specifically, the height
+ of the legend is the same as the height of the plot (the panel and
+ strip regions combined), and the width is the minimum required to fit
+ the legend in the display. This is different in some ways from the
+ \code{hexbin} implementation. In particular, the size of the hexagons
+ in the legend are completely unrelated to the sizes in the panels,
+ which is pretty much unavoidable because the sizes need not be the
+ same across panels if \code{xbnds} or \code{ybnds} is \code{"data"}.
+ The size of the hexagons encode information when \code{style} is
+ \code{"lattice"} or \code{"centroids"}, consequently a warning is
+ issued when a legend is drawn with wither of these styles.
+
+}
+
+\value{
+ \code{hexbinplot} produces an object of class \code{"trellis"}. The
+ \code{update} method can be used to update components of the object and
+ the \code{print} method (usually called by default) will plot it on an
+ appropriate plotting device. \code{hexlegendGrob} produces a
+ \code{"grob"} (grid object).
+
+}
+\author{ Deepayan Sarkar \email{deepayan at stat.wisc.edu}}
+\seealso{
+ \code{\link{hexbin}}, \code{\link[lattice]{xyplot}}
+}
+
+\examples{
+mixdata <-
+ data.frame(x = c(rnorm(5000),rnorm(5000,4,1.5)),
+ y = c(rnorm(5000),rnorm(5000,2,3)),
+ a = gl(2, 5000))
+hexbinplot(y ~ x, mixdata, aspect = 1,
+ trans = sqrt, inv = function(x) x^2)
+hexbinplot(y ~ x | a, mixdata)
+hexbinplot(y ~ x | a, mixdata, style = "lattice",
+ xbnds = "data", ybnds = "data")
+hexbinplot(y ~ x | a, mixdata, style = "nested.centroids")
+hexbinplot(y ~ x | a, mixdata, style = "nested.centroids",
+ border = FALSE, type = c("g", "smooth"))
+}
+
+\keyword{dplot}
diff --git a/man/hexplom.Rd b/man/hexplom.Rd
new file mode 100644
index 0000000..8365b1b
--- /dev/null
+++ b/man/hexplom.Rd
@@ -0,0 +1,96 @@
+\name{hexplom}
+\title{Hexbin Plot Matrices}
+\alias{hexplom}
+\alias{hexplom.formula}
+\alias{hexplom.data.frame}
+\alias{hexplom.matrix}
+\alias{panel.hexplom}
+
+\usage{
+hexplom(x, data, \dots)
+
+\method{hexplom}{formula}(x, data = NULL, \dots)
+
+\method{hexplom}{data.frame}(x, data = NULL, \dots, groups = NULL,
+ subset = TRUE)
+
+\method{hexplom}{matrix}(x, data = NULL, \dots, groups = NULL, subset = TRUE)
+
+panel.hexplom(\dots)
+}
+
+\description{
+ \code{hexplom} draws Conditional Hexbin Plot Matrices. It is similar
+ to \code{splom}, expect that the default display is different.
+ Specifically, the default display is created using
+ \code{panel.hexplom}, which is an alias for \code{panel.hexbinplot}.
+}
+
+\arguments{
+ \item{x}{
+ The object on which method dispatch is carried out.
+
+ For the \code{"formula"} method, a formula describing the structure
+ of the plot, which should be of the form \code{~ x | g1 * g2 *
+ \dots}, where \code{x} is a data frame or matrix. Each of \code{g1,
+ g2, \dots} must be either factors or shingles. The conditioning
+ variables \code{g1, g2, \dots} may be omitted.
+
+ For the \code{data.frame} and \code{matrix} methods, a data frame or
+ matrix as appropriate.
+ }
+ \item{data}{
+ For the \code{formula} method, an optional data frame in which
+ variables in the formula (as well as \code{groups} and
+ \code{subset}, if any) are to be evaluated. By default, the
+ environment where the function was called from is used.
+ }
+
+ \item{groups, subset, \dots}{ see \code{\link[lattice]{splom}}. The
+ non-standard evaluation of \code{groups} and \code{subset} only
+ applies in the \code{formula} method. Apart from arguments that
+ apply to \code{splom} (many of which are only documented in
+ \code{\link[lattice]{xyplot}}), additional arguments meant for
+ \code{panel.hexplom} (which is an alias for
+ \code{\link{panel.hexbinplot}}) may also be supplied. Such
+ arguments may include ones that control details of the hexbin
+ calculations, documented in \code{\link{gplot.hexbin}}}
+
+}
+\value{
+
+ An object of class \code{"trellis"}. The
+ \code{\link[lattice:update.trellis]{update}} method can be used to
+ update components of the object and the
+ \code{\link[lattice:print.trellis]{print}} method (usually called by
+ default) will plot it on an appropriate plotting device.
+
+}
+
+\seealso{
+ \code{\link[lattice]{splom}}, \code{\link[lattice]{xyplot}},
+ \code{\link[hexbin]{hexbinplot}},
+ \code{\link[lattice]{Lattice}}, \code{\link[lattice]{panel.pairs}}
+}
+
+\author{ Deepayan Sarkar \email{Deepayan.Sarkar at R-project.org},
+ Nicholas Lewin-Koh \email{nikko at hailmail.net}}
+
+\examples{
+
+## Simple hexplom
+data(NHANES)
+hexplom(~NHANES[,7:14], xbins=15)
+
+## With colors and conditioning
+hexplom(~NHANES[,9:13] | Sex, data = NHANES,
+ xbins = 15, colramp = magent)
+
+## With custom panel function
+hexplom(NHANES[,9:13], xbins = 20,colramp = BTY,
+ upper.panel = panel.hexboxplot)
+
+
+}
+\keyword{hplot}
+
diff --git a/man/hexpolygon.Rd b/man/hexpolygon.Rd
new file mode 100644
index 0000000..cfa38d0
--- /dev/null
+++ b/man/hexpolygon.Rd
@@ -0,0 +1,78 @@
+\name{hexpolygon}
+\alias{hexpolygon}
+\alias{hexcoords}
+\title{Hexagon Coordinates and Polygon Drawing}
+\description{
+ Simple \sQuote{low-level} function for computing and drawing hexagons.
+ Can be used for \sQuote{grid} (package \pkg{grid}) or
+ \sQuote{traditional} (package \pkg{graphics}) graphics.
+}
+\usage{
+hexcoords(dx, dy = NULL, n = 1, sep = NULL)
+
+hexpolygon(x, y, hexC = hexcoords(dx, dy, n = 1), dx, dy = NULL,
+ fill = 1, border = 0, hUnit = "native", ...)
+}
+\arguments{
+ \item{dx,dy}{horizontal and vertical width of the hexagon(s).}
+ \item{n}{number of hexagon \dQuote{repeats}.}
+ \item{sep}{separator value to be put between coordinates of different
+ hexagons. The default, \code{NULL} doesn't use a separator.}
+ \item{x,y}{numeric vectors of the same length specifying the hexagon
+ \emph{centers} around which to draw.}
+ \item{hexC}{a list as returned from \code{hexcoords()}.
+ Its component \code{no.sep} determines if grid or traditional
+ graphics are used. The default (via default of \code{hexcoords}) is
+ now to use grid graphics.}
+ \item{fill,border}{passed to \code{\link[grid]{grid.polygon}} (for \pkg{grid}).}
+ \item{hUnit}{string or \code{NULL} determining in which units (x,y)
+ values are.}
+ \item{\dots}{further arguments passed to \code{\link{polygon}} (for
+ \pkg{graphics}).}
+}
+\value{
+ \code{hexcoords()} returns a list with components
+ \item{x,y}{numeric vectors of length \eqn{n \times 6}{n * 6} (or
+ \eqn{n \times 7}{n * 7} if \code{sep} is not NULL)
+ specifying the hexagon polygon coordinates (with \code{sep} appended
+ to each 6-tuple).}
+ \item{no.sep}{a logical indicating if \code{sep} was \code{NULL}.}
+
+ \code{hexpolygon} returns what its last \code{\link[grid]{grid.polygon}(.)}
+ or \code{\link{polygon}(.)} call returns.
+}
+\author{Martin Maechler, originally.}
+\seealso{\code{\link{grid.hexagons}} which builds on these.}
+\examples{
+str(hexcoords(1, sep = NA)) # multiple of (6 + 1)
+str(hexcoords(1, sep = NULL))# no separator -> multiple of 6
+\dontshow{
+stopifnot(3 * (6+1) == sapply(hexcoords(2, n = 3, sep = NA)[1:2], length),
+ 6 == sapply(hexcoords(1)[1:2], length))
+set.seed(1001)
+}
+
+## hexpolygon()s:
+x <- runif(20, -2, 2)
+y <- x + rnorm(20)
+
+## 1) traditional 'graphics'
+plot(x,y, asp = 1, "plot() + hexpolygon()")
+hexpolygon(x,y, dx = 0.1, density = 25, col = 2, lwd = 1.5)
+
+## 2) "grid" :
+
+addBit <- function(bnds, f = 0.05) bnds + c(-f, f) * diff(bnds)
+sc <- addBit(rxy <- range(x,y))# same extents (cheating asp=1)
+library("grid")
+grid.newpage()
+pushViewport(plotViewport(.1+c(4,4,2,1), xscale = sc, yscale = sc))
+grid.rect()
+grid.xaxis()
+grid.yaxis()
+grid.points(x,y)
+hexpolygon(x,y, hexcoords(dx = 0.1, sep=NULL), border = "blue", fill=NA)
+popViewport()
+}
+\keyword{dplot}
+\keyword{aplot}
diff --git a/man/hsmooth-methods.Rd b/man/hsmooth-methods.Rd
new file mode 100644
index 0000000..ee8185a
--- /dev/null
+++ b/man/hsmooth-methods.Rd
@@ -0,0 +1,28 @@
+\name{hsmooth-methods}
+\docType{methods}% + generic -- still use this doctype ?
+\alias{hsmooth}% generic
+\alias{hsmooth-methods}
+\alias{hsmooth,hexbin-method}
+\title{Hexagon Bin Smoothing: Generic hsmooth() and Methods}
+\description{
+ Methods for the generic function \code{hsmooth} in package
+ \pkg{hexbin}:
+ There is currently only the one for \code{\link{hexbin}} objects.
+}
+\usage{
+\S4method{hsmooth}{hexbin}(bin, wts)
+}
+\arguments{
+ \item{bin}{a \code{\link{hexbin}} object, or an extension such as
+ \code{\link{erodebin-class}}.}
+ \item{wts}{weights vector, see \code{\link{smooth.hexbin}}}
+}
+\section{Methods}{
+ \describe{
+ \item{bin = "hexbin"}{is just the \code{\link{smooth.hexbin}}
+ function (for back compatibility); see its documentation, also for
+ examples.}
+ }
+}
+\keyword{methods}
+
diff --git a/man/inout.hex.Rd b/man/inout.hex.Rd
new file mode 100644
index 0000000..307e051
--- /dev/null
+++ b/man/inout.hex.Rd
@@ -0,0 +1,31 @@
+\name{inout.hex}
+\alias{inout.hex}
+\title{Check points for inclusion}
+\description{
+ Check which points are in hexagons with \code{count} <= mincnt.
+}
+\usage{
+inout.hex(hbin, mincnt)
+}
+
+\arguments{
+ \item{hbin}{an object of class \code{\link{hexbin}}.}
+ \item{mincnt}{Cutoff, id's for counts less than mincnt are returned}
+}
+\details{
+ Check which points are in hexagons with \code{count} <= mincnt and
+ returns the row ids for those points. One can use the ids to plot low
+ ount hexagons as points instead.
+}
+\value{
+ A vector with the row ids of points which fall in hexagons with
+ \code{count} less than or equal to mincnt
+}
+
+\author{Nicholas Lewin-Koh}
+
+
+\seealso{\code{\link{plotMAhex}}}
+
+\keyword{misc}
+
diff --git a/man/list2hexList.Rd b/man/list2hexList.Rd
new file mode 100644
index 0000000..ab40823
--- /dev/null
+++ b/man/list2hexList.Rd
@@ -0,0 +1,25 @@
+\name{list2hexList}
+\alias{list2hexList}
+\title{Convert list to hexList}
+\description{
+ Converts a list of hexbin objects with same xbnds, ybnds, shape and
+ xbins to a \code{\link{hexList}} object.
+}
+\usage{
+list2hexList(binlst)
+}
+\arguments{
+ \item{binlst}{A list of hexbin objects}
+}
+
+\value{
+ a \code{\link{hexList}} object
+}
+
+\author{Nicholas Lewin-Koh}
+
+
+\seealso{\code{\link{hexList}},\code{\link{hdiffplot}} }
+
+\keyword{misc}
+
diff --git a/man/old-classes.Rd b/man/old-classes.Rd
new file mode 100644
index 0000000..efec494
--- /dev/null
+++ b/man/old-classes.Rd
@@ -0,0 +1,24 @@
+\name{old-classes}
+\title{Class "unit" and "viewport" as S4 classes}
+%
+\docType{class}
+\alias{unit-class}
+\alias{viewport-class}
+%
+\description{Package "hexbin" now uses S4 classes throughout and hence
+ needs to \code{\link[methods]{setOldClass}} both \code{"unit"} and
+ \code{"viewport"} (which are S3 classes from the \pkg{grid} package),
+ in order to be able to use those in slots of its own classes.
+}
+\section{Objects from the Class}{A virtual Class: No objects may be
+ created from it.}
+\section{Extends}{
+ Class \code{"oldClass"}, directly.
+}
+\section{Methods}{
+ No methods defined with class "unit" in the signature.
+}
+% \seealso{
+% add link to grid ??
+% }
+\keyword{classes}
diff --git a/man/optShape.Rd b/man/optShape.Rd
new file mode 100644
index 0000000..6ed8c10
--- /dev/null
+++ b/man/optShape.Rd
@@ -0,0 +1,50 @@
+\name{optShape}
+\alias{optShape}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Optimal Shape Parameter for Hexbin Viewport}
+\description{
+ Takes a viewport or a given height and width and returns the shape
+ parameter that will fill the specified plotting region with the
+ appropriately shaped hexagons. If margins are specified the margins
+ are subtracted from height and width before the shape parameter is
+ specified.
+}
+\usage{
+optShape(vp, height = NULL, width = NULL, mar = NULL)
+}
+\arguments{
+ \item{vp}{a \code{viewport} object, optional see details}
+ \item{height}{the height of the plotting region, can be numeric or units}
+ \item{width}{The width of the plotting region, can be numeric or units}
+ \item{mar}{A four element numeric or units vector describing the
+ margins in the order \code{c(bottom, left, top, right)}}
+}
+\value{
+ a scalar numeric value specifiyng \code{shape}.
+}
+\author{Nicholas Lewin-Koh}
+\section{Warning}{If a viewport is given as an argument it should
+ already be pushed on the graphics device or it will have null units
+ and a meaningless shape parameter will be returned.
+}
+\seealso{\code{\link{hexViewport}}, \code{\link{hexVP-class}},
+ \code{\link{hexbin}}}
+\examples{
+x <- rgamma(10000,.9)
+m <- as.logical(rbinom(10000,1,.17))
+x[m] <- -x[m]
+y <- rnorm(x,abs(x))
+library("grid")
+vp <- plotViewport(xscale= range(x)+c(-.5,.5),
+ yscale= range(y)+c(-.5,.5),
+ default.units = "native")
+grid.newpage()
+pushViewport(vp)
+grid.rect()
+shape <- optShape(vp)
+shape
+hb <- hexbin(x,y,xbins=40,shape=shape)
+grid.hexagons(hb,colramp=BTY)
+}
+\keyword{dplot}
+
diff --git a/man/panel.hexboxplot.Rd b/man/panel.hexboxplot.Rd
new file mode 100644
index 0000000..305a8bb
--- /dev/null
+++ b/man/panel.hexboxplot.Rd
@@ -0,0 +1,49 @@
+\name{panel.hexboxplot}
+\alias{panel.hexboxplot}
+\title{Boxplot for hexbin lattice plot}
+\description{
+A panel function to add a boxplot to a hexbin lattice plot.
+}
+\usage{
+panel.hexboxplot(x, y, xbins = 30,
+ xbnds = c("data", "panel"), ybnds = c("data", "panel"),
+ .prelim = FALSE, .cpl = current.panel.limits(),
+ .xlim = .cpl$xlim, .ylim = .cpl$ylim,
+ .aspect.ratio, type = character(0), cdfcut = 0.25,
+ shadow = 0.05, ..., check.erosion = TRUE)
+}
+\arguments{
+ \item{x, y}{numeric vector or factor.}
+ \item{xbins}{the number of bins partitioning the range of xbnds.}
+ \item{xbnds, ybnds}{horizontal and vertical limits of the binning
+ region in x or y units respectively; must be numeric vector of
+ length 2.}
+ \item{.prelim, .cpl, .xlim, .ylim, .aspect.ratio}{for internal use.}
+ \item{type}{character vector controlling additional augmentation of
+ the display. A \code{"g"} in \code{type} adds a reference grid, an
+ \code{"hg"} adds a hexagonal grid.}
+ \item{cdfcut}{number in (0,1) indicating the confidence level for the
+ erosion limits. See \code{\link{erode.hexbin}} for more information.}
+ \item{shadow}{number in (0,1) indicating the confidence level for the
+ erosion limits of a boxplot shadow. See \code{\link{erode.hexbin}}
+ for more information.}
+ \item{\dots}{potential further arguments passed on.}
+ \item{check.erosion}{logical indicating only eroded points should be
+ used for \code{"erodebin"} objects; simply passed to
+ \code{\link{hcell2xy}}, see its documentation.}
+}
+\value{
+ There is no return value from this function. The results are plotted on
+ the current active device.
+}
+\author{Nicholas Lewin-Koh \email{nikko at hailmail.net}}
+\seealso{\code{\link{hexbinplot}}, \code{\link{panel.hexgrid}},
+ \code{\link[lattice]{panel.bwplot}}
+}
+\examples{
+mixdata <-
+ data.frame(x = c(rnorm(5000),rnorm(5000,4,1.5)),
+ y = rep(1:2, 5000))
+hexbinplot(y ~ x, mixdata, panel = panel.hexboxplot)
+}
+\keyword{hplot}
diff --git a/man/panel.hexgrid.Rd b/man/panel.hexgrid.Rd
new file mode 100644
index 0000000..341eb33
--- /dev/null
+++ b/man/panel.hexgrid.Rd
@@ -0,0 +1,21 @@
+\name{panel.hexgrid}
+\alias{panel.hexgrid}
+\title{Hexagonal grid for a lattice plot}
+\description{
+A panel function to add a hexagonal grid to a lattice plot.
+}
+\usage{
+panel.hexgrid(h, border = grey(0.85))
+}
+
+\arguments{
+ \item{h}{an object of class \code{hexbin}.}
+ \item{border}{a color for the hexagon border colors}
+}
+\value{
+ There is no return value from this function. The results are plotted on
+ the current active device.
+}
+\author{Nicholas Lewin-Koh \email{nikko at hailmail.net}}
+\seealso{\code{\link{hexbinplot}}, \code{\link{hexGraphPaper}}}
+\keyword{hplot}
diff --git a/man/panel.hexloess.Rd b/man/panel.hexloess.Rd
new file mode 100644
index 0000000..e96e985
--- /dev/null
+++ b/man/panel.hexloess.Rd
@@ -0,0 +1,41 @@
+\name{panel.hexloess}
+\alias{panel.hexloess}
+\title{Loess line for hexbin lattice plot}
+\description{
+ A panel function to add a loess line to a hexbin lattice plot.
+
+ This function contravened CRAN policy and is no longer available.
+}
+\usage{
+panel.hexloess(bin, w = NULL, span = 2/3, degree = 1,
+ family = c("symmetric", "gaussian"), evaluation = 50,
+ lwd = add.line$lwd, lty = add.line$lty,
+ col, col.line = add.line$col, \dots)
+
+}
+\arguments{
+ \item{bin}{an object of class \code{hexbin}.}
+ \item{w}{optional counts for object \code{bin}.}
+ \item{span}{smoothness parameter for \code{loess}.}
+ \item{degree}{degree of local polynomial used.}
+ \item{family}{if \code{"gaussian"} fitting is by least-squares, and
+ if \code{"symmetric"} a re-descending M-estimator is used.}
+ \item{evaluation}{number of points at which to evaluate the smooth curve.}
+ \item{lwd}{line weight graphical parameter.}
+ \item{lty}{line type graphical parameter.}
+ \item{col}{same as \code{col.line}.}
+ \item{col.line}{line color graphical parameter.}
+ \item{\dots}{optional arguments to \code{\link[stats]{loess.control}}.}
+}
+\value{
+ There is no return value from this function. The results are plotted on
+ the current active device.
+}
+\author{Nicholas Lewin-Koh \email{nikko at hailmail.net}}
+\seealso{
+\code{\link{hexbinplot}}, \code{\link{panel.hexgrid}},
+\code{\link{loess.smooth}},
+\code{\link{loess.control}},
+\code{\link[lattice:panel.functions]{panel.loess}}
+}
+\keyword{hplot}
diff --git a/man/plotMAhex.Rd b/man/plotMAhex.Rd
new file mode 100644
index 0000000..6dd5c0b
--- /dev/null
+++ b/man/plotMAhex.Rd
@@ -0,0 +1,133 @@
+\name{plotMAhex}
+\alias{plotMAhex}
+\title{MA-plot using hexagon bins}
+\description{
+ Creates an MA-plot using hexagons with color/glyph coding for control spots.
+}
+\usage{
+plotMAhex(MA, array = 1, xlab = "A", ylab = "M",
+ main = colnames(MA)[array], xlim = NULL, ylim = NULL,
+ status = NULL, values, pch, col, cex, nbin = 40,
+ zero.weights = FALSE, style = "colorscale", legend = 1.2,
+ lcex = 1, minarea = 0.04, maxarea = 0.8, mincnt = 2,
+ maxcnt = NULL, trans = NULL, inv = NULL, colorcut = NULL,
+ border = NULL, density = NULL, pen = NULL,
+ colramp = function(n) { LinGray(n, beg = 90, end = 15) },
+ newpage = TRUE, type = c("p", "l", "n"),
+ xaxt = c("s", "n"), yaxt = c("s", "n"),
+ verbose = getOption("verbose"))
+}
+\arguments{
+ \item{MA}{an \code{RGList}, \code{MAList} or \code{MArrayLM} object,
+ or any list with components \code{M} containing log-ratios and
+ \code{A} containing average intensities. Alternatively a
+ \code{matrix}, \code{Affybatch} or \code{ExpressionSet} object.}
+ \item{array}{integer giving the array to be plotted. Corresponds to
+ columns of \code{M} and \code{A}.}
+ \item{xlab, ylab, main}{character strings giving label for x-axis,
+ y-axis or main tile of the plot.}
+ \item{xlim, ylim}{numeric vectors of length 2 giving limits for x-axis
+ (or y-axis respectively), defaulting to min and max of the data.}
+ \item{status}{character vector giving the control status of each spot
+ on the array, of same length as the number of rows of \code{MA$M}.
+ If omitted, all points are plotted in the default color, symbol and size.}
+ \item{values}{character vector giving values of \code{status} to be
+ highlighted on the plot. Defaults to unique values of \code{status}.
+ Ignored if there is no \code{status} vector.}
+ \item{pch}{vector or list of plotting characters. Default to integer code 16.
+ Ignored is there is no \code{status} vector.}
+ \item{col}{numeric or character vector of colors, of the same length
+ as \code{values}. Defaults to \code{1:length(values)}. Ignored if
+ there is no \code{status} vector.}
+ \item{cex}{numeric vector of plot symbol expansions, of the the same
+ length as \code{values}. Defaults to 0.2 for the most common status
+ value and 1 for the others. Ignored if there is no \code{status} vector.}
+ \item{nbin}{ Number of bins } %% << FIXME
+ \item{zero.weights}{logical, should spots with zero or negative
+ weights be plotted?}
+ \item{style}{string specifying the style of hexagon plot,
+ see \code{\link{grid.hexagons}} for the possibilities.}
+ \item{legend}{numeric width of the legend in inches of \code{FALSE}.
+ In the latter case, or when \code{0}, no legend is not produced.}
+ \item{lcex}{characters expansion size for the text in the legend.}
+ \item{minarea}{fraction of cell area for the lowest count.}
+ \item{maxarea}{fraction of the cell area for the largest count.}
+ \item{mincnt}{cells with fewer counts are ignored.}
+ \item{maxcnt}{cells with more counts are ignored.}
+ \item{trans}{\code{\link{function}} specifying a transformation for
+ the counts such as \code{sqrt}.}
+ \item{inv}{the inverse transformation of \code{trans}.}
+ \item{colorcut}{vector of values covering [0, 1] that determine
+ hexagon color class boundaries and hexagon legend size boundaries.
+ Alternatively, an integer (\code{<= maxcnt}) specifying the
+ \emph{number} of equispaced colorcut values in [0,1].}
+ \item{border, density, pen}{color for polygon borders and filling of
+ each hexagon drawn, passed to \code{\link{grid.hexagons}}.}
+ \item{colramp}{function accepting an integer \code{n} as an argument and
+ returning n colors.}
+ \item{newpage}{should a new page start?}
+ \item{type, xaxt, yaxt}{strings to be used (when set to \code{"n"}) for
+ suppressing the plotting of hexagon symbols, or the x- or y-axis,
+ respectively.}
+ \item{verbose}{logical indicating if some diagnostic output should happen.}
+}
+
+\details{
+ An MA-plot is a plot of log-intensity ratios (M-values) versus
+ log-intensity averages (A-values). If \code{MA} is an \code{RGList} or
+ \code{MAList} then this function produces an ordinary within-array
+ MA-plot. If \code{MA} is an \code{MArrayLM} object, then the plot is an
+ fitted model MA-plot in which the estimated coefficient is on the y-axis
+ and the average A-value is on the x-axis.
+
+ If \code{MA} is a \code{matrix} or \code{ExpressionSet} object, then this
+ function produces a between-array MA-plot. In this case the A-values in
+ the plot are the average log-intensities across the arrays and the
+ M-values are the deviations of the log-intensities for the specified
+ array from the average. If there are more than five arrays, then the
+ average is computed robustly using medians. With five or fewer arrays,
+ it is computed by means.
+
+ The \code{status} vector is intended to specify the control status of
+ each spot, for example "gene", "ratio control", "house keeping gene",
+ "buffer" and so on. The vector is usually computed using the function
+ \code{\link[limma]{controlStatus}} from package \pkg{limma} and a
+ spot-types file. However the function may be used to highlight any
+ subset of spots.
+
+ The arguments \code{values}, \code{pch}, \code{col} and \code{cex}
+ can be included as attributes to \code{status} instead of being
+ passed as arguments to \code{plotMA}.
+
+ See \code{\link[graphics]{points}} for possible values for \code{pch},
+ \code{col} and \code{cex}.
+}
+
+\value{
+ A plot is created on the current graphics device.
+ and a list with the following items is returned invisibly:
+ \item{plot.vp}{the \code{\link{hexViewport}} constructed and used.}
+ \item{legend.vp}{if a legend has been produced, its
+ \code{\link[grid]{viewport}}.}
+ \item{hbin}{a \code{hexbin} object built with A as the x coordinate
+ and M as the y coordinate.}
+}
+
+\references{See \url{http://www.statsci.org/micrarra/refs/maplots.html}}
+
+\author{Nicholas Lewin-Koh, adapted from code by Gordon Smyth}
+
+\seealso{\code{\link[limma:plotma]{plotMA}} from package \pkg{limma},
+ and \code{\link{gplot.hexbin}}.
+}
+
+\examples{
+ if(require(marray)){ %% for the data only --> data(swirl, package="marray")
+ data(swirl)
+ hb <- plotMAhex(swirl[,1],newpage=FALSE,
+ main = "M vs A plot with hexagons", legend=0)
+ hexVP.abline(hb$plot.vp,h=0,col=gray(.6))
+ hexMA.loess(hb)
+ }
+}
+\keyword{hplot}
diff --git a/man/pushHexport.Rd b/man/pushHexport.Rd
new file mode 100644
index 0000000..49f07f4
--- /dev/null
+++ b/man/pushHexport.Rd
@@ -0,0 +1,29 @@
+\name{pushHexport}
+\alias{pushHexport}
+\title{Push a Hexagon Viewport ("hexVP")}
+\description{
+ Push a Hexagon Viewport (\code{"hexVP"}, see \link{hexVP-class}) on to
+ the tree of (grid) viewports, calling
+ \code{\link[grid:viewports]{pushViewport}}.
+}
+\usage{
+pushHexport(hvp, clip = "off")
+}
+\arguments{
+ \item{hvp}{a hexagon viewport, i.e., an object of class
+ \code{"hexVP"}, see \link{hexVP-class}, typically produced by
+ \code{\link{hexViewport}(..)}.}
+ \item{clip}{which viewport to push, either 'on' or 'off' are the
+ allowed arguments, see details.}
+}
+\seealso{the underlying \code{\link[grid:viewports]{pushViewport}} from the
+ \pkg{grid} package.
+}
+\details{
+ A hexagon viewport (\code{"hexVP"}) object has slots for two replicate
+ viewports one with clipping turned on and one with clipping off. This
+ allows toggling the clipping option.
+}
+%\examples{
+%}
+\keyword{dplot}
diff --git a/man/smooth.hexbin.Rd b/man/smooth.hexbin.Rd
new file mode 100644
index 0000000..92adc21
--- /dev/null
+++ b/man/smooth.hexbin.Rd
@@ -0,0 +1,84 @@
+\name{smooth.hexbin}
+\alias{smooth.hexbin}
+\alias{smoothbin-class}
+\title{Hexagon Bin Smoothing}
+\description{
+ Given a \code{"hexbin"} (hexagon bin) object, compute a discrete
+ kernel smoother that covers seven cells, namely a center cell and its
+ six neighbors. With two iterations the kernel effectively covers
+ 1+6+12=19 cells.
+}
+\usage{
+smooth.hexbin(bin, wts=c(48,4,1))
+}
+\arguments{
+ \item{bin}{object of class \code{"hexbin"}, typically resulting from
+ \code{\link{hexbin}()} or \code{\link{erode,hexbin-method}}.}
+ \item{wts}{numeric vector of length 3 for relative weights of the
+ center, the six neighbor cells, and twelve second neighbors.}
+}
+\value{
+ an object of class \code{"smoothbin"}, extending class
+ \code{"hexbin"}, see \code{\link{hexbin}}.
+ The object includes the additional slot \code{wts}.
+}
+\references{see \code{\link{grid.hexagons}} and \code{\link{hexbin}}.}
+
+\details{
+ This discrete kernel smoother uses the center cell, immediate
+ neighbors and second neighbors to smooth the counts. The counts for
+ each resulting cell is a linear combination of previous cell counts
+ and weights. The weights are
+ \tabular{ll}{
+ 1 center cell, \tab weight = wts[1]\cr
+ 6 immediate neighbors\tab weight = wts[2]\cr
+ 12 second neighbors \tab weight =wts[3]\cr
+ }
+ If a cell, its immediate and second neighbors all have a value of
+ \code{max(cnt)}, the new maximum count would be
+ \code{max(cnt)*sum(wts)}. It is possible for the counts to overflow.
+
+ The domain for cells with positive counts increases. The hexbin
+ slots \code{xbins}, \code{xbnds}, \code{ybnds}, and \code{dimen} all
+ reflect this increase.
+ Note that usually \code{dimen[2] = xbins+1}.
+
+ The intent was to provide a fast, iterated, immediate neighbor smoother.
+ However, the current hexbin plotting routines only support shifting
+ even numbered rows to the right. Future work can
+
+ (1) add a shift indicator to hexbin objects that indicates left or
+ right shifting.\cr
+ (2) generalize plot.hexbin() and hexagons()\cr
+ (3) provide an iterated kernel.\cr
+
+ With \code{wts[3]=0}, the smoother only uses the immediate neighbors.
+ With a shift indicator the domain could increase by 2 rows (one bottom
+ and on top) and 2 columns (one left and one right). However the current
+ implementation increases the domain by 4 rows and 4 columns, thus
+ reducing plotting resolution.
+}
+
+\seealso{
+ \code{\link{hexbin}}, \code{\link{erode.hexbin}}, %MISSING \code{\link{hthin}},
+ \code{\link{hcell2xy}},% \code{\link{hcell}},
+ \code{\link{gplot.hexbin}}, \code{\link{hboxplot}},
+ %\code{\link{hdiffplot}}, \code{\link{hmatplot}},
+ \code{\link{grid.hexagons}}, \code{\link{grid.hexlegend}}.
+}
+\examples{
+x <- rnorm(10000)
+y <- rnorm(10000)
+bin <- hexbin(x,y)
+# show the smooth counts in gray level
+smbin <- smooth.hexbin(bin)
+plot(smbin, main = "smooth.hexbin(.)")
+
+# Compare the smooth and the origin
+smbin1 <- smbin
+smbin1 at count <- as.integer(ceiling(smbin at count/sum(smbin at wts)))
+plot(smbin1)
+smbin2 <- smooth.hexbin(bin,wts=c(1,0,0)) # expand the domain for comparability
+plot(smbin2)
+}
+\keyword{misc}
diff --git a/src/hbin.f b/src/hbin.f
new file mode 100644
index 0000000..00737b3
--- /dev/null
+++ b/src/hbin.f
@@ -0,0 +1,88 @@
+ subroutine hbin(x,y,cell,cnt,xcm,ycm, size, shape,
+ * rx,ry, bnd, n, cellid)
+
+C Copyright 1991
+C Version Date: September 16, 1994
+C Programmer: Dan Carr
+C Indexing: Left to right, bottom to top
+C bnd(1) rows, bnd(2) columns
+C Output: cell ids for non empty cells, revised bnd(1)
+
+c optionally also return cellid(1:n)
+c Copyright (2004) Nicholas Lewin-Koh and Martin Maechler
+
+ implicit none
+
+ integer n, nc, cell(*), cnt(*), bnd(2), cellid(*)
+c cellid(*): length 1 or n
+ double precision x(n), y(n), xcm(*),ycm(*), rx(2),ry(2), size
+ double precision shape
+ integer i, i1, i2, iinc
+ integer j1, j2, jinc
+ integer L, lmax, lat
+ double precision c1, c2, con1, con2, dist1
+ double precision sx, sy, xmin, ymin, xr, yr
+ logical keepID
+
+ keepID = (cellid(1) .eq. 0)
+C_______Constants for scaling the data_____________________________
+
+ xmin = rx(1)
+ ymin = ry(1)
+ xr = rx(2)-xmin
+ yr = ry(2)-ymin
+ c1 = size/xr
+ c2 = size*shape/(yr*sqrt(3.))
+
+ jinc= bnd(2)
+ lat=jinc+1
+ iinc= 2*jinc
+ lmax=bnd(1)*bnd(2)
+ con1=.25
+ con2=1.0/3.0
+
+C_______Binning loop________________________________________
+
+ do i=1,n
+ sx = c1 * (x(i) - xmin)
+ sy = c2 * (y(i) - ymin)
+ j1 = sx+.5
+ i1 = sy+.5
+ dist1=(sx-j1)**2 + 3.*(sy-i1)**2
+
+ if(dist1 .lt. con1) then
+ L=i1*iinc + j1+1
+ elseif(dist1 .gt. con2) then
+ L=int(sy)*iinc + int(sx)+lat
+ else
+ j2 = sx
+ i2 = sy
+ if(dist1 .le. (sx-j2 -.5)**2 + 3.*(sy-i2 -.5)**2) then
+ L=i1*iinc+ j1+1
+ else
+ L=i2*iinc+ j2+lat
+ endif
+ endif
+
+ cnt(L)=cnt(L)+1
+ if (keepID) cellid(i)=L
+ xcm(L)=xcm(L)+ (x(i)-xcm(L))/cnt(L)
+ ycm(L)=ycm(L)+ (y(i)-ycm(L))/cnt(L)
+ enddo
+
+C_______Compression of output________________________________________
+
+ nc=0
+ do L=1,lmax
+ if(cnt(L) .gt. 0) then
+ nc=nc+1
+ cell(nc)=L
+ cnt(nc)=cnt(L)
+ xcm(nc)=xcm(L)
+ ycm(nc)=ycm(L)
+ endif
+ enddo
+ n=nc
+ bnd(1)=(cell(nc)-1)/bnd(2)+1
+ return
+ end
diff --git a/src/hcell.f b/src/hcell.f
new file mode 100644
index 0000000..2d6c78b
--- /dev/null
+++ b/src/hcell.f
@@ -0,0 +1,62 @@
+ subroutine hcell(x,y,cell,n,size,shape,rx,ry,bnd)
+C Copyright 1991
+C Version Date: September 16, 1994
+C Programmer: Dan Carr
+C Indexing: Left to right, bottom to top
+C bnd(1) rows, bnd(2) columns
+C Output: cell ids for none empty cells, revised bnd(1)
+
+c implicit none
+ integer n, cell(1), bnd(2)
+ double precision x(1), y(1), rx(2), ry(2), size, shape
+ integer i, i1, i2, iinc
+ integer j1, j2, jinc
+ integer L, lat, celmax
+ double precision c1, c2, con1, con2, dist1
+ double precision sx, sy, xmin, ymin, xr, yr
+
+C_______Constants for scaling the data_____________________________
+
+ xmin = rx(1)
+ ymin = ry(1)
+ xr = rx(2)-xmin
+ yr = ry(2)-ymin
+ c1 = size/xr
+ c2 = size*shape/(yr*sqrt(3.))
+
+ jinc= bnd(2)
+ lat=jinc+1
+ iinc= 2*jinc
+ con1=.25
+ con2=1./3.
+ celmax=0
+
+C_______Binning loop________________________________________
+
+ do i=1,n
+ sx = c1 * (x(i) - xmin)
+ sy = c2 * (y(i) - ymin)
+ j1 = sx+.5
+ i1 = sy+.5
+ dist1=(sx-j1)**2 + 3.*(sy-i1)**2
+
+ if(dist1.lt.con1)then
+ L=i1*iinc+j1+1
+ elseif(dist1.gt.con2)then
+ L=int(sy)*iinc + int(sx)+lat
+ else
+ j2 = sx
+ i2 = sy
+ if( dist1.le.(sx-j2-.5)**2 + 3. * (sy - i2 -.5)**2) then
+ L=i1*iinc+j1+1
+ else
+ L=i2*iinc+j2+lat
+ endif
+ endif
+
+ cell(i)=L
+ celmax = max(celmax,L)
+ enddo
+ bnd(1)=(celmax-1)/bnd(2)+1
+ return
+ end
diff --git a/src/herode.f b/src/herode.f
new file mode 100644
index 0000000..08f2423
--- /dev/null
+++ b/src/herode.f
@@ -0,0 +1,245 @@
+C File: herode.f
+C Version date: Jan 4, 1994
+C Programmer: Daniel B. Carr
+C
+C The vector erode returns the gray-level erosion order for hexagon cells.
+C The erosion cycle is:
+C cycle = (erode-1)/6 + 1
+C Many cells may be eroded in the same cycle
+C A tie break is the cell count deficit at erosion time:
+C deficit=erode - 6*cycle
+C The last eroded cell might be considered a bivariate median
+C
+C The algorithm:
+C Repeat until no cells are left in the list.
+C Process list
+C Reduce the cell counts by the a multiple of exposed sides
+C If a cell count is zero or less after an erosion cycle
+C let order=order + 6
+C report erode = order + cell count (count is <= 0)
+C remove the cell from consideration
+C update exposed side counts for existing neighbor cells
+C if exposed sides was zero, temporarily store id's
+C else
+C compress list
+C endif
+C Add temporarily stored id's to list
+C End Repeat
+
+ subroutine herode(cell,cnt,n,bdim,
+ * erode,ncnt,ncell,sides,neib,exist)
+
+C
+C
+ implicit none
+
+ integer cell(*), cnt(*) ! cell id and count
+ integer n, bdim(2) ! number of cells and 2-D array bounds
+ integer erode(*) ! erosion status
+ integer ncell(*),ncnt(*) ! extracted id's and expanded counts
+ integer sides(*) ! number of exposed sides
+ integer neib(6,*) ! pointers to the neighbors
+ logical exist(0:*) ! cell existence
+
+ integer nrow, ncol, Lmax ! dimensions
+ integer inc1(6), inc2(6) ! increments to get neighbors
+ integer i, icell, j, k, L ! subscripts
+ integer nc, nnc, nb, ninc, r, c !more subscripts
+ integer loop, order, maxcnt
+
+
+C_______Zero cell ordering numbers________________________________
+
+ order=0
+
+C_______Load the increment arrays and constants
+
+ nrow = bdim(1)
+ ncol = bdim(2)
+ Lmax = nrow * ncol
+ nnc = n
+
+C______Load increment arrays to neigbors______________
+C
+C order=right, up left, down left, up right, left, down right
+
+ inc1(1)= 1
+ inc1(2)= ncol-1
+ inc1(3)= -ncol-1
+ inc1(4)= ncol
+ inc1(5)=-1
+ inc1(6)= -ncol
+
+ inc2(1)= 1
+ inc2(2)= ncol
+ inc2(3)= -ncol
+ inc2(4)= ncol+1
+ inc2(5)=-1
+ inc2(6)= -ncol+1
+
+
+c_______load working arrays_______________________________________________
+
+ do i=0,Lmax
+ exist(i)=.false.
+ enddo
+
+ maxcnt=0
+ do i=1,n
+ icell=cell(i)
+ ncnt(icell)=cnt(i)
+ exist(icell)=.true.
+ maxcnt=max(maxcnt,cnt(i))
+ enddo
+
+C_______Store pointers to cell neighbors_________________________
+C
+C A pointer of 0 means the neigbor in out of bounds
+C Also find the max count
+C Speed: Can avoid adding 1's to r and c
+C but this code is easier to follow
+ do i=1,n
+ L=cell(i)
+ k = L -1
+ r=k/ncol+1
+ c=mod(k,ncol)+1
+ if(mod(r,2).eq.1)then
+ do j = 1,6
+ neib(j,L) = L + inc1(j)
+ enddo
+
+ if (c .eq. 1) then
+ neib(2,L) = 0
+ neib(3,L) = 0
+ neib(5,L) = 0
+ else if (c .eq. ncol) then
+ neib(1,L) = 0
+ endif
+
+ if (r .eq. 1) then
+ neib(3,L) = 0
+ neib(6,L) = 0
+ else if(r.eq.nrow)then
+ neib(2,L) = 0
+ neib(4,L) =0
+ endif
+
+ else
+ do j= 1,6
+ neib(j,L) = L + inc2(j)
+ enddo
+
+ if (c .eq. 1) then
+ neib(5,L) = 0
+ else if (c .eq. ncol) then
+ neib(1,L) = 0
+ neib(4,L) = 0
+ neib(6,L) = 0
+ endif
+
+ if (r .eq. nrow) then
+ neib(2,L) = 0
+ neib(4,L) = 0
+ endif
+
+ endif
+ enddo
+
+
+C_______Count exposed sides for cells in the contour_________________
+
+ do i=1,n
+ icell=cell(i)
+ sides(icell)=0
+ do j=1,6
+ if(.not. exist( neib(j,icell) ) )then
+ sides(icell)=sides(icell)+ 1
+ endif
+ enddo
+ enddo
+
+C________Grab surface cells___________________________________________
+
+ nc=0
+ do i=1,n
+ if(sides(cell(i)).gt.0)then
+ nc=nc+1
+ ncell(nc)=cell(i)
+ endif
+ enddo
+ n=nc !n is now the number of exposed, non-empty cells
+
+C_______The outer loop________________________________________________
+C
+C temporary indices
+C nc: index for cells remaining on the list
+C ninc: index for newly exposed cells added to back of list
+
+ do while(n.gt.0)
+
+C Subtract exposed-side counts from the surface cell counts
+C until at least one cell is empty.
+
+ loop=maxcnt
+ do i=1,n
+ icell=ncell(i)
+ loop=min( (ncnt(icell)-1)/sides(icell) , loop)
+ enddo
+ loop=loop+1 !all loop values are 1 too small
+
+C update the counts, rank and remove eroded cells
+
+ nc=0
+ order=order+6
+ ninc=n
+ do i=1,n
+ icell=ncell(i)
+ ncnt(icell)=ncnt(icell)-sides(icell)*loop
+ if(ncnt(icell).le.0)then
+
+C Remove the empty cell and store it's order
+ exist(icell)=.false.
+ erode(icell)=order+ncnt(icell)
+
+C Update the neighbors of the empty cell
+ do j=1,6
+ nb=neib(j,icell)
+ if(exist(nb))then
+
+C Store cells for addition to surface list
+ if(sides(nb).eq.0)then
+ ninc=ninc+1
+ ncell(ninc)=nb
+ endif
+
+C Update sides for the neighbors
+ sides(nb)=sides(nb)+1
+ endif
+ enddo
+ else
+
+C Save remaining cells
+ nc=nc+1
+ ncell(nc)=ncell(i)
+ endif
+ enddo
+
+C Add new surface cells if any
+
+ do i=n+1,ninc,1
+ nc=nc+1
+ ncell(nc)=ncell(i)
+ enddo
+ n=nc
+ enddo
+
+C_______compress result___________________________________________
+
+
+ do i=1,nnc
+ erode(i)=erode(cell(i))
+ enddo
+ n=nnc
+
+ return
+ end
diff --git a/src/hsm.f b/src/hsm.f
new file mode 100644
index 0000000..b282cc0
--- /dev/null
+++ b/src/hsm.f
@@ -0,0 +1,114 @@
+C File: hsm.f
+C Programmer: Daniel B. Carr
+C Version Date: January 3, 1994
+C
+C This program is an hexagon cell smoother. It smooths into
+C neighboring cells and hence expands.
+
+C The kernal is a crude integer kernel.
+C The boundary hexagons get weight 1, the center hexagon
+C gets weight, wt, which by default is set to six.
+C
+C
+
+ subroutine hsm(cell,cnt,n,nmax,sm,ncol,wt)
+
+ implicit none
+
+ integer n, nmax, ncol
+ integer cell(*), cnt(*), sm(*), wt(*)
+ integer ind, ind1(6), ind2(12),ind3(6), ind4(12), loc
+ integer row, cnt1, cnt2, wta, wtb, wtc
+ integer i, j
+
+C__________Constants___________________________________________
+
+ ind1(1)=-1
+ ind1(2)=ncol-1
+ ind1(3)=ncol
+ ind1(4)=+1
+ ind1(5)=-ncol
+ ind1(6)=-ncol-1
+
+ ind2(1)=-2
+ ind2(2)=ncol-2
+ ind2(3)=2*ncol-1
+ ind2(4)=2*ncol
+ ind2(5)=2*ncol+1
+ ind2(6)=ncol+1
+ ind2(7)=2
+ ind2(8)=-ncol+1
+ ind2(9)=-2*ncol+1
+ ind2(10)=-2*ncol
+ ind2(11)=-2*ncol-1
+ ind2(12)=-ncol-2
+
+ ind3(1)=-1
+ ind3(2)=ncol
+ ind3(3)=ncol+1
+ ind3(4)=+1
+ ind3(5)=-ncol+1
+ ind3(6)=-ncol
+
+ ind4(1)=-2
+ ind4(2)=ncol-1
+ ind4(3)=2*ncol-1
+ ind4(4)=2*ncol
+ ind4(5)=2*ncol+1
+ ind4(6)=ncol+2
+ ind4(7)=2
+ ind4(8)=-ncol+2
+ ind4(9)=-2*ncol+1
+ ind4(10)=-2*ncol
+ ind4(11)=-2*ncol-1
+ ind4(12)=-ncol-1
+
+ wta = wt(1)
+ wtb = wt(2)
+ wtc = wt(3)
+
+C_________Smoothing_____________________________________
+
+ do i=1,n
+ sm(cell(i))=wta*cnt(i)
+ enddo
+
+ do i=1,n
+ loc=cell(i)
+ row=(loc-1)/ncol + 1
+ cnt1=wtb*cnt(i)
+ cnt2=wtc*cnt(i)
+
+ if(mod(row,2).eq.1)then
+ do j=1,6
+ ind=loc+ind1(j)
+ sm(ind)=sm(ind)+cnt1
+ enddo
+ do j=1,12
+ ind=loc+ind2(j)
+ sm(ind)=sm(ind)+cnt2
+ enddo
+ else
+ do j=1,6
+ ind=loc+ind3(j)
+ sm(ind)=sm(ind)+cnt1
+ enddo
+ do j=1,12
+ ind=loc+ind4(j)
+ sm(ind)=sm(ind)+cnt2
+ enddo
+ endif
+ enddo
+
+ n=0
+ do i=1,nmax
+ if(sm(i).gt.0)then
+ n=n+1
+ cell(n)=i
+ cnt(n)=sm(i)
+ endif
+ enddo
+ return
+ end
+
+
diff --git a/tests/hdiffplot.R b/tests/hdiffplot.R
new file mode 100644
index 0000000..921d061
--- /dev/null
+++ b/tests/hdiffplot.R
@@ -0,0 +1,36 @@
+library(hexbin)
+
+if(R.version$major != "1" || as.numeric(R.version$minor) >= 7)
+ RNGversion("1.6")
+set.seed(213)
+x1 <- rnorm(10000)
+y1 <- rnorm(10000)
+
+x2 <- rnorm(10000,mean = .3)
+y2 <- rnorm(10000,mean = .3)
+
+rx <- range(x1,x2)
+ry <- range(y1,y2)
+
+str(bin1 <- hexbin(x1,y1, xbnds = rx, ybnds = ry))
+str(bin2 <- hexbin(x2,y2, xbnds = rx, ybnds = ry))
+
+str(erode(bin1))
+
+str(smbin1 <- smooth.hexbin(bin1))
+(smbin2 <- smooth.hexbin(bin2))
+
+str(erodebin1 <- erode.hexbin(smbin1))
+(erodebin2 <- erode.hexbin(smbin2))
+
+if(FALSE)## does not work -- what funny stuff is hdiffplot() doing???
+ par(mfrow = c(2,1))
+
+if(exists("hdiffplot", mode="function")) { ## not yet in new hexbin
+hdiffplot(bin1,bin2, main = "Original N(0,*) Random bins")
+
+hdiffplot(smbin1,smbin2, main = "smooth.hexbin() smoothed bins")
+
+plot.new()
+hdiffplot(erodebin1,erodebin2, main = "erode.hexbin()d smoothed bins")
+}# not yet
diff --git a/tests/hdiffplot.Rout.save b/tests/hdiffplot.Rout.save
new file mode 100644
index 0000000..89706a5
--- /dev/null
+++ b/tests/hdiffplot.Rout.save
@@ -0,0 +1,155 @@
+
+R Under development (unstable) (2013-01-29 r61780) -- "Unsuffered Consequences"
+Copyright (C) 2013 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(hexbin)
+Loading required package: grid
+Loading required package: lattice
+>
+> if(R.version$major != "1" || as.numeric(R.version$minor) >= 7)
++ RNGversion("1.6")
+Warning message:
+In RNGkind("Marsaglia-Multicarry", "Buggy Kinderman-Ramage") :
+ buggy version of Kinderman-Ramage generator used
+> set.seed(213)
+> x1 <- rnorm(10000)
+> y1 <- rnorm(10000)
+>
+> x2 <- rnorm(10000,mean = .3)
+> y2 <- rnorm(10000,mean = .3)
+>
+> rx <- range(x1,x2)
+> ry <- range(y1,y2)
+>
+> str(bin1 <- hexbin(x1,y1, xbnds = rx, ybnds = ry))
+Formal class 'hexbin' [package "hexbin"] with 16 slots
+ ..@ cell : int [1:535] 16 20 48 70 74 75 76 80 99 101 ...
+ ..@ count : int [1:535] 1 1 1 1 1 1 1 1 1 1 ...
+ ..@ xcm : num [1:535] 0.37 1.338 0.721 -1.846 -0.965 ...
+ ..@ ycm : num [1:535] -3.66 -3.71 -3.54 -3.2 -3.24 ...
+ ..@ xbins : num 30
+ ..@ shape : num 1
+ ..@ xbnds : num [1:2] -3.8 4.3
+ ..@ ybnds : num [1:2] -3.71 4.17
+ ..@ dimen : num [1:2] 36 31
+ ..@ n : int 10000
+ ..@ ncells: int 535
+ ..@ call : language hexbin(x = x1, y = y1, xbnds = rx, ybnds = ry)
+ ..@ xlab : chr "x1"
+ ..@ ylab : chr "y1"
+ ..@ cID : NULL
+ ..@ cAtt : int(0)
+> str(bin2 <- hexbin(x2,y2, xbnds = rx, ybnds = ry))
+Formal class 'hexbin' [package "hexbin"] with 16 slots
+ ..@ cell : int [1:545] 41 51 75 76 104 107 110 114 136 138 ...
+ ..@ count : int [1:545] 1 1 1 1 1 2 1 1 2 1 ...
+ ..@ xcm : num [1:545] -1.141 1.445 -0.493 -0.324 -0.995 ...
+ ..@ ycm : num [1:545] -3.42 -3.45 -3.24 -3.35 -2.9 ...
+ ..@ xbins : num 30
+ ..@ shape : num 1
+ ..@ xbnds : num [1:2] -3.8 4.3
+ ..@ ybnds : num [1:2] -3.71 4.17
+ ..@ dimen : num [1:2] 36 31
+ ..@ n : int 10000
+ ..@ ncells: int 545
+ ..@ call : language hexbin(x = x2, y = y2, xbnds = rx, ybnds = ry)
+ ..@ xlab : chr "x2"
+ ..@ ylab : chr "y2"
+ ..@ cID : NULL
+ ..@ cAtt : int(0)
+>
+> str(erode(bin1))
+Formal class 'erodebin' [package "hexbin"] with 19 slots
+ ..@ eroded: logi [1:535] FALSE FALSE FALSE FALSE FALSE FALSE ...
+ ..@ cdfcut: num 0.5
+ ..@ erode : int [1:71] 12 35 34 57 52 4 30 101 138 150 ...
+ ..@ cell : int [1:535] 16 20 48 70 74 75 76 80 99 101 ...
+ ..@ count : int [1:535] 1 1 1 1 1 1 1 1 1 1 ...
+ ..@ xcm : num [1:535] 0.37 1.338 0.721 -1.846 -0.965 ...
+ ..@ ycm : num [1:535] -3.66 -3.71 -3.54 -3.2 -3.24 ...
+ ..@ xbins : num 30
+ ..@ shape : num 1
+ ..@ xbnds : num [1:2] -3.8 4.3
+ ..@ ybnds : num [1:2] -3.71 4.17
+ ..@ dimen : num [1:2] 36 31
+ ..@ n : int 10000
+ ..@ ncells: int 535
+ ..@ call : language hexbin(x = x1, y = y1, xbnds = rx, ybnds = ry)
+ ..@ xlab : chr "x1"
+ ..@ ylab : chr "y1"
+ ..@ cID : NULL
+ ..@ cAtt : int(0)
+>
+> str(smbin1 <- smooth.hexbin(bin1))
+Formal class 'smoothbin' [package "hexbin"] with 17 slots
+ ..@ wts : num [1:3] 48 4 1
+ ..@ cell : int [1:906] 17 18 19 21 22 23 51 52 53 54 ...
+ ..@ count : int [1:906] 1 1 1 1 1 1 1 4 5 2 ...
+ ..@ xcm : num [1:535] 0.37 1.338 0.721 -1.846 -0.965 ...
+ ..@ ycm : num [1:535] -3.66 -3.71 -3.54 -3.2 -3.24 ...
+ ..@ xbins : num 34
+ ..@ shape : num 1
+ ..@ xbnds : num [1:2] -4.34 4.84
+ ..@ ybnds : num [1:2] -4.23 4.7
+ ..@ dimen : num [1:2] 40 35
+ ..@ n : int 10000
+ ..@ ncells: int 535
+ ..@ call : language hexbin(x = x1, y = y1, xbnds = rx, ybnds = ry)
+ ..@ xlab : chr "x1"
+ ..@ ylab : chr "y1"
+ ..@ cID : NULL
+ ..@ cAtt : int(0)
+> (smbin2 <- smooth.hexbin(bin2))
+'hexbin' object from call: hexbin(x = x2, y = y2, xbnds = rx, ybnds = ry)
+n = 10000 points in nc = 545 hexagon cells in grid dimensions 40 by 35
+>
+> str(erodebin1 <- erode.hexbin(smbin1))
+Formal class 'erodebin' [package "hexbin"] with 19 slots
+ ..@ eroded: logi [1:906] FALSE FALSE FALSE FALSE FALSE FALSE ...
+ ..@ cdfcut: num 0.5
+ ..@ erode : int [1:73] 11 35 95 100 117 88 6 39 167 232 ...
+ ..@ cell : int [1:906] 17 18 19 21 22 23 51 52 53 54 ...
+ ..@ count : int [1:906] 1 1 1 1 1 1 1 4 5 2 ...
+ ..@ xcm : num [1:535] 0.37 1.338 0.721 -1.846 -0.965 ...
+ ..@ ycm : num [1:535] -3.66 -3.71 -3.54 -3.2 -3.24 ...
+ ..@ xbins : num 34
+ ..@ shape : num 1
+ ..@ xbnds : num [1:2] -4.34 4.84
+ ..@ ybnds : num [1:2] -4.23 4.7
+ ..@ dimen : num [1:2] 40 35
+ ..@ n : int 10000
+ ..@ ncells: int 535
+ ..@ call : language hexbin(x = x1, y = y1, xbnds = rx, ybnds = ry)
+ ..@ xlab : chr "x1"
+ ..@ ylab : chr "y1"
+ ..@ cID : NULL
+ ..@ cAtt : int(0)
+> (erodebin2 <- erode.hexbin(smbin2))
+'hexbin' object from call: hexbin(x = x2, y = y2, xbnds = rx, ybnds = ry)
+n = 10000 points in nc = 545 hexagon cells in grid dimensions 40 by 35
+>
+> if(FALSE)## does not work -- what funny stuff is hdiffplot() doing???
++ par(mfrow = c(2,1))
+>
+> if(exists("hdiffplot", mode="function")) { ## not yet in new hexbin
++ hdiffplot(bin1,bin2, main = "Original N(0,*) Random bins")
++
++ hdiffplot(smbin1,smbin2, main = "smooth.hexbin() smoothed bins")
++
++ plot.new()
++ hdiffplot(erodebin1,erodebin2, main = "erode.hexbin()d smoothed bins")
++ }# not yet
+>
diff --git a/tests/hray.R b/tests/hray.R
new file mode 100644
index 0000000..13a9cce
--- /dev/null
+++ b/tests/hray.R
@@ -0,0 +1,31 @@
+library(hexbin)
+
+set.seed(572)
+
+x <- rnorm(100)
+y <- rnorm(100)
+val <- rnorm(100)
+inc <- abs(rnorm(100,sd = .3))
+loB <- val-inc
+hiB <- val+inc
+
+if(exists("hray", mode="function")) { # 'real soon now'
+
+## no confidence bounds
+plot(x,y,type = 'n')
+hray(x,y,val)
+
+## confidence bounds
+plot(x,y,type = 'n')
+hray(x,y,val, lo = loB, hi = hiB)
+
+## clockwise orientation
+plot(x,y,type = 'n')
+hray(x,y,val, loB, hiB, clockwise = TRUE)
+
+## no tics and small filled dots
+plot(x,y,type = 'n')
+hray(x,y,val, loB, hiB, ticlength = FALSE,
+ dotside = 20, dotlength = .025, dotden = -1)
+
+}
diff --git a/tests/hray.Rout.save b/tests/hray.Rout.save
new file mode 100644
index 0000000..35c9748
--- /dev/null
+++ b/tests/hray.Rout.save
@@ -0,0 +1,52 @@
+
+R version 3.1.1 (2014-07-10) -- "Sock it to Me"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(hexbin)
+>
+> set.seed(572)
+>
+> x <- rnorm(100)
+> y <- rnorm(100)
+> val <- rnorm(100)
+> inc <- abs(rnorm(100,sd = .3))
+> loB <- val-inc
+> hiB <- val+inc
+>
+> if(exists("hray", mode="function")) { # 'real soon now'
++
++ ## no confidence bounds
++ plot(x,y,type = 'n')
++ hray(x,y,val)
++
++ ## confidence bounds
++ plot(x,y,type = 'n')
++ hray(x,y,val, lo = loB, hi = hiB)
++
++ ## clockwise orientation
++ plot(x,y,type = 'n')
++ hray(x,y,val, loB, hiB, clockwise = TRUE)
++
++ ## no tics and small filled dots
++ plot(x,y,type = 'n')
++ hray(x,y,val, loB, hiB, ticlength = FALSE,
++ dotside = 20, dotlength = .025, dotden = -1)
++
++ }
+>
+> proc.time()
+ user system elapsed
+ 0.252 0.012 0.258
diff --git a/tests/large.R b/tests/large.R
new file mode 100644
index 0000000..aa42e04
--- /dev/null
+++ b/tests/large.R
@@ -0,0 +1,39 @@
+library(hexbin)
+
+if(FALSE) { ## the following is still quite a bit from working/useful :
+
+## what should that do? set a palette?
+rgb <- matrix(c(
+ 15,15,15,
+
+ 0, 0, 0,
+ 1, 9,15,
+ 9,15, 9,
+ 15, 9, 9,
+
+ 0, 0, 0,
+ 0, 0, 0,
+ 0, 0, 0,
+ 0, 0, 0,
+ 0, 0, 0,
+ 0, 0, 0,
+
+ 9, 9, 9,
+ 0, 2, 7,
+ 0, 7, 1,
+ 8, 1, 1,
+
+ 15, 2, 2,
+ 11, 1, 1,
+ 8, 1, 1,
+ 5, 1, 1,
+ 5, 1, 1,
+ 15,15,15), ncol = 3, byrow = TRUE)
+
+##ps.options(rasters=600,color=rgb/15,background=2)
+##ps.options(color=rgb/15,background=2)
+postscript("large.ps",width = 10,height = 7.5)
+
+plot.hexbin(ans.25mil, style = "nest", lcex = .9)
+
+}## FALSE, i.e. nothing done
diff --git a/tests/large.Rout.save b/tests/large.Rout.save
new file mode 100644
index 0000000..5081e01
--- /dev/null
+++ b/tests/large.Rout.save
@@ -0,0 +1,60 @@
+
+R version 3.1.1 (2014-07-10) -- "Sock it to Me"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(hexbin)
+>
+> if(FALSE) { ## the following is still quite a bit from working/useful :
++
++ ## what should that do? set a palette?
++ rgb <- matrix(c(
++ 15,15,15,
++
++ 0, 0, 0,
++ 1, 9,15,
++ 9,15, 9,
++ 15, 9, 9,
++
++ 0, 0, 0,
++ 0, 0, 0,
++ 0, 0, 0,
++ 0, 0, 0,
++ 0, 0, 0,
++ 0, 0, 0,
++
++ 9, 9, 9,
++ 0, 2, 7,
++ 0, 7, 1,
++ 8, 1, 1,
++
++ 15, 2, 2,
++ 11, 1, 1,
++ 8, 1, 1,
++ 5, 1, 1,
++ 5, 1, 1,
++ 15,15,15), ncol = 3, byrow = TRUE)
++
++ ##ps.options(rasters=600,color=rgb/15,background=2)
++ ##ps.options(color=rgb/15,background=2)
++ postscript("large.ps",width = 10,height = 7.5)
++
++ plot.hexbin(ans.25mil, style = "nest", lcex = .9)
++
++ }## FALSE, i.e. nothing done
+>
+> proc.time()
+ user system elapsed
+ 0.240 0.032 0.265
diff --git a/tests/viewp-ex.R b/tests/viewp-ex.R
new file mode 100644
index 0000000..1983963
--- /dev/null
+++ b/tests/viewp-ex.R
@@ -0,0 +1,21 @@
+library(hexbin)
+
+## a variation on Nicholas' post to bioconductor & example(hexViewport)
+set.seed(545)
+x <- rnorm(2^15)
+y <- 3*x - .2*x^2 + rnorm(2^15)
+hbin <- hexbin(x,y)
+
+##
+hp <- hexViewport(hbin, newpage = TRUE)
+pushHexport(hp)
+library("grid")
+grid.rect()
+grid.xaxis()
+grid.yaxis()
+grid.hexagons(hbin, style = "centroid")
+hloess <- loess(y ~ x, data = hcell2xy(hbin), weights = hbin @ count)
+xx <- seq(hbin at xbnds[1], hbin at xbnds[2], length = 500)
+grid.lines(xx, predict(hloess, xx),
+ gp = gpar(col = 'red', lwd = 2), default.units = "native")
+popViewport()
diff --git a/tests/viewp-ex.Rout.save b/tests/viewp-ex.Rout.save
new file mode 100644
index 0000000..a2806ca
--- /dev/null
+++ b/tests/viewp-ex.Rout.save
@@ -0,0 +1,42 @@
+
+R version 3.1.1 (2014-07-10) -- "Sock it to Me"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(hexbin)
+>
+> ## a variation on Nicholas' post to bioconductor & example(hexViewport)
+> set.seed(545)
+> x <- rnorm(2^15)
+> y <- 3*x - .2*x^2 + rnorm(2^15)
+> hbin <- hexbin(x,y)
+>
+> ##
+> hp <- hexViewport(hbin, newpage = TRUE)
+> pushHexport(hp)
+> library("grid")
+> grid.rect()
+> grid.xaxis()
+> grid.yaxis()
+> grid.hexagons(hbin, style = "centroid")
+> hloess <- loess(y ~ x, data = hcell2xy(hbin), weights = hbin @ count)
+> xx <- seq(hbin at xbnds[1], hbin at xbnds[2], length = 500)
+> grid.lines(xx, predict(hloess, xx),
++ gp = gpar(col = 'red', lwd = 2), default.units = "native")
+> popViewport()
+>
+> proc.time()
+ user system elapsed
+ 0.368 0.020 0.379
diff --git a/vignettes/hexagon_binning.Rnw b/vignettes/hexagon_binning.Rnw
new file mode 100644
index 0000000..928a584
--- /dev/null
+++ b/vignettes/hexagon_binning.Rnw
@@ -0,0 +1,502 @@
+%% Emacs: use Rnw-mode if available, else noweb
+%% NOTE -- ONLY EDIT THE .Rnw FILE !
+
+%\VignetteIndexEntry{Hexagon Binning}
+%\VignetteDepends{hexbin, grid, marray}
+%\VignetteKeywords{Over plotting, Large data set, Visualization}
+%\VignettePackage{hexbin}
+
+\documentclass[]{article}
+
+\usepackage[authoryear,round]{natbib}
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+
+\author{Nicholas Lewin-Koh\footnote{with minor assistance by Martin M\"achler}}
+
+\begin{document}
+
+\title{Hexagon Binning: an Overview}
+\maketitle{}
+
+\section{Overview}
+Hexagon binning is a form of bivariate histogram useful for visualizing
+the structure in datasets with large $n$. The underlying concept of
+hexagon binning is extremely simple;
+\begin{enumerate}
+\item the $xy$ plane over the set (range($x$), range($y$)) is tessellated
+by a regular grid of hexagons.
+
+\item the number of points falling in each hexagon are counted and
+stored in a data structure
+
+\item the hexagons with count $ > 0$ are plotted using a color ramp or
+varying the radius of the hexagon in proportion to the counts.
+\end{enumerate}
+
+The underlying algorithm is extremely fast and effective for displaying
+the structure of datasets with $n \ge 10^6$.
+If the size of the grid and the cuts in the color ramp are chosen in a
+clever fashion than the structure inherent in the data should emerge
+in the binned plots. The same caveats apply to hexagon binning as
+apply to histograms and care should be exercised in choosing the
+binning parameters.
+
+The hexbin package is a set of function for creating, manipulating and
+plotting hexagon bins. The package extends the basic hexagon binning
+ideas with several functions for doing bivariate smoothing, finding an
+approximate bivariate median, and looking at the difference between
+two sets of bins on the same scale. The basic functions can be
+incorporated into many types of plots. This package is based on the
+original package for S-PLUS by Dan Carr at George Mason University and
+is mostly the fruit of his graphical genius and intuition.
+
+\section{Theory and Algorithm}
+Why hexagons? There are many reasons for using hexagons, at least over
+squares. Hexagons have symmetry of nearest neighbors which is lacking
+in square bins. Hexagons are the maximum number of sides a polygon can
+have for a regular tesselation of the plane, so in terms of packing a
+hexagon is 13\% more efficient for covering the plane than
+squares. This property translates into better sampling efficiency at
+least for elliptical shapes. Lastly hexagons are visually less biased
+for displaying densities than other regular tesselations. For instance
+with squares our eyes are drawn to the horizontal and vertical lines
+of the grid. The following figure adapted from \cite[]{carretal}shows
+this effectively.
+
+\begin{figure}[h]
+ \centering
+<<comphexsq, fig=TRUE, width=7, height=4, echo=FALSE>>=
+library("grid")
+library("hexbin")
+x <- rnorm(1000)
+y <- rnorm(1000)
+##-- Hexagon Bins: --
+hbin <- hexbin(x,y, xbins = 25)
+grid.newpage()
+pushViewport(viewport(layout=grid.layout(1, 2)))
+pushViewport(viewport(layout.pos.col=1,layout.pos.row=1))
+plot(hbin, style="lattice", legend=0, xlab = "X", ylab = "Y", newpage=FALSE)
+popViewport()
+
+##-- Manual "square" binning: --
+## grid
+rx <- range(x); bx <- seq(rx[1],rx[2], length=29)
+ry <- range(y); by <- seq(ry[1],ry[2], length=29)
+## midpoints
+mx <- (bx[-1]+bx[-29])/2
+my <- (by[-1]+by[-29])/2
+gg <- as.matrix(expand.grid(mx,my))# dim = (28^2, 2)
+zz <- unname(table(cut(x, b = bx), cut(y, b = by)))# 28 x 28
+ind <- zz > 0
+if(FALSE) ## ASCII image:
+ symnum(unname(ind))
+sq.size <- zz[ind]^(1/3) / max(zz)
+## if we used base graphics:
+## symbols(gg[ind,], squares = sq.size, inches = FALSE, fg = 2, bg = 2)
+pushViewport(viewport(layout.pos.col=2, layout.pos.row=1))
+vp <- plot(hbin, style="lattice", legend=0,
+ xlab = "X", ylab = "Y", newpage=FALSE, type="n")
+pushHexport(vp$plot, clip="on")
+grid.rect(x= gg[ind,1], y=gg[ind,2], width = sq.size, height= sq.size,
+ default.units = "native", gp = gpar(col="black",fill="black"))
+popViewport()
+@
+ \caption[bivariate: squares and hexagons]{A bivariate point set binned
+ into squares and hexagons. Bins are
+ scaled approximately equal, and the size of the glyph is proportional
+ to the count in that bin.}
+ \label{fig:compHexSq}
+\end{figure}
+
+
+We can see in Figure~\ref{fig:compHexSq} that when the data are plotted
+as squares centered on a regular lattice our eye is drawn to the regular lines
+which are parallel to the underlying grid. Hexagons tend to break up
+the lines.
+
+How does does the hexagon binning algorithm work?
+
+\begin{enumerate}
+\item Squash $Y$ by $\sqrt{3}$
+\item Create a dual lattice
+\item Bin each point into pair of near neighbor rectangles
+\item Pick closest of the rectangle centers (adjusting for $\sqrt{3}$)
+\end{enumerate}
+
+
+<< nearNeighbor, echo = false, results = hide >>=
+x <- -2:2
+sq <- expand.grid(list(x = x, y = c(-1,0,1)))
+fc.sq <- rbind(sq,sq+.5) # face centered squares
+fc.sq$y <- sqrt(3)*fc.sq$y # stretch y by the sqrt(3)
+nr <- length(fc.sq$x)/2
+@
+
+\begin{figure}[h]
+ \centering
+<< fig = TRUE,width = 4,height = 8,echo = FALSE >>=
+par(mfrow = c(3,1))
+par(mai = c(.1667,0.2680,0.1667,0.2680)) ##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+points(-.25,.15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1)+1
+py <- sqrt(3)*(c(0,0,-1,-1)+1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+
+par(mai = c(.1667, 0.2680, 0.1667, 0.2680))##par(mai=.25*par("mai"))
+plot(fc.sq$x, fc.sq$y, pch = 16, cex = .5)
+nr <- length(fc.sq$x)/2
+points(fc.sq$x[1:nr], fc.sq$y[1:nr], pch = 15, cex = .7, col = 5)
+px <- c(-1,-2,-2,-1) + 1
+py <- sqrt(3)*(c(0,0,-1,-1) + 1)
+polygon(px, py, density = 0, col = 5)
+polygon(px+.5, py-sqrt(3)/2, density = 0)
+px <- c(-.5,-.5,0,.5, .5, 0)
+py <- c(-.5, .5,1,.5,-.5,-1) /sqrt(3)
+polygon(px, py, col = gray(.5), density = 0)
+polygon(px-.5, py+sqrt(3)/2, density = 0, col = 4)
+points(-.25, .15, col = 2, pch = 16, cex = .5)
+plot.new()
+arrows(-.25, .15, 0, 0, angle = 10, length = .05)
+@
+\caption[Near Neighbor Rectangles]{}
+\label{fig:binalg}
+\end{figure}
+
+Figure~\ref{fig:binalg} shows graphically how the algorithm works. In
+the first panel we see the the dual lattice laid out in black and blue
+points. The red point is an arbitrary point to be binned. The second
+panel shows the near neigbor rectangles for each lattice around the
+point to be binned, the intersection of the rectangles contains the
+point. The last panel shows the simple test for locating the point in
+the hexagon, the closest of the two corners which are not
+intersections is the center of the hexagon to which the point should
+be allocated. The binning can be calculated in one pass through the
+data, and is clearly $O(n)$ with a small constant. Storage is vastly
+reduced compared to the original data.
+
+\section{Basic Hexagon Binning Functions}
+Using the basic hexagon binning functions are not much more involved
+than using the basic plotting functions. The following little example
+shows the basic features of the basic plot and binning functions.
+We start by loading the package and generating a toy example data set.
+
+<< basic, fig = TRUE, results = hide >>=
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40)
+plot(hbin)
+@
+There are two things to note here. The first is that the function
+\texttt{gplot.hexbin} is defined as a \texttt{plot} method for the S4 class
+\texttt{hexbin}. The second is that the default color scheme for the
+hexplot is a gray scale. However, there is an argument to plot,
+\texttt{colramp}, that allows the use of any function that excepts an
+argument \texttt{n} and returns $n$ colors. Several functions are supplied
+that provide alternative color-ramps to R's built in color ramp functions,
+see \texttt{help(ColorRamps)}.
+
+<< showcol, fig = TRUE, width = 7, height = 4, echo = FALSE >>=
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"),"inches"),
+ convertHeight(unit(1,"npc"),"inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+
+x <- rnorm(20000)
+y <- rnorm(20000)
+hbin <- hexbin(x,y, xbins = 40, shape = shape)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y", newpage = FALSE)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = terrain.colors)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hbin, legend = 0, xlab = "X", ylab = "Y",
+ newpage = FALSE, colramp = BTY)
+popViewport()
+@
+
+The figure shows three examples of using hexagons in a plot for large $n$ with
+different color schemes. Upper left: the default gray scale, upper right: the
+R base \texttt{terrain.colors()}, and lower middle: \texttt{BTY()}, a
+blue to yellow color ramp supplied with hexbin on a perceptually linear
+scale.
+
+The hexbin package supplies a plotting method for the hexbin data
+structure. The plotting method \texttt{gplot.hexbin} accepts all the
+parameters for the hexagon function and supplies a legend as well, for
+easy interpretation of the plot. Figure~2 shows a hex binned plot with
+a legend. A function \texttt{grid.hexlegend} is supplied for creating user
+specified hexagon legends.
+
+\section{Extended Hexagon Functions}
+So far we have looked at the basic hexagon plot. The hexbin package
+supplies several extensions to the basic hexbin, and the associated
+hexplot. The extensions discussed in this section will be smoothing
+hexbin objects using the hsmooth function, approximating a bivariate
+median with hexagons and a version of a bivariate boxplot, and using
+eroded hexbin objects to look at the overlap of two bivariate populations.
+
+\subsection{Smoothing with \texttt{hsmooth}}
+At this point the hexbin package only provides a single option for
+smoothing using a discrete kernel. Several improvements are in
+development including an apply function over neighborhoods and spline
+functions using a hexagonal basis or tensor products. The apply
+function should facilitate constructing more sophisticated kernel
+smoothers. The hexagon splines will provide an alternative to
+smoothing on a square grid and allow interpolation of hexagons to
+finer grids.
+
+The current implementation uses the center cell, immediate
+neighbors and second neighbors to smooth the counts. The counts for
+each resulting cell is a linear combination of the counts in the
+defined neighborhood, including the center cell and weights. The
+counts are blurred over the the domain, and the domain increases
+because of shifting. Generally the dimension of the occupied cells of
+the lattice increases by one, sometimes two.
+
+Some examples of using the hsmooth function are given below. Notice in
+the plots that the first plot is with no smoothing, weights are
+\texttt{c(1,0,0)} meaning that only the center cell is used with
+identity weights. The second plot shows a first order kernel using
+weights \texttt{c(24,12,0)}, while the third plot uses weights for
+first and second order neighbors specified as \texttt{c(48,24,12)}.
+The code segment generating these plots rescales the smoothed counts
+so that they are on the original scale.
+
+<< showsmth, fig = TRUE, width = 8, height = 4, echo = FALSE >>=
+#nf <- layout(matrix(c(1,1,2,2,4,3,3,4), ncol=4, nrow=2, byrow=TRUE),
+# widths = rep(1,4), heights=rep(1,2))
+x <- rnorm(10000)
+y <- rnorm(10000)
+grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+ convertHeight(unit(1,"npc"), "inches"))
+shape <- optShape(height = vpin[2],width = vpin[1]/3,mar = mai)
+hbin <- hexbin(x,y, xbins = 30,shape = shape)
+hsmbin1 <- hsmooth(hbin, c( 1, 0,0))
+hsmbin2 <- hsmooth(hbin, c(24,12,0))
+hsmbin2 at count <- as.integer(ceiling(hsmbin2 at count/sum(hsmbin2 at wts)))
+hsmbin3 <- hsmooth(hbin,c(48,24,12))
+hsmbin3 at count <- as.integer(ceiling(hsmbin3 at count/sum(hsmbin3 at wts)))
+pushViewport(viewport(layout = grid.layout(1, 3)))
+pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
+plot(hsmbin1, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+plot(hsmbin2, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+pushViewport(viewport(layout.pos.col = 3,layout.pos.row = 1))
+plot(hsmbin3, legend = 0, xlab = "X", ylab = "Y", newpage= FALSE,colramp = BTY)
+popViewport()
+@
+\subsection{Bin Erosion and the \texttt{hboxplot}}
+The next tool to introduce, gray level erosion, extends the idea of
+the boxplot. The idea is to extract cells in a way that the most
+exposed cells are removed first, ie cells with fewer neighbors, but
+cells with lower counts are removed preferentially to cells with
+higher counts. The algorithm works as follows:
+Mark the high count cells containing a given fraction, cdfcut, of
+the total counts. Mark all the cells if cdfcut is zero.
+The algorithm then performs gray-level erosion on the
+marked cells. Each erosion cycle removes counts from cells. The
+counts removed from each cell are a multiple of the cell's exposed-face
+count. The algorithm chooses the multiple so at least one cell will be
+empty or have a count deficit on each erosion cycle. The erode vector
+contains an erosion number for each cell. The value of erode is
+
+\begin{center}
+ $6\times$(The erosion cycle at cell removal) $ - $
+ (The cell deficit at removal)
+\end{center}
+
+The cell with the highest erosion number is a candidate bivariate
+median. A few ties in the erosion order are common.
+
+The notion of an ordering to the median is nice because it allows us
+to create a version of a bivariate box plot built on hexagons. The
+following example comes from a portion of the ''National Health and Nutrition
+Examination Survey'' included in \texttt{hexbin} as the sample data
+set NHANES. The data consist of 9575 persons and mesures various
+clinical factors. Here in Figure~\ref{hbox} we show the levels of
+transferin, a measure of iron binding against hemoglobin for all
+
+\begin{figure}[h]
+ \centering
+
+<< echo = FALSE >>=
+data(NHANES)
+#grid.newpage()
+mar <- unit(0.1 + c(5,4,4,2),"lines")
+mai <- as.numeric(convertUnit(mar, "inches"))
+#vpin <- c(convertWidth (unit(1,"npc"), "inches"),
+# convertHeight(unit(1,"npc"), "inches"))
+vpin <- c(unit(6,"inches"),unit(4, "inches"))
+shape <- optShape(height = vpin[2], width = vpin[1], mar = mai)
+@
+
+<< hbox, fig = TRUE, width = 6, height = 4, echo = FALSE >>=
+hb <- hexbin(NHANES$Transferin, NHANES$Hemoglobin, shape = shape)
+hbhp <- hboxplot(erode(hb,cdfcut = .05),unzoom = 1.3)
+pushHexport(hbhp,clip = 'on')
+hexGraphPaper(hb,fill.edges = 3)
+popViewport()
+@
+\caption{Hexagon "boxplots" showing the top 95 percent of the data for
+ males and females. The red hexagons are an estimate of the bivariate median.}
+\label{hbox}
+\end{figure}
+
+Note that we have added ``hexagon graph paper'' to the plot. This can
+be done for any hexbin plot, using the command
+\texttt{hexGraphPaper()} where the main argument is the hexbin object.
+
+\subsection{Comparing Distributions and the \texttt{hdiffplot}}
+With univariate data, if there are multiple groups, one often uses a
+density estimate to overlay densities, and compare two or more
+distributions. The hdiffplot is the bivariate analog. The idea behind
+the hdiff plot is to plot one or more bin objects representing
+multiple groups to compare the distributions. The following example
+uses the National Health data supplied in the hexbin package,
+(\texttt{NHANES}). Below we show a comparison of males and females,
+the bivariate relationship is transferin, which is a derived measure
+of the ability of blood to bind oxygen, vs the level of hemoglobin.
+Note that in the call to \texttt{hdiffplot} we erode the bins to
+calculate the bivariate medians, and only display the upper 75\% of
+the data.
+\begin{figure}[h]
+ \centering
+<< hdiff, fig = TRUE, width = 6, height = 4, echo = TRUE >>=
+#grid.newpage()
+shape <- optShape(height = vpin[2],width = vpin[1],mar = mai)
+xbnds <- range(NHANES$Transferin,na.rm = TRUE)
+ybnds <- range(NHANES$Hemoglobin,na.rm = TRUE)
+hbF <- hexbin(NHANES$Transferin[NHANES$Sex == "F"],
+ NHANES$Hemoglobin[NHANES$Sex == "F"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+hbM <- hexbin(NHANES$Transferin[NHANES$Sex == "M"],
+ NHANES$Hemoglobin[NHANES$Sex == "M"],
+ xbnds = xbnds, ybnds = ybnds, shape = shape)
+#plot.new()
+hdiffplot(erode(hbF,cdfcut = .25),erode(hbM,cdfcut = .25),unzoom = 1.3)
+@
+\caption{A difference plot of transferin vs hemoglobin for males and females.}
+\label{hdiffplot}
+\end{figure}
+
+
+
+\subsection{Plotting a Third Concomitant Variable}
+In many cases, such as with spatial data, one may want to plot the
+levels of a third variable in each hexagon. The grid.hexagons function
+has a pair of arguments, \texttt{use.count} and \texttt{cell.at}. If
+\texttt{use.count = FALSE} and \texttt{cell.at} is a numeric vector of
+the same length as \texttt{hexbin at count} then the attribute vector
+will be used instead of the counts. \texttt{hexTapply} will
+summarize values for each hexagon according to the supplied function
+and return the table in the right order to use as an attribute
+vector. Another alternative is to set the \texttt{cAtt} slot of the
+hexbin object and grid.hexagons will automatically plot the attribute
+if \texttt{use.count = FALSE} and \texttt{cell.at = NULL}.
+
+Here is an example using spatial data. Often cartographers use
+graduated symbols to display varying numerical quantities across a region.
+
+
+
+\section{Example: cDNA Chip Normalization}
+This example is taken from the marray package, which
+supplies methods and classes for the normalization and diagnostic
+plots of cDNA microarrays. In this example the goal is not to make any
+comments about the normalization methodology, but rather to show how
+the diagnostic plots can be enhanced using hexagon binning due to the
+large number of points ($n = 8,448$ cDNA probes per chip).
+
+We look at the diagnostic plot $M$ vs $A$, where $M$ is the
+log--ratio, $M = \log <- 2 \frac{R}{G}$ and $A$ is the overall intensity,
+$A = \log <- 2\sqrt{RG}$. Figure~3 shows the plot using points and on the
+right hexagons. The hexagon binned plot shows that most of the pairs
+are well below zero, and that the overall shape is more like a comet
+with most of the mass at the bottom of the curve, rather than a thick
+bar of points curving below the line.
+
+<< marray1, fig = TRUE, results = hide >>=
+### Need to redo this part.
+library("marray")
+data(swirl, package = "marray") ## use swirl dataset
+
+hb1 <- hexbin(maA(swirl[,1]), maM(swirl[,1]), xbins = 40)
+grid.newpage()
+pushViewport(viewport(layout = grid.layout(1, 2)))
+
+pushViewport(viewport(layout.pos.col = 1,layout.pos.row = 1))
+nb <- plot(hb1, type = 'n', xlab = 'A', ylab = 'M',
+ main = "M vs A plot with points", legend = 0, newpage = FALSE)
+pushHexport(nb$plot.vp)
+grid.points(maA(swirl[,1]), maM(swirl[,1]),pch = 16,gp = gpar(cex = .4))
+popViewport()
+nb$hbin <- hb1
+hexVP.abline(nb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(nb)
+popViewport()
+
+pushViewport(viewport(layout.pos.col = 2,layout.pos.row = 1))
+hb <- plotMAhex(swirl[,1], newpage = FALSE,
+ main = "M vs A plot with hexagons", legend = 0)
+hexVP.abline(hb$plot.vp,h = 0,col = gray(.6))
+hexMA.loess(hb)
+popViewport()
+@
+
+
+
+\section{Manipulating Hexbins}
+The underlying functions for hexbin have been rewritten and now depend
+on the grid graphics system. The support unit for all hexagon plots is
+the hexViewport. The function \texttt{hexViewport()} takes a hexbin
+object as input and creates a viewport scaled to the current device or
+viewport so that the aspect ratio is scaled appropriately for the
+hexagons. Unlike in the base graphic functions where the aspect ratio
+is maintained by shifting the range of the axes, here the extra space
+is shifted into the margins. Currently hexViewport returns a
+hexViewport object that has information on the margins and
+its own pushViewport method. In the next example we will 1st show how
+to manipulate an existing plot using grid commands and second show how to
+create a custom plotting function using \texttt{hexViewport} and grid.
+
+\subsection{Adding to an existing plot}
+Adding to an existing plot requires the use of grid
+functions. For instance, in the following code,
+<< addto,fig = TRUE,echo = TRUE >>=
+hplt <- plot(hb1,style = 'centroid',border = gray(.65))
+pushHexport(hplt$plot.vp)
+ll.fit <- loess(hb1 at ycm ~ hb1 at xcm, weights = hb1 at count, span = .4)
+pseq <- seq(hb1 at xbnds[1]+1, hb1 at xbnds[2]-1, length = 100)
+grid.lines(pseq, predict(ll.fit,pseq),
+ gp = gpar(col = 2), default.units = "native")
+@
+we have to use \texttt{grid.lines()}, as opposed to \texttt{lines()}.
+
+
+\end{document}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-hexbin.git
More information about the debian-med-commit
mailing list