Как найти точку в векторе, где значение начинает выходить на плато - PullRequest
Новая
       37

Как найти точку в векторе, где значение начинает выходить на плато

1 голос
/ 10 июня 2019

У меня есть следующий вектор: 

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")

, мы можем получить это:

enter image description here

На глаз мы видим, что в точке оси x 4 изменение значения начинает резко изменяться.

Мой вопрос задается вектором wss как мы можем автоматически определить индекс 4, не глядя на график.

1 Ответ

1 голос
/ 10 июня 2019

Редактировать: Это работает лучше: 

#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

Второе редактирование: Это несколько субъективно, но вот как мои три метода сравниваются для ваших двух наборов данных,В то время как легко визуализировать, что такое плато, вы должны уметь в математической терминологии описать, что такое плато, чтобы автоматизировать его.

Plateau Finding Methods

Оригинал: Если вы знаете, что вторая производная будет переворачиваться с положительного на отрицательный, вы можете сделать это: 

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)
...