Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
235 lines (201 sloc) 8.42 KB
---
title: "Chart: Almost 7 million adults have been victims of partner abuse"
author: Matt Ashby
date: '2019-08-26'
slug: partner-abuse
categories: ["Crime and justice chart of the week"]
tags:
- crime
- violence
- domestic abuse
- CSEW
---
```{r set knitr options, include=FALSE}
knitr::opts_chunk$set(cache = TRUE, include=FALSE)
```
```{r set chart parameters}
chart_details <- list(
id = "partner-abuse",
title = "Almost 7 million adults have been victims of partner abuse",
subtitle = "Among the 42 million adults in England and Wales aged between 16 and 74, 1.3 million have been sexually assaulted by a current or former partner, 4.3 million subjected to non-sexual assault and 2.3 million have been stalked. In every category, at least twice as many women as men have been victimised.",
source_url = "https://www.ons.gov.uk/peoplepopulationandcommunity/crimeandjustice/articles/domesticabusefindingsfromthecrimesurveyforenglandandwales/yearendingmarch2018",
source_title = "Crime Survey for England and Wales, 2018"
)
```
```{r load packages and helper}
# custom packages not loaded by helpers.R
library("readxl")
# load this after loading custom packages
source(here::here("helpers.R"))
```
```{r get and tidy data}
if (!file.exists(paste0(chart_details$id, "-data.csv.gz"))) {
# download data
data_file <- tempfile(fileext = ".xlsx")
GET("https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/crimeandjustice/datasets/domesticabusefindingsfromthecrimesurveyforenglandandwalesappendixtables/yearendingmarch2018/domesticabusetablesfinal.xlsx", write_disk(data_file))
# read data
file_data <- read_excel(data_file, sheet = "Table 1", skip = 5)
# tidy data
tidy_data <- file_data %>%
slice(4, 15, 17:18, 30, 39) %>%
select(1:3, 6:7, 10:11, 14:15) %>%
magrittr::set_colnames(c("type", "men - 16 to 59 - since age 16",
"women - 16 to 59 - since age 16",
"men - 60 to 74 - since age 16",
"women - 60 to 74 - since age 16",
"men - 16 to 59 - past year",
"women - 16 to 59 - past year",
"men - 60 to 74 - past year",
"women - 60 to 74 - past year")) %>%
gather("group", "prevalence", -type) %>%
separate(group, c("sex", "age_group", "period"), sep = " - ") %>%
mutate(
prevalence = as.numeric(prevalence) / 100,
type = str_remove(str_remove(type, " by a partner"), "/ex-partner")
)
# save tidy data
write_csv(tidy_data, paste0(chart_details$id, "-data.csv.gz"))
} else {
# load tidy data
tidy_data <- read_csv(paste0(chart_details$id, "-data.csv.gz"))
}
if (!file.exists("pop-age-england-wales-2017-data.csv.gz")) {
# download data
pop_data_file <- tempfile(fileext = ".xls")
GET("https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/populationandmigration/populationestimates/datasets/populationestimatesforukenglandandwalesscotlandandnorthernireland/mid2017/ukmidyearestimates2017finalversion.xls", write_disk(pop_data_file))
# read and tidy data
pop_data <- map_dfr(c("MYE2 - M", "MYE2 - F"), function (x) {
read_excel(pop_data_file, sheet = x, skip = 4) %>%
slice(3) %>%
select(5:95) %>%
gather("age", "population") %>%
mutate(sex = str_sub(x, -1))
}) %>%
mutate(
age = as.numeric(age),
population = as.numeric(population),
sex = fct_recode(sex, "women" = "F", "men" = "M")
)
# save data
write_csv(pop_data, "pop-age-england-wales-2017-data.csv.gz")
} else {
# load tidy data
pop_data <- read_csv("pop-age-england-wales-2017-data.csv.gz")
}
```
```{r prepare data for chart}
# group population data by age to match prevalence data
pop_data <- pop_data %>%
mutate(age_group = case_when(
between(age, 16, 59) ~ "16 to 59",
between(age, 60, 74) ~ "60 to 74",
TRUE ~ "other"
)) %>%
group_by(age_group, sex) %>%
summarise(population = sum(population))
chart_data <- tidy_data %>%
left_join(pop_data, by = c("age_group", "sex")) %>%
mutate(
period = fct_rev(period),
type = fct_collapse(
str_to_lower(type),
"any type" = "any partner abuse (non-physical abuse, threats, force, sexual assault or stalking)",
"non-physical abuse" = "non-physical abuse (emotional, financial)",
"non-sexual assault" = "force",
"sexual assault" = "any sexual assault (including attempts)"
),
type = fct_rev(fct_relevel(type, "any type", "non-physical abuse",
"threats", "non-sexual assault",
"sexual assault")),
victims = round(population * prevalence)
) %>%
filter(period == "since age 16") %>%
group_by(type, sex) %>%
summarise(victims = sum(victims))
# add chart labels
chart_labels <- tribble(
~x, ~y, ~xend, ~yend, ~sex, ~label, ~hjust, ~vjust, ~curve,
4.8, 1.8e6, "threats", 2.4e6, "men", balance_lines("includes emotional abuse or financial coercive control", 2), "left", "center", "right",
2, 0.8e6, "sexual assault", 1.2e6, "men", balance_lines("includes rape, assault by penetration and indecent exposure", 2), "left", "center", "right",
5.4, 4.9e6, "threats", 4.75e6, "women", balance_lines("almost 5 million women have been victims of partner abuse", 3), "right", "top", "left"
)
```
```{r build plot}
chart <- ggplot(chart_data, aes(x = type, y = victims, fill = sex,
label = type)) +
geom_col(width = 0.8) +
geom_label(aes(colour = sex), data = filter(chart_data, sex == "men"),
hjust = 0, nudge_y = 20000, size = elements$label_text_size,
lineheight = elements$label_text_lineheight,
fill = "white", label.size = NA) +
geom_text(data = filter(chart_data, sex == "women"), hjust = 1,
nudge_y = -20000, size = elements$label_text_size,
lineheight = elements$label_text_lineheight, colour = "white") +
# add explanatory labels
geom_curve(aes(x = x, y = y, xend = xend, yend = yend),
data = filter(chart_labels, curve == "right"), inherit.aes = FALSE,
curvature = elements$label_line_curvature,
colour = elements$label_line_colour,
arrow = elements$label_arrow, show.legend = FALSE) +
geom_segment(aes(x = x, y = y, xend = xend, yend = yend),
data = filter(chart_labels, curve == "straight"),
inherit.aes = FALSE, colour = elements$label_line_colour,
arrow = elements$label_arrow, show.legend = FALSE) +
geom_curve(aes(x = x, y = y, xend = xend, yend = yend),
data = filter(chart_labels, curve == "left"), inherit.aes = FALSE,
curvature = elements$label_line_curvature * -1,
colour = elements$label_line_colour,
arrow = elements$label_arrow, show.legend = FALSE) +
geom_label(aes(x = xend, y = yend, label = label, hjust = hjust,
vjust = vjust),
data = chart_labels, inherit.aes = FALSE,
colour = elements$label_text_colour,
fill = elements$label_text_fill, size = elements$label_text_size,
lineheight = elements$label_text_lineheight,
label.size = NA, show.legend = FALSE) +
# end of explanatory labels
scale_y_continuous(
expand = expand_scale(mult = c(0, 0.02)),
labels = scales::number_format(scale = 1/1e6, suffix = "m")
) +
scale_fill_manual(
values = unname(ucl_colours_list[c("Orange", "Light Blue")])
) +
coord_flip() +
facet_grid(rows = vars(sex), switch = "y") +
labs(
title = chart_details$title,
subtitle = format_subtitle(chart_details$subtitle),
legend = NULL,
x = NULL,
y = "adults in England and Wales who have been a victim since age 16"
) +
theme_cjcharts() +
theme(
axis.line.y = element_line(colour = elements$reference_line_colour),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
legend.position = "none",
panel.grid.major.x = element_line(colour = "grey92"),
panel.grid.minor.x = element_line(colour = "grey92"),
panel.grid.major.y = element_blank(),
strip.placement = "outside",
strip.text.y = element_text(angle = 270, hjust = 0.5)
)
```
`r chart_details$subtitle`
```{r display plot, echo=FALSE, include=TRUE}
add_logo(chart + labs(title = NULL, subtitle = NULL),
chart_details$source_title, chart_details$id)
```
[larger image](../`r chart_details$id`.png)
| [annotated R code to produce this chart](https://github.com/mpjashby/lesscrime.info/blob/master/content/post/`r chart_details$id`.Rmd)
Data source: [`r chart_details$source_title`](`r chart_details$source_url`)
```{r export chart}
# save PNG for social media
ggsave(
filename = paste0(chart_details$id, ".png"),
plot = add_logo(chart, chart_details$source_title, chart_details$id),
device = "png", width = 600 / 72, height = 400 / 72, units = "in"
)
```
You can’t perform that action at this time.