earcut_r.R

## numbers to json
toj <- function(x) {
  sprintf("[%s]", paste(x, collapse = ", "))
}
## x,y numbers to json
tojxy <- function(x, y) {
  sprintf("[%s]", paste(paste(x, y, sep = ","), collapse = ", "))
}
## run earcut
get_tri <- function(x, y, holes = NULL) {
  if (is.null(holes)) {
    ct$eval(sprintf("var triangles = earcut(%s);", tojxy(x, y)))
    
  } else {
    ct$eval(sprintf("var triangles = earcut(%s, %s);", tojxy(x, y), toj(holes)))
    
  }
  ct$get("triangles") + 1L
}

plot_tri <- function(x, y, tri, ...) {
  xy <- cbind(x, y)
  plot(xy, pch = ".")
  apply(matrix(tri, nrow = 3), 2, function(a) polygon(xy[a, ], ...))
}

library(V8)
ct <- v8()
## load up the bunde
## see here for preparation: https://github.com/hypertidy/rearcut/issues/1
ct$source("earcutbundle.js")

## [1] "function s(o,u){if(!n[o]){if(!t[o]){var a=typeof require==\"function\"&&require;if(!u&&a)return a(o,!0);if(i)return i(o,!0);var f=new Error(\"Cannot find module '\"+o+\"'\");throw f.code=\"MODULE_NOT_FOUND\",f}var l=n[o]={exports:{}};t[o][0].call(l.exports,function(e){var n=t[o][1][e];return s(n?n:e)},l,l.exports,e,t,n,r)}return n[o].exports}"

## run this just to see that we have earcut
ct$get(JS('Object.keys(global)'))

##  [1] "console"      "print"        "global"       "ArrayBuffer" 
##  [5] "Int8Array"    "Uint8Array"   "Int16Array"   "Uint16Array" 
##  [9] "Int32Array"   "Uint32Array"  "Float32Array" "Float64Array"
## [13] "DataView"     "earcut"

library(silicate)
p <- PATH(minimal_mesh)
library(sf)

## Linking to GEOS 3.5.1, GDAL 2.2.2, proj.4 4.9.2

polygon <- st_cast(subset(inlandwaters, Province == "Tasmania"), "POLYGON")[2, ]

## Warning in st_cast.sf(subset(inlandwaters, Province == "Tasmania"),
## "POLYGON"): repeating attributes for all sub-geometries for which they may
## not be constant

p <- PATH(polygon)
p$path$hole <- duplicated(p$path$object)
tri <- unlist(lapply(split(p$path, p$path$object_), function(apath) {
  x <- dplyr::inner_join(apath, p$path_link_vertex, "path_") %>% 
    dplyr::inner_join(p$vertex, "vertex_") %>% dplyr::select(x_, y_, vertex_, path_)
  x <- x[!duplicated(x["vertex_"]), ]
  holes <- which(abs(diff(as.integer(factor(x$path_)))) > 0)
  idx <- get_tri(x$x_, x$y_, holes)
  
  out <- match(x$vertex_[idx], p$vertex$vertex_)
  out
}))
plot_tri(p$vertex$x_, p$vertex$y_, tri, col = "grey")

## NULL