Skip to content

Instantly share code, notes, and snippets.

@HughParsonage

HughParsonage/HESSIH201516-12.R

Last active September 18, 2018 01:18
Show Gist options
  • Save HughParsonage/d8e492a13ca6d87a62d675164c612fab to your computer and use it in GitHub Desktop.
Save HughParsonage/d8e492a13ca6d87a62d675164c612fab to your computer and use it in GitHub Desktop.
Download ZIP
Proportion of asset value vs net worth decile by age by asset type
Raw
HESSIH201516-12.R
stopifnot(file.exists("12.R"),
basename(dirname(normalizePath(dir(pattern = "^12.R$",
full.names = TRUE),
winslash = "/"))) == "issues")
library(data.table)
library(magrittr)
library(hutils)
library(grattan)
library(grattanCharts) # install_github('hughparsonage/grattanCharts@57bfd19')
library(ggplot2)
library(scales)
stopifnot(packageVersion("ggplot2") == "3.0.0")
stopifnot(packageVersion("scales") == "1.0.0")
stopifnot(packageVersion("grattanCharts") == "0.9.1")
library(HESSIH201516)
p <-
WealthPartition_by_HH %>%
.[AgeRefPerson_by_HH, on = "id_hh"] %>%
.[, lapply(.SD, as.integer)] %>%
.[Weight_by_HH, on = "id_hh"] %>%
.[AgeRefPerson >= 25L] %>%
.[, Age := age_grouper(AgeRefPerson,
min_age = 25,
interval = 10,
max_age = 75)] %>%
.[, AgeRefPerson := NULL] %>%
.[, NetWealthDecile := weighted_ntile(NetWealth, WeightSIHHousehold, n = 10),
by = "Age"] %>%
melt.data.table(id.vars = c("id_hh",
"NetWealth",
"NetWealthDecile",
"Age",
"WeightSIHHousehold"),
variable.factor = TRUE,
variable.name = "asset_type",
value.name = "asset_value") %T>%
.[, stopifnot(identical(levels(asset_type),
c("HomeNetValue",
"OtherProperty",
"SuperBalance",
"NonSuperFinancial",
"BusinessAssets",
"OtherWealth")))] %>%
.[, asset_type := factor(asset_type,
levels = c("SuperBalance",
"HomeNetValue",
rev(c("OtherProperty",
"NonSuperFinancial",
"BusinessAssets",
"OtherWealth"))),
labels = c("Super",
"Home-(net)",
rev(c("Other property (net)",
"Non-super financial",
"Business wealth",
"Other wealth"))),
ordered = TRUE)] %>%
.[, min_asset_value_by_id := min(asset_value), keyby = "id_hh"] %>%
.[, min_asset_value_by_id := pmin.int(min_asset_value_by_id, 0L)] %>%
.[, asset_value_positives := asset_value - min_asset_value_by_id] %>%
.[, sum_asset_value_positives := sum(asset_value_positives), keyby = "id_hh"] %>%
.[, asset_prop := asset_value_positives / sum_asset_value_positives, keyby = "id_hh"] %>%
.[is.nan(asset_prop), asset_prop := 0] %>% # 0/0 => 0
.[,
.(asset_prop = weighted.mean(asset_prop, WeightSIHHousehold)),
keyby = .(Age,
asset_type,
NetWealthDecile)] %T>%
fwrite("12.csv") %>%
.[, facet_group := factor(paste0(if_else(asset_type %pin% c("Home", "^Super"),
sub("-", "\n", asset_type, fixed = TRUE),
" "), # override later
" "),
levels = c(" ",
"Home\n(net) ",
"Super "),
ordered = TRUE)] %>%
.[, text.label := if_else(and(NetWealthDecile == 10L,
facet_group %ein% " "),
gsub("-", " ", fixed = TRUE,
gsub(" ", "\n ", asset_type)),
NA_character_)] %>%
# Reverse because columns go from first to last
.[order(NetWealthDecile, -asset_type)] %>%
.[Age == "75+" & facet_group %ein% " " & NetWealthDecile == 10,
text.y := if_else(Age == max(Age),
-asset_prop + cumsum(asset_prop) + c(0, 0.08, 0.05, 0.19),
0)] %>%
.[, text.x := 10.9] %>%
.[] %>%
grplot(aes(x = NetWealthDecile,
y = asset_prop,
group = asset_type,
fill = asset_type)) +
theme(strip.background = element_blank(),
strip.text.y = element_text(angle = 0),
strip.text.x = element_text(margin = margin(t = 2, b = 4)),
axis.line.x = element_line(size = 0.3),
axis.title.x = element_text(face = "plain",
margin = margin(t = 4.5,
b = 4.5))) +
scale_x_continuous("Net worth decile (by age)",
breaks = c(1, 5, 9),
expand = expand_scale(add = c(0, 0.0))) +
geom_col(color = "white",
size = 0.1,
width = 1) +
geom_text(aes(x = text.x,
y = text.y,
label = text.label,
color = asset_type),
na.rm = TRUE,
lineheight = 0.82,
fontface = "bold",
vjust = 0.75,
hjust = 0) +
scale_fill_manual(values = gpal(6)[c(1, 2, 6, 5, 4, 3)]) +
scale_color_manual(values = gpal(6)[c(1, 2, 6, 5, 4, 3)]) +
facet_grid(facet_group~Age) +
scale_y_continuous(labels = percent,
limits = c(0, 1.1),
expand = c(0, 0))
grid::grid.newpage()
gt <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(p))
# gt$layout$clip[gt$layout$name == "panel"] <- "off"
# gt$layout$clip[gt$layout$name %pin% "strip"] <- "off"
gt$layout$clip <- "off"
grid::grid.draw(gt)
dev_copy2a4("12.pdf")
save_pptx2 <- function(p, filename, template = c("presentation", "report"), template.file = NULL) {
if (!requireNamespace("officer", quietly = TRUE) &&
!requireNamespace("ReporteRs", quietly = TRUE)) {
warning("package:ReporteRs is not installed, though is necessary for `save_pptx`.")
} else {
if (is.null(template.file)) {
DropboxInfo <-
if (Sys.getenv("OS") == "Windows_NT") {
file.path(Sys.getenv("LOCALAPPDATA"), "Dropbox", "info.json")
} else {
"~/.dropbox/info.json"
}
if (file.exists(DropboxInfo)) {
Path2Dropbox <-
jsonlite::fromJSON(DropboxInfo) %>%
use_series("business") %>%
use_series("path")
template <- match.arg(template)
template.potx <-
file.path(Path2Dropbox,
"Grattan Team",
"Templates",
"Charts",
paste0("r-pkg-Charts-for-", template, "s.pptx"))
if (!file.exists(template.potx)) {
stop("Could not find the ",
paste0("r-pkg-Charts-for-", template, "s.pptx"),
" template file in ",
file.path(Path2Dropbox,
"Grattan Team",
"Templates",
"Charts"))
}
template.file <- tempfile(fileext = ".pptx")
file.copy(template.potx, template.file, overwrite = TRUE)
} else {
stop("Could not find the chart template on Dropbox. ",
"Ensure you have access to the Grattan Team directory.")
}
}
if (requireNamespace("ReporteRs", quietly = TRUE)) {
fun <- function() grid::grid.draw(gt)
ReporteRs::pptx(template = template.file) %>% ReporteRs::addSlide(slide.layout = if (template == "presentation") "Slide with chart" else "Chart") %>%
ReporteRs::addPlot(fun = fun, fontname_sans = "Arial",
vector.graphic = TRUE,
width = 22.16/2.5,
height = 14.5/2.5,
offx = if (template == "presentation") 1 else 0,
offy = if (template == "presentation") 2 else 0) %>%
ReporteRs::writeDoc(file = filename)
} else if (requireNamespace("officer", quietly = TRUE)) {
template <- officer::read_pptx(path = template.file)
template %<>% officer::add_slide(layout = "Slide with chart",
master = "Charts for overheads")
officer::ph_with_gg_at(x = template,
value= p,
# fontname_sans = "Arial",
width = 22.16/2.5,
height = 14.5/2.5,
left = if (template == "presentation") 1 else 0,
top = if (template == "presentation") 2 else 0) %>%
print(target = filename)
}
}
}
# save_pptx(ggplot2::last_plot(), "12-report.pptx", template = "report")
save_pptx2(p, "12-report.pptx", template = "report")
save_pptx2(p, "12-presentation.pptx", template = "report")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment