如何加速R语言中训练SOM映射的自定义函数？

你的自定义SOM函数运行缓慢的核心原因是嵌套循环+纯R实现的距离计算——R的循环本身效率较低，且自定义距离函数没有利用底层优化的计算逻辑。以下是针对性的优化方案：

核心优化方向 #

1. 批量计算距离，替换嵌套循环 #

将逐个样本计算距离的内层循环改为一次性计算所有样本与神经元的距离矩阵，大幅减少循环次数；同时将权重更新也改为批量操作，利用矩阵运算的向量化特性提速。

2. 用底层优化的距离计算逻辑替代自定义函数 #

避免纯R手写距离公式，改用向量化矩阵运算或依赖底层C/Fortran实现的计算逻辑，比纯R函数快数个量级。

3. 预计算重复常量 #

比如余弦距离中神经元权重的模长、样本的模长，只需计算一次，无需每次迭代重复计算。

4. 减少不必要的类型转换 #

提前将数据转换为矩阵格式，避免在循环内频繁调用as.matrix()、as.numeric()这类耗时操作。

优化后的完整代码 #

kohonen_map_optimized <- function(data = iris[, -5], 
                                  data_classes = iris$Species, 
                                  neighborhood_fun = "gaussian", 
                                  learning_rate = 0.01, 
                                  distance_type = "euclidean", 
                                  sigma = 0.1, 
                                  num_neurons = 3, 
                                  num_iterations = 100) {
  # 提前转换为矩阵，避免循环内重复转换
  data <- as.matrix(data)
  
  # 初始化权重：按类别取均值转置
  map_weights <- t(sapply(split(data[, 1:4], data_classes), colMeans))
  map_weights <- as.matrix(map_weights)
  
  # 初始化参数
  radius <- num_neurons / 2
  learning_rate_decay <- 0.9
  
  # 预计算距离相关常量（针对余弦距离）
  weight_norms <- NULL
  data_norms <- NULL
  if (distance_type == "cosine") {
    weight_norms <- sqrt(rowSums(map_weights^2))
    data_norms <- sqrt(rowSums(data^2))
  }
  
  # 定义向量化的距离计算逻辑
  compute_distances <- function(X, Y) {
    switch(distance_type,
           "euclidean" = {
             # 向量化欧式距离：(x-y)^2的行和开根号
             sqrt(rowSums((t(X) - Y)^2))
           },
           "manhattan" = {
             rowSums(abs(t(X) - Y))
           },
           "cosine" = {
             # 复用预计算的模长，避免重复计算
             1 - (Y %*% t(X)) / (data_norms %*% t(weight_norms))
           },
           stop("Invalid distance type. Supported values are euclidean, manhattan, and cosine."))
  }
  
  # 定义邻域核函数
  neighborhood_kernel <- switch(neighborhood_fun,
                                "gaussian" = function(win_idx, all_idx) {
                                  exp(-((win_idx - all_idx) / sigma)^2)
                                },
                                "circular" = function(win_idx, all_idx) {
                                  as.numeric(abs(win_idx - all_idx) <= radius)
                                },
                                stop("Invalid neighborhood function. Supported values are gaussian and circular."))
  
  # 迭代训练：外层迭代，批量处理所有样本
  for (i in 1:num_iterations) {
    # 一次性计算所有样本与神经元的距离矩阵（每行=一个样本到所有神经元的距离）
    dist_matrix <- t(apply(data, 1, function(x) compute_distances(map_weights, x)))
    
    # 找到每个样本的获胜神经元
    winning_neurons <- apply(dist_matrix, 1, which.min)
    
    # 批量更新权重：按获胜神经元分组更新，减少重复计算
    for (win_idx in unique(winning_neurons)) {
      sample_indices <- which(winning_neurons == win_idx)
      samples_batch <- data[sample_indices, , drop = FALSE]
      
      neighborhood_factors <- neighborhood_kernel(win_idx, 1:num_neurons)
      # 用批量样本的均值更新权重，替代逐个样本更新
      map_weights <- map_weights + learning_rate * neighborhood_factors * (colMeans(samples_batch) - map_weights)
    }
    
    # 更新衰减参数
    radius <- radius * learning_rate_decay
    learning_rate <- learning_rate * learning_rate_decay
  }
  
  # 预测阶段：批量计算距离找获胜神经元
  pred_dist_matrix <- t(apply(data, 1, function(x) compute_distances(map_weights, x)))
  predicted_classes <- apply(pred_dist_matrix, 1, which.min)
  
  return(predicted_classes)
}

额外性能提升建议 #

• 若数据量极大，可使用Rcpp实现核心距离计算和权重更新逻辑，性能会再提升一个量级。
• 训练时可采用随机抽样样本的方式（每次迭代只取部分样本），而非遍历所有样本，适合大数据集场景。
• 对于欧式距离，可使用fastmatrix::dist_euclidean()这类专门的高效包函数进一步加速。

运行对比示例 #

library(caret)

# 原函数运行时间
system.time(pred_old <- kohonen_map())
# 优化后函数运行时间
system.time(pred_new <- kohonen_map_optimized())

# 验证结果一致性（可设置seed确保初始化一致）
confusionMatrix(unique(iris[,5])[pred_old], iris[,5])
confusionMatrix(unique(iris[,5])[pred_new], iris[,5])

内容的提问来源于stack exchange，提问作者Tou Mou