R - locate intersection of two curves - r

There are a number of questions in this forum on locating intersections between a fitted model and some raw data. However, in my case, I am in an early stage project where I am still evaluating data.
To begin with, I have created a data frame that contains a ratio value whose ideal value should be 1.0. I have plotted the data frame and also used abline() function to plot a horizontal line at y=1.0. This horizontal line and the plot of ratios intersect at some point.
plot(a$TIME.STAMP, a$PROCESS.RATIO,
xlab='Time (5s)',
ylab='Process ratio',
col='darkolivegreen',
type='l')
abline(h=1.0,col='red')
My aim is to locate the intersection point, say x and draw two vertical lines at x±k, as abline(v=x-k) and abline(v=x+k) where, k is certain band of tolerance.
Applying a grid on the plot is not really an option because this plot will be a part of a multi-panel plot. And, because ratio data is very tightly laid out, the plot will not be too readable. Finally, the x±k will be quite valuable in my discussions with the domain experts.
Can you please guide me how to achieve this?

Here are two solutions. The first one uses locator() and will be useful if you do not have too many charts to produce:
x <- 1:5
y <- log(1:5)
df1 <-data.frame(x= 1:5,y=log(1:5))
k <-0.5
plot(df1,type="o",lwd=2)
abline(h=1, col="red")
locator()
By clicking on the intersection (and stopping the locator top left of the chart), you will get the intersection:
> locator()
$x
[1] 2.765327
$y
[1] 1.002495
You would then add abline(v=2.765327).
If you need a more programmable way of finding the intersection, we will have to estimate the function of your data. Unfortunately, you haven’t provided us with PROCESS.RATIO, so we can only guess what your data looks like. Hopefully, the data is smooth. Here’s a solution that should work with nonlinear data. As you can see in the previous chart, all R does is draw a line between the dots. So, we have to fit a curve in there. Here I’m fitting the data with a polynomial of order 2. If your data is less linear, you can try increasing the order (2 here). If your data is linear, use a simple lm.
fit <-lm(y~poly(x,2))
newx <-data.frame(x=seq(0,5,0.01))
fitline = predict(fit, newdata=newx)
est <-data.frame(newx,fitline)
plot(df1,type="o",lwd=2)
abline(h=1, col="red")
lines(est, col="blue",lwd=2)
Using this fitted curve, we can then find the closest point to y=1. Once we have that point, we can draw vertical lines at the intersection and at +/-k.
cross <-est[which.min(abs(1-est$fitline)),] #find closest to 1
plot(df1,type="o",lwd=2)
abline(h=1)
abline(v=cross[1], col="green")
abline(v=cross[1]-k, col="purple")
abline(v=cross[1]+k, col="purple")

Related

Trying to find point of intersection using approx function, results are correct on y but off on x axis

Working in R, I am attempting to plot stream cross sections, interpolate a point at an intersection opposite an identified "bankful" point, and calculate the area under the bankful line. It is part of a loop that is processing many cross sections. The best solution I have come up with is using the approx function, however all of the points are not exactly on the point of intersection and I have not been able to figure out what I am doing wrong.
It is hard to provide sample data since it is part of a loop, but the sample of code below produces the result in the image. The blue triangle is supposed to be at the point of intersection between the dashed "bankful" line and the solid cross section perimeter line.
###sample data
stn.sub.sort <- data.frame(dist = c(0,1.222,2.213,2.898,4.453,6.990,7.439,7.781,8.753,10.824,10.903,13.601,17.447), depth=c(-0.474,-0.633,0,-0.349,-1.047,-2.982,-2.571,-3.224,-3.100,-3.193,-2.995,-0.065,-0.112), Bankful = c(0,0,0,0,1,0,0,0,0,0,0,0,0))
###plot cross section with identified bankful
plot(stn.sub.sort$dist,
as.numeric(stn.sub.sort$depth),
type="b",
col=ifelse(stn.sub.sort$Bankful==1,"red","black"),
ylab="Depth (m)",
xlab="Station (m)",
ylim=range(stn.sub.sort$depth),
xlim=range(stn.sub.sort$dist),
main="3")
###visualize bankful line of intersection
abline(h=stn.sub.sort$depth[stn.sub.sort$Bankful==1],
lty=2,
col="black")
###approximate point at intersection
index.bf=which(stn.sub.sort$Bankful==1)
index.approx<-which(stn.sub.sort$dist>stn.sub.sort$dist[index.bf])
sbf <- approx(stn.sub.sort$depth[index.approx],
stn.sub.sort$dist[index.approx],
xout=stn.sub.sort$depth[index.bf])
###plot opposite bankful points
points(sbf$y,sbf$x,pch=2,col="blue")
So your description leaves many questions about the nature of the data that you will have to deal with. I am going to assume that it will be roughly like your example - down from the first bankful point, then going back up with the curve crossing the depth of the bankful point just one more time.
With that assumption, it is easy to find the point before and the point after the crossing point. You just need to draw the line between those two points and solve for the correct dist value. I do this below by using approxfun to get the inverse function of the line connecting the two points. Then we can just plug in to get the dist-value of the crossing point.
BankfulDepth = stn.sub.sort$depth[stn.sub.sort$Bankful==1]
Low = max(which(stn.sub.sort$depth < BankfulDepth))
InvAF = approxfun(stn.sub.sort$depth[c(Low,Low+1)],
stn.sub.sort$dist[c(Low,Low+1)])
points(InvAF(BankfulDepth), BankfulDepth, pch=2,col="blue")

In R, find non-linear lines from two sets of points and then find the intersection of those points

Using R, I want to estimate two curves using points from two vectors, and then find the x and y coordinates where those estimated curves intersect.
In a strategic setting with players "t" and "p", I am simulating best responses for both players in response to what the other would pick in a strategic setting (game theory). The problem is that I don't have functions or lines, I have two sets of points originating from simulation, with one set of points corresponding to the player's best response to given actions by the other player. The actual math was too difficult for me (or matlab) to solve, which is why I'm using this simulated visual approach. I want to estimate best response functions (i.e. create non-linear curves) using the points, and then take the two estimated curves and find where they intersect in order to identify nash equilibrium (where the best response curves intersect).
As an example, here are two such vectors I am working with:
t=c(10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0)
p=c(12.3,12.3,12.3,12.3,12.3,12.3,12.4,12.4,12.4,12.5,12.5,12.5,12.6,12.6,12.7,12.7,12.8,12.8,12.9,12.9,13.0,13.1,13.1,13.2,13.3,13.4,13.5,13.4,13.5,13.6,13.6,13.7,13.8,13.8,13.9,13.9,13.9,14.0,14.0,14.0,14.0)
For the first line, the sample is made up of (t,a), and for the second line, the sample is made up of (a,p) where a is a third vector given by
a = seq(10, 14, by = 0.1)
For example, the first point for the sample corresponding to the first vector would be (10.0,10.0) and the second point would be (10.0,10.1). The first point for the sample corresponding to the second vector would be (10.0,12.3) and the second point would be (10.1,12.3).
What I originally tried to do is estimate the lines using polynomials produced by lm models, but those don't seem to always work:
plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")
fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(10,14), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")
fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4]
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]
a_opt1 = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(10,14))$minimum
b_opt1 = as.numeric(fit4pCurve(a_opt1))
EDIT:
After fixing the type, I get the correct answer, but it doesn't always work if the samples don't come back as cleanly.
So my question can be broken down a few ways. First, is there a better way to accomplish what I'm trying to do. I know what I'm doing isn't perfectly accurate by any means, but it seems like a decent approximation for my purposes. Second, if there isn't a better way, is there a way I could improve on the methodology I have listed above.
Restart your R session, make sure all variables are cleared and copy/paste this code. I found a few mistakes in referenced variables. Also note that R is case sensitive. My suspicion is that you've been overwriting variables.
plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")
fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(T,P), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")
fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4]
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]
a_opt = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(T,P))$minimum
b_opt = as.numeric(fit4pCurve(a_opt))
As you will see:
> a_opt
[1] 12.24213
> b_opt
[1] 10.03581

Area of polygon in ordiellipse is NaN - why?

I'm trying to add ellipses onto my NMDS plot created with Vegan package on R, but although the code goes through without an error, no polygons get drawn onto my graph. After using the summary() function, I found that the area of the polygon is NaN, hence why no polygons get drawn. I'm not sure why I don't have an area - is it something to do with my data?
My data can be found here: https://docs.google.com/spreadsheets/d/1uxWbKAvhdVqnorIMXURvYLrDZuoqejJpUsc9N6wSDxA/edit?usp=sharing
Three transects were done in three types of habitat - Interior forest, edge of the forest and disturbed habitat. Each dragonfly and damselfly seen was counted.
My R code is as follows:
OdonateNMDSdata <- read.csv(file.choose(), header=TRUE)
Odonaterownames <- row.names(OdonateNMDSdata) <- c("Interior", "Edge", "Disturbed")
library(vegan)
OdonateNMDS <- metaMDS(OdonateNMDSdata, k=2)
ordiplot(OdonateNMDS,type="n")
orditorp(OdonateNMDS,display="species",col="red",air=0.01)
orditorp(OdonateNMDS,display="sites",cex=1.25,air=0.01)
Ellipse <- ordiellipse(OdonateNMDS, groups=Odonaterownames, kind = "ehull", draw="polygon", col="blue", cex=0.7, conf=0.95)
summary(Ellipse)
Thanks
You have three points, and you want to draw three ellipses, one for each point. You need more than one point for each ellipse (and even for two points the enclosing ellipse would be a line connecting the points).
However, it seems that with enclosing ellipse (kind = "ehull") we give NaN as the area of one-point-ellipse, whereas with other kinds we give the area as 0 for one point. I'll change that.

Plotting a fitted quadratic curve in r

I have some data which I have fit a quadratic curve to using
model<-lm(Frequency ~ poly(Distance, 2, raw=TRUE))
I want to then draw this curve on the scatterplot of my data. I've tried using
lines(predict(model))
based on some information I find online, but it doesn't work quite right as the resulting curve is squished into the left side of the plot.
Ignore the regression line.
I believe the problem is that my variable Distance is a set of values each 5 greater than the previous, and that when I plot the curve it ignores this and plots using increments of 1. What I'm not sure of is how to fix it. Any help would be appreciated.

GraphPad Mann Whitney scatter plot in R

I try to make a plot similar to the top three plot of this:
I found a partial answer here, however I am unsure how to add the p-values in the scatter-plot.
Any tips?
You've already got a partial answer. If you just want to know how to put p-values on then use text. (looking at graph C).
text(x = 1.5, y = 73, 'p = 0.03')
If you want the p-values and the lines underneath, assuming you also want those caps on the lines, use arrows instead of segments.
arrows(1, 70, 2, length = 2, angle = 90, code = 3)
If you're sticking with solving this in base R that's a great learning exercise and can give you full control over your plot. However, if you just want to get it done I'd suggest the beeswarm package (you're making beeswarm plots).
As an aside, this prompted me to investigate why you get those upward curving lines in beeswarm plots. It's a consequence of the typical algorithm. The line curves upward because the positions are calculated through increasing y-values. If the next y-value is so close that the points would overlap in the y-axis it's plotted at an angle off the x position. Many points close together on Y results in upward curving lines until you get far enough along Y to go back to X. Smaller points should alleviate that. Also, the beeswarm package in R has several optional algorithms that avoid that as well.

Resources