编辑 Fuzzy C 表示以Haversine 公式作为距离度量的函数

Question

我是 r 的新手，如果我的要求是不可能的或疯狂的，请纠正我。

我想将一组地理坐标数据（纬度、经度）聚类成预定数量的大小大致相同的聚类。

我关心的是 k-means 和 FCM 算法，因为它是基于欧几里德距离计算的。我在想如果我可以用Haversine公式代替它，也许会起作用。我查看了 cmeans 函数的源代码，但不知道发生了什么......

我的想法是在下面的metric方法下添加一个Haversine选项，并相应地添加代码。

  `dist <- pmatch(dist, c("euclidean", "manhattan","Haversine"))`

我也尝试过 DBSCAN，但由于我需要固定数量的类似大小的集群，我发现很难实现我的目标。

如果可能，请告诉我。也欢迎任何关于如何执行集群的其他想法，谢谢！

#Fuzzy C Means
fcmeans=function (x, centers, iter.max = 100, verbose = FALSE, dist = "euclidean", 
          method = "cmeans", m = 2, rate.par = NULL, weights = 1, control = list()) 
{
  x <- as.matrix(x)
  xrows <- nrow(x)
  xcols <- ncol(x)
  if (missing(centers)) 
    stop("Argument 'centers' must be a number or a matrix.")
  dist <- pmatch(dist, c("euclidean", "manhattan"))
  if (is.na(dist)) 
    stop("invalid distance")
  if (dist == -1) 
    stop("ambiguous distance")
  method <- pmatch(method, c("cmeans", "ufcl"))
  if (is.na(method)) 
    stop("invalid clustering method")
  if (method == -1) 
    stop("ambiguous clustering method")
  if (length(centers) == 1) {
    ncenters <- centers
    centers <- x[sample(1:xrows, ncenters), , drop = FALSE]
    if (any(duplicated(centers))) {
      cn <- unique(x)
      mm <- nrow(cn)
      if (mm < ncenters) 
        stop("More cluster centers than distinct data points.")
      centers <- cn[sample(1:mm, ncenters), , drop = FALSE]
    }
  }
  else {
    centers <- as.matrix(centers)
    if (any(duplicated(centers))) 
      stop("Initial centers are not distinct.")
    cn <- NULL
    ncenters <- nrow(centers)
    if (xrows < ncenters) 
      stop("More cluster centers than data points.")
  }
  if (xcols != ncol(centers)) 
    stop("Must have same number of columns in 'x' and 'centers'.")
  if (iter.max < 1) 
    stop("Argument 'iter.max' must be positive.")
  if (method == 2) {
    if (missing(rate.par)) {
      rate.par <- 0.3
    }
  }
  reltol <- control$reltol
  if (is.null(reltol)) 
    reltol <- sqrt(.Machine$double.eps)
  if (reltol <= 0) 
    stop("Control parameter 'reltol' must be positive.")
  if (any(weights < 0)) 
    stop("Argument 'weights' has negative elements.")
  if (!any(weights > 0)) 
    stop("Argument 'weights' has no positive elements.")
  weights <- rep(weights, length = xrows)
  weights <- weights/sum(weights)
  perm <- sample(xrows)
  x <- x[perm, ]
  weights <- weights[perm]
  initcenters <- centers
  pos <- as.factor(1:ncenters)
  rownames(centers) <- pos
  if (method == 1) {
    retval <- .C("cmeans", as.double(x), as.integer(xrows), 
                 as.integer(xcols), centers = as.double(centers), 
                 as.integer(ncenters), as.double(weights), as.double(m), 
                 as.integer(dist - 1), as.integer(iter.max), as.double(reltol), 
                 as.integer(verbose), u = double(xrows * ncenters), 
                 ermin = double(1), iter = integer(1), PACKAGE = "e1071")
  }
  else if (method == 2) {
    retval <- .C("ufcl", x = as.double(x), as.integer(xrows), 
                 as.integer(xcols), centers = as.double(centers), 
                 as.integer(ncenters), as.double(weights), as.double(m), 
                 as.integer(dist - 1), as.integer(iter.max), as.double(reltol), 
                 as.integer(verbose), as.double(rate.par), u = double(xrows * 
                                                                        ncenters), ermin = double(1), iter = integer(1), 
                 PACKAGE = "e1071")
  }
  centers <- matrix(retval$centers, ncol = xcols, dimnames = list(1:ncenters, 
                                                                  colnames(initcenters)))
  u <- matrix(retval$u, ncol = ncenters, dimnames = list(rownames(x), 
                                                         1:ncenters))
  u <- u[order(perm), ]
  iter <- retval$iter - 1
  withinerror <- retval$ermin
  cluster <- apply(u, 1, which.max)
  clustersize <- as.integer(table(cluster))
  retval <- list(centers = centers, size = clustersize, cluster = cluster, 
                 membership = u, iter = iter, withinerror = withinerror, 
                 call = match.call())
  class(retval) <- c("fclust")
  return(retval)
}

Answer 1

fuzzy c-means，就像 k-means 一样，依赖 mean 来与您的距离函数保持一致。

即对于经度 +179 和 -179 处的两个点，他们会将平均值置于 0，而不是 +180！这可能导致算法永远不会收敛。

不要对地理数据使用基于均值的算法

如果您的数据是本地数据，您可以投影到 UTM 区域，这提供了非常好的欧几里得近似值。 （这就是这个投影的重点，但它一次只能在一片地球上起作用）

另一种解决方法是使用 3d 空间。

Answer 2

所以，对于初学者来说，这个函数并没有像你想象的那样使用距离。它说的是如何测量点之间的距离，无论是用欧几里德距离（例如，乌鸦飞）还是曼哈顿距离（它坚持笛卡尔平面的网格线）。

这两种方法的问题在于它们计算的距离输入是错误的——而不是平方和或曼哈顿距离测量是错误的。

您可以将更改添加到pmatch(dist, ...，但您还必须更改它调用的代码。如果您使用cmeans（而不是ufcl）作为method 的值，则该函数调用e1071 包中的C 程序cmeans（这就是.C 的内容） .您可以从CRAN 获取软件包的源代码。该程序在任何地方计算与其他物体的距离，您都需要修改它以使用Haversine 公式。至少这包括对ufcl_dissimilarities 的更改。进行这些更改后，您将需要重新编译源代码（来自终端的R CMD build）。

我对数学还不够熟悉，无法完全遵循cmeans.c 程序，但你可能会有更好的运气。

除非您熟悉 C/C++/想要挑战，否则最好使用欧几里德距离，因为知道它计算的点之间的距离是错误的。由于误差随着点的分开而增加，理论上，它不应该对您造成太大伤害，因为您正在尝试放置集群以使它们最小化距离。