x and y from col/row

Author: mdsumner

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: vaster
 Title: Tools for Raster Grid Logic 
-Version: 0.0.2.9002
+Version: 0.0.2.9003
 Authors@R: c(person("Michael", "Sumner", email = "mdsumner@gmail.com", 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 

NEWS.md

@@ -1,6 +1,7 @@
 # vaster dev
 
-* We now have internal functions `col_from_x_c()` and `row_from_y_c()` that use C under the hood, these currently return 0-based indexes. 
+* We now have internal functions `col_from_x_c()` and `row_from_y_c()`, `x_from_col_c()` and `y_from_row_c()` that use C under the hood, these currently accept and return 0-based indexes. 
+
 
 * Package now requires compilation, with the R C api. 
 

R/C_versions.R

@@ -4,3 +4,10 @@ row_from_y_c <- function(dimension, extent, y) {
 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")
 }
+
+x_from_col_c <- function(dimension, extent, col) {
+  .Call("x_from_col_", 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))
+}

src/coordinates.c

@@ -42,3 +42,31 @@ SEXP row_from_y_(SEXP nrow, SEXP ylim, SEXP py)
   return bin_from_float(nrow, ylim, py);
 
 }
+
+SEXP coord_from_bin(SEXP bins, SEXP range, SEXP index) {
+  int nn = LENGTH(index);
+  SEXP out;
+  out = PROTECT(Rf_allocVector(REALSXP, nn));
+
+  int nbins = INTEGER(bins)[0];
+  double res = (REAL(range)[1] - REAL(range)[0])/nbins;
+  double cmin = REAL(range)[0];
+  double* rout = REAL(out);
+  int* rindex = INTEGER(index);
+  for (int i = 0; i < nn; i++) {
+    if ((rindex[i] >= 0) && (rindex[i] < nbins)) {
+      rout[i] = cmin + res/2 + rindex[i] * res;
+    } else {
+      rout[i] = R_NaReal;
+    }
+  }
+  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);
+}

src/init.c

@@ -10,10 +10,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);
 
 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},
     {NULL, NULL, 0}
 };