params <- list(family = "teal", preset = "homage") ## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", message = FALSE, warning = FALSE, fig.width = 6, fig.height = 4 ) ## ----albers-classes, echo=FALSE, results='asis'------------------------------- cat(sprintf( paste0( '' ), params$family, params$preset )) ## ----load-pkg----------------------------------------------------------------- library(adjoin) library(Matrix) ## ----first-graph-------------------------------------------------------------- set.seed(42) X <- as.matrix(iris[, 1:4]) # 150 flowers × 4 measurements ng <- graph_weights(X, k = 5, neighbor_mode = "knn", weight_mode = "heat") A <- adjacency(ng) # sparse 150×150 similarity matrix cat("nodes:", nvertices(ng), " | edges:", nnzero(A) / 2, "\n") ## ----first-graph-plot, echo = FALSE, fig.cap = "Adjacency matrix reordered by species. The three diagonal blocks show that flowers connect mostly within their own species.", out.width = "65%"---- ord <- order(iris$Species) A_ord <- as.matrix(A[ord, ord]) breaks <- cumsum(table(iris$Species)) / nrow(iris) image(seq(0, 1, length.out = nrow(A_ord)), seq(0, 1, length.out = ncol(A_ord)), A_ord, col = colorRampPalette(c("white", "#2c7bb6"))(50), axes = FALSE, xlab = "", ylab = "", main = "Feature-similarity adjacency (iris, k = 5, heat kernel)") abline(v = breaks[-3], h = breaks[-3], col = "firebrick", lwd = 1.5) legend("topright", fill = "firebrick", legend = "species boundary", bty = "n", cex = 0.8) ## ----step1-------------------------------------------------------------------- X <- as.matrix(iris[, 1:4]) dim(X) ## ----step2-------------------------------------------------------------------- ng <- graph_weights(X, k = 5, weight_mode = "heat", sigma = 0.5) ## ----step3-------------------------------------------------------------------- A <- adjacency(ng) # sparse similarity matrix L <- laplacian(ng) # L = D − A L_norm <- laplacian(ng, normalized = TRUE) # I − D^{-1/2} A D^{-1/2} ## ----inspect------------------------------------------------------------------ names(ng) str(ng$params, max.level = 1) ## ----accessors---------------------------------------------------------------- nvertices(ng) # number of nodes head(edges(ng)) # edge list as a character matrix ## ----weight-modes------------------------------------------------------------- ng_norm <- graph_weights(X, k = 5, weight_mode = "normalized") ng_cos <- graph_weights(X, k = 5, weight_mode = "cosine") ng_heat <- graph_weights(X, k = 5, weight_mode = "heat", sigma = 0.5) ## ----weight-mode-plot, echo = FALSE, fig.cap = "Edge weight distributions for three weight modes. All three spread similarity scores continuously across (0, 1].", fig.width = 7, fig.height = 3.5---- w_norm <- adjacency(ng_norm)@x; w_norm <- w_norm[w_norm > 0] w_cos <- adjacency(ng_cos)@x; w_cos <- w_cos[w_cos > 0] w_heat <- adjacency(ng_heat)@x; w_heat <- w_heat[w_heat > 0] local({ oldpar <- par(no.readonly = TRUE) tryCatch({ par(mfrow = c(1, 3), mar = c(4, 3, 2.5, 1)) hist(w_norm, breaks = 30, col = "#4dac26", main = "normalized", xlab = "edge weight", ylab = "") hist(w_cos, breaks = 30, col = "#d01c8b", main = "cosine", xlab = "edge weight", ylab = "") hist(w_heat, breaks = 30, col = "#2c7bb6", main = "heat (sigma = 0.5)", xlab = "edge weight", ylab = "") }, finally = { par(oldpar) }) }) ## ----symmetry----------------------------------------------------------------- # mutual: both must nominate each other (sparser, higher confidence) ng_mutual <- graph_weights(X, k = 5, weight_mode = "heat", type = "mutual") # asym: directed — i→j does not imply j→i ng_asym <- graph_weights(X, k = 5, weight_mode = "heat", type = "asym") # edge counts: normal ≥ mutual c(normal = nnzero(adjacency(ng)) / 2, mutual = nnzero(adjacency(ng_mutual)) / 2) ## ----nnsearcher--------------------------------------------------------------- searcher <- nnsearcher(X, labels = iris$Species) ## ----find-nn------------------------------------------------------------------ nn_result <- find_nn(searcher, k = 5) names(nn_result) # indices, distances, labels ## ----find-nn-among------------------------------------------------------------ nn_setosa <- find_nn_among(searcher, k = 3, idx = 1:50) ## ----find-nn-between---------------------------------------------------------- nn_cross <- find_nn_between(searcher, k = 3, idx1 = 1:50, idx2 = 51:100) ## ----nn-to-graph, eval = FALSE------------------------------------------------ # ng2 <- neighbor_graph(searcher, k = 5, transform = "heat", sigma = 0.5) ## ----class-graph-------------------------------------------------------------- cg <- class_graph(iris$Species) nclasses(cg) ## ----class-graph-plot, echo = FALSE, fig.cap = "class_graph adjacency for iris. Each block is a fully connected class; no edges cross species boundaries.", out.width = "65%"---- A_cg <- as.matrix(adjacency(cg)) ord <- order(iris$Species) breaks <- cumsum(table(iris$Species)) / nrow(iris) image(seq(0, 1, length.out = nrow(A_cg)), seq(0, 1, length.out = ncol(A_cg)), A_cg[ord, ord], col = colorRampPalette(c("white", "#d7191c"))(3), axes = FALSE, xlab = "", ylab = "", main = "class_graph: within-species connectivity (iris)") abline(v = breaks[-3], h = breaks[-3], col = "grey50", lwd = 1) ## ----class-queries, eval = FALSE---------------------------------------------- # # within-class neighbors for every point # wc <- within_class_neighbors(cg, X, k = 3) # # # nearest between-class neighbors for every point # bc <- between_class_neighbors(cg, X, k = 3) ## ----cross-adj---------------------------------------------------------------- X_ref <- as.matrix(iris[1:100, 1:4]) # 100 reference points X_query <- as.matrix(iris[101:150, 1:4]) # 50 query points # 50×100 sparse matrix: row i = query flower, col j = nearest reference C <- cross_adjacency(X_ref, X_query, k = 3, as = "sparse") dim(C) ## ----normalize---------------------------------------------------------------- A_raw <- adjacency(ng) A_norm <- normalize_adjacency(A_raw) range(Matrix::rowSums(A_norm)) Matrix::isSymmetric(A_norm) ## ----random-walk-transition--------------------------------------------------- deg <- Matrix::rowSums(A_raw) P_walk <- Matrix::Diagonal(x = ifelse(deg > 0, 1 / deg, 0)) %*% A_raw range(Matrix::rowSums(P_walk)[deg > 0])