Блог

У меня есть временные ряды, и мне нужно найти кластеры значений выше порога и отобразить этот кластер на отдельном графике.

Мой пример кода. К сожалению, я не знаю, как генерировать хорошо кластеризованные значения.

 #generate sample data

Sys.setlocale("LC_ALL","English")

set.seed(8)

Values <- sample(0:100,24241,  replace = T)

Values <- rpois(24241, lambda=60)

start <- as.POSIXct("2012-01-15 06:10:00")
interval <- 15
end <- start   as.difftime(4, units="days")   as.difftime(5, units = "hours")

DateTimes <-  seq(from=start, by=interval, to=end) 

my_data_sample <- tibble(datetime = DateTimes, Value =  Values)

threshold <-  82


ggplot(data = my_data_sample, aes(x = datetime, y = Value))  
  geom_line(size = 1, color = "darkgreen")  
  geom_hline(yintercept=threshold, linetype="dashed", color = "red")  
  theme_bw()   
  labs(
    x= ""    ,
    y = "",
    title = paste("Threshold:", threshold )
    )  
  scale_x_datetime(date_breaks = "8 hour", labels = date_format("%b %d - %H:%M"))  
  theme(axis.text.x = element_text(angle = 25, vjust = 1.0, hjust = 1.0))

 

Вот что мне нужно:

Мне нужно найти кластеры значений выше порога — последовательные или рядом друг с другом, отсортировать эти кластеры, используя длину кластера в секундах (самые длинные кластеры) или сумму значений (самые мощные кластеры), и нанести, скажем, топ-3 из этих периодов времени на отдельные графики.

Есть предложения, как это сделать?

Вы можете найти прогоны, которые соответствуют некоторым ожиданиям, используя кодирование длины выполнения (RLE). На уровне RLE вы можете отфильтровывать слишком короткие прогоны с обеих сторон. Вы можете играть со run_threshold значением, пока оно не совпадет с вашими данными.

 # Put some actual deviating runs in the data
my_data_sample$Value[5001:5100] <- rpois(100, lambda = 80)
my_data_sample$Value[10001:11000] <- rpois(1000, lambda = 80)

threshold <-  82

rle <- rle(my_data_sample$Value > threshold)
# Find sub-threshold values in between super-threshold values,
# convert these to other class
run_threshold <- 20
rle$values[!rle$values amp; rle$lengths < run_threshold] <- TRUE
# Restructure rle
rle <- rle(inverse.rle(rle))

# Find short super-threshold values to filter
run_threshold <- 5
rle$values[rle$values amp; rle$lengths < run_threshold] <- FALSE
rle <- rle(inverse.rle(rle))

# Find run starts and ends
rle_start <- {rle_end <- cumsum(rle$lengths)} - rle$lengths   1

# Format as data.frame for ggplot
rle_df <- data.frame(
  min = my_data_sample$datetime[rle_start],
  max = my_data_sample$datetime[rle_end],
  value = rle$values
)

ggplot(data = my_data_sample, aes(x = datetime, y = Value))  
  geom_line(size = 1, color = "darkgreen")  
  geom_rect(aes(xmin = min, xmax = max, ymin = 0, ymax = 10, fill = value),
            data = rle_df, inherit.aes = FALSE)  
  geom_hline(yintercept=threshold, linetype="dashed", color = "red")  
  theme_bw()   
  labs(
    x= ""    ,
    y = "",
    title = paste("Threshold:", threshold )
  )  
  scale_x_datetime(date_breaks = "8 hour", labels = date_format("%b %d - %H:%M"))  
  theme(axis.text.x = element_text(angle = 25, vjust = 1.0, hjust = 1.0))