Graph gallery: SGD metric MDS

mesh.graph <- mesh.surface.graph(
  5, 5,
  surface = "saddle",
  amplitude = 0.8
)

mesh.fit <- metric.mds(
  edges = mesh.graph$edges,
  n = mesh.graph$n,
  edge.weights = mesh.graph$edge_weights,
  dim = 3,
  seed = 1,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
mesh.coords <- mesh.fit$coords

mesh.summary <- data.frame(
  family = mesh.graph$family,
  surface = mesh.graph$surface,
  n = mesh.graph$n,
  m = nrow(mesh.graph$edges),
  weight_scale = mesh.graph$weight_scale
)

knitr::kable(mesh.summary, digits = 3)

documentation.view(
  list(`SGD metric MDS`=mesh.coords,
       `Reference geometry`=mesh.graph$coords_surface,
       `Parameter grid`=cbind(mesh.graph$coords_param, z=0)),
  edges=mesh.graph$edges, aligned=TRUE,
  description="Mesh: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

torus.graph <- torus.surface.graph(
  5, 6,
  surface = "pinched",
  minor.radius = 0.33,
  amplitude = 0.18,
  twist = 0.18
)

torus.fit <- metric.mds(
  edges = torus.graph$edges,
  n = torus.graph$n,
  edge.weights = torus.graph$edge_weights,
  dim = 3,
  seed = 2,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
torus.coords <- torus.fit$coords

knitr::kable(
  data.frame(
    family = torus.graph$family,
    surface = torus.graph$surface,
    n = torus.graph$n,
    m = nrow(torus.graph$edges)
  )
)

documentation.view(
  list(`SGD metric MDS`=torus.coords,
       `Reference geometry`=torus.graph$coords_surface),
  edges=torus.graph$edges, aligned=TRUE,
  description="Torus: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

vicsek.graph <- vicsek.surface.graph(
  level = 2,
  surface = "ripple",
  amplitude = 0.55
)

vicsek.fit <- metric.mds(
  edges = vicsek.graph$edges,
  n = vicsek.graph$n,
  edge.weights = vicsek.graph$edge_weights,
  dim = 3,
  seed = 3,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
vicsek.coords <- vicsek.fit$coords

documentation.view(
  list(`SGD metric MDS`=vicsek.coords,
       `Reference geometry`=vicsek.graph$coords_surface),
  edges=vicsek.graph$edges, aligned=TRUE,
  description="Vicsek: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

annulus.graph <- irregular.annulus.surface.graph(
  rings = 5,
  outer.count = 24,
  inner.radius = 0.42,
  surface = "folded",
  amplitude = 0.2
)

annulus.fit <- metric.mds(
  edges = annulus.graph$edges,
  n = annulus.graph$n,
  edge.weights = annulus.graph$edge_weights,
  dim = 3,
  seed = 4,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
annulus.coords <- annulus.fit$coords

documentation.view(
  list(`SGD metric MDS`=annulus.coords,
       `Reference geometry`=annulus.graph$coords_surface),
  edges=annulus.graph$edges, aligned=TRUE,
  description="Annulus: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

cube.graph <- cube.channel.network.surface.graph(
  side = 5,
  level = 1,
  surface = "twisted",
  twist = 0.2
)

cube.fit <- metric.mds(
  edges = cube.graph$edges,
  n = cube.graph$n,
  edge.weights = cube.graph$edge_weights,
  dim = 3,
  seed = 5,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
cube.coords <- cube.fit$coords

knitr::kable(
  data.frame(
    family = cube.graph$family,
    n = cube.graph$n,
    m = nrow(cube.graph$edges)
  )
)

documentation.view(
  list(`SGD metric MDS`=cube.coords,
       `Reference geometry`=cube.graph$coords_surface),
  edges=cube.graph$edges, aligned=TRUE,
  description="Cube: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

tree.graph <- kary.tree.weighted.graph(
  k = 2,
  depth = 4,
  depth.rule = "geometric",
  depth.decay = 0.82,
  branch.rule = "linear",
  branch.spread = 0.25
)

tree.fit <- metric.mds(
  edges = tree.graph$edges,
  n = tree.graph$n,
  edge.weights = tree.graph$edge_weights,
  dim = 3,
  seed = 6,
  backend = "sgd", pair.weights = "uniform",
  max.iter = 1000, diagnostics = FALSE
)
#> Warning: Selected metric.mds() start terminated with iteration_limit; budget
#> exhaustion does not certify convergence; inspect metadata$starts
tree.coords <- tree.fit$coords

knitr::kable(
  head(tree.graph$edge_table[, c(
    "parent",
    "child",
    "child_depth",
    "branch_index",
    "edge_weight"
  )]),
  digits = 3
)

documentation.view(
  list(`SGD metric MDS`=tree.coords),
  edges=tree.graph$edges, aligned=TRUE,
  description="Tree: drag to rotate, scroll to zoom; use the selector to compare geometries."
)

fits <- list(Saddle=mesh.fit, Torus=torus.fit, Vicsek=vicsek.fit,
             Annulus=annulus.fit, Porous=cube.fit, Tree=tree.fit)
for (name in names(fits)) {
  cat("\n\n### ", name, "\n\n", sep="")
  print(knitr::kable(fits[[name]]$metadata$starts, digits=5))
}