## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 8.2,
  fig.height = 5.2
)

## -----------------------------------------------------------------------------
library(grip)

## -----------------------------------------------------------------------------
read.extdata.csv <- function(file.name) {
  candidates <- c(
    system.file("extdata", file.name, package = "grip"),
    file.path("inst", "extdata", file.name),
    file.path("..", "inst", "extdata", file.name)
  )
  path <- candidates[file.exists(candidates)][1L]
  if (!length(path) || is.na(path) || !nzchar(path)) {
    stop("could not locate ", file.name)
  }
  utils::read.csv(path, stringsAsFactors = FALSE)
}

read.edge.csv <- function(file.name) {
  as.matrix(read.extdata.csv(file.name))
}

read.karate.club <- function() {
  labels <- read.extdata.csv("karate-club-membership.csv")
  labels <- labels[order(labels$vertex), , drop = FALSE]
  labels$club
}

compact.summary <- function(x) {
  keep <- intersect(c(
    "candidate",
    "preset",
    "rounds",
    "final.rounds",
    "num.nbrs",
    "repulsion.factor",
    "sampled.stress.mean",
    "edge.length.cv.mean",
    "sampled.nonedge.sep.ratio.mean",
    "cluster.separation.mean",
    "stability.procrustes.mean",
    "score.composite"
  ), names(x))
  x[, keep, drop = FALSE]
}

plot.layout.triptych <- function(layouts,
                                 edges,
                                 titles,
                                 vertex.cols = NULL) {
  if (is.null(vertex.cols)) {
    vertex.cols <- rep(list("black"), length(layouts))
  }
  op <- par(mfrow = c(1, length(layouts)), mar = c(1.2, 1.2, 3.2, 1.2))
  on.exit(par(op), add = TRUE)
  for (i in seq_along(layouts)) {
    plot.layout(
      layouts[[i]],
      edges,
      projection = if (ncol(layouts[[i]]) == 3L) "ortho" else NULL,
      vertex.col = vertex.cols[[i]],
      edge.col = "gray82",
      main = titles[[i]]
    )
  }
}

edge.matrix.from.adj <- function(adj.list) {
  edges <- list()
  idx <- 0L
  for (u in seq_along(adj.list)) {
    nbrs <- adj.list[[u]]
    nbrs <- nbrs[nbrs > u]
    if (!length(nbrs)) next
    for (v in nbrs) {
      idx <- idx + 1L
      edges[[idx]] <- c(u, v)
    }
  }
  do.call(rbind, edges)
}

read.hmp.vignette.results <- function() {
  path <- system.file(
    "extdata", "hmp_u01_gc_coarse", "vignette_results.rds",
    package = "grip"
  )
  if (!nzchar(path)) {
    stop("could not locate bundled HMP/U01 vignette results")
  }
  readRDS(path)
}

## -----------------------------------------------------------------------------
karate.edges <- read.edge.csv("karate-club-edges.csv")
karate.n <- max(karate.edges)
karate.club <- read.karate.club()
karate.cols <- ifelse(karate.club == "Mr. Hi", "#1b9e77", "#d95f02")

karate.cmp <- compare.layouts(
  edges = karate.edges,
  n = karate.n,
  dim = 3,
  candidates = c("default", "tree", "mesh"),
  clusters = karate.club,
  seeds = 1:3,
  sample.size.stress = 1000L,
  sample.size.nonedge = 2000L,
  edge.crossings = "never",
  return.layouts = TRUE
)

knitr::kable(compact.summary(karate.cmp$summary), digits = 3)

## ----fig.width=11.2, fig.height=4.2-------------------------------------------
plot.layout.triptych(
  layouts = list(
    karate.cmp$layouts$default[["1"]],
    karate.cmp$layouts$tree[["1"]],
    karate.cmp$layouts$mesh[["1"]]
  ),
  edges = karate.edges,
  titles = c("default", "tree", "mesh"),
  vertex.cols = rep(list(karate.cols), 3)
)

## -----------------------------------------------------------------------------
karate.search <- compare.layouts(
  edges = karate.edges,
  n = karate.n,
  dim = 3,
  search = list(
    candidate.prefix = "karate.search",
    preset = c("tree"),
    rounds = c(96L, 128L),
    final_rounds = c(192L, 224L),
    repulsion_factor = c(1.25, 2.0)
  ),
  clusters = karate.club,
  seeds = 1:3,
  sample.size.stress = 1000L,
  sample.size.nonedge = 2000L,
  edge.crossings = "never",
  return.layouts = TRUE
)

knitr::kable(head(compact.summary(karate.search$summary), 6), digits = 3)

## ----fig.width=9, fig.height=4.2----------------------------------------------
op <- par(mfrow = c(1, 2), mar = c(4, 4, 2.2, 1))
on.exit(par(op), add = TRUE)

plot(
  karate.search$summary$repulsion.factor,
  karate.search$summary$sampled.stress.mean,
  pch = 19,
  col = "#1F3B73",
  xlab = "repulsion.factor",
  ylab = "sampled.stress.mean",
  main = "stress across local search"
)

plot(
  karate.search$summary$repulsion.factor,
  karate.search$summary$cluster.separation.mean,
  pch = 19,
  col = "#B24745",
  xlab = "repulsion.factor",
  ylab = "cluster.separation.mean",
  main = "cluster separation across search"
)

## -----------------------------------------------------------------------------
kite.edges <- read.edge.csv("krackhardt-kite-edges.csv")
kite.n <- max(kite.edges)

kite.coords <- grip(
  kite.edges,
  n = kite.n,
  dim = 2,
  preset = "tree",
  seed = 5
)

score.layout(kite.coords, edges = kite.edges, n = kite.n)

## ----fig.width=5.4, fig.height=4.2--------------------------------------------
plot.layout(
  kite.coords,
  kite.edges,
  main = "Krackhardt kite",
  pch = 16,
  cex = 0.9,
  edge.col = "gray80"
)

## -----------------------------------------------------------------------------
data(hmp.u01.gc.coarse)

hmp.graph.info <- data.frame(
  quantity = c(
    "coarse vertices",
    "weighted undirected edges",
    "selected k",
    "representation"
  ),
  value = c(
    hmp.u01.gc.coarse$graph_info$coarse_vertices,
    hmp.u01.gc.coarse$graph_info$edge_count,
    hmp.u01.gc.coarse$graph_info$selected_k,
    hmp.u01.gc.coarse$graph_info$representation
  ),
  stringsAsFactors = FALSE
)

hmp.weight.summary <- as.data.frame(t(summary(unlist(
  hmp.u01.gc.coarse$weight_list,
  use.names = FALSE
))))

knitr::kable(hmp.graph.info)
knitr::kable(hmp.weight.summary, digits = 4)

## -----------------------------------------------------------------------------
hmp.weight.cv <- with(
  list(w = unlist(hmp.u01.gc.coarse$weight_list, use.names = FALSE)),
  stats::sd(w) / mean(w)
)

hmp.weight.cv

## ----eval=FALSE---------------------------------------------------------------
# weighted.candidates <- list(
#   weighted_default = weighted.grip(
#     adj_list = hmp.u01.gc.coarse$adj_list,
#     weight_list = hmp.u01.gc.coarse$weight_list,
#     n = length(hmp.u01.gc.coarse$adj_list),
#     dim = 3,
#     seed = 1
#   ),
#   weighted_irregular = weighted.grip(
#     adj_list = hmp.u01.gc.coarse$adj_list,
#     weight_list = hmp.u01.gc.coarse$weight_list,
#     n = length(hmp.u01.gc.coarse$adj_list),
#     dim = 3,
#     preset = "irregular",
#     seed = 1
#   )
# )
# 
# weighted.scores <- lapply(weighted.candidates, function(coords) {
#   score.layout(
#     coords,
#     adj_list = hmp.u01.gc.coarse$adj_list,
#     weight_list = hmp.u01.gc.coarse$weight_list,
#     n = length(hmp.u01.gc.coarse$adj_list),
#     clusters = hmp.u01.gc.coarse$vertex_data$cst,
#     sample.size.stress = 2000L,
#     sample.size.nonedge = 5000L,
#     edge.crossings = "never"
#   )
# })

## -----------------------------------------------------------------------------
hmp.results <- read.hmp.vignette.results()
hmp.edges <- edge.matrix.from.adj(hmp.u01.gc.coarse$adj_list)
hmp.cst <- hmp.u01.gc.coarse$vertex_data$cst
hmp.cst.levels <- sort(unique(hmp.cst))
hmp.cst.cols <- setNames(grDevices::hcl.colors(length(hmp.cst.levels), "Dark 3"),
                         hmp.cst.levels)
hmp.cst.col <- hmp.cst.cols[hmp.cst]

hmp.case.info <- data.frame(
  quantity = c(
    "source dataset",
    "representation",
    "selected k",
    "original giant-component vertices",
    "coarsened vertices",
    "weighted undirected edges"
  ),
  value = c(
    hmp.u01.gc.coarse$graph_info$source_dataset,
    hmp.u01.gc.coarse$graph_info$representation,
    hmp.u01.gc.coarse$graph_info$selected_k,
    hmp.u01.gc.coarse$graph_info$original_vertices,
    hmp.u01.gc.coarse$graph_info$coarse_vertices,
    hmp.u01.gc.coarse$graph_info$edge_count
  ),
  stringsAsFactors = FALSE
)

knitr::kable(hmp.case.info)

## -----------------------------------------------------------------------------
hmp.preset.keep <- c(
  "candidate",
  "sampled.stress.mean",
  "edge.length.cv.mean",
  "sampled.nonedge.sep.ratio.mean",
  "cluster.separation.mean",
  "score.composite"
)

knitr::kable(hmp.results$preset_summary[, hmp.preset.keep], digits = 3)

## ----fig.width=11.2, fig.height=4.4-------------------------------------------
plot.layout.triptych(
  layouts = list(
    hmp.results$layouts$preset$default,
    hmp.results$layouts$preset$tree,
    hmp.results$layouts$preset$torus
  ),
  edges = hmp.edges,
  titles = c("default", "tree", "torus"),
  vertex.cols = rep(list(hmp.cst.col), 3)
)

## -----------------------------------------------------------------------------
hmp.local.keep <- c(
  "candidate",
  "rounds",
  "final.rounds",
  "repulsion.factor",
  "sampled.stress.mean",
  "cluster.separation.mean",
  "score.composite"
)

knitr::kable(
  head(hmp.results$local_search_summary[, hmp.local.keep], 4),
  digits = 3
)

## ----fig.width=11.2, fig.height=4.4-------------------------------------------
top.local <- hmp.results$top_local_candidates
plot.layout.triptych(
  layouts = lapply(top.local, function(nm) hmp.results$layouts$local[[nm]]),
  edges = hmp.edges,
  titles = top.local,
  vertex.cols = rep(list(hmp.cst.col), length(top.local))
)