Is there a way to draw a simple ellipse based on the following definition (instead of eigenvalue) in R?
The definition I want to use is that an ellipse is the set of points in a plane for which the sum of the distances to two fixed points F1 and F2 is a constant.
Should I just use a polar cordinate?
This may be more algorithmic question.
As #DWin suggested, there are several implementations for plotting ellipses (such as function draw.ellipse in package plotrix). To find them:
RSiteSearch("ellipse", restrict="functions")
That being said, implementing your own function is fairly simple if you know a little geometry. Here is an attempt:
ellipse <- function(xf1, yf1, xf2, yf2, k, new=TRUE,...){
# xf1 and yf1 are the coordinates of your focus F1
# xf2 and yf2 are the coordinates of your focus F2
# k is your constant (sum of distances to F1 and F2 of any points on the ellipse)
# new is a logical saying if the function needs to create a new plot or add an ellipse to an existing plot.
# ... is any arguments you can pass to functions plot or lines (col, lwd, lty, etc.)
t <- seq(0, 2*pi, by=pi/100) # Change the by parameters to change resolution
k/2 -> a # Major axis
xc <- (xf1+xf2)/2
yc <- (yf1+yf2)/2 # Coordinates of the center
dc <- sqrt((xf1-xf2)^2 + (yf1-yf2)^2)/2 # Distance of the foci to the center
b <- sqrt(a^2 - dc^2) # Minor axis
phi <- atan(abs(yf1-yf2)/abs(xf1-xf2)) # Angle between the major axis and the x-axis
xt <- xc + a*cos(t)*cos(phi) - b*sin(t)*sin(phi)
yt <- yc + a*cos(t)*sin(phi) + b*sin(t)*cos(phi)
if(new){ plot(xt,yt,type="l",...) }
if(!new){ lines(xt,yt,...) }
}
An example:
F1 <- c(2,3)
F2 <- c(1,2)
plot(rbind(F1, F2), xlim=c(-1,5), ylim=c(-1, 5), pch=19)
abline(h=0, v=0, col="grey90")
ellipse(F1[1], F1[2], F2[1], F2[2], k=2, new=FALSE, col="red", lwd=2)
points((F1[1]+F2[1])/2, (F1[2]+F2[2])/2, pch=3)
Related
I would like to fit a line through two points from a random distribution of points, then calculate the location along that line that each point intersects it orthogonally. I am not interested in the residual distance of each point from the line (points above/below the line are treated equally), I am only interested in calculating the location along the line of where that point would intersect (e.g. points at different distances from the line but at the same orthogonal location would have the same value). The data aren't connected to the line explicitly as the abline is drawn from the location of only 2 points, and so i can't extract these values in a classic residual type way. I don't think this is difficult, but I can't wrap by head around how to calculate it and it's really bugging me!
I have explored the dist2d function but that calculates the orthogonal distance of each point to the line. Is there a way to use that value to the then calculate the hypotenuse from the data point to some fixed constant point on the line, and then in turn calculate the adjacent distance from that constant? I would really appreciate any help!
#here is some example starter code here to visualise what I mean
#get random data
r = rnorm(100)
t = rnorm(100)
#bind and turn into a df
data = cbind(r,t)
data = as.data.frame(data)
head(data)
#plot
plot(data)
#want to draw abline between 2 points
#isolate points of interest
#here randomly select first two rows
d = data[c(1:2),]
head(d)
#calculate abline through selected points
lm = lm(t ~ r, d)
abline(lm)
#draw points to see which ones they cut through
points(d$r, d$t, bg = "red", pch = 21)
This code below works.
# Create dataframe
data = data.frame(x = rnorm(100), y = rnorm(100))
plot(data, xlim=c(-3, 3), ylim=c(-3, 3))
# Select two points
data$x1_red <- data[1,1]; data$y1_red <- data[1,2]; data$x2_red <- data[2,1]; data$y2_red <- data[2,2];
points(data$x1_red, data$y1_red, bg = "red", pch = 21); points(data$x2_red, data$y2_red, bg = "red", pch = 21);
# Show a red line where the points intersect
# Get its slope (m_red) and intercept (b_red)
data$m_red <- (data[2,2] - data[1,2]) / (data[2,1] - data[1,1])
data$b_red <- data$y1_red - data$m * data$x1_red
abline(data$b_red, data$m_red, col='red')
# Calculate the orthogonal slope
data$m_blue <- (-1/data$m_red)
abline(0, data$m_blue, col='blue')
# Solve for each point's b-intercept (if using the blue slope)
# y = m_blue * x + b
# b = y - m_blue * x
data$b <- data$y - data$m_blue * data$x
# Solve for where each point (using the m_blue slope) intersects the red line (x' and y')
# y' = m_blue * x' + b
# y' = m_red * x' + b_red
# Set those equations equal to each other and solve for x'
data$x_intersect <- (data$b_red - data$b) / (data$m_blue - data$m_red)
# Then solve for y'
data$y_intersect <- data$m_blue * data$x_intersect + data$b
# Calculate the distance between the point and where it intersects the red line
data$dist <- sqrt( (data$x - data$x_intersect)^2 + (data$y - data$y_intersect)^2 )
Given a set of data I have calculated an ellipse that fit to them using the next command:
eli<-ellipse(cor(x,y),scale=c(sd(x),sd(y)), centre=c(mean(x), mean(y)), level = 0.95)
Where "x" and "y" are the columns of my bivariate data. I would like to know how to find the elements of my ellipse (in red), say: the foci and the a" and "b" values.
In an attempt to find the semi-axis distance I tried to get a lineal regression of the data but I truly doubt of my method
How can I find those parameters? Or get the equation of the ellipse?
Since ellipse generates 100 points, this approach may be accurate enough. Of course you could set npoints to higher value to increase accuracy. I've also made plots to explain.
#rm(list = ls()) #Remove everything from the environment
#Generate some points
set.seed(42)
x = rnorm(20,5,1)
y = rnorm(20,5,2)
#Fit Ellipse
require(ellipse)
eli = ellipse(cor(x,y),scale=c(sd(x),sd(y)), centre=c(mean(x), mean(y)), level = 0.95, npoints = 250)
#Draw ellipse and points
plot(eli[,1], eli[,2], type = "l", asp = 1)
points(x,y)
#Calculate the center of ellipse
eli_center = c(mean(eli[,1]), mean(eli[,2]))
#Plot eli_center
points(eli_center[1], eli_center[2], pch = 19, cex = 1.5)
#A function to calculate distance between points 'x1' and 'x2'
dist_2_points <- function(x1, x2) {
return(sqrt(sum((x1 - x2)^2)))
}
#Compute distance of each point in ellipse from eli_center
distance = numeric(0)
for (i in 1:nrow(eli)){
distance[i] = dist_2_points(eli_center, eli[i,])
}
#The maximum distance from eli_center is 'a'
a = distance[which.max(distance)]
a_point = eli[ which.max(distance), ]
#Draw 'a'
points(a_point[1],a_point[2], pch = 5)
lines(rbind(eli_center, a_point))
#The minimum distance from eli_center is 'b'
b = distance[which.min(distance)]
b_point = eli[ which.min(distance), ]
#Draw 'b'
points(b_point[1],b_point[2], pch = 5)
lines(rbind(eli_center, b_point))
#find foci
foci = sqrt(a^2 - b^2)
This is the code that the car:::ellipse function uses after doing some error checking and other "housekeeping":
angles <- (0:segments) * 2 * pi/segments
unit.circle <- cbind(cos(angles), sin(angles))
Q <- chol(shape, pivot = TRUE)
order <- order(attr(Q, "pivot"))
ellipse <- t(center + radius * t(unit.circle %*% Q[, order]))
colnames(ellipse) <- c("x", "y")
You will notice that the regression line you drew was a bit "off-axis". If you drew in the line from X regressed on Y it would also be "off-axis" in the other direction. Do a search on "total least squares regression" or "Deming regression" (and you'll find some other names that I'm not coming up with off the top of my head.) Regression lines determined by ordinary least squares lines do not go through the major axis of the ellipse that that you are calculating.
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()
Rotate a plot (with below rotation setting) seems to be impossible in R according to Google.
So I am looking for a way to do that, but still no success till now.
Rotation setting :
The rotation center is the origin of plot ({0,0})
The given angle will be the angle between the y axis and the plot.
Here is a code where
a is something depending on angle and x axis length. (I think)
b is something depending on angle and y axis length. (I think)
:
speed <- cars$speed
dist <- cars$dist
plot(speed,dist, xlim=c(0,121), ylim=c(0,121))
xTemp <- speed
speed <- speed + (a)
dist <- dist + (b)
par(new=TRUE)
plot(speed,dist, xlim=c(0,121), ylim=c(0,121), col="red")
Any idea of a and b values ?
Here is for example a code in wich the plot is rotated by about 50 degrees from the y axis (Notice that is is not a true rotation. speed value is extended after rotation.. I don't now how to fix it.) :
speed <- cars$speed
dist <- cars$dist
plot(speed,dist, xlim=c(0,121), ylim=c(0,121))
xTemp <- speed
speed <- speed + dist
dist <- dist - xTemp
par(new=TRUE)
plot(speed,dist, xlim=c(0,121), ylim=c(0,121), col="red")
Just apply a rotation matrix
to your data.
angle <- pi/3
M <- matrix( c(cos(angle), -sin(angle), sin(angle), cos(angle)), 2, 2 )
plot( as.matrix(cars[,c("speed","dist")]) %*% M )
What happens may be clearer on a different example:
library(mlbench)
d <- mlbench.smiley()$x
op <- par(mfrow=c(1,2))
plot(d, asp=1)
plot(as.matrix(d) %*% M, col="red", asp=1)
par(op)
It looks I found the solution :
speed <- cars$speed
dist <- cars$dist
angle <- 45
plot(speed,dist, xlim=c(-121,121), ylim=c(-121,121))
speed1 <- double(); dist1=double()
for(i in 1:length(speed)){
sq <- sqrt((speed[i]*speed[i]) + (dist[i]*dist[i]))
angleInit <- (180*atan(dist[i]/speed[i]))/pi
angle2 <- angleInit - angle
speed1[i] <- cos(pi*angle2/180) * sq
dist1[i] <- sin(pi*angle2/180) * sq
}
par(new=TRUE)
plot(speed1,dist1, xlim=c(-121,121), ylim=c(-121,121), col="red")
Thank you
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