1# Copyright 2001-2019 by Nicholas Lewin-Koh and Roger Bivand 2# 3 4relativeneigh <- function(coords, nnmult=3) { 5 if (inherits(coords, "SpatialPoints")) { 6 if (!is.na(is.projected(coords)) && !is.projected(coords)) { 7 warning("relativeneigh: coordinates should be planar") 8 } 9 coords <- coordinates(coords) 10 } else if (inherits(coords, "sfc")) { 11 if (!inherits(coords, "sfc_POINT")) 12 stop("Point geometries required") 13 if (attr(coords, "n_empty") > 0L) 14 stop("Empty geometries found") 15 if (!is.na(sf::st_is_longlat(coords)) && sf::st_is_longlat(coords)) 16 warning("relativeneigh: coordinates should be planar") 17 coords <- sf::st_coordinates(coords) 18 } 19 x <- coords 20 if (!is.matrix(x)) stop("Data not in matrix form") 21 if (any(is.na(x))) stop("Data cannot include NAs") 22 np <- nrow(x) 23 if(ncol(x)!=2) stop("Only works in 2d") 24 ngaballoc <- np*nnmult 25 g1<-g2<-rep(0,ngaballoc) 26 nogab <- 0 27 storage.mode(x) <- "double" 28 z <- .C("compute_relative", np=as.integer(np), from=as.integer(g1), 29 to=as.integer(g2), nedges=as.integer(nogab), 30 ngaballoc=as.integer(ngaballoc), x=x[,1], 31 y=x[,2], PACKAGE="spdep") 32 z$from<-z$from[1:z$nedges] 33 z$to<-z$to[1:z$nedges] 34 attr(z, "call") <- match.call() 35 class(z)<-c("Graph","relative") 36 z 37} 38 39plot.relative<-function(x, show.points=FALSE, add=FALSE, linecol=par(col),...){ 40 if(!add) plot(x$x,x$y,type='n') 41 segments(x$x[x$from],x$y[x$from], 42 x$x[x$to],x$y[x$to],col=linecol) 43 if(show.points) points(x$x,x$y,...) 44} 45