graphs_chapter.R
In gRbase: A Package for Graphical Modelling in R

## ----include=FALSE--------------------------------------------------------------------------------
library(knitr)
opts_chunk$set(
fig.path='fig/GRAPH', tidy=FALSE
)

## ----echo=F-------------------------------------------------------------------
options("width"=80)
library(igraph)
ps.options(family="serif")

## -----------------------------------------------------------------------------
library(gRbase)
ug0 <- gRbase::ug(~a:b, ~b:c:d, ~e)
ug0 <- gRbase::ug(~a:b + b:c:d + e)
ug0 <- gRbase::ug(~a*b + b*c*d + e)
ug0 <- gRbase::ug(c("a", "b"), c("b", "c", "d"), "e")
ug0

## -----------------------------------------------------------------------------
plot(ug0)

## -----------------------------------------------------------------------------
myplot <- function(x, layout=layout.fruchterman.reingold(x), ...) {
  V(x)$size <- 30
  V(x)$label.cex <- 3
  plot(x, layout=layout, ...)
  return(invisible())
}

## -----------------------------------------------------------------------------
myplot(ug0)

## -----------------------------------------------------------------------------
ug0i <- gRbase::ug(~a:b + b:c:d + e, result="matrix")
ug0i

## -----------------------------------------------------------------------------
as(ug0, "matrix")
as(ug0, "dgCMatrix")
as(ug0i, "igraph")

## ----eval=T-------------------------------------------------------------------
## Using gRbase
ug0a <- gRbase::addEdge("a", "c", ug0)
ug0a <- gRbase::removeEdge("c", "d", ug0)

## -----------------------------------------------------------------------------
## Using igraph
ug0a <- igraph::add_edges(ug0, c("a", "c"))
ug0a <- igraph::delete_edges(ug0, c("c|d"))

## ----eval=T-------------------------------------------------------------------
## Using gRbase
gRbase::nodes(ug0)           
gRbase::edges(ug0) |> str()

## -----------------------------------------------------------------------------
## Using igraph
igraph::V(ug0)
igraph::V(ug0) |> attr("names")
igraph::E(ug0)
igraph::E(ug0) |> attr("vnames")

## -----------------------------------------------------------------------------
gRbase::maxClique(ug0) ## |> str() 
gRbase::get_cliques(ug0) |> str()
## Using igraph
igraph::max_cliques(ug0) |>
    lapply(function(x) attr(x, "names"))  |> str()

## -----------------------------------------------------------------------------
gRbase::separates("a", "d", c("b", "c"), ug0)

## -----------------------------------------------------------------------------
ug1 <- gRbase::subGraph(c("b", "c", "d", "e"), ug0)

## -----------------------------------------------------------------------------
ug12 <- igraph::subgraph(ug0, c("b", "c", "d", "e"))

## -----------------------------------------------------------------------------
par(mfrow=c(1,2), mar=c(0,0,0,0))
myplot(ug1); myplot(ug12)

## -----------------------------------------------------------------------------
gRbase::adj(ug0, "c")
gRbase::closure("c", ug0)

## -----------------------------------------------------------------------------
dag0 <- gRbase::dag(~a, ~b*a,  ~c*a*b, ~d*c*e, ~e*a, ~g*f)
dag0 <- gRbase::dag(~a + b*a + c*a*b + d*c*e + e*a + g*f)
dag0 <- gRbase::dag(~a + b|a + c|a*b + d|c*e + e|a + g|f)
dag0 <- gRbase::dag("a", c("b", "a"), c("c", "a", "b"), c("d", "c", "e"), 
            c("e", "a"), c("g", "f"))
dag0

## ----echo=T-------------------------------------------------------------------
myplot(dag0)

## -----------------------------------------------------------------------------
gRbase::nodes(dag0)
gRbase::edges(dag0) |> str()

## -----------------------------------------------------------------------------
edgeList(dag0) |> str()

## -----------------------------------------------------------------------------
vpardag0 <- gRbase::vpar(dag0)
vpardag0 |> str()
vpardag0$c

## -----------------------------------------------------------------------------
gRbase::parents("d", dag0)
gRbase::children("c", dag0)
gRbase::ancestralSet(c("b", "e"), dag0)
ag <- gRbase::ancestralGraph(c("b", "e"), dag0)
myplot(ag)

## -----------------------------------------------------------------------------
dag0m <- gRbase::moralize(dag0)
myplot(dag0m)

## -----------------------------------------------------------------------------
adjm <- matrix(c(0, 1, 1, 1,
                 1, 0, 0, 1,
                 1, 0, 0, 1,
                 0, 1, 0, 0), byrow=TRUE, nrow=4)
rownames(adjm) <- colnames(adjm) <- letters[1:4]
adjm

## -----------------------------------------------------------------------------
gG1 <- gG2 <- as(adjm, "igraph")
lay <- layout.fruchterman.reingold(gG1)
E(gG2)$arrow.mode <- c(2,0)[1+is.mutual(gG2)]

## -----------------------------------------------------------------------------
par(mfrow=c(1,2), mar=c(0,0,0,0))
myplot(gG1, layout=lay); myplot(gG2, layout=lay)

## -----------------------------------------------------------------------------
d1 <- matrix(0, 11, 11)
d1[1,2] <- d1[2,1] <- d1[1,3] <- d1[3,1] <- d1[2,4] <- d1[4,2] <- 
  d1[5,6] <- d1[6,5] <- 1
d1[9,10] <- d1[10,9] <- d1[7,8] <- d1[8,7] <- d1[3,5] <- 
  d1[5,10] <- d1[4,6] <- d1[4,7] <- 1
d1[6,11] <- d1[7,11] <- 1
rownames(d1) <- colnames(d1) <- letters[1:11]
cG1 <- as(d1, "igraph")
E(cG1)$arrow.mode <- c(2,0)[1+is.mutual(cG1)]
myplot(cG1, layout=layout.fruchterman.reingold)

## -----------------------------------------------------------------------------
myplot(ug0)

## -----------------------------------------------------------------------------
gRbase::separates("a", "d", "b", ug0) 

## -----------------------------------------------------------------------------
gRbase::separates("a", "d", character(0), ug0)

## ----eval=T-------------------------------------------------------------------
d_separates <- function(a, b, c, dag_) {
    ##ag <- ancestralGraph(union(union(a, b), c), dag_)
    ag <- ancestralGraph(c(a, b, c), dag_)
    separates(a, b, c, moralize(ag))
}
d_separates("c", "e", "a", dag0)    

## -----------------------------------------------------------------------------
gRbase::is.simplicial("b", ug0)
gRbase::simplicialNodes(ug0)

## -----------------------------------------------------------------------------
gRbase::connComp(ug0) |> str()
## Using igraph
igraph::components(ug0) |> str()

## ----eval=T-------------------------------------------------------------------
gRbase::is.triangulated(ug0)

## -----------------------------------------------------------------------------
igraph::is_chordal(ug0)

## -----------------------------------------------------------------------------
gRbase::is.decomposition("a", "d", c("b", "c"), ug0) 

## -----------------------------------------------------------------------------
myplot(ug0)

## -----------------------------------------------------------------------------
gRbase::mcs(ug0)

## -----------------------------------------------------------------------------
igraph::max_cardinality(ug0)
igraph::max_cardinality(ug0)$alpham1 |> attr("names")

## -----------------------------------------------------------------------------
gRbase::mcs(ug0, root=c("d", "c", "a"))

## -----------------------------------------------------------------------------
gRbase::rip(ug0)

## -----------------------------------------------------------------------------
ug2 <- gRbase::ug(~a:b:c + c:d + d:e + a:e)
ug2 <- gRbase::ug(~a:b:c + c:d + d:e + e:f + a:f)

gRbase::is.triangulated(ug2)
igraph::is_chordal(ug2)  |> str()
myplot(ug2)

## -----------------------------------------------------------------------------
ug3 <- gRbase::triangulate(ug2)
gRbase::is.triangulated(ug3)

## -----------------------------------------------------------------------------
zzz <- igraph::is_chordal(ug2, fillin=TRUE, newgraph=TRUE)
V(ug2)[zzz$fillin]
ug32 <- zzz$newgraph

## -----------------------------------------------------------------------------
par(mfrow=c(1,3), mar=c(0,0,0,0))
lay <- layout.fruchterman.reingold(ug2) 
myplot(ug2, layout=lay);
myplot(ug3, layout=lay);
myplot(ug32, layout=lay)

## ----eval=F-------------------------------------------------------------------
#  adj(moralize(dag0), "e")

## -----------------------------------------------------------------------------
ug4 <- graph.formula(a -- b:c, c--b:d, e -- a:d) 
ug4
myplot(ug4)

## ----eval=T-------------------------------------------------------------------
ug4.2 <- graph.empty(n=5, directed=FALSE)
V(ug4.2)$name <- V(ug4.2)$label <- letters[1:5]
ug4.2 <- add.edges(ug4.2, 1+c(0,1, 0,2, 0,4, 1,2, 2,3, 3,4))
ug4.2

## ----eval=F-------------------------------------------------------------------
#  myplot(ug4, layout=layout.graphopt)

## -----------------------------------------------------------------------------
ug4$layout   <- layout.graphopt(ug4)
V(ug4)$label <- V(ug4)$name
V(ug4)$color <- "red"
V(ug4)[1]$color <- "green"
V(ug4)$size <- 40
V(ug4)$label.cex <- 3
plot(ug4)

## -----------------------------------------------------------------------------
ug5 <- set.vertex.attribute(ug4, "discrete", value=c(T, T, F, F, T))
V(ug5)[discrete]$color <- "green"
V(ug5)[!discrete]$color <- "red"
plot(ug5)

## ----eval=F-------------------------------------------------------------------
#  xy <- tkplot.getcoords(2)
#  plot(g, layout=xy)

## -----------------------------------------------------------------------------
layout.fruchterman.reingold(ug4)

## -----------------------------------------------------------------------------
ug4$layout <- layout.fruchterman.reingold

## -----------------------------------------------------------------------------
ug4$layout <- layout.fruchterman.reingold(ug4)

## ----samelay, include=T, eval=T-----------------------------------------------
ug5 <- gRbase::ug(~A*B*C + B*C*D + D*E)
ug6 <- gRbase::ug(~A*B + B*C + C*D + D*E) 
lay.fr <- layout.fruchterman.reingold(ug5)
ug6$layout       <- ug5$layout       <- lay.fr
V(ug5)$size      <- V(ug6)$size      <- 50
V(ug5)$label.cex <- V(ug6)$label.cex <- 3
par(mfrow=c(1,2), mar=c(0,0,0,0))
plot(ug5); plot(ug6)

## ----eval=T-------------------------------------------------------------------
em1 <- matrix(c(0, 1, 1, 0,
                0, 0, 0, 1,
                1, 0, 0, 1,
                0, 1, 0, 0), nrow=4, byrow=TRUE)
iG  <- graph.adjacency(em1) 
V(iG)$shape <- c("circle", "square", "circle", "square")  
V(iG)$color <- rep(c("red", "green"), 2)
V(iG)$label <- c("A", "B", "C", "D")
E(iG)$arrow.mode <- c(2,0)[1 + is.mutual(iG)]
E(iG)$color  <- rep(c("blue", "black"), 3)
E(iG)$curved <- c(T, F, F, F, F, F) 
iG$layout    <- layout.graphopt(iG)
myplot(iG)

## -----------------------------------------------------------------------------
args(querygraph)

## ----eval=T-------------------------------------------------------------------
ug_ <- gRbase::ug(~a:b + b:c:d + e)
gRbase::separates("a", "d", c("b", "c"), ug_)                   
gRbase::querygraph(ug_, "separates", "a", "d", c("b", "c"))
gRbase::qgraph(ug_, "separates", "a", "d", c("b", "c"))