首页 > 解决方案 > 如何在向量中找到值开始平稳的点

问题描述

我有以下向量:

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不查看绘图的情况下自动检测索引。

标签: rnumeric

解决方案


编辑:这效果更好:

#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 中解决此问题的关键部分。另请参阅:

在曲线中找到肘部/膝盖

创建图表的代码:

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)

推荐阅读