Find most distant point all other points in R

Question

I'm having trouble finding a solution to this simple problem. I have been searching the forums and altought I have gotten closer to an answer this is not exactly what I need.

I'm trying to find from a set of x,y points which point is the furthest away from any other points i.e. not the maximum distance between points, but the one furthest from the rest.

I've tried

x <-c(x1,x2,x3....)
y <-c(y1,y2,y3...)
dist(cbind(x,y))

Which gives me a matrix of the distance between each point to each point. I can interrogate the data in MS Excel and find the answer. Find the minimum values in each column, then the maximum number across them.

If I were to plot the data, I would like to have as output the distance of either the red or blue line (depending on which is longer).

Answer 1

Starting from this example data set:

set.seed(100)
x <- rnorm(150)
y <- rnorm(150)
coord <- cbind(x,y)
dobj <- dist(coord)

Now dobj is a distance object, but you can't examine that directly. You'll have to convert that to a matrix first, and make sure you don't take zero distances between a point and itself into account:

dmat <- as.matrix(dobj)
diag(dmat) <- NA

The latter line replaces the diagonal values in the distance matrix with NA.

Now you can use the solution of amonk:

dmax <- max(apply(dmat,2,min,na.rm=TRUE))

This gives you the maximum distance to the nearest point. If you want to know which points these are, you can take an extra step :

which(dmat == dmax, arr.ind = TRUE)
#     row col
# 130 130  59
# 59   59 130

So point 130 and 59 are the two points fulfilling your conditions. Plotting this gives you:

id <- which(dmat == dmax, arr.ind = TRUE) 
plot(coord)
lines(coord[id[1,],], col = 'red')

Note how you get this info twice, as euclidean distances between two points are symmetric (A -> B is as long as B -> A ).

Answer 2

It looks like to me, that you have spatial points in some projection. One could argue, that the point furthest away from the rest, is the one which lies furthest from the center (the mean coordinates):

library(raster)

set.seed(21)

# create fake points
coords <- data.frame(x=sample(438000:443000,10),y=sample(6695000:6700000,10))

# calculate center
center <- matrix(colMeans(coords),ncol=2)

# red = center, magenta = furthest point (Nr.2)
plot(coords)

# furthest point #2
ix <- which.max(pointDistance(coords,center,lonlat = F))

points(center,col='red',pch='*',cex=3)
points(coords[ix,],col='magenta',pch='*',cex=3)

segments(coords[ix,1],coords[ix,2],center[1,1],center[1,2],col='magenta')

Answer 3

To find the points farthest from the rest of the points you could do something like this. I opted for the median distance as you said the point(s) farthest from the rest of the data. If you have a group of points very close to each other the median should remain robust to this.

There is probably also a way to do this with hierarchical clustering but it is escaping me at the moment.

set.seed(1234)
mat <- rbind(matrix(rnorm(100), ncol=2), c(-5,5), c(-5.25,4.75))
d <- dist(mat)
sort(apply(as.matrix(d), 1, median), decreasing = T)[1:5]
# 51       52       20       12        4 
# 6.828322 6.797696 3.264315 2.806263 2.470919 

Answer 4

I wrote up a handy little function you can use for picking from the largest of line distances. You can specify if you want the largest, second largest, and so forth with the n argument.

getBigSegment <- function(x, y, n = 1){
  a <- cbind(x,y)
  d <- as.matrix(dist(a, method = "euclidean"))
  sorted <- order(d, decreasing = T)
  sub <- (1:length(d))[as.logical(1:length(sorted) %% 2)]
  s <- which(d == d[sorted[sub][n]], arr.ind = T)
  t(cbind(a[s[1],], a[s[2],]))
}

With some example data similar to your own you can see:

set.seed(100)
mydata <- data.frame(x = runif(10, 438000, 445000) + rpois(10, 440000), 
                     y = runif(10, 6695000, 6699000) + rpois(10, 6996000))

# The function
getBigSegment(mydata$x, mydata$y)
#            x        y
#[1,] 883552.8 13699108
#[2,] 881338.8 13688458    

Below you can visualize how I would use such a function

# easy plotting function
pointsegments <- function(z, ...) {
  segments(z[1,1], z[1,2], z[2,1], z[2,2], ...)
  points(z, pch = 16, col = c("blue", "red"))

}

plot(mydata$x, mydata$y) # points
top3 <- lapply(1:3, getBigSegment, x = mydata$x, y = mydata$y) # top3 longest lines
mycolors <- c("black","blue","green") # 3 colors
for(i in 1:3) pointsegments(top3[[i]], col = mycolors[i]) # plot lines
legend("topleft", legend = round(unlist(lapply(top3, dist))), lty = 1,
       col = mycolors, text.col = mycolors, cex = .8) # legend