Identifying anomalies with AnomalyDetection
Currently the AnomalyDetection package is not availible on CRAN so we have to use install_github() from the devtools package to get it.
install.packages(
"AnomalyDetection",
repos="http://ghrr.github.io/drat",
type="source"
)
library(AnomalyDetection)
library(dplyr)
library(ggplot2)
The package is a little picky about the data it accepts for processing so we have to build a new data frame. It should contain only the date and count variable. Furthermore, date should be named timestamp and transformed to type POSIXct.
page_views <- wp_trend("Syria", from = "2012-01-01")
## .
page_views_br <-
page_views %>%
select(date, count) %>%
rename(timestamp=date) %>%
unclass() %>%
as.data.frame() %>%
mutate(timestamp = as.POSIXct(timestamp))
Having transformed the data we can detect anomalies via AnomalyDetectionTs(). The function offers various options e.g. the significance level for rejecting normal values (alpha); the maximum fraction of the data that is allowed to be detected as anomalies (max_amoms); whether or not upward deviations, downward devaitions or irregularities in both directions might form the basis of anomaly detection (direction) and last but not least whether or not the time frame for detection is larger than one month (lonterm).
Lets choose a greedy set of parameters and detect possible anomalies:
res <-
AnomalyDetectionTs(
x = page_views_br,
alpha = 0.05,
max_anoms = 0.40,
direction = "both",
longterm = T
)$anoms
res$timestamp <- as.Date(res$timestamp)
head(res)
## timestamp anoms
## 1 2012-01-01 4816
## 2 2012-01-07 5533
## 3 2012-01-13 6725
## 4 2012-01-12 8336
## 5 2012-01-11 9301
## 6 2012-01-10 8753
… and play back the detected anomalies to our page_views data set:
page_views <-
page_views %>%
mutate(normal = !(page_views$date %in% res$timestamp)) %>%
mutate(anom = page_views$date %in% res$timestamp )
class(page_views) <- c("wp_df", "data.frame")
Now we can plot counts and anomalies …
(
p <-
ggplot( data=page_views, aes(x=date, y=count) ) +
geom_line(color="steelblue") +
geom_point(data=filter(page_views, anom==T), color="red2", size=2) +
theme_bw()
)
… as well as compare running means:
p +
geom_line(stat = "smooth", size=2, color="red2", alpha=0.7) +
geom_line(data=filter(page_views, anom==F),
stat = "smooth", size=2, color="dodgerblue4", alpha=0.5)
It seems like upward and downward anomalies partial each other out most of the time since both smooth lines (with and without anomalies) do not differ much. Nonetheless, keeping anomalies in will upward bias the counts slightly, so we proceed with a cleaned up data set:
page_views_clean <-
page_views %>%
filter(anom==F) %>%
select(date, count, lang, page, rank, month, title)
page_views_br_clean <-
page_views_br %>%
filter(page_views$anom==F)
Identifying mean shifts with BreakoutDetection
BreakoutDetection is a package that allows to search data for mean level shifts by dividing it into timespans of change and those of stability in the presence of seasonal noise. Similar to AnomalyDetection the BreakoutDetection package is not available on CRAN but has to be obtained from Github.
install.packages(
"BreakoutDetection",
repos="http://ghrr.github.io/drat",
type="source"
)
library(BreakoutDetection)
library(dplyr)
library(ggplot2)
library(magrittr)
… again the workhorse function (breakout()) is picky and requires “a data.frame which has ‘timestamp’ and ‘count’ components” like our page_views_br_clean.
The function has two general options: one tweaks the minimum length of a timespan (min.size); the other one does determine how many mean level changes might occur during the whole time frame (method); and several method specific options, e.g. decree, beta, and percent which control the sensitivity adding further breakpoints. In the following case the last option tells the function that overall model fit should be increased by at least 5 percent if adding a breakpoint.
br <-
breakout(
page_views_br_clean,
min.size = 30,
method = 'multi',
percent = 0.05,
plot = TRUE
)
br
## $loc
## [1] 30 60 138 170 502 532
##
## $time
## [1] 0.7
##
## $pval
## [1] NA
##
## $plot
In the following snippet we combine the break information with our page views data and can have a look at the dates at which the breaks occured.
breaks <- page_views_clean[br$loc,]
breaks
## date count lang page rank month title
## 30 2012-02-14 17177 en Syria 1802 201202 Syria
## 60 2012-03-07 13366 en Syria 1802 201203 Syria
## 138 2012-06-30 8315 en Syria 1802 201206 Syria
## 170 2012-07-27 17383 en Syria 1802 201207 Syria
## 502 2013-08-02 5171 en Syria 1802 201308 Syria
## 532 2013-10-06 5997 en Syria 1802 201310 Syria
Next, we add a span variable capturing which page_view observations belong to which span, allowing us to aggregate data.
page_views_clean$span <- 0
for (d in breaks$date ) {
page_views_clean$span[ page_views_clean$date > d ] %<>% add(1)
}
page_views_clean$mcount <- 0
for (s in unique(page_views_clean$span) ) {
iffer <- page_views_clean$span == s
page_views_clean$mcount[ iffer ] <- mean(page_views_clean$count[iffer])
}
spans <-
page_views_clean %>%
as_data_frame() %>%
group_by(span) %>%
summarize(
start = min(date),
end = max(date),
length = end-start,
mean_count = round(mean(count)),
min_count = min(count),
max_count = max(count),
var_count = var(count)
)
spans
## Source: local data frame [7 x 8]
##
## span start end length mean_count min_count max_count
## 1 0 2012-01-02 2012-02-14 43 11640 5280 36378
## 2 1 2012-02-15 2012-03-07 21 14888 12324 23197
## 3 2 2012-03-08 2012-06-30 114 8834 4222 23467
## 4 3 2012-07-03 2012-07-27 24 13633 6464 31744
## 5 4 2012-07-28 2013-08-02 370 7681 0 20874
## 6 5 2013-08-03 2013-10-06 64 23434 4121 96840
## 7 6 2013-10-08 2015-04-30 569 4916 0 19187
## Variables not shown: var_count (dbl)
Also, we can now plot the shifting mean.
ggplot(page_views_clean, aes(x=date, y=count) ) +
geom_line(alpha=0.5, color="steelblue") +
geom_line(aes(y=mcount), alpha=0.5, color="red2", size=1.2) +
theme_bw()
