## ----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()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.