Я предполагаю, что вам дан вектор наблюдений длины len, как те, что изображены в вашем примере, и вы хотите определить k скачков и k размеров скачков.(Или, может быть, я вас неправильно понял, но вы на самом деле не сказали, чего хотите достичь.) Ниже я нарисую решение, используя Local Search.Я начну с данных вашего примера:
x <- seq(0, 10, by = 0.01)
y <- staircase(x,
c(1,2,2,5),
c(2,5,2,1)) + rnorm(length(x), mean = 0, sd = 0.2)
Решением является список позиций и размеров прыжков.Обратите внимание, что я использую векторы для хранения этих данных, так как определение переменных становится громоздким, скажем, при 20 скачках.
Пример (случайное) решение:
k <- 5 ## number of jumps
len <- length(x)
sol <- list(position = sample(len, size = k),
size = runif(k))
## $position
## [1] 89 236 859 885 730
##
## $size
## [1] 0.2377453 0.2108495 0.3404345 0.4626004 0.6944078
Нам нужноцелевая функция для расчета качества решения.Я также определяю простую вспомогательную функцию stairs, которая используется целевой функцией.Целевая функция abs_diff вычисляет среднюю абсолютную разницу между подобранными рядами (как определено решением) и y.
stairs <- function(len, position, size) {
ans <- numeric(len)
ans[position] <- size
cumsum(ans)
}
abs_diff <- function(sol, y, stairs, ...) {
yy <- stairs(length(y), sol$position, sol$size)
sum(abs(y - yy))/length(y)
}
Теперь идет ключевой компонент для локального поиска: функция соседства, котораяиспользуется для развития решения.Функция соседства принимает решение и слегка его меняет.Здесь он либо выберет позицию или размер и немного его изменит.
neighbour <- function(sol, len, ...) {
p <- sol$position
s <- sol$size
if (runif(1) > 0.5) {
## either move one of the positions ...
i <- sample.int(length(p), size = 1)
p[i] <- p[i] + sample(-25:25, size = 1)
p[i] <- min(max(1, p[i]), len)
} else {
## ... or change a jump size
i <- sample.int(length(s), size = 1)
s[i] <- s[i] + runif(1, min = -s[i], max = 1)
}
list(position = p, size = s)
}
Пример вызова: здесь новое решение имеет свой первый размер прыжкаизменено.
## > sol
## $position
## [1] 89 236 859 885 730
##
## $size
## [1] 0.2377453 0.2108495 0.3404345 0.4626004 0.6944078
##
## > neighbour(sol, len)
## $position
## [1] 89 236 859 885 730
##
## $size
## [1] 0.2127044 0.2108495 0.3404345 0.4626004 0.6944078
Мне осталось запустить локальный поиск.
library("NMOF")
sol.ls <- LSopt(abs_diff,
list(x0 = sol, nI = 50000, neighbour = neighbour),
stairs = stairs,
len = len,
y = y)
Мы можем построить решение: выделенная линия показана синим.
plot(x, y)
lines(x, stairs(len, sol.ls$xbest$position, sol.ls$xbest$size),
col = "blue", type = "S")
