Start adding some data grid functions

DESCRIPTION

@@ -43,3 +43,4 @@ Collate:
     'width.r'
     'h.r'
     'mt.r'
+    'dgrid.r'

NAMESPACE

@@ -1,13 +1,18 @@
+S3method("[",dgrid)
 S3method("[<-",ranged)
 S3method(Math,condensed)
 S3method(Ops,condensed)
 S3method(Ops,ranged)
 S3method(as.condensed,condensed)
 S3method(as.condensed,data.frame)
 S3method(as.data.frame,ranged)
+S3method(as.integer,dgrid)
+S3method(max,dgrid)
 S3method(max,ranged)
+S3method(min,dgrid)
 S3method(min,ranged)
 S3method(print,ranged)
+S3method(range,dgrid)
 S3method(range,ranged)
 S3method(str,ranged)
 S3method(transform,condensed)
@@ -18,11 +23,13 @@ export(bin)
 export(breaks)
 export(condense)
 export(dchallenge)
+export(dgrid)
 export(find_origin)
 export(find_width)
 export(frange)
 export(h_grid)
 export(is.condensed)
+export(is.dgrid)
 export(is.ranged)
 export(mt)
 export(peel)

R/condensed.r

@@ -35,9 +35,8 @@ condensed <- function(groups, grouped, summary) {
   summary <- as.data.frame(summary)
 
   for (i in seq_along(groups)) {
-    attr(grouped[[i]], "width") <- groups[[i]]$width()
-    attr(grouped[[i]], "origin") <- groups[[i]]$origin()
-    attr(grouped[[i]], "nbins") <- groups[[i]]$nbins()
+    grouped[[i]] <- dgrid(grouped[[i]],
+      groups[[i]]$width(), groups[[i]]$origin(), groups[[i]]$nbins())
   }
 
   names(summary) <- paste0(".", names(summary))

R/dgrid.r

@@ -0,0 +1,47 @@
+#' dgrid: an S3 class for data grids
+#'
+#' @param x a numeric vector to test or coerce.
+#' @param width bin width
+#' @param origin bin origins
+#' @param nbins number of bins
+#' @export
+#' @examples
+#' g <- dgrid(0:10 + 0.5, width = 1)
+#' range(g)
+#' as.integer(g)
+dgrid <- function(x, width, origin = 0, nbins = NULL) {
+  stopifnot(is.numeric(x))
+  stopifnot(is.numeric(width), length(width) == 1, width > 0)
+  stopifnot(is.numeric(origin), length(origin) == 1)
+
+  if (is.null(nbins)) {
+    nbins <- floor((max(x) - origin) / width)
+  }
+
+  structure(x, class = "dgrid",
+    width = width, origin = origin, nbins = nbins)
+}
+
+#' @export
+#' @rdname dgrid
+is.dgrid <- function(x) inherits(x, "dgrid")
+
+#' @S3method [ dgrid
+"[.dgrid" <- function(x, ...) {
+  dgrid(NextMethod(), width = attr(x, "width"),
+    origin = attr(x, "origin"), nbins = attr(x, "nbins"))
+}
+
+#' @S3method min dgrid
+min.dgrid <- function(x, ...) attr(x, "origin")
+#' @S3method max dgrid
+max.dgrid <- function(x, ...) {
+  min(x) + attr(x, "nbins") * attr(x, "width")
+}
+#' @S3method range dgrid
+range.dgrid <- function(x, ...) c(min(x), max(x))
+
+#' @S3method as.integer dgrid
+as.integer.dgrid <- function(x, ...) {
+  as.integer((unclass(x) - attr(x, "origin")) / attr(x, "width") + 1L)
+}

man/dgrid.Rd

@@ -0,0 +1,27 @@
+\name{dgrid}
+\alias{dgrid}
+\alias{is.dgrid}
+\title{dgrid: an S3 class for data grids}
+\usage{
+  dgrid(x, width, origin = 0, nbins = NULL)
+
+  is.dgrid(x)
+}
+\arguments{
+  \item{x}{a numeric vector to test or coerce.}
+
+  \item{width}{bin width}
+
+  \item{origin}{bin origins}
+
+  \item{nbins}{number of bins}
+}
+\description{
+  dgrid: an S3 class for data grids
+}
+\examples{
+g <- dgrid(0:10 + 0.5, width = 1)
+range(g)
+as.integer(g)
+}
+