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

How to find a point in a vector where the value begin to plateau

我有以下向量:

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

编辑: 这样效果更好:

#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() 函数将是在 base 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)