Nothing
## -----------------------------------------------------------------------------
library(rdecision)
## -----------------------------------------------------------------------------
# new page
grid::grid.newpage()
# functions to transform coordinates and distances in graph space (0:300)
# to grid space (cm)
fig.size <- dev.size("cm")
scale <- max(300.0 / fig.size[[1L]], 300.0 / fig.size[[2L]])
gx <- function(x) {
xcm <- fig.size[[1L]] / 2.0 + (x - 150.0) / scale
return(xcm)
}
gy <- function(y) {
ycm <- fig.size[[2L]] / 2.0 + (y - 150.0) / scale
return(ycm)
}
gd <- function(d) {
dcm <- d / scale
return(dcm)
}
# grid
for (x in seq(50L, 250L, 50L)) {
grid::grid.move.to(
x = grid::unit(gx(x), "cm"), y = grid::unit(gy(50.0), "cm")
)
grid::grid.line.to(
x = grid::unit(gx(x), "cm"), y = grid::unit(gy(250.0), "cm"),
gp = grid::gpar(lwd = 2.0)
)
}
for (y in seq(50L, 250L, 50L)) {
grid::grid.move.to(
x = grid::unit(gx(50.0), "cm"), y = grid::unit(gy(y), "cm")
)
grid::grid.line.to(
x = grid::unit(gx(250.0), "cm"), y = grid::unit(gy(y), "cm"),
gp = grid::gpar(lwd = 2.0)
)
}
grid::grid.text(
label = "A", x = grid::unit(gx(45.0), "cm"), y = grid::unit(gy(255.0), "cm"),
gp = grid::gpar(fontsize = 14.0)
)
grid::grid.text(
label = "B", x = grid::unit(gx(255.0), "cm"), y = grid::unit(gy(45.0), "cm"),
gp = grid::gpar(fontsize = 14.0)
)
# restaurants
BB <- data.frame(
x0 = c(150.0, 100.0, 210.0, 160.0, 250.0, 110.0, 50.0),
y0 = c(60.0, 110.0, 100.0, 150.0, 160.0, 200.0, 210.0),
x1 = c(150.0, 100.0, 240.0, 190.0, 250.0, 140.0, 50.0),
y1 = c(90.0, 140.0, 100.0, 150.0, 190.0, 200.0, 240.0)
)
apply(BB, MARGIN = 1L, function(r) {
grid::grid.move.to(
x = grid::unit(gx(r[["x0"]]), "cm"), y = grid::unit(gy(r[["y0"]]), "cm")
)
grid::grid.line.to(
x = grid::unit(gx(r[["x1"]]), "cm"),
y = grid::unit(gy(r[["y1"]]), "cm"),
gp = grid::gpar(col = "red", lwd = 6.0, lend = "square")
)
})
## -----------------------------------------------------------------------------
# node index function
idx <- function(i, j) {
return(5L * (i - 1L) + j)
}
# create vertices
N <- vector(mode = "list", length = 5L * 4L)
for (i in seq(5L)) {
for (j in seq(5L)) {
N[[idx(i, j)]] <- Node$new(paste0("N", i, j))
}
}
# create edges
H <- vector(mode = "list", length = 5L * 4L)
ie <- 1L
for (i in seq(5L)) {
for (j in seq(4L)) {
a <- Arrow$new(
N[[idx(i, j)]], N[[idx(i, j + 1L)]], paste0("H", i, j)
)
H[[ie]] <- a
ie <- ie + 1L
}
}
V <- vector(mode = "list", length = 4L * 5L)
ie <- 1L
for (i in seq(4L)) {
for (j in seq(5L)) {
a <- Arrow$new(
N[[idx(i, j)]], N[[idx(i + 1L, j)]], paste0("V", i, j)
)
V[[ie]] <- a
ie <- ie + 1L
}
}
# create graph
G <- Digraph$new(V = N, A = c(V, H))
## -----------------------------------------------------------------------------
# get all paths from A to B
A <- N[[1L]]
B <- N[[25L]]
P <- G$paths(A, B)
# convert paths to walks
W <- lapply(P, FUN = G$walk)
# count and tabulate how many special edges each walk traverses
BB <- c("V11", "H22", "V25", "H33", "V32", "H44", "V43")
nw <- vapply(W, FUN.VALUE = 1L, FUN = function(w) {
lv <- vapply(w, FUN.VALUE = TRUE, FUN = function(e) e$label() %in% BB)
return(sum(lv))
})
# tabulate
ct <- as.data.frame(table(nw))
## -----------------------------------------------------------------------------
names(ct) <- c("n", "frequency")
knitr::kable(ct)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.