# Regression Lines With Same Intercept

So, I struggle with Regression a lot. I just found out how to get 2 lines with the same slope, but I cannot manage to get 2 lines with the same intercept. I read about ANCOVA a lot (because I thought this was what I needed), but no one uses the same intercepts; just the same slope. Can someone help out with this?

• lm(y~x+f:x) ... Oct 11, 2012 at 16:51
• how do I plot this?
– lisa
Oct 11, 2012 at 17:24

library(ggplot2)
set.seed(1)
x <-  1:10
dd <- rbind(data.frame(x=x,fac="a", y=x+rnorm(10)),
data.frame(x=2*x,fac="b", y=x+rnorm(10)))
coef <- lm(y~x:fac, data=dd)$coefficients qplot(data=dd, x=x, y=y, color=fac)+ geom_abline(slope=coef["x:faca"], intercept=coef["(Intercept)"])+ geom_abline(slope=coef["x:facb"], intercept=coef["(Intercept)"])  • I have a indicator variable ky which takes values 1 and 2, but if I try to do ["x:ky1"] it says that object does not exist. What am I missing? – lisa Oct 12, 2012 at 1:17 • look at the names of lm(y~x:fac, data=dd)$coefficients Oct 12, 2012 at 6:15

Although this is a quite old thread, it is probably noteworthy that @jem77bfp's answer appears to work only when the intercept term is zero or close to zero. Consider:

set.seed(1)
x <-  1:10
dd <- rbind(data.frame(x=10+x,fac="a", y=x+rnorm(10)),
data.frame(x=10+2*x,fac="b", y=x+rnorm(10)))
coef <- lm(y~x:fac, data=dd)$coefficients #(Intercept) x:faca x:facb # -7.0223128 0.8243321 0.6023107  And even more drastically off: set.seed(1) x <- 1:10 dd <- rbind(data.frame(x=100+x,fac="a", y=x+rnorm(10)), data.frame(x=100+4*x,fac="b", y=x+rnorm(10))) coef <- lm(y~x:fac, data=dd)$coefficients

# (Intercept)      x:faca      x:facb
# -32.4026986   0.3610346   0.3122729


@Ben Bolker's suggestion lm(y~x+f:x) fits two slopes and two intercepts, which can be seen from "correctly" predicting the slopes when both intercepts are different.

I don't know if there is a way to exploit lm, but you can certainly exploit minpack.lm::nls.lm specifying your own error model.

test <- data.frame(x = 1:10,
y1 = 10 + 2*1:10 + rnorm(10, sd = 0.05),
y2 = 10 + 8*1:10 + rnorm(10, sd = 0.05))

my_fun <- function(a, x, b1, b2) data.frame(y1 = a + x * b1, y2 = a + x * b2)

# this is the function which will yield the residuals; note that we need to unlist the data.frame finally
my_fun.res <- function(p, obs, x) unlist(obs - do.call(my_fun, c(list(x = x), as.list(p))))

minpack.lm::nls.lm(par = list(a = 1, b1 = 1, b2 = 1), fn = my_fun.res,
obs = test[, c("y1", "y2")], x = test\$x) -> pred

summary(pred)

# Parameters:
#    Estimate Std. Error t value Pr(>|t|)
# a  10.009693   0.025435   393.5   <2e-16 ***
# b1  2.001747   0.004517   443.1   <2e-16 ***
# b2  7.996578   0.004517  1770.3   <2e-16 ***
$$$$
`