r - 在哪里定义与 fitdist (fitdistrplus) 或 fitdistr (MASS) 一起使用的分布函数？

Question

我想定义我自己的分布函数以与 R 中的 fitdist 或 fitdistr 函数一起使用。
以 fitdistrplus 包中的 fitdist 为例。我定义了一个名为 sgamma 的自定义分布，如下所示:

dsgamma<-function(x,shape){return(dgamma(x,shape,scale=1));}
qsgamma<-function(p,shape){return(qgamma(p,shape,scale=1));}
psgamma<-function(q,shape){return(pgamma(q,shape,scale=1));}
rsgamma<-function(n,shape){return(rgamma(n,shape,scale=1));}

我的问题是我应该在哪里定义这些函数。

如果上面的定义和声明是在顶层环境中进行的，那么我可以使用这个分布函数调用 fitdist。换句话说，我的脚本 test1.R 具有以下内容将运行得很好:

rm(list=ls())
require(fitdistrplus);
dsgamma<-function(x,shape){return(dgamma(x,shape,scale=1));}
qsgamma<-function(p,shape){return(qgamma(p,shape,scale=1));}
psgamma<-function(q,shape){return(pgamma(q,shape,scale=1));}
rsgamma<-function(n,shape){return(rgamma(n,shape,scale=1));}
x<-rgamma(100, shape=0.4, scale=1);
zfit<-fitdist(x, distr=dsgamma, start=list(shape=0.3));

现在，如果我将上面的代码包装在一个函数中，它就不起作用了。请参阅下面的 test2.R:

rm(list=ls())
testfit<-function(x)
{
    require(fitdistrplus);
    dsgamma<-function(x,shape){return(dgamma(x,shape,scale=1));}
    qsgamma<-function(p,shape){return(qgamma(p,shape,scale=1));}
    psgamma<-function(q,shape){return(pgamma(q,shape,scale=1));}
    rsgamma<-function(n,shape){return(rgamma(n,shape,scale=1));}
    zfit<-fitdist(x, distr=dsgamma, start=list(shape=0.3));
    return(zfit);
}

x<-rgamma(100, shape=0.4, scale=1);
zfit<-testfit(x);

我收到以下错误:

Error in fitdist(x, distr = dsgamma, start = list(shape = 0.3)) : 
  The  dsgamma  function must be defined

请注意，如果我更换，我仍然会收到错误

zfit<-fitdist(x, distr=dsgamma, start=list(shape=0.3));

和

zfit<-fitdist(x, distr="sgamma", start=list(shape=0.3));

我想关键问题是 fitdist 在哪里寻找参数 distr 指定的函数。我将衷心感谢您的帮助。

Answer 1

好问题。此错误的原因是 fitdistrplus 的作者包使用exists()检查函数所需参数的变化。

以下是fitdist的代码节选和 mledist职能。作者采用 distr 给出的值并在全局环境和fitdist 所在的环境中寻找合适的密度和概率函数和 mledist被定义。

if (!exists(ddistname,mode="function"))
    stop(paste("The ", ddistname, " function must be defined"))
pdistname <- paste("p", distname, sep = "")
if (!exists(pdistname,mode="function"))
    stop(paste("The ", pdistname, " function must be defined"))

这是从存在如何工作的摘录:

此函数查看名称“x”是否绑定(bind)了值
在指定的环境中。 如果“继承”为“真”且值为
在指定环境中未找到“x”，封闭
搜索环境的帧，直到名称“x”
遭遇。 请参阅“环境”和“R 语言定义”
有关环境结构及其详细信息的手册
外壳。

要了解更多关于为什么存在使您的函数失败的信息，请查看这篇文章: http://adv-r.had.co.nz/Environments.html

本质上，fitdist 和 mledist 不会在您正在创建的函数的环境中搜索，从而为您提供 dsgamma(以及您定义的其他函数)不存在的错误。

这可以通过使用 <<- 最容易地规避。而不是 <-在 testfit() 中定义函数。这将在全局范围内定义您的子函数。

 > testfit<-function(x)
 +     {
 +             require(fitdistrplus);
 +                 dsgamma<<-function(x,shape){return(dgamma(x,shape,scale=1))}
 +                 qsgamma<<-function(p,shape){return(qgamma(p,shape,scale=1))}
 +                 psgamma<<-function(q,shape){return(pgamma(q,shape,scale=1))}
 +                 rsgamma<<-function(n,shape){return(rgamma(n,shape,scale=1))}
 +                 zfit<-function(x){return(fitdist(x,distr="sgamma" , start=list(shape=0.3)))};
 +                 return(zfit(x))
 +         }
!> testfit(x)
 Fitting of the distribution ' sgamma ' by maximum likelihood
 Parameters:
       estimate Std. Error
 shape 0.408349 0.03775797

您可以通过将 envir=parent.frame() 添加到如下所示的存在检查中来更改 fitdist 的代码以在函数环境中搜索，但我不建议这样做。

if (!exists(ddistname,mode="function",envir=parent.frame()))

但是，这仍然不能解决您的问题，因为 fitdist来电 mledist和 mledist有同样的问题。

 Error in mledist(data, distname, start, fix.arg, ...) (from #43) :
   The  dsgamma  function must be defined

要采用这种方法，您必须更改 mledist并告诉它在 fitdistr 的 parent.frame 中搜索.每次加载库时都必须进行这些更改。