switch from Rfast to philentropy

Author: EmilHvitfeldt

R/extract_fit_summary.R

@@ -167,15 +167,27 @@ extract_fit_summary.hclust <- function(object, ...) {
   sse_within_total_total <- map2_dbl(
     by_clust$data,
     seq_len(n_clust),
-    ~sum(Rfast::dista(centroids[.y, ], .x))
+    ~sum(
+      philentropy::dist_many_many(
+        as.matrix(centroids[.y, ]),
+        as.matrix(.x),
+        method = "euclidean"
+      )
+    )
   )
 
   list(
     cluster_names = unique(clusts),
     centroids = centroids,
     n_members = unname(as.integer(table(clusts))),
     sse_within_total_total = sse_within_total_total,
-    sse_total = sum(Rfast::dista(t(overall_centroid), training_data)),
+    sse_total = sum(
+      philentropy::dist_many_many(
+        t(overall_centroid),
+        as.matrix(training_data),
+        method = "euclidean"
+      )
+    ),
     orig_labels = NULL,
     cluster_assignments = clusts
   )

R/metric-helpers.R

@@ -65,13 +65,20 @@ prep_data_dist <- function(
 #' @param new_data A data frame
 #' @param centroids A data frame where each row is a centroid.
 #' @param dist_fun A function for computing matrix-to-matrix distances. Defaults
-#'   to `Rfast::dista()`
-get_centroid_dists <- function(new_data, centroids, dist_fun = Rfast::dista) {
+#'   to
+#'   `function(x, y) philentropy::dist_many_many(x, y, method = "euclidean")`.
+get_centroid_dists <- function(
+  new_data,
+  centroids,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  }
+) {
   if (ncol(new_data) != ncol(centroids)) {
     rlang::abort("Centroids must have same columns as data.")
   }
 
   suppressMessages(
-    dist_fun(centroids, new_data)
+    dist_fun(as.matrix(centroids), as.matrix(new_data))
   )
 }

R/metric-sse.R

@@ -19,7 +19,13 @@
 #'
 #' sse_within(kmeans_fit)
 #' @export
-sse_within <- function(object, new_data = NULL, dist_fun = Rfast::dista) {
+sse_within <- function(
+  object,
+  new_data = NULL,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  }
+) {
   if (inherits(object, "cluster_spec")) {
     rlang::abort(
       paste(
@@ -44,7 +50,10 @@ sse_within <- function(object, new_data = NULL, dist_fun = Rfast::dista) {
     )
   } else {
     suppressMessages(
-      dist_to_centroids <- dist_fun(summ$centroids, new_data)
+      dist_to_centroids <- dist_fun(
+        as.matrix(summ$centroids),
+        as.matrix(new_data)
+      )
     )
 
     res <- dist_to_centroids %>%
@@ -123,7 +132,9 @@ sse_within_total.cluster_fit <- function(
   ...
 ) {
   if (is.null(dist_fun)) {
-    dist_fun <- Rfast::dista
+    dist_fun <- function(x, y) {
+      philentropy::dist_many_many(x, y, method = "euclidean")
+    }
   }
 
   res <- sse_within_total_impl(object, new_data, dist_fun, ...)
@@ -144,7 +155,9 @@ sse_within_total.workflow <- sse_within_total.cluster_fit
 sse_within_total_vec <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   sse_within_total_impl(object, new_data, dist_fun, ...)
@@ -153,7 +166,9 @@ sse_within_total_vec <- function(
 sse_within_total_impl <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   sum(sse_within(object, new_data, dist_fun, ...)$wss, na.rm = TRUE)
@@ -210,7 +225,9 @@ sse_total.cluster_fit <- function(
   ...
 ) {
   if (is.null(dist_fun)) {
-    dist_fun <- Rfast::dista
+    dist_fun <- function(x, y) {
+      philentropy::dist_many_many(x, y, method = "euclidean")
+    }
   }
 
   res <- sse_total_impl(object, new_data, dist_fun, ...)
@@ -231,7 +248,9 @@ sse_total.workflow <- sse_total.cluster_fit
 sse_total_vec <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   sse_total_impl(object, new_data, dist_fun, ...)
@@ -240,7 +259,9 @@ sse_total_vec <- function(
 sse_total_impl <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   # Preprocess data before computing distances if appropriate
@@ -256,7 +277,8 @@ sse_total_impl <- function(
     overall_mean <- colSums(summ$centroids * summ$n_members) /
       sum(summ$n_members)
     suppressMessages(
-      tot <- dist_fun(t(as.matrix(overall_mean)), new_data)^2 %>% sum()
+      tot <- dist_fun(t(as.matrix(overall_mean)), as.matrix(new_data))^2 %>%
+        sum()
     )
   }
 
@@ -314,7 +336,9 @@ sse_ratio.cluster_fit <- function(
   ...
 ) {
   if (is.null(dist_fun)) {
-    dist_fun <- Rfast::dista
+    dist_fun <- function(x, y) {
+      philentropy::dist_many_many(x, y, method = "euclidean")
+    }
   }
   res <- sse_ratio_impl(object, new_data, dist_fun, ...)
 
@@ -334,7 +358,9 @@ sse_ratio.workflow <- sse_ratio.cluster_fit
 sse_ratio_vec <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   sse_ratio_impl(object, new_data, dist_fun, ...)
@@ -343,7 +369,9 @@ sse_ratio_vec <- function(
 sse_ratio_impl <- function(
   object,
   new_data = NULL,
-  dist_fun = Rfast::dista,
+  dist_fun = function(x, y) {
+    philentropy::dist_many_many(x, y, method = "euclidean")
+  },
   ...
 ) {
   sse_within_total_vec(object, new_data, dist_fun) /

R/predict_helpers.R

@@ -96,7 +96,11 @@ make_predictions <- function(x, prefix, n_clusters) {
     )
 
     # need this to be obs on rows, dist to new data on cols
-    dists_new <- Rfast::dista(xnew = training_data, x = new_data, trans = TRUE)
+    dists_new <- philentropy::dist_many_many(
+      training_data,
+      new_data,
+      method = "euclidean"
+    )
 
     cluster_dists <- dplyr::bind_cols(data.frame(dists_new), clusters) %>%
       dplyr::group_by(.cluster) %>%
@@ -109,7 +113,12 @@ make_predictions <- function(x, prefix, n_clusters) {
     ## Centroid linkage_method, dist to center
 
     cluster_centers <- extract_centroids(object) %>% dplyr::select(-.cluster)
-    dists_means <- Rfast::dista(new_data, cluster_centers)
+
+    dists_means <- philentropy::dist_many_many(
+      new_data,
+      cluster_centers,
+      method = "euclidean"
+    )
 
     pred_clusts_num <- apply(dists_means, 1, which.min)
   } else if (linkage_method %in% c("ward.D", "ward", "ward.D2")) {