如何将一个复杂的方程转化为R公式?
我们以树木直径作为预测因子,树高作为因变量。对于这类数据,存在许多不同的方程,我们尝试对其中一些方程进行建模并比较结果 然而,我们无法找出如何正确地将一个方程放入相应的如何将一个复杂的方程转化为R公式?,r,statistics,data-modeling,regression,linear-regression,R,Statistics,Data Modeling,Regression,Linear Regression,我们以树木直径作为预测因子,树高作为因变量。对于这类数据,存在许多不同的方程,我们尝试对其中一些方程进行建模并比较结果 然而,我们无法找出如何正确地将一个方程放入相应的R公式格式中 R中的树数据集可以用作示例 data(trees) df <- trees df$h <- df$Height * 0.3048 #transform to metric system df$dbh <- (trees$Girth * 0.3048) / pi #transform tree
R
公式
格式中
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
给出一个错误:
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()
中的整个项,只给出了一个系数,这似乎是合乎逻辑的
我们怎样才能使第二个方程式与我们的数据相吻合 你有几个问题。(1)
form2
的分母缺少括号(而且R无法知道您想在分母中添加一个常量a
,或者在哪里放置任何参数,实际上),而且问题更大:(2)您的第二个模型不是线性的,因此lm
无法工作
固定(1)很容易:
您需要为
nls
中的参数提供起始猜测。我刚刚选择了1,但您应该更好地猜测大概参数是什么。编辑:已修复,不再错误地使用偏移量…
一个补充@shujaa的答案:
你可以把你的问题从
H = 1.3 + D^2/(a+b*D+c*D^2)
到
这通常会打乱模型的假设(即,如果H
为正态分布且方差为常数,则1/(H-1.3)
不会。不过,我们还是试试吧:
data(trees)
df <- transform(trees,
h=Height * 0.3048, #transform to metric system
dbh=Girth * 0.3048 / pi #transform tree girth to 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
您可以看到,结果与线性拟合大致相同,但不完全相同
pframe <- data.frame(dbh=seq(0.8,2,length=51))
因为我们在LHS上使用了常数(这几乎但不完全符合使用偏移量的框架——我们只能在公式为1/H-1.3=a/D^2+…
的情况下使用偏移量,也就是说,如果常数调整是在链接(反向)比例上,而不是在原始比例上),这并不完全适合ggplot
的geom_-smooth
框架
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)
假设您使用的是
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
我会将此答案标记为正确答案,因为a)它包括如何估计起始值,b)使用普通R函数允许我们非常容易地拟合其他非线性函数,c)它绘制结果。谢谢谢谢你的回答!我们要花很多时间才能发现这些问题,甚至更长时间才能找到解决方案。
1/(H-1.3) = a/D^2+b/D+c
data(trees)
df <- transform(trees,
h=Height * 0.3048, #transform to metric system
dbh=Girth * 0.3048 / pi #transform tree girth to 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
(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 Total (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))
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()
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)
# 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)