simpler layering

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: vaster
 Title: Tools for Raster Grid Logic 
-Version: 0.0.2.9003
+Version: 0.0.2.9004
 Authors@R: c(person("Michael", "Sumner", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2471-7511")))
 Description: Provides raster grid logic, the grid operations that don't require access to materialized data, i.e. most of them. 
  Grids are arrays with dimension and extent, and many operations are functions of just the dimension 'nrows', 'ncols' or 

R/C_versions.R

@@ -1,13 +1,21 @@
 row_from_y_c <- function(dimension, extent, y) {
-  .Call("row_from_y_", as.integer(dimension[2L]), as.double(extent[3:4]), as.double(y), PACKAGE = "vaster")
+  .Call("index_from_coord_", as.integer(dimension[2L]), as.double(extent[3:4]), as.double(y), PACKAGE = "vaster")
 }
 col_from_x_c <- function(dimension, extent, x) {
-  .Call("col_from_x_", as.integer(dimension[1L]), as.double(extent[1:2]), as.double(x), PACKAGE = "vaster")
+  .Call("index_from_coord_", as.integer(dimension[1L]), as.double(extent[1:2]), as.double(x), PACKAGE = "vaster")
 }
 
 x_from_col_c <- function(dimension, extent, col) {
-  .Call("x_from_col_", as.integer(dimension[1L]), as.double(extent[1:2]), as.integer(col))
+  .Call("coord_from_index_", as.integer(dimension[1L]), as.double(extent[1:2]), as.integer(col))
 }
 y_from_row_c <- function(dimension, extent, row) {
-  .Call("y_from_row_", as.integer(dimension[2L]), as.double(extent[3:4]), as.integer(row))
+  .Call("coord_from_index_", as.integer(dimension[2L]), as.double(extent[3:4]), as.integer(row))
+}
+
+
+x_centre_c <- function(dimension, extent) {
+  .Call("coord_centre_", as.integer(dimension[1L]), as.double(extent[1:2]))
+}
+y_centre_c <- function(dimension, extent) {
+  .Call("coord_centre_", as.integer(dimension[2L]), as.double(extent[3:4]))
 }

R/coordinates.R

@@ -1,66 +1,4 @@
 
-
-#' Convert to long form coordinates
-#'
-#' Matrix of xyz values in raster order.
-#'
-#' Use 'raster_order = FALSE' for traditional R matrix x,y order
-#'
-#' @inheritParams grid
-#' @param data data values
-#' @param raster_order use raster order or native R matrix order
-#'
-#' @return matrix of coordinates x,y
-#' @export
-#'
-#' @examples
-#' vaster_long(c(10, 5), c(0, 10, 0, 5))
-#' # see https://gist.github.com/mdsumner/b844766f28910a3f87dc2c8a398a3a13
-vaster_long <- function(dimension, extent = NULL, data = NULL, raster_order = TRUE) {
-  extent <- extent %||% extent0(dimension)
-  .check_args(dimension, extent)
-
-    three <- if (length(dim(data)) == 3L) 3 else NULL
-    if (!is.null(data)) {
-      data <- aperm(data, c(2, 1, three))
-      data <- matrix(data, n_cell(dimension))
-    }
-    xyz <- cbind(xy_from_cell(dimension, extent = extent, seq_len(n_cell(dimension))), data)
-  if (!raster_order) {
-   xyz <- xyz[order(xyz[,2L], xyz[,1L]), ]
-  }
-  colnames(xyz) <- if (is.null(data)) c("x", "y") else  c("x", "y", "z")
-    xyz
-}
-
-#' Image xyz list
-#'
-#' Generate list of x and y rectilinear coordinates with z matrix.
-#'
-#' The rectilinear coordinates are degenerate (just a product of extent/dimension).
-#' @inheritParams grid
-#' @param data data values (length of the product of 'dimension')
-#'
-#' @return list with elementx x,y,z as per [graphics::image]
-#' @export
-#'
-#' @examples
-#' vaster_listxyz(c(10, 5), c(0, 10, 0, 5))
-#' ## see https://gist.github.com/mdsumner/b844766f28910a3f87dc2c8a398a3a13
-vaster_listxyz <- function(dimension, extent = NULL, data = NULL) {
-  extent <- extent %||% extent0(dimension)
-  .check_args(dimension, extent)
-
-  if (is.null(data)) {
-    data <- matrix(FALSE, dimension[2], dimension[1])
-  }
-  if (length(dim(data)) > 2) {
-    message("multi array not supported, this is trad image( ) format")
-    data <- data[,,1L]  ## should warn
-  }
-  list(x = x_from_col(dimension, extent = extent, seq_len(dimension[1])),
-           y = rev(y_from_row(dimension, extent = extent, seq_len(dimension[2]))), z = t(data[nrow(data):1, ]))
-}
 #' Coordinates
 #'
 #' Functions that work with coordinates.
@@ -208,6 +146,70 @@ xy <- function(dimension, extent = NULL) {
 }
 
 
+
+
+#' Convert to long form coordinates
+#'
+#' Matrix of xyz values in raster order.
+#'
+#' Use 'raster_order = FALSE' for traditional R matrix x,y order
+#'
+#' @inheritParams grid
+#' @param data data values
+#' @param raster_order use raster order or native R matrix order
+#'
+#' @return matrix of coordinates x,y
+#' @export
+#'
+#' @examples
+#' vaster_long(c(10, 5), c(0, 10, 0, 5))
+#' # see https://gist.github.com/mdsumner/b844766f28910a3f87dc2c8a398a3a13
+vaster_long <- function(dimension, extent = NULL, data = NULL, raster_order = TRUE) {
+  extent <- extent %||% extent0(dimension)
+  .check_args(dimension, extent)
+
+  three <- if (length(dim(data)) == 3L) 3 else NULL
+  if (!is.null(data)) {
+    data <- aperm(data, c(2, 1, three))
+    data <- matrix(data, n_cell(dimension))
+  }
+  xyz <- cbind(xy_from_cell(dimension, extent = extent, seq_len(n_cell(dimension))), data)
+  if (!raster_order) {
+    xyz <- xyz[order(xyz[,2L], xyz[,1L]), ]
+  }
+  colnames(xyz) <- if (is.null(data)) c("x", "y") else  c("x", "y", "z")
+  xyz
+}
+
+#' Image xyz list
+#'
+#' Generate list of x and y rectilinear coordinates with z matrix.
+#'
+#' The rectilinear coordinates are degenerate (just a product of extent/dimension).
+#' @inheritParams grid
+#' @param data data values (length of the product of 'dimension')
+#'
+#' @return list with elementx x,y,z as per [graphics::image]
+#' @export
+#'
+#' @examples
+#' vaster_listxyz(c(10, 5), c(0, 10, 0, 5))
+#' ## see https://gist.github.com/mdsumner/b844766f28910a3f87dc2c8a398a3a13
+vaster_listxyz <- function(dimension, extent = NULL, data = NULL) {
+  extent <- extent %||% extent0(dimension)
+  .check_args(dimension, extent)
+
+  if (is.null(data)) {
+    data <- matrix(FALSE, dimension[2], dimension[1])
+  }
+  if (length(dim(data)) > 2) {
+    message("multi array not supported, this is trad image( ) format")
+    data <- data[,,1L]  ## should warn
+  }
+  list(x = x_from_col(dimension, extent = extent, seq_len(dimension[1])),
+       y = rev(y_from_row(dimension, extent = extent, seq_len(dimension[2]))), z = t(data[nrow(data):1, ]))
+}
+
 #' Grid boundary in native resolution
 #'
 #' currently only return centre coords
@@ -224,3 +226,7 @@ vaster_boundary <- function(dimension, extent = NULL) {
             seq(n_cell(dimension) - dimension[1L] + 1, by = -dimension[1], length.out = dimension[2L]))
   xy_from_cell(dimension, extent, cell)
 }
+
+
+
+

src/coordinates.c

@@ -2,7 +2,9 @@
 # include <Rinternals.h>
 # include "vaster.h"
 
-SEXP bin_from_float(SEXP bins, SEXP range, SEXP coord) {
+SEXP index_from_coord_(SEXP bins, SEXP range, SEXP coord) {
+  check_size(bins);
+  check_range(range);
  int nn = LENGTH(coord);
   double scl = (REAL(range)[1] - REAL(range)[0])/INTEGER(bins)[0];
   SEXP out;
@@ -26,24 +28,11 @@ SEXP bin_from_float(SEXP bins, SEXP range, SEXP coord) {
   UNPROTECT(1);
   return out;
 }
-SEXP col_from_x_(SEXP ncol, SEXP xlim, SEXP px)
-{
-  check_size(ncol);
-  check_range(xlim);
 
- return bin_from_float(ncol, xlim, px);
-}
-SEXP row_from_y_(SEXP nrow, SEXP ylim, SEXP py)
-{
-  check_size(nrow);
-  check_range(ylim);
-
-
-  return bin_from_float(nrow, ylim, py);
-
-}
 
-SEXP coord_from_bin(SEXP bins, SEXP range, SEXP index) {
+SEXP coord_from_index_(SEXP bins, SEXP range, SEXP index) {
+  check_size(bins);
+  check_range(range);
   int nn = LENGTH(index);
   SEXP out;
   out = PROTECT(Rf_allocVector(REALSXP, nn));
@@ -63,10 +52,20 @@ SEXP coord_from_bin(SEXP bins, SEXP range, SEXP index) {
   UNPROTECT(1);
   return out;
 }
-SEXP x_from_col_(SEXP ncol, SEXP xlim, SEXP col) {
-  return coord_from_bin(ncol, xlim, col);
-}
 
-SEXP y_from_row_(SEXP nrow, SEXP ylim, SEXP row) {
-  return coord_from_bin(nrow, ylim, row);
+SEXP coord_centre_(SEXP bins, SEXP range) {
+  int nn = INTEGER(bins)[0];
+  SEXP out;
+  out = PROTECT(Rf_allocVector(REALSXP, nn));
+  double cmin = REAL(range)[0];
+  double scl = (REAL(range)[1] - cmin) / nn;
+  double* rout = REAL(out);
+  for (int i = 0; i < nn; i++) {
+      rout[i] = cmin + scl/2 + i * scl;
+  }
+  UNPROTECT(1);
+  return out;
 }
+
+
+

src/init.c

@@ -8,16 +8,14 @@
 */
 
 /* .Call calls */
-extern SEXP col_from_x_(SEXP, SEXP, SEXP);
-extern SEXP row_from_y_(SEXP, SEXP, SEXP);
-extern SEXP x_from_col_(SEXP, SEXP, SEXP);
-extern SEXP y_from_row_(SEXP, SEXP, SEXP);
+extern SEXP coord_centre_(SEXP, SEXP);
+extern SEXP coord_from_index_(SEXP, SEXP, SEXP);
+extern SEXP index_from_coord_(SEXP, SEXP, SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
-    {"col_from_x_", (DL_FUNC) &col_from_x_, 3},
-    {"row_from_y_", (DL_FUNC) &row_from_y_, 3},
-    {"x_from_col_", (DL_FUNC) &x_from_col_, 3},
-    {"y_from_row_", (DL_FUNC) &y_from_row_, 3},
+    {"coord_centre_",     (DL_FUNC) &coord_centre_,     2},
+    {"coord_from_index_", (DL_FUNC) &coord_from_index_, 3},
+    {"index_from_coord_", (DL_FUNC) &index_from_coord_, 3},
     {NULL, NULL, 0}
 };
 

src/vaster.h

@@ -6,3 +6,6 @@ void check_dimension(SEXP);
 SEXP row_from_y_(SEXP, SEXP, SEXP);
 SEXP col_from_x_(SEXP, SEXP, SEXP);
 SEXP bin_from_float(SEXP, SEXP, SEXP);
+
+SEXP x_centre_(SEXP, SEXP);
+SEXP y_centre_(SEXP, SEXP);