https://github.com/cran/emplik
Raw File
Tip revision: e2f16b0adc0f6df124c7ee126345f66d8d2c7961 authored by Mai Zhou on 09 October 2011, 00:00:00 UTC
version 0.9-7
Tip revision: e2f16b0
el.trun.test.R
el.trun.test <- function(y,x,fun=function(t){t},mu,maxit=20,error=1e-9) {
x <- as.vector(x)
y <- as.vector(y)
temp <- Wdataclean2(x,d=rep(1, length(x))) 
x <- temp$value
wt0 <- temp$weight

indi <- function(u,v){ as.numeric(u > v) }
uij <- outer(x,y,FUN="indi")
m <- length(y)
w0 <- rep(1/length(x), length(x))
xmu <- fun(x) - mu
for(i in 1:maxit) {
     pvec0 <- as.vector( w0 %*% uij )
     nvec <- wt0 + as.vector(rowsum( t(w0*(1-uij))/pvec0, group=rep(1, m)))
     w0 <- nvec/sum(nvec)
}
w <- w0
for(i in 1:maxit) {
       pvec <- as.vector( w %*% uij )
       nvec <- wt0 + as.vector(rowsum( t(w*(1-uij))/pvec, group=rep(1, m)))
       w <- el.test.wt(x=xmu, wt=nvec, mu=0)$prob
}
pvec <- as.vector( w %*% uij )
pvec0 <- as.vector( w0 %*% uij )
ELR <- sum(wt0*log(w0)) - sum(log(pvec0)) - sum(wt0*log(w)) + sum(log(pvec))
return(list(NPMLE=w0, NPMLEmu=w, "-2LLR"=2*ELR) )
}
back to top