截断的法线由下式给出:
dtnorm<- function(x, mean, sd, a, b) {
dnorm(x, mean, sd)/(pnorm(b, mean, sd)-pnorm(a, mean, sd))
}
ptnorm <- function(x, mean, sd, a, b) {
(pnorm(x,mean,sd) - pnorm(a,mean,sd)) /
(pnorm(b,mean,sd) - pnorm(a,mean,sd))
}
拟合如下:
fitdist( data, tnorm, method="mle",
start=list(mean=mapply("[[", results[1], 1),
sd=mapply("[[", results[1], 2)),
fix.arg=list(a=minLoose,b=maxLoose))
其中results [i]是一个矩阵,其中fitdist的mle结果使用normal而不是tnormal。
我得到了tnorm的以下结果:
mean=-0.00844725266454969, sd=0.012540928272073
而与规范:
mean=0.00748402597402597, sd=0.00614293813955003
数据都大于0且小于0.04,因此获得tnorm的mle似乎不正确....任何建议?
谢谢!
答案 0 :(得分:5)
你的数据都高于正常值(呃,而不是0以上)这一事实对于最适合截断分布的“均值”是否达到0几乎没有影响。你拟合右尾a正态分布到您的数据。截断的估计位置参数实际上不是平均值,而是平均值在未经审查的数据集中,其右尾与您的数据具有相同的密度“形状”。 (这实际上是一个统计问题而不是R问题。)
您可以在Wikipedia文章的moment部分找到计算双重截断Normal的预期值的公式:
http://en.wikipedia.org/wiki/Truncated_normal_distribution可以轻松转换为对pnorm
和qnorm
的调用。
进一步考虑:检查在包中使用截断分布的工具:'gamlss'和'gamlss.tr'。
答案 1 :(得分:-1)
您可以使用此脚本的部分内容来估算参数
rm(list=ls(all=TRUE))
dtnorm<- function(x, mean, sd, a, b) {
dnorm(x, mean, sd)/(pnorm(b, mean, sd)-pnorm(a, mean, sd))
}
simuls=5
simul_mat=matrix(nrow=simuls,ncol=6)
for(simul in 1:simuls) {
acm=rnorm(1)
acsd=runif(1)*2+0.5
limits=sort(acm+rnorm(2))
all=limits[1]
aul=limits[2]
x=rnorm(10000)*acsd+acm
x=subset(x,x>all & x<aul)
norm_parms<-function(parms){
mp=parms[1]
sdp=parms[2]^2
ll=median(x)-parms[3]^2
ul=median(x)+parms[4]^2
xs=subset(x,x>ll & x<ul)
ds=dtnorm(xs,mp,sdp,ll,ul)
if(length(x)>5){
do=rep(dnorm(-6),length(x)-length(xs))
ds=c(ds,do)
}
if(length(x)<=5){
ds=rep(dnorm(-9),length(x))
}
mll=-sum(log(ds))
return(mll)
}
bestv=Inf
methodss=c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN")
for(method in methodss){
try(bestc<-optim(par=c(0,1,1,1),norm_parms,method=method))
if(bestc$value<bestv) {best=bestc;bestv=bestc$value}
}
parms=best$par
mp=parms[1]
sdp=parms[2]^2
ll=median(x)-parms[3]^2
ul=median(x)+parms[4]^2
print(c(acm,acsd,all,aul))
print(c(mp,sdp,ll,ul))
print(best$value)
acparms=c(acm,acsd,sqrt(median(x)-all),sqrt(aul-median(x)))
acv=norm_parms(acparms)
cnames=c("Actual a","Estimated a","Actual b","Estimated b","Actual optim","Best optim`")
simul_mat[simul,]=c(all,ll,aul,ul,best$value,acv)
cnames=c("Actual a","Estimated a","Actual b","Estimated b","Actual optim","Best optim`")
colnames(simul_mat)=cnames
print(simul_mat)
}