determine circle center based on two points (radius known) with solve/optim - r

I have a pair of points and I would like to find a circles of known r that are determined by these two points. I will be using this in a simulation and possible space for x and y have boundaries (say a box of -200, 200).
It is known that square of radius is
(x-x1)^2 + (y-y1)^2 = r^2
(x-x2)^2 + (y-y2)^2 = r^2
I would now like to solve this non-linear system of equations to get two potential circle centers. I tried using package BB. Here is my feeble attempt which gives only one point. What I would like to get is both possible points. Any pointers into right direction will be met with complimentary beer on first possible occasion.
library(BB)
known.pair <- structure(c(-46.9531139599816, -62.1874917150412, 25.9011462171242,
16.7441676243879), .Dim = c(2L, 2L), .Dimnames = list(NULL, c("x",
"y")))
getPoints <- function(ps, r, tr) {
# get parameters
x <- ps[1]
y <- ps[2]
# known coordinates of two points
x1 <- tr[1, 1]
y1 <- tr[1, 2]
x2 <- tr[2, 1]
y2 <- tr[2, 2]
out <- rep(NA, 2)
out[1] <- (x-x1)^2 + (y-y1)^2 - r^2
out[2] <- (x-x2)^2 + (y-y2)^2 - r^2
out
}
slvd <- BBsolve(par = c(0, 0),
fn = getPoints,
method = "L-BFGS-B",
tr = known.pair,
r = 40
)
Graphically you can see this with the following code, but you will need some extra packages.
library(sp)
library(rgeos)
plot(0,0, xlim = c(-200, 200), ylim = c(-200, 200), type = "n", asp = 1)
points(known.pair)
found.pt <- SpatialPoints(matrix(slvd$par, nrow = 1))
plot(gBuffer(found.pt, width = 40), add = T)
ADDENDUM
Thank you all for your valuable comments and code. I provide timings for answers by posters who complimented their answers with code.
test replications elapsed relative user.self sys.self user.child sys.child
4 alex 100 0.00 NA 0.00 0 NA NA
2 dason 100 0.01 NA 0.02 0 NA NA
3 josh 100 0.01 NA 0.02 0 NA NA
1 roland 100 0.15 NA 0.14 0 NA NA

The following code will get you the points at the centers of the two desired circles. No time right now to comment this up or convert the results to Spatial* objects, but this should give you a good start.
First, here's an ASCII-art diagram to introduce point names. k and K are the known points, B is a point on the horizontal drawn through k, and C1 and C2 are the centers of the circles you are after:
C2
K
k----------------------B
C1
Now the code:
# Example inputs
r <- 40
known.pair <- structure(c(-46.9531139599816, -62.1874917150412,
25.9011462171242, 16.7441676243879), .Dim = c(2L, 2L),
.Dimnames = list(NULL, c("x", "y")))
## Distance and angle (/_KkB) between the two known points
d1 <- sqrt(sum(diff(known.pair)^2))
theta1 <- atan(do.call("/", as.list(rev(diff(known.pair)))))
## Calculate magnitude of /_KkC1 and /_KkC2
theta2 <- acos((d1/2)/r)
## Find center of one circle (using /_BkC1)
dx1 <- cos(theta1 + theta2)*r
dy1 <- sin(theta1 + theta2)*r
p1 <- known.pair[2,] + c(dx1, dy1)
## Find center of other circle (using /_BkC2)
dx2 <- cos(theta1 - theta2)*r
dy2 <- sin(theta1 - theta2)*r
p2 <- known.pair[2,] + c(dx2, dy2)
## Showing that it worked
library(sp)
library(rgeos)
plot(0,0, xlim = c(-200, 200), ylim = c(-200, 200), type = "n", asp = 1)
points(known.pair)
found.pt <- SpatialPoints(matrix(slvd$par, nrow = 1))
points(p1[1], p1[2], col="blue", pch=16)
points(p2[1], p2[2], col="green", pch=16)

This is the basic geometric way of going about solving it that everybody else is mentioning. I use polyroot to get the roots of the resulting quadratic equation but you could easily just use the quadratic equation directly.
# x is a vector containing the two x coordinates
# y is a vector containing the two y coordinates
# R is a scalar for the desired radius
findCenter <- function(x, y, R){
dy <- diff(y)
dx <- diff(x)
# The radius needs to be at least as large as half the distance
# between the two points of interest
minrad <- (1/2)*sqrt(dx^2 + dy^2)
if(R < minrad){
stop("Specified radius can't be achieved with this data")
}
# I used a parametric equation to create the line going through
# the mean of the two points that is perpendicular to the line
# connecting the two points
#
# f(k) = ((x1+x2)/2, (y1+y2)/2) + k*(y2-y1, x1-x2)
# That is the vector equation for our line. Then we can
# for any given value of k calculate the radius of the circle
# since we have the center and a value for a point on the
# edge of the circle. Squaring the radius, subtracting R^2,
# and equating to 0 gives us the value of t to get a circle
# with the desired radius. The following are the coefficients
# we get from doing that
A <- (dy^2 + dx^2)
B <- 0
C <- (1/4)*(dx^2 + dy^2) - R^2
# We could just solve the quadratic equation but eh... polyroot is good enough
k <- as.numeric(polyroot(c(C, B, A)))
# Now we just plug our solution in to get the centers
# of the circles that meet our specifications
mn <- c(mean(x), mean(y))
ans <- rbind(mn + k[1]*c(dy, -dx),
mn + k[2]*c(dy, -dx))
colnames(ans) = c("x", "y")
ans
}
findCenter(c(-2, 0), c(1, 1), 3)

Following #PhilH's solution, just using trigonometry in R:
radius=40
Draw the original points on the radius
plot(known.pair,xlim=100*c(-1,1),ylim=100*c(-1,1),asp=1,pch=c("a","b"),cex=0.8)
Find the midpoint c of ab (which is also the midpoint of de the two circle centers)
AB.bisect=known.pair[2,,drop=F]/2+known.pair[1,,drop=F]/2
C=AB.bisect
points(AB.bisect,pch="c",cex=0.5)
Find the length and angle of the chord ab
AB.vector=known.pair[2,,drop=F]-known.pair[1,,drop=F]
AB.len=sqrt(sum(AB.vector^2))
AB.angle=atan2(AB.vector[2],AB.vector[1])
names(AB.angle)<-NULL
Calculate the length and angle of the line from c to the centers of the two circles
CD.len=sqrt(diff(c(AB.len/2,radius)^2))
CD.angle=AB.angle-pi/2
Calculate and plot the position of the two centers d and e from the perpendicular to ab and the length:
center1=C+CD.len*c(x=cos(CD.angle),y=sin(CD.angle))
center2=C-CD.len*c(x=cos(CD.angle),y=sin(CD.angle))
points(center1[1],center1[2],col="blue",cex=0.8,pch="d")
points(center2[1],center2[2],col="blue",cex=0.8,pch="e")
Shows:

No numerical equation solving required. Just formulae:
You know that since both points A and B lie on the circle, the distance from each to a given centre is the radius r.
Form an isosceles triangle with the chord of the two known points at the base and the third point at the circle centre.
Bisect the triangle midway between A and B, giving you a right-angle triangle.
http://mathworld.wolfram.com/IsoscelesTriangle.html gives you the height in terms of the base length and the radius.
Follow the normal to the AB chord (See this SO Answer) for a distance of the height just calculated in each direction from the point.

Here are the bones of an answer, if I have time later I'll flesh them out. This should be easy enough to follow if you draw along with the words, sorry I don't have the right software on this computer to draw the picture for you.
Leave aside degenerate cases where the points are identical (infinite solutions) or too far apart to lie on the same circle of your chosen radius (no solutions).
Label the points X and Y and the unknown centre points of the 2 circles c1 and c2. c1 and c2 lie on the perpendicular bisector of XY; call this line c1c2, at this stage it's immaterial that we don't know all the details of the locations of c1 and c2.
So, figure out the equation of line c1c2. It passes through the half-way point of XY (call this point Z) and has slope equal to the negative reciprocal of XY. Now you have the equation of c1c2 (or you would if there was any flesh on these bones).
Now construct the triangle from one point to the intersection of the line and its perpendicular bisector and the centre point of a circle (say XZc1). You still don't know exactly where c1 is but that never stopped anyone sketching the geometry. You have a right triangle with two side lengths known (XZ and Xc1), so it's easy to find Zc1. Repeat the process for the other triangle and circle centre.
Of course, this approach is quite different from OP's initial approach and may not appeal.

Some warnings to get rid of, but this should get you started. There might be a performance issue, so solving it completely with basic geometry could be a better approach.
known.pair <- structure(c(-46.9531139599816, -62.1874917150412, 25.9011462171242,
16.7441676243879), .Dim = c(2L, 2L), .Dimnames = list(NULL, c("x",
"y")))
findCenter <- function(p,r) {
yplus <- function(y) {
((p[1,1]+sqrt(r^2-(y-p[1,2])^2)-p[2,1])^2+(y-p[2,2])^2-r^2)^2
}
yp <- optimize(yplus,interval=c(min(p[,2]-r),max(p[,2]+r)))$minimum
xp <- p[1,1]+sqrt(r^2-(yp-p[1,2])^2)
cp <- c(xp,yp)
names(cp)<-c("x","y")
yminus <- function(y) {
((p[1,1]-sqrt(r^2-(y-p[1,2])^2)-p[2,1])^2+(y-p[2,2])^2-r^2)^2
}
ym <- optimize(yminus,interval=c(min(p[,2]-r),max(p[,2]+r)))$minimum
xm <- p[1,1]-sqrt(r^2-(ym-p[1,2])^2)
cm <- c(xm,ym)
names(cm)<-c("x","y")
list(c1=cp,c2=cm)
}
cent <- findCenter(known.pair,40)

I hope you know some basic geometry, because I cannot draw it unfortunately.
The perpendicular bisector is the line where every middle point of a circle which crosses both A and B lays.
Now you have the middle of AB and r, so you can draw a right triangle with the point A, the middle of AB and the unknown middle point of the circle.
Now use the pythagoras' theorem to get the distance from the middle point of AB to the middle point of the circle, and calculate the position of the circle shouldn't be hard from here, using basic sin/cos combinations.

Related

Calculating the area between shapes in R

I am trying to calculate the area generated (in orange) by an arbitrary point in the space. here are some example pictures of different possible scenarios:
So basically in all three pictures I want to be able to calculate the orange area that is generated from point by drawing a horizontal and vertical line from the point to the blue area. The idea is simple but actually implementing is very challenging. I am writing this code in R so any help with R code would be great. Also, for the third example, we can just assume that the orange area is bounded at x and y equal to 8. And, we also know the coordinates of the green points. Any suggestion greatly appreciated!
Oh an here is my code for generating the plots below:
x = c(1,3,5)
y = c(5,3,1)
point1 = c(2,4)
point2 = c(2,2)
point3 = c(0,0)
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point1[1],point1[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point1[1],point1[2],pch=21,bg="blue")
box()
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point2[1],point2[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point2[1],point2[2],pch=21,bg="blue")
box()
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point3[1],point3[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point3[1],point3[2],pch=21,bg="blue")
box()
You're working much harder than necessary. pracma::polyarea will calculate the area of any polygon given the coordinates of all vertices.
Think about the entire plotting region as an unequal grid of rectangles, with x- and y-grid points at the x- and y-coordinates of the rectangle vertices you're plotting.
x <- c(1, 3, 5)
y <- c(5, 3, 1)
max.x <- max(x) + 10
max.y <- max(y) + 10
point <- c(0, 0)
x.grid <- sort(unique(c(x, point[1], max.x)))
x.grid
# [1] 0 1 3 5 15
y.grid <- sort(unique(c(y, point[2], max.y)))
y.grid
# [1] 0 1 3 5 15
We'll keep track of the grid rectangles we painted orange with the matrix orange:
orange <- matrix(FALSE, nrow=length(y.grid)-1, ncol=length(x.grid)-1)
We'll make a plotting function that labels cells in orange based on the passed rectangle, with (x1, y1) as lower left and (x2, y2) as upper right:
plot.rect <- function(x1, y1, x2, y2, value) {
x1.idx <- which(x.grid == x1)
y1.idx <- which(y.grid == y1)
x2.idx <- which(x.grid == x2)
y2.idx <- which(y.grid == y2)
orange[y1.idx:(y2.idx-1),x1.idx:(x2.idx-1)] <<- value
}
Then, let's plot our orange rectangle (filling in TRUE) followed by all the blue ones (filling in FALSE):
plot.rect(point[1], point[2], max.x, max.y, TRUE)
for (idx in 1:length(x)) {
plot.rect(x[idx], y[idx], max.x, max.y, FALSE)
}
Finally, let's compute the size of each grid rectangle, enabling the final size computation (the point I selected at the top corresponds to your third plot; since the plot extends up 15 and to the right 15, it appears to be working as intended):
sizes <- t(outer(diff(x.grid), diff(y.grid)))
area <- sum(orange * sizes)
area
# [1] 41

Rotate graph by angle

I have multiple matrices filled with the x and y coordinates of multiple points in 2D space that make up a graph. The matrices look something like this
x1 x2 x3 x4 ...
y1 y2 y3 y4 ...
A possible graph looks something like this
What I want to do is rotate the graph around point A so that the line between the points A and B are parallel to the X-Axis.
My idea was to treat the line AB as the hypothenuse of a right-triangle, calculate α (the angle at point A) and rotate the matrix for this graph by it using a rotation matrix.
What I did so far is the following
#df is the subset of my data that describes the graph we're handling right now,
#df has 2 or more rows
beginx=df[1,]$xcord #get the x coordinate of point A
beginy=df[1,]$ycord #get the y coordinate of point A
endx=df[nrow(df)-1,]$xcord #get the x coordinate of point B
endy=df[nrow(df)-1,]$ycord #get the y coordinate of point B
xnow=df$xcord
ynow=df$ycord
xdif=abs(beginx-endx)
ydif=abs(beginy-endy)
if((xdif != 0) & (ydif!=0)){
direct=sqrt(abs((xdif^2)-(ydif^2))) #calculate the length of the hypothenuse
sinang=abs(beginy-endy)/direct
angle=1/sin(sinang)
if(beginy>endy){
angle=angle
}else{
angle=360-angle
}
rotmat=rot(angle) # use the function rot(angle) to get the rotation matrix for
# the calculated angle
A = matrix(c(xnow,ynow),nrow=2,byrow = TRUE) # matrix containing the graph coords
admat=rotmat%*%A #multiply the matrix with the rotation matrix
}
This approach fails because it isn't flexible enough to always calculate the needed angle with the result being that the graph is rotated by the wrong angle and / or in the wrong direction.
Thanks in advance for reading and hopefully some of you can bring some fresh ideas to this
Edit: Data to reproduce this can be found here
X-Coordinates
Y-Coordinates
Not sure how to provide the data you've asked for, I'll gladly provide it in another way if you specify how you'd like it
Like this?
#read in X and Y as vectors
M <- cbind(X,Y)
#plot data
plot(M[,1],M[,2],xlim=c(0,1200),ylim=c(0,1200))
#calculate rotation angle
alpha <- -atan((M[1,2]-tail(M,1)[,2])/(M[1,1]-tail(M,1)[,1]))
#rotation matrix
rotm <- matrix(c(cos(alpha),sin(alpha),-sin(alpha),cos(alpha)),ncol=2)
#shift, rotate, shift back
M2 <- t(rotm %*% (
t(M)-c(M[1,1],M[1,2])
)+c(M[1,1],M[1,2]))
#plot
plot(M2[,1],M2[,2],xlim=c(0,1200),ylim=c(0,1200))
Edit:
I'll break down the transformation to make it easier to understand. However, it's just basic linear algebra.
plot(M,xlim=c(-300,1200),ylim=c(-300,1200))
#shift points, so that turning point is (0,0)
M2.1 <- t(t(M)-c(M[1,1],M[1,2]))
points(M2.1,col="blue")
#rotate
M2.2 <- t(rotm %*% (t(M2.1)))
points(M2.2,col="green")
#shift back
M2.3 <- t(t(M2.2)+c(M[1,1],M[1,2]))
points(M2.3,col="red")
Instead of a data frame, it looks like your data is better served as a matrix (via as.matrix).
This answer very similar to Roland's, but breaks things down into more steps and has some special-case handling when the angle is a multiple of pi/2.
#sample data
set.seed(1) #for consistency of random-generated data
d <- matrix(c(sort(runif(50)),sort(runif(50))),ncol=2)
#rotation about point A
rotA <- function(d) {
d.offset <- apply(d,2,function(z) z - z[1]) #offset data
endpoint <- d.offset[nrow(d.offset),] #gets difference
rot <- function(angle) matrix(
c(cos(angle),-sin(angle),sin(angle),cos(angle)),nrow=2) #CCW rotation matrix
if(endpoint[2] == 0) {
return(d) #if y-diff is 0, then no action required
} else if (endpoint[1] == 0) {
rad <- pi/2 #if x-diff is 0, then rotate by a right angle
} else {rad <- atan(endpoint[2]/endpoint[1])}
d.offset.rotate <- d.offset %*% rot(-rad) #rotation
d.rotate <- sapply(1:2,function(z) d.offset.rotate[,z] + d[1,z]) #undo offset
d.rotate
}
#results and plotting to check visually
d.rotate <- rotA(d)
plot(d.rotate)
abline(h=d[1,2])

Calculating the distance between polygon and point in R

I have a, not necessarily convex, polygon without intersections and a point outside this polygon. I'm wondering how calculate the Euclidian distance most efficiently in a 2-dimensional space. Is there a standard method in R?
My first idea was to calculate the minimum distance of all the lines of the polygon (extended infinitely so they are line, not line pieces) and then calculate the distance from the point to each individual line using the start of the line piece and Pythagoras.
Do you know about a package that implements an efficient algorithm?
You could use the rgeos package and the gDistance method. This will require you to prepare your geometries, creating spgeom objects from the data you have (I assume it is a data.frame or something similar). The rgeos documentation is very detailed (see the PDF manual of the package from the CRAN page), this is one relevant example from the gDistance documentation:
pt1 = readWKT("POINT(0.5 0.5)")
pt2 = readWKT("POINT(2 2)")
p1 = readWKT("POLYGON((0 0,1 0,1 1,0 1,0 0))")
p2 = readWKT("POLYGON((2 0,3 1,4 0,2 0))")
gDistance(pt1,pt2)
gDistance(p1,pt1)
gDistance(p1,pt2)
gDistance(p1,p2)
readWKT is included in rgeos as well.
Rgeos is based on the GEOS library, one of the de facto standards in geometric computing. If you don't feel like reinventing the wheel, this is a good way to go.
I decided to return and write up a theoretical solution, just for posterity. This isn't the most concise example, but it is fully transparent for those who want to know how to go about solving a problem like this by hand.
The theoretical algorithm
First, our assumptions.
We assume the polygon's vertices specify the points of a polygon in a rotational order going clockwise or counter-clockwise and the lines of the polygon cannot intersect. This means we have a normal geometric polygon, and not some strangely-defined vector graphic shape.
We assume this is a set of Cartesian coordinates, using 'x' and 'y' values that represent location on a 2-dimensional plane.
We assume the point must be outside the internal area of the polygon.
Finally, we assume that the distance desired is the minimum distance between the point and all of the infinite number of points on the perimeter of the polygon.
Now before coding, we should write out in basic terms what we want to do. We can assume that the shortest distance between the polygon and the point outside the polygon will always be one of two things: a vertex of the polygon or a point on a line between two vertices. With this in mind, we do the following steps:
Calculate the distances between all vertices and the target point.
Find the two vertices closest to the target point.
If either:
(a) the two closest vertices are not adjacent or
(b) the inside angles of either of the two vertices is greater or equal to 90 degrees,
then the closest vertex is the closest point. Calculate the distance between the closest point and the target point.
Otherwise, calculate the height of the triangle formed between the two points.
We're basically just looking to see if a vertex is closest to the point or if a point on a line is closest to the point. We have to use a few trig functions to make this work.
The code
To make this work properly, we want to avoid any 'for' loops and want to only use vectorized functions when looking at the entire list of polygon vertices. Luckily, this is pretty easy in R. We accept a data frame with 'x' and 'y' columns for our polygon's vertices, and we accept a vector with one 'x' and 'y' value for the point's location.
get_Point_Dist_from_Polygon <- function(.polygon, .point){
# Calculate all vertex distances from the target point.
vertex_Distance <- sqrt((.point[1] - .polygon$x)^2 + (.point[2] - .polygon$y)^2)
# Select two closest vertices.
min_1_Index <- which.min(vertex_Distance)
min_2_Index <- which.min(vertex_Distance[-min_1_Index])
# Calculate lengths of triangle sides made of
# the target point and two closest points.
a <- vertex_Distance[min_1_Index]
b <- vertex_Distance[min_2_Index]
c <- sqrt(diff(.polygon$x[c(min_1_Index, min_2_Index)])^2 + diff(.polygon$y[c(min_1_Index, min_2_Index)])^2)
if(abs(min_1_Index - min_2_Index) != 1 |
acos((b^2 + c^2 - a^2)/(2*b*c)) >= pi/2 |
acos((a^2 + c^2 - b^2)/(2*a*c)) >= pi/2
){
# Step 3 of algorithm.
return(vertex_Distance[min_1_Index])
} else {
# Step 4 of algorithm.
# Here we are using the law of cosines.
return(sqrt((a+b-c) * (a-b+c) * (-a+b+c) * (a+b+c)) / (2 * c))
}
}
Demo
polygon <- read.table(text="
x, y
0, 1
1, 0.8
2, 1.3
3, 1.4
2.5,0.3
1.5,0.5
0.5,0.1", header=TRUE, sep=",")
point <- c(3.2, 4.1)
get_Point_Dist_from_Polygon(polygon, point)
# 2.707397
Otherwise:
p2poly <- function(pt, poly){
# Closing the polygon
if(!identical(poly[1,],poly[nrow(poly),])){poly<-rbind(poly,poly[1,])}
# A simple distance function
dis <- function(x0,x1,y0,y1){sqrt((x0-x1)^2 +(y0-y1)^2)}
d <- c() # Your distance vector
for(i in 1:(nrow(poly)-1)){
ba <- c((pt[1]-poly[i,1]),(pt[2]-poly[i,2])) #Vector BA
bc <- c((poly[i+1,1]-poly[i,1]),(poly[i+1,2]-poly[i,2])) #Vector BC
dbc <- dis(poly[i+1,1],poly[i,1],poly[i+1,2],poly[i,2]) #Distance BC
dp <- (ba[1]*bc[1]+ba[2]*bc[2])/dbc #Projection of A on BC
if(dp<=0){ #If projection is outside of BC on B side
d[i] <- dis(pt[1],poly[i,1],pt[2],poly[i,2])
}else if(dp>=dbc){ #If projection is outside of BC on C side
d[i] <- dis(poly[i+1,1],pt[1],poly[i+1,2],pt[2])
}else{ #If projection is inside of BC
d[i] <- sqrt(abs((ba[1]^2 +ba[2]^2)-dp^2))
}
}
min(d)
}
Example:
pt <- c(3,2)
triangle <- matrix(c(1,3,2,3,4,2),byrow=T, nrow=3)
p2poly(pt,triangle)
[1] 0.3162278
I used distm() function in geosphere package to calculate the distence when points and apexes are presented in coordinate system. Also, you can easily make some alternation by substitude dis <- function(x0,x1,y0,y1){sqrt((x0-x1)^2 +(y0-y1)^2)}
for distm() .
algo.p2poly <- function(pt, poly){
if(!identical(poly[1,],poly[nrow(poly),])){poly<-rbind(poly,poly[1,])}
library(geosphere)
n <- nrow(poly) - 1
pa <- distm(pt, poly[1:n, ])
pb <- distm(pt, poly[2:(n+1), ])
ab <- diag(distm(poly[1:n, ], poly[2:(n+1), ]))
p <- (pa + pb + ab) / 2
d <- 2 * sqrt(p * (p - pa) * (p - pb) * (p - ab)) / ab
cosa <- (pa^2 + ab^2 - pb^2) / (2 * pa * ab)
cosb <- (pb^2 + ab^2 - pa^2) / (2 * pb * ab)
d[which(cosa <= 0)] <- pa[which(cosa <= 0)]
d[which(cosb <= 0)] <- pb[which(cosb <= 0)]
return(min(d))
}
Example:
poly <- matrix(c(114.33508, 114.33616,
114.33551, 114.33824,
114.34629, 114.35053,
114.35592, 114.35951,
114.36275, 114.35340,
114.35391, 114.34715,
114.34385, 114.34349,
114.33896, 114.33917,
30.48271, 30.47791,
30.47567, 30.47356,
30.46876, 30.46851,
30.46882, 30.46770,
30.47219, 30.47356,
30.47499, 30.47673,
30.47405, 30.47723,
30.47872, 30.48320),
byrow = F, nrow = 16)
pt1 <- c(114.33508, 30.48271)
pt2 <- c(114.6351, 30.98271)
algo.p2poly(pt1, poly)
algo.p2poly(pt2, poly)
Outcome:
> algo.p2poly(pt1, poly)
[1] 0
> algo.p2poly(pt2, poly)
[1] 62399.81

a fast way to calculate orthogonal distance of a point to y=x in R

I have a bunch of points that lie around y=x (see the examples below), and I hope to calculate the orthogonal distance of each point to this y=x. Suppose that a point has coordinates (a,b), then it's easy to see the projected point on the y=x has coordinates ((a+b)/2, (a+b)/2). I use the following native codes for the calculation, but I think I need a faster one without the for loops. Thank you very much!
set.seed(999)
n=50
typ.ord = seq(-2,3, length=n) # x-axis
#
good.ord = sort(c(rnorm(n/2, typ.ord[1:n/2]+1,0.1),rnorm(n/2,typ.ord[(n/2+1):n]-0.5,0.1)))
y.min = min(good.ord)
y.max = max(good.ord)
#
plot(typ.ord, good.ord, col="green", ylim=c(y.min, y.max))
abline(0,1, col="blue")
#
# a = typ.ord
# b = good.ord
cal.orth.dist = function(n, typ.ord, good.ord){
good.mid.pts = (typ.ord + good.ord)/2
orth.dist = numeric(n)
for (i in 1:n){
num.mat = rbind(rep(good.mid.pts[i],2), c(typ.ord[i], good.ord[i]))
orth.dist[i] = dist(num.mat)
}
return(orth.dist)
}
good.dist = cal.orth.dist(50, typ.ord, good.ord)
sum(good.dist)
As easy as
good.dist <- sqrt((good.ord - typ.ord)^2 / 2)
It all boils down to compute the distance between a point and a line. In the 2D case of y = x, this becomes particularly easy (try it yourself).
In the more general case (extending to other lines in possibly more than 2-D space), you can use the following. It works by constructing a projection matrix P from the subspace (here the vector A) onto which you want to project the points x. Subtracting the projected component from the points leaves the orthogonal component, for which it's easy to calculate the distances.
x <- cbind(typ.ord, good.ord) # Points to be projected
A <- c(1,1) # Subspace to project onto
P <- A %*% solve(t(A) %*% A) %*% t(A) # Projection matrix P_A = A (A^T A)^-1 A^T
dists <- sqrt(rowSums(x - x %*% P)^2) # Lengths of orthogonal residuals

Generating multidimensional data

Does R have a package for generating random numbers in multi-dimensional space? For example, suppose I want to generate 1000 points inside a cuboid or a sphere.
I have some functions for hypercube and n-sphere selection that generate dataframes with cartesian coordinates and guarantee a uniform distribution through the hypercube or n-sphere for an arbitrary amount of dimensions :
GenerateCubiclePoints <- function(nrPoints,nrDim,center=rep(0,nrDim),l=1){
x <- matrix(runif(nrPoints*nrDim,-1,1),ncol=nrDim)
x <- as.data.frame(
t(apply(x*(l/2),1,'+',center))
)
names(x) <- make.names(seq_len(nrDim))
x
}
is in a cube/hypercube of nrDim dimensions with a center and l the length of one side.
For an n-sphere with nrDim dimensions, you can do something similar, where r is the radius :
GenerateSpherePoints <- function(nrPoints,nrDim,center=rep(0,nrDim),r=1){
#generate the polar coordinates!
x <- matrix(runif(nrPoints*nrDim,-pi,pi),ncol=nrDim)
x[,nrDim] <- x[,nrDim]/2
#recalculate them to cartesians
sin.x <- sin(x)
cos.x <- cos(x)
cos.x[,nrDim] <- 1 # see the formula for n.spheres
y <- sapply(1:nrDim, function(i){
if(i==1){
cos.x[,1]
} else {
cos.x[,i]*apply(sin.x[,1:(i-1),drop=F],1,prod)
}
})*sqrt(runif(nrPoints,0,r^2))
y <- as.data.frame(
t(apply(y,1,'+',center))
)
names(y) <- make.names(seq_len(nrDim))
y
}
in 2 dimensions, these give :
From code :
T1 <- GenerateCubiclePoints(10000,2,c(4,3),5)
T2 <- GenerateSpherePoints(10000,2,c(-5,3),2)
op <- par(mfrow=c(1,2))
plot(T1)
plot(T2)
par(op)
Also check out the copula package. This will generate data within a cube/hypercube with uniform margins, but with correlation structures that you set. The generated variables can then be transformed to represent other shapes, but still with relations other than independent.
If you want more complex shapes but are happy with uniform and idependent within the shape then you can just do rejection sampling: generate data within a cube that contains your shape, then test if the points are within your shape, reject them if not, then keep doing this until there are enough points.
A couple of years ago, I made a package called geozoo. It is available on CRAN.
install.packages("geozoo")
library(geozoo)
It has many different functions to produce objects in N-dimensions.
p = 4
n = 1000
# Cube with points on it's face.
# A 3D version would be a box with solid walls and a hollow interior.
cube.face(p)
# Hollow sphere
sphere.hollow(p, n)
# Solid cube
cube.solid.random(p, n)
cube.solid.grid(p, 10) # evenly spaced points
# Solid Sphere
sphere.solid.random(p, n)
sphere.solid.grid(p, 10) # evenly spaced points
One of my favorite ones to watch animate is a cube with points along its edges, because it was one of the first objects that I made. It also gives you a sense of distance between vertices.
# Cube with points along it's edges.
cube.dotline(4)
Also, check out the website: http://streaming.stat.iastate.edu/~dicook/geometric-data/. It contains pictures and downloadable data sets.
Hope it meets your needs!
Cuboid:
df <- data.frame(
x = runif(1000),
y = runif(1000),
z = runif(1000)
)
head(df)
x y z
1 0.7522104 0.579833314 0.7878651
2 0.2846864 0.520284731 0.8435828
3 0.2240340 0.001686003 0.2143208
4 0.4933712 0.250840233 0.4618258
5 0.6749785 0.298335804 0.4494820
6 0.7089414 0.141114804 0.3772317
Sphere:
df <- data.frame(
radius = runif(1000),
inclination = 2*pi*runif(1000),
azimuth = 2*pi*runif(1000)
)
head(df)
radius inclination azimuth
1 0.1233281 5.363530 1.747377
2 0.1872865 5.309806 4.933985
3 0.2371039 5.029894 6.160549
4 0.2438854 2.962975 2.862862
5 0.5300013 3.340892 1.647043
6 0.6972793 4.777056 2.381325
Note: edited to include code for sphere
Here is one way to do it.
Say we hope to generate a bunch of 3d points of the form y = (y_1, y_2, y_3)
Sample X from multivariate Gaussian with mean zero and covariance matrix R.
(x_1, x_2, x_3) ~ Multivariate_Gaussian(u = [0,0,0], R = [[r_11, r_12, r_13],r_21, r_22, r_23], [r_31, r_32, r_33]]
You can find a function which generates Multivariate Gaussian samples in an R package.
Take the Gaussian cdf of each covariate (phi(x_1) , phi(x_2), phi(x_3)). In this case, phi is the Gaussian cdf of our variables. Ie phi(x_1) = Pr[x <= x_1] By the probability integral transform, these (phi(x_1) , phi(x_2), phi(x_3)) = (u_1, u_2, u_3), will each be uniformly distrubted on [0,1].
Then, take the inverse cdf of each uniformly distributed marginal. In other words take the inverse cdf of u_1, u_2, u_3:
F^{-1}(u_1), F^{-2}(u_2), F^{-3}(u_3) = (y_1, y_2, y_3), where F is the marginal cdf of the distrubution you are trying to sample from.

Resources