glmmML <- function(formula,
                   data = list(),
                   cluster = NULL,
                   family = binomial,
                   start.coef = NULL,
                   start.sigma = NULL,
                   offset = NULL,
                   method = "vmmin",
                   control = glm.control(epsilon = 1.e-8,
                     maxit = 100, trace = FALSE),
                   n.points = 16){

  method <- (method == "vmmin") ## 1 if vmmin, 0 otherwise
  if (!method) stop("Use default method (the only available at present)")
  cl <- match.call()

  if (is.character(family)) 
    family <- get(family)
  if (is.function(family)) 
    family <- family()
  if (is.null(family$family)) {
    print(family)
    stop("`family' not recognized")
  }

  if (missing(data))
    data <- environment(formula)
  
  mf <- match.call(expand.dots = FALSE)
                     # get a copy of the call; result: a list.

  mf$family <- mf$start.coef <- mf$start.sigma <- NULL
  mf$control <- mf$maxit <- NULL
  mf$n.points <- mf$method <- mf$start.coef <- mf$start.sigma <- NULL
  mf[[1]] <- as.name("model.frame") # turn into a call to model.frame
  mf <- eval(mf, environment(formula)) # run model.frame

  # Pick out the parts.
  mt <-  attr(mf, "terms")

  
  xvars <- as.character(attr(mt, "variables"))[-1]
  if ((yvar <- attr(mt, "response")) > 0) 
    xvars <- xvars[-yvar]
  xlev <- if (length(xvars) > 0) {
    xlev <- lapply(mf[xvars], levels)
    xlev[!sapply(xlev, is.null)]
  }
  
  X <- if (!is.empty.model(mt)) 
    model.matrix(mt, mf, contrasts)

  p <- NCOL(X)
 
  Y <- model.response(mf, "numeric")
  offset <- model.offset(mf)

  if (NCOL(Y) >  1) stop("Response must be univariate")
  
  if (!is.null(offset) && length(offset) != NROW(Y)) 
    stop(paste("Number of offsets is", length(offset), ", should equal", 
               NROW(Y), "(number of observations)"))

  mixed <- ( !is.null(cluster) ) && ( n.points >= 2 )

  fit <- glmmML.fit(X, Y,
                    start.coef,
                    start.sigma,
                    mixed,
                    cluster,
                    offset,
                    family,
                    n.points,
                    control,
                    method,
                    intercept = ( attr(mt, "intercept") > 0) )
                    
  if (!fit$convergence) return(list(convergence = fit$convergence))
  bdim <- p + 1
  res <- list()

  res$convergence <- as.logical(fit$convergence)
  res$aic <- -2 * fit$loglik + 2 * (p + as.integer(mixed))
  res$variance <- fit$coef.variance
  if (mixed){
    res$sigma <- fit$sigma
    res$sigma.sd <- sqrt(fit$sigma.vari)
  }else{
    res$sigma = 0
    res$sigma.sd = 0
  }
  res$coefficients <- fit$beta
  names(res$coefficients) <- c(colnames(X))
  res$deviance <- fit$deviance
##   options(show.error.messages = FALSE)
##  vari <- try(solve(-res$hessian))
#  if(is.numeric(vari)){
#    se <- sqrt(diag(vari))
#  }else{
#    se <- rep(NA, p + 1)
#  }
  res$call <- cl
  res$df.residual <- fit$df.residual
  res$sd <- sqrt(diag(res$variance))
  names(res$sd) <- names(res$coefficients)
  res$mixed <- mixed
  if (mixed){
    res$frail <- fit$frail
  }
  class(res) <- "glmmML"
  res
}

print.glmmML <- function(x,
                         digits = max(3, getOption("digits") - 3),
                         na.print = "",
                         ...){ 
  
  cat("\nCall: ", deparse(x$call), "\n\n")
  savedig <- options(digits = digits)
  on.exit(options(savedig))
  coef <- x$coefficients
  se <- x$sd
  tmp <- cbind(coef,
               se,
               coef/se,
               signif(1 - pchisq((coef/se)^2, 1), digits - 1)
               )
  dimnames(tmp) <- list(names(coef),
                        c("coef", "se(coef)", "z", "Pr(>|z|)")
                        )
  cat("\n")
  prmatrix(tmp)

  if(x$mixed){
    cat("\nStandard deviation in mixing distribution: ", x$sigma,  "\n")
    cat("Std. Error:                                ", x$sigma.sd, "\n")
  }
  cat("\nResidual deviance:",
      format(signif(x$deviance, digits)), "on",
      x$df.residual, "degrees of freedom", 
      "\tAIC:",
      format(signif(x$aic, digits)), "\n")
}
glmmML.fit <- function (X, Y, 
                        start.coef = NULL, 
                        start.sigma = NULL,
                        mixed = FALSE,
                        cluster = NULL,                        
                        offset = rep(0, nobs),
                        family = binomial(),
                        n.points = 16,
                        control = glm.control(),
                        method,
                        intercept = TRUE){
  
  X <- as.matrix(X)
  conv <- FALSE
  nobs <- NROW(Y)
  p <- NCOL(X)
  nvars <- p + as.integer(mixed)
  
  if (is.null(offset)) 
    offset <- rep(0, nobs)
  variance <- family$variance
  dev.resids <- family$dev.resids
  aic <- family$aic
  linkinv <- family$linkinv
  mu.eta <- family$mu.eta
  
  if (!is.function(variance) || !is.function(linkinv)) 
    stop("illegal `family' argument")

  if (is.null(start.coef)){
    start.coef <- numeric(p) # Start values equal to zero,
    if (family$family == "binomial"){
      start.coef[1] <- log(mean(Y) / (1 - mean(Y)))
    }else if (family$family == "poisson"){
      start.coef[1] <- log(mean(Y))
    }else{ ## this is a proviso!!
      start.coef[1] <- mean(Y)
    }
                           
  }else{                   
    if (length(start.coef) != p) stop("beta.start has wrong length")
  }
  
  if (mixed) {
    if (is.null(start.sigma)){
      start.sigma <- 0.5 ## More sofisticated choice is = ?
    }else{                  
      if (length(start.sigma) != 1) stop("sigma.start has wrong length")
    }
  }else{
    if (length(start.coef) != p) stop("beta.start has wrong length")
    n.points <- 1
    if (is.null(start.sigma)) start.sigma <- 0
  }
  
  ord <- order(cluster)
  Y <- Y[ord]
  X <- X[ord, ,drop = FALSE]

  ## Center the covariates so we avoid (some) numeric problems: 
  if (intercept){
    if (p >= 2){
      means <- numeric(p-1)
      for (i in 2:p){
        means[i-1] <- mean(X[, i])
        X[, i] <- X[, i] - means[i-1]
      }
    }
  }else{
    means <- numeric(p)
    for (i in 1:p){
      means[i] <- mean(X[, i])
      X[, i] <- X[, i] - means[i]
    }
  }
  
  cluster <- cluster[ord]
  fam.size <- as.vector(table(cluster))
  n.fam <- length(fam.size)
  

  if (family$family == "binomial"){
    if (family$link == "logit"){
      fam <- 0
    }else if (family$link == "cloglog"){
      fam <- 1
    }else{
      stop("Unknown link function; only 'logit' and 'cloglog' implemented")
    }
  }else if (family$family == "poisson"){
    fam <- 2
  }else{
    stop("Unknown family; only 'binomial' and 'poisson' implemented")
  }
              
  fit <- .C("glmm_ml",
            as.integer(fam),
            as.integer(method),
            as.integer(p),
            as.double(start.coef),
            as.double(start.sigma),
            as.double(t(X)),       ### Note CAREFULLY (03-01-09)!!!
            as.integer(Y),
            as.double(offset),
            as.integer(fam.size),
            as.integer(n.fam),
            as.integer(n.points),
            as.double(control$epsilon),
            as.integer(control$maxit),
            as.integer(control$trace),
            beta = double(p),  ## Return values from here.
            sigma = double(1),
            loglik = double(1),
            variance = double((p + 1) * (p + 1)),
            frail = double(n.fam),
            mu = double(nobs),
            convergence = integer(1),
            PACKAGE = "glmmML"
            )  

  vari <- matrix(fit$variance, ncol = (p + 1))
  ## Correct the estimate of the intercept for the centering:
  if (intercept){
    if (p >= 2){
      fit$beta[1] <- fit$beta[1] - sum(fit$beta[2:p] * means)
      aa <- numeric(p)
      aa[1] <- 1.0
      for (i in 2:p){ 
        aa[i] <- -means[i-1]
        ## "Restore" X (to what use?!):
        X[, i] <- X[, i] + means[i-1]
      }
      vari[1, 1] <- aa %*% vari[1:p, 1:p] %*% aa
    }
  }else{
    for (i in 1:p){ ## "Restore" mm (to what use?!):
      X[, i] <- X[, i] + means[i]
    }
  }
  
  if (mixed){
    sigma.vari <- vari[(p + 1), (p + 1)] * fit$sigma * fit$sigma
  }else{
    sigma.vari <- NULL
  }
  
  aic.model <- -2 * fit$loglik + 2 * nvars

  list(beta = fit$beta,
       sigma = fit$sigma,
       loglik = fit$loglik,
       coef.variance = vari[1:p, 1:p, drop = FALSE],
       sigma.variance = sigma.vari,
       frail = fit$frail,
       residuals = residuals,
       fitted.values = fit$mu, 
       family = family, 
       deviance = -2*fit$loglik,
       aic = aic.model, 
       #null.deviance = nulldev,
       df.residual = NROW(Y) - NCOL(X) - as.integer(mixed),
       df.null = NROW(Y) - as.integer(intercept),
       #y = y,
       convergence = fit$convergence)
}
.First.lib <- function(lib, pkg)
{
  library.dynam( "glmmML", pkg, lib )
}
