<!-- README.md is generated from README.Rmd. Please edit that file -->

rvoronoi

<!-- badges: start -->

<!-- badges: end -->

rvoronoi provides fast Delaunay triangulation and Voronoi tessellation using Fortune’s Sweep Line Algorithm.

A key benefit of this package (besides speed!) is that the Voronoi tesselation can return a full set of enclosed polygons matched to the input sites. This makes it convenient for plotting.

The core of this package is Steven Fortune’s original C source code for his sweep algorithm. This code has been updated and adapted to run within R. Original source code (packaged as a shell archive)

For small sets of site (e.g. 20 points) this package can be 10x faster than RTriangle package. For larger sets of sites, the gap closes up - e.g. for N = 1000, still 2x faster than RTriangle package.

Installation

You can install from GitHub with:

# install.packages('remotes')
remotes::install_github('coolbutuseless/rvoronoi')

In fair Voronoi, where we lay our scene

A Voronoi tessellation of a scene from 1996 movie Romeo + Juliet

library(nara)
library(grid)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Load image
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rj <- jpeg::readJPEG("man/figures/rj.jpg", native = TRUE)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Sample lots of random points in the image
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
set.seed(5)
N <- 4000
x <- (runif(N, 1, ncol(rj))) 
y <- (runif(N, 1, nrow(rj))) 

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Extract the colour at each pointt
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ind  <- round(y) * ncol(rj) + round(x)
cols <- rj[ind]
cols <- nara::packed_cols_to_hex_cols(cols)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Calculate the Voronoi
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
vor <- voronoi(as.double(x), as.double(y))

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Plot all Voronoi polygons in their appropriate colour
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
nr <- nara::nr_new(ncol(rj), nrow(rj))
nr_polygon(nr, x = vor$polygons$coords$x, y = vor$polygons$coords$y,
           id = vor$polygons$coords$idx, fill = cols)
grid.raster(nr)

<img src="man/figures/README-romeo-1.png" width="100%" />

Voronoi Terminology

• Initial sites (i.e. seed points)
• Fortune’s algorithm returns
  • vertices
  • segments (finite, semi-finite and infinite)
• This package reconstructs polygons (i.e. Voronoi cells) by assembling the segments into polygons, and bounding any exterior cells by intersecting with a rectangular boundary

Voronoi Tessellation feature comparison

| Package | rvoronoi | deldir | RTriangle | |---------------------------|----------|--------|-----------| | vertices | Yes | Yes | Yes | | segments | Yes | Yes | Yes | | interior polygons | Yes | Yes | | | bounded exterior polygons | Yes | Yes | | | matched sites/polygons | Yes | ??? | |

Delaunay Triangulation feature comparison

| Package | rvoronoi | deldir | RTriangle | |----------------------------------|----------|--------|-----------| | site indices (defining polygons) | Yes | Yes | Yes | | polygon coordinates | Yes | | | | triangle areas | Yes | | | | segment lengths | Yes | | |

Voronoi Tessellation

The following code calculates the Voronoi tessellation on 20 random points.

library(rvoronoi)

set.seed(4)
x <- runif(20)
y <- runif(20)

vor <- voronoi(x, y) 

plot(vor, polys = FALSE, sites = TRUE, labels = TRUE, label_cex = 0.7)

<img src="man/figures/README-voronoi-1.png" width="100%" />

plot(vor, labels = TRUE, label_cex = 0.7)

<img src="man/figures/README-voronoi-2.png" width="100%" />

library(ggplot2)

ggplot() + 
  geom_polygon(data = vor$polygons$coords, 
               aes(x, y, group = idx, fill = as.factor(idx)), 
               col = 'black') +
  theme_void() + 
  coord_equal(xlim = c(-0.2, 1.2), ylim = c(-0.2, 1.2)) +
  theme(
    legend.position = 'none'
  )

<img src="man/figures/README-unnamed-chunk-2-1.png" width="100%" />

Delaunay Triangulation

library(rvoronoi)

set.seed(2024)
x <- runif(10)
y <- runif(10)

del <- delaunay(x, y)

plot(del)

<img src="man/figures/README-delaunay-1.png" width="100%" />

Delaunay Benchmark

Compare Delaunay Triangulation using

• {rvoronoi}
• {delone}
  • remotes::install_github("hypertidy/delone")
• {RTriangle}
• {deldir}

<details> <summary>

Delaunay Triangulation Benchmark

</summary>

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Delaunay
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
library(rvoronoi)
# library(delone)
library(RTriangle)
library(deldir)
#> deldir 2.0-4      Nickname: "Idol Comparison"
#> 
#>      The syntax of deldir() has changed since version 
#>      0.0-10.  Read the help!!!.
#> deldir 2.0-4      Nickname: "Idol Comparison"
#> 
#>      The syntax of deldir() has changed since version 
#>      0.0-10.  Read the help!!!.

set.seed(1)
N <- 1000
x <- runif(N)
y <- runif(N)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# {rvoronoi}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
del_rvoronoi <- rvoronoi::delaunay(x, y)$tris

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# {delone} - normalise to 
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# del_delone <- delone::xy_tri(x, y)
# del_delone <- matrix(del_delone, ncol = 3, byrow = TRUE) |> as.data.frame()
# 
# stopifnot(identical(
#   rvoronoi:::normalise_del(del_rvoronoi),
#   rvoronoi:::normalise_del(del_delone)
# ))

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# RTriangle
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
del_rtriangle <- RTriangle::triangulate(RTriangle::pslg(cbind(x, y)))$T
del_rtriangle <- as.data.frame(del_rtriangle)

stopifnot(identical(
  rvoronoi:::normalise_del(del_rvoronoi),
  rvoronoi:::normalise_del(del_rtriangle)
))


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# deldir
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
del_deldir <- deldir::deldir(x, y)
del_deldir <- deldir::triMat(del_deldir)
del_deldir <- as.data.frame(del_deldir)

stopifnot(identical(
  rvoronoi:::normalise_del(del_rvoronoi),
  rvoronoi:::normalise_del(del_deldir)
))

</details>

bench::mark(
  # delone    = xy_tri  (x, y),
  rvoronoi  = delaunay(x, y, calc_polygons = TRUE),
  rvoronoi  = delaunay(x, y, calc_polygons = FALSE),
  rvoronoi  = delaunay(x, y, calc_polygons = FALSE, calc_areas = TRUE),
  rvoronoi  = delaunay(x, y, calc_polygons = FALSE, calc_segments = TRUE),
  rtriangle = triangulate(pslg(cbind(x, y))),
  deldir    = deldir(x, y),
  check = FALSE
)[,1:5]  |> knitr::kable()

| expression | min | median | itr/sec | mem_alloc | |:-----------|--------:|--------:|-----------:|----------:| | rvoronoi | 397.9µs | 413.6µs | 2397.09618 | 162.78KB | | rvoronoi | 385.9µs | 396.2µs | 2499.56380 | 23.58KB | | rvoronoi | 392µs | 400.1µs | 2475.19530 | 39.07KB | | rvoronoi | 743.4µs | 768.9µs | 1293.61878 | 163.41KB | | rtriangle | 725.9µs | 763.2µs | 1278.59166 | 292.63KB | | deldir | 16.8ms | 17.1ms | 58.32546 | 5.67MB |

Voronoi Tessellation Benchmark

Compare:

• {rvoronoi}
• {deldir}
• {RTriangle}

<details> <summary>

Voronoi Tessellation Benchmark

</summary>

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Voronoi
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
library(rvoronoi)
library(deldir)
library(RTriangle)

set.seed(1)
N <- 1000
x <- runif(N)
y <- runif(N)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# rvoronoi
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
vor_rvoronoi <- rvoronoi::voronoi(x, y)

if (FALSE) {
  plot(x, y, asp = 1, ann = F, axes = F, pch = '.')
  for (p in vor_rvoronoi$polygons) {
    polygon(p)
  }
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# deldir
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
vor_deldir   <- deldir::cvt(deldir::deldir(x, y), stopcrit = 'maxit', maxit = 1, verb = TRUE)

if (FALSE) {
  plot(x, y, asp = 1, ann = F, axes = F, pch = '.')
  for (p in vor_deldir$tiles) {
    polygon(p)
  }
}

if (FALSE) {
  plot(vor_deldir$tiles)
}
  
if (FALSE) {
  set.seed(42)
  x <- runif(20)
  y <- runif(20)
  dxy <- deldir(x,y,rw=c(0,1,0,1))
  cxy1 <- cvt(dxy,verb=TRUE, stopcrit = 'maxit', maxit = 1)
  plot(cxy1$tiles)
  with(cxy1$centroids,points(x,y,pch=20,