如何在向量中找到一个值开始稳定的点

Question

我有以下向量：

wss <- c(23265.2302840678, 4917.06943551649, 1330.49917983449, 288.050702912287, 
216.182464712486, 203.769578557051, 151.991297068931, 139.635571841227, 
118.285305833194, 117.164567420633, 105.397722980407, 95.4682187817563, 
116.448588269066, 88.1287299776581, 83.9345098736843)

如果我们使用以下绘图代码

plot(1:15, wss, type="b", xlab="Number of Clusters",
     ylab="Within groups sum of squares")

我们可以得到这个：

用肉眼我们可以看到在x轴点4处的值变化开始急剧平稳。

我的问题是给定向量wss，如何在不查看图的情况下自动检测索引4。

Answer 1

修改：：效果更好：

#change relative to the maximum change
threshold <- 0.1

d1 <- diff(wss)

# this assumes that the first value is the highest
## you could use max(d1) instead of d1[1]

which.max((d1 / d1[1]) < threshold)  #results in 3

d1 <- diff(wss2)
which.max(d1 / d1[1] < threshold) #results in 5

第二编辑：这有点主观，但是这是我的三种方法对您的两个数据集进行比较的方式。虽然可以很容易地看到平稳状态，但是您需要能够用数学术语描述平稳状态是什么，以使其自动化。

原始：如果您知道二阶导数将从正变为负，则可以执行以下操作：

sec_der <- diff(wss, differences = 2)
inflection_pt <- which.min(sign(sec_der))

inflection_pt

对于此数据集，结果为5，对应于原始数据集结果7（即151.991）。

代替查看拐点，您可以查看一些相对百分比阈值。

thrshold <- 0.06

which.min(sign(abs(diff(wss)) / wss[1:(length(wss)-1)] - thrshold))

使用一阶导数方法也得到5。

无论如何，使用diff()函数都是在基数R中弄清楚这一点的关键部分。另请参见：

Finding the elbow/knee in a curve

创建图形的代码：

wss <- c(23265.2302840678, 4917.06943551649, 1330.49917983449, 288.050702912287, 
         216.182464712486, 203.769578557051, 151.991297068931, 139.635571841227, 
         118.285305833194, 117.164567420633, 105.397722980407, 95.4682187817563, 
         116.448588269066, 88.1287299776581, 83.9345098736843)

wss2 <- c(1970.08410513303, 936.826421218935, 463.151086710784, 310.219800983285, 227.747583214178, 191.601552329558, 159.703151798393, 146.881710048563, 138.699803963718, 134.534334658148)

data_list <- list(wss, wss2)

# Potential_methods -------------------------------------------------------

plateau_method = list(thresh_to_max = function(x) which.max(diff(x) / diff(x)[1] < threshold)
                      , inflection_pt = function(x) which.min(sign(diff(x, differences = 2)))
                      , deriv_to_raw = function(x) which.min(sign(abs(diff(x)) / x[1:(length(x)-1)] - threshold))
)

threshold <- 0.1

results <- t(sapply(plateau_method, mapply, data_list))

# graphing ----------------------------------------------------------------

par(mfrow = c(3,2))

apply(results, 1, function (x) {
  for (i in seq_along(x)) {
    plot(data_list[[i]],ylab="Within groups sum of squares", type = 'b', xlab = 'Number of Clusters')
    abline(v = x[i])
  }
} )

lapply(seq_along(names(plateau_method))
       , function (i) {
         mtext(paste(names(plateau_method)[i]
                     , "- \n"
                     , substring(plateau_method[i], 15))
               , side = 3, line = -18*(i)+15, outer = TRUE)
         })

mtext('Threshold = 0.1', side = 3, line = -53, outer = T)