R/runFCIPlus.R

Defines functions runFCIPlus

runFCIPlus <- function(X, parentsOf, alpha, setOptions, 
                       directed, verbose, ...){
  
  dots <- list(...)
  if(length(dots) > 0){
    warning("options provided via '...' not taken")
  }
  
  # additional options for FCI
  optionsList <- list("indepTest"=pcalg::gaussCItest,
                      "alpha"=alpha, "labels"=as.character(1:ncol(X)))
  
  # adjust according to setOptions if necessary
  optionsList <- adjustOptions(availableOptions = optionsList, 
                               optionsToSet = setOptions)
  
  suffStat <- list(C = cor(X), n = nrow(X))
  fci.fit <- pcalg::fciPlus(suffStat, 
                         indepTest = optionsList$indepTest, 
                         alpha = alpha,
                         labels=optionsList$labels,
                         p=ncol(X), 
                         verbose= verbose )
  fcimat <- fci.fit@amat
  
  if(directed){ 
    stop("directed currently not implemented for fciplus.")
    warning("Removing undirected edges from estimated connectivity matrix.")
    
    # fcimat <- fcimat * (t(fcimat)==0) #TODO: fix
  }
  
  result <- vector("list", length = length(parentsOf))
  
  for (k in 1:length(parentsOf)){
    result[[k]] <- which(as.logical(fcimat[, parentsOf[k]]))
    attr(result[[k]],"parentsOf") <- parentsOf[k]
  }
  
  if(length(parentsOf) < ncol(X)){
    fcimat <- fcimat[,parentsOf]
  }
  
  list(resList = result, resMat = fcimat)
}

Try the CompareCausalNetworks package in your browser

Any scripts or data that you put into this service are public.

CompareCausalNetworks documentation built on April 14, 2020, 7:31 p.m.