R/affinity.R

Defines functions affinity_kernel kneighbors_graph pairwise_kernels rbf_kernel

Documented in affinity_kernel kneighbors_graph pairwise_kernels rbf_kernel

rbf_kernel <- function(X, Y, gamma = NULL) {
  if (is.null(gamma)) {
    gamma <- 1.0 / length(X)
  }
  K <- sum((X - Y) ^ 2)
  K <- K * -gamma
  K <- exp(K)
  return(K)
}

pairwise_kernels <- function(X,
                             kernel = "rbf") {
  n <- nrow(X)
  if (typeof(kernel) == "character") {
    kernel_fun <- switch(kernel, "rbf" = rbf_kernel)
  } else {
    kernel_fun <- kernel
  }
  # https://stackoverflow.com/questions/16944409/fast-computation-of-kernel-matrix-in-r
  connectivity <- outer(1:n, 1:n,
                        Vectorize(function(i, j)
                          kernel_fun(X[i,], X[j,])))
  return(connectivity)
}

kneighbors_graph <- function(X,
                             n_neighbors = 10) {
  distance <- pairwise_kernels(X, function(x, y)
    sum((x - y) ^ 2))
  n <- nrow(X)
  index <- t(apply(distance, 1, order))[, 1:n_neighbors]
  affinity_matrix <- matrix(0, n, n)
  for (i in 1:n)
  {
    affinity_matrix[i, index[i,]] <- 1
  }
  return(affinity_matrix)
}

affinity_kernel <- function(X,
                            kernel = "rbf") {
  if (kernel == "precomputed") {
    affinity_matrix <- X
  } else if (kernel == "nearest_neighbors") {
    connectivity <- kneighbors_graph(X)
    affinity_matrix <- 0.5 * (connectivity + t(connectivity))
  } else {
    affinity_matrix <- pairwise_kernels(X, kernel)
  }
  return(affinity_matrix)
}
arthans/SpectralClustering documentation built on Dec. 19, 2021, 4:41 a.m.