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)
##
## Attaching package: 'dplyr'
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
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 = "2010-01-01")
## http://stats.grok.se/json/en/201505/Syria
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 2010-02-02 5567
## 2 2010-02-04 5191
## 3 2010-01-23 0
## 4 2010-02-03 4322
## 5 2010-02-01 3918
## 6 2010-02-08 0
… 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] 53 105 137 174 263 306 389 426 458 488 518 566 601 640 670 751 784
##
## $time
## [1] 1.79
##
## $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
## 53 2010-02-13 3327 en Syria 1802 201002 Syria
## 105 2010-04-08 5210 en Syria 1802 201004 Syria
## 137 2010-06-03 5176 en Syria 1802 201006 Syria
## 174 2010-07-14 3874 en Syria 1802 201007 Syria
## 263 2010-11-22 6090 en Syria 1802 201011 Syria
## 306 2010-12-05 6182 en Syria 1802 201012 Syria
## 389 2011-04-15 6113 en Syria 1802 201104 Syria
## 426 2011-05-12 8217 en Syria 1802 201105 Syria
## 458 2011-06-07 9442 en Syria 1802 201106 Syria
## 488 2011-07-04 4745 en Syria 1802 201107 Syria
## 518 2011-08-07 7506 en Syria 1802 201108 Syria
## 566 2011-10-22 7449 en Syria 1802 201110 Syria
## 601 2011-11-27 8492 en Syria 1802 201111 Syria
## 640 2012-01-31 11496 en Syria 1802 201201 Syria
## 670 2012-02-22 23197 en Syria 1802 201202 Syria
## 751 2012-06-04 9461 en Syria 1802 201206 Syria
## 784 2012-07-27 17383 en Syria 1802 201207 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 [18 x 8]
##
## span start end length mean_count min_count max_count
## 1 0 2010-01-01 2010-02-13 43 3662 0 4734
## 2 1 2010-02-14 2010-04-08 53 4768 0 8179
## 3 2 2010-04-10 2010-06-03 54 4900 3849 5741
## 4 3 2010-06-04 2010-07-14 40 3454 0 5270
## 5 4 2010-07-20 2010-11-22 125 5760 4172 8711
## 6 5 2010-11-24 2010-12-05 11 5488 4752 6182
## 7 6 2010-12-06 2011-04-15 130 7158 3725 22825
## 8 7 2011-04-16 2011-05-12 26 10075 6713 19661
## 9 8 2011-05-13 2011-06-07 25 6374 3672 9442
## 10 9 2011-06-08 2011-07-04 26 7135 4194 11989
## 11 10 2011-07-05 2011-08-07 33 4940 3395 9729
## 12 11 2011-08-08 2011-10-22 75 5729 3510 12574
## 13 12 2011-10-24 2011-11-27 34 8060 5195 13217
## 14 13 2011-11-28 2012-01-31 64 6479 0 11496
## 15 14 2012-02-01 2012-02-22 21 18015 7005 36378
## 16 15 2012-02-23 2012-06-04 102 9042 0 24728
## 17 16 2012-06-05 2012-07-27 52 12042 6464 25414
## 18 17 2012-07-28 2015-05-31 1037 7287 0 111331
## 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()
