rng <- function (x = NULL, dx = NULL, r = 1, method = NULL, usedeldir = TRUE, open = TRUE, k = NA, algorithm = "cover_tree", weighted = TRUE) { if (is.na(k)) { if (is.null(dx)) { if (is.null(x)) stop("One of x or dx must be given.") dx <- as.matrix(proxy::dist(x, method = method)) } else { usedeldir <- FALSE } n <- nrow(dx) A <- matrix(0, nrow = n, ncol = n) if (is.vector(x)) x <- matrix(x, ncol = 1) if (usedeldir && ncol(x) == 2) { del <- deldir::deldir(x[, 1], x[, 2]) for (edge in 1:nrow(del$delsgs)) { i <- del$delsgs[edge, 5] j <- del$delsgs[edge, 6] d <- min(apply(cbind(dx[i, -c(i, j)], dx[j, -c(i, j)]), 1, max)) rd <- r * dx[i, j] if ((open && rd < d) || rd <= d) { A[i, j] <- A[j, i] <- rd } } } else { diag(dx) <- Inf for (i in 1:n) { for (j in setdiff(1:n, i)) { d <- min(apply(cbind(dx[i, -c(i, j)], dx[j, -c(i, j)]), 1, max)) rd <- r * dx[i, j] if ((open && rd < d) || rd <= d) { A[i, j] <- A[j, i] <- rd } } } } diag(A) <- 0 out <- graph.adjacency(A, mode = "undirected", weighted = weighted) } else { if (is.null(x)) stop("x must not be null") n <- nrow(x) k <- min(k, n - 1) dx <- get.knn(x, k = k, algorithm = algorithm) edges <- NULL weights <- NULL for (i in 1:n) { i.indices <- dx$nn.index[i, ] i.dists <- dx$nn.dist[i, ] for (j in 1:k) { rd <- r * i.dists[j]/2 j.indices <- dx$nn.index[i.indices[j], ] j.dists <- dx$nn.dist[i.indices[j], ] rd <- r * i.dists[j] S <- setdiff(intersect(i.indices, j.indices), c(i, i.indices[j])) if (length(S) > 0) { d <- Inf for (si in S) { a <- which(i.indices == si) b <- which(j.indices == si) d <- min(d, max(i.dists[a], j.dists[b])) } if ((open && rd < d) || rd <= d) { edges <- cbind(edges, c(i, i.indices[j])) weights <- cbind(weights, rd) } } } } g <- graph(edges, n = n, directed = FALSE) if( weighted ) { edge.attributes(g) <- list(weight=weights) } out <- simplify(g, edge.attr.comb = "first") } if (!is.null(x)) { out$layout <- x } out$r <- r out }
Weighted Relative Neighborhood Graph in R based on cccd::rng
The R package cccd contains a nice implementation of the Relative Neighborhood Graph (rng) but in the current version 1.5 it returns a non-weighted igraph. But for one of my experiments I needed the weighted version so I've slightly changed the code to get an igraph with weights.
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment