library(stringi)
library(rvest)
library(hrbrthemes)
library(tidyverse)
article <- read_html("https://theconversation.com/the-epa-has-backed-off-enforcement-under-trump-here-are-the-numbers-108640")
html_node(article, "iframe#psm7n") %>% # find the iframe
html_attr("src") %>% # get iframe URL
read_html() %>% # read it in
html_node(xpath=".//script[contains(., 'data: ')]") %>% # find the javascript section with the data
html_text() %>% # get that section
stri_split_lines() %>% # split into lines so we can target the actual data element
unlist() %>%
keep(stri_detect_fixed, 'data: "Fiscal') %>% # just get the data line
stri_trim_both() %>% # prep it for extraction
stri_replace_first_fixed('data: "', "") %>%
stri_replace_last_fixed('"', "") %>%
stri_replace_all_fixed("\\n", "\n") %>% # make lines lines
stri_split_lines() %>%
unlist() %>%
stri_split_fixed("\\t") %>% # we now have a list of vectors
map_dfc(~set_names(list(.x[2:length(.x)]), .x[1])) %>% # first element of each vector is colname
type_convert(col_types = "cddn") %>% # get real types
set_names(c("act", "y2018", "y2017", "pct")) -> psm
psm
## # A tibble: 8 x 4
## act y2018 y2017 pct
## <chr> <dbl> <dbl> <dbl>
## 1 CAA 199 405 -51
## 2 CERCLA 147 194 -24
## 3 CWA 320 565 -43
## 4 EPCRA 56 107 -48
## 5 FIFRA 363 910 -60
## 6 RCRA 149 275 -46
## 7 SDWA 121 178 -32
## 8 TSCA 80 152 -47
## # A tibble: 8 x 4
## act y2018 y2017 pct
## <chr> <dbl> <dbl> <dbl>
## 1 CAA 199 405 -51
## 2 CERCLA 147 194 -24
## 3 CWA 320 565 -43
## 4 EPCRA 56 107 -48
## 5 FIFRA 363 910 -60
## 6 RCRA 149 275 -46
## 7 SDWA 121 178 -32
## 8 TSCA 80 152 -47
psm %>%
arrange(desc(y2017)) %>%
mutate(act = factor(act, levels = rev(act))) -> psm
# setup x axis breaks and max value for label position computation
x_breaks <- pretty(c(psm$y2018, psm$y2017))
max_val <- max(x_breaks)
# act info for caption
c(
"CAA" = "Clean Air Act (CAA)",
"CWA" = "Clean Water Act (CWA)",
"EPCRA" = "Emergency Planning and Community Right to Know Act (EPCRA)",
"FIFRA" = "Federal Insecticide, Fungicide, and Rodenticide Act (FIFRA)",
"RCRA" = "Resource Conservation and Recovery Act (RCRA)",
"SDWA" = "Safe Drinking Water Act (SDWA)",
"TSCA" = "Toxic Substances Control Act (TSCA)",
"CERCLA" = "Comprehensive Environmental Response, Compensation, and Liability Act (CERCLA)"
) -> acts
w125 <- scales::wrap_format(125)
act_info <- w125(paste0(unname(acts[as.character(psm$act)]), collapse = "; "))
ggplot(psm) +
# dots from 0 to minval
geom_segment(
aes(0, act, xend = y2018, yend = act),
linetype = "dotted", color = "#b2b2b2", size = 0.33
) +
# minval label
geom_label(
aes(y2018, act, label = y2018),
label.size = 0, hjust = 1, size = 3.5, family = font_rc
) +
# maxval label
geom_label(
aes(y2017 + (0.0015 * y2017), act, label = y2017),
label.size = 0, hjust = 0, size = 3.5, family = font_rc
) +
# the measure line+arrow
geom_segment(
aes(y2018, act, xend = y2017, yend = act),
color = "#4a90e2", size = 0.75,
arrow = arrow(ends = "first", length = unit(5, "pt"))
) +
# top of chart year (min)
geom_label(
data = head(psm, 1),
aes(y2018, 9, label = "2018"),
hjust = 0, vjust = 1, label.size = 0, size = 3.75, family = font_rc, color = ft_cols$slate
) +
# top of chart year (max)
geom_label(
data = head(psm, 1),
aes(y2017, 9, label = "2017"),
hjust = 1, vjust = 1, label.size = 0, size = 3.75, family = font_rc, color = ft_cols$slate
) +
# bar from top of chart year label to first minval measure
geom_segment(
data = head(psm, 1),
aes(
y2018 + (0.005 * max_val), 8.5,
xend = y2018 + (0.005 * max_val), yend = 8.25
),
size = 0.25
) +
# bar from top of chart year label to first maxval measure
geom_segment(
data = head(psm, 1),
aes(
y2017 - (0.005 * max_val), 8.5,
xend = y2017 - (0.005 * max_val), yend = 8.25
),
size = 0.25
) +
# fix x axis scale and place breaks
scale_x_comma(limits = c(0, max_val), breaks = seq(0, max_val, 200)) +
scale_y_discrete(expand = c(0, 1)) +
labs(
y = NULL,
title = "Decline by statute",
subtitle = "The number of civil cases the EPA brought to conclusion has dropped across a number of federal statutes,\nincluding the Clean Air Act (CAA) and others.",
x = act_info,
caption = "Original Chart/Data: The Conversation, CC-BY-ND;<https://bit.ly/2VuJrOT>; Source: Environmental Data & Government Initiative <https://bit.ly/2VpcFyl>"
) +
theme_ipsum_rc(grid = "X") +
theme(axis.text.x = element_text(color = ft_cols$slate)) +
theme(axis.title.x = element_text(
hjust = 0, size = 10, face = "italic", color = ft_cols$gray, margin = margin(t = 10)
)) +
theme(plot.caption = element_text(hjust = 0))
devtools::session_info()
## ─ Session info ──────────────────────────────────────────────────────────
## setting value
## version R version 3.5.2 RC (2018-12-17 r75868)
## os macOS Mojave 10.14.3
## system x86_64, darwin15.6.0
## ui RStudio
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz America/New_York
## date 2019-01-06
##
## ─ Packages ──────────────────────────────────────────────────────────────
## package * version date lib source
## assertthat 0.2.0 2017-04-11 [1] CRAN (R 3.5.0)
## backports 1.1.2 2017-12-13 [1] CRAN (R 3.5.0)
## base64enc 0.1-3 2015-07-28 [1] CRAN (R 3.5.0)
## bindr 0.1.1 2018-03-13 [1] CRAN (R 3.5.0)
## bindrcpp * 0.2.2 2018-03-29 [1] CRAN (R 3.5.0)
## broom 0.5.1 2018-12-05 [1] CRAN (R 3.5.1)
## callr 3.0.0 2018-08-24 [1] CRAN (R 3.5.0)
## cellranger 1.1.0 2016-07-27 [1] CRAN (R 3.5.0)
## cli 1.0.1 2018-09-25 [1] CRAN (R 3.5.0)
## colorspace 1.3-2 2016-12-14 [1] CRAN (R 3.5.0)
## crayon 1.3.4 2017-09-16 [1] CRAN (R 3.5.0)
## curl 3.2 2018-03-28 [1] CRAN (R 3.5.0)
## debugme 1.1.0 2017-10-22 [1] CRAN (R 3.5.0)
## desc 1.2.0 2018-05-01 [1] CRAN (R 3.5.0)
## devtools * 2.0.1 2018-10-26 [1] CRAN (R 3.5.1)
## digest 0.6.18 2018-10-10 [1] CRAN (R 3.5.0)
## dplyr * 0.7.8 2018-11-10 [1] CRAN (R 3.5.0)
## evaluate 0.12 2018-10-09 [1] CRAN (R 3.5.0)
## extrafont 0.17 2014-12-08 [1] CRAN (R 3.5.0)
## extrafontdb 1.0 2012-06-11 [1] CRAN (R 3.5.0)
## fansi 0.4.0 2018-10-05 [1] CRAN (R 3.5.0)
## forcats * 0.3.0 2018-02-19 [1] CRAN (R 3.5.0)
## fs 1.2.6 2018-08-23 [1] CRAN (R 3.5.0)
## generics 0.0.2 2018-11-29 [1] CRAN (R 3.5.0)
## ggplot2 * 3.1.0 2018-10-25 [1] CRAN (R 3.5.0)
## glue 1.3.0 2018-12-06 [1] Github (tidyverse/glue@35c61e9)
## gtable 0.2.0 2016-02-26 [1] CRAN (R 3.5.0)
## haven 2.0.0 2018-11-22 [1] CRAN (R 3.5.0)
## hms 0.4.2 2018-03-10 [1] CRAN (R 3.5.0)
## hrbrthemes * 0.5.0 2018-12-06 [1] local
## htmltools 0.3.6 2017-04-28 [1] CRAN (R 3.5.0)
## httr 1.3.1 2017-08-20 [1] CRAN (R 3.5.0)
## jsonlite 1.5 2017-06-01 [1] CRAN (R 3.5.0)
## knitr 1.20 2018-02-20 [1] CRAN (R 3.5.0)
## lattice 0.20-38 2018-11-04 [1] CRAN (R 3.5.2)
## lazyeval 0.2.1 2017-10-29 [1] CRAN (R 3.5.0)
## lubridate 1.7.4 2018-04-11 [1] CRAN (R 3.5.0)
## magrittr 1.5 2014-11-22 [1] CRAN (R 3.5.0)
## memoise 1.1.0 2017-04-21 [1] CRAN (R 3.5.0)
## modelr 0.1.2 2018-05-11 [1] CRAN (R 3.5.0)
## munsell 0.5.0 2018-06-12 [1] CRAN (R 3.5.0)
## nlme 3.1-137 2018-04-07 [1] CRAN (R 3.5.2)
## pillar 1.3.0 2018-07-14 [1] CRAN (R 3.5.0)
## pkgbuild 1.0.2.9000 2018-12-05 [1] Github (r-lib/pkgbuild@6e4ebdf)
## pkgconfig 2.0.2 2018-08-16 [1] CRAN (R 3.5.0)
## pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.5.0)
## plyr 1.8.4 2016-06-08 [1] CRAN (R 3.5.0)
## prettyunits 1.0.2 2015-07-13 [1] CRAN (R 3.5.0)
## processx 3.2.0 2018-08-16 [1] CRAN (R 3.5.0)
## ps 1.2.1 2018-11-06 [1] CRAN (R 3.5.0)
## purrr * 0.2.5 2018-05-29 [1] CRAN (R 3.5.0)
## R6 2.3.0 2018-10-04 [1] CRAN (R 3.5.0)
## Rcpp 1.0.0 2018-11-07 [1] CRAN (R 3.5.0)
## readr * 1.2.1 2018-11-22 [1] CRAN (R 3.5.0)
## readxl 1.1.0 2018-04-20 [1] CRAN (R 3.5.0)
## remotes 2.0.2 2018-10-30 [1] CRAN (R 3.5.0)
## rlang 0.3.0.9001 2018-12-06 [1] Github (r-lib/rlang@05f778f)
## rmarkdown 1.10 2018-06-11 [1] CRAN (R 3.5.0)
## rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.5.0)
## rstudioapi 0.8 2018-10-02 [1] CRAN (R 3.5.0)
## Rttf2pt1 1.3.7 2018-06-29 [1] CRAN (R 3.5.0)
## rvest * 0.3.2 2016-06-17 [1] CRAN (R 3.5.0)
## scales 1.0.0.9000 2018-12-06 [1] Github (hadley/scales@7cd8121)
## selectr 0.4-1 2018-04-06 [1] CRAN (R 3.5.0)
## sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.5.0)
## stringi * 1.2.4 2018-07-20 [1] CRAN (R 3.5.0)
## stringr * 1.3.1 2018-05-10 [1] CRAN (R 3.5.0)
## testthat 2.0.1 2018-10-13 [1] CRAN (R 3.5.0)
## tibble * 1.4.2 2018-01-22 [1] CRAN (R 3.5.0)
## tidyr * 0.8.2 2018-10-28 [1] CRAN (R 3.5.0)
## tidyselect 0.2.5 2018-10-11 [1] CRAN (R 3.5.0)
## tidyverse * 1.2.1 2017-11-14 [1] CRAN (R 3.5.0)
## usethis * 1.4.0 2018-08-14 [1] CRAN (R 3.5.0)
## utf8 1.1.4 2018-05-24 [1] CRAN (R 3.5.0)
## withr 2.1.2 2018-03-15 [1] CRAN (R 3.5.0)
## xml2 * 1.2.0 2018-01-24 [1] CRAN (R 3.5.0)
##
## [1] /Library/Frameworks/R.framework/Versions/3.5/Resources/library