tests/replica/replica_nng_batches.R

In scclust: Size-Constrained Clustering

batch_assign <- function(nng,
                         unassigned_method) {
  cl_label <- rep(as.integer(NA), ncol(nng))
  current_label <- 0
  assigned <- rep(FALSE, ncol(nng))
  invisible(lapply(1:ncol(nng), function(i) {
    if (!assigned[i] && any(nng[, i])) {
      if (!any(assigned[nng[, i]])) {
        assigned[nng[, i]] <<- TRUE
        cl_label[nng[, i]] <<- current_label
        current_label <<- current_label + 1
      } else if (unassigned_method == "any_neighbor") {
        cand <- which(nng[, i])
        cl_label[i] <<- cl_label[cand[assigned[cand]][1]]
      }
    }
  }))

  cl_label
}


replica_nng_clustering_batches <- function(distances,
                                           size_constraint,
                                           unassigned_method = "any_neighbor",
                                           radius = NULL,
                                           primary_data_points = NULL) {
  ensure_distances(distances)
  num_data_points <- length(distances)
  size_constraint <- coerce_size_constraint(size_constraint, num_data_points)
  unassigned_method <- coerce_args(unassigned_method,
                                   c("ignore", "any_neighbor"))
  radius <- coerce_radius(radius)
  if (!is.null(primary_data_points)) {
    ensure_indicators(primary_data_points, num_data_points, TRUE)
  }

  distances <- as.matrix(distances)
  nng <- get_simple_nng(distances,
                        size_constraint,
                        radius,
                        primary_data_points)

  cl_label <- batch_assign(nng, unassigned_method)

  make_scclust(as.integer(cl_label),
               length(unique(cl_label[!is.na(cl_label)])),
               attr(distances, "ids", exact = TRUE))
}