chull()
returns the ordered indices of the matrix rows corresponding to corners of the convex hull.
set.seed(123)
matrix(rnorm(24, 100, 15), ncol=2)
xy <- chull(xy) hullIdx <-
plot(xy, xlab="x", ylab="y", asp=1, type="n")
polygon(xy[hullIdx, ], border="blue", lwd=2)
points(xy, pch=16, cex=1.5)
function(xy) {
getBoundingBox <-stopifnot(is.matrix(xy), is.numeric(xy), ncol(xy) == 2)
range(xy[ , 1])
x <- range(xy[ , 2])
y <- c(xleft=x[1], ybottom=y[1], xright=x[2], ytop=y[2])
pts <-return(list(pts=pts, width=abs(diff(x)), height=abs(diff(y))))
}
getBoundingBox(xy)
bb <-plot(xy, xlab="x", ylab="y", asp=1, type="n")
rect(bb$pts[1], bb$pts[2], bb$pts[3], bb$pts[4], border="blue", lwd="2")
points(xy, pch=16, cex=1.5)
$width * bb$height bb
[1] 2516.849
function(xy) {
getMinBBox <-stopifnot(is.matrix(xy), is.numeric(xy), nrow(xy) >= 2, ncol(xy) == 2)
## rotating calipers algorithm using the convex hull
chull(xy) # hull indices, vertices ordered clockwise
H <- length(H) # number of hull vertices
n <- xy[H, ] # hull vertices
hull <-
## unit basis vectors for all subspaces spanned by the hull edges
diff(rbind(hull, hull[1,])) # account for circular hull vertices
hDir <- sqrt(rowSums(hDir^2)) # length of basis vectors
hLens <- diag(1/hLens) %*% hDir # scaled to unit length
huDir <-
## unit basis vectors for the orthogonal subspaces
## rotation by 90 deg -> y' = x, x' = -y
cbind(-huDir[ , 2], huDir[ , 1])
ouDir <-
## project hull vertices on the subspaces spanned by the hull edges, and on
## the subspaces spanned by their orthogonal complements - in subspace coords
rbind(huDir, ouDir) %*% t(hull)
projMat <-
## range of projections and corresponding width/height of bounding rectangle
matrix(numeric(n*2), ncol=2) # hull edge
rangeH <- matrix(numeric(n*2), ncol=2) # orth subspace
rangeO <- numeric(n)
widths <- numeric(n)
heights <-for(i in seq(along=H)) {
range(projMat[ i, ])
rangeH[i, ] <- range(projMat[n+i, ]) # orth subspace is in 2nd half
rangeO[i, ] <- abs(diff(rangeH[i, ]))
widths[i] <- abs(diff(rangeO[i, ]))
heights[i] <-
}
## extreme projections for min-area rect in subspace coordinates
which.min(widths*heights) # hull edge leading to minimum-area
eMin <- rbind( rangeH[eMin, ], 0)
hProj <- rbind(0, rangeO[eMin, ])
oProj <-
## move projections to rectangle corners
sweep(hProj, 1, oProj[ , 1], "+")
hPts <- sweep(hProj, 1, oProj[ , 2], "+")
oPts <-
## corners in standard coordinates, rows = x,y, columns = corners
## in combined (4x2)-matrix: reverse point order to be usable in polygon()
cbind(huDir[eMin, ], ouDir[eMin, ]) # basis formed by hull edge and orth
basis <- basis %*% hPts
hCorn <- basis %*% oPts
oCorn <- t(cbind(hCorn, oCorn[ , c(2, 1)]))
pts <-
return(list(pts=pts, width=widths[eMin], height=heights[eMin]))
}
getMinBBox(xy) ## minimum bounding box
mbb <- chull(xy) ## convex hull
H <-
# plot original points, convex hull, and minimum bounding box
plot(xy, xlab="x", ylab="y", asp=1, type="n",
xlim=range(c(xy[ , 1], mbb$pts[ , 1])),
ylim=range(c(xy[ , 2], mbb$pts[ , 2])))
polygon(xy[H, ], col=NA) ## show convex hull
polygon(mbb$pts, border="blue", lwd=2)
points(xy, pch=16, cex=1.5)
$width * mbb$height ## box area mbb
[1] 2127.255
Skyum algorithm based on the convex hull
function(xy) {
getCircleFrom3 <-stopifnot(is.matrix(xy), is.numeric(xy), nrow(xy) == 3, ncol(xy) == 2)
xy[1, ]
aa <- xy[2, ]
bb <- xy[3, ]
cc <- xy[ , 2]
y <-
bb[1] - aa[1]
xDeltaA <- bb[2] - aa[2]
yDeltaA <- cc[1] - bb[1]
xDeltaB <- cc[2] - bb[2]
yDeltaB <- cc[1] - aa[1]
xDeltaC <- cc[2] - aa[2]
yDeltaC <-
## check if the points are collinear: qr(xy)$rank == 1, or:
## determinant of difference matrix = 0, no need to use det()
rbind(c(xDeltaA, yDeltaA), c(xDeltaB, yDeltaB))
dMat <-if(isTRUE(all.equal(dMat[1,1]*dMat[2,2] - dMat[1,2]*dMat[2,1], 0, check.attributes=FALSE))) {
## define the circle as the one that's centered between the points
range(c(aa[1], bb[1], cc[1]))
rangeX <- range(c(aa[2], bb[2], cc[2]))
rangeY <- c(rangeX[1] + 0.5*diff(rangeX), rangeY[1] + 0.5*diff(rangeY))
ctr <- sqrt((0.5*diff(rangeX))^2 + (0.5*diff(rangeY))^2)
rad <-else {
} prod(dist(xy)) / (2 * abs(det(cbind(xy, 1)))) # circle radius
rad <- rowSums(xy^2) # first vector in the numerator
v1 <- c( xDeltaB, -xDeltaC, xDeltaA) # 2nd vector numerator for Mx
v2x <- c(-yDeltaB, yDeltaC, -yDeltaA) # 2nd vector numerator for My
v2y <- c(t(v1) %*% v2y, t(v1) %*% v2x) / (2 * (t(y) %*% v2x)) # center
ctr <-
}
return(list(ctr=ctr, rad=rad))
}
Used later in getMinCircle()
function(xy, S) {
getMaxRad <-stopifnot(is.matrix(xy), is.numeric(xy), nrow(xy) >= 2, ncol(xy) == 2)
stopifnot(is.numeric(S), length(S) >= 2, length(S) <= nrow(xy))
length(S) # number of points
n <- seq(along=S) # index for points
Sidx <- numeric(n) # radii for all circles
rads <- (Sidx %% n) + 1 # next point in S
post <- Sidx[order(post)] # previous point in S
prev <-for(i in Sidx) {
rbind(xy[S[prev[i]], ], xy[S[i], ], xy[S[post[i]], ])
pts <- getCircleFrom3(pts)$rad # circle radius
rads[i] <-
}
return(which.max(rads))
}
function(xy) {
isBiggerThan90 <-stopifnot(is.matrix(xy), is.numeric(xy), nrow(xy) == 3, ncol(xy) == 2)
dist(xy)
d <- d[1]
dAB <- d[2]
dAC <- d[3]
dBC <-return((dAB^2 + dBC^2 - dAC^2) < 0)
}
function(xy) {
getMaxPairDist <-stopifnot(is.matrix(xy), is.numeric(xy), ncol(xy) == 2, nrow(xy) >= 2)
# 2D -> only convex hull is relevant
chull(xy) # convex hull indices (vertices ordered clockwise)
H <- xy[H, ] # points that make up the convex hull
pts <- nrow(pts) # number of points on hull
N <- dist(pts, method="euclidean") # distance matrix
dMat <- which.max(as.matrix(dMat)) # maximum distance
idx <- (idx-1) %/% N+1 # column -> point 1
i <- (idx-1) %% N+1 # row -> point 2
j <- H[c(i, j)] # rows with max distance
mPts <- max(dMat) # max distance
dst <-
return(list(d=dst, idx=mPts))
}
function(xy) {
getMinCircle <-stopifnot(is.matrix(xy), is.numeric(xy), nrow(xy) >= 2, ncol(xy) == 2)
chull(xy) # convex hull indices (vertices ordered clockwise)
H <- xy[H, ] # points that make up the convex hull
hPts <-
## min circle may touch convex hull in only two points
## if so, it is centered between the hull points with max distance
getMaxPairDist(hPts)
maxPD <- maxPD$idx # index of points with max distance
idx <- maxPD$d / 2 # half the distance -> radius
rad <- c(hPts[idx[1], 1], hPts[idx[2], 1])
rangeX <- c(hPts[idx[1], 2], hPts[idx[2], 2])
rangeY <- c(rangeX[1] + 0.5*diff(rangeX), rangeY[1] + 0.5*diff(rangeY))
ctr <-
## check if circle centered between hPts[pt1Idx, ] and hPts[pt2Idx, ]
## contains all points (all distances <= rad)
dist(rbind(ctr, hPts[-idx, ])) # distances to center
dst2ctr <-if(all(as.matrix(dst2ctr)[-1, 1] <= rad)) { # if all <= rad, we're done
rbind(hPts[idx, ], ctr)
tri <-return(getCircleFrom3(tri))
}
## min circle touches hull in three points - Skyum algorithm
H # copy of hull indices that will be changed
S <-while(length(S) >= 2) {
length(S) # number of remaining hull vertices
n <- seq(along=S) # index for vertices
Sidx <- (Sidx %% n) + 1 # next vertex in S
post <- Sidx[order(post)] # previous vertex in S
prev <- getMaxRad(xy, S) # idx for maximum radius
mIdx <-
## triangle where mIdx is vertex B in ABC
rbind(xy[S[prev[mIdx]], ], xy[S[mIdx], ], xy[S[post[mIdx]], ])
Smax <-
## if there's only two hull vertices, we're done
if(n <= 2) { break }
## check if angle(ABC) is > 90
## if so, eliminate B - if not, we're done
if(isBiggerThan90(Smax)) { S <- S[-mIdx] } else { break }
}
return(getCircleFrom3(Smax))
}
getMinCircle(xy)
mc <- seq(0, 2*pi, length.out=200)
angles <- cbind(mc$ctr[1] + mc$rad*cos(angles),
circ <-$ctr[2] + mc$rad*sin(angles))
mc
# determine axis limits so that the circle will be visible
mc$ctr[1] + c(-mc$rad, mc$rad)
xLims <- mc$ctr[2] + c(-mc$rad, mc$rad)
yLims <-plot(xy, xlab="x", ylab="y", xlim=xLims, ylim=yLims, asp=1, type="n")
lines(circ, col="blue", lwd=2)
points(xy, pch=16, cex=1.5)
R markdown - markdown - R code - all posts