Почему пересечение полиномиальной аппроксимации не соответствует y-значениям графика и приводит к запутанным линиям?

Я пытаюсь подогнать полиномы разных порядков к набору данных и построить полученные кривые на диаграмме рассеяния. Мой полином первого порядка выглядит нормально:

fit1

но когда я добавляю термины более высокого порядка, появляется куча чепухи (для меня). Есть идеи, почему это так?

Вот моя кривая третьей степени:

fit3

Там есть смутно выглядящая полиномиальная вещь третьей степени, но ее точка пересечения по оси y, кажется, составляет около 5, тогда как сводка полинома дает точку пересечения 3,5:

summary

Вот соответствующий код:

PS1 <- read.csv("PhrynoSpermo.csv")
phryno <- PS1$Phrynosoma.solare[1:330]
spermo <- PS1$Spermophilus.tereticaudus[1:330]
plot(spermo, phryno, pch=20, ylab="P. solare", xlab = "S. tereticaudus")
fit1 <- lm(phryno~spermo)
fit2 <- lm(phryno~poly(spermo,2))
fit3 <- lm(phryno~poly(spermo,3))
fit4 <- lm(phryno~poly(spermo,4))
lines(spermo,predict(fit1),col="red")
lines(spermo,predict(fit2),col="green")
lines(spermo,predict(fit3),col="blue")
lines(spermo,predict(fit4),col="purple")

И я понимаю, что ни один из них не подходит очень хорошо, но я просто хочу понять, что происходит.


r regression linear-regression curve-fitting poly
person reco    schedule 07.08.2020    source источник
comment
Предоставьте свои данные в воспроизводимом формате, чтобы мы могли скопировать /paste в R, чтобы проверить себя. Фотографии данных не помогают.   -  person MrFlick    schedule 07.08.2020
comment
Возможный дубликат stackoverflow.com/ вопросы/36519983/   -  person MrFlick    schedule 07.08.2020

Ответы (1)


arrow_upward
0
arrow_downward

Ваша первая проблема уже рассмотрена в этом ответе, поэтому я сосредоточусь на вашей второй проблеме, почему перехват вашей полиномиальной подгонки не работает не соответствуют y-значениям вашего графика.

Причина в том, что poly по умолчанию использует ортогональные полиномы, поэтому вам нужно использовать raw=TRUE. Сравнить:

fit.o <- lm(y ~ poly(x, 2, raw=FALSE))
fit.r <- lm(y ~ poly(x, 2, raw=TRUE))

fit.o$coefficients
# (Intercept) poly(x, 2, raw = FALSE)1 poly(x, 2, raw = FALSE)2 
#    1.057333                -2.279484                 2.376741 

fit.r$coefficients
# (Intercept) poly(x, 2, raw = TRUE)1 poly(x, 2, raw = TRUE)2 
#  1.62373208             -0.53938558              0.08607933

Коэффициенты разные, а подогнанные значения одинаковые.

all.equal(fit.o$fitted.values, fit.r$fitted.values)
# [1] TRUE

Правая панель следующего графика показывает различия. Я использую довольно уродливую xaxs="i" здесь, чтобы сделать линии более узкими к осям.

op <- par(mfrow=c(1, 2))
## left panel
plot(x, y, xaxs="i")
lines(x, predict(fit.r), col=2)
legend("topright", "fit unordered", lty=1, col=2, cex=.8)
## right panel
plot(x, y, xaxs="i")
lines(x[order(x)], predict(fit.r)[order(x)], col=2)
abline(h=fit.o$coefficients[1], lty=2, col=4)  ## orthogonal
abline(h=fit.r$coefficients[1], lty=2, col=3)  ## raw
legend("topright", c("fit ordered", "raw intercept", "orthog. intercept"), 
       lty=c(1, 2, 2), col=2:4, cex=.8)
par(op)

введите здесь описание изображения

Вы можете видеть, что необработанная точка пересечения идеально соответствует точке пересечения полиномиальной кривой.

Данные игрушек:

x <- with(iris, Petal.Length - min(Petal.Length))
y <- with(iris, Sepal.Width - min(Sepal.Width))
person jay.sf    schedule 07.08.2020