tests/test_backdoor.R

In pcalg: Methods for Graphical Models and Causal Inference

library(pcalg)
## (doExtras <- pcalg:::doExtras())

## NB: add tests in addition to the simple ones from Maathuis and Colombo (2013)
## in ../man/backdoor.Rd
##    ~~~~~~~~~~~~~~~~~~

`%w/o%` <- function(x, y) x[!x %in% y] #--  x without y
## slightly faster:
`%w/o%` <- function(x, y) x[!match(x, y, nomatch = 0L)]

###-------- DAG ----------------------
suppressWarnings(RNGversion("3.5.0"))
set.seed(47)
## p <- if(doExtras) 17 else 12
p <- 12
myDAG <- randomDAG(p, prob = 1/4) ## true DAG

## Extract the adjacency matrix of the true DAG
true.amat <- (amat <- as(myDAG, "matrix")) != 0 # TRUE/FALSE <==> 1/0
print.table(1*true.amat, zero.=".") # "visualization"

nodes <- 1:p; names(nodes) <- nodes
cat("Time for many backdoor(.., \"dag\") s : ", system.time(
LL <- lapply(nodes, function(i)
	     lapply(nodes %w/o% i,
		    backdoor,
		    amat = true.amat, x = i, type="dag"))
), "\n")

## if(doExtras) {
##     for(i in nodes[1:3]) ## Nodes 1,2,3 are all "root" nodes:
## 	stopifnot(vapply(LL[[i]], identical, NA, y=integer(0)))

##     str(LL[-(1:3)]) ## Martin: interesting.. Q: is "this" known? A: yes, basically
## } else {
##     str(LL)
## }
str(LL)

###-------- CPDAG --------------------

## estimate the true CPDAG
myCPDAG <- dag2cpdag(myDAG)
## Extract the adjacency matrix of the true CPDAG
CP.amat <- (as(myCPDAG, "matrix") != 0) # 1/0 <==> TRUE/FALSE

cat("Time for many backdoor(.., \"cpdag\") s : ", system.time(
L2 <- lapply(nodes, function(i)
	     lapply(nodes %w/o% i,
		    backdoor,
		    amat = CP.amat, x = i, type="cpdag"))
), "\n")

str(L2)


###-------- PAG ----------------------

## define nodes 2 and 6 to be latent variables
L <- c(2,6)

## compute the true covariance matrix of g
cov.mat <- trueCov(myDAG)
## transform covariance matrix into a correlation matrix
true.corr <- cov2cor(cov.mat)

## find PAG
## as dependence "oracle", we use the true correlation matrix in
## gaussCItest() with a large "virtual sample size" and a large alpha:
true.pag <- dag2pag(suffStat = list(C = true.corr, n = 10^9),
                    indepTest = gaussCItest,
                    graph=myDAG, L=L, alpha = 0.9999)
PAG.amat <- true.pag@amat # {0 1 2 3}

cat("Time for many backdoor(.., \"pag\") s : ", system.time(
L3 <- lapply(nodes, function(i)
	     lapply(nodes %w/o% i,
		    backdoor,
		    amat = PAG.amat, x = i, type="pag"))
), "\n")

str(L3)


###-------- MAG ----------------------


## find a valid MAG such that no additional edges are directed into
(MAG.amat <- pag2magAM(PAG.amat, 4))

cat("Time for many backdoor(.., \"mag\") s : ", system.time(
L4 <- lapply(nodes, function(i)
	     lapply(nodes %w/o% i,
		    backdoor,
		    amat = MAG.amat, x = i, type="mag"))
), "\n")
## actually this is the *fastest* of the cases

str(L4)