计算非线性最小二乘拟合的R ^ 2

时间:2013-01-25 21:35:54

标签: r

假设我有x个值,y值和预期y值f(来自某些非线性最佳拟合曲线)。

如何在R中计算R ^ 2?请注意,此函数不是线性模型,而是非线性最小二乘(nls)拟合,因此不适合lm

6 个答案:

答案 0 :(得分:16)

您只需使用lm函数拟合线性模型:

x = runif(100)
y = runif(100)
spam = summary(lm(x~y))
> spam$r.squared
[1] 0.0008532386

请注意,r平方没有为非线性模型定义,或者至少非常棘手,quote from R-help

  

有一个很好的理由是适合R的nls模型没有提供   r-squared-r-squared对于一般的nls模型没有意义。

     

一种思考r平方的方法是作为残差的比较   拟合模型的平方和与剩余平方和的平方和   一个由常数组成的普通模型。你不能   保证这是嵌套模型在处理时的比较   一个nls模型。如果模型没有嵌套,则这种比较不是   非常有意义。

     

所以答案是你可能不希望在第一次这样做   的地方。

如果您需要经过同行评审的证据,请参阅this article,例如;并不是你不能计算R ^ 2值,只是它可能与平面模型情况中的意思相同/具有相同的理想属性。

答案 1 :(得分:10)

听起来像f是你的预测值。因此,它们与实际值之间的距离由y *方差y

划分

类似

1-sum((y-f)^2)/(length(y)*var(y))

应该给你一个准的值,只要你的模型合理地接近线性模型并且n非常大。

答案 2 :(得分:4)

非线性模型的另一个准R平方是对实际y值和预测y值之间的相关性进行平方。对于线性模型,这是常规的R平方。

答案 3 :(得分:2)

作为对所提问题的直接回答(而不是认为R2 /伪R2无效)nagelkerke包中的rcompanion函数将报告非线性最小二乘的各种伪R2值(nls)模型由McFadden,Cox和Snell以及Nagelkerke提出,例如

require(nls)
data(BrendonSmall)
quadplat = function(x, a, b, clx) {
          ifelse(x  < clx, a + b * x   + (-0.5*b/clx) * x   * x,
                           a + b * clx + (-0.5*b/clx) * clx * clx)}
model = nls(Sodium ~ quadplat(Calories, a, b, clx),
            data = BrendonSmall,
            start = list(a   = 519,
                         b   = 0.359,
                         clx = 2304))
nullfunct = function(x, m){m}
null.model = nls(Sodium ~ nullfunct(Calories, m),
             data = BrendonSmall,
             start = list(m   = 1346))
nagelkerke(model, null=null.model)

soilphysics包还会将Efron的伪R2和调整后的nls模型的伪R2值报告为1 - RSS / TSS:

pred <- predict(model)
n <- length(pred)
res <- resid(model)
w <- weights(model)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(model)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)

也是由pseudo R2包中的accuracy函数计算的rcompanion。基本上,这个R2测量你的健康程度要比你只是画一条平坦的水平线要好多少。如果您的null模型是允许仅拦截模型的模型,则这对nls模型有意义。对于特定的其他非线性模型,它也是有意义的。例如。对于使用严格增加的样条曲线的scam模型(样条曲线中的bs =“mpi”),最坏情况的拟合模型(例如,您的数据严格减少的地方)将是一条平线,因此会导致R2为零。调整后的R2也会对具有更高n次拟合参数的模型进行惩罚。使用调整后的R2值已经解决了上述链接的许多批评,http://www.ncbi.nlm.nih.gov/pmc/articles/PMC2892436/(此外,如果通过使用信息标准进行模型选择,问题就变成了使用哪个 - AIC,BIC,EBIC ,AICc,QIC等)。

只需使用

r.sq <- max(cor(y,yfitted),0)^2
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df

我认为如果你有正常的高斯误差也是有意义的 - 即观察到的和拟合的y之间的相关性(截断为零,所以负关系意味着零预测能力)平方,然后调整为nr调整版本中的拟合参数。如果yyfitted朝同一方向前进,则会为常规线性模型报告R2adjusted R2值。对我来说,这至少是完全合理的,所以我不同意完全拒绝pseudo R2 nls模型对McFadden pseudo R2模型的有用性,因为上面的答案似乎暗示了这一点。

对于非正常的错误结构(例如,如果您使用的GAM具有非正常错误),1-residual deviance/null deviance 的定义类似于

--Incoming_orders:
Destination  Timestamp
ROUTE B      14/03/2018 7:48:00 
ROUTE A      14/03/2018 7:58:00
ROUTE A      14/03/2018 12:48:00
ROUTE C      14/03/2018 13:28:00

--Scheduled_Output
ROUTE A      14/03/2018 8:00:00
ROUTE A      14/03/2018 11:00:00
ROUTE A      14/03/2018 12:00:00
ROUTE A      14/03/2018 17:00:00    
ROUTE B      14/03/2018 8:00:00
ROUTE B      14/03/2018 10:00:00
ROUTE B      14/03/2018 12:00:00
ROUTE C      14/03/2018 07:00:00 
ROUTE C      14/03/2018 14:00:00 
ROUTE C      14/03/2018 17:00:00 

--Which would lead to the following outgoing_orders:
ROUTE A      14/03/2018 8:00:00
ROUTE B      14/03/2018 8:00:00 
ROUTE C      14/03/2018 14:00:00
ROUTE A      14/03/2018 17:00:00

有关有用的讨论,请参阅herehere

答案 4 :(得分:1)

作为这个问题的替代方案,我多次使用以下程序:

  1. 使用nls函数计算数据拟合
  2. 使用生成的模型进行预测
  3. 跟踪(绘制......)数据与模型预测的值(如果模型良好,点应该在bissectrix附近)。
  4. 计算线性régression的R2。
  5. 祝愿所有人。帕特里克。

答案 5 :(得分:0)

使用 modelr

modelr::rsquare(nls_model, data)

nls_model <- nls(mpg ~ a /  wt + b, data = mtcars, start = list(a = 40, b = 4))

modelr::rsquare(nls_model, mtcars)
# 0.794

这与 Tom 在 rcompanion 资源中描述的更长的方法基本相同。

使用 nagelkerke 函数的更长的方法

nullfunct <- function(x, m){m}
null_model <- nls(mpg ~ nullfunct(wt, m),
                 data = mtcars,
                 start = list(m = mean(mtcars$mpg)))

nagelkerke(nls_model, null_model)[2]
# 0.794 or 0.796

最后,使用预测值

lm(mpg ~ predict(nls_model), data = mtcars) %>% broom::glance()
# 0.795

就像他们说的,这只是一个近似值。