tdtexact<-function(stat, n)
{
	m <- (1 + sqrt(1 + 8 * length(n)))/2
	nij <- matrix(0, nrow = m, ncol = m)
	nij[row(nij) < col(nij)] <- n
	nn <- apply(nij, 2, sum) + apply(nij, 1, sum)
	nij <- nij + t(nij)
	ex <- exact(nn, nij, stat)
	pv <- rep(0, m)
	for(i in 1:m) {
		pv[i] <- pvx(nn[i], stat)
	}
	ex2 <- matrix(pv, m, m, byrow = T) - ex
	tree <- prim(1 - ex2)
	sum(pv) - sum(1 - tree$C[-1])
}
exact<-function(nn, nij, stat)
{
	sm <- 0 * nij
	l <- length(nn)
	for(i in 1:(l - 1)) {
		for(j in (i + 1):l) {
			sm[i, j] <- sm[i, j] + prob(nn[j], nn[i], nij[i, j], 
				stat)
		}
	}
	for(i in 2:l) {
		for(j in 1:(i - 1)) {
			sm[i, j] <- sm[i, j] + prob(nn[j], nn[i], nij[i, j], 
				stat)
		}
	}
	sm
}
prob<-function(n1, n2, n12, stat)
{
	sm <- 0
	ind1 <- ceiling(stat * sqrt(n1/4) + n1/2)
	ind2l <- max(ceiling( - stat * sqrt(n2/4) + n2/2), 0)
	ind2u <- floor(stat * sqrt(n2/4) + n2/2)
	for(i in ind1:n1) {
		if(ind1 <= n1) {
			for(j in ind2l:ind2u) {
				indkl <- max(i - n12, 0, j + i - n2)
				indku <- min(j + i - n12, i, n1 - n12)
				if(indkl <= indku) {
				  for(k in indkl:indku) {
				    sm <- sm + fact(n1 - n12, k) * fact(n2 - 
				      n12, i + j - n12 - k) * fact(n12, i - k) * 
				      0.5^(n1 + n2 - n12)
				  }
				}
			}
		}
	}
	2 * sm
}
fact<-function(i, j)
{
	if(j > 0 & j < i) {
		ff <- prod(1:i)/(prod(1:j) * prod(1:(i - j)))
	}
	if(j == 0 | j == i)
		ff <- 1
	ff
}
pvx<-function(n, stat)
{
	sm <- 0
	up <- min(floor(stat * sqrt(n/4) + n/2), n)
	low <- max(ceiling( - stat * sqrt(n/4) + n/2), 0)
	for(i in low:up) {
		sm <- sm + fact(n, i) * (0.5^n)
	}
	1 - sm
}
prim<-function(dist)
{
	n <- length(dist[, 1])
	A <- rep(0, n)
	B <- rep(0, n)
	C <- rep(Inf, n)
	j <- 1
	A[1] <- 1
	for(i in 2:n) {
		mn <- Inf
		for(k in 2:n) {
			if(A[k] == 0) {
				distance <- dist[j, k]
				if(distance < C[k]) {
				  C[k] <- distance
				  B[k] <- j
				}
				if(mn > C[k]) {
				  mn <- C[k]
				  nnext <- k
				}
			}
		}
		j <- nnext
		A[j] <- 1
	}
	list(A = A, B = B, C = C)
}