"NNclean" <-
function(data, k, distances = NULL, edge.correct=FALSE, wrap = 0.1, convergence = 0.001, plot=FALSE)
{
#
# Function to perform the Nearest Neighbour cleaning of features 
# in a  point process as in 
# Byers, S. and Raftery, A. E. (1998) Nearest-Neighbor Clutter
# Removal for Estimating Features in Spatial Point Processes,
# Journal of the American Statistical Association, 93, 577-584
#
# R-port of Splus-package by Byers and Raftery.
#
# WE CAN TRY TO HELP WITH PROBLEMS BUT CANNOT GUARANTEE
# ACCURACY OR RESULTS.
#
# The data need to be a matrix of points in the process.
# To speed up one might provide the Splus distance object, 
# but one still needs the data.
# source("NNclean.q")
#
# Written originally in Splus 3.3, run on  Irix 5.2 at 
# U of Washington Stat. Dept.
# R-port by Christian Hennig <hennig@math.uni-hamburg.de>
#
# Permission is hereby given to StatLib to redistribute this software.
# The software can be freely used for non-commercial purposes, and can
# be freely distributed for non-commercial purposes only. 
#
#

        require(mva)
	data <- as.matrix(data)
	d <- dim(data)[2]
	n <- dim(data)[1]
	if(n > 800) {
		options(object.size = 50000000)
	}
#
# This does the toroidal edge correction for two dimensions, if required. 
#
	if( (d==2)  && (edge.correct==TRUE) ){
		r1 <- diff(range(data[,1]))	
		r2 <- diff(range(data[,2]))
		tran2 <- matrix(c(rep(0,n),rep(r2,n)),byrow=FALSE,nrow=n)
		tran1 <- matrix(c(rep(r1,n),rep(0,n)),byrow=FALSE,nrow=n)
		aux.dat <- rbind(data+tran1,data-tran1,data+tran2,data-tran2, data+tran1+tran2, data-tran1+tran2, data-tran1-tran2, data+tran1-tran2)
		aux.dat <- aux.dat[ aux.dat[,1] < (max(data[,1]) +wrap*r1) & aux.dat[,1] > (min(data[,1]) -wrap*r1) & aux.dat[,2] < (max(data[,2]) +wrap*r2) & aux.dat[,2] > (min(data[,2]) -wrap*r2), ]
		full.data <-  rbind(data,aux.dat)
	}
	else{
		full.data <- data
	}
#
# This is a useful, local function that finds the density of D_K
#
	dDk <- function(x, lambda, k, d, alpha.d)
	{
		(exp( - lambda * alpha.d * x^d) * 2 * (lambda * alpha.d)^k * x^( d * k - 1))/gamma(k)
	}

	if( is.null(distances) ){ distances <- dist(full.data)}
#
#  This next part sorts through the Splus distance object and forms kthNND, 
#  kth nearest neighbour distance, for each point.
#
	kthNND <- rep(0, n)
	Labels <- 1:(n - 1)
        kthNND[1] <- sort(distances[Labels])[k]
        Labels[(2):(n - 1)] <- Labels[(2):(n - 1)] + (n - 1 - 1)
        for(i in 2:n) {
          kthNND[i] <- sort(distances[Labels])[k]
          Labels[1:(i - 1)] <- Labels[1:(i - 1)] + 1
          Labels[(i + 1):(n - 1)] <- Labels[(i + 1):(n - 1)] + (n-i-1)
        }
	kthNND <- kthNND[1:n]
	alpha.d <- (2 * pi^(d/2))/(d * gamma(d/2))
#
# Now use kthNND in E-M algorithm, first get starting guesses.
#
	delta <- rep(0, n)
	delta[kthNND > (min(kthNND) + diff(range(kthNND))/3)] <- 1
	p <- 0.5
	lambda1 <- k/(alpha.d * mean((kthNND[delta == 0])^d))
	lambda2 <- k/(alpha.d * mean((kthNND[delta == 1])^d))
	loglik.old <- 0
	loglik.new <- 1	
#
# Iterator starts here,
#
	while(abs((loglik.new - loglik.old)/loglik.new) > convergence) {
# E - step
		delta <- (p * dDk(kthNND, lambda1, k = k, d = d, alpha.d = 
			alpha.d))/(p * dDk(kthNND, lambda1, k = k, d = d, 
			alpha.d = alpha.d) + (1 - p) * dDk(kthNND, lambda2, k = k, d = d, alpha.d = alpha.d))	
# M - step
		p <- sum(delta)/n
		lambda1 <- (k * sum(delta))/(alpha.d * sum((kthNND^d) * delta))
		lambda2 <- (k * sum((1 - delta)))/(alpha.d * sum((kthNND^d) * (1 - delta)))
		loglik.old <- loglik.new
		loglik.new <- sum( - p * lambda1 * alpha.d * ((kthNND^d) * delta) - (1 - p) * lambda2 * alpha.d * ((kthNND^d) * (1 -delta)) + delta * k * log(lambda1 * alpha.d) + (1 - delta) * k * log(lambda2 * alpha.d))
		print(loglik.new)
	}
#
# Plot the histogram if a device is active,
#
#
        if (plot){
		hist(kthNND, nclass = 20, axes = TRUE, ylab = "Estimate of Mixture", xlim = c(0, max(kthNND)), probability=TRUE, xlab = paste("Distance to", eval(k), "th nearest neighbour"))
		box()
		support <- seq(0, max(kthNND), length = 200)
		lines(support,(p * dDk(support, lambda1, k = k, d = d, alpha.d
			 = alpha.d) + (1 - p) * dDk(support, lambda2, k = k, d
			 = d, alpha.d = alpha.d)))
	}
#
# z will be the classifications. 1= in cluster. 0= in noise.
#
	probs<- dDk(kthNND, lambda1, k = k, d = d, alpha.d = alpha.d)/(dDk(
		kthNND, lambda1, k = k, d = d, alpha.d = alpha.d) + dDk(kthNND, 
		lambda2, k = k, d = d, alpha.d = alpha.d))
        out <- list(z=round(probs), probs=probs, k=k, lambda1=lambda1,
                    lambda2=lambda2, p=p, kthNND=kthNND)
        class(out) <- "nnclean"
	return(out)
}

print.nnclean <- function(x, ...){
  cat("Nearest neighbor noise detection\n")
  cat("by Byers, S. and Raftery, A. E. (1998) Nearest-Neighbor Clutter\n")
  cat("Removal for Estimating Features in Spatial Point Processes,\n")
  cat("Journal of the American Statistical Association, 93, 577-584.\n")
  cat("Classification: ( 0 means noise)\n", x$z, "\n")
  cat("The Poisson process mixture of the distance to kth nearest neighbor\n")
  cat("is characterized by k=",x$k,", p=",x$p,"\n")
  cat("lambda1=",x$lambda1,", lambda2=",x$lambda2,"\n")
}
  
"autoconst" <-
function(x, prange=c(0,1), twostep=TRUE,
                      step1=0.1, step2=0.01, plot=TRUE, nperp=4,
                      ejprob=NULL, species.fixed=TRUE, pdfnb=FALSE){
  probs <- prange[1]+step1*(0:round((prange[2]-prange[1])/step1))
  if (is.null(ejprob)){
    cat("  Calculating disjunction probability for original data ")
    cn <- con.regmat(x$prab,x$nb)
    ejumps <- sum(cn-1)
    den <- sum(x$regperspec-1)
    if (den==0 | ejumps==0)
      ejprob <- 0
    else
      ejprob <- ejumps/sum(x$regperspec-1)
    cat(ejprob,"\n")
  }
  out <- list()
  if (ejprob>0)
    out <-  autoreg(x, probs, ejprob, plot, nperp,
                    species.fixed=species.fixed, pdfnb=pdfnb)
  if (ejprob==0)
    out$pd <- 0
  if (out$pd<0)
    out$pd <- 0
  if (out$pd>1)
    out$pd <- 1
  if (twostep & out$pd>0){
    out1 <- out
    prange2 <- c(max(0,out$pd-5*step2),min(1,out$pd+5*step2))
    probs <- prange2[1]+step2*(0:round((prange2[2]-prange2[1])/step2))
    out <- autoreg(x, probs, ejprob, plot, nperp,
                     species.fixed=species.fixed, pdfnb=pdfnb)
    if (out$pd<0 | out$pd>1)
      out <- out1
  }
  out <- c(out,list(ejprob=ejprob))
  out
}











"autoreg" <-
function(x, probs, ejprob, plot=TRUE, nperp=4, species.fixed=TRUE, pdfnb=FALSE){
  tjumps <- matrix(nrow=nperp*length(probs),ncol=3)
  for (j in 1:length(probs)){
    cat("    Estimating disj. parameter: Simulations for p= ",probs[j],"\n")
    for (i in 1:nperp){
#      print(x$n.species)
#      print(x$specperreg)
#      print(sum(x$specperreg))
      test <- randpop.nb(x$nb,p.nb=probs[j], n.species=x$n.species,
                         vector.species=x$regperspec,
                         species.fixed=species.fixed,
                         pdf.regions=x$specperreg/sum(x$specperreg),
                         count=FALSE, pdfnb=pdfnb)
#      print("Test generated")
#      print(test)
#      print(dim(test))
#      print(x$regperspec)
      nst <- apply(test,2,sum)
#      print(nst)
#      print(apply(test,1,sum) - x$specperreg)
      tcn <- con.regmat(test,x$nb,count=FALSE)
#      print("tcn computed")
      ind <- (j-1)*nperp+i
      tjumps[ind,1] <- probs[j]
      tjumps[ind,2] <- sum(tcn-1)
#      print(tjumps[ind,2])
      tjumps[ind,3] <- tjumps[ind,2]/sum(nst-1)
    }
  }
  ejlm <- lm(tjumps[,3]~tjumps[,1])
  if (plot){
    plot(tjumps[,1],tjumps[,3],xlab="pdisj",
         ylab="qdisj")
#    print(tjumps[,1])
#    print(tjumps[,3])
    abline(ejlm$coef)
    abline(c(ejprob,0), lty=2)
  }
  pd <- (ejprob-ejlm$coef[1])/ejlm$coef[2]
  cat("  Estimated disjunction parameter =",pd,"\n")
  out <- list(pd=pd, coef=ejlm$coef)
  out
}
"cluspop.nb" <-
function(neighbors,p.nb=0.5,n.species,clus.specs,reg.group,
                       grouppf=10, n.regions=length(neighbors),
                       vector.species=rep(1,n.species),
                       pdf.regions=rep(1/n.regions,n.regions),count=TRUE,
                       pdfnb=FALSE){
# print(vector.species)
  out <- matrix(0,ncol=n.species,nrow=n.regions)
  if (pdfnb)
  {
    for (i in 1:n.regions)
      pdf.regions[i] <- pdf.regions[i]/max(1,length(neighbors[[i]]))
    pdf.regions <- pdf.regions/sum(pdf.regions)
  }
  pdf.group <- pdf.complement <- pdf.regions
  pdf.groupstart <- pdf.cstart <- rep(0,n.regions)
  sp <- spc <- spr <- 0
  prob.group <- sum(pdf.group[reg.group])
  pdf.complement[reg.group] <- pdf.regions[reg.group]/grouppf
  spc <- sum(pdf.complement[reg.group])
  sp <- spc*grouppf
  reg.c <- (1:n.regions)[-reg.group]
  pdf.group[reg.c] <- pdf.regions[reg.c]/grouppf
  pdf.cstart[reg.c] <- pdf.regions[reg.c]/(1-sp)
  pdf.complement[reg.c] <- pdf.cstart[reg.c]*(1-spc)
  spr <- sum(pdf.group[reg.c])
  pdf.groupstart[reg.group] <- pdf.regions[reg.group]/sp
  pdf.group[reg.group] <- pdf.groupstart[reg.group]*(1-spr)
  cdf.local <- cdf.regions <- cdf.groupstart <- cdf.cstart <- c()
  for (i in 1:n.regions){
    cdf.regions[i] <- sum(pdf.regions[1:i])
    cdf.groupstart[i] <- sum(pdf.groupstart[1:i])
    cdf.cstart[i] <- sum(pdf.cstart[1:i])
  }
# print(pdf.groupstart)    
# print(cdf.groupstart)    
# regular species
  for (i in 1:(n.species-clus.specs))
  {
    if(count)
      cat("Species ",i,"\n")
    spec.regind <- spec.neighb <- rep(FALSE,n.regions)
    nsize <- vector.species[1+floor(length(vector.species)*runif(1))]
# print(nsize)
    r1 <- runif(1)
    reg <- 1+sum(r1>cdf.regions)
# print(reg)
    spec.regind[reg] <- TRUE
    for (k in neighbors[[reg]])
      spec.neighb[k] <- TRUE
    out[reg,i] <- 1
    if(nsize>1)
      for (j in 2:nsize)
        if ((sum(spec.neighb)==0) | (sum(pdf.regions[spec.neighb])<1e-8) |
             (sum(spec.neighb | spec.regind)==n.regions))
# no further neighbors or only neighbors, i.e., next region is drawn from all
# remaining
        {
          nreg <- sum(!spec.regind)
          pdf.local <- pdf.regions[!spec.regind]
          pdf.local <- pdf.local/sum(pdf.local)
          for (l in 1:nreg)
            cdf.local[l] <- sum(pdf.local[1:l])
# cat(nreg, "\n")
          r1 <- runif(1)
          zz <- 1+sum(r1>cdf.local[1:nreg])
# cat(zz,"\n")
          reg <- (1:n.regions)[!spec.regind][zz]
# cat("reg, all ",reg,"\n")  
          spec.regind[reg] <- TRUE
          spec.neighb[reg] <- FALSE
          for (k in neighbors[[reg]])
            spec.neighb[k] <- !(spec.regind[k])
          out[reg,i] <- 1
        }
        else
          if (runif(1)<p.nb)
# next region is drawn from non-neighbors (jump)
          { 
            regs <- !(spec.regind | spec.neighb)
            nreg <- sum(regs)
            pdf.local <- pdf.regions[regs]
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
# cat(nreg," ",zz,"\n")
            reg <- (1:n.regions)[regs][zz]  
# cat("reg, jump ",reg,"\n")  
            spec.regind[reg] <- TRUE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,i] <- 1
# if (sum(out[,i])!=sum(spec.regind))
#   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
          }
          else
          {
# next region is drawn from neighbors
            nreg <- sum(spec.neighb)
            pdf.local <- pdf.regions[spec.neighb]
# print(pdf.local)
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
# print(cdf.local)
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
# cat("nreg= ",nreg," zz =",zz,"\n")
            reg <- (1:n.regions)[spec.neighb][zz]  
# cat("reg, neighbor ",reg,"\n")  
            spec.regind[reg] <- TRUE
            spec.neighb[reg] <- FALSE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,i] <- 1
# if (sum(out[,i])!=sum(spec.regind))
#   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
          }
# end if nsize>1 for j 
# cat("out=",sum(out[,i]),"  ind=",sum(spec.regind),"  nb=",sum(spec.neighb),
#    "  nni=",sum(!(spec.regind | spec.neighb)),"\n")
  } # for i - regular species
# species from reg.group
  for (i in 1:clus.specs)
  {
    ind <-i+n.species-clus.specs 
    if(count)
      cat("Clustered species ",ind,"\n")
    groupind <- runif(1)<prob.group
    if (groupind){
      spec.regind <- spec.neighb <- rep(FALSE,n.regions)
      nsize <- vector.species[1+floor(length(vector.species)*runif(1))]
  # print(nsize)
      r1 <- runif(1)
      reg <- 1+sum(r1>cdf.groupstart)
  # print(reg)
      spec.regind[reg] <- TRUE
      for (k in neighbors[[reg]])
        spec.neighb[k] <- TRUE
      out[reg,ind] <- 1
      if(nsize>1)
        for (j in 2:nsize)
          if ((sum(spec.neighb)==0) | (sum(pdf.group[spec.neighb])<1e-8) |
               (sum(spec.neighb | spec.regind)==n.regions))
  # no further neighbors or only neighbors, i.e., next region is drawn from all
  # remaining
          {
            nreg <- sum(!spec.regind)
            pdf.local <- pdf.group[!spec.regind]
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
  # cat(nreg, "\n")
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat(zz,"\n")
            reg <- (1:n.regions)[!spec.regind][zz]
  # cat("reg, all ",reg,"\n")  
            spec.regind[reg] <- TRUE
            spec.neighb[reg] <- FALSE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,ind] <- 1
          }
          else
            if (runif(1)<p.nb)
  # next region is drawn from non-neighbors (jump)
            { 
              regs <- !(spec.regind | spec.neighb)
              nreg <- sum(regs)
              pdf.local <- pdf.group[regs]
              pdf.local <- pdf.local/sum(pdf.local)
              for (l in 1:nreg)
                cdf.local[l] <- sum(pdf.local[1:l])
              r1 <- runif(1)
              zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat(nreg," ",zz,"\n")
              reg <- (1:n.regions)[regs][zz]  
  # cat("reg, jump ",reg,"\n")  
              spec.regind[reg] <- TRUE
              for (k in neighbors[[reg]])
                spec.neighb[k] <- !(spec.regind[k])
              out[reg,ind] <- 1
  # if (sum(out[,i])!=sum(spec.regind))
  #   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
            }
            else
            {
  # next region is drawn from neighbors
              nreg <- sum(spec.neighb)
              pdf.local <- pdf.group[spec.neighb]
  # print(pdf.local)
              pdf.local <- pdf.local/sum(pdf.local)
              for (l in 1:nreg)
                cdf.local[l] <- sum(pdf.local[1:l])
  # print(cdf.local)
              r1 <- runif(1)
              zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat("nreg= ",nreg," zz =",zz,"\n")
              reg <- (1:n.regions)[spec.neighb][zz]  
  # cat("reg, neighbor ",reg,"\n")  
              spec.regind[reg] <- TRUE
              spec.neighb[reg] <- FALSE
              for (k in neighbors[[reg]])
                spec.neighb[k] <- !(spec.regind[k])
              out[reg,ind] <- 1
  # if (sum(out[,i])!=sum(spec.regind))
  #   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
            }
  # end if nsize>1 for j 
  # cat("out=",sum(out[,i]),"  ind=",sum(spec.regind),"  nb=",sum(spec.neighb),
  #    "  nni=",sum(!(spec.regind | spec.neighb)),"\n")
    } # if groupind           
# species from complement
    else{
      spec.regind <- spec.neighb <- rep(FALSE,n.regions)
      nsize <- vector.species[1+floor(length(vector.species)*runif(1))]
  # print(nsize)
      r1 <- runif(1)
      reg <- 1+sum(r1>cdf.cstart)
  # print(reg)
      spec.regind[reg] <- TRUE
      for (k in neighbors[[reg]])
        spec.neighb[k] <- TRUE
      out[reg,ind] <- 1
      if(nsize>1)
        for (j in 2:nsize)
          if ((sum(spec.neighb)==0) | (sum(pdf.complement[spec.neighb])<1e-8) |
               (sum(spec.neighb | spec.regind)==n.regions))
  # no further neighbors or only neighbors, i.e., next region is drawn from all
  # remaining
          {
            nreg <- sum(!spec.regind)
            pdf.local <- pdf.complement[!spec.regind]
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
  # cat(nreg, "\n")
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat(zz,"\n")
            reg <- (1:n.regions)[!spec.regind][zz]
  # cat("reg, all ",reg,"\n")  
            spec.regind[reg] <- TRUE
            spec.neighb[reg] <- FALSE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,ind] <- 1
          }
          else
            if (runif(1)<p.nb)
  # next region is drawn from non-neighbors (jump)
            { 
              regs <- !(spec.regind | spec.neighb)
              nreg <- sum(regs)
              pdf.local <- pdf.complement[regs]
              pdf.local <- pdf.local/sum(pdf.local)
              for (l in 1:nreg)
                cdf.local[l] <- sum(pdf.local[1:l])
              r1 <- runif(1)
              zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat(nreg," ",zz,"\n")
              reg <- (1:n.regions)[regs][zz]  
  # cat("reg, jump ",reg,"\n")  
              spec.regind[reg] <- TRUE
              for (k in neighbors[[reg]])
                spec.neighb[k] <- !(spec.regind[k])
              out[reg,ind] <- 1
  # if (sum(out[,i])!=sum(spec.regind))
  #   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
            }
            else
            {
  # next region is drawn from neighbors
              nreg <- sum(spec.neighb)
              pdf.local <- pdf.complement[spec.neighb]
  # print(pdf.local)
              pdf.local <- pdf.local/sum(pdf.local)
              for (l in 1:nreg)
                cdf.local[l] <- sum(pdf.local[1:l])
  # print(cdf.local)
              r1 <- runif(1)
              zz <- 1+sum(r1>cdf.local[1:nreg])
  # cat("nreg= ",nreg," zz =",zz,"\n")
              reg <- (1:n.regions)[spec.neighb][zz]  
  # cat("reg, neighbor ",reg,"\n")  
              spec.regind[reg] <- TRUE
              spec.neighb[reg] <- FALSE
              for (k in neighbors[[reg]])
                spec.neighb[k] <- !(spec.regind[k])
              out[reg,ind] <- 1
  # if (sum(out[,i])!=sum(spec.regind))
  #   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
            }
  # end if nsize>1 for j 
  # cat("out=",sum(out[,i]),"  ind=",sum(spec.regind),"  nb=",sum(spec.neighb),
  #    "  nni=",sum(!(spec.regind | spec.neighb)),"\n")
    } # else (complement)
  } # for i
  out
}
comp.test <- function(cl, spg){
  cs <- chisq.test(cl,spg,simulate.p.value=TRUE,B=10000)
  print(cs)
  invisible(cs)
}
"con.comp" <-
function(comat){
  nc <- ncol(comat)
#  print(nc)
  ccn <- rep(0, times=nc) # con.comp number for each point
  fhist <- rep(FALSE, times=nc) # indicator if point had been under consideration  
  stn <- 0                  # current cc number
  pn <- 1                  # point nr. to which similar objects are looked for
  while(pn>0){
    stn <- stn+1
    repeat{
      sm <- 0              # smallest new point nr.
      ccn[pn] <- stn
      fhist[pn] <- TRUE
      if(nc>1)
      {
  	for(i in 2:nc)
        {
# print(comat[i,])
# cat(i, pn, ccn[i], comat[i,pn],"\n")
  	  if((ccn[i]==0) & (comat[i,pn]))
            ccn[i] <- stn
  	  if ((sm==0) & (ccn[i]==stn) & (fhist[i]==FALSE))
            sm <- i
  	} # for i
# cat("stn=", stn, "sm=", sm, "\n")
      } # if nc>1
      if (sm>0)
        pn <- sm
      else
        break
    } # repeat
#    print("repeat terminated")
    pn <- 0
    i <- 2
    while(i<=nc){
      if(ccn[i]==0){
        pn <- i
        i <- nc
      } # if
      i <- i+1
    } # while i
  } # while pn>0 (stn-loop)
  ccn
}
"con.regmat" <-
function(regmat,neighbors,count=FALSE){
  nart <- ncol(regmat)
  nreg <- nrow(regmat)
  out <- c()
  for (i in 1:nart)
  {
    nspec <- sum(regmat[,i])
    if (count)
      cat("Species ",i," size ",nspec,"\n")
    regions <- (1:nreg)[as.logical(regmat[,i])]
    comat <- matrix(FALSE,ncol=nspec,nrow=nspec)
    for (j in 1:nspec)
      for (k in neighbors[[regions[j]]])
        comat[j,(1:nspec)[regions==k]] <- TRUE
    out[i] <- max(con.comp(comat))
  }
  out
}
"distratio" <-
function(distmat, prop=0.25){
  nc <- ncol(distmat)
  net <- as.integer(nc*(nc-1)/2)
  if (prop==(-1))
    prop <- 0.25
  vdist <- distmat[upper.tri(distmat)]
# cat("length=",length(vdist)," net=",net,"\n")
  sdist <- sort(vdist)
  lo <- floor(prop*net)
  hi <- ceiling((1-prop)*net)+1
# cat("lo=", lo, " hi=",hi,"\n")
  los <- sum(sdist[1:lo])
  his <- sum(sdist[hi:net])
  lowmean <- los/lo
  himean <- his/(net+1-hi)
  dr <- lowmean/himean
  out <- list(dr=dr,lowmean=lowmean,himean=himean,prop=prop)
  out
}
"homogen.test" <-
function(distmat,ne=ncol(distmat),testdist="erdos"){
  nc <- ncol(distmat)
  vdist <- distmat[upper.tri(distmat)]
  sdist <- sort(vdist)
  distcut <- sdist[ne]
  iv <- nc
  for (i in 1:nc)
    iv <- iv - (min(distmat[-i,i])<=distcut)
  if(testdist=="erdos"){
    lambda <- exp(-2*ne/(nc-1) + log(nc))
    p <- 1-ppois(iv-1,lambda)
    if (iv>=lambda)
      psymm <- 2*pnorm((lambda-iv)/sqrt(lambda))
    else
      psymm <- 2*pnorm((iv-lambda)/sqrt(lambda))
    out <- list(p=p, p.twoside=psymm, iv=iv, lambda=lambda, distcut=distcut, ne=ne)
  } 
  if(testdist=="ling"){
    print("Computation of Ling-probabilities...")
    prob <- rep(0,ne*(nc-iv))
    dim(prob) <- c(ne,(nc-iv))
#    prob <- rep(0,ne*nc)
#    dim(prob) <- c(ne,nc)
    prob[1,2] <- 1
    n2 <- choose(nc,2)
    for (i in 2:ne)
      for(j in 3:(nc-iv))
#      for(j in 3:nc)
        prob[i,j] <- (choose(nc-j+2,2)*prob[i-1,j-2]+
          (j-1)*(nc-j+1)*prob[i-1,j-1]+(choose(j,2)-(i-1))*prob[i-1,j])/
          (n2-(i-1))
#    cat(prob)
    p2 <- p <- 0
    for(j in 2:(nc-iv))
      p <- p+prob[ne,j]
    print("finished.")
    out <- list(p=p, iv=iv, distcut=distcut, ne=ne)
  }
  out
}

"incmatrix" <-
function(regmat){
  nart <- ncol(regmat)
  nreg <- nrow(regmat)
  neq <- 0
  incmat <- diag(nart)
  for (i in 1:(nart-1))
    for (j in (i+1):nart){
#      cat (i," ",j," ",sum(regmat[,i]<regmat[,j]),sum(regmat[,j]<regmat[,i]),"\n")
      if (sum(regmat[,i]<regmat[,j])==0)
        incmat[i,j] <- 1
      if (sum(regmat[,j]<regmat[,i])==0)
        incmat[j,i] <- 1
      if (identical(regmat[,i],regmat[,j]))
#        incmat[i,j] <- 0
        neq <- neq+1
    }
  out <- list(m=incmat, ninc=sum(incmat)-2*neq-nart, neq=neq)
  out
}
"jaccard" <-
function(regmat){
  nart <- ncol(regmat)
  jdist <- rep(0, nart*nart)
  dim(jdist) <- c(nart,nart)
  for (i in 1:(nart-1)){
#    cat("Row ",i,"\n")
    for (j in (i+1):nart){
      jdist[j,i] <- jdist[i,j] <-  1-sum(regmat[,i]+regmat[,j]>1.99)/sum(regmat[,i]+regmat[,j]>0.99)
      if (is.na(jdist[i,j]))
        cat("Warning! NA at i=",i,", j=", j,"\n")
    }
  }
  jdist
}
"kulczynski" <-
function(regmat){
  nart <- ncol(regmat)
  jdist <- rep(0, nart*nart)
  dim(jdist) <- c(nart,nart)
  for (i in 1:(nart-1)){
#    cat("Row ",i,"\n")
    for (j in (i+1):nart){
      ri <- sum(regmat[,i])
      rj <- sum(regmat[,j])
      srij <- sum(regmat[,i]+regmat[,j]>=1.99) 
      jdist[j,i] <- jdist[i,j] <- 1 - 0.5* (srij/ri + srij/rj)
      if (is.na(jdist[i,j]))
        cat("Warning! NA at i=",i,", j=", j,"\n")
    }
  }
  jdist
}
"lcomponent" <-
function(distmat, ne=floor(3*ncol(distmat)/4)){
  nc <- ncol(distmat)
  vdist <- distmat[upper.tri(distmat)]
  sdist <- sort(vdist)
  distcut <- sdist[ne]
  cm <- (distmat<=distcut)  
  ccn <- con.comp(cm)
  stn <- max(ccn)
  pn <- vector(length=stn)
  for (i in 1:stn)
    pn[i] <- sum(ccn==i)
  lc <- max(pn)
  out <- list(lc=lc,ne=ne)
  out
}
"nbtest" <-
  function(nblist, n.regions=length(nblist)){
    nbok <- TRUE
    if (!is.list(nblist)){
      cat("Neighborhood is not a list.\n")
      nbok <- FALSE
    }
    lnb <- length(nblist)
    if (lnb!=n.regions){
      cat("Neighborhood length",lnb,"does not match regions number",
          n.regions,".\n")
      nbok <- FALSE
    }
    for (i in 1:lnb){
      if (length(nblist[[i]])>0){
        if (min(nblist[[i]]<1))
          stop("Neighborhood list contains elements smaller than 1.")
        if (max(nblist[[i]]>n.regions))
          stop("Neighborhood list contains elements larger than number of regions.")
        for (n in nblist[[i]]){
          if (n==i){
            cat(i,"is neighbor of itself.\n")
            nbok <- FALSE
          }
          if (all(nblist[[n]]!=i)){
            cat(i,"is neighbor of",n,"but",n,"is not neighbor of",
                i,".\n")
            nbok <- FALSE
          }
        }
      }
    }
    if (!nbok) stop("Improper neighborhood list.")
    invisible(nbok)
  }


"nn" <-
function(distmat,ne=1){
  nc <- ncol(distmat)
  nnd <- c()
  for (i in 1:nc)
    nnd[i] <- sort(distmat[i,])[ne+1]
  out <- mean(nnd)
  out
}
"pop.sim" <-
function(regmat, neighbors, h0c=1, times=200, dist="kulczynski",
                    teststat="isovertice",testc=NULL,
                    n.species=ncol(regmat), specperreg=NULL,
                    regperspec=NULL, species.fixed=FALSE, pdfnb=FALSE){
  statres <- rep(0,times)
  if (is.null(specperreg))
      nregions <- apply(regmat,1,sum)
  else
      nregions <- specperreg
  if (is.null(regperspec))
      nspecies <- apply(regmat,2,sum)
  else
      nspecies <- regperspec
  for (i in 1:times)
  {
    cat("Simulation run ",i)
    mat <- randpop.nb(neighbors,p.nb=h0c,n.species=n.species,
                        vector.species=nspecies, species.fixed=species.fixed,
                        pdf.regions=nregions/sum(nregions),count=FALSE,
                      pdfnb=pdfnb)
    if (teststat!="inclusions"){
      if (dist=="jaccard")
        distm <- jaccard(mat)
      if (dist=="kulczynski")
        distm <- kulczynski(mat)
    }
    else
      statres[i] <- incmatrix(mat)$ninc
    if (teststat=="isovertice")
    {
      test <- homogen.test(distm,ne=testc)
      statres[i] <- test$iv
    }
    if (teststat=="lcomponent")
      statres[i] <- lcomponent(distm,ne=testc)$lc
    if (teststat=="distratio")
      statres[i] <- distratio(distm,prop=testc)$dr
    if (teststat=="nn")
      statres[i] <- nn(distm,ne=testc)
    cat(" statistics value=",statres[i],"\n")
  }
  if (teststat!="inclusions"){
    if (dist=="jaccard")
      distm <- jaccard(regmat)
    if (dist=="kulczynski")
      distm <- kulczynski(regmat)
  }
  else{
    test <- incmatrix(regmat)$ninc
    p.above <- (1+sum(statres>=test))/(1+times)
    p.below <- (1+sum(statres<=test))/(1+times)
    datac <- test
  }
  if (teststat=="isovertice")
  {
    test <- homogen.test(distm,ne=testc)
    p.above <- (1+sum(statres>=test$iv))/(1+times)
    p.below <- (1+sum(statres<=test$iv))/(1+times)
    pb <- min(p.above,p.below)*2
    p.above <- max(p.above,p.below)
    p.below <- pb
    datac <- test$iv
    testc <- test$ne
  }
  if (teststat=="lcomponent")
  {
    test <- lcomponent(distm,ne=testc)
    p.above <- (1+sum(statres>=test$lc))/(1+times)
    p.below <- (1+sum(statres<=test$lc))/(1+times)
    datac <- test$lc
    testc <- test$ne
  }
  if (teststat=="nn")
  {
    test <- nn(distm,ne=testc)
    p.above <- (1+sum(statres>=test))/(1+times)
    p.below <- (1+sum(statres<=test))/(1+times)
    datac <- test
  }
  if (teststat=="distratio")
  {
    test <- distratio(distm,prop=testc)
    p.above <- (1+sum(statres>=test$dr))/(1+times)
    p.below <- (1+sum(statres<=test$dr))/(1+times)
    datac <- test$dr
    testc <- test$prop
  }
  cat("Data value: ",datac,"\n")
  out <- list(results=statres,p.above=p.above,p.below=p.below,datac=datac,
              testc=testc)
  out
}







"prabclust" <-
function(prabobj, mdsmethod="classical", mdsdim=4,
                      nnk=ceiling(prabobj$n.species/40), nclus=0:9,
                      modelid="noVVV"){
  require(mva)
  require(MASS)
  require(mclust)
  dm <- prabobj$distmat
  if (mdsmethod!="classical"){
    mindm <- min(dm[dm>0])/10
    for (i in 1:(prabobj$n.species-1))
      for (j in (i+1):prabobj$n.species)
        if (dm[i,j]<mindm) dm[i,j] <- dm[j,i] <- mindm
  }
  mds <- switch(mdsmethod,
                classical = cmdscale(dm, k=mdsdim),
                kruskal = isoMDS(dm, k=mdsdim)$points,
                sammon = sammon(dm, k=mdsdim)$points)
  kn <- NNclean(mds, k=nnk)
  if (modelid=="all")
    kem <- EMclustN(mds, G=nclus, noise=1-kn$z)
  else{
    if (modelid=="noVVV")
      kem <- EMclustN(mds, G=nclus,
                           emModelNames=c("EII","VII","EEI","VEI",
                             "EVI", "VVI", "EEE","EEV", "VEV"),
                           noise=1-kn$z)
    else
      kem <- EMclustN(mds, G=nclus,
                     emModelNames=modelid, noise=1-kn$z)
  }
  skem <- summary(kem,mds)
  uclustering <- skem[[4]]
#  print(kem)
  nc <- max(uclustering)
  noisec <- ifelse(nc==ncol(skem$mu),FALSE,TRUE)
#   print(nc)
#   print(skem[[5]])
#   print(skem[[6]])
#   print(skem[[7]])
#   print(skem[[4]])
  clustering <- uclustering
  csum <- function(n, cv){
    out <- c()
    for (i in 1:length(n))
      out[i] <- sum(cv==n[i])
    out
  }
  ncl <- ifelse(noisec, nc-1, nc)
  cs <- csum(1:ncl,clustering)
  ocs <- order(-cs)
  for (i in 1:ncl)
    clustering[uclustering==ocs[i]] <- i
  if (noisec & nc==1) symbols <- c("N")
  else{
    if (noisec)
      symbols <- c(sapply(1:ncl, toString),"N")
    else
      symbols <- sapply(1:nc, toString)
  }
  clsym <- symbols[clustering]
  for (i in 1:ncl)
    if (sum(clustering==i)<2)
      clsym[clustering==i] <- "N"      
  plot(mds, pch=clsym)
  out <- list(clustering=clustering, clustsummary=skem, bicsummary=kem,
              points=mds, nnk=nnk, mdsdim=mdsdim, mdsmethod=mdsmethod,
              symbols=clsym)
  class(out) <- "prabclust"
  out
}
"prabinit" <-
function(file=NULL, prabmatrix=NULL, 
                     rows.are.species=TRUE, neighborhood="none",
                     distance="kulczynski", toprab=FALSE, toprabp=0.05,
                     outc=5.2){
  if (is.null(prabmatrix))
    m1 <- as.matrix(read.table(file))
  else
    m1 <- as.matrix(prabmatrix)
  if(rows.are.species)
    m1 <- t(m1)
  # From now on, species are columns
  regperspec <- apply(m1,2,sum)
  specperreg <- apply(m1,1,sum)
  m1 <- as.matrix(m1[,regperspec>0])
  regperspec <- regperspec[regperspec>0]
  n.species <- ncol(m1)
  n.regions <- nrow(m1)
  nb <- list()
  if (is.list(neighborhood))
      nb <- neighborhood
  else{
    if(neighborhood=="none")
      for (i in 1:n.regions)
        nb[[i]] <- numeric(0)
    else
      for (i in 1:n.regions)
        nb <- c(nb,list(scan(file=neighborhood, skip=i-1,nlines=1, quiet=TRUE)))
  }
  nbtest(nb, n.regions)
  if(toprab){
    nscut <- toprabp*specperreg
    minno <- c()
    for (i in 1:n.species){
      g0 <- log(m1[,i][m1[,i]>0])
      minno[i] <- median(g0)-mad(g0,constant=outc)
    }
    for (i in 1:n.regions)
      for (j in 1:n.species)
        m1[i,j] <- as.integer(m1[i,j]>=nscut[i] | log(m1[i,j])>=minno[j])
    regperspec <- apply(m1,2,sum)
    specperreg <- apply(m1,1,sum)
  }
  distmat <- switch(distance,
                    kulczynski = kulczynski(m1),
                    jaccard = jaccard(m1),
                    simpson = simpsond(m1),
                    none = NULL)
  out <- list(distmat=distmat, prab=m1, nb=nb, regperspec=regperspec,
              specperreg=specperreg, n.species=n.species, n.regions=n.regions,
              distance=distance, spatial=(!identical(neighborhood,"none")))
  class(out) <- "prab"
  out
}
"prabtest" <-
function(x, teststat="distratio",tuning=switch(teststat,distratio=0.25,
                        lcomponent=floor(3*ncol(x$distmat)/4),
                        isovertice=ncol(x$distmat),nn=4,NA), times=1000,
                        pd=NULL,
                      prange=c(0,1), nperp=4, step=0.1, twostep=TRUE,
                      sf.sim=FALSE, sf.const=sf.sim,
         pdfnb=FALSE){
  if (is.null(pd) & x$spatial)
    ac <- autoconst(x, twostep=twostep, prange=prange, nperp=nperp,
                    step1=step, species.fixed=sf.const)
  else{
    if (is.null(pd))
      pd <- 1
    ac <- list(pd=pd, coef=NA)
  }
#  if (!is.logical(pdfnb))
#    pdfnb <- nbdiag(x,pd=ac$pd,plot=FALSE)$pdfnb
  psim <- pop.sim(x$prab,x$nb,teststat=teststat, h0c=ac$pd,
                  dist=x$distance,
                  times=times, testc=tuning, n.species=x$n.species,
                  specperreg=x$specperreg, regperspec=x$regperspec,
                  species.fixed=sf.sim, pdfnb=pdfnb)
  out <- list(results=psim$results, datac=psim$datac,
              p.value=ifelse(teststat=="inclusions", 
              psim$p.above,psim$p.below), tuning=tuning, pd=ac$pd,
              reg=ac$coef,
              teststat=teststat, distance=x$distance, times=times,
              pdfnb=pdfnb)
  class(out) <- "prabtest"
  out
}
"print.prab" <-
function(x, ...){
  cat("Presence-absence matrix object with\n")
  cat(x$n.species," species and ",x$n.regions," regions,\n")
  cat("including regions neighborhoods and \n")
  cat("between-species distance matrix of type ",x$distance,".\n")
}
"print.prabclust" <-
function(x, bic=FALSE, ...){
  cat("* Clustered presence-absence matrix * \n\n")
  cat("Clustered: ", x$mdsdim, "-dim. MDS result from method ",x$mdsmethod,"\n\n")
#  cat("mclust decided for ",ncol(x$clustsummary[[3]]$mu),
#      " clusters plus noise.\n")
  cat("Noise-detector NNclean has been used with k=", x$nnk, "\n")
  cat("NNclean is explained in S. Byers and A. E. Raftery, JASA 95 (1998), 781-794\n")
  cat("A Normal mixture model with noise component (mclust) has been used.\n")
  if (bic){
    cat("Cluster summary:\n")
    print(x$clustsummary)
    cat("\n")
    cat("BIC value summary:\n")
    print(x$bicsummary)
    cat("\n")
  }
  else{
    cat("Mixture component memberships:\n")
    print(x$clustering)
    cat("\n")
  }
  cat("Clustering (N denotes noise or one-point components):\n")
  print(x$symbols)
}
"print.summary.prabtest" <-
function(x, ...){
  cat("* Monte Carlo test for presence-absence data *\n\n")
  cat("Test statistics: ",x$teststat,", Tuning constant=",x$tuning,"\n")
  cat("Distance: ",x$distance,"\n")
  cat("Simulation runs: ",x$times,"\n")
  cat("Disjunction parameter: ",x$pd,"\n")
  if (x$pdfnb)
    cat("Neighbor-based correction of region probabilities was used.\n")
  else 
    cat("Neighbor-based correction of region probabilities was not used.\n")
  cat("Statistics value for original data: ",x$datac,"\n")
  cat("Mean for null data: ",x$rmean,", range: ",x$rrange,"\n")
  cat("p= ",x$p.value,"\n")
}
"randpop.nb" <-
function(neighbors,p.nb=0.5,n.species,
                       n.regions=length(neighbors),
                       vector.species=rep(1,n.species), species.fixed=FALSE,
                       pdf.regions=rep(1/n.regions,n.regions),count=TRUE,
                       pdfnb=FALSE){
# print(vector.species)
  out <- matrix(0,ncol=n.species,nrow=n.regions)
  if (pdfnb)
  {
    for (i in 1:n.regions)
      pdf.regions[i] <- pdf.regions[i]/max(1,length(neighbors[[i]]))
    pdf.regions <- pdf.regions/sum(pdf.regions)
  }
  cdf.local <- cdf.regions <- c()
  for (i in 1:n.regions)
    cdf.regions[i] <- sum(pdf.regions[1:i])
  for (i in 1:n.species)
  {
    if(count)
      cat("Species ",i,"\n")
    spec.regind <- spec.neighb <- rep(FALSE,n.regions)
    nsize <- ifelse(species.fixed, vector.species[i],
                    vector.species[1+floor(length(vector.species)*runif(1))])
#    print(vector.species)
#    print(nsize)
    r1 <- runif(1)
    reg <- 1+sum(r1>cdf.regions)
# print(reg)
#    print(cdf.regions)
    spec.regind[reg] <- TRUE
    for (k in neighbors[[reg]])
      spec.neighb[k] <- TRUE
    out[reg,i] <- 1
#    print(out)
#    print(nsize)
    if(nsize>1)
      for (j in 2:nsize)
        if (all(!spec.neighb) | all(pdf.regions[spec.neighb]<1e-8) |
             all(spec.neighb | spec.regind) |
            all(pdf.regions[!(spec.regind | spec.neighb)]<1e-8))
# no further neighbors or only neighbors, i.e., next region is drawn from all
# remaining
        {
          nreg <- sum(!spec.regind)
          pdf.local <- pdf.regions[!spec.regind]
          pdf.local <- pdf.local/sum(pdf.local)
          for (l in 1:nreg)
            cdf.local[l] <- sum(pdf.local[1:l])
# cat(nreg, "\n")
          r1 <- runif(1)
          zz <- 1+sum(r1>cdf.local[1:nreg])
# cat(zz,"\n")
          reg <- (1:n.regions)[!spec.regind][zz]
#          if (spec.regind[reg]) cat("reg, all ",reg,"\n")  
          spec.regind[reg] <- TRUE
          spec.neighb[reg] <- FALSE
          for (k in neighbors[[reg]])
            spec.neighb[k] <- !(spec.regind[k])
          out[reg,i] <- 1
        }
        else
          if (runif(1)<p.nb)
# next region is drawn from non-neighbors (jump)
          { 
            regs <- !(spec.regind | spec.neighb)
            nreg <- sum(regs)
            pdf.local <- pdf.regions[regs]
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
# cat(nreg," ",zz,"\n")
            reg <- (1:n.regions)[regs][zz]
#            if (is.na(spec.regind[reg]))  cat("reg, jump ",r1," ",cdf.local,"\n")  
            spec.regind[reg] <- TRUE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,i] <- 1
# if (sum(out[,i])!=sum(spec.regind))
#   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
          }
          else
          {
# next region is drawn from neighbors
            nreg <- sum(spec.neighb)
            pdf.local <- pdf.regions[spec.neighb]
# print(pdf.local)
            pdf.local <- pdf.local/sum(pdf.local)
            for (l in 1:nreg)
              cdf.local[l] <- sum(pdf.local[1:l])
# print(cdf.local)
            r1 <- runif(1)
            zz <- 1+sum(r1>cdf.local[1:nreg])
# cat("nreg= ",nreg," zz =",zz,"\n")
            reg <- (1:n.regions)[spec.neighb][zz]  
#            if (spec.regind[reg]) cat("reg, neighbor ",reg,"\n")  
            spec.regind[reg] <- TRUE
            spec.neighb[reg] <- FALSE
            for (k in neighbors[[reg]])
              spec.neighb[k] <- !(spec.regind[k])
            out[reg,i] <- 1
# if (sum(out[,i])!=sum(spec.regind))
#   cat("error: sum= ",sum(out[,i])," ind=",sum(spec.regind),"\n")
          }
# end if nsize>1 for j 
# cat("out=",sum(out[,i]),"  ind=",sum(spec.regind),"  nb=",sum(spec.neighb),
#   "  nni=",sum(!(spec.regind | spec.neighb)),"\n")
  } # for i           
  out
}
"summary.prabtest" <-
function(object, ...){
  rrange <- range(object$results)
  rmean <- mean(object$results)
  out <- list(rrange=rrange, rmean=rmean, datac=object$datac,
              p.value=object$p.value, pd=object$pd, tuning=object$tuning,
              teststat=object$teststat, distance=object$distance,
              times=object$times, pdfnb=object$pdfnb)
  class(out) <- "summary.prabtest"
  out
}
