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
Related
I have made a ggplot using some A and B numeric values. (If possible can you give me the solution for grid too?)
Such as:
A B
2 3
3 7
4 8
5 9
6 2
7 1
Now from the points, lets say A1 and A2 as shown in diagram, I want to measure the angle and the distance covered from each point.
I know how to calculate the distance (via euclidean distance formula) from one point and for angle it can be calculated as cross and dot product of the vectors. But I am facing the problem to code this and to represent it.
Can you help?
Okay, here is a first pass - doing it in grid. This could be done in ggplot2 too I imagine, but I want to learn grid for now since ggplot2 and lattice are based on it. This plot has some issues, for example the angle of the annotation text really has to be calculated in device coordinates, not native coordinates, so it only looks right if your grid squares are really square. I might fix that later, but I don't have time now. Also I would think I could specify the defaults so that each primitive doesn't have that default.units parameter. This should get you started though.
library(grid)
grid.newpage()
df <- data.frame(a=c(2,3,4,5,6,7),b=c(3,7,8,9,2,1))
vp <- viewport(x=0.5,y=0.5,width=0.999,height=0.999,xscale=c(0,1),yscale=c(0,1))
pushViewport(vp)
# a rectangle (with dashed lines) on the border of the viewport:
grid.rect(gp=gpar(lty="dashed",col="steelblue"))
vp <- viewport(x=0.5,y=0.5,width=0.9,height=0.9,xscale=c(0,8),yscale=c(0,10),
default.units="native")
pushViewport(vp)
#draw the background grid
grid.polyline(x=rep(0:8,each=2),y=rep(c(0,10),9),id=rep(1:9,each=2),
gp=gpar(lty="solid",col="gray"),default.units="native")
grid.polyline(x=rep(c(0,8),11),y=rep(0:10,each=2),id=rep(1:11,each=2),
gp=gpar(lty="solid",col="gray"),default.units="native")
# add the lables
grid.text(as.character(0:8),x=0:8,y=rep(-0.2,9),
gp=gpar(col="gray",fontsize=12),default.units="native")
grid.text(as.character(0:10),y=0:10,x=rep(-0.2,11),
gp=gpar(col="gray",fontsize=12),default.units="native")
grid.lines(x=df$a,y=df$b,gp=gpar(col="steelblue"),default.units="native")
grid.points(x=df$a,y=df$b,gp=gpar(col="steelblue"),default.units="native")
for (i in 1:(nrow(df)-1)){
x0 <- df$a[i]
y0 <- df$b[i]
x1 <- df$a[i+1]
y1 <- df$b[i+1]
dx <- x1-x0
dy <- y1-y0
dist <- sqrt( dx^2 + dy^2 )
ang <- (180/3.14159)*atan2(dy,dx)
txt <- sprintf("D: %.1f Ang:%.1f",dist,ang)
xt <- (x0+x1)/2
yt <- (y0+y1)/2 + 0.2*abs(dy/dx)
grid.text(txt,x=xt,y=yt,rot=ang,
gp=gpar(col="steelblue",fontsize=9),default.units="native")
}
It sounds easier to calculate those angles and distances outside the plot,
library(dplyr)
d <- data.frame(x=c(2,3,4,5,6,7),
y=c(3,7,8,9,2,1))
d2 <- with(d, data.frame(dx=diff(x), dy=diff(y)))
d2 <- mutate(d2, distance = sqrt(dx^2 + dy^2),
angle = atan2(dy, dx))
ann <- mutate(cbind(d[-nrow(d),], d2),
x=x+dx/2, y=y+dy/2,
label = sprintf("%.2f\n %2.f degrees",
distance, angle*180/pi))
library(ggplot2)
ggplot(d, aes(x,y)) + geom_line() +
geom_text(data = ann, vjust = 0,
aes(x, y, label=label, angle=angle*180/pi)) +
coord_equal()
I have a grid of rectangles, whose coordinates are stored in the variable say, 'gridPoints' as shown below:
gridData.Grid=GridTopology(c(min(data$LATITUDE),min(data$LONGITUDE)),c(0.005,0.005),c(32,32));
gridPoints = as.data.frame(coordinates(gridData.Grid))[1:1000,];
names(gridPoints) = c("LATITUDE","LONGITUDE");
plot(gridPoints,col=4);
points(data,col=2);
When plotted, these are the black points in the image,
Now, I have another data set of points called say , 'data', which when plotted are the blue points above.
I would want a count of how many blue points fall within each rectangle in the grid. Each rectangle can be represented by the center of the rectangle, along with the corresponding count of blue points within it in the output. Also, if the blue point lies on any of the sides of the rectangle, it can be considered as lying within the rectangle while making the count. The plot has the blue and black points looking like circles, but they are just standard points/coordinates and hence, much smaller than the circles. In a special case, the rectangle can also be a square.
Try this,
x <- seq(0,10,by=2)
y <- seq(0, 30, by=10)
grid <- expand.grid(x, y)
N <- 100
points <- cbind(runif(N, 0, 10), runif(N, 0, 30))
plot(grid, t="n", xaxs="i", yaxs="i")
points(points, col="blue", pch="+")
abline(v=x, h=y)
binxy <- data.frame(x=findInterval(points[,1], x),
y=findInterval(points[,2], y))
(results <- table(binxy))
d <- as.data.frame.table(results)
xx <- x[-length(x)] + 0.5*diff(x)
d$x <- xx[d$x]
yy <- y[-length(y)] + 0.5*diff(y)
d$y <- yy[d$y]
with(d, text(x, y, label=Freq))
A more general approach (may be overkill for this case, but if you generalize to arbitrary polygons it will still work) is to use the over function in the sp package. This will find which polygon each point is contained in (then you can count them up).
You will need to do some conversions up front (to spatial objects) but this method will work with more complicated polygons than rectangles.
If all the rectangles are exactly the same size, then you could use k nearest neighbor techniques using the centers of the rectangles, see the knn and knn1 functions in the class package.
I am trying to shade under curve (contrast to y direction in this post). Just the following is hypothesis of filling direction.
curve(dnorm(x,0,1),xlim=c(-3,3),main='Standard Normal')
I am trying to write a function, where I can fill very small polygons with different colors ( I do not know if this is right approach), then it will look like gradient.
The idea is to extend the following filling of single polygon to n polygons.
codx <- c(-3,seq(-3,-2,0.01),-2)
cody <- c(0,dnorm(seq(-3,-2,0.01)),0)
curve(dnorm(x,0,1),xlim=c(-3,3),main='Standard Normal')
polygon(codx,cody,col='red')
I tried to extend it to a function:
x1 <- NULL
y1 <- NULL
polys <- function ( lwt, up, itn) {
x1 <- c(lwt,seq(lwt,up, itn),up)
y1 <- c(0,dnorm(seq(lwt,up,tn)),0)
out <- list (x1, y1)
return (out)
}
out <- polys(lwt = 0, up = 1, itn = 0.1)
library(RColorBrewer)
plotclr <- brewer.pal(10,"YlOrRd")
Neither I could workout the function nor I could brew more colors than 9 this way. Help appreciated.
You can use segments to achieve "roughly" what you want
x <- seq(from=-3, to=3,by=0.01)
curve(dnorm(x,0,1), xlim=c(-3,3))
segments(x, rep(0,length(x)),x,dnorm(x,0,1) , col=heat.colors(length(x)), lwd=2)
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.
I have two matrices (of approximately 300 x 100) and I would like to plot a graph to see the parts of the first one that are higher than those of the second.
I can do, for instance:
# Calculate the matrices and put them into m1 and m2
# Note that the values are between -1 and 1
par(mfrow=c(1,3))
image(m1, zlim=c(-1,1))
image(m2, zlim=c(-1,1))
image(m1-m2, zlim=c(0,1))
This will plot only the desired regions in the 3rd plot but I would like to do something a bit different, like putting a line around those areas over the first plot in order to highlight them directly there.
Any idea how I can do that?
Thank you
nico
How about:
par(mfrow = c(1, 3))
image(m1, zlim = c(-1, 1))
contour(m1 - m2, add = TRUE)
image(m2, zlim = c(-1, 1))
contour(m1 - m2, add = TRUE)
image(m1 - m2, zlim = c(0, 1))
contour(m1 - m2, add = TRUE)
This adds a contour map around the regions. Sort of puts rings around the areas of the 3rd plot (might want to fiddle with the (n)levels of the contours to get fewer 'circles').
Another way of doing your third image might be:
image(m1>m2)
this produces a matrix of TRUE/FALSE values which gets imaged as 0/1, so you have a two-colour image. Still not sure about your 'putting a line around' thing though...
Here's some code I wrote to do something similar. I wanted to highlight contiguous regions above a 0.95 threshold by drawing a box round them, so I got all the grid squares above 0.95 and did a clustering on them. Then do a bit of fiddling with the clustering output to get the rectangle coordinates of the regions:
computeHotspots = function(xyz, thresh, minsize=1, margin=1){
### given a list(x,y,z), return a data frame where each row
### is a (xmin,xmax,ymin,ymax) of bounding box of a contiguous area
### over the given threshhold.
### or approximately. lets use the clustering tools in R...
overs <- which(xyz$z>thresh,arr.ind=T)
if(length(overs)==0){
## found no hotspots
return(NULL)
}
if(length(overs)==2){
## found one hotspot
xRange <- cbind(xyz$x[overs[,1]],xyz$x[overs[,1]])
yRange <- cbind(xyz$y[overs[,2]],xyz$y[overs[,2]])
}else{
oTree <- hclust(dist(overs),method="single")
oCut <- cutree(oTree,h=10)
oXYc <- data.frame(x=xyz$x[overs[,1]],y=xyz$y[overs[,2]],oCut)
xRange <- do.call("rbind",tapply(oXYc[,1],oCut,range))
yRange <- do.call("rbind",tapply(oXYc[,2],oCut,range))
}
### add user-margins
xRange[,1] <- xRange[,1]-margin
xRange[,2] <- xRange[,2]+margin
yRange[,1] <- yRange[,1]-margin
yRange[,2] <- yRange[,2]+margin
## put it all together
xr <- apply(xRange,1,diff)
xm <- apply(xRange,1,mean)
xRange[xr<minsize,1] <- xm[xr<minsize]-(minsize/2)
xRange[xr<minsize,2] <- xm[xr<minsize]+(minsize/2)
yr <- apply(yRange,1,diff)
ym <- apply(yRange,1,mean)
yRange[yr<minsize,1] <- ym[yr<minsize]-(minsize/2)
yRange[yr<minsize,2] <- ym[yr<minsize]+(minsize/2)
cbind(xRange,yRange)
}
Test code:
x=1:23
y=7:34
m1=list(x=x,y=y,z=outer(x,y,function(x,y){sin(x/3)*cos(y/3)}))
image(m1)
hs = computeHotspots(m1,0.95)
That should give you a matrix of rectangle coordinates:
> hs
[,1] [,2] [,3] [,4]
1 13 15 8 11
2 3 6 17 20
3 22 24 18 20
4 13 16 27 30
Now you can draw them over the image with rect:
image(m1)
rect(hs[,1],hs[,3],hs[,2],hs[,4])
and to show they are where they should be:
image(list(x=m1$x,y=m1$y,z=m1$z>0.95))
rect(hs[,1],hs[,3],hs[,2],hs[,4])
You could of course adapt this to draw circles, but more complex shapes would be tricky. It works best when the regions of interest are fairly compact.
Barry