pprvBF <- function(y, x, alpha=NULL)
{
  
  # --------------------------------------------------
  # log(sum(exp(v))), a utility function to 
  # handle overflow/underflow
  # --------------------------------------------------
  "logsumexp" <- 
  function(v, na.rm=FALSE)
  {
    if(any(is.infinite(v))){
      stop("infinite values\n") 
    }
    
    if(na.rm){
      v = na.omit(v)
    }else{
      if(any(is.na(v))){
        stop("NA values\n") 
      }
    }
    
    lv = length(v)
    if(lv==0){ return(-Inf) }
    if(lv==1){ return(v[1]) }
    
    w1  = which.max(v)
    res = sum(exp(v[-w1] - v[w1]))
    lse = v[w1] + log(1+res)
    lse
  }
  
  # --------------------------------------------------
  # count the number of permutations of case-control
  # status given a matrix of k_i, k_j, k_l ...
  # each row of Omega is one combinations of those ks
  # --------------------------------------------------
  
  "logCount" <- 
  function(Omega, ns, n, ny)
  {
    len1  = nrow(Omega)
    len2  = ncol(Omega)
    njsum = sum(ns)
    
    tmp   = rep(NA, len1)
    
    for(i in 1:len1){
      kjsum = 0
      
      for(j in 1:len2){
        kj = Omega[i,j]
        nj = ns[j]
        if(j == 1){
          tmp[i] = lchoose(nj, kj)
        }else{
          tmp[i] = tmp[i] + lchoose(nj, kj)
        }
        kjsum = kjsum + kj
      }
      
      tmp[i] = tmp[i] + lchoose(n - njsum, ny - kjsum)
    }
    
    logsumexp(tmp)
  }
  
  # --------------------------------------------------
  # hyper cubic
  # --------------------------------------------------
    
  "hcube" <-
  function(nUpper, nLower=NULL)
  {
    # This is a modified version of the function  
    # with the same name in R/combinat
    # 
    # it outputs all points in a hypercuboid lattice
    # with lower and upper bounds by nLower and nUpper
    # or (if nLower == NULL) from 0 to nUpper.
    
    if(!is.null(nLower)) {
      x = nUpper - nLower
    }else{
      x = nUpper
    }
    
    x1 = x + 1
    ncols = length(x)
    nrows = prod(x1)
    cp    = c(1, cumprod(x1)[ - ncols])
    out   = lapply(as.list(1:length(x)), function(i, a, b, d, nr)
                  rep(rep(0:a[i], rep(b[i], d[i])), length = nr), 
                  a = x, b = cp, d=x1, nr = nrows)
    out   = array(unlist(out), c(nrows, ncols))

    if(!is.null(nLower)) {
      out = sweep(out, 2, nLower, FUN = "+")
    }
    out
  }
  
  # --------------------------------------------------
  # check inputs
  # --------------------------------------------------
  
  if(!is.numeric(y)){
    stop("y must be a nuemric vector\n")  
  }
  
  if(!is.matrix(x)){
    stop("x must be a matrix\n")  
  }
  
  if(ncol(x) < 2){
    stop("x must be a matrix with at least two columns\n")  
  }
  
  if(nrow(x) != length(y)){
    stop("x and y have different lengths\n")
  }
  
  if(any(sort(unique(y)) != c(0,1))){
    stop("y must be a binary vector with values 0 or 1\n")  
  }
  
  if(any(sort(unique(as.vector(x))) != c(0,1))){
    stop("x can only be 0 or 1\n")  
  }
    
  # --------------------------------------------------
  # data dimension 
  # --------------------------------------------------
  n  = length(y)
  ny = sum(y)
  nx = ncol(x) 
  
  # --------------------------------------------------
  # make sure the number of cases is larger than the 
  # number of samples with at least one rare variant
  # --------------------------------------------------
  wcase   = which(y==1)
  r1      = rep(1, ncol(x))
  rowSums = drop(x %*% r1)
  wrare   = which(rowSums > 0)
  
  if(length(wcase) <= length(wrare)){
    str1 = "number of cases must be larger than the number of samples"
    str1 = paste(str1, "with at least one rare variant")
    stop(str1)
  }
  
  # --------------------------------------------------
  # prepare data 
  # --------------------------------------------------
  r1 = matrix(1, nrow=1, ncol=nrow(x))
  hs = ns = drop(r1 %*% x)
  nclass = nx

  wInterSec = which(rowSums > 1)
  interSect = FALSE
  
  # cntIntSum[i] = # smaples with rare allele in SNP i and 
  # at least one other SNP
  cntIntSum = rep(0, nx)
  idxL = cntL = namL = list()
  
  idxL[[1]] = diag(nx)
  cntL[[1]] = ns
  namL[[1]] = as.character(1:nx)
  
  if(length(wInterSec) > 0){
    interSect = TRUE
    idxInsTb  = table(apply(x[wInterSec, ,drop=FALSE], 1, paste, collapse="-"))
    xnew      = x[-wInterSec,]
    rnew      = r1[-wInterSec]
    hs        = as.numeric(c(drop(rnew %*% xnew), idxInsTb))
    nclass    = nclass + length(idxInsTb)
    
    idx1 = strsplit(names(idxInsTb), split="-")
    nam1 = lapply(idx1, function(v){which(v=="1")})
    
    nam1Str = sapply(nam1, paste, collapse=";")
    nam1Str = paste(nam1Str, ";", sep="")
    namL[[1]] = c(namL[[1]], nam1Str)
    
    idx1   = matrix(as.numeric(unlist(idx1)), ncol=length(idxInsTb))
    cntIntSum = drop(idx1 %*% idxInsTb)
  }

  idxs <- function(c1){
    v=rep(0,nx)
    v[c1]=1
    v
  }
  
  counts <- function(c1){
    xx = x[,c1,drop=FALSE]
    xnew = drop(xx %*% rep(1, ncol(xx)) )
    length(which(xnew > 0))
  }
  
  for(i in 2:nx){
    comb1 = combn(nx, i)
    if(is.vector(comb1)){
      comb1 = matrix(comb1, ncol=1)
    }
    
    idxL[[i]] = apply(comb1, 2, idxs)
    cntL[[i]] = apply(comb1, 2, counts)
    namL[[i]] = apply(comb1, 2, paste, collapse="-")
  }
  
  if(interSect){
    for(i in 1:length(idxL)){
      idxM = idxL[[i]]
      
      for(j in 1:length(nam1)){
        idxT = apply(idxM[nam1[[j]],,drop=FALSE], 2, sum)
        idxT[idxT > 1] = 1
        idxM = rbind(idxM, idxT)
      }
      idxL[[i]] = idxM
    }
  }
  
  # --------------------------------------------------
  # calculate nominal p-value 
  # --------------------------------------------------
  
  if(is.null(alpha)){
    alpha = 1.0
    
    for(i in 1:nx){
      idxLi = idxL[[i]][1:nx,,drop=FALSE]
      cntLi = cntL[[i]]
      
      for(j in 1:ncol(idxLi)){
        idxLij = which(idxLi[,j] == 1)
        xnew   = x[,idxLij,drop=FALSE]
        xnew   = drop(xnew %*% rep(1, ncol(xnew)))
        xnew[which(xnew > 1)] = 1
        
        m1   = sum(xnew*y)
        pval = phyper(m1-1, ny, n-ny, cntLi[j], lower.tail=FALSE)
        
        if(pval < alpha){ alpha = pval }
      }
    }
  }

  # --------------------------------------------------
  # save the quantiles 
  # --------------------------------------------------
  qntL = list()
  
  for(i in 1:nx){
    cntLi = cntL[[i]]
    lenCi = length(cntLi)
    qnt1  = rep(NA, lenCi)
    
    for(j in 1:lenCi){
      qnt1[j] = qhyper(1 - alpha, ny, n-ny, cntLi[j]) + 1
    }
    
    qntL[[i]] = qnt1
  }
  
  # --------------------------------------------------
  # find the feasible combinations of ks 
  # and count the number of permutations
  # --------------------------------------------------
  
  gall = numeric(0)
  
  xx   = hcube(hs)
  wkp  = rep(FALSE, nrow(xx))
  
  for(i in 1:nx){
    yy   = xx %*% idxL[[i]]
    qnti = qntL[[i]]
    for(j in 1:ncol(yy)){
      wkp = (wkp | yy[,j] >= qnti[j])
    }
  }
  
  Omega = xx[wkp,]
  g1 = logCount(Omega, hs, n, ny)
  
  # --------------------------------------------------
  # finally, calculate permutation p-values
  # --------------------------------------------------
    
  list(p=alpha, perP=exp(g1 - lchoose(n, ny)))
  
}
