Как поставить сложное уравнение в формулу R?

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

Однако мы не можем понять, как правильно поместить одно уравнение в соответствующий формат R formula .

В качестве примера можно использовать набор данных trees в R .

data(trees)
df <- trees
df$h <- df$Height * 0.3048   #transform to metric system
df$dbh <- (trees$Girth * 0.3048)/pi   #transform tree girth to diameter

Во-первых, пример уравнения, которое, кажется, работает хорошо:

enter image description here

form1 <- h ~ I(dbh ^ -1) + I( dbh ^ 2)  
m1 <- lm(form1, data = df)
m1

Call:
lm(formula = form1, data = df)

Coefficients:
(Intercept)    I(dbh^-1)     I(dbh^2)  
27.1147      -5.0553       0.1124  

Коэффициенты a , b и c оцениваются, что нас интересует.

Теперь проблематичное уравнение:

enter image description here

Попытка подойти так:

form2 <- h ~ I(dbh ^ 2)/dbh + I(dbh ^ 2) + 1.3

дает ошибку:

m1 <- lm(form2, data = df)
Error in terms.formula(formula, data = data) 
invalid model formula in ExtractVars

Думаю, это потому, что / интерпретируется как вложенная модель, а не арифметический оператор?

Это не дает ошибки:

form2 <- h ~ I(I(dbh ^ 2)/dbh + I(dbh ^ 2) + 1.3)
m1 <- lm(form2, data = df)

Но результат не тот, который нам нужен:

m1
Call:
lm(formula = form2, data = df)

Coefficients:
(Intercept)  I(I(dbh^2)/dbh + I(dbh^2) + 1.3)  
19.3883                            0.8727  

Дается только один коэффициент для всего члена внутри внешнего I() , который кажется логичным.

Как мы можем сопоставить второе уравнение с нашими данными?

9
nl ja de

3 ответы

У вас есть пара проблем. (1) Вам не хватает скобок для знаменателя form2 (и R не знает, что вы хотите добавить константу a в знаменатель или где на самом деле поставить любой из параметров) и гораздо более проблематично: (2) ваша вторая модель не является линейной , поэтому lm не будет работать.

Фиксация (1) проста:

form2 <- h ~ 1.3 + I(dbh^2)/(a + b * dbh + c * I(dbh^2))

Исправление (2), хотя есть много способов оценить параметры для нелинейной модели, nls (нелинейные наименьшие квадраты) - это хорошее место для начала:

m2 <- nls(form2, data = df, start = list(a = 1, b = 1, c = 1))

Вам нужно предоставить начальные предположения для параметров в nls . Я только что выбрал 1, но вы должны использовать лучшие догадки, которые могут повлиять на параметры.

12
добавлено
Спасибо за Ваш ответ! Нам потребовались бы годы, чтобы выявить эти проблемы и еще больше, чтобы найти решение.
добавлено автор donodarazao, источник

Предполагая, что вы используете nls , формула R может использовать обычную функцию R, H (a, b, c, D) , поэтому формула может быть просто h ~ H (a, b, c, dbh) , и это работает:

# use lm to get startingf values
lm1 <- lm(1/(h - 1.3) ~ I(1/dbh) + I(1/dbh^2), df)
start <- rev(setNames(coef(lm1), c("c", "b", "a")))

# run nls
H <- function(a, b, c, D) 1.3 + D^2/(a + b * D + c * D^2)
nls1 <- nls(h ~ H(a, b, c, dbh), df, start = start)

nls1 # display result

Графический вывод:

plot(h ~ dbh, df)
lines(fitted(nls1) ~ dbh, df)

enter image description here

11
добавлено
Я буду отмечать этот ответ как правильный, потому что а) он включает в себя, как оценивать начальные значения, б) использование обычной функции R позволяет нам легко подогнать другую нелинейную функцию и в) она отображает результаты. Благодаря!
добавлено автор donodarazao, источник

edit: fixed, no longer incorrectly using offset ...

Ответ, который дополняет @ shujaa's:

Вы можете преобразовать свою проблему из

H = 1.3 + D^2/(a+b*D+c*D^2)

в

1/(H-1.3) = a/D^2+b/D+c

Это обычно испортило бы предположения модели (т. Е. Если H обычно распределялся с постоянной дисперсией, то 1/(H-1.3) не был бы. , давайте попробуем все равно:

data(trees)
df <- transform(trees,
            h=Height * 0.3048,   #transform в metric system
            dbh=Girth * 0.3048/pi   #transform tree girth в diameter
            )
lm(1/(h-1.3) ~ poly(I(1/dbh),2,raw=TRUE),data=df)

## Coefficients:
##                    (Intercept)  poly(I(1/dbh), 2, raw = TRUE)1  
##                       0.043502                       -0.006136  
## poly(I(1/dbh), 2, raw = TRUE)2  
##                       0.010792  

These results would normally be good enough в get good starting values for the nls fit. However, you can do better than that via glm, which uses a link function в allow for some forms of non-linearity. Specifically,

(fit2 <- glm(h-1.3 ~ poly(I(1/dbh),2,raw=TRUE),
             family=gaussian(link="inverse"),data=df))

## Coefficients:
##                    (Intercept)  poly(I(1/dbh), 2, raw = TRUE)1  
##                       0.041795                       -0.002119  
## poly(I(1/dbh), 2, raw = TRUE)2  
##                       0.008175  
## 
## Degrees of Freedom: 30 вtal (i.e. Null);  28 Residual
## Null Deviance:       113.2 
## Residual Deviance: 80.05     AIC: 125.4 
## 

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

pframe <- data.frame(dbh=seq(0.8,2,length=51))

We use predict, but need в correct the prediction в account for the fact that we subtracted a constant from the LHS:

pframe$h <- predict(fit2,newdata=pframe,type="response")+1.3
p2 <- predict(fit2,newdata=pframe,se.fit=TRUE) ## predict on link scale
pframe$h_lwr <- with(p2,1/(fit+1.96*se.fit))+1.3
pframe$h_upr <- with(p2,1/(fit-1.96*se.fit))+1.3
png("dbh_tmp1.png",height=4,width=6,units="in",res=150)
par(las=1,bty="l")
plot(h~dbh,data=df)
with(pframe,lines(dbh,h,col=2))
with(pframe,polygon(c(dbh,rev(dbh)),c(h_lwr,rev(h_upr)),
      border=NA,col=adjustcolor("black",alpha=0.3)))
dev.off()

enter image description here

Because we have used the constant on the LHS (this almost, but doesn't quite, fit inв the framework of using an offset -- we could only use an offset if our formula were 1/H - 1.3 = a/D^2 + ..., i.e. if the constant adjustment were on the link (inverse) scale rather than the original scale), this doesn't fit perfectly inв ggplot's geom_smooth framework

library("ggplot2")
ggplot(df,aes(dbh,h))+geom_point()+theme_bw()+
   geom_line(data=pframe,colour="red")+
   geom_ribbon(data=pframe,colour=NA,alpha=0.3,
             aes(ymin=h_lwr,ymax=h_upr))

ggsave("dbh_tmp2.png",height=4,width=6)

enter image description here

10
добавлено