Amendments to GOV.UK statistics publications
Duncan Garmonsway
January 15, 2019
Introduction
The Reproducible Analytical Pipeline (RAP) is an alternative production methodology for automating the bulk of steps involved in creating a statistical report.
One motivation to use RAP methods is to avoid making trivial mistakes, by removing as much opportunity for human error as possible. For example, the following note describes a trivial amendment that could have been avoided by programming a computer to update the date of the quarterly publication.
The date for the publication … was incorrectly stated as 14 February 2019, this has now been corrected to 21 February 2019 which is in line with the release calendar and established practice to publish on the third Thursday of the month.
This article investigates.
- How common amendments are
- Whether they are becoming more or less common
- Why amendments are made The code is on GitHub
# Extract the change history of each report
empty_changes <- tibble(public_timestamp = character(),
note = character())
chuck_changes <-
function(.x) {
out <- purrr::chuck(.x, "details", "change_history") # purrr::chuck() not on CRAN
if (is.null(out)) {
stop("null!") # change_history can be present yet NULL
}
out
}
possibly_pluck_changes <- possibly(chuck_changes, otherwise = empty_changes)
chuck_organisation <-
function(.x) {
out <- purrr::chuck(.x, # purrr::chuck() not on CRAN
"links",
"primary_publishing_organisation",
"title")
if (is.null(out)) {
stop("null!") # element can be present yet NULL
}
out
}
possibly_pluck_organisation <-
possibly(chuck_organisation, otherwise = NA_character_)
changes <-
reports %>%
mutate(organisation = map_chr(reports, possibly_pluck_organisation),
organisation = str_trim(organisation),
changes = map(reports, possibly_pluck_changes)) %>%
select(-reports) %>%
unnest() %>%
mutate(public_timestamp = parse_datetime(public_timestamp),
month = floor_date(public_timestamp, "month"),
year = floor_date(public_timestamp, "year"),
is_first_publication = note == "First published.")
no_changes <- anti_join(reports, changes, by = "base_path")Detection of amendments
Updates are regarded as ‘amendments’ when they contain a word from a list. The list of words was compiled in discussion with colleagues and by referring to a thesaurus. Some words were discarded because there were many false positives.
error_vocab <-
c(
"aberration",
"amend", # keep but omit "Updated to reflect amendments made to existing licences since previous publication"
"blunder",
"correct", # keep
"deviation",
"erratum", # keep
"error", # keep
"falsehood",
"fix", # keep
"flaw",
"glitch",
"inaccuracy", # keep
"inadvertent", # keep
"lapse",
"misapplication",
"misapprehension",
"miscalculation",
"misconception",
"misinterpretation", # keep
"misjudgment",
"misprint",
"misstatement",
"misstep",
"mistake", # keep
"misunderstanding",
"omission", # keep
"overestimation",
"oversight",
"rectify", # keep
"remedy",
"wrong" # keep
# "alter", # discard: conflicts with 'alternative'
# "change", # discard: inconsistent, often not necessary
# "confusion", # discard
# "failure", # discard: crops up in fire statistics
# "fault", # discard
# "repair", # discard: inconsistent
# "revise", # discard: often improvements not corrections
)
error_regex <- paste0("(", paste0(error_vocab, collapse = ")|("), ")")
error_patterns <- map(error_vocab, fixed, ignore_case = TRUE)
count_term <-
function(strings, pattern) {
sum(stringr::str_detect(strings, pattern))
}
count_matches <-
function(.data, col, ...) {
strings <- dplyr::pull(.data, !! rlang::enquo(col))
patterns <- rlang::flatten(rlang::list2(...))
counts <- purrr::map_int(patterns,
count_term,
strings = strings)
tibble(pattern = purrr::flatten_chr(patterns),
n = counts)
}The number of notes that matched each word in the vocabulary
count_matches(changes, note, error_patterns) %>%
arrange(desc(n), pattern) %>%
print(n = Inf)## # A tibble: 31 x 2
## pattern n
## <chr> <int>
## 1 correct 395
## 2 amend 385
## 3 error 189
## 4 erratum 16
## 5 fix 11
## 6 mistake 4
## 7 omission 4
## 8 wrong 4
## 9 inadvertent 3
## 10 inaccuracy 1
## 11 misinterpretation 1
## 12 rectify 1
## 13 aberration 0
## 14 blunder 0
## 15 deviation 0
## 16 falsehood 0
## 17 flaw 0
## 18 glitch 0
## 19 lapse 0
## 20 misapplication 0
## 21 misapprehension 0
## 22 miscalculation 0
## 23 misconception 0
## 24 misjudgment 0
## 25 misprint 0
## 26 misstatement 0
## 27 misstep 0
## 28 misunderstanding 0
## 29 overestimation 0
## 30 oversight 0
## 31 remedy 0Searchable table of all notes
changes %>%
dplyr::filter(!str_detect(note,
"Updated to reflect amendments made to existing licences since previous publication")) %>%
select(note) %>%
datatable()changes <-
changes %>%
mutate(is_amendment = str_detect(note,
regex(error_regex,
ignore_case = TRUE)),
is_amendment = is_amendment & !str_detect(note, "Updated to reflect amendments made to existing licences since previous publication"))How common are changes (not just amendments)?
Many first publications were backdated. The date of the first change is a reasonable estimate for the date that GOV.UK first published statistics
first_change_date <-
changes %>%
dplyr::filter(!is_first_publication) %>%
pull(public_timestamp) %>%
min()Changes per month
changes %>%
dplyr::filter(public_timestamp >= first_change_date,
month < max(month)) %>% # drop the latest (incomplete) month
count(month, is_first_publication) %>%
ggplot(aes(month, n, colour = is_first_publication)) +
geom_line() +
scale_colour_discrete(name = "First publication") +
xlab("") +
ylab("Number of new publications or changes") +
ggtitle("Number of new publications and changes per month")
Changes per year
changes %>%
dplyr::filter(public_timestamp >= first_change_date,
year < max(year)) %>% # drop the latest (incomplete) year
count(year, is_first_publication) %>%
ggplot(aes(year, n, colour = is_first_publication)) +
geom_line() +
scale_colour_discrete(name = "First publication") +
xlab("") +
ylab("Number of new publications or changes") +
ggtitle("Number of new publications and changes per year")
How common are amendments?
The most that can be said is that “amendments happen”. The number of amendments detected is in fact quite low (about 2% of all changes), and that could be because:
- There aren’t many amendments to be detected
- Some amendments are silently fixed in a subsequent update
- The method of detecting amendments isn’t sensitive enough
On the other hand, RAP won’t necessarily reduce the number of amendments – in fact it might increase it by having greater power to detect mistakes through peer review. Errors are likely to be noticed when RAP is first applied.
amendments <- dplyr::filter(changes, is_amendment)Amendments per month
amendments %>%
dplyr::filter(public_timestamp >= first_change_date,
month < max(month)) %>% # drop the latest (incomplete) month
count(month) %>%
ggplot(aes(month, n)) +
geom_line() +
xlab("") +
ylab("Number of amendments") +
ggtitle("Number of amendments per month")
Amendments per year
amendments %>%
dplyr::filter(public_timestamp >= first_change_date,
year < max(year)) %>% # drop the latest (incomplete) year
count(year) %>%
ggplot(aes(year, n)) +
geom_line() +
xlab("") +
ylab("Number of amendments") +
ggtitle("Number of amendments per year")
Amendments as percentage of all changes per month
changes %>%
dplyr::filter(public_timestamp >= first_change_date,
month < max(month)) %>% # drop the latest (incomplete) month
count(month, is_amendment) %>%
spread(is_amendment, n, fill = 0L) %>%
mutate(amendment_prop = `TRUE` / (`TRUE` + `FALSE`)) %>%
ggplot(aes(month, amendment_prop)) +
geom_line() +
scale_y_continuous(labels = scales::percent) +
xlab("") +
ylab("") +
ggtitle("Amendments as a percentage of all changes (monthly)")
#’ ### Amendments as percentage of all changes per year
changes %>%
dplyr::filter(public_timestamp >= first_change_date,
year < max(year)) %>% # drop the latest (incomplete) year
count(year, is_amendment) %>%
spread(is_amendment, n, fill = 0L) %>%
mutate(amendment_prop = `TRUE` / (`TRUE` + `FALSE`)) %>%
ggplot(aes(year, amendment_prop)) +
geom_line() +
scale_y_continuous(labels = scales::percent) +
xlab("") +
ylab("") +
ggtitle("Amendments as a percentage of all changes (annual)")
Distribution of rates per organisation in the last complete year
The graph shows for each organisation:
- (Left) The total number of changes, including amendments
- (Right, ticks) The percentage of changes that were amendments
- (Right, lines) The 95% credible interval of the Empirical Bayes estimate of the rate. Longer lines show greater uncertainty about the true rate when an organisation has few publications.
Most organisations have made no amendments. Some of those haven’t published much, but a few have published a lot. Few organisations have a credible interval entirely above a 5% amendment rate.
The Empirical Bayes model was fitted with a beta-binomial prior fitted to the data by maximum likelihood estimation; see ?ebbr::ebb_fit_prior for details.
bayes_rates <-
changes %>%
dplyr::filter(public_timestamp >= first_change_date,
year == max(year) - years(1L)) %>% # drop the latest (incomplete) year
count(year, organisation, is_amendment) %>%
spread(is_amendment, n, fill = 0L) %>%
mutate(total = `TRUE` + `FALSE`,
amendments = `TRUE`) %>%
select(-`TRUE`, -`FALSE`) %>%
add_ebb_estimate(amendments, total) %>%
dplyr::filter(!is.na(organisation)) %>%
# mutate(organisation = fct_reorder2(organisation, .high, .low))
# mutate(organisation = fct_reorder2(organisation, .low, total))
mutate(organisation = fct_reorder(organisation, (total)))
p_count <-
bayes_rates %>%
ggplot(aes(organisation)) +
geom_segment(aes(xend = organisation, y = 0, yend = total)) +
scale_y_reverse(position = "right") +
ggtitle("Number of changes published per organisation") +
coord_flip() +
xlab("") +
ylab("") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank())
p_prop <-
bayes_rates %>%
ggplot(aes(organisation)) +
geom_point(aes(y = amendments / total), colour = "black", shape = 3) +
geom_segment(aes(xend = organisation, y = .low, yend = .high)) +
scale_y_continuous(labels = scales::percent,
limits = c(0, NA),
position = "right") +
ggtitle("Actual and estimated amendment rate per organisation",
subtitle = "Ticks: true percentage of amendments\nLines: 95% credible interval of the percentage of amendments") +
coord_flip() +
xlab("") +
ylab("") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank())
p_count + p_prop + plot_layout(nrow = 1)
Why are amendments made?
changes %>%
dplyr::filter(is_amendment) %>%
arrange(desc(public_timestamp)) %>%
mutate(date = strftime(public_timestamp, "%Y-%m-%d"),
publication = paste0("https://www.gov.uk", base_path)) %>%
select(publication,
organisation,
date,
note) %>%
datatable()What other changes are made?
changes %>%
dplyr::filter(!is_amendment) %>%
arrange(desc(public_timestamp)) %>%
mutate(date = strftime(public_timestamp, "%Y-%m-%d"),
publication = paste0("https://www.gov.uk", base_path)) %>%
select(publication,
organisation,
date,
note) %>%
datatable()Session info
devtools::session_info()## ─ Session info ──────────────────────────────────────────────────────────
## setting value
## version R version 3.5.2 (2018-12-20)
## os Arch Linux
## system x86_64, linux-gnu
## ui X11
## language
## collate en_NZ.UTF-8
## ctype en_GB.UTF-8
## tz Europe/London
## date 2019-01-17
##
## ─ Packages ──────────────────────────────────────────────────────────────
## package * version date lib
## assertthat 0.2.0 2017-04-11 [1]
## backports 1.1.3 2018-12-14 [1]
## bindr 0.1.1 2018-03-13 [1]
## bindrcpp * 0.2.2 2018-03-29 [1]
## broom 0.5.1 2018-12-05 [1]
## callr 3.1.0 2018-12-10 [1]
## cellranger 1.1.0 2016-07-27 [1]
## cli 1.0.1 2018-09-25 [1]
## codetools 0.2-15 2016-10-05 [2]
## colorout * 1.2-0 2018-04-27 [1]
## colorspace 1.3-2 2016-12-14 [1]
## crayon 1.3.4 2017-09-16 [1]
## crosstalk 1.0.0 2016-12-21 [1]
## desc 1.2.0 2018-05-01 [1]
## devtools * 2.0.1.9000 2018-11-23 [1]
## digest 0.6.18 2018-10-10 [1]
## dplyr * 0.7.8 2018-11-10 [1]
## DT * 0.5 2018-11-05 [1]
## ebbr * 0.1 2019-01-11 [1]
## evaluate 0.12 2018-10-09 [1]
## fansi 0.4.0 2018-11-09 [1]
## forcats * 0.3.0 2018-02-19 [1]
## fs 1.2.5 2018-07-30 [1]
## generics 0.0.2 2018-11-29 [1]
## ggplot2 * 3.1.0 2018-10-25 [1]
## glue 1.3.0.9000 2019-01-08 [1]
## gtable 0.2.0 2016-02-26 [1]
## haven 1.1.1 2018-01-18 [1]
## here * 0.1 2017-05-28 [1]
## highr 0.7 2018-06-09 [1]
## hms 0.4.2.9001 2018-11-16 [1]
## htmltools 0.3.6 2017-04-28 [1]
## htmlwidgets 1.3 2018-09-30 [1]
## httpuv 1.4.3 2018-05-10 [1]
## httr 1.4.0 2018-12-11 [1]
## jsonlite 1.6 2018-12-07 [1]
## knitr 1.21 2018-12-10 [1]
## labeling 0.3 2014-08-23 [1]
## later 0.7.3.9000 2018-09-12 [1]
## lattice 0.20-38 2018-11-04 [2]
## lazyeval 0.2.1 2017-10-29 [1]
## lubridate * 1.7.4 2018-04-11 [1]
## magrittr 1.5 2014-11-22 [1]
## memoise 1.1.0 2017-04-21 [1]
## mime 0.6 2018-10-05 [1]
## modelr 0.1.1 2017-07-24 [1]
## munsell 0.5.0 2018-06-12 [1]
## nlme 3.1-137 2018-04-07 [2]
## nvimcom * 0.9-75 2019-01-03 [1]
## patchwork * 0.0.1 2018-06-20 [1]
## pillar 1.3.1.9000 2019-01-11 [1]
## pkgbuild 1.0.2 2018-10-16 [1]
## pkgconfig 2.0.2 2018-08-16 [1]
## pkgload 1.0.2 2018-10-29 [1]
## plyr 1.8.4 2016-06-08 [1]
## prettyunits 1.0.2 2015-07-13 [1]
## processx 3.2.1 2018-12-05 [1]
## promises 1.0.1 2018-04-13 [1]
## ps 1.2.1 2018-11-06 [1]
## purrr * 0.2.99.9000 2019-01-11 [1]
## R6 2.3.0 2018-10-04 [1]
## Rcpp 1.0.0 2018-11-07 [1]
## readr * 1.2.1.9000 2018-11-30 [1]
## readxl 1.1.0.9000 2018-12-14 [1]
## remotes 2.0.1 2018-10-19 [1]
## rlang 0.3.1 2019-01-08 [1]
## rmarkdown * 1.11 2018-12-08 [1]
## rprojroot 1.3-2 2018-01-03 [1]
## rstudioapi 0.8 2018-10-02 [1]
## rvest 0.3.2 2016-06-17 [1]
## scales 1.0.0 2018-08-09 [1]
## sessioninfo 1.1.1 2018-11-05 [1]
## shiny 1.1.0 2018-05-17 [1]
## stringi 1.2.4 2018-07-20 [1]
## stringr * 1.3.1 2018-05-10 [1]
## testthat 2.0.0 2017-12-13 [1]
## tibble * 2.0.0.9000 2019-01-11 [1]
## tidyr * 0.8.2 2018-10-28 [1]
## tidyselect 0.2.5 2018-10-11 [1]
## tidyverse * 1.2.1 2017-11-14 [1]
## usethis * 1.4.0 2018-08-14 [1]
## utf8 1.1.4 2018-05-24 [1]
## VGAM 1.0-6 2018-08-18 [1]
## withr 2.1.2 2018-03-15 [1]
## xfun 0.4 2018-10-23 [1]
## xml2 1.2.0 2018-01-24 [1]
## xtable 1.8-2 2016-02-05 [1]
## yaml 2.2.0 2018-07-25 [1]
## source
## CRAN (R 3.5.0)
## CRAN (R 3.5.2)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.2)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## Github (jalvesaq/colorout@c42088d)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## Github (r-lib/devtools@55f982c)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## Github (dgrtwo/ebbr@4b9747d)
## CRAN (R 3.5.1)
## Github (brodieG/fansi@ab11e9c)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## CRAN (R 3.5.1)
## Github (tidyverse/glue@3f7012c)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## Github (tidyverse/hms@979286f)
## CRAN (R 3.5.0)
## CRAN (R 3.5.2)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## Github (r-lib/later@b87fa73)
## CRAN (R 3.5.2)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## local
## Github (thomasp85/patchwork@1d3eccb)
## Github (r-lib/pillar@9cc3030)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## Github (tidyverse/purrr@57dd213)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## Github (tidyverse/readr@d52a177)
## Github (tidyverse/readxl@90b6658)
## CRAN (R 3.5.1)
## CRAN (R 3.5.2)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## Github (tidyverse/tibble@df59721)
## CRAN (R 3.5.1)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.2)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
## CRAN (R 3.5.0)
## CRAN (R 3.5.0)
## CRAN (R 3.5.1)
##
## [1] /home/nacnudus/R/x86_64-pc-linux-gnu-library/3.5
## [2] /usr/lib/R/library