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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.