nr_polygons() added.

.github/workflows/R-CMD-check.yaml

@@ -20,11 +20,11 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          # - {os: macos-latest,   r: 'release'}
-          # - {os: windows-latest, r: 'release'}
-          # - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: macos-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
-          # - {os: ubuntu-latest,   r: 'oldrel-1'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nara
 Type: Package
 Title: Native Raster Image Tools
-Version: 0.1.1.9023
+Version: 0.1.1.9024
 Authors@R: c(
     person("Mike", "Cheng", role = c("aut", "cre", 'cph'), email = "[email protected]")
     )

NAMESPACE

@@ -20,6 +20,7 @@ export(nr_line)
 export(nr_new)
 export(nr_point)
 export(nr_polygon)
+export(nr_polygons)
 export(nr_polyline)
 export(nr_rect)
 export(nr_replace)

NEWS.md

@@ -1,5 +1,5 @@
 
-# nara 0.1.1.9023 2024-08-18
+# nara 0.1.1.9024 2024-08-18
 
 * Remove 'isocubes()'
 * Remove 'op' argument. 
@@ -41,6 +41,7 @@
 * Parse image sequences from `magick` into nativeRaster
 * Export C functions for use in other packages via `LinkingTo`
     * draw points
+* Added `nr_polygons()`
 
 # nara 0.1.1 2022-07-30
 

R/nr-draw.R

@@ -178,6 +178,32 @@ nr_polygon <- function(nr, x, y, fill = 'black', color = NA) {
 }
 
 
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' Draw multiple polygon on a \code{nativeRaster} image
+#'
+#' @inheritParams nr_fill
+#' @inheritParams nr_point
+#' @param fill fill color 
+#' @param id integer vector used to separate coordinates into 
+#'        multiple polygons. Consecutive runs of the same \code{id}
+#'        value belong to the same polygon.  If NULL (the default) then 
+#'        all coordinates are assumed to be vertices of a single polygon.
+#' 
+#' @return Original \code{nativeRaster} modified in-place
+#'
+#' @examples
+#' N <- 20
+#' nr <- nr_new(N, N, 'grey80')
+#' nr_polygon(nr, x = c(0, N-1, 0), y = c(0, 0, N-1), fill = 'blue', color = 'red')
+#' plot(nr)
+#'
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+nr_polygons <- function(nr, x, y, id = NULL, fill = 'black', color = NA) {
+  invisible(.Call(nr_polygons_, nr, x, y, id = id, fill, color))
+}
+
+
 
 if (FALSE) {
 

src/init.c

@@ -54,6 +54,7 @@ extern SEXP nr_rect_    (SEXP nr_, SEXP x_ , SEXP y_ , SEXP w_, SEXP h_, SEXP fi
 extern SEXP nr_circle_  (SEXP nr_, SEXP x_ , SEXP y_ , SEXP r_         , SEXP fill_, SEXP color_);
 extern SEXP nr_polyline_(SEXP nr_, SEXP x_ , SEXP y_                               , SEXP color_, SEXP close_);
 extern SEXP nr_polygon_ (SEXP nr_, SEXP x_ , SEXP y_                   , SEXP fill_, SEXP color_);
+extern SEXP nr_polygons_(SEXP nr_, SEXP x_ , SEXP y_, SEXP id_         , SEXP fill_, SEXP color_);
 
 //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 // Color
@@ -94,6 +95,7 @@ static const R_CallMethodDef CEntries[] = {
   {"nr_circle_"    , (DL_FUNC) &nr_circle_    , 6},
   {"nr_polyline_"  , (DL_FUNC) &nr_polyline_  , 5},
   {"nr_polygon_"   , (DL_FUNC) &nr_polygon_   , 5},
+  {"nr_polygons_"  , (DL_FUNC) &nr_polygons_  , 6},
 
   {"colors_to_packed_cols_"   , (DL_FUNC) &colors_to_packed_cols_   , 1},
   {"packed_cols_to_hexcolors_", (DL_FUNC) &packed_cols_to_hexcolors_, 1},

src/nr-draw.c

@@ -695,7 +695,7 @@ SEXP nr_polygon_(SEXP nr_, SEXP x_, SEXP y_, SEXP fill_, SEXP color_) {
 
   int height = Rf_nrows(nr_);
   int width  = Rf_ncols(nr_);
-
+  
   uint32_t color = color_sexp_to_packed_col(color_);
   uint32_t fill   = color_sexp_to_packed_col(fill_);
 
@@ -720,3 +720,97 @@ SEXP nr_polygon_(SEXP nr_, SEXP x_, SEXP y_, SEXP fill_, SEXP color_) {
   return nr_;
 }
 
+
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+// R Polygon [R interface]
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+SEXP nr_polygons_(SEXP nr_, SEXP x_, SEXP y_, SEXP id_, SEXP fill_, SEXP color_) {
+
+  // Can we just do single polygon handling?
+  if (isNull(id_)) {
+    // Rprintf("Calling single\n");
+    return nr_polygon_(nr_, x_, y_, fill_, color_);
+  }
+  // Rprintf("Processing multiple\n");
+
+  // Unpack native raster
+  assert_nativeraster(nr_);
+  uint32_t *nr = (uint32_t *)INTEGER(nr_);
+  int height = Rf_nrows(nr_);
+  int width  = Rf_ncols(nr_);
+
+  // Sanity check
+  int N = length(x_);
+  if (length(y_) != N) {
+    error("Arguments 'x' and 'y' must be same length.");
+  }
+
+  if (length(id_) != N) {
+    error("Must supply 'id' arguments for all coordinates");
+  }
+
+  // Ensure 'id' is integer type for easier processing
+  bool freeid = false;
+  int *id = as_int32_vec(id_, N, &freeid);
+
+  // How many polygons are defined by 'id'?
+  int npolys = 1;
+  int last_id = id[0];
+  for (int i = 2; i < N; i++) {
+    if (id[i] != last_id) {
+      last_id = id[i];
+      npolys++;
+    }
+  }
+
+  // Rprintf("Number of polygons defined: %i\n", npolys);
+
+  // get an int* from a numeric from R
+  bool freex = false, freey = false;
+  int *x = as_int32_vec(x_, N, &freex);
+  int *y = as_int32_vec(y_, N, &freey);
+
+  // Colors
+  bool freecol = false, freefill = false;
+  uint32_t *color = colors_to_packed_cols(color_, npolys, &freecol);
+  uint32_t *fill  = colors_to_packed_cols(fill_ , npolys, &freefill);
+
+  int poly_id = id[0];
+  int poly_start = 0;
+  int poly_end = 1;
+  for (int i = 0; i < npolys - 1; i++) {
+
+    while ( id[poly_end] == poly_id ) {
+      poly_end++;
+    } 
+
+    int len = poly_end - poly_start;
+
+    // Rprintf("Fill [%i] = %i\n", i, fill[i]);
+    nr_polygon(nr, height, width, x + poly_start, y + poly_start, len, fill[i]);
+
+    poly_start = poly_end;
+    poly_id    = id[poly_start];
+    poly_end++;
+    // if (!is_transparent(color)) {
+    //   nr_polyline_(nr_, x_, y_, color_, ScalarLogical(1));
+    // }
+  }
+
+
+  // Final polygon
+  int len = N - poly_start;
+  // Rprintf("Final len: %i\n", len);
+  nr_polygon(nr, height, width, x + poly_start, y + poly_start, len, fill[npolys - 1]);
+
+
+
+
+  // free and return
+  if (freex)    free(x);
+  if (freey)    free(y);
+  if (freecol)  free(color);
+  if (freefill) free(fill);
+  return nr_;
+}
+

tests/testthat/test-multiple-polygons.R

@@ -0,0 +1,23 @@
+
+
+test_that("multiple polygons work", {
+
+  x <- c(0, 100, 100)
+  y <- c(0,   0, 100)
+
+  nr <- nr_new(100, 100)
+
+  expect_no_error(
+    nr_polygons(nr, x = x, y = y)
+  )
+
+  x <- c(0, 100, 100,   0,  0,  100,   25, 75, 75, 25)
+  y <- c(0,   0, 100,   0, 100, 100,   25, 25, 75, 75)
+  id <- c(1, 1, 1, 2, 2, 2, 8, 8, 8, 8)
+
+  nr <- nr_new(100, 100)
+
+  expect_no_error(
+    nr_polygons(nr, x = x, y = y, id = id, fill = c('grey20', 'blue', 'hotpink'))
+  )  
+})