tests/test_gac.R

In pcalg: Methods for Graphical Models and Causal Inference

library(pcalg)

xx <- TRUE
##################################################
## DAG / CPDAG
##################################################
## CPDAG 1: Paper Fig 1
mFig1 <- matrix(c(0,1,1,0,0,0, 1,0,1,1,1,0, 0,0,0,0,0,1,
                  0,1,1,0,1,1, 0,1,0,1,0,1, 0,0,0,0,0,0), 6,6)
type <- "cpdag"
x <- 3; y <- 6
## FIXME: test more than just $gac
## Ver.1: Let gac() return an S3 class, say "GACfit" or "gacFit", with a print() method
##        and (auto)print(.) everywhere below, save *.Rout.save -> output compared: Is ok, as all "discrete"

xx <- xx &  gac(mFig1,x,y, z=c(2,4), type)$gac
xx <- xx &  gac(mFig1,x,y, z=c(4,5), type)$gac
xx <- xx &  gac(mFig1,x,y, z=c(4,2,1), type)$gac
xx <- xx &  gac(mFig1,x,y, z=c(4,5,1), type)$gac
xx <- xx &  gac(mFig1,x,y, z=c(4,2,5), type)$gac
xx <- xx &  gac(mFig1,x,y, z=c(4,2,5,1), type)$gac
xx <- xx & !gac(mFig1,x,y, z= 2,    type)$gac
xx <- xx & !gac(mFig1,x,y, z= NULL, type)$gac

## CPDAG 2: Paper Fig 5a
mFig5a <- matrix(c(0,1,0,0,0, 1,0,1,0,0, 0,0,0,0,1, 0,0,1,0,0, 0,0,0,0,0), 5,5)
type <- "cpdag"
x <- c(1,5); y <- 4
xx <- xx &  gac(mFig5a, x,y, z=c(2,3), type)$gac
xx <- xx & !gac(mFig5a, x,y, z= 2,     type)$gac

## DAG 1 from Marloes' Talk
mMMd1 <- matrix(c(0,1,0,1,0,0, 0,0,1,0,1,0, 0,0,0,0,0,1,
                  0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0),6,6)
type <- "dag"
x <- 1; y <- 3
xx <- xx &  gac(mMMd1, x,y, z=NULL, type)$gac
xx <- xx & !gac(mMMd1, x,y, z= 2, type)$gac
xx <- xx &  gac(mMMd1, x,y, z= 4, type)$gac
xx <- xx & !gac(mMMd1, x,y, z= 5, type)$gac
xx <- xx & !gac(mMMd1, x,y, z= 6, type)$gac
xx <- xx & !gac(mMMd1, x,y, z=c(4,5), type)$gac

## DAG 2 from Marloes' Talk
mMMd2 <- matrix(c(0,1,0,1,0,0, 0,0,0,0,0,0, 0,1,0,0,1,0,
                  0,0,0,0,1,0, 0,0,0,0,0,1, 0,0,0,0,0,0), 6,6)
type <- "dag"
x <- 4; y <- 6
xx <- xx &  gac(mMMd2, x,y, z= 1, type)$gac
xx <- xx &  gac(mMMd2, x,y, z= 3, type)$gac
xx <- xx & !gac(mMMd2, x,y, z= 5, type)$gac
xx <- xx & !gac(mMMd2, x,y, z=c(1,5), type)$gac
xx <- xx &  gac(mMMd2, x,y, z=c(1,2), type)$gac
xx <- xx &  gac(mMMd2, x,y, z=c(1,3), type)$gac
xx <- xx & !gac(mMMd2, x,y, z= 2, type)$gac

##################################################
## PAG
##################################################
mFig3a <- matrix(c(0,1,0,0, 1,0,1,1, 0,1,0,1, 0,1,1,0), 4,4)
mFig3b <- matrix(c(0,2,0,0, 3,0,3,3, 0,2,0,3, 0,2,2,0), 4,4)
mFig3c <- matrix(c(0,3,0,0, 2,0,3,3, 0,2,0,3, 0,2,2,0), 4,4)
mFig4a <- matrix(c(0,0,1,0,0,0, 0,0,1,0,0,0, 2,2,0,3,3,2,
                   0,0,2,0,2,2, 0,0,2,1,0,2, 0,0,1,3,3,0), 6,6)
mFig4b <- matrix(c(0,0,1,0,0,0, 0,0,1,0,0,0, 2,2,0,0,3,2,
                   0,0,0,0,2,2, 0,0,2,3,0,2, 0,0,2,3,2,0), 6,6)
mFig5b <- matrix(c(0,1,0,0,0,0,0, 2,0,2,3,0,3,0, 0,1,0,0,0,0,0, 0,2,0,0,3,0,0,
                   0,0,0,2,0,2,3, 0,2,0,0,2,0,0, 0,0,0,0,2,0,0), 7,7)
type <- "pag"
xx <- xx & !gac(mFig3a, x=2,      y=4, z=NULL,   type)$gac
xx <- xx & !gac(mFig3b, x=2,      y=4, z=NULL,   type)$gac
xx <- xx &  gac(mFig3c, x=2,      y=4, z=NULL,   type)$gac
xx <- xx & !gac(mFig4a, x=3,      y=4, z=NULL,   type)$gac
xx <- xx &  gac(mFig4a, x=3,      y=4, z= 6,     type)$gac
xx <- xx &  gac(mFig4a, x=3,      y=4, z=c(1,6), type)$gac
xx <- xx &  gac(mFig4a, x=3,      y=4, z=c(2,6), type)$gac
xx <- xx &  gac(mFig4a, x=3,      y=4, z=c(1,2,6), type)$gac
xx <- xx & !gac(mFig4b, x=3,      y=4, z=NULL,   type)$gac
xx <- xx & !gac(mFig4b, x=3,      y=4, z= 6,     type)$gac
xx <- xx & !gac(mFig4b, x=3,      y=4, z=c(5,6), type)$gac
xx <- xx & !gac(mFig5b, x=c(2,7), y=6, z=NULL,   type)$gac
xx <- xx &  gac(mFig5b, x=c(2,7), y=6, z=c(4,5), type)$gac
xx <- xx &  gac(mFig5b, x=c(2,7), y=6, z=c(4,5,1), type)$gac
xx <- xx &  gac(mFig5b, x=c(2,7), y=6, z=c(4,5,3), type)$gac
xx <- xx &  gac(mFig5b, x=c(2,7), y=6, z=c(1,3,4,5), type)$gac

## PAG in Marloes' talk
mMMp <- matrix(c(0,0,0,3,2,0,0, 0,0,0,0,1,0,0, 0,0,0,0,1,0,0, 2,0,0,0,0,3,2,
                 3,2,2,0,0,0,3, 0,0,0,2,0,0,0, 0,0,0,2,2,0,0), 7,7)
x <- c(5,6); y <- 7
xx <- xx & !gac(mMMp, x,y, z=NULL, type)$gac
xx <- xx & !gac(mMMp, x,y, z= 1,   type)$gac
xx <- xx & !gac(mMMp, x,y, z= 4,   type)$gac
xx <- xx & !gac(mMMp, x,y, z= 2,   type)$gac
xx <- xx & !gac(mMMp, x,y, z= 3,   type)$gac
xx <- xx & !gac(mMMp, x,y, z=c(2,3), type)$gac
xx <- xx &  gac(mMMp, x,y, z=c(1,4), type)$gac
xx <- xx &  gac(mMMp, x,y, z=c(1,4,2), type)$gac
xx <- xx &  gac(mMMp, x,y, z=c(1,4,3), type)$gac
xx <- xx &  gac(mMMp, x,y, z=c(1,4,2,3), type)$gac

##################################################
## type = "pag" -- Tests from Ema
##################################################
type <- "pag"
pag.m <- readRDS(system.file("external/gac-pags.rds", package="pcalg"))
m1 <- pag.m[["m1"]]
x <- 6; y <- 9
xx <- xx & !gac(m1,x,y, z=NULL, type)$gac
xx <- xx & !gac(m1,x,y, z=1, type)$gac
xx <- xx & !gac(m1,x,y, z=2, type)$gac
xx <- xx & !gac(m1,x,y, z=3, type)$gac
xx <- xx & !gac(m1,x,y, z=4, type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,3), type)$gac
xx <- xx &  gac(m1,x,y, z=c(2,3,8), type)$gac
xx <- xx &  gac(m1,x,y, z=c(2,3,7,8), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,3,5,8), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,3,5,7,8), type)$gac

x <- c(6,8); y <- 9
xx <- xx & !gac(m1,x,y, z=NULL, type)$gac
xx <- xx & !gac(m1,x,y, z=1, type)$gac
xx <- xx & !gac(m1,x,y, z=2, type)$gac
xx <- xx & !gac(m1,x,y, z=3, type)$gac
xx <- xx & !gac(m1,x,y, z=4, type)$gac
xx <- xx &  gac(m1,x,y, z=c(2,3), type)$gac
xx <- xx &  gac(m1,x,y, z=c(2,3,4), type)$gac
xx <- xx &  gac(m1,x,y, z=c(2,3,7), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,3,5), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,3,5,7), type)$gac

x <- 3; y <- 1
xx <- xx & !gac(m1,x,y, z=NULL, type)$gac
xx <- xx & !gac(m1,x,y, z=2, type)$gac
xx <- xx & !gac(m1,x,y, z=4, type)$gac
xx <- xx & !gac(m1,x,y, z=5, type)$gac
xx <- xx & !gac(m1,x,y, z=6, type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,6), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,8), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,7,8), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,5,8), type)$gac
xx <- xx & !gac(m1,x,y, z=c(2,5,7,8), type)$gac

m2 <- pag.m[["m2"]]
x <- 3; y <-1
xx <- xx & !gac(m2,x,y, z=NULL, type)$gac
xx <- xx &  gac(m2,x,y, z=2, type)$gac
xx <- xx & !gac(m2,x,y, z=4, type)$gac
xx <- xx & !gac(m2,x,y, z=c(2,8), type)$gac
xx <- xx & !gac(m2,x,y, z=8, type)$gac
xx <- xx & !gac(m2,x,y, z=9, type)$gac
xx <- xx & !gac(m2,x,y, z=c(2,8,9), type)$gac
xx <- xx &  gac(m2,x,y, z=c(2,5), type)$gac

x <- c(3,9); y <- 1
xx <- xx & !gac(m2,x,y, z=NULL, type)$gac
xx <- xx & !gac(m2,x,y, z=2, type)$gac
xx <- xx & !gac(m2,x,y, z=4, type)$gac
xx <- xx & !gac(m2,x,y, z=c(2,8), type)$gac
xx <- xx & !gac(m2,x,y, z=8, type)$gac
xx <- xx & !gac(m2,x,y, z=9, type)$gac
xx <- xx & !gac(m2,x,y, z=c(2,8,9), type)$gac
xx <- xx & !gac(m2,x,y, z=c(2,5), type)$gac

m3 <- pag.m[["m3"]]
x <- 1; y <- 9
xx <- xx & !gac(m3,x,y, z=NULL, type)$gac
xx <- xx & !gac(m3,x,y, z=2, type)$gac
xx <- xx & !gac(m3,x,y, z=3, type)$gac
xx <- xx & !gac(m3,x,y, z=5, type)$gac
xx <- xx & !gac(m3,x,y, z=7, type)$gac
xx <- xx & !gac(m3,x,y, z=8, type)$gac
xx <- xx &  gac(m3,x,y, z=c(2,3), type)$gac
xx <- xx &  gac(m3,x,y, z=c(5,7), type)$gac

x <- 1; y <- 8
xx <- xx & !gac(m3,x,y, z=NULL, type)$gac
xx <- xx & !gac(m3,x,y, z=2, type)$gac
xx <- xx & !gac(m3,x,y, z=3, type)$gac
xx <- xx & !gac(m3,x,y, z=5, type)$gac
xx <- xx &  gac(m3,x,y, z=7, type)$gac
xx <- xx & !gac(m3,x,y, z=9, type)$gac
xx <- xx &  gac(m3,x,y, z=c(2,3), type)$gac
xx <- xx & !gac(m3,x,y, z=c(5,9), type)$gac

if (!xx) stop("Problem when testing function gac.")