R Under development (unstable) (2024-09-06 r87103 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> 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.")
>
> proc.time()
user system elapsed
1.78 0.25 2.03