Revision 128cc5eed366a5a3f6c33b70a81379c1b1ca8688 authored by Matthias Templ on 16 August 2010, 18:42:55 UTC, committed by cran-robot on 16 August 2010, 18:42:55 UTC
1 parent 4c9961a
Raw File
alrEM.R
alrEM <- function(x, pos=ncol(x), dl=rep(0.05, ncol(x)-1), eps=0.0001, maxit=50) {
  stopifnot(all(x[,pos] != 0 & length(which(is.na(x[,pos]))) == 0))
  m=matrix(rep(dl,each=nrow(x)),ncol=length(dl))
  phi <- log(m/x[,pos]) 
  xOrig <- x
  if(length(colnames) < 1) names <- letters[1:ncol(x)] else names <- colnames(x)
  nam <- colnames(x)[pos]
  x <- cbind(x[, -pos], x[, pos])
  w <- which(colnames(x) == "x[, pos]")
  colnames(x)[w] <- nam
  ## close the X rows to 1:
  xc <- constSum(x)
  ## convert zeros into missing values:
  x[x==0] <- NA
  ## transform x into y=alr(x,pos):
  # x is already in the correct order
  y <- alr(x)$x.alr
  y <- data.frame(y)
  w <- is.na(y)
  wr <- apply(y, 1, function(x) any(is.na(x)) )
  wrr <- which(wr)
  it <- 0
  d <- 99999999
  y <- as.matrix(y)
  y[w] <- 0 
  it <- 0
  amountMiss <- length(which(w))
  while( d > eps & it <= maxit ){
	it <- it + 1
	yold <- y
    for(i in 1:ncol(y)){ 
	    lm1 <- lm( y[,i,drop=FALSE] ~ y[,-i,drop=FALSE] ) 
	    yhat <- predict(lm1, new.data=y[,-i])	  
	    s <- sd(y[,i], na.rm=TRUE)
	    ex <- (phi[,i] - yhat)/s 
	    yhat2 <- yhat - s*dnorm(ex)/pnorm(ex)	   
          y[w[,i],i] <- ifelse(yhat2[w[,i]] >= phi[w[,i],i], phi[w[,i],i], yhat2[w[,i]]) 
    }
	d <- sum(abs(y)- sum(abs(yold)))/amountMiss
  }
  

  ximp <- suppressWarnings(invalr(y))
  w <- which(colnames(ximp) == "rat")
  colnames(ximp)[w] <- nam
  colnames(ximp)[which(colnames(ximp) =="")] <- names[pos]
  ximp <- ximp[, names]
  
  res <- list(xOrig=xOrig, xImp=ximp, wind=NULL, iter=it, eps=eps) 
  invisible(res)
}


back to top