使用mob()树(partykit包)和nls()模型

时间:2016-05-04 20:29:58

标签: r nls party

我尝试使用基于模型的递归分区(MOB)与mob()函数(来自partykit包)来分隔使用{{1}导出的几条曲线功能。我必须定义我的模型并确定起始值。我一直试图看看这是否可以与nls()功能一起使用无效。

我尝试过第7页的示例: https://cran.r-project.org/web/packages/partykit/vignettes/mob.pdf 我创建了一个拟合函数来估计起始值,并返回mob()的估计值等。但在那之后我似乎无法做任何事情。我想知道是否可以使用自定义模型,系数以及相关变量和自变量,并将它们包含在nls()中并使其工作。我尝试了mob()函数,但当然这只会给出一条直线。

我的代码如下。基本上我使用分段线性回归来获得我正在使用的双指数曲线的起始值。这是我基本上得到的最远的。参数估计给出了一个错误等,如果你甚至过去它只是不会运行。我只需要知道lmtree()函数是否可以运行mob()

我加载了示例数据,但是如果可以使用nls()

nls()

以下是我的示例数据:

    photo.try <- function(y, x,start = NULL, weights = NULL, offset = NULL, estfun = FALSE, object = TRUE) 
        {
            lin.mod1 <- lm(y ~ x)
            segmented.mod.2 <- segmented(lin.mod1, seg.Z = ~x, psi=1)
            segmented.mod1 <- segmented(lin.mod1, seg.Z = ~x, psi =  segmented.mod.2$psi[1,2])
            nls(y ~ (a*exp(-b * x) - c* exp(-d* x)), start = list(a = -1*(intercept(segmented.mod1)[[1]][1,1]) , b = slope(segmented.mod1)[[1]][1,1], 
            c = -1*(intercept(segmented.mod1)[[1]][2,1]), 
            d = -1*slope(segmented.mod1)[[1]][2,1]))

        }

photo_form <- Pn ~ (a*exp(-b * PAR) - c* exp(-d* PAR))| Species


photo_tree <- mob(photo_form, data = eco, fit = (photo.try))

1 个答案:

答案 0 :(得分:2)

是的,我们可以! ; - )

原则上,你试图做正确的事,但有些方面并不完全正确。主要问题是如何传递数据和公式:由于mob()nls()指定公式的方式一无所知,因此需要使用普通公式Pn ~ PAR | Species,然后fit函数需要知道如何处理数据。 mob()提供的预处理可以建立模型矩阵(具有截距,伪/对比编码等)或模型框架(其中因子仍然是因子等)。在这种情况下,最简单的方法是使用默认模型矩阵,然后在拟合函数中省略截距。

您的代码的第二个问题是您使用了fit函数的扩展规范(带有estfunobject参数),但只提供了拟合的模型对象。根据该规范,mob()期望fit函数设置包含coefficientsobjfun等的合适列表。

结合使用,这意味着您的fit函数应如下所示:

photofit <- function(y, x = NULL, start = NULL, weights = NULL, offset = NULL, ...,
  estfun = FALSE, object = FALSE)
{
  ## only use first real regressor (without intercept)
  x <- x[, 2]

  ## obtain starting values if necessary
  if(is.null(start)) {
    aux_lm <- lm(y ~ x)
    aux_seg_2 <- segmented::segmented(aux_lm, seg.Z = ~ x, psi = 1)
    aux_seg_1 <- segmented::segmented(aux_lm, seg.Z = ~ x, psi = aux_seg_2$psi[1, 2])
    start <- list(
      a = -1 * (segmented::intercept(aux_seg_1)[[1]][1, 1]),
      b =           segmented::slope(aux_seg_1)[[1]][1, 1], 
      c = -1 * (segmented::intercept(aux_seg_1)[[1]][2, 1]), 
      d = -1 *      segmented::slope(aux_seg_1)[[1]][2, 1]
    )
  } else {
    start <- as.list(start)
  }

  ## estimate NLS model
  rval <- nls(y ~ (a * exp(-b * x) - c * exp(-d * x)), start = start)

  ## return processed information for mob()
  list(
    coefficients = coef(rval),
    objfun = deviance(rval),
    estfun = if(estfun) sandwich::estfun(rval) else NULL,
    object = if(object) rval else NULL    
  )
}

然后你可以增长MOB树。指定verbose = TRUE控件选项会在您等待时为您提供一些进度信息:

photomob <- mob(Pn ~ PAR | Species, data = eco, fit = photofit,
  control = mob_control(verbose = TRUE))
coef(photomob)
##           a             b         c             d
## 4  2.967680 -3.216708e-05  1.519680  1.076879e+01
## 5 -1.811596  1.967366e-02 -3.573079 -4.877852e-05
## 6 -2.772783  1.438087e-02 -4.177953 -7.821814e-05
## 8 -2.427253  1.757744e-02 -4.449105 -1.328930e-04
## 9 -4.579248  1.020021e-02 -5.714575 -7.502393e-05

然后,您还可以将树可视化。默认情况下,每个节点都会显示数字摘要,但您也可以轻松显示拟合曲线:

plot(photomob)
plot(photomob, terminal_panel = node_bivplot, tnex = 2)

photomob visualization 1

photomob visualization 2

如您所见,树选择了五个具有不同参数的终端节点。我建议您对不同节点中的模型拟合进行更多诊断,因为我不确定所有参数的识别情况。我对NLS不太熟悉并且可能完全错误,但似乎并非所有参数都可以可靠地确定。

作为一个例子,我执行以下操作:从树中提取所有九个拟合nls个对象。对于来自根节点(节点1)的模型,我通过对所有观察梯度贡献求和(由estfun()方法计算)来计算梯度:

photonls <- refit.modelparty(photomob)
library("sandwich")
colSums(estfun(photonls[[1]]))
##             a             b             c             d 
##  2.010552e-05  5.753230e-02 -1.166331e-04  6.771585e+00 

参数a-c的梯度合理地接近于零但是对于d则不是。这也可能影响mob()中的推理,该推理基于观察明确的梯度贡献(也称为模型得分或估计函数)。

简而言之:你想做什么,可以做到!但我建议考虑一个更简单的模型。如果您这样做,则只需相应地修改photofit()功能,然后再次通过mob()运行。