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