.packageName <- "energy"
edist <- 
function(x, sizes, distance = FALSE, ix = 1:sum(sizes), alpha = 1) {
    #  computes the e-dissimilarity matrix between k samples or clusters
    #  x:          pooled sample or Euclidean distances
    #  sizes:      vector of sample (cluster) sizes
    #  distance:   TRUE if x is a distance matrix, otherwise FALSE
    #  ix:         a permutation of row indices of x 
    #  alpha:      distance exponent
    #    
    k <- length(sizes)
    if (k == 1) return (as.dist(0.0))
    if (k < 1) return (NA)
    e <- matrix(nrow=k, ncol=k)
    n <- cumsum(sizes)
    m <- 1 + c(0, n[1:(k-1)])
    if (distance == FALSE) {
        if (is.vector(x)) x <- matrix(x, nrow = length(x), ncol = 1)
        dst <- as.matrix(dist(x))
        }
    else dst <- as.matrix(x)
    if (alpha != 1) {
    	if (alpha <= 0 || alpha > 2)
    	    warning("exponent alpha should be in (0,2]")
    	dst <- dst^alpha  
    	}
    for (i in 1:(k - 1)) {
        e[i, i] <- 0.0
        for (j in (i + 1):k) {
            n1 <- sizes[i]
            n2 <- sizes[j]
            ii <- ix[m[i]:n[i]]
            jj <- ix[m[j]:n[j]]
            w <- n1 * n2 / (n1 + n2)
            m11 <- sum(dst[ii, ii]) / (n1 * n1)
            m22 <- sum(dst[jj, jj]) / (n2 * n2)
            m12 <- sum(dst[ii, jj]) / (n1 * n2)
            e[i, j] <- e[j, i] <- w * ((m12 + m12) - (m11 + m22))
            }
        }
    as.dist(e)
}


energy.hclust <- 
function(dst, alpha = 1) {
    d <- dst
    if (is.matrix(dst)) {
        if (nrow(dst) != ncol(dst) || sum(dst != t(dst)) > 0)
            stop("distance matrix must be square symmetric")
    	d <- as.dist(dst)
    	attr(d, "Labels") <- row.names(dst)
    }
    n <- attr(d, "Size")
    if (is.null(n))
        stop("dst argument must be square matrix or dist object")
    if (alpha != 1) {
    	if (alpha <= 0 || alpha > 2)
    	    warning("exponent alpha should be in (0,2]")
    	d <- d^alpha  
    }
    labels <- attr(d, "Labels")
    if (is.null(labels))
        labels <- paste(1:n)  
    merge <- integer(2 * (n - 1))
    height <- double(n - 1)
    order <- integer(n) 
    ecl <- .C("Emin_hclust", 
              diss = as.double(d), 
              en = as.integer(n), 
              merge = as.integer(merge), 
              height = as.double(height),
              order = as.integer(order),
              PACKAGE = "energy")
    merge <- matrix(ecl$merge, nrow = n - 1, ncol = 2)
    e <- list(merge = merge, 
              height = ecl$height, 
              order = ecl$order,
              labels = labels,
              method = "e-distance",
              call = match.call(),
              dist.method = attr(dst, "method"))      
    class(e) <- "hclust"            
    e
}
ksample.e <- 
function(x, sizes, distance = FALSE, ix = 1:sum(sizes), 
         incomplete = FALSE, N = 100) {
    ## computes the k-sample E-statistic for equal distributions
    ##   x:          pooled sample or distance matrix
    ##   sizes:      vector of sample sizes
    ##   distance:   TRUE if x is a distance matrix, otherwise FALSE
    ##   ix:         a permutation of row indices of x
    ##   incomplete: if TRUE compute incomplete E-statistic
    ##   N:          incomplete sample size
    ##   
    ##   NOT much error checking here: for test use eqdist.etest
    ## 
    k <- length(sizes)
    if (k == 1) return (0.0)
    if (k < 2) return (NA)
    e <- e0 <- 0
    if (!is.null(attr(x, "Size"))) distance <- TRUE
    x <- as.matrix(x)
    if (incomplete == TRUE && distance == FALSE && any(sizes > N))
        return(.incomplete.etest(x, sizes=sizes, R=0, N=N)$statistic)  
    
    if (distance == TRUE) {
        ##  same as test with 0 replicates
        b <- .C("ksampleEtest", 
	    x = as.double(t(x)), 
	    byrow = as.integer(1),
	    nsamples = as.integer(length(sizes)), 
	    sizes = as.integer(sizes),
	    dim = as.integer(0), 
	    R = as.integer(0), 
	    e0 = as.double(e),
	    e = as.double(e), 
	    pval = as.double(e), 
	    PACKAGE = "energy")           
        return (b$e0)
    }

    ##  compute e directly, without storing distances
    d <- ncol(x)
    n <- cumsum(sizes)
    m <- 1 + c(0, n[1:(k-1)])
    for (i in 1:(k - 1)) {
        for (j in (i + 1):k) {
            n1 <- sizes[i]
            n2 <- sizes[j]
            ii <- ix[m[i]:n[i]]
            jj <- ix[m[j]:n[j]]
                if (d == 1) y <- as.matrix(c(x[ii], x[jj]))
                else y <- rbind(x[ii,], x[jj,])
                e <- e + .C("E2sample",
                        x = as.double(t(y)), 
                        sizes = as.integer(c(n1, n2)), 
                        dim = as.integer(d), 
                        e = as.double(e0),
                        PACKAGE = "energy")$e
            }
        }
    e
}

eqdist.etest <- 
function(x, sizes, distance = FALSE, incomplete = FALSE, N = 100, R = 999) {
    ## multivariate E-test of the multisample hypothesis of equal distributions
    ##   x:          matrix of pooled sample or distance matrix
    ##   sizes:      vector of sample sizes
    ##   distance:   logical, TRUE if x is a distance matrix, otherwise false
    ##   R:          number of replicates
    ##   incomplete: logical, TRUE if incomplete E statistics
    ##   N:          sample size for incomplete version
    ##   
    
    nsamples <- length(sizes)
    if (nsamples < 2) return (NA)
    if (min(sizes) < 1) return (NA)
    if (!is.null(attr(x, "Size"))) distance <- TRUE
    
    if (nsamples == 2) {
        if (incomplete == TRUE && distance == FALSE && any(sizes > N))
            return(.incomplete.etest(x, sizes=sizes, N=N, R=R))  
        }
        
    x <- as.matrix(x)
    if (nrow(x) != sum(sizes)) stop("nrow(x) should equal sum(sizes)")
    if (distance == FALSE && nrow(x) == ncol(x))
        warning("square data matrix with distance==FALSE")
    d <- ncol(x)
    if (distance == TRUE) d <- 0
    str <- "Multivariate "
    if (d == 1) str <- "Univariate "
    if (d == 0) str <- ""

    e0 <- 0.0
    repl <- rep(0, R)
    pval <- 1.0
    b <- .C("ksampleEtest", 
        x = as.double(t(x)), 
        byrow = as.integer(1),
        nsamples = as.integer(nsamples), 
        sizes = as.integer(sizes),
        dim = as.integer(d), 
        R = as.integer(R), 
        e0 = as.double(e0),
        e = as.double(repl), 
        pval = as.double(pval), 
        PACKAGE = "energy")       
    
    names(b$e0) <- "E-statistic"
    sz <- paste(sizes, collapse = " ", sep = "")
    methodname <- paste(str, length(sizes), 
                  "-sample E-test of equal distributions", sep = "")
    dataname <- paste("sample sizes ", sz, ", replicates ", R, sep="")
    e <- list(
        method = methodname,
        statistic = b$e0,
        p.value = b$pval,
        data.name = dataname)

    class(e) <- "htest"        
    e
}
 

.incomplete.etest <- 
function(x, sizes, N = 100, R = 999) {
    ##   intended to be called from eqdist.etest, not much error checking
    ## 
    ##   multivariate E-test of the multisample hypothesis of equal 
    ##   distributions, incomplete E-statistic
    ##   C library currently supports two sample test only
    ##   x:          matrix of pooled sample or distance matrix
    ##   sizes:      vector of sample sizes
    ##   N:          max sample size for estimation of pairwise E
    ##   R:          number of replicates
    ##   
    
    k <- length(sizes)
    if (k != 2) return (NA);
    n <- cumsum(sizes) 
    m <- 1 + c(0, n[1:(k-1)])
    x <- as.matrix(x)
    if (nrow(x) != sum(sizes)) return (NA)
    d <- ncol(x)
    r <- nrow(x)
    str <- "Multivariate "
    if (d == 1) str <- "Univariate "
    e0 <- 0
    pval <- 1
    repl <- rep(0, R)  
    b <- .C("twosampleIEtest", 
        x = as.double(t(x)), 
        byrow = as.integer(1),
        sizes = as.integer(sizes),
        dim = as.integer(d),
        iN = as.integer(N),
        R = as.integer(R), 
        e0 = as.double(e0),
        e = as.double(repl), 
        pval = as.double(pval),
        PACKAGE = "energy")           

    methodname <- paste(str, length(sizes), 
                    "-sample E-test of equal distributions", sep = "") 
    sz <- paste(sizes, collapse = " ", sep = "")
    dataname <- paste("sample sizes ", sz, ", replicates ", 
                  R, ", N ", N, sep="")
    names(b$e0) <- "(Incomplete) E-statistic"
    e <- list(
        method = methodname,
        statistic = b$e0,
        p.value = b$pval,
        data.name = dataname)

    class(e) <- "htest"        
    e
}

indep.e<- 
function(x, y) {
    # energy statistic for multivariate independence
    x <- as.matrix(x)
    y <- as.matrix(y)
    n <- nrow(x)
    m <- nrow(y)
    if (n != m || n < 2) stop("Sample sizes must agree")
    if (! (all(is.finite(c(x, y)))))
        stop("Data contains missing or infinite values")
    
    stat <- 0
    dims <- c(n, ncol(x), ncol(y))

    if (ncol(x) == 1 && ncol(y) == 1) {
    e <- .C("indep", 
            x = as.double(t(x)),
            y = as.double(t(y)),
            size = as.integer(n), 
            stat = as.double(stat), 
            PACKAGE = "energy")
    print(e$stat)
    }
    
    e <- .C("indepE", 
            x = as.double(t(x)),
            y = as.double(t(y)),
            byrow = as.integer(TRUE),
            dims = as.integer(dims), 
            stat = as.double(stat), 
            PACKAGE = "energy")
    sqrt(e$stat)
}
  
            
indep.etest<- 
function(x, y, R=199) {
    # energy test for multivariate independence
    x <- as.matrix(x)
    y <- as.matrix(y)
    n <- nrow(x)
    m <- nrow(y)
    if (n != m || n < 2) stop("Sample sizes must agree")
    if (! (all(is.finite(c(x, y))))) 
        stop("Data contains missing or infinite values")

    stat <- reps <- 0
    if (R > 0) reps <- rep(0, R)
    pval <- 1
    dims <- c(n, ncol(x), ncol(y), R)
    
    a <- .C("indepEtest", 
            x = as.double(t(x)),
            y = as.double(t(y)),
            byrow = as.integer(TRUE),
            dims = as.integer(dims), 
            stat = as.double(stat), 
            reps = as.double(reps),
            pval = as.double(pval),
            PACKAGE = "energy")
    stat <- sqrt(a$stat)
    names(stat) <- "I"
    dataname <- paste("x (",n," by ",ncol(x), "), y(",n," by ", ncol(y), "), replicates ", R, sep="")
    e <- list(
        method = paste("Energy test of independence", sep = ""),
        statistic = stat, 
        p.value = a$pval, 
        data.name = dataname)
    class(e) <- "htest"                   
    e
}
  
            
mvnorm.etest <- 
function(x, R = 999) 
{
    # parametric bootstrap E-test for multivariate normality
    if (is.vector(x)) {
        n <- length(x)
        d <- 1
        bootobj <- boot(x, statistic = normal.e, R = R, sim = "parametric", 
            ran.gen = function(x, y) {return(rnorm(n)) })
        }
        else {
        n <- nrow(x)
        d <- ncol(x)
        bootobj <- boot(x, statistic = mvnorm.e, R = R, sim = "parametric", 
            ran.gen = function(x, y) {
                return(matrix(rnorm(n * d), nrow = n, ncol = d)) })
        }
    p <- 1 - mean(bootobj$t < bootobj$t0)
    names(bootobj$t0) <- "E-statistic"
    e <- list(statistic = bootobj$t0,
              p.value = p,
              method = "Energy test of multivariate normality: estimated parameters",
              data.name = paste("x, sample size ", n, ", dimension ", d, ", replicates ", R, sep = ""))
    class(e) <- "htest"        
    e                 
}

mvnorm.e <- 
function(x) 
{
    # E-statistic for multivariate normality
    if (is.vector(x)) return(normal.e(x))
    n <- nrow(x)
    d <- ncol(x)
    if (n < 2) return(normal.e(x))
    z <- scale(x, scale = FALSE)    #subtract column means and 
    ev <- eigen(var(x), symmetric = TRUE)    #compute S^(-1/2)
    P <- ev$vectors
    lambda <- ev$values    
    y <- z %*% (P %*% diag(1 / sqrt(lambda)) %*% t(P))
    if (any(!is.finite(y))) return (NA)
    stat <- 0
    e <- .C("mvnEstat", y = as.double(t(y)), byrow = as.integer(TRUE),
            nobs = as.integer(n), dim = as.integer(d), 
            stat = as.double(stat), PACKAGE = "energy")$stat
    e
}

normal.e <- 
function(x) 
{
   x <- as.vector(x)
   y <- sort(x)
   n <- length(y)
   if (y[1] == y[n]) return (NA)
   y <- scale(y) 
   K <- seq(1 - n, n - 1, 2)
   e <- 2 * (sum(2 * y * pnorm(y) + 2 * dnorm(y)) - n / sqrt(pi) - mean(K * y))
   e
}
   
poisson.mtest <- 
function(x, R = 999) {
    # parametric bootstrap mean distance test of Poisson distribution
    n <- length(x)
    lambda <- mean(x)
    bootobj <- boot(x, statistic = poisson.m, R = R, sim = "parametric", 
            ran.gen = function(x, y) {rpois(n, lambda)})
    p <- 1 - mean(bootobj$t < bootobj$t0)
    names(bootobj$t0) <- "test statistic"
    names(lambda) <- "mean"
    e <- list(
        method = paste("Mean distance test of Poisson distribution", sep = ""),
        statistic = bootobj$t0, 
        p.value = p, 
        data.name = paste("sample size ", n, ", replicates ", R, sep=""),
        estimate = lambda)
    class(e) <- "htest"        
    e           
}

poisson.m<- 
function(x) {
    # mean distance statistic for Poissonity
    n <- length(x)
    stat <- 0
    e <- .C("poisMstat", 
            x = as.integer(x),
            nx = as.integer(n), 
            stat = as.double(stat), 
            PACKAGE = "energy")$stat
    e
}
.First.lib <- function(lib, pkg)
{
    require(boot)
    library.dynam("energy", pkg, lib) 
}
