#Productivity Commission 2018 analysis for the Rising Inequality? Commission Research Paper #Script for HES data analysis and charts #Must run 1_HES_setup_and_data & 2_HES_variables first #Some charts combine HES and HILDA data and HILDA dataframes must be generated first ######################################################################################################## #### COLOUR PALETTE ######################################################################################################## #define custom colour palette blue <- rgb2hex(c(102,188,219)) dark_blue <- rgb2hex(c(38,90,154)) PC_green <- rgb2hex(c(120,162,47)) dark_green <- rgb2hex(c(77,112,40)) yellow <- rgb2hex(c(244,177,35)) orange <- rgb2hex(c(241,90,37)) red <- rgb2hex(c(165,40,40)) purple <- rgb2hex(c(137,86,163)) black <- rgb2hex(c(0,0,0)) grey <- rgb2hex(c(191,191,191)) dark_purple <- rgb2hex(c(103,64,122)) # new mid_blue <- rgb2hex(c(44,149,186)) # new dark_grey <- rgb2hex(c(64,64,64)) white <- rgb2hex(c(254,255,255)) PCcols <- c(blue, dark_blue, PC_green, dark_green, yellow, orange, red, purple) PCcolsPres <- c(blue, PC_green, dark_green, yellow, orange, purple) PCcolsPres2 <- c(dark_green, yellow, orange, purple) PCcolsTen <- c(blue, mid_blue, dark_blue, PC_green, dark_green, yellow, orange, red, purple, dark_purple) PCcols1 <- c(blue, dark_blue, dark_green, yellow, orange, red, purple) #Create extended ten colour palette PCcols_gradient <- scale_fill_gradientn(colours = PCcols, space = "Lab", na.value = "grey50", guide = "legend", breaks = seq(1,10,1)) PCcols_gradient_col <- scale_color_gradientn(colours = PCcols, space = "Lab", na.value = "grey50", guide = "legend", breaks = seq(1,10,1)) ######################################################################################################## #### CHART LABELS AND BREAKS ######################################################################################################## HES_years <- c(1989, 1994, 1999, 2004, 2010, 2016) every_3_years <- c(1989, 1992, 1995, 1998, 2001, 2004, 2007, 2010, 2013, 2016) income_types <- c("eq_yearly_lab_inc", "eq_yearly_cap_inc", "eq_yearly_trans_inc", "eq_yearly_inc_tax", "eq_yearly_gross_inc") age_groups <- c("under15s", "15to24", "25to34", "35to44", "45to54", "55to64", "65plus") HESP_age_groups <- c("15to24", "25to34", "35to44", "45to54", "55to64", "65plus") fin_year_labels = as_labeller(c(`1988` = "1987-88", `1989` = "1988-89", `1992` = "1991-92", `1994` = "1993-94", `1995` = "1994-95", `1996` = "1995-96", `1997` = "1996-97", `1998` = "1997-98", `1999` = "1998-99", `2000` = "1999-00", `2001` = "2000-01", `2002` = "2001-02", `2003` = "2002-03", `2004` = "2003-04", `2005` = "2004-05", `2006` = "2005-06", `2007` = "2006-07", `2008` = "2007-08", `2009` = "2008-09", `2010` = "2009-10", `2011` = "2010-11", `2012` = "2011-12", `2013` = "2012-13", `2014` = "2013-14", `2015` = "2014-15", `2016` = "2015-16")) short_fin_year_labels = as_labeller(c(`1988` = "'87-88", `1989` = "'88-89", `1992` = "'91-92", `1994` = "'93-94", `1995` = "'94-95", `1996` = "'95-96", `1997` = "'96-97", `1998` = "'97-98", `1999` = "'98-99", `2000` = "'99-00", `2001` = "'00-01", `2003` = "'02-03", `2004` = "'03-04", `2006` = "'05-06", `2008` = "'07-08", `2010` = "'09-10", `2012` = "'11-12", `2014` = "'13-14", `2016` = "'15-16")) very_short_fin_year_labels = as_labeller(c(`1988` = "'88", `1989` = "'89", `1992` = "'92", `1994` = "'94", `1995` = "'95", `1996` = "'96", `1997` = "'97", `1998` = "'98", `1999` = "'99", `2000` = "'00", `2001` = "'01", `2003` = "'03", `2004` = "'04", `2006` = "'06", `2008` = "'08", `2010` = "'10", `2012` = "'12", `2014` = "'14", `2016` = "'16")) period_labels = as_labeller(c(`1994` = "'88-89 to '93-94", `1999` = "'93-94 to '98-99", `2004` = "'98-99 to '03-04", `2010` = "'03-04 to '09-10", `2016` = "'09-10 to '15-16")) HESP_period_labels = as_labeller(c(`1999` = "'88-89 to '98-99", `2004` = "'98-99 to '03-04", `2010` = "'03-04 to '09-10", `2016` = "'09-10 to '15-16")) income_labels = as_labeller(c(eq_disp_inc = "Disposable income", eq_priv_inc = "Private income", eq_gross_inc = "Gross income")) consumption_gini_labels= as_labeller(c(eq_disp_inc = "Disposable income", eq_cons = "Final consumption", eq_cons_exp = "Consumption expenditure", eq_cons_no_inkind = "Private consumption")) consumption_labels = as_labeller(c(eq_yearly_cons = "Final consumption", eq_yearly_disp_inc = "Disposable income", eq_yearly_cons_no_inkind = "Private consumption")) inkind_type_labels= as_labeller(c(eq_yearly_inkind_health = "Health", eq_yearly_inkind_educ = "Education", eq_yearly_inkind_welfare = "Welfare services", eq_yearly_inkind_childcare = "Childcare", eq_yearly_inkind_govt_rent = "Government housing")) marginal_effect_labels = as_labeller(c(gross_less_cap = "Capital income", gross_less_lab = "Labour income", gross_less_trans = "Transfer income", disp_less_tax = "Income tax")) inc_dec_labels = as_labeller(c(`1` = "Bottom", `2` = "2", `3` = "3", `4` = "4", `5` = "5", `6` = "6", `7` = "7", `8` = "8", `9` = "9", `10` = "Top")) wealth_dec_labels = inc_dec_labels income_type_labels = as_labeller(c("eq_yearly_lab_inc" = "Labour income", "eq_yearly_cap_inc" = "Capital income", "eq_yearly_trans_inc" = "Transfer income", "eq_yearly_inc_tax" = "Income tax")) wealth_type_labels = as_labeller(c("eq_home_equity" = "Owner-\noccupied\nhousing", "eq_other_property_equity" = "Other\nproperty", "eq_super" = "Super-\nannuation", "eq_business" = "Business", "eq_financial_equity" = "Financial", "eq_vehicle_equity" = "Vehicle", "eq_personal_equity" = "Personal")) income_consumption_labels = as_labeller(c(eq_cons = "Final consumption", eq_disp_inc = "Disposable income", eq_priv_inc = "Private income")) income_consumption_levels = c("eq_priv_inc", "eq_disp_inc", "eq_cons") wealth_type_labels_consolidated = as_labeller(c("eq_home_equity" = "Owner-occupied\nhousing", "eq_super" = "Superannuation", "eq_other" = "Other")) wealth_type_labels_consolidated1 = as_labeller(c("eq_home_equity" = "Owner-occupied\nhousing", "eq_super" = "Superannuation", "eq_other" = "Other", "eq_business" = "Business", "eq_financial_equity" = "Financial", "eq_vehicle_equity" = "Vehicle", "eq_personal_equity" = "Personal", "eq_other_property_equity" = "Other property")) household_type_labels = as_labeller(c("family_employed_1" = "Family, 1 income", "family_employed_2" = "Family, 2+ incomes", "family_unemployed" = "Family, no paid work", "retiree_other" = "Retiree, no pension", "retiree_pension" = "Retiree, receiving pension", "working_age_employed" = "Working age, employed", "working_age_unemployed" = "Working age, no paid work")) household_type_labels_poverty = as_labeller(c("family_employed" = "Family,\n1+ employed", "family_unemployed" = "Family,\nno paid work", "retiree" = "Retiree", "working_age_employed" = "Working age,\nemployed", "working_age_unemployed" = "Working age,\nno paid work")) household_type_labels_spaced = as_labeller(c("family_employed_1" = "Family,\n1\nincome", "family_employed_2" = "Family,\n2+\nincomes", "family_unemployed" = "Family,\nno\npaid work", "retiree_other" = "Retiree,\nno\npension", "retiree_pension" = "Retiree,\nreceiving\npension", "working_age_employed" = "Working\nage,\nemployed", "working_age_unemployed" = "Working\nage,\nno\npaid work")) age_group_labels = as_labeller(c("under15s" = "Under 15", "15to24" = "15 to 24", "25to34" = "25 to 34", "35to44" = "35 to 44", "45to54" = "45 to 54", "55to64" = "55 to 64", "65plus" = "65+")) HESP_age_group_labels = as_labeller(c("15to24" = "15 to 24", "25to34" = "25 to 34", "35to44" = "35 to 44", "45to54" = "45 to 54", "55to64" = "55 to 64", "65plus" = "65+")) addline_format <- function(x,...){ gsub('\\s','\n',x) } spaced_income_type_labels = as_labeller(addline_format(c("eq_yearly_lab_inc" = "Labour income", "eq_yearly_cap_inc" = "Capital income", "eq_yearly_trans_inc" = "Transfer income", "eq_yearly_inc_tax" = "Income tax"))) poverty_labels= as_labeller(c(income = "Income", consumption = "Final consumption", financial_Headey_liquid_assets = "Financial", cons_no_in_kind = "Private consumption")) ################################################################################################## #CHARTS AND SUMMARY STATS FOR CHAPTERS ################################################################################################## ######################################################################################################## # CHAPTER 2 ######################################################################################################## ######################################################################################################## # Decile ranges vary greatly (figure 2.6) ######################################################################################################## # income - figure 2.6a # emf(file = here("HES","Charts","decile_distribution_income.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% filter(year == 2016) %>% ggplot(aes(eq_yearly_disp_inc, weight=hhwt, fill=factor(inc_dec), group=inc_dec )) + geom_histogram(binwidth = 2000)+ scale_y_continuous(expand=c(0,0), name ="Number of people", limits = c(0,1400000), breaks = seq(0,1400000,200000), labels = comma_format(digits=0))+ scale_x_continuous(expand=c(0,0), name = "Dollars", limits = c(-0,155000), labels = dollar_format(digits=0)) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", # axis.text.x=element_blank(), legend.title = element_text()) + scale_fill_manual(values = PCcolsTen) + guides(fill=guide_legend(nrow=1, byrow=TRUE, title="Income decile")) # dev.off() # same chart for presentation on dark background # emf(file = here("HES","Charts","decile_distribution_income_presentation.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% filter(year == 2016) %>% ggplot(aes(eq_yearly_disp_inc, weight=hhwt, fill=factor(inc_dec), group=inc_dec )) + geom_histogram(binwidth = 2000)+ scale_y_continuous(expand=c(0,0), name ="Number of people", limits = c(0,1400000), breaks = seq(0,1400000,200000), labels = comma_format(digits=0))+ scale_x_continuous(expand=c(0,0), name = "Dollars", limits = c(-0,155000), labels = dollar_format(digits=0)) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", legend.title = element_text(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) + scale_fill_manual(values = PCcolsTen) + guides(fill=guide_legend(nrow=1, byrow=TRUE, title="Income decile")) # dev.off() # wealth - figure 2.6b # emf(file = here("HES","Charts","decile_distribution_wealth.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% filter(year == 2016) %>% ggplot(aes(eq_wealth, weight=hhwt, fill=factor(wealth_dec), group=wealth_dec )) + geom_histogram(binwidth = 20000)+ scale_y_continuous(expand=c(0,0), name ="Number of people", limits = c(0,1400000), breaks = seq(0,1400000,200000), labels = comma_format(digits=0))+ scale_x_continuous(expand=c(0,0), name = "Dollars", limits = c(-40000,2100000), labels = dollar_format(digits=0)) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", # axis.text.x=element_blank(), legend.title = element_text()) + scale_fill_manual(values = PCcolsTen) + guides(fill=guide_legend(nrow=1, byrow=TRUE, title="Wealth decile")) # dev.off() ################################################################################################## #CHAPTER 3 ################################################################################################## ######INCOME CHAPTER KEY STATS #table of mean income by year mean_disp_inc <- HESH_expanded %>% select(year,hhwt, eq_yearly_disp_inc) %>% group_by(year) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(year) %>% mutate(diff=((mean_value-lag(mean_value,5))/(year-lag(year,5)))) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) # write.csv(x=mean_disp_inc, file= here("HES", "mean_disp_inc.csv"), row.names=FALSE) #table of mean income by income decile and year mean_disp_inc_by_dec <- HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec, year) %>% mutate(diff=((mean_value-lag(mean_value,5))/(year-lag(year,5)))) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) # write.csv(x=mean_disp_inc_by_dec, file= here("HES", "mean_disp_inc_deciles.csv"), row.names=FALSE) ######################################################################################################## #Average and median equivalised disposable income (figure 3.1) ######################################################################################################## HES_income <- HESH_expanded %>% select(year, eq_yearly_disp_inc, hhwt) %>% group_by(year) %>% summarise(mean = wtd.mean(eq_yearly_disp_inc, weights=hhwt), median = wtd.quantile(eq_yearly_disp_inc, weights=hhwt, probs=0.5) ) %>% mutate(source="HES") saveRDS(HES_income, file= here("shared_dataframes", "HES_income.rds") ) #Run HILDA and SIH scripts first to generate the dataframes below HILDA_income <- readRDS(file= here("shared_dataframes", "HILDA_income.rds") ) SIH_income <- readRDS(file= here("shared_dataframes", "SIH_income_mean_and_median.rds") ) #Add source to each dataframe HES_income <- HES_income %>% mutate(source = "HES") HILDA_income <- HILDA_income %>% mutate(source = "HILDA") SIH_income <- SIH_income %>% mutate(source = "SIH") SIH_income <- SIH_income %>% filter(year != 1990) SIHHES_income <- bind_rows(SIH_income, HES_income) %>% arrange(desc(source)) %>% # - so that all SIH ones are first, check using View() distinct(year, .keep_all=TRUE) %>% mutate(source="HES/SIH") # annualised change SIH/HES average income 1988-89 to 2015-16 = 2.1% p.a. SIHHES_income %>% filter(year %in% c(1989, 2016)) %>% arrange(year) %>% mutate(percent=(((mean/lag(mean,1))^(1/(year-lag(year,1)))) - 1)*100) #Combine HES and HILDA dataframes all_incomes <- bind_rows(SIHHES_income, HILDA_income ) #Chart # emf(file = here("HES", "charts", "all_income_mean_median.emf"), width = 5.5, height = 4) all_incomes %>% rename(Average=mean, Median=median) %>% gather(key="measure", value="value", -year, -source) %>% ggplot(aes(x=year, y=value, col=source, shape=measure )) + geom_point(size = 2) + geom_line(size =1) + scale_x_continuous(expand=c(0.03, 0.03), labels = fin_year_labels, breaks=HES_years, name="Year") + scale_y_continuous(expand = c(0,0), labels=comma, name="Dollars", limits=c(0,60000), breaks=seq(0,60000,10000)) + scale_color_manual(values=PCcols)+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm")) # dev.off() ######################################################################################################## #Gini coefficients for equivalised disposable income, SIH/HES (figure 3.2) ######################################################################################################## HILDA_ginis <- readRDS(file= here("shared_dataframes", "HILDA_ginis.csv") ) SIH_ginis <- readRDS(file= here("shared_dataframes", "SIH_gini_coef.rds") ) #Add source to each dataframe ginis <- ginis %>% mutate(source = "HES") HILDA_ginis <- HILDA_ginis %>% mutate(source = "HILDA") SIH_ginis <- SIH_ginis %>% mutate(source = "SIH", variable= 'eq_disp_inc', gini = eq_yearly_disp_inc, year = eq_disp_incp ) SIH_ginis <- SIH_ginis %>% filter( year != 1990) # combined SIH/HES income ginis dataframe SIHHES_ginis <- bind_rows(ginis,SIH_ginis) %>% filter(variable == "eq_disp_inc")%>% arrange(desc(source)) %>% # - so that all SIH ones are first, check using View() distinct(year, .keep_all=TRUE) %>% mutate(source="HES/SIH") # save SIHHES income ginis # saveRDS(SIHHES_ginis, file= here("shared_dataframes", "SIHHES_income_ginis.rds") ) #Combine HES and HILDA dataframes all_ginis <- bind_rows(SIHHES_ginis, HILDA_ginis) #Chart # emf(file = here("HES","Charts","income_ginis.emf"), width = 5.90551, height = 3.14961) all_ginis %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x=year,y=gini, col = source, group = source)) + geom_line(size = 1)+ geom_point(size = 2)+ scale_x_continuous(expand=c(0.03,0.03),breaks = HES_years, labels = fin_year_labels)+ scale_y_continuous(expand=c(0,0), limits=c(0.2, 0.4)) + scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Gini coefficient")+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm")) # dev.off() # same chart, for presentation on a dark background # emf(file = here("HES","Charts","income_ginis_presentation.emf"), width = 5.90551, height = 3.14961) all_ginis %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x=year,y=gini, col = source, group = source)) + geom_line(size = 1)+ # geom_point(size = 2)+ scale_x_continuous(expand=c(0.03,0.03),breaks = HES_years, labels = fin_year_labels)+ scale_y_continuous(expand=c(0,0), limits=c(0.2, 0.4)) + scale_color_manual(values=PCcolsPres)+ xlab("Year")+ ylab("Gini coefficient")+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() # same chart, for presentation on a dark background (half width) # emf(file = here("HES","Charts","income_ginis_presentation_half_width.emf"), width = 2.95, height = 3.14961) all_ginis %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x=year,y=gini, col = source, group = source)) + geom_line(size = 1)+ # geom_point(size = 2)+ scale_x_continuous(expand=c(0.03,0.03),breaks = HES_years, labels = short_fin_year_labels)+ scale_y_continuous(expand=c(0,0), limits=c(0.2, 0.7), breaks=seq(0.2, 0.7, by=0.1)) + scale_color_manual(values=PCcolsPres)+ xlab("Year")+ ylab("Gini coefficient")+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() ######################################################################################################## #Quantile ratios of equivalised disposable income (figure 3.3) ######################################################################################################## cuts_wtd <- mutate(cuts_wtd, "P90/P10" = cut90/cut10) cuts_wtd <- mutate(cuts_wtd, "P90/P50" = cut90/cut50) cuts_wtd <- mutate(cuts_wtd, "P50/P10" = cut50/cut10) HES_income_ratios <- cuts_wtd %>% select(year, "P90/P10", "P90/P50", "P50/P10") %>% gather(ratio, value, -year) SIH_income_ratios <- readRDS(file= here("shared_dataframes", "SIH_income_ratios.rds") ) HES_income_ratios <- HES_income_ratios %>% mutate(source = "HES") SIH_income_ratios <-SIH_income_ratios %>% mutate(source = "SIH") SIH_income_ratios <- SIH_income_ratios %>% filter (year!= 1990) SIHHES_ratios <- bind_rows(HES_income_ratios,SIH_income_ratios)%>% group_by(ratio)%>% arrange(desc(source)) %>% # - so that all SIH ones are first, check using View() distinct(year, .keep_all=TRUE) %>% mutate(source="HES/SIH") #Chart # emf(file = here("SIH","Charts","SIHHES_ratios.emf"), width = 5.90551, height = 3.14961) SIHHES_ratios %>% ggplot(aes(x=year, y=value, col=ratio) ) + geom_line(size = 1)+ geom_point(size=2)+ scale_color_manual(values=PCcols1)+ scale_y_continuous(expand=c(0,0), limits = c(0,5))+ scale_x_continuous(expand=c(0.03,0.03), breaks = HES_years, labels = fin_year_labels)+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text())+ labs( y = "Ratio", x = "Year", col = "Quantile ratios") # dev.off() ################################################################ # visual summary - figure 2, top panel - 'Income and consumption inequality in Australia has risen slightly according to some measures …' ################################################################### inc_gini_vs2 <- all_ginis %>% filter(variable == "eq_disp_inc") %>% filter(source=="HES/SIH") %>% select(variable, year, gini) fin_cons_gini_vs2 <- ginis %>% filter(variable == "eq_cons") %>% filter(year>1989) %>% select(variable, year, gini) vs2 <- bind_rows(fin_cons_gini_vs2, inc_gini_vs2) PCcols_vs2 <- c(PC_green, dark_blue) # emf(file = here("HES","Charts","visual_sum_fig_2_top_panel.emf"), width = 5.90551, height = 3.14961) vs2 %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size = 1)+ geom_point(size = 2)+ scale_x_continuous(expand=c(0.03,0.03),breaks = every_3_years, labels = fin_year_labels)+ scale_y_continuous(expand=c(0,0), limits=c(0.15, 0.35), breaks = seq(0.15, 0.35, 0.05)) + scale_color_manual(values=PCcols_vs2)+ xlab("Year")+ ylab("Gini coefficient")+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm")) # dev.off() ############################################################################################################# # Visual summary - figure 2, bottom panel - '… but other sources reveal no clear trend for income inequality' ############################################################################################################# vs2_fifty10_inc <- SIHHES_ratios %>% filter(ratio=='P50/P10') %>% rename(variable = ratio) %>% mutate(value = (value+1.875)/12.5) %>% # transformation done so taht value matches second axis when chart is produced select(variable, year, value) vs2_HILDA_inc_gini <- all_ginis %>% filter(variable == "eq_disp_inc") %>% filter(source=="HILDA") %>% select(variable, year, gini) %>% rename(value = gini) vs2_bottom <- bind_rows(vs2_fifty10_inc, vs2_HILDA_inc_gini) PCcols_vs2_bottom <- c(blue, purple) # emf(file = here("HES","Charts","visual_sum_fig_2_bottom_panel.emf"), width = 5.90551, height = 3.14961) vs2_bottom %>% ggplot(aes(x=year,y=value, col = variable, group = variable))+ geom_line(size = 1)+ geom_point(size = 2)+ scale_x_continuous(expand=c(0.03,0.03),breaks = every_3_years, labels = fin_year_labels)+ scale_y_continuous(expand=c(0,0), limits=c(0.15, 0.35), breaks = seq(0.15, 0.35, 0.05), sec.axis = sec_axis(~.*12.5-1.875, name="Ratio") ) + scale_color_manual(values=PCcols_vs2_bottom)+ xlab("Year")+ ylab("Gini coefficient")+ theme(legend.position = "none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm")) # dev.off() ###Figure 3.4 made in Excel ######################################################################################################## #Average equivalised disposable income by income decile (figure 3.5) ######################################################################################################## #Chart panel a # emf(file = here("HES","Charts","annualised_dollar_change_mean_disp_inc.emf"), width = 2.95276, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(diff=((mean_value-lag(mean_value,5))/(year-lag(year,5)))) %>% filter(year==2016) %>% ggplot(aes(x = inc_dec, y = diff))+ geom_col(position="dodge", aes(fill=as.factor(inc_dec) ) )+ scale_y_continuous(labels = comma_format(digits=0), expand=c(0,0),limits = c(0,2500))+ scale_x_continuous(breaks = seq(1,10,1), expand = c(0.01, 0.01), labels = inc_dec_labels)+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.title.y=element_text(), axis.text.x = element_text(hjust= 0.7))+ labs(x = "Income decile", y = "Dollars") # dev.off() #Chart panel b # emf(file = here("HES","Charts","total_CAGR_mean_disp_inc.emf"), width = 2.95276, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) %>% filter(year==2016) %>% ggplot(aes(x = inc_dec, y = percent, fill = factor(inc_dec)))+ geom_col(position="dodge")+ scale_y_continuous(labels=comma_format(digits = 1), expand=c(0,0), limits = c(0,2.5))+ scale_x_continuous(breaks = seq(1,10,1), expand = c(0.01, 0.01), labels = inc_dec_labels)+ theme(legend.position = "none", legend.title=element_blank())+ labs(x = "Income decile", y = "Per cent")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.text.x = element_text(hjust= 0.7)) # dev.off() # summary stat - average growth rate across the deciles = 1.98 (unweighted average across the ten deciles) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) %>% filter(year==2016) %>% summarise(ave_growth = mean(percent)) # same chart, for presentation on dark background (width changed also) # emf(file = here("HES","Charts","total_CAGR_mean_disp_inc_presentation.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) %>% filter(year==2016) %>% ggplot(aes(x = inc_dec, y = percent, fill = factor(inc_dec)))+ geom_col(position="dodge")+ scale_y_continuous(labels=comma_format(digits = 1), expand=c(0,0), limits = c(0,2.5))+ scale_x_continuous(breaks = seq(1,10,1), expand = c(0.01, 0.01), labels = inc_dec_labels)+ theme(legend.position = "none", legend.title=element_blank())+ labs(x = "Income decile", y = "Per cent")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.text.x = element_text(hjust= 0.7, colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() ######################################################################################################## #Average annual growth rates in equivalised disposable income between by time period and income decile (figure 3.6) ######################################################################################################## #Chart: # emf(file = here("HES","Charts","period_CAGR_mean_disp_inc.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = factor(inc_dec), group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma_format(digits=1), expand=c(0.01,0.01), breaks=seq(-4,8,2), limits=c(-5,8))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # same chart for presentation on dark background # emf(file = here("HES","Charts","period_CAGR_mean_disp_inc_presentation.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = factor(inc_dec), group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma_format(digits=1), expand=c(0.01,0.01), breaks=seq(-4,8,2), limits=c(-5,8))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(colour=white), legend.text = element_text(colour=white), axis.line.x = element_blank(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) + geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # same chart for presentation on dark background - fewer periods, single colours PCcolsSpec <- c( blue, PC_green, yellow) # emf(file = here("HES","Charts","period_CAGR_mean_disp_inc_presentation_3_periods.emf"), width = 5.90551, height = 3.14961) # svg(file = here("HES","Charts", "period_CAGR_mean_disp_inc_presentation_3_periods.svg")) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989 & year!=1999 & year !=2004) %>% ggplot(aes(x = factor(year), y = percent, fill = factor(year), group = inc_dec))+ geom_col(position="dodge", col=dark_grey)+ scale_y_continuous(labels = comma_format(digits=1), expand=c(0.01,0.01), breaks=seq(-4,6,2))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ scale_fill_manual(values = PCcolsSpec) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), # legend.title = element_text(colour=white), # legend.text = element_text(colour=white), legend.position="none", axis.line.x = element_blank(), axis.text.x = element_blank(), axis.text.y = element_text(colour=white), axis.title.x = element_blank(), axis.title.y = element_text(colour=white)) + geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # broken up by different income types (charts not used but discussed in text) # LABOUR income - 'For all but the top three deciles, average labour income declined' HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_lab_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_lab_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = inc_dec, group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma, expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ PCcols_gradient+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # CAPITAL income - 'very strong growth in capital income in the top two income deciles' HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_cap_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_cap_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = inc_dec, group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma, expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ PCcols_gradient+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # TRANSFER income - 'This decrease was partially offset by strong growth in average transfer income among lower and middle income earner' HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_trans_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_trans_inc, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = inc_dec, group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma, expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ PCcols_gradient+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # taxes paid - 'as well as declines in income tax paid' HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_inc_tax) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_inc_tax, weight = hhwt))) %>% ungroup() %>% arrange(inc_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year!=1989) %>% ggplot(aes(x = factor(year), y = percent, fill = inc_dec, group = inc_dec))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma, expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Income decile:")+ PCcols_gradient+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) ####################################################################################### # Australia's income growth (USD PPP) - to feed into EXCEL chart Figure 3.7 ########################################################################### HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% ungroup() %>% arrange(year,inc_dec) %>% filter(year %in% c(1989, 2016)) %>% View() ######################################################################################################## #Top 1 per cent share of total equivalised disposable income (figure 3.8) ######################################################################################################## #Top 1 per cent column HESH_expanded <- HESH_expanded %>% group_by(year) %>% mutate(top_one_per_cent = ifelse(eq_yearly_disp_inc > wtd.quantile(eq_yearly_disp_inc, weights=hhwt, probs=0.99), 1, 0)) %>% mutate(ninety_nine_per_cent = abs(top_one_per_cent-1)) #Top 1 per cent mean income growth HESH_expanded %>% group_by(year) %>% summarise(mean_value = wtd.mean(eq_yearly_disp_inc, weights=hhwt*top_one_per_cent)) %>% mutate(one_per_cent_growth = (((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) #Top 1 per cent income share by income type one_per_cent_share <- HESH_expanded %>% select(year, hhwt, eq_disp_inc, eq_priv_inc, eq_lab_inc, eq_cap_inc) %>% gather(key = "variable", value = "value", c(-year, -hhwt)) %>% group_by(year, variable) %>% mutate(one_per_cent_indicator = ifelse(value > wtd.quantile(value, weights=hhwt, probs=0.99), 1, 0), other_top_dec_indicator = ifelse((value > wtd.quantile(value, weights=hhwt, probs=0.90)) & one_per_cent_indicator == 0, 1,0)) %>% summarise(share = sum(value*hhwt*one_per_cent_indicator)/sum(value*hhwt)*100, remainder_dec_share = sum(value*hhwt*other_top_dec_indicator)/sum(value*hhwt)*100) #What percentage of top 1 per cent's private/gross income is capital income? HESH_expanded %>% select(year, hhwt, top_one_per_cent, ninety_nine_per_cent, eq_disp_inc, eq_cap_inc, eq_lab_inc, eq_trans_inc, eq_gross_inc, eq_priv_inc) %>% group_by(year) %>% summarise(cap_private_inc_share_1_per_cent = sum(top_one_per_cent*eq_cap_inc*hhwt)/sum(top_one_per_cent*eq_priv_inc*hhwt), cap_gross_inc_share_1_per_cent = sum(top_one_per_cent*eq_cap_inc*hhwt)/sum(top_one_per_cent*eq_gross_inc*hhwt), cap_private_inc_share = sum(eq_cap_inc*hhwt)/sum(eq_priv_inc*hhwt), cap_gross_inc_share = sum(eq_cap_inc*hhwt)/sum(eq_gross_inc*hhwt)) #What percentage of income type goes to top 1 per cent? HESH_expanded %>% select(year, hhwt, top_one_per_cent, eq_disp_inc, eq_cap_inc, eq_lab_inc, eq_trans_inc, eq_gross_inc) %>% group_by(year) %>% summarise(cap_inc_share = sum(top_one_per_cent*hhwt*eq_cap_inc)/sum(hhwt*eq_cap_inc), disp_inc_share = sum(top_one_per_cent*hhwt*eq_disp_inc)/sum(hhwt*eq_disp_inc)) #Gini comparison with and without top 1 per cent one_per_cent_ginis <- HESH_expanded %>% select(year, hhwt, eq_disp_inc, eq_priv_inc, eq_lab_inc, eq_cap_inc) %>% gather(key = "variable", value = "value", c(-year, -hhwt)) %>% mutate(value = ifelse(value > 0, value,0)) %>% group_by(year, variable) %>% mutate(ninety_nine_per_cent_indicator = ifelse(value < wtd.quantile(value, weights=hhwt, probs=0.99), 1, 0)) %>% summarise(total_gini = gini(value, weights = hhwt), ninety_nine_per_cent_gini = gini(value, weights = hhwt*ninety_nine_per_cent_indicator), per_cent_difference = (total_gini - ninety_nine_per_cent_gini)/total_gini*100) #Gini comparison - percentage contribution to change in Gini - total period one_per_cent_gini_contribution <- one_per_cent_ginis %>% ungroup() %>% group_by(variable) %>% mutate(total_gini_change = (total_gini-lag(total_gini,5)), ninety_nine_per_cent_gini_change = (ninety_nine_per_cent_gini-lag(ninety_nine_per_cent_gini,5)), per_cent_contribution = (total_gini_change-ninety_nine_per_cent_gini_change)/total_gini_change) #Chart 3.8 panel a # emf(file = here("HES","Charts","top_1_per_cent_inc_share.emf"), width = 5.90551, height = 3.14961) one_per_cent_share %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x = year,y = share, col = variable, group = variable)) + geom_line(size = 1)+ geom_point(size = 2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels)+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Per cent")+ ylim(c(0,10))+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none") # dev.off() # same chart, for presentation on dark background # emf(file = here("HES","Charts","top_1_per_cent_inc_share_presentation.emf"), width = 5.90551, height = 3.14961) one_per_cent_share %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x = year,y = share, col = variable, group = variable)) + geom_line(size = 1)+ # geom_point(size = 2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels)+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Per cent")+ ylim(c(0,10))+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() #Chart 3.8 panel b # emf(file = here("HES","Charts","top_1_per_cent_Gini_reduction.emf"), width = 2.95276, height = 3.14961) one_per_cent_ginis %>% filter(variable == "eq_disp_inc") %>% ggplot(aes(x = year,y = per_cent_difference, col = variable, group = variable)) + geom_line(size = 1)+ geom_point(size = 2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels)+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Per cent")+ ylim(c(0,10))+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none") # dev.off() ######################################################################################################## #Types of income as a share of equivalised gross income (figure 3.9) ######################################################################################################## #Chart # emf(file = here("HES","Charts","decile_percentage_income_by_income_type_2016.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_lab_inc, eq_yearly_cap_inc, eq_yearly_trans_inc, eq_yearly_inc_tax, eq_yearly_gross_inc) %>% filter(year==2016) %>% gather(inc_type,value,c(-year,-inc_dec, -hhwt, - eq_yearly_gross_inc)) %>% group_by(year, inc_type,inc_dec) %>% summarise(percent = 100*sum(value*hhwt)/sum(eq_yearly_gross_inc*hhwt)) %>% ggplot(aes(x = factor(inc_type, levels = income_types), y = percent, fill = factor(inc_dec), group = inc_dec))+ geom_col(position = "dodge")+ scale_x_discrete(labels = income_type_labels, expand = c(0.01, 0.01), name="Income type")+ scale_y_continuous(expand=c(0.01,0.01), limits = c(-30,100), name="Per cent")+ scale_fill_manual(values = PCcolsTen, name="Income decile:") + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ # labs(fill="Income decile:")+ geom_hline(yintercept = 0, colour = grey)+ #Add this to get a horizontal axis line at zero guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # same chart as above (Figure 3.9) but for presentation on dark background # emf(file = here("HES","Charts","decile_percentage_income_by_income_type_2016_presentation.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_lab_inc, eq_yearly_cap_inc, eq_yearly_trans_inc, eq_yearly_inc_tax, eq_yearly_gross_inc) %>% filter(year==2016) %>% gather(inc_type,value,c(-year,-inc_dec, -hhwt, - eq_yearly_gross_inc)) %>% group_by(year, inc_type,inc_dec) %>% summarise(percent = 100*sum(value*hhwt)/sum(eq_yearly_gross_inc*hhwt)) %>% ggplot(aes(x = factor(inc_type, levels = income_types), y = percent, fill = factor(inc_dec), group = inc_dec))+ geom_col(position = "dodge")+ scale_x_discrete(labels = income_type_labels, expand = c(0.01, 0.01), name="Income type")+ scale_y_continuous(expand=c(0.01,0.01), limits = c(-30,100), name="Per cent")+ scale_fill_manual(values = PCcolsTen, name="Income decile:") + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(colour=white), legend.text = element_text(colour=white), axis.line.x = element_blank(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white))+ # labs(fill="Income decile:")+ geom_hline(yintercept = 0, colour = grey)+ #Add this to get a horizontal axis line at zero guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ######################################################################################################## #Average annual growth rate in average equivalised disposable income by income type (figure 3.10) ######################################################################################################## #Chart # svg(file = here("HES","Charts","total_CAGR_mean_disp_inc_by_income_type_and_inc_dec.svg"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year,hhwt, inc_dec, eq_yearly_lab_inc, eq_yearly_cap_inc, eq_yearly_trans_inc, eq_yearly_inc_tax) %>% gather(inc_type,value,c(-year,-inc_dec, -hhwt)) %>% group_by(year, inc_type,inc_dec) %>% summarise(mean_value=wtd.mean(value, weight = hhwt)) %>% ungroup() %>% arrange(inc_dec,inc_type,year) %>% mutate(percent=(((mean_value/lag(mean_value,5))^(1/(year-lag(year,5)))) - 1)*100) %>% filter(year==2016) %>% ggplot(aes(x = factor(inc_type, levels = income_types), y = percent, group = inc_dec, fill = factor(inc_dec))) + geom_col(position="dodge")+ scale_y_continuous(expand=c(0,0), limits = c(0,6))+ scale_x_discrete(labels = income_type_labels, expand = c(0.01, 0.01))+ labs(x = "Type of income", y = "Per cent", fill = "Income decile")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text())+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ######################################################################################################## #Gini coefficients for equivalised income (gross, disposable and private) (figure 3.11) ######################################################################################################## #Chart # emf(file = here("HES","Charts","tax_and_transfer_ginis.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_gross_inc" | variable == "eq_priv_inc") %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size=1.05)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = fin_year_labels, name="Year")+ scale_y_continuous(expand=c(0,0), name="Gini coefficient", limits=c(0,0.5)) + scale_color_manual(expand=c(0.03,0.03), values=PCcols, labels = income_labels)+ theme(legend.position="none", plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm")) # dev.off() # chart with disp, gross and private income for presentation on dark background, no points # emf(file = here("HES","Charts","ginis_income_presentation.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_gross_inc" | variable == "eq_priv_inc" ) %>% mutate(variable = factor(variable)) %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size=1.05)+ # geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = fin_year_labels, name="Year", expand = c(0.03, 0.03))+ scale_y_continuous(name="Gini coefficient", limits=c(0,0.5), breaks=seq(0,0.5,0.1), expand = c(0.0, 0.0)) + scale_color_manual(values=PCcolsPres2, labels = consumption_gini_labels)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() # chart with disp, gross and private income, and cons_no_in_kind and cons, for presentation on dark background, no points # emf(file = here("HES","Charts","ginis_presentation.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_gross_inc" | variable == "eq_priv_inc" | variable == "eq_cons_no_inkind" | variable == "eq_cons") %>% mutate(variable = factor(variable)) %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size=1.05)+ # geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = fin_year_labels, name="Year", expand = c(0.03, 0.03))+ scale_y_continuous(name="Gini coefficient", limits=c(0,0.5), breaks=seq(0,0.5,0.1), expand = c(0.0, 0.0)) + scale_color_manual(values=PCcolsPres, labels = consumption_gini_labels)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() # chart with disp, gross and private income, and cons_no_in_kind and cons, for presentation on dark background, 2016 column chart # emf(file = here("HES","Charts","ginis_presentation_3bar.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_priv_inc" | variable == "eq_cons") %>% filter(year==2016) %>% mutate(variable = factor(variable)) %>% ggplot(aes(y=gini, x= factor(variable, levels = income_consumption_levels), group = variable, fill=variable)) + geom_col(position="dodge") + scale_x_discrete(expand = c(0.03, 0.03), labels = income_consumption_labels)+ scale_y_continuous(expand=c(0.0,0.0), limits = c(0,0.8), breaks=seq(0,0.8,0.1))+ scale_fill_manual(values = PCcolsPres) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_blank(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.y = element_text(colour=white), axis.title.x = element_blank(), legend.position="none" ) + labs(x="", y = "Gini coefficient", fill = "Income decile:")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ######################################################################################################## #Marginal effect of income components on the Gini coefficient of income (figure 3.12) ######################################################################################################## #Effect of income tax on disposable income marginal_disp_ginis <- HESH_expanded %>% select(year, hhwt, eq_disp_inc, eq_gross_inc) %>% mutate(eq_disp_inc_non_zero = ifelse(eq_disp_inc > 0, eq_disp_inc,0)) %>% mutate(eq_gross_inc_non_zero = ifelse(eq_gross_inc > 0, eq_gross_inc,0)) %>% group_by(year) %>% summarise(eq_disp_inc_gini = gini(eq_disp_inc_non_zero, weights = hhwt), eq_gross_inc_gini = gini(eq_gross_inc_non_zero, weights = hhwt), marginal_effect = eq_disp_inc_gini-eq_gross_inc_gini) #Effect of labour, capital and transfers on gross income marginal_gross_ginis <- HESH_expanded %>% select(year, hhwt, eq_gross_inc, eq_lab_inc, eq_cap_inc, eq_trans_inc) %>% mutate(gross_total = ifelse(eq_gross_inc > 0, eq_gross_inc,0), gross_less_lab = ifelse(eq_gross_inc - eq_lab_inc > 0, eq_gross_inc - eq_lab_inc,0), gross_less_cap = ifelse(eq_gross_inc - eq_cap_inc > 0, eq_gross_inc - eq_cap_inc,0), gross_less_trans = ifelse(eq_gross_inc - eq_trans_inc > 0, eq_gross_inc - eq_trans_inc,0)) %>% gather(key = "variable", value = "value", c(gross_less_lab, gross_less_cap, gross_less_trans)) %>% group_by(year, variable) %>% summarise(gross_gini = gini(gross_total, weights = hhwt), gross_less_gini = gini(value, weights = hhwt), marginal_effect = gross_gini-gross_less_gini) #Combining all marginal effects marginal_disp_ginis <- marginal_disp_ginis %>% mutate(variable = "disp_less_tax") marginal_ginis <- bind_rows(marginal_gross_ginis,marginal_disp_ginis) #Chart 3.12 panel a # emf(file = here("HES","Charts","marginal_gini_effects_tax.emf"), width = 2.95276, height = 2.3622) marginal_ginis %>% filter(variable=="disp_less_tax") %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.1,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.12 panel b # emf(file = here("HES","Charts","marginal_gini_effects_capital.emf"), width = 2.95276, height = 2.3622) marginal_ginis %>% filter(variable=="gross_less_cap") %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.1,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.12 panel c # emf(file = here("HES","Charts","marginal_gini_effects_labour.emf"), width = 2.95276, height = 2.3622) marginal_ginis %>% filter(variable=="gross_less_lab") %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.35,-0.25)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.12 panel d # emf(file = here("HES","Charts","marginal_gini_effects_transfer.emf"), width = 2.95276, height = 2.3622) marginal_ginis %>% filter(variable=="gross_less_trans") %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.15,-0.05)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() ######################################################################################################## #Marginal effect of income components on the Gini coefficient of gross income (figure 3.13) ######################################################################################################## #Effect of different transfer components on gross income marginal_trans_ginis <- HESH_expanded %>% select(year, hhwt, eq_gross_inc, eq_age_trans, eq_disability_trans, eq_carer_trans, eq_student_trans, eq_working_trans, eq_family_trans, eq_uncategorised_trans) %>% mutate(gross_total = ifelse(eq_gross_inc > 0, eq_gross_inc,0), gross_less_age_trans = ifelse((eq_gross_inc - eq_age_trans) > 0, eq_gross_inc - eq_age_trans,0), gross_less_disability_and_carer_trans = ifelse((eq_gross_inc - eq_disability_trans - eq_carer_trans) > 0, eq_gross_inc - eq_disability_trans - eq_carer_trans,0), gross_less_student_and_working_trans = ifelse((eq_gross_inc - eq_student_trans - eq_working_trans) > 0, eq_gross_inc - eq_student_trans - eq_working_trans,0), gross_less_family_trans = ifelse((eq_gross_inc - eq_family_trans) > 0, eq_gross_inc - eq_family_trans,0), gross_less_uncategorised_trans = ifelse((eq_gross_inc - eq_uncategorised_trans) > 0, eq_gross_inc - eq_uncategorised_trans,0)) %>% gather(key = "variable", value = "value", c(gross_less_age_trans, gross_less_disability_and_carer_trans, gross_less_student_and_working_trans, gross_less_family_trans, gross_less_uncategorised_trans)) %>% group_by(year, variable) %>% summarise(gross_gini = gini(gross_total, weights = hhwt), gross_less_gini = gini(value, weights = hhwt), marginal_effect = gross_gini-gross_less_gini) #Chart 3.13 panel a # emf(file = here("HES","Charts","marginal_gini_effects_age_trans.emf"), width = 2.95276, height = 2.3622) marginal_trans_ginis %>% filter(variable=="gross_less_age_trans") %>% filter(year!=1994) %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.05,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.13 panel b # emf(file = here("HES","Charts","marginal_gini_effects_disability_and_carer_trans.emf"), width = 2.95276, height = 2.3622) marginal_trans_ginis %>% filter(variable=="gross_less_disability_and_carer_trans") %>% filter(year!=1994) %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.05,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.13 panel c # emf(file = here("HES","Charts","marginal_gini_effects_student_and_working_trans.emf"), width = 2.95276, height = 2.3622) marginal_trans_ginis %>% filter(variable=="gross_less_student_and_working_trans") %>% filter(year!=1994) %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.05,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() #Chart 3.13 panel d # emf(file = here("HES","Charts","marginal_gini_effects_family_trans.emf"), width = 2.95276, height = 2.3622) marginal_trans_ginis %>% filter(variable=="gross_less_family_trans") %>% filter(year!=1994) %>% ggplot(aes(x=year,y=marginal_effect, col = variable)) + geom_line(size=1)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = short_fin_year_labels, position = "top")+ scale_color_manual(values=PCcols)+ xlab("Year")+ ylab("Change in Gini coefficient")+ ylim(-0.05,0)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), legend.position = "none") # dev.off() ######################################################################################################## #Share of people of a given age in each income decile (figure 3.14) ######################################################################################################## #Chart # emf(file = here("HES","Charts","per_cent_age_group_in_inc_dec_legend_bottom.emf"), width = 5.90551, height = 3.14961) HESH %>% group_by(year,inc_dec) %>% summarise(under15s = sum(under15s * hhwt), `15to24` = sum(`15to24` * hhwt), `25to34` = sum(`25to34` * hhwt), `35to44` = sum(`35to44` * hhwt), `45to54` = sum(`45to54` * hhwt), `55to64` = sum(`55to64` * hhwt), `65plus` = sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "pop",-c("year","inc_dec")) %>% group_by(year, age_group) %>% mutate(percent = pop/sum(pop)) %>% filter(year==2016) %>% ggplot(aes(x=factor(age_group, levels = age_groups), y=percent*100, fill=factor(inc_dec), group=inc_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.1, 0.1), labels = age_group_labels)+ scale_y_continuous(expand=c(0,0), limits = c(0,30))+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position="bottom") + labs(x = "Age group", y = "Per cent", fill = "Income decile:")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ######################################################################################################## #Average annual growth rates in equivalised disposable income by time period and age group (figure 3.15) ######################################################################################################## #Chart # emf(file = here("HES","Charts","period_CAGR_mean_disp_inc_by_age_group.emf"), width = 5.90551, height = 3.14961) HESP %>% select(year,pswt, eq_yearly_disp_inc, age_group) %>% filter(!is.na(age_group)) %>% group_by(year, age_group) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = pswt))) %>% ungroup() %>% arrange(age_group,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year>1993) %>% ggplot(aes(x = factor(year), y = percent, fill = age_group, group = age_group))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma_format(digits=0), expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = HESP_period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Age group:")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() #Same as above but with unequivalised personal income HESP %>% select(year,pswt, yearly_disp_inc_pers, age_group) %>% filter(!is.na(age_group)) %>% group_by(year, age_group) %>% summarise(mean_value = (wtd.mean(yearly_disp_inc_pers, weight = pswt))) %>% ungroup() %>% arrange(age_group,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year>1993) %>% ggplot(aes(x = factor(year), y = percent, fill = age_group, group = age_group))+ geom_col(position="dodge")+ scale_y_continuous(labels = comma, expand=c(0.01,0.01))+ scale_x_discrete(breaks = HES_years, labels = HESP_period_labels, expand = c(0.01, 0.01))+ labs(x = "Time period", y = "Per cent", fill = "Age group:")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey)+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) ######################################################################################################## #Average equivalised disposable income by age and birth decade, 1988-89 to 2015-16 (figure 3.16) ######################################################################################################## #Chart birth_decade_data <- HESP %>% group_by(year, birth_decade) %>% filter(year!=1994, !is.na(birth_decade)) %>% summarise(disp_inc = weighted.mean(eq_yearly_disp_inc, pswt), age = weighted.mean(age_midpoint, pswt)) %>% filter(age <= 65) # emf(file = here("HES","Charts","mean_disp_inc_by_age_and_birth_decade.emf"), width = 2.95276, height = 3.14961) ggplot(birth_decade_data, aes(x = age, y = disp_inc, group = birth_decade, col = birth_decade))+ geom_point(size=2)+ geom_line(size=1.05)+ scale_y_continuous(expand=c(0,0), limits = c(0,80000), breaks=c(20000,40000,60000,80000), labels=comma_format(digits = 0))+ scale_x_continuous(expand = c(0.01, 0.01), breaks = c(seq(15,65,5)), limits = c(24,65)) + scale_color_manual(values=PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "none", legend.title.align = 0.5, legend.title = element_text()) + labs(x = "Average age of birth cohort", y = "Dollars", col = paste0("Decade",'\n', "of birth"))+ theme(plot.title = element_text(hjust = 0.5)) # dev.off() ##Same as above but using unequivalised personal income birth_decade_data <- HESP %>% group_by(year, birth_decade) %>% filter(!is.na(birth_decade)) %>% summarise(disp_inc = weighted.mean(yearly_disp_inc_pers, pswt), age = weighted.mean(age_midpoint, pswt)) %>% filter(age <= 65) # emf(file = here("HES","Charts","mean_disp_inc_pers_by_age_and_birth_decade.emf"), width = 2.95276, height = 3.14961) ggplot(birth_decade_data, aes(x = age, y = disp_inc, group = birth_decade, col = birth_decade))+ geom_point(size=2)+ geom_line(size=1.05)+ scale_y_continuous(expand=c(0,0), limits = c(0,80000), labels=comma_format(digits = 0))+ scale_x_continuous(expand = c(0.01, 0.01), breaks = c(seq(15,65,5)), limits = c(24,65))+ scale_color_manual(values=PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "none", legend.title.align = 0.5, legend.title = element_text()) + labs(x = "Average age of birth cohort", y = "Dollars", col = paste0("Decade",'\n', "of birth"))+ theme(plot.title = element_text(hjust = 0.5)) # dev.off() # same as above (unequivalised personal income) but full width and for presentation on dark background, 2016-17 dollars label # emf(file = here("HES","Charts","mean_disp_inc_pers_by_age_and_birth_decade_full_width_presentation.emf"), width = 5.90551, height = 3.14961) birth_decade_data <- HESP %>% group_by(year, birth_decade) %>% filter(!is.na(birth_decade)) %>% summarise(disp_inc = weighted.mean(yearly_disp_inc_pers, pswt), age = weighted.mean(age_midpoint, pswt)) %>% filter(age <= 65) ggplot(birth_decade_data, aes(x = age, y = disp_inc, group = birth_decade, col = birth_decade))+ # geom_point(size=2.00)+ geom_line(size=1.05)+ scale_y_continuous(expand=c(0,0), limits = c(0,80000), labels=comma_format(digits = 0))+ scale_x_continuous(expand = c(0.01, 0.01), breaks = c(seq(15,65,5)), limits = c(24,65))+ scale_color_manual(values=PCcolsPres)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), plot.title = element_text(hjust = 0.5), legend.position = "none", legend.title.align = 0.5, legend.title = element_text(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) + labs(x = "Average age of birth cohort", y = "Dollars (2016-17)", col = paste0("Decade",'\n', "of birth"))+ geom_label_repel(aes(label = birth_decade), fill = NA, segment.color = NA, data = subset(birth_decade_data, year == 2016 | (birth_decade == "1940s" & year == 2010)), nudge_x = 0, nudge_y = 5000, na.rm = TRUE, label.size = NA) # dev.off() #same as above but men only birth_decade_data <- HESP %>% group_by(year, birth_decade) %>% filter(!is.na(birth_decade), sex == 1) %>% summarise(disp_inc = weighted.mean(yearly_disp_inc_pers, pswt), age = weighted.mean(age_midpoint, pswt)) %>% filter(age <= 65) men_inc_plot <- ggplot(birth_decade_data, aes(x = age, y = disp_inc, group = birth_decade, col = birth_decade))+ geom_point()+ geom_line()+ scale_y_continuous(expand=c(0,0), limits = c(0,80000), labels = comma)+ scale_x_continuous(expand = c(0.01, 0.01), breaks = c(seq(15,65,5)), limits = c(24,65))+ scale_color_manual(values=PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "none", legend.title.align = 0.5, legend.title = element_text()) + labs(x = "Average age of birth cohort", y = "Dollars", col = paste0("Decade",'\n', "of birth"))+ ggtitle("Men")+ theme(plot.title = element_text(hjust = 0.5)) #same as above but women only birth_decade_data <- HESP %>% group_by(year, birth_decade) %>% filter(!is.na(birth_decade), sex==2) %>% summarise(disp_inc = weighted.mean(yearly_disp_inc_pers, pswt), age = weighted.mean(age_midpoint, pswt)) %>% filter(age <= 65) women_inc_plot <- ggplot(birth_decade_data, aes(x = age, y = disp_inc, group = birth_decade, col = birth_decade))+ geom_point()+ geom_line()+ scale_y_continuous(expand=c(0,0), limits = c(0,80000), labels = comma)+ scale_x_continuous(expand = c(0.01, 0.01), breaks = c(seq(15,65,5)), limits = c(24,65))+ scale_color_manual(values=PCcols)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "none", legend.title.align = 0.5, legend.title = element_text()) + labs(x = "Average age of birth cohort", y = "Dollars", col = paste0("Decade",'\n', "of birth"))+ geom_label_repel(aes(label = birth_decade), segment.color = NA, fill = NA, data = subset(birth_decade_data, year == 2016 | (birth_decade == "1940s" & year == 2010)), nudge_x = 0, nudge_y = 2000, na.rm = TRUE, label.size = NA)+ ggtitle("Women")+ theme(plot.title = element_text(hjust = 0.5)) #emf(file = here("HES","Charts","mean_disp_inc_pers_by_sex_and_age_and_birth_decade.emf"), width = 5.90551, height = 3.14961) #Men and women charts side by side grid.arrange(women_inc_plot, men_inc_plot, ncol = 2) #dev.off() ######################################################################################################## #Share of people from a particular household type in each income decile, 2015 16(figure 3.17) ######################################################################################################## #Chart # emf(file = here("HES","Charts","per_cent_household_type_in_inc_dec.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% group_by(year, inc_dec, household_type) %>% summarise(pop = sum(hhwt)) %>% ungroup() %>% complete(year, inc_dec,household_type) %>% #new line group_by(year, household_type) %>% mutate(percent = pop/sum(pop, na.rm=TRUE)) %>% #new line filter(year==2016) %>% ggplot(aes(x = household_type, y=percent*100, fill=factor(inc_dec), group=inc_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.2, 0.2), labels = household_type_labels_spaced)+ scale_y_continuous(expand=c(0,0), breaks = seq(0,60,10))+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text()) + labs(x = "Household type", y = "Per cent", fill = "Income decile:")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ######################################################################################################## #Average final equivalised consumption by income decile (figure 3.18) ######################################################################################################## #Chart # emf(file = here("HES","Charts","mean_consumption_by_inc_dec_and_year.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% filter(year!=1989) %>% group_by(year, inc_dec) %>% summarise(mean_cons = weighted.mean(eq_yearly_cons, w = hhwt)) %>% ggplot(aes(x = factor(inc_dec), y = mean_cons, fill = factor(year), group = factor(year))) + geom_col(position = "dodge")+ labs(x = "Income decile", y = "Dollars", fill = "Year")+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0,0), limits = c(0,110000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = inc_dec_labels)+ scale_fill_manual(values=PCcols, labels = fin_year_labels, name="Year:") + guides(fill=guide_legend(nrow=1, byrow=TRUE)) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), # axis.title.y = element_text(), legend.position = "bottom") # dev.off() ######################################################################################################## #Average equivalised income and consumption by income decile (figure 3.19) ######################################################################################################## # emf(file = here("HES","Charts","mean_income_consumption_savings_by_inc_dec.emf"), width = 5.90551, height = 6.29921) inc_plot <- HESH_expanded %>% select(year, hhwt, inc_dec, eq_yearly_disp_inc) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(inc_dec), y = mean_value))+ geom_col(position="dodge", fill = dark_blue)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(-10000,150000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = inc_dec_labels, name = "Income decile")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ geom_hline(yintercept = 0, colour = grey)+ ggtitle("Income") private_cons_plot <- HESH_expanded %>% select(year, hhwt, inc_dec, eq_yearly_cons_no_inkind) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_cons_no_inkind, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(inc_dec), y = mean_value))+ geom_col(position="dodge", fill = PC_green)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(-10000,150000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = inc_dec_labels, name = "Income decile")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ geom_hline(yintercept = 0, colour = grey)+ ggtitle("Private consumption") final_cons_plot <- HESH_expanded %>% select(year, hhwt, inc_dec, eq_yearly_cons) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_cons, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(inc_dec), y = mean_value))+ geom_col(position="dodge", fill = PC_green)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(-10000,150000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = inc_dec_labels, name = "Income decile")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ geom_hline(yintercept = 0, colour = grey)+ ggtitle("Final consumption") savings_plot <- HESH_expanded %>% select(year, hhwt, inc_dec, eq_yearly_savings) %>% group_by(year, inc_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_savings, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(inc_dec), y = mean_value))+ geom_col(position="dodge", fill = dark_green)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(-10000,150000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = inc_dec_labels, name = "Income decile")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ geom_hline(yintercept = 0, colour = grey)+ ggtitle("Savings") grid.arrange(inc_plot, private_cons_plot, final_cons_plot, savings_plot, ncol = 2) # dev.off() ######################################################################################################## #Gini coefficients for equivalised disposable income, private consumption and final consumption (figure 3.20) ######################################################################################################## consumption_gini_levels = c("eq_disp_inc", "eq_cons_no_inkind", "eq_cons") # emf(file = here("HES","Charts","consumption_ginis.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_cons_no_inkind" | variable == "eq_cons") %>% mutate(variable = factor(variable, levels = consumption_gini_levels)) %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size=1.05)+ geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = fin_year_labels, name="Year", expand = c(0.03, 0.03))+ scale_y_continuous(name="Gini coefficient", limits=c(0,0.4), breaks=seq(0,0.4,0.1), expand = c(0.0, 0.0)) + scale_color_manual(values=PCcols, labels = consumption_gini_labels)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none") # dev.off() # same chart - for presentation on dark background # emf(file = here("HES","Charts","ginis_cons_presentation.emf"), width = 5.90551, height = 3.14961) ginis %>% filter(variable == "eq_disp_inc" | variable == "eq_cons_no_inkind" | variable == "eq_cons") %>% mutate(variable = factor(variable)) %>% ggplot(aes(x=year,y=gini, col = variable, group = variable)) + geom_line(size=1.05)+ # geom_point(size=2)+ scale_x_continuous(breaks = HES_years, labels = fin_year_labels, name="Year", expand = c(0.03, 0.03))+ scale_y_continuous(name="Gini coefficient", limits=c(0,0.4), breaks=seq(0,0.4,0.1), expand = c(0.0, 0.0)) + scale_color_manual(values=PCcolsPres, labels = consumption_gini_labels)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() ######################################################################################################## #Average yearly in-kind transfers by income decile (figure 3.21) ######################################################################################################## inkind_types <- c( "eq_yearly_inkind_health", "eq_yearly_inkind_educ", "eq_yearly_inkind_welfare", "eq_yearly_inkind_govt_rent", "eq_yearly_inkind_childcare") #Chart # emf(file = here("HES","Charts","mean_inkind_by_income_decile.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year, hhwt, eq_yearly_inkind_educ, eq_yearly_inkind_health, eq_yearly_inkind_welfare, eq_yearly_inkind_govt_rent, eq_yearly_inkind_childcare, eq_yearly_cons, inc_dec) %>% filter(year==2016) %>% gather(inkind_type, value, c(-year, -inc_dec, -hhwt, -eq_yearly_cons)) %>% group_by(year, inkind_type, inc_dec) %>% summarise(inkind_mean = weighted.mean(value,hhwt)) %>% ggplot(aes(x = factor(inc_dec), y = inkind_mean, group = factor(inkind_type, levels = inkind_types), fill = factor(inkind_type, levels = inkind_types)))+ geom_col()+ scale_y_continuous(labels = comma_format(digits = 0), expand = c(0, 0), limits = c(0,20000))+ scale_x_discrete(expand = c(0.01, 0.01), labels=inc_dec_labels) + theme(legend.position = "right", axis.title.y = element_text(), text = element_text(size = 12), plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"))+ labs(x = "Income decile", y = "Dollars", fill = "Transfer type")+ scale_fill_manual(values = c(blue, dark_blue, PC_green, orange, yellow), labels = inkind_type_labels) # dev.off() ######################################################################################################## #Share of people of a given age in each income/consumption decile (figure 3.22) ######################################################################################################## #Chart 3.22 panel a # emf(file = here("HES","Charts","per_cent_age_group_in_inc_dec.emf"), width = 5.90551, height = 3.14961) HESH %>% group_by(year,inc_dec) %>% summarise(under15s = sum(under15s * hhwt), `15to24` = sum(`15to24` * hhwt), `25to34` = sum(`25to34` * hhwt), `35to44` = sum(`35to44` * hhwt), `45to54` = sum(`45to54` * hhwt), `55to64` = sum(`55to64` * hhwt), `65plus` = sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "pop",-c("year","inc_dec")) %>% group_by(year, age_group) %>% mutate(percent = pop/sum(pop)) %>% filter(year==2016) %>% ggplot(aes(x=factor(age_group, levels = age_groups), y=percent*100, fill=factor(inc_dec), group=inc_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.1, 0.1), labels = age_group_labels)+ scale_y_continuous(expand=c(0,0), limits = c(0,30))+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position="top") + labs(x = "Age group", y = "Per cent", fill = "Income decile")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() #Chart 3.22 panel b # emf(file = here("HES","Charts","per_cent_age_group_in_con_dec.emf"), width = 5.90551, height = 3.14961) HESH %>% group_by(year,cons_dec) %>% summarise(under15s = sum(under15s * hhwt), `15to24` = sum(`15to24` * hhwt), `25to34` = sum(`25to34` * hhwt), `35to44` = sum(`35to44` * hhwt), `45to54` = sum(`45to54` * hhwt), `55to64` = sum(`55to64` * hhwt), `65plus` = sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "pop",-c("year","cons_dec")) %>% group_by(year, age_group) %>% mutate(percent = pop/sum(pop)) %>% filter(year==2016) %>% ggplot(aes(x=factor(age_group, levels = age_groups), y=percent*100, fill=factor(cons_dec), group=cons_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.1, 0.1), labels = age_group_labels)+ scale_y_continuous(expand=c(0,0), limits = c(0,30))+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position="top") + labs(x = "Age group", y = "Per cent", fill = "Final consumption decile")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ################################################################################################## #CHAPTER 4 ################################################################################################## # chart 4.1 in HILDA code ############################################################################################################# #Average annual growth in wealth by wealth decile(figure 4.2) ############################################################################################################# # emf(file = here("HES","Charts","mean_wealth_by_wealth_dec.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% filter(year==2004 | year==2016) %>% group_by(year, wealth_dec) %>% summarise(mean_value = weighted.mean(eq_wealth, hhwt)) %>% ggplot(aes(x = factor(wealth_dec), y = mean_value, fill = factor(year), group = year))+ geom_col(position="dodge")+ scale_y_continuous(name="Dollars", labels = comma_format(digits = 0), expand = c(0, 0))+ scale_x_discrete(expand = c(0.01, 0.01), labels = wealth_dec_labels)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"))+ labs(x = "Wealth decile", fill = "Year")+ scale_fill_manual(values = PCcols, labels = fin_year_labels) # dev.off() ############################################## #Annualised growth rate of average wealth by wealth decile, 2003-04 to 2015-16 (figure 4.3) ################################################## # emf(file = here("HES","Charts","CAGR_mean_wealth_by_wealth_dec.emf"), width = 5.90551, height = 2.7) # note that height is less than standard to fit chart on page HESH_expanded %>% select(year,hhwt, wealth_dec, eq_wealth) %>% filter(year==2016 | year==2004) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_wealth, weight = hhwt))) %>% ungroup() %>% arrange(wealth_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year==2016) %>% ggplot(aes(x = wealth_dec, y = percent, fill = as.factor(wealth_dec) ) )+ geom_col(position="dodge")+ scale_y_continuous(labels = comma_format(digits=0), expand=c(0.01,0.01))+ scale_x_continuous(breaks = seq(1,10,1), expand = c(0.01, 0.01), labels = inc_dec_labels)+ theme(legend.position = "none", legend.title=element_blank())+ labs(x = "Wealth decile", y = "Per cent")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.line.x = element_blank())+ geom_hline(yintercept = 0, colour = grey) # dev.off() # same chart - for presentation on dark background # emf(file = here("HES","Charts","CAGR_mean_wealth_by_wealth_dec_presentation.emf"), width = 5.90551, height = 2.7) # note that height is less than standard to fit chart on page HESH_expanded %>% select(year,hhwt, wealth_dec, eq_wealth) %>% filter(year==2016 | year==2004) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_wealth, weight = hhwt))) %>% ungroup() %>% arrange(wealth_dec,year) %>% mutate(percent=(((mean_value/lag(mean_value))^(1/(year-lag(year)))) - 1)*100) %>% filter(year==2016) %>% ggplot(aes(x = wealth_dec, y = percent, fill = as.factor(wealth_dec) ) )+ geom_col(position="dodge")+ scale_y_continuous(labels = comma_format(digits=0), expand=c(0.01,0.01))+ scale_x_continuous(breaks = seq(1,10,1), expand = c(0.01, 0.01), labels = inc_dec_labels)+ theme(legend.position = "none", legend.title=element_blank())+ labs(x = "Wealth decile", y = "Per cent")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", axis.line.x = element_blank(), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white))+ geom_hline(yintercept = 0, colour = grey) # dev.off() # Figures 4.4 to 4.7 are in HILDA code ############################################################################################################# #Absolute (top figure) and percentage terms (bottom figure)(figure 4.8) ############################################################################################################# wealth_type_levels_consolidated = c("eq_super","eq_home_equity", "eq_other") #Chart 4.8 panel a HESH_expanded_PHIL <- HESH_expanded %>% filter(year==2016) %>% select(year, hhwt, wealth_dec, eq_home_equity, eq_super, eq_other) %>% gather(asset_type, value, -year, -hhwt, -wealth_dec) %>% group_by(asset_type, wealth_dec) %>% summarise(group_total = wtd.mean(value, hhwt) ) HESH_expanded_PHIL$asset_type <- fct_relevel(HESH_expanded_PHIL$asset_type,"eq_super","eq_home_equity") # emf(file = here("HES","Charts","wealth_decs_by_wealth_type_consolidated_stacked.emf"), width = 5.90551, height = 3.14961) ggplot(HESH_expanded_PHIL,aes(x=as.factor(wealth_dec), y=group_total, fill = factor(asset_type, levels = wealth_type_levels_consolidated), group = asset_type))+ geom_col(position="stack") + scale_y_continuous(expand=c(0,0), label=comma)+ scale_x_discrete(expand=c(0.01, 0.01), labels = inc_dec_labels)+ scale_fill_manual(values=PCcols, label = wealth_type_labels_consolidated)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "right", legend.title.align = 0.5, legend.title = element_text(face = "bold")) + labs(x = "Wealth decile",y = "Dollars", fill = "Wealth type") # dev.off() ###################################################### #Chart 4.8 panel b # emf(file = here("HES","Charts","wealth_decs_by_wealth_type_stacked.emf"), width = 5.90551, height = 3.14961) HESH_expanded_PHIL2 <- HESH_expanded %>% filter(year==2016) %>% select(year, hhwt, wealth_dec, eq_home_equity, eq_other_property_equity, eq_super, eq_business, eq_financial_equity, eq_vehicle_equity, eq_personal_equity) %>% gather(asset_type, value, -year, -hhwt, -wealth_dec) %>% group_by(asset_type, wealth_dec) %>% summarise(group_total = wtd.mean(value, hhwt) ) %>% filter(group_total > 0)%>% arrange(desc(group_total)) HESH_expanded_PHIL2$asset_type <- fct_relevel(HESH_expanded_PHIL2$asset_type,"eq_super","eq_home_equity", "eq_financial_equity","eq_business") ggplot(HESH_expanded_PHIL2,aes(x=as.factor(wealth_dec), y=group_total, fill = asset_type, group = asset_type))+ geom_col(position="fill") + scale_y_continuous(expand=c(0,0), label = function(x) x * 100)+ scale_x_discrete(expand=c(0.01, 0.01), labels = inc_dec_labels)+ scale_fill_manual(values= PCcols1, label = wealth_type_labels_consolidated1)+ PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.title.y = element_text(), legend.position = "right", legend.title.align = 0.5, legend.title = element_text(face = "bold")) + labs(x = "Wealth decile", y = "Per cent", fill = "Wealth type") # dev.off() # Figure 4.8 title - 'over half of household wealth is held in property' - TRUE about 52% (looking at equivalised wealth) HESH_expanded_PHIL2 %>% group_by(asset_type) %>% summarise(value=sum(group_total)) %>% ungroup() %>% mutate(perc = value/sum(value)) ############################################################################################################# #Absolute change in average household wealtha by wealth type and wealth decile (figure 4.9) ############################################################################################################# # emf(file = here("HES","Charts","dollar_change_in_wealth_type_by_wealth_dec.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% select(year, hhwt, wealth_dec, eq_home_equity, eq_other_property_equity, eq_super, eq_business, eq_financial_equity, eq_vehicle_equity, eq_personal_equity) %>% gather(wealth_type,value,c(-year,-wealth_dec, -hhwt)) %>% group_by(year, wealth_type, wealth_dec) %>% summarise(mean_value=wtd.mean(value, weight = hhwt)) %>% ungroup() %>% arrange(wealth_dec,wealth_type,year) %>% mutate(diff=mean_value-lag(mean_value,2)) %>% filter(year==2016) %>% ggplot(aes(x = wealth_type, y = diff, group = wealth_dec, fill = as.factor(wealth_dec)) ) + geom_col(position="dodge")+ scale_x_discrete(labels = wealth_type_labels, expand = c(0.01, 0.01))+ labs(x = "Type of wealth", y= "Dollars", fill = "Wealth decile")+ scale_fill_manual(values = PCcolsTen) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), axis.line.x = element_blank(), axis.title.y = element_text())+ geom_hline(yintercept = 0, colour = grey)+ scale_y_continuous(labels = comma_format(digits=0), expand=c(0,0), limits=c(-50000,265000), breaks=seq(-50000,250000,50000))+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() ############################################################################################################# #Joint distribution of wealth and income, per cent of total population (figure 4.10) ############################################################################################################# inc_wealth_prop <- as.data.frame(prop(wtd.table(HESH_expanded$inc_dec[HESH_expanded$year == 2016], HESH_expanded$wealth_dec[HESH_expanded$year == 2016], HESH_expanded$hhwt[HESH_expanded$year == 2016]))) colnames(inc_wealth_prop) <- c("inc_dec", "wealth_dec", "per_cent") inc_wealth_prop <- inc_wealth_prop %>% filter(inc_dec!="Total", wealth_dec!="Total") #Chart # emf(file = here("HES","Charts","inc_dec_by_wealth_dec_dodge.emf"), width = 5.90551, height = 3.14961) inc_wealth_prop %>% ggplot(aes(x = factor(wealth_dec), y = per_cent, fill = as.factor(inc_dec), group = factor(inc_dec))) + geom_col(position = "dodge")+ scale_y_continuous(expand=c(0,0))+ scale_x_discrete(expand=c(0.1, 0.01), label=wealth_dec_labels ) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = c(0.5,0.9), legend.title.align = 0.5, legend.title = element_text(face = "bold")) + labs(x = "Wealth decile", y = "Per cent", fill = "Income decile")+ scale_fill_manual(values = PCcolsTen) + guides(fill=guide_legend(nrow=1, byrow=TRUE))+ geom_hline(yintercept = 1, colour = black, size = 0.5, linetype = "dashed") # dev.off() ############################################################################################################# # Average income, consumption and wealth by wealth decile (figure 4.11) ############################################################################################################# # emf(file = here("HES","Charts","mean_income_consumption_wealth_by_wealth_dec.emf"), width = 5.90551, height = 6.29921) inc_plot <- HESH_expanded %>% select(year, hhwt, wealth_dec, eq_yearly_disp_inc) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_disp_inc, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(wealth_dec), y = mean_value))+ geom_col(position="dodge", fill = dark_blue)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(0,125000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = wealth_dec_labels, name = "Wealth decile")+ scale_fill_manual(values = PCcols)+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ ggtitle("Income") cons_plot <- HESH_expanded %>% select(year, hhwt, wealth_dec, eq_yearly_cons) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_cons, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(wealth_dec), y = mean_value))+ geom_col(position="dodge", fill = PC_green)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(0,125000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = wealth_dec_labels, name = "Wealth decile")+ scale_fill_manual(values = PCcols)+ PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ ggtitle("Final consumption") savings_plot <- HESH_expanded %>% select(year, hhwt, wealth_dec, eq_yearly_savings) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_yearly_savings, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(wealth_dec), y = mean_value))+ geom_col(position="dodge", fill = dark_green)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(0,125000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = wealth_dec_labels, name = "Wealth decile")+ scale_fill_manual(values = PCcols)+ PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ ggtitle("Savings") wealth_plot <- HESH_expanded %>% select(year, hhwt, wealth_dec, eq_wealth) %>% group_by(year, wealth_dec) %>% summarise(mean_value = (wtd.mean(eq_wealth, weight = hhwt))) %>% filter(year==2016) %>% ggplot(aes(x = factor(wealth_dec), y = mean_value))+ geom_col(position="dodge", fill = blue)+ scale_y_continuous(labels = comma_format(digits = 0), expand=c(0, 0), name = "Dollars", limits = c(0,2250000))+ scale_x_discrete(expand = c(0.01, 0.01), labels = wealth_dec_labels, name = "Wealth decile")+ scale_fill_manual(values = PCcols)+ PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,1.00,0.25), "cm"), legend.position = "none")+ theme(legend.position = "none", legend.title=element_blank(), strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), # panel.border = element_rect(colour = grey, fill = NA), axis.text.x = element_text(angle = 90, hjust = 1), plot.title = element_text(hjust=0.5, size = 10, face = "bold"))+ ggtitle("Wealth") grid.arrange(wealth_plot, inc_plot, cons_plot, savings_plot, ncol = 2) # dev.off() ############################################################################################################# #Share of age group in income and wealth deciles(figure 4.12) ############################################################################################################# #Wealth Chart # emf(file = here("HES","Charts","per_cent_age_group_in_wealth_dec.emf"), width = 5.90551, height = 3.14961) HESH %>% group_by(year,wealth_dec) %>% summarise(under15s = sum(under15s * hhwt), `15to24` = sum(`15to24` * hhwt), `25to34` = sum(`25to34` * hhwt), `35to44` = sum(`35to44` * hhwt), `45to54` = sum(`45to54` * hhwt), `55to64` = sum(`55to64` * hhwt), `65plus` = sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "pop",-c("year","wealth_dec")) %>% group_by(year, age_group) %>% mutate(percent = pop/sum(pop)) %>% filter(year==2016) %>% ggplot(aes(x=factor(age_group, levels = age_groups), y=percent*100, fill=factor(wealth_dec), group=wealth_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.1, 0.1), labels = age_group_labels)+ scale_y_continuous(expand=c(0,0), limits = c(0,30))+ scale_fill_manual(values = PCcolsTen) + PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position="top") + labs(x = "Age group", y = "Per cent", fill = "Wealth decile")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() #Income Chart # emf(file = here("HES","Charts","per_cent_age_group_in_inc_dec.emf"), width = 5.90551, height = 3.14961) HESH %>% group_by(year,inc_dec) %>% summarise(under15s = sum(under15s * hhwt), `15to24` = sum(`15to24` * hhwt), `25to34` = sum(`25to34` * hhwt), `35to44` = sum(`35to44` * hhwt), `45to54` = sum(`45to54` * hhwt), `55to64` = sum(`55to64` * hhwt), `65plus` = sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "pop",-c("year","inc_dec")) %>% group_by(year, age_group) %>% mutate(percent = pop/sum(pop)) %>% filter(year==2016) %>% ggplot(aes(x=factor(age_group, levels = age_groups), y=percent*100, fill=factor(inc_dec), group=inc_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.1, 0.1), labels = age_group_labels)+ scale_y_continuous(expand=c(0,0), limits = c(0,30))+ scale_fill_manual(values = PCcolsTen) + PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position="top") + labs(x = "Age group", y = "Per cent", fill = "Income decile")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # 4.13 in HILDA code ############################################################################################################# #Share of people from a particular household type in each wealth/income decile (figure 4.14) ############################################################################################################# # (in text) majority of these (families w dependend children and no one in paid work) relying on government transfers for most of their income - 93.2% HESH_expanded %>% filter(year==2016) %>% filter(inc_dec==1 | inc_dec==2) %>% filter(household_type=='family_unemployed') %>% select(year, hhwt, eq_trans_inc, eq_gross_inc) %>% mutate(maj_trans = ifelse(eq_trans_inc>0.5*eq_gross_inc, 1, 0)) %>% summarise(perc_maj_trans = sum(maj_trans*hhwt) / sum(hhwt) ) # (in text) Retiree households who receive pension payments typically have low incomes, although many have substantial wealth. More than half of this wealth is in the form of owner occupied housing HESH_expanded %>% filter(year==2016) %>% filter(household_type=='retiree_pension') %>% select(year, hhwt, eq_wealth, eq_home_equity) %>% summarise(sum(eq_home_equity*hhwt) / sum(eq_wealth*hhwt)) #Chart 4.14 panel a # emf(file = here("HES","Charts","per_cent_household_type_in_wealth_dec.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% group_by(year, wealth_dec, household_type) %>% summarise(pop = sum(hhwt)) %>% ungroup() %>% complete(year, wealth_dec,household_type) %>% group_by(year, household_type) %>% mutate(percent = pop/sum(pop, na.rm=TRUE)) %>% filter(year==2016) %>% ggplot(aes(x = household_type, y=percent*100, fill=factor(wealth_dec), group=wealth_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.2, 0.2),labels = household_type_labels_spaced)+ scale_y_continuous(expand=c(0,0), breaks=seq(0,90,10))+ scale_fill_manual(values = PCcolsTen) + PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position = "top") + labs(x = "Household type", y = "Per cent", fill = "Wealth decile:")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() #Chart 4.14 panel b # emf(file = here("HES","Charts","per_cent_household_type_in_inc_dec.emf"), width = 5.90551, height = 3.14961) HESH_expanded %>% group_by(year, inc_dec, household_type) %>% summarise(pop = sum(hhwt)) %>% ungroup() %>% complete(year, inc_dec,household_type) %>% group_by(year, household_type) %>% mutate(percent = pop/sum(pop, na.rm=TRUE)) %>% filter(year==2016) %>% ggplot(aes(x = household_type, y=percent*100, fill=factor(inc_dec), group=inc_dec)) + # geom_hline(yintercept = 10)+ geom_col(position = "dodge")+ scale_x_discrete(expand = c(0.2, 0.2), labels = household_type_labels_spaced)+ scale_y_continuous(expand=c(0,0), breaks = seq(0,90,10), limits=c(0,90))+ scale_fill_manual(values = PCcolsTen) + PC.theme.bar()+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.title = element_text(), legend.position = "top") + labs(x = "Household type", y = "Per cent", fill = "Income decile:")+ geom_hline(yintercept = 10, colour = black, size = 0.5, linetype = "dashed")+ guides(fill=guide_legend(nrow=1, byrow=TRUE)) # dev.off() # consumption deciles (in text) - Most families with dependent children and no one in paid work also have low consumption — more than 6 in 10 are in the bottom three final consumption deciles. HESH_expanded %>% group_by(year, cons_dec, household_type) %>% summarise(pop = sum(hhwt)) %>% ungroup() %>% complete(year, cons_dec,household_type) %>% group_by(year, household_type) %>% mutate(percent = pop/sum(pop, na.rm=TRUE)) %>% filter(year==2016) ######################################################################################################## # CHAPTER 6 ######################################################################################################## ######################################################################################################## # Various summary stats discussed in text ######################################################################################################## #Per cent in poverty perc_poverty <- HESH_expanded %>% group_by(year) %>% summarise(income = weighted.mean(inc_poverty, w = hhwt), consumption = weighted.mean(cons_poverty, w = hhwt), cons_no_in_kind = weighted.mean(cons_no_inkind_poverty, w = hhwt), wealth = weighted.mean(wealth_poverty, w = hhwt), financial_ABS = weighted.mean(fin_poverty_ABS, w = hhwt), financial_Headey_liquid_assets = weighted.mean(fin_poverty_Headey_liquid_assets, w = hhwt)) #Mean poverty gap mean_poverty_gap_dollars <- HESH_expanded %>% group_by(year) %>% summarise(income = weighted.mean(inc_poverty_line - eq_yearly_disp_inc, w = hhwt * inc_poverty), consumption = weighted.mean(cons_poverty_line - eq_yearly_cons, w = hhwt * cons_poverty), cons_no_in_kind = weighted.mean(cons_no_inkind_poverty_line - eq_yearly_cons_no_inkind, w = hhwt * cons_no_inkind_poverty)) mean_poverty_gap_percent <- HESH_expanded %>% group_by(year) %>% summarise(income = weighted.mean((inc_poverty_line - eq_yearly_disp_inc) / inc_poverty_line, w = hhwt * inc_poverty), consumption = weighted.mean((cons_poverty_line - eq_yearly_cons) / cons_poverty_line, w = hhwt * cons_poverty), cons_no_in_kind = weighted.mean((cons_no_inkind_poverty_line - eq_yearly_cons_no_inkind) / cons_no_inkind_poverty_line, w = hhwt * cons_no_inkind_poverty)) #Per cent in poverty by household type perc_poverty_by_household <- HESH_expanded %>% group_by(year, household_type_poverty) %>% summarise(income = weighted.mean(inc_poverty, w = hhwt), consumption = weighted.mean(cons_poverty, w = hhwt), cons_no_in_kind = weighted.mean(cons_no_inkind_poverty, w = hhwt), wealth = weighted.mean(wealth_poverty, w = hhwt), financial_ABS = weighted.mean(fin_poverty_ABS, w = hhwt), financial_Headey_liquid_assets = weighted.mean(fin_poverty_Headey_liquid_assets, w = hhwt)) ##Per cent in poverty by age group #Add poverty indicator to HESH for age calculations HESH_poverty <- HESH_expanded %>% select(ABSHID, year, inc_poverty, cons_no_inkind_poverty, wealth_poverty) HESH <- left_join(HESH, HESH_poverty, by=c("year", "ABSHID")) %>% distinct(year, ABSHID, .keep_all = TRUE) inc_poverty_by_age_group <- HESH %>% group_by(year) %>% summarise(under15s = sum(under15s * inc_poverty * hhwt)/sum(under15s * hhwt), `15to24` = sum(`15to24` * inc_poverty * hhwt)/sum(`15to24` * hhwt), `25to34` = sum(`25to34` * inc_poverty * hhwt)/sum(`25to34` * hhwt), `35to44` = sum(`35to44` * inc_poverty * hhwt)/sum(`35to44` * hhwt), `45to54` = sum(`45to54` * inc_poverty * hhwt)/sum(`45to54` * hhwt), `55to64` = sum(`55to64` * inc_poverty * hhwt)/sum(`55to64` * hhwt), `65plus` = sum(`65plus` * inc_poverty * hhwt)/sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "inc_poverty_rate",-year) cons_no_inkind_poverty_by_age_group <- HESH %>% group_by(year) %>% summarise(under15s = sum(under15s * cons_no_inkind_poverty * hhwt)/sum(under15s * hhwt), `15to24` = sum(`15to24` * cons_no_inkind_poverty * hhwt)/sum(`15to24` * hhwt), `25to34` = sum(`25to34` * cons_no_inkind_poverty * hhwt)/sum(`25to34` * hhwt), `35to44` = sum(`35to44` * cons_no_inkind_poverty * hhwt)/sum(`35to44` * hhwt), `45to54` = sum(`45to54` * cons_no_inkind_poverty * hhwt)/sum(`45to54` * hhwt), `55to64` = sum(`55to64` * cons_no_inkind_poverty * hhwt)/sum(`55to64` * hhwt), `65plus` = sum(`65plus` * cons_no_inkind_poverty * hhwt)/sum(`65plus` * hhwt)) %>% gather(key = "age_group", value = "cons_no_inkind_poverty_rate",-year) perc_poverty_by_age_group <- left_join(inc_poverty_by_age_group, cons_no_inkind_poverty_by_age_group, by = c("year", "age_group")) #Household type as % of total poverty perc_total_poverty_by_household <- HESH_expanded %>% group_by(year, household_type) %>% summarise(income_pop = sum(inc_poverty * hhwt), consumption_pop = sum(cons_poverty * hhwt), cons_no_in_kind_pop = sum(cons_no_inkind_poverty * hhwt), wealth_pop = sum(wealth_poverty * hhwt), financial_ABS_pop = sum(fin_poverty_ABS * hhwt), financial_Headey_liquid_assets_pop = sum(fin_poverty_Headey_liquid_assets * hhwt)) %>% ungroup() %>% group_by(year) %>% mutate(income = income_pop/sum(income_pop), consumption = consumption_pop/sum(consumption_pop), cons_no_in_kind = cons_no_in_kind_pop/sum(cons_no_in_kind_pop), wealth = wealth_pop/sum(wealth_pop), financial_ABS = financial_ABS_pop/sum(financial_ABS_pop), financial_Headey_liquid_assets = financial_Headey_liquid_assets_pop/sum(financial_Headey_liquid_assets_pop)) #Age group as % of total poverty perc_total_inc_poverty_by_age_group <- HESH %>% group_by(year) %>% summarise(under15s = sum(under15s * inc_poverty * hhwt), `15to24` = sum(`15to24` * inc_poverty * hhwt), `25to34` = sum(`25to34` * inc_poverty * hhwt), `35to44` = sum(`35to44` * inc_poverty * hhwt), `45to54` = sum(`45to54` * inc_poverty * hhwt), `55to64` = sum(`55to64` * inc_poverty * hhwt), `65plus` = sum(`65plus` * inc_poverty * hhwt)) %>% gather(key = "age_group", value = "inc_poverty_pop",-year) %>% group_by(year) %>% mutate(income = inc_poverty_pop/sum(inc_poverty_pop)) perc_cons_no_inkind_poverty_by_age_group <- HESH %>% group_by(year) %>% summarise(under15s = sum(under15s * cons_no_inkind_poverty * hhwt), `15to24` = sum(`15to24` * cons_no_inkind_poverty * hhwt), `25to34` = sum(`25to34` * cons_no_inkind_poverty * hhwt), `35to44` = sum(`35to44` * cons_no_inkind_poverty * hhwt), `45to54` = sum(`45to54` * cons_no_inkind_poverty * hhwt), `55to64` = sum(`55to64` * cons_no_inkind_poverty * hhwt), `65plus` = sum(`65plus` * cons_no_inkind_poverty * hhwt)) %>% gather(key = "age_group", value = "cons_no_inkind_poverty_pop",-year) %>% group_by(year) %>% mutate(cons_no_in_kind = cons_no_inkind_poverty_pop/sum(cons_no_inkind_poverty_pop)) perc_total_poverty_by_age_group <- left_join(perc_total_inc_poverty_by_age_group, perc_cons_no_inkind_poverty_by_age_group, by = c("year", "age_group")) #Per cent in poverty anchored to 1989 median perc_poverty_anchored <- HESH_expanded %>% group_by(year) %>% summarise(income_anchored = weighted.mean(inc_poverty_anchored, w = hhwt), wealth_anchored = weighted.mean(wealth_poverty_anchored, w = hhwt)) #Poverty line poverty_line <- HESH_expanded %>% group_by(year) %>% summarise(income = weighted.mean(inc_poverty_line, w = hhwt), consumption = weighted.mean(cons_poverty_line, w = hhwt), cons_no_in_kind = weighted.mean(cons_no_inkind_poverty_line, w = hhwt), wealth = weighted.mean(wealth_poverty_line, w = hhwt)) ######################################################################################################## # Per cent of population falling below each poverty threshold (figure 6.1) ######################################################################################################## #Chart # emf(file = here("HES","Charts","poverty_rates_by_year.emf"), width = 5.90551, height = 3.14961) perc_poverty %>% gather(key = "variable", value = "percent",-year) %>% filter(variable == "income" | variable == "consumption" | variable == "cons_no_in_kind" | variable == "financial_Headey_liquid_assets") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent in poverty", breaks=seq(0, 12, 2), limits=c(0,12.1))+ scale_x_continuous(expand=c(0.03,0.03),name = "Year", breaks = HES_years, labels = fin_year_labels)+ scale_color_manual(values=PCcols, labels = poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"),legend.position="none") # dev.off() # - chart as above but for presentation on dark background, no dots # emf(file = here("HES","Charts","poverty_rates_by_year_presentation.emf"), width = 5.90551, height = 3.14961) perc_poverty %>% gather(key = "variable", value = "percent",-year) %>% filter(variable == "income" | variable == "consumption" | variable == "cons_no_in_kind" | variable == "financial_Headey_liquid_assets") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ # geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent in poverty", breaks=seq(0, 12, 2), limits=c(0,12.1))+ scale_x_continuous(expand=c(0.03,0.03),name = "Year", breaks = HES_years, labels = fin_year_labels)+ scale_color_manual(values=PCcols, labels = poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white), legend.position="none") # dev.off() ######################################################################################################## # Per cent of population falling below the relative income poverty threshold (figure 6.2) ######################################################################################################## anchored_poverty_labels= as_labeller(c(income_anchored = "Income", consumption_anchored = "Final consumption", cons_no_in_kind_anchored = "Private consumption")) #Chart # emf(file = here("HES","Charts","anchored_poverty_rates_by_year.emf"), width = 5.90551, height = 3.14961) perc_poverty_anchored %>% gather(key = "variable", value = "percent",-year) %>% filter(variable!="wealth_anchored") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0), name="Per cent in poverty", limits=c(0,10), breaks=seq(0,10,2))+ scale_x_continuous(expand=c(0.03,0.03), name = "Year", breaks = HES_years, labels = fin_year_labels)+ scale_color_manual(values=PCcols, labels = anchored_poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"),legend.position="none") # dev.off() # income poverty and relative income poverty, for presentation on dark background perc_poverty_relative_anchored <- left_join(perc_poverty, perc_poverty_anchored, by="year") # emf(file = here("HES","Charts","poverty_relative_anchored_presentation.emf"), width = 2.95, height = 3.14961) perc_poverty_relative_anchored %>% gather(key = "variable", value = "percent",-year) %>% filter(variable == "income" | variable == "income_anchored") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ # geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent in poverty", breaks=seq(0, 20, 5), limits=c(0,20))+ scale_x_continuous(expand=c(0.03,0.03),name = "Year", breaks = HES_years, labels = short_fin_year_labels)+ scale_color_manual(values=PCcolsPres, labels = poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() # full width # emf(file = here("HES","Charts","poverty_relative_anchored_presentation_full.emf"), width = 5.90551, height = 3.14961) perc_poverty_relative_anchored %>% gather(key = "variable", value = "percent",-year) %>% filter(variable == "income" | variable == "income_anchored") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ # geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent in poverty", breaks=seq(0, 20, 5), limits=c(0,20))+ scale_x_continuous(expand=c(0.03,0.03),name = "Year", breaks = HES_years, labels = fin_year_labels)+ scale_color_manual(values=PCcolsPres, labels = poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() # just anchored # emf(file = here("HES","Charts","poverty_anchored_presentation_full.emf"), width = 5.90551, height = 3.14961) perc_poverty_relative_anchored %>% gather(key = "variable", value = "percent",-year) %>% filter( variable == "income_anchored") %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ # geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent in poverty", breaks=seq(0, 20, 5), limits=c(0,20))+ scale_x_continuous(expand=c(0.03,0.03),name = "Year", breaks = HES_years, labels = fin_year_labels)+ scale_color_manual(values=PCcolsPres, labels = poverty_labels) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none", axis.text.x = element_text(colour=white), axis.text.y = element_text(colour=white), axis.title.x = element_text(colour=white), axis.title.y = element_text(colour=white)) # dev.off() ######################################################################################################## # Average relative poverty gaps(figure 6.3) ######################################################################################################## #Chart 6.3 panel a # emf(file = here("HES", "Charts", "mean_poverty_gaps_dollars.emf"), width = 3, height = 3.14961) mean_poverty_gap_dollars %>% gather(key = "variable", value = "value",-year) %>% ggplot(aes(x=year,y=value,col=variable)) + geom_line(size=1.05)+ geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0), name="Dollars", labels = comma_format(digits = 0), limits = c(0,10000))+ scale_x_continuous(expand=c(0.05,0.05), name = "Year", breaks = c(1989,2004,2016), labels = fin_year_labels)+ PC.theme.line()+ scale_color_manual(values=PCcols) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none") # dev.off() #Chart 6.3 panel b # emf(file = here("HES", "Charts","mean_poverty_gaps_percent.emf"), width = 2.9, height = 3.14961) mean_poverty_gap_percent %>% gather(key = "variable", value = "percent",-year) %>% ggplot(aes(x=year,y=percent*100,col=variable)) + geom_line(size=1.05)+ geom_point(size=2, shape=16)+ scale_y_continuous(expand=c(0,0),name="Per cent", limits = c(0,70), breaks =seq(0,70,10))+ scale_x_continuous(expand=c(0.05,0.05), name = "Year", breaks = c(1989,2004,2016), labels = fin_year_labels)+ PC.theme.line()+ scale_color_manual(values=PCcols) + theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position="none") # dev.off() # Figure 6.4 & 6.5 - generated in Excel ######################################################################################################## # Poverty rates by household type (figure 6.6) ######################################################################################################## perc_poverty_by_household_plot <- perc_poverty_by_household %>% gather(key = "variable", value = "percent",c(-year,-household_type_poverty)) %>% filter(variable == "cons_no_in_kind" | variable == "income") %>% mutate(household_type_poverty_labels = case_when(household_type_poverty == "family_employed" ~ "Family,\n1+ employed", household_type_poverty == "family_unemployed" ~ "Family,\nno paid work", household_type_poverty == "retiree" ~ "Retiree", household_type_poverty == "working_age_employed" ~ "Working age,\nemployed", household_type_poverty == "working_age_unemployed" ~ "Working age,\nno paid work")) poverty_household_levels <- c("income", "cons_no_in_kind") # emf(file = here("HES","Charts","poverty_rates_by_household_type.emf"), width = 5.90551, height = 3.14961) perc_poverty_by_household_plot %>% ggplot(aes(x = year, y = percent*100, col = household_type_poverty)) + geom_line(size=1.05)+ geom_point(size=2)+ scale_y_continuous(name="Per cent in poverty", breaks=seq(0,60,10))+ scale_x_continuous(name="Year", breaks = HES_years, labels = short_fin_year_labels, limits = c(1989, 2022))+ theme(text=element_text(size=14), legend.position = "bottom",legend.title=element_blank())+ facet_wrap(~factor(variable, levels = poverty_household_levels), labeller = poverty_labels, ncol = 2)+ PC.theme.line()+ scale_colour_manual(values = PCcols, labels = household_type_labels_poverty)+ theme(plot.margin = unit(c(0.13,0.25,0.13,0.25), "cm"), legend.position = "none", strip.background = element_rect(fill = grey), strip.text = element_text(face = "bold"), panel.border = element_rect(colour = grey, fill = NA)) # dev.off() ######################################################################################################## # Code used to generate figures 6.7 & 6.8 in Excel ######################################################################################################## perc_poverty_by_age_group %>% gather(key = "variable", value = "percent",c(-year,-age_group)) %>% filter(!is.na(percent)) %>% View() #figures 6.9 - 6.11 in HILDA code #figure 6.12 generated in Excel #figure 6.13 in HILDA code #figure 6.14 - 6.16 generated in Excel # for Venn diagram - comparing 4 main poverty types, and overlap (used in presentation slides) HESH_expanded %>% select(year, hhwt, inc_poverty, cons_poverty, cons_no_inkind_poverty, fin_poverty_Headey_liquid_assets) %>% filter(year==2016) %>% mutate(no_poverty = ifelse(inc_poverty==0 & cons_poverty==0 & cons_no_inkind_poverty==0, 1, 0), one_inc_poverty = ifelse(inc_poverty==1 & cons_poverty==0 & cons_no_inkind_poverty==0, 1, 0), one_cons_poverty = ifelse(inc_poverty==0 & cons_poverty==1 & cons_no_inkind_poverty==0, 1, 0), one_cons_no_inkind_poverty = ifelse(inc_poverty==0 & cons_poverty==0 & cons_no_inkind_poverty==1, 1, 0), two_inc_cons_poverty = ifelse(inc_poverty==1 & cons_poverty==1 & cons_no_inkind_poverty==0, 1, 0), two_cons_cons_no_inkind_poverty = ifelse(inc_poverty==0 & cons_poverty==1 & cons_no_inkind_poverty==1, 1, 0), two_inc_cons_no_inkind_not_fin_poverty = ifelse(inc_poverty==1 & cons_poverty==0 & cons_no_inkind_poverty==1 & fin_poverty_Headey_liquid_assets==0, 1, 0), three_not_cons_poverty = ifelse(inc_poverty==1 & cons_poverty==0 & cons_no_inkind_poverty==1 & fin_poverty_Headey_liquid_assets==1, 1, 0), three_not_fin_poverty = ifelse(inc_poverty==1 & cons_poverty==1 & cons_no_inkind_poverty==1 & fin_poverty_Headey_liquid_assets==0, 1, 0), four_incl_fin_poverty = ifelse(inc_poverty==1 & cons_poverty==1 & cons_no_inkind_poverty==1 & fin_poverty_Headey_liquid_assets==1, 1, 0)) %>% summarise(#tot_pop = sum(hhwt), tot_no_poverty = sum(no_poverty*hhwt), tot_one_inc_poverty = sum(one_inc_poverty*hhwt), tot_one_cons_poverty = sum(one_cons_poverty*hhwt), tot_one_cons_no_inkind_poverty = sum(one_cons_no_inkind_poverty*hhwt), tot_two_inc_cons_poverty = sum(two_inc_cons_poverty*hhwt), tot_two_cons_cons_no_inkind_poverty = sum(two_cons_cons_no_inkind_poverty*hhwt), tot_two_inc_cons_no_inkind_not_fin_poverty = sum(two_inc_cons_no_inkind_not_fin_poverty*hhwt), tot_three_not_cons_poverty = sum(three_not_cons_poverty*hhwt), tot_three_not_fin_poverty = sum(three_not_fin_poverty*hhwt), tot_four_incl_fin_poverty = sum(four_incl_fin_poverty*hhwt) ) %>% gather(key="variable", value="pop", -year) %>% # arrange(pop) %>% # mutate(culm=cumsum(pop)) %>% mutate(perc = 100*pop/sum(pop))