davidcsterratt / RTriangle

Port of the Triangle Two-Dimensional Quality Mesh Generator and Delaunay Triangulator to R
https://cran.r-project.org/package=RTriangle
9 stars 4 forks source link

potential anyDuplicated speed-up for pslg #7

Closed mdsumner closed 1 year ago

mdsumner commented 6 years ago

anyDuplicated.matrix is quite slow, as it uses apply(), which means pslg is a fair bit slower than the actual triangulate call. There's a substantial speed up in using the .data.frame method rather than .matrix, as in pslg2 below.

I think there are faster ways still to speed this up, and while it's easy enough to construct the pslg manually with my own validations, this might be a useful modification - thanks!

library(RTriangle)
set.seed(98)
xy <- matrix(rnorm(1e6), ncol = 2)
system.time(sl1 <- pslg(xy))  # 10s
system.time(sl2 <- pslg2(xy))  # 3s

system.time(triangulate(sl1)) # 2s

## simple modification for anyDuplicated at 1.
pslg2 <- 
function (P, PB = NA, PA = NA, S = NA, SB = NA, H = NA) {
  P <- as.matrix(P)
  PB <- as.integer(PB)
  PA <- as.matrix(PA)
  S <- as.matrix(S)
  SB <- as.integer(SB)
  H <- as.matrix(H)
  check.na.nan <- function(x) {
    if (!is.null(x)) {
      if (any(is.nan(x))) {
        stop(paste("NaN in", deparse(substitute(x))))
      }
      if (any(is.na(x))) {
        stop(paste("NA in", deparse(substitute(x))))
      }
    }
  }
  check.na.nan(P)
  if (ncol(P) != 2) {
    stop("Matrix of vertices P should have 2 columns")
  }
## 1. modification, anyDuplicated(data.frame) rather than matrix
  if (anyDuplicated(as.data.frame(P))) {
    stop("Duplicated vertices in P.")
  }
  if (any(is.na(PA))) {
    PA <- matrix(0, nrow(P), 0)
  }
  if (nrow(PA) != nrow(P)) {
    stop("Point attribute matrix PA does not have same number of rows the point matrix P")
  }
  if (is.na(PB)) {
    PB <- 0
  }
  PB <- rep(PB, length.out = nrow(P))
  if (any(is.na(S))) {
    S <- matrix(0, 0, 2)
  }
  else {
    if (ncol(S) != 2) {
      stop("Matrix of segments S should have 2 columns")
    }
  }
  if (any(is.na(SB))) {
    SB <- 0
  }
  SB <- rep(SB, length.out = nrow(S))
  if (any(is.na(H))) {
    H <- matrix(0, 0, 2)
  }
  else {
    if (ncol(H) != 2) {
      stop("Matrix of holes H should have 2 columns")
    }
  }
  storage.mode(P) <- "double"
  storage.mode(PA) <- "double"
  storage.mode(PB) <- "integer"
  storage.mode(S) <- "integer"
  storage.mode(SB) <- "integer"
  storage.mode(H) <- "double"
  ret <- list(P = P, PA = PA, PB = PB, S = S, SB = SB, H = H)
  class(ret) <- "pslg"
  return(ret)
}
davidcsterratt commented 6 years ago

Thanks for this suggestion. If you'd like to submit this via a pull request, making sure that RTriangle's tests are passed, I'll take a look at it. (I might take a look at it eventually, but the pull request would speed up matters.)

davidcsterratt commented 6 years ago

I've now tested the patch, also on my Retistruct revdep. Are there any other speed improvements you can think of before I submit to CRAN?

mdsumner commented 6 years ago

Possibly the use of anyNA for the missing value checks in triangulate(), but I haven't checked - nothing else obviously stands out .

Thanks!

davidcsterratt commented 1 year ago

This was submitted to CRAN on 2018-01-30, so closing the issue.