require(boot)

# "cramer.statistic" calculates the value of the test statistic T
# it is build so it can be called by "boot"
#   daten   is the original data set (is just given since boot wants it like that))
#   indexe  is the bootstrapped vector of indices (first m are observations of X, the next n of Y)
#   m       is the number of observations of X
#   n       is the number of observations of Y
#   lookup  is a matrix containing the distances of points i und j
cramer.statistic<-function(daten,indexe,mm,nn,lookup) {
    xind<-indexe[1:mm]
    yind<-indexe[(mm+1):(mm+nn)]
    mm*nn/(mm+nn)*(sum(lookup[xind,yind])/(mm*nn)-sum(lookup[xind,xind])/(2*mm^2)-sum(lookup[yind,yind])/(2*nn^2))
}

cramer.test<-function(x,y,conf.level=0.95,replicates=1000,sim="ordinary",just.statistic=FALSE) {    
    RVAL <- list(method = "nonparametric Cramer-Test (on equality of two distributions)",
                 d = 0,
                 m = 0,
                 n = 0,
                 statistic = 0,
                 conf.level = conf.level,
                 crit.value = 0,
                 p.value = 0,                 
                 result = 0,
                 sim = sim,
                 replicates = replicates) 
    if ((is.vector(x))&&(is.vector(y))) RVAL$d<-1
    if ((is.matrix(x))&&(is.matrix(y))) if (ncol(x)==ncol(y)) RVAL$d<-ncol(x)
    if (RVAL$d==0) stop("types of x and y incompatible or inappropriate.")    
    if (RVAL$d==1) {
        RVAL$m<-length(x)
        RVAL$n<-length(y)
        daten<-matrix(c(x,y),ncol=1,byrow=TRUE)
    } else {
        RVAL$m<-nrow(x)
        RVAL$n<-nrow(y)
        daten<-matrix(c(t(x),t(y)),ncol=ncol(x),byrow=TRUE)
    }
    lookup<-matrix(rep(0,(RVAL$m+RVAL$n)^2),ncol=(RVAL$m+RVAL$n))
    for (i in 2:(RVAL$m+RVAL$n))
         for (j in 1:(i-1)) {
             lookup[i,j]<-sqrt(sum((daten[i,]-daten[j,])^2))
             lookup[j,i]<-lookup[i,j]
         }
    if (just.statistic) {
        RVAL$statistic<-cramer.statistic(daten,1:(RVAL$m+RVAL$n),RVAL$m,RVAL$n,lookup)
    } else {
        b<-boot(data=daten,statistic=cramer.statistic,mm=RVAL$m,nn=RVAL$n,lookup=lookup,sim=RVAL$sim,stype="i",R=RVAL$replicates)
        RVAL$statistic<-b$t0
        RVAL$p.value<-1-rank(c(b$t0,b$t))[1]/(replicates+1)
        RVAL$crit.value<-sort(b$t)[round(RVAL$conf.level*RVAL$replicates)]
        if (RVAL$statistic>RVAL$crit.value) RVAL$result<-1
    }
    class(RVAL) <- "cramertest"
    return(RVAL)
}

print.cramertest<-function(x) {
    cat("\n",x$d,"-dimensional ",x$method,"\n\n")
    cat("\tx-sample: ",x$m," values        ")
    cat("y-sample: ",x$n," values\n\n")
    if (x$crit.value>0) {
        cat("critical value for confidence level ",format(100 * x$conf.level),"% : ",x$crit.value,"\n")
        cat("observed statistic ",x$statistic,", so that\n\t hypothesis (\"x is distributed as y\") is ")
        cat(ifelse(x$result==0," ACCEPTED"," REJECTED"),".\n")
        cat("estimated p-value = ",x$p.value,"\n\n")
        cat("\t[result based on ",x$replicates," ",x$sim," bootstrap-replicates]\n\n")
    } else {
        cat("observed statistic ",x$statistic,"\n\n")
    }
    invisible(x)
}
