.packageName <- "SIN"
holm <- function(pvals){
  p <- dim(pvals)[1]
  pvalsH <- pvals
  temp <- pvals[lower.tri(pvals)]
  oo <- order(temp)
  temp <- temp[oo]
  q <- p*(p-1)/2
  tempHa <- 1-(1-temp)^((q:1)/q)
  tempH <- rep(0,q)
  for(i in 1:q){
    tempH[i] <- max(tempHa[1:i])
  }
  tempH[oo] <-  tempH
  pvalsH[lower.tri(pvalsH)] <- tempH
  pvalsH[upper.tri(pvalsH)] <- t(pvalsH)[upper.tri(pvalsH)]
  return(zapsmall(pvalsH))
}
sinBG <- function(S,n){
  pvals <- simpvalueMx(cov2cor(S), n-3)
  dimnames(pvals) <- dimnames(S)
  return(zapsmall(pvals))
}
plotBGpvalues <- function(pvals, legend=T, legendpos=NULL){
#   vecBGpvalues <- function(pvals){
#     p <- dim(pvals)[1]
#     pvec <- c()
#     for(i in 1:(p-1)){
#       pvec <- c(pvec, pvals[i,(i+1):p])
#     }
#     return(pvec)
#   }
  createBGlabels <- function(pvals){
    p <- dim(pvals)[1]
    labels <- c()
    for(i in 1:(p-1)){
      for(j in (i+1):p){
        labels <- c(labels, paste(i,j, sep="<->"))
      }
    }
    return(labels)
  }
  par(mar=c(6,5,2,6)+0.1)
  BGlab <- createBGlabels(pvals)
  BGpvals <-  pvals[lower.tri(pvals)] #vecBGpvalues(pvals)
  temp <- length(BGlab)
  plot(as.factor(1:temp), BGpvals, type="n",
       ylab="P-value", xlab="", axes=F, ylim=c(0,1), cex.lab=1.2, las=2)
  title(xlab = "Edge", line = 4, cex.lab=1.2)
  axis(1, at=1:temp, labels=BGlab[1:temp], las=2)
  axis(2, at=seq(0,1,by=0.1), las=1)
  temp2 <- sapply(seq(0,1,by=0.1), abline, 0, lty="dotted", col="grey")
  plot(as.factor(1:temp), BGpvals, add=T, axes=F)
  box()
  p <- dim(pvals)[1]
  plotlabels <- as.character(1:p)
  for(i in 1:p){
    plotlabels[i] <- paste(plotlabels[i],dimnames(pvals)[[1]][i], sep="  ")
  }
  if(legend==T){
    if(is.null(legendpos)){
      legend(temp+0.6,1, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
    else{
      x <- legendpos[1]
      y <- legendpos[2]
      legend(x,y, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
  }
}
sinCG <- function(blocks, S, n, type="AMP"){
  if(!is.blocks(blocks, dim(S)[1])){
    return("blocks is not a valid block structure over the variables!")
  }
  ## blocks is now a list of vectors 
  sinAMP <- function(blocks, S, n){
    complete.order <- unlist(blocks)
    S <- S[complete.order,complete.order]
    p <- dim(S)[1]
    q <- length(blocks)
    pvals <- diag(rep(1,p))
    labels <- dimnames(S)[[1]]
    dimnames(pvals) <- list(labels, labels)
    ## Do block 1 explicitly (since no parents)
    b <- cumsum(unlist(lapply(blocks, length)))
    corr.part <- -cov2cor(solve(S[1:b[1],1:b[1]]))
    pvals[1:b[1],1:b[1]] <- simpvalueMx(corr.part,n-b[1]-1)
    ## Loop thru blocks 2 to q
    if(q==1){
      return(zapsmall(pvals))
    }
    else{
      for(i in 2:q){
        ## within block i
        corr.part <- -cov2cor(solve(S[1:b[i],1:b[i]]))
        pvals[(b[i-1]+1):b[i],(b[i-1]+1):b[i]] <-
          simpvalueMx(corr.part[(b[i-1]+1):b[i],(b[i-1]+1):b[i]],n-b[i]-1)
        ## block i to strict past
        for(w in (b[i-1]+1):b[i]){
          corr.part <- -cov2cor(solve(S[c(1:b[i-1], w),c(1:b[i-1], w)]))
          pvals[1:b[i-1],w] <-
            pvals[w,1:b[i-1]] <-
              simpvalueVec(corr.part[1:b[i-1],b[i-1]+1],
                           n-(b[i-1]+1)-1,b[i-1]+1)
        }
      }
      return(zapsmall(pvals))
    }
  }
  ## blocks is now a list of vectors 
  sinLWF <- function(blocks, S, n){
    complete.order <- unlist(blocks)
    S <- S[complete.order,complete.order]
    p <- dim(S)[1]
    q <- length(blocks)
    pvals <- diag(rep(1,p))
    labels <- dimnames(S)[[1]]
    dimnames(pvals) <- list(labels, labels)
    ## Do block 1 explicitly (since no parents)
    b <- cumsum(unlist(lapply(blocks, length)))
    corr.part <- -cov2cor(solve(S[1:b[1],1:b[1]]))
    pvals[1:b[1],1:b[1]] <- simpvalueMx(corr.part,n-b[1]-1)
    ## Loop thru blocks 2 to q
    if(q==1){
      return(zapsmall(pvals))
    }
    else{
      for(i in 2:q){
        ## block i vs past i
        corr.part <- -cov2cor(solve(S[1:b[i],1:b[i]]))
        pvals[(b[i-1]+1):b[i],1:b[i]] <-
          simpvalueMx(corr.part,n-b[i]-1)[(b[i-1]+1):b[i],1:b[i]]
        pvals[1:b[i],(b[i-1]+1):b[i]] <- t(pvals[(b[i-1]+1):b[i],1:b[i]])
      }
      return(zapsmall(pvals))
    }
  }
  ## Call one of the above functions now
  if(type=="AMP"){
    return(sinAMP(blocks,S,n))
  }
  else{
    if(type=="LWF"){
      return(sinLWF(blocks,S,n))
    }
    else{
      print("type must be AMP or LWF (as string)!")
    }
  }
}

 
plotCGpvalues <- function(blocks, pvals, legend=T, legendpos=NULL){
  if(!is.blocks(blocks, dim(pvals)[1])){
    return("blocks is not a valid block structure over the variables!")
  }
  ## two functions to order p-values and create labels
  vecCGpvalues <- function(blocks, pvals){
    p <- dim(pvals)[1]
    q <- length(blocks)
    b <- cumsum(unlist(lapply(blocks, length)))
    pvec <- c()
    ## Block 1 first
    if(b[1]>=2){
      for(j in 1:(b[1]-1)){
        pvec <- c(pvec, pvals[j,(j+1):b[1]])
      }
    }
    ## Blocks 2 trhu q
    for(i in 2:q){
      ## directed edges 
      for(j in (b[i-1]+1):b[i]){
        for(k in 1:b[i-1]){
          pvec <- c(pvec, pvals[k,j])
        }
      }
      ## undirected edges in Block i
      if(b[i]-b[i-1]>=2){
        for(j in (b[i-1]+1):(b[i]-1)){
          pvec <- c(pvec, pvals[j,(j+1):b[i]])
        }
      }
    }
    return(pvec)
  }
  
  createCGlabels <- function(blocks, pvals){
    p <- dim(pvals)[1]
    q <- length(blocks)
    b <- cumsum(unlist(lapply(blocks, length)))
    labels <- c()
    ## Block 1 first
    if(b[1]>=2){
      for(j in 1:(b[1]-1)){
        for(k in (j+1):b[1]){
          labels <-
            c(labels,
              paste(letters[1],j,"-",letters[1],k, sep=""))
        }
      }
    }
    ## Blocks 2 trhu q
    for(i in 2:q){
      ## directed edges 
      for(j in (b[i-1]+1):b[i]){
        for(l in 1:b[1]){
          labels <-
            c(labels,
              paste(letters[1],l,"->",letters[i],j-b[i-1], sep=""))
        }
        if(i >=3){
          for(k in 2:(i-1)){
            for(l in (b[k-1]+1):b[k]){
              labels <-
                c(labels,
                  paste(letters[k],l-b[k-1],"->",letters[i],j-b[i-1], sep=""))
            }
          }
        }
      }
      ## undirected edges in Block i
      if(b[i]-b[i-1]>=2){
        for(j in (b[i-1]+1):(b[i]-1)){
          for(k in (j+1):b[i]){
            labels <-
              c(labels,
                paste(letters[i],j-b[i-1],"-",letters[i],k-b[i-1], sep=""))
          }
        }
      }
    }
    return(labels)
  }
  ## actual plotting 
  par(mar=c(7,5,2,2)+0.1)
  CGlab <- createCGlabels(blocks, pvals)
  CGpvals <- vecCGpvalues(blocks, pvals)
  temp <- length(CGlab)
  plot(as.factor(1:temp), CGpvals, type="n",
       ylab="P-value", xlab="", axes=FALSE, ylim=c(0,1), cex.lab=1.2, las=2)
  title(xlab = "Edge", line = 5, cex.lab=1.2)
  axis(1, at=1:temp, labels=CGlab[1:temp], las=2)
  axis(2, at=seq(0,1,by=0.1), las=1)
  temp2 <- sapply(seq(0,1,by=0.1), abline, 0, lty="dotted", col="grey")
  plot(as.factor(1:temp), CGpvals, axes=FALSE, add=T) 
  box()
  plotlabels <- c()
  for(i in 1:length(blocks)){
    for(j in 1:length(blocks[[i]])){
      plotlabels <- c(plotlabels, paste(letters[i],j,sep="" ))
    }
  }
  for(i in 1:length(plotlabels)){
    plotlabels[i] <- paste(plotlabels[i],dimnames(pvals)[[1]][i], sep="  ")
  }
  if(legend==T){
    if(is.null(legendpos)){
      legend(temp+0.6,1, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
    else{
      x <- legendpos[1]
      y <- legendpos[2]
      legend(x,y,  x.intersp=-0.3,
             plotlabels, bg="white", xjust=1, yjust=1)
    }
  }
}
## order has to be a list, e.g. as.list(1:p)
sinDAG <- function(order, S, n){
  order <- unlist(order)
  S <- S[order,order]
  p <- dim(S)[1]
  pvals <- diag(rep(1,p))
  labels <- dimnames(S)[[1]]
  dimnames(pvals) <- list(labels, labels)
  for(i in 2:p){
    corr.part <- -cov2cor(solve(S[1:i,1:i]))
    pvals[i,1:(i-1)] <- pvals[1:(i-1),i] <-
      simpvalueVec(c(corr.part[i,1:(i-1)]),n-i-1,i)
  }
  for(i in 1:p) pvals[i,i] <- NA
  return(zapsmall(pvals))
}
plotDAGpvalues <- function(pvals, legend=T, legendpos=NULL){
#   vecDAGpvalues <- function(pvals){
#     p <- dim(pvals)[1]
#     pvec <- c()
#     for(i in 2:p){
#       pvec <- c(pvec, pvals[1:(i-1),i])
#     }
#     return(pvec)
#   }
  createDAGlabels <- function(pvals){
    p <- dim(pvals)[1]
    labels <- c()
    for(i in 2:p){
      for(j in 1:(i-1)){
        labels <- c(labels, paste(j,i, sep="->"))
      }
    }
    return(labels)
  }
  par(mar=c(6,5,2,2)+0.1)
  DAGlab <- createDAGlabels(pvals)
  DAGpvals <- pvals[upper.tri(pvals)] #vecDAGpvalues(pvals)
  temp <- length(DAGlab)
  plot(as.factor(1:temp), DAGpvals, type="n",
       ylab="P-value", xlab="", axes=F, ylim=c(0,1), cex.lab=1.2, las=2)
  title(xlab = "Edge", line = 4, cex.lab=1.2)
  axis(1, at=1:temp, labels=DAGlab[1:temp], las=2)
  axis(2, at=seq(0,1,by=0.1), las=1)
  temp2 <- sapply(seq(0,1,by=0.1), abline, 0, lty="dotted", col="grey")
  plot(as.factor(1:temp), DAGpvals, add=T, axes=F)
  box()
  p <- dim(pvals)[1]
  plotlabels <- as.character(1:p)
  for(i in 1:p){
    plotlabels[i] <- paste(plotlabels[i],dimnames(pvals)[[1]][i], sep="  ")
  }
  if(legend==T){
    if(is.null(legendpos)){
      legend(temp+0.6,1, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
    else{
      x <- legendpos[1]
      y <- legendpos[2]
      legend(x,y, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
  }
}
sinUG <- function(S,n){
  p <- dim(S)[1]
  pvals <- simpvalueMx(-cov2cor(solve(S)), n-p-1)
  dimnames(pvals) <- dimnames(S)
  return(zapsmall(pvals))
}
plotUGpvalues <- function(pvals, legend=T, legendpos=NULL){
#   vecUGpvalues <- function(pvals){
#     p <- dim(pvals)[1]
#     pvec <- c()
#     for(i in 1:(p-1)){
#       pvec <- c(pvec, pvals[i,(i+1):p])
#     }
#     return(pvec)
#   }
  createUGlabels <- function(pvals){
    p <- dim(pvals)[1]
    labels <- c()
    for(i in 1:(p-1)){
      for(j in (i+1):p){
        labels <- c(labels, paste(i,j, sep="-"))
      }
    }
    return(labels)
  }
  par(mar=c(6,5,2,6)+0.1)
  UGlab <- createUGlabels(pvals)
  UGpvals <- pvals[lower.tri(pvals)] #vecUGpvalues(pvals)
  temp <- length(UGlab)
  plot(as.factor(1:temp), UGpvals, type="n",
       ylab="P-value", xlab="", axes=F, ylim=c(0,1), cex.lab=1.2, las=2)
  title(xlab = "Edge", line = 4, cex.lab=1.2)
  axis(1, at=1:temp, labels=UGlab[1:temp], las=2)
  axis(2, at=seq(0,1,by=0.1), las=1)
  temp2 <- sapply(seq(0,1,by=0.1), abline, 0, lty="dotted", col="grey")
  plot(as.factor(1:temp), UGpvals, add=T, axes=F)
  box()
  p <- dim(pvals)[1]
  plotlabels <- as.character(1:p)
  for(i in 1:p){
    plotlabels[i] <- paste(plotlabels[i],dimnames(pvals)[[1]][i], sep="  ")
  }
  if(legend==T){
    if(is.null(legendpos)){
      legend(temp+0.6,1, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
    else{
      x <- legendpos[1]
      y <- legendpos[2]
      legend(x,y, x.intersp=-0.3, 
             plotlabels, bg="white", xjust=1, yjust=1)
    }
  }
}
#### HELP FUNCTIONS ##############
fisherz <- function(corrs){
  if(any(is.na(corrs))){
    return(NA)
  }
  if( (max(corrs)>1) || (min(corrs)< -1)){
    return("Argument is not a vector of correlations!")
  }
  else{
    return(0.5*log((1+corrs)/(1-corrs)))
  }
}
sdcor2cov <- function(stddev, corr){
    p <- (d <- dim(corr))[1]
    if (!is.numeric(corr) || length(d) != 2 || p != d[2]) 
        stop("`corr' is not a square numeric matrix")
    
    if (!is.numeric(stddev) || length(stddev) != d[2]) 
        stop("`stddev' and `corr' are not compatible")
    if (any(!is.finite(stddev))) 
        warning("stddev has non-finite entries")
    r <- corr
    r[] <- stddev * corr * rep(stddev, each = p)
    r
}
simpvalueVec <- function(corrs,n,p){
    temp <- sapply(corrs,fisherz)
    temp <- sapply(temp, abs)
    temp <- temp*sqrt(n)
    temp <- sapply(temp, pnorm)
    temp <- 1- ( 2*temp -1 )^(p*(p-1)/2)
    return(temp)
}
simpvalueMx <- function(corr,n){
  if(is.matrix(corr)){
    p <- dim(corr)[1]
  }
  else{
    p <- 1
  }
  if(p==1){
    return(matrix(NA, 1,1))
  }
  else{
    temp <- simpvalueVec(c(corr),n,p)
    temp <- matrix(temp, p,p)
    diag(temp) <- NA
    return(temp)
  }
}
is.blocks <- function(blocks, p){
  if(!is.list(blocks)){
    return(FALSE)
  }
  if(!(all.equal(sort(unlist(blocks)), 1:p)==TRUE)){
    return(FALSE)
  }
  return(TRUE)
}
getgraph <- function(pvals, alpha, type="UG", blocks=NULL){
  getUG <- function(pvals, alpha){
    UG <- pvals
    diag(UG) <- 1
    UG <- matrix(as.numeric(UG <= alpha), ncol=dim(pvals)[1])
    dimnames(UG) <- dimnames(pvals)
    return(UG)
  }
  getDAG <- function(pvals, alpha){
    DAG <- getUG(pvals, alpha)
    DAG[lower.tri(DAG)] <- 0
    return(DAG)
  }
  getCG <- function(blocks, pvals, alpha){
    CG <- UG <- getUG(pvals,alpha)
    CG[lower.tri(CG)] <- 0
    for(i in 1:length(blocks)){
      CG[blocks[[i]],blocks[[i]]] <-
        UG[blocks[[i]],blocks[[i]]]
    }
    return(CG)
  }
  getBG <- function(pvals,alpha){
    return(2*getUG(pvals,alpha))
  }
  if( (!is.numeric(pvals)) || (!is.matrix(pvals)) ){
    return("pvals is not a matrix of p-values!")
  }
  if( (max(pvals[!is.na(pvals)])>1) ||
      (min(pvals[!is.na(pvals)])<0) ){
    return("pvals is not a matrix of p-values!")
  }
  if(!is.numeric(alpha)){
    return("alpha is not a significance level!")
  }
  if( (alpha<0) || (alpha>1) ){
    return("alpha is not a significance level!")
  }
  if(type=="CG"){
    if(!is.blocks(blocks, dim(pvals)[1])){
      return("blocks is not a valid block structure over the variables!")
    }
    return(getCG(blocks, pvals, alpha))
  }
  else{
    functioncall <- call(paste("get",type, sep=""), pvals, alpha)
    return(eval(functioncall))
  }
}
#### END FUNCTIONS ###########


