inst/doc/PairVizIntroduction.R

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----eval=FALSE---------------------------------------------------------------
#  install.packages("PairViz")

## ----eval=FALSE---------------------------------------------------------------
#  if (!requireNamespace("graph", quietly = TRUE)){
#      install.packages("BiocManager")
#      BiocManager::install("graph")
#  }

## -----------------------------------------------------------------------------
requireNamespace("igraph")
if (!requireNamespace("igraph", quietly = TRUE)){
    install.packages("igraph")
}


igplot <- function(g,weights=FALSE,layout=igraph::layout_in_circle, 
                   vertex.size=60, vertex.color="lightblue",...){
    g <- igraph::graph_from_graphnel(as(g, "graphNEL"))
    op <- par(mar=c(1,1,1,1))
    if (weights){
      ew <- round(igraph::get.edge.attribute(g,"weight"),3)  
      igraph::plot.igraph(g,layout=layout,edge.label=ew,vertex.size=vertex.size,vertex.color=vertex.color,...)
    }
    else
    igraph::plot.igraph(g,layout=layout,vertex.size=vertex.size,vertex.color=vertex.color,...)
    par(op)
}

## ----eval=FALSE---------------------------------------------------------------
#  
#  if (!requireNamespace("Rgraphviz", quietly = TRUE)){
#      install.packages("BiocManager")
#      BiocManager::install("Rgraphviz")
#  }
#  
#  # For a graph g use
#  plot(g)

## ----fig.show='hold'----------------------------------------------------------
suppressPackageStartupMessages(library(PairViz))
k4 <- mk_complete_graph(4)
k5 <- mk_complete_graph(5)
igplot(k4)
igplot(k5)

## -----------------------------------------------------------------------------
eulerian(k5)

## ----fig.show='hold', fig.align='center'--------------------------------------
k5a <- removeEdge("1", "2", k5)
igplot(k5a)
eulerian(k5a)

## -----------------------------------------------------------------------------
eulerian(k4)

## -----------------------------------------------------------------------------
n <- LETTERS[1:5]
g <- new("graphNEL",nodes=n)
efrom <- n[c(1,1,2,2,2,4)]
eto <- n[c(2:3,3:5,5)]
ew <- c(8,9,5:7,1)
g <- addEdge(efrom, eto, g, ew) 

## ----fig.align="center"-------------------------------------------------------
igplot(g, weights=TRUE,edge.label.color="black")

## -----------------------------------------------------------------------------
eulerian(g)

## -----------------------------------------------------------------------------
eulerian(g, weighted=FALSE)

## ----fig.show='hold'----------------------------------------------------------
ew <- rep(1, length(edgeNames(k5)))
s1 <- c(1,5,9,10)
ew[s1]<- 5
ec <- rep("grey40", length(ew))
ec[s1]<- "cyan"
igplot(k5, edge.width=ew, edge.color=ec)

ew[]<- 1
s2 <- c(2,6:8)
ew[s2]<- 5
ec[] <- "grey40"
ec[s2]<- "magenta"
igplot(k5, edge.width=ew, edge.color=ec)

## ----fig.align='center'-------------------------------------------------------
ew[]<- 5
ec[s1]<- "cyan"
s3 <- 3:4
ec[s3]<- "rosybrown1"
igplot(k5, edge.width=ew, edge.color=ec)
igplot(k5, edge.width=ew, edge.color=ec)

## -----------------------------------------------------------------------------
hpaths(5)

## -----------------------------------------------------------------------------
hpaths(5, matrix=FALSE)

## -----------------------------------------------------------------------------
hpaths(6)
hpaths(6, matrix=FALSE)

## -----------------------------------------------------------------------------
hpaths(1:5)

## -----------------------------------------------------------------------------
set.seed(123)
k7 <- mk_complete_graph(7)
ew <- sample(numEdges(k7),numEdges(k7)) # a vector of edgeweights

## -----------------------------------------------------------------------------
d7 <- matrix(0,7,7)
d7[lower.tri(d7)] <- ew
d7[upper.tri(d7)]<-  t(d7)[upper.tri(d7)]
d7 
# or using the shortcut function edge2dist from PairViz
#d7 <- as.matrix(edge2dist(ew))

## ----fig.align="center",fig.width=6, fig.height=6-----------------------------
k7 <- mk_complete_graph(d7)
igplot(k7, weights=TRUE,edge.label.color="black", vertex.label.cex=2,vertex.size=30)

# Unfortunately, plot.igraph does not show graph edge weights  automatically, you have to 
# input them as above. You might want to check that the igraph
# matches that of ew.
igraph::E(igraph::graph_from_graphnel(k7))


## -----------------------------------------------------------------------------
weighted_hpaths(d7)
# this version returns the eulerian
weighted_hpaths(d7, matrix=FALSE)

## -----------------------------------------------------------------------------
o <- weighted_hpaths(d7, matrix=FALSE)
o1 <- o[1:8] # include the 8th to form the tour
d7e <- dist2edge(d7) 
# d7e is a vector giving edge weights in order (1,1)... (1,7), (2,3),.. (2,7) etc
h1weights <- path_weights(d7e, o1) # the edge weights for o1
# the same as
d7[cbind(head(o1,-1), o1[-1])]

h1weights
sum(h1weights)

## -----------------------------------------------------------------------------
o2 <- o[8:15]
sum(path_weights(d7e, o2))
o3 <- o[15:22]
sum(path_weights(d7e, o3))

## -----------------------------------------------------------------------------
order_best(d7,cycle=TRUE)
order_tsp(d7,cycle=TRUE)

## -----------------------------------------------------------------------------
e1 <- eseq(7)
e2 <- eseqa(7)
e3 <- eulerian(7) # same path as eulerian(k7, weighted=FALSE)
h1 <- hpaths(7, matrix=FALSE)

## ----fig.width=7, fig.height=6, echo=FALSE------------------------------------
par(mfrow=c(2,2))
par(mar=c(2,2,3,1))

plot(e1, type="n",main="eseq(7)")
lines(e1[1:4], col="tan1", lwd=1.5)
lines(4:11,e1[4:11], col="cyan", lwd=1.5)
lines(11:22,e1[11:22], col="magenta", lwd=1.5)

points(e1, pch=20); grid()

plot(e2, type="n",main="eseqa(7)")
e2x <- rep(NA, length(e2))
gap1 <- seq(1, length(e2), by=3)
gap1 <- sort(c(gap1, gap1+1))

e2x[gap1]<- e2[gap1]
lines(e2x, col="tan1", lwd=1.5)

e2x <- rep(NA, length(e2))
gap2 <- gap1+1
e2x[gap2]<- e2[gap2]
lines(e2x, col="cyan", lwd=1.5)

e3x <- rep(NA, length(e2))
gap3 <- gap2+1
e3x[gap3]<- e2[gap3]
lines(e3x, col="magenta", lwd=1.5)
points(e2, pch=20);grid()


plot(e3, type="n", main="eulerian(7)")


e3x <- rep(NA, length(e3))
#indy <- which(head(e3,-1) <= 1 | e3[-1] <= 1)
indy <- which(pmin(head(e3,-1), e3[-1]) <= 1)
e3x[indy] <- e3[indy]
e3x[indy+1] <- e3[indy+1]
lines(e3x, col="tan1", lwd=1.5)


e3x <- rep(NA, length(e3))
#indy <- which(head(e3,-1) %in% c(2,3) | e3[-1] %in% c(2,3))
indy <- which(pmin(head(e3,-1), e3[-1]) %in% c(2,3))

e3x[indy] <- e3[indy]
e3x[indy+1] <- e3[indy+1]
lines(e3x, col="cyan", lwd=1.5)



e3x <- rep(NA, length(e3))
#indy <- which(head(e3,-1) >=4 & e3[-1] >=4)
indy <- which(pmin(head(e3,-1), e3[-1]) >=4)
e3x[indy] <- e3[indy]
e3x[indy+1] <- e3[indy+1]
lines(e3x, col="magenta", lwd=1.5)

points(e3, pch=20);grid()

plot(h1, type="n", main="hpaths(7)"); 
lines(1:8,h1[1:8], col="cyan", lwd=1.5); lines(8:15,h1[8:15], col="magenta", lwd=1.5)
lines(15:22,h1[15:22], col="tan1", lwd=1.5)
points(h1, pch=20);grid()

## -----------------------------------------------------------------------------
e4 <- eulerian(d7) # same path as eulerian(k7)
h2 <- weighted_hpaths(d7, matrix=FALSE)

## ----fig.width=7, fig.height=3, echo=FALSE------------------------------------
par(mfrow=c(1,2))
par(mar=c(2,2,3,1))



plot(e4, type="n", main="eulerian(d7)")

e4x <- rep(NA, length(e4))
indy <- which(pmin(head(e4,-1), e4[-1]) %in% c(2,3))
e4x[indy] <- e4[indy]
e4x[indy+1] <- e4[indy+1]
lines(e4x, col="cyan", lwd=1.5)

e4x <- rep(NA, length(e4))
indy <- which(pmin(head(e4,-1), e4[-1]) <= 1)

e4x[indy] <- e4[indy]
e4x[indy+1] <- e4[indy+1]
lines(e4x, col="tan1", lwd=1.5)

e4x <- rep(NA, length(e4))
indy <-  which(pmin(head(e4,-1), e4[-1]) >=4)

e4x[indy] <- e4[indy]
e4x[indy+1] <- e4[indy+1]
lines(e4x, col="magenta", lwd=1.5)



points(e4, pch=20);grid()

plot(h2, type="n", main="weighted_hpaths(d7)"); 
lines(1:8,h2[1:8], col="cyan",lwd=1.5); lines(8:15,h2[8:15], lwd=1.5,col="magenta")
lines(15:22,h2[15:22], col="tan1", lwd=1.5)
points(h2, pch=20);grid()

## -----------------------------------------------------------------------------
d7e <- dist2edge(d7) 
path_weights(d7e, e4) # the edge weights for e4
path_weights(d7e, h2) # the edge weights for h2

## ----fig.width=7, fig.height=3, echo=FALSE------------------------------------
par(mfrow=c(1,2))
par(mar=c(2,2,3,1))

e4w <- path_weights(d7e, e4)
plot(e4w, type="l", col="grey80", main="edge weights of eulerian(d7)", ylab="weight")
points(e4w, pch=21, bg="cyan");grid()

h2w <- path_weights(d7e, h2)
plot(h2w, type="l", col="grey80", main="edge weights of hpaths(d7)", ylab="weight")

points(1:7,h2w[1:7], pch=21, bg="cyan", col="grey50")
points(8:14,h2w[8:14], pch=21, bg="magenta", col="grey50")
points(15:21,h2w[15:21], pch=21, bg="tan1",col="grey50")
grid()

Try the PairViz package in your browser

Any scripts or data that you put into this service are public.

PairViz documentation built on Aug. 12, 2022, 5:06 p.m.