Как векторизовать жадный алгоритм в R? - PullRequest
Новая
       5

Как векторизовать жадный алгоритм в R?

2 голосов
/ 12 февраля 2020

Я пишу сценарий R, который реализует жадный алгоритм для оптимизации функции. В качестве простого примера, предположим, что у меня есть вектор положительных чисел, которые будут распределены по 3 кластерам. Я хочу минимизировать общее расстояние внутри кластера в каждом кластере. Я использую жадный алгоритм распределения чисел по одному и размещения каждого числа в кластере, у которого наименьшая сумма расстояний между этим числом и числами уже в кластере. Вот скрипт R для реализации этого алгоритма: 

n <- 100
set.seed(0)
x <- rnorm(n)
cluster <- integer(n)

total_distance <- function(c, x, cluster){
  if(!any(cluster == c)){
    total_dist <- 0
  } else{
    total_dist <- sum(abs(x[cluster == c] - x[which.min(cluster > 0)]))
  }
  return(total_dist)
}

for(i in 1:n){
  within_cluster_distances <- mapply(total_distance, 1:3,
                                     MoreArgs = list(x = x, cluster = cluster))
  cluster[i] <- which.min(within_cluster_distances)
}

> cluster
  [1] 1 2 3 1 2 3 2 2 2 1 1 3 3 2 2 2 2 3 1 3 2 1 2 1 2 1 1 3 3 2 2 3 2 3 1 1 1 2 1 2 1 1 2 3 3 3 3 1 1 2 2 2 1 3 2 2 1 2 3 3 2 2 3 2 3 2 3
 [68] 1 2 2 2 2 3 2 1 1 2 2 3 3 3 1 1 2 2 2 1 2 1 1 1 3 2 3 1 2 2 1 2 1

Возможно (или даже желательно) векторизовать l oop, чтобы получить вектор cluster? Я не знаю, как векторизовать, когда значения в выходном векторе зависят от других значений в этом векторе.

РЕДАКТИРОВАТЬ: я понимаю, что описанный выше жадный алгоритм не является эффективным методом кластеризации. Описанная выше проблема - это не та проблема, которую я пытаюсь решить. Мой вопрос о том, возможно ли и полезно ли векторизовать l oop в моем примере кода.

1 Ответ

1 голос
/ 12 февраля 2020

Другим вариантом является использование stats::kmeans: 

kmeans(x, 3)$cluster

Проверка, которая более плотно упакована: 

cldist <- function(v) sum(abs(outer(v, v, `-`)))

tapply(x, cluster, FUN=cldist)
#       1        2        3 
#1086.007 1132.614 1019.575 

tapply(x, kmeans(x, 3)$cluster, FUN=cldist)
#       1        2        3 
#234.8734 722.5750 374.7199
...