本节我们使用TidyTuesday 2021-02-09发布的项目数据集来进行数据分析；该数据集是关于随着时间的推移美国不同种族的财富和收入情况的变化；各位看官老爷细细品味，喜欢请关注个人公众号R语言数据分析指南持续分享更多优质资源
pacman::p_load(tidytuesdayR,knitr,tidyverse,glue,
ggtext,textclean,scales,magick)
TTdata <- tidytuesdayR::tt_load('2021-02-09')
Homedata <- TTdata$home_owner
Homedata_summary1976 <- Homedata %>%
filter(year == "1976")
Homedata_summary2016 <- Homedata %>%
filter(year == "2016")
house <- image_read("House_transparent.png")
house <- image_fill(house, "white")
raster <- as.raster(house)
1976
housefacet1976 <- Homedata_summary1976 %>%
ggplot(aes(x = 0, y = home_owner_pct, fill = race)) +
geom_bar(stat = "identity") +
ylim(0,1)+
geom_hline(aes(yintercept = Homedata_summary1976$home_owner_pct),
color = "#333333", size = 2 ) +
annotation_raster(raster,-Inf,Inf,0,Inf)+
scale_fill_manual(values = c("Black" = "#836d9c",
"Hispanic" = "#4EA2A0",
"White" = "#518557"))+
facet_wrap(~race) +theme_void()+
theme(legend.position = "none",
text = element_text(family = 'AvantGarde Bk BT'),
plot.title = element_textbox_simple(
size = 18,color = "#333333",padding = margin(5,5,5,5),
margin = margin(19,0,0,0),halign = 0,
face = "bold"),
plot.subtitle = element_textbox_simple(size = 16,
color = "#333333",padding = margin(5,5,5,5),
margin = margin(0,0,0,0),halign = 0,
face = "italic"),strip.text = element_blank()) +
labs(title = "Percentage of Home Ownership in 1976",
subtitle = "By Race")+
geom_label(aes(y = Homedata_summary1976$home_owner_pct,
label = percent(Homedata_summary1976$home_owner_pct)),
hjust = .5,fill = "#333333",color = "#ffffff",label.size = NA)
ggsave("1976.png", height = 3.88,width = 8,units = "in",dpi = 100)
2016
housefacet2016 <- Homedata_summary2016 %>%
ggplot(aes(x = 0, y = home_owner_pct, fill = race)) +
geom_bar(stat = "identity") +
ylim(0,1)+
geom_hline(aes(yintercept = Homedata_summary2016$home_owner_pct),
color = "#333333", size = 2 ) +
annotation_raster(raster,-Inf,Inf,0,Inf)+
scale_fill_manual(values = c("Black" = "#836d9c",
"Hispanic" = "#4EA2A0",
"White" = "#518557"))+
facet_wrap(~race) +theme_void()+
theme(legend.position = "none",
text = element_text(family = 'AvantGarde Bk BT'),
plot.title = element_textbox_simple(
size = 18,color = "#333333",padding = margin(5,5,5,5),
margin = margin(19,0,0,0),halign = 0,face = "bold"),
plot.subtitle = element_textbox_simple(size = 16,
color = "#333333",padding = margin(5,5,5,5),
margin = margin(0,0,0,0),halign = 0,
face = "italic"),strip.text = element_blank()) +
labs(title = "Percentage of Home Ownership in 2016",
subtitle = "By Race")+
geom_label(aes(y = Homedata_summary2016$home_owner_pct,
label = percent(Homedata_summary2016$home_owner_pct)),
hjust = .5,fill = "#333333",
color = "#ffffff",label.size = NA)
ggsave("2016.png", height = 3.88,width = 8,units = "in",dpi = 100)
Loading in PNG facets
#1976===
facet1976 <- png::readPNG("1976.png")
facet1976 <- grid::rasterGrob(facet1976, interpolate = TRUE)
#2016===
facet2016 <- png::readPNG("2016.png")
facet2016 <- grid::rasterGrob(facet2016, interpolate = TRUE)
Legend Points
legenddata <- data.frame(x = rep(4.2,3),
y =c(5.35,4.8,4.25),
label = c("Black","Hispanic","White"))
completehomeplot <- ggplot()+
xlim(0,5)+ylim(0,10)+
annotation_custom(facet1976, xmin = 0, xmax = 5, ymin = 5, ymax = 10) +
annotation_custom(facet2016, xmin = 0, xmax = 5, ymin = 0, ymax = 5) +
theme_void()+
geom_rect(aes(xmin=4.15, xmax =5, ymin = 3.8, ymax = 6),
fill = "#333333",linetype = "dotted",
color = "#333333",alpha = .4)+
geom_point(data = legenddata, aes(x=x, y = y),
color = c("#836d9c","#4EA2A0","#518557"),size = 6)+
geom_text(data = legenddata, aes(x = x, y = y),
nudge_x = 0.1, label = legenddata$label,
size = 6,hjust = 0,
color = c("#836d9c","#4EA2A0","#518557"),
fontface = "bold")+
annotate(geom = "text",label = "Races:",
color = "#ffffff",fontface = "bold",
size = 5,x = 4.45, y = 5.7,hjust = 0,vjust = 0)
completehomeplot
喜欢请关注个人公众号R语言数据分析指南,点击原文链接获取数据
原文链接：https://mp.weixin.qq.com/s/_n3phC3zHbbc5_OvtFCBjQ
网友评论