R/runCAM.R

Defines functions runCAM

runCAM<- function(X, interventions, parentsOf, setOptions, 
                  verbose, ...){
  
  # additional options for CAM
  optionsList <- list("scoreName"="SEMGAM", "numCores"=1,
                      "variableSel"=FALSE, "variableSelMethod"=CAM::selGamBoost, 
                      "pruning"=FALSE, "pruneMethod"=CAM::selGam)
  
  dots <- list(...)
  if(length(dots) > 0){
    warning("options provided via '...' not taken")
  }
  
  
  # adjust according to setOptions if necessary
  optionsList <- adjustOptions(availableOptions = optionsList, 
                               optionsToSet = setOptions)
  
  if(!is.null(interventions)){
    intervMat <- matrix(FALSE,nrow=nrow(X),ncol=ncol(X))
    for (i in 1:length(interventions)){
      if(length(interventions[[i]])>0) intervMat[i, interventions[[i]]] <- TRUE
    }
    
    cammat <- as(CAM::CAM(X,intervData=TRUE,intervMat=intervMat,
                         scoreName=optionsList$scoreName, 
                         numCores=optionsList$numCores, 
                         output= verbose, 
                         variableSel=optionsList$variableSel, 
                         variableSelMethod= optionsList$variableSelMethod, 
                         pruning = optionsList$pruning, 
                         pruneMethod=optionsList$pruneMethod)$Adj,"matrix")
  }else{
    cammat <- as(CAM::CAM(X, scoreName=optionsList$scoreName, 
                          numCores=optionsList$numCores, 
                          output= verbose, 
                          variableSel=optionsList$variableSel, 
                          variableSelMethod= optionsList$variableSelMethod, 
                          pruning = optionsList$pruning, 
                          pruneMethod=optionsList$pruneMethod)$Adj,"matrix")
  }

  result <- vector("list", length = length(parentsOf))
  
  for (k in 1:length(parentsOf)){
    result[[k]] <- which(cammat[, parentsOf[k]]>0)
    attr(result[[k]],"parentsOf") <- parentsOf[k]
  }
  
  if(length(parentsOf) < ncol(X)){
    cammat <- cammat[,parentsOf]
  }
  
  list(resList = result, resMat = cammat)
}

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.