Нахождение, где два линейных пересечения пересекаются в R - PullRequest
7 голосов
/ 19 августа 2011

У меня есть два линейных подгонки, которые я получил от вызовов lm в моем R-скрипте. Например ...

fit1 <- lm(y1 ~ x1)
fit2 <- lm(y2 ~ x2)

Я бы хотел найти точку (x, y), в которой эти две линии (fit1 и fit2) пересекаются, если они вообще пересекаются.

Ответы [ 4 ]

11 голосов
/ 19 августа 2011

Вот некоторая геометрия средней школы; -)

# First two models
df1 <- data.frame(x=1:50, y=1:50/2+rnorm(50)+10)
m1 <- lm(y~x, df1)

df2 <- data.frame(x=1:25, y=25:1*2+rnorm(25)-10)
m2 <- lm(y~x, df2)

# Plot them to show the intersection visually    
plot(df1)
points(df2)

# Now calculate it!    
a <- coef(m1)-coef(m2)
c(x=-a[[1]]/a[[2]], y=coef(m1)[[2]]*x + coef(m1)[[1]])

Или, чтобы упростить решение на основе solve с помощью @Dwin:

cm <- rbind(coef(m1),coef(m2)) # Coefficient matrix
c(-solve(cbind(cm[,2],-1)) %*% cm[,1])
# [1] 12.68034 16.57181 
7 голосов
/ 19 августа 2011

Один из способов избежать геометрии состоит в том, чтобы повторно параметризовать уравнения как:

y1 = m1 * (x1 - x0) + y0
y2 = m2 * (x2 - x0) + y0

с точки зрения их точки пересечения (x0, y0), а затем выполнить согласование обоих одновременно, используя nls, такчто возвращенные значения x0 и y0 дают результат:

# test data
set.seed(123)
x1 <- 1:10
y1 <- -5 + x1 + rnorm(10)
x2 <- 1:10
y2 <- 5 - x1 + rnorm(10)
g <- rep(1:2, each = 10) # first 10 are from x1,y1 and second 10 are from x2,y2

xx <- c(x1, x2)
yy <- c(y1, y2)
nls(yy ~ ifelse(g == 1, m1 * (xx - x0) + y0, m2 * (xx - x0) + y0),
    start = c(m1 = -1, m2 = 1, y0 = 0, x0 = 0))

РЕДАКТИРОВАТЬ: Обратите внимание, что строки xx<-... и yy<-... являются новыми, и строка nls была указана всроки их и исправлены.

4 голосов
/ 19 августа 2011

Если коэффициенты регрессии в двух моделях не равны (что почти наверняка), то линии будут пересекаться.Функция coef используется для их извлечения.Остальное - геометрия средней школы.

Для Брэндона: M ^ -1% *% перехватывает ->

M <- matrix( c(coef(m1)[2], coef(m2)[2], -1,-1), nrow=2, ncol=2 )
intercepts <- as.matrix( c(coef(m1)[1], coef(m2)[1]) )  # a column matrix
 -solve(M) %*% intercepts
#        [,1]
#[1,] 12.78597
#[2,] 16.34479
2 голосов
/ 17 февраля 2016

Я немного удивлен, что для этого нет встроенной функции.

Здесь находится элементарная функция (для результатов lm), использующая тот же общий метод, что и Томми выше. При этом используется метод простой замены для двух линий в форме "y = mx + b", чтобы найти общее пересечение в точке y (y1 = y2; m1 * x + b1 = m2 * x + b2), и решается для x:

Определение функции

# Linear model Intercept function
lmIntx <- function(fit1, fit2, rnd=2) {
  b1<- fit1$coefficient[1]  #y-int for fit1
  m1<- fit1$coefficient[2]  #slope for fit1
  b2<- fit2$coefficient[1]  #y-int for fit2
  m2<- fit2$coefficient[2]  #slope for fit2
  if(m1==m2 & b1==b2) {print("Lines are identical")
  } else if(m1==m2 & b1 != b2) {print("Lines are parallel")
  } else {
    x <- (b2-b1)/(m1-m2)      #solved general equation for x
    y <- m1*x + b1            #plug in the result
    data.frame(x=round(x, rnd), y=round(y, rnd))
  }
}

Тест:

line1 <- data.frame(x=c(0,1), y=c(0,2))
line2 <- data.frame(x=c(0,1), y=c(1,3))
line3 <- data.frame(x=c(0,1), y=c(1,5))

lmIntx(lm(line1$y~line1$x), lm(line2$y~line2$x))
[1] "Lines are parallel"


lmIntx(lm(line1$y~line1$x), lm(line1$y~line1$x))
[1] "Lines are identical"

lmIntx(lm(line1$y~line1$x), lm(line3$y~line3$x))
               x  y
(Intercept) -0.5 -1
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...