Economist Plot
Steven Surya Tanujaya
July 24, 2019
This is my attempt to duplicate this economist plot.
bp <- read.csv("Blood_Pressure.csv",header = F)
bp<-bp[1:200,]
names(bp)<- c("Country","ISO","Man_prevalence","Woman_prevalence","Text","Category")
bp$Man_prevalence<-bp$Man_prevalence*100
bp$Woman_prevalence<-bp$Woman_prevalence*100
bp$Category<-factor(bp$Category, levels=c("Central and Eastern Europe","High-Income Western","Sub-Saharan Africa","Other"))
head(bp,30)## Country ISO Man_prevalence Woman_prevalence Text
## 1 Albania ALB 33.0165 25.0051
## 2 Bosnia and Herzegovina BIH 33.9592 27.5857
## 3 Bulgaria BGR 33.6334 22.9666
## 4 Croatia HRV 38.4052 26.3309 Croatian
## 5 Czech Republic CZE 34.4005 21.1890
## 6 Estonia EST 34.2512 20.8743
## 7 Hungary HUN 36.0937 23.9852
## 8 Latvia LVA 36.4342 22.9443
## 9 Lithuania LTU 36.1294 23.0609
## 10 Macedonia (TFYR) MKD 32.7202 24.0737
## 11 Montenegro MNE 34.3683 23.8256
## 12 Poland POL 34.5629 22.9717
## 13 Romania ROU 34.7345 25.1701
## 14 Serbia SRB 33.7858 25.1538
## 15 Slovakia SVK 34.2575 22.8467
## 16 Slovenia SVN 35.7978 24.9390
## 17 Andorra AND 23.1990 14.1659
## 18 Antigua and Barbuda ATG 26.4043 20.3508
## 19 Argentina ARG 27.5787 17.6478
## 20 Australia AUS 18.0209 12.3193
## 21 Austria AUT 25.1695 16.8004
## 22 Bahamas BHS 25.2054 16.8495
## 23 Barbados BRB 26.9746 21.6732
## 24 Belgium BEL 22.3969 12.5584
## 25 Canada CAN 15.5854 10.7832 Canada
## 26 Chile CHL 25.3772 16.5205
## 27 Costa Rica CRI 21.0475 16.3033
## 28 Cyprus CYP 23.8914 15.4575
## 29 Denmark DNK 26.4563 14.7673
## 30 Finland FIN 23.9947 14.6599
## Category
## 1 Central and Eastern Europe
## 2 Central and Eastern Europe
## 3 Central and Eastern Europe
## 4 Central and Eastern Europe
## 5 Central and Eastern Europe
## 6 Central and Eastern Europe
## 7 Central and Eastern Europe
## 8 Central and Eastern Europe
## 9 Central and Eastern Europe
## 10 Central and Eastern Europe
## 11 Central and Eastern Europe
## 12 Central and Eastern Europe
## 13 Central and Eastern Europe
## 14 Central and Eastern Europe
## 15 Central and Eastern Europe
## 16 Central and Eastern Europe
## 17 High-Income Western
## 18 Other
## 19 Other
## 20 High-Income Western
## 21 High-Income Western
## 22 High-Income Western
## 23 Other
## 24 High-Income Western
## 25 High-Income Western
## 26 Other
## 27 Other
## 28 High-Income Western
## 29 High-Income Western
## 30 High-Income Westernlibrary(ggplot2)## Registered S3 methods overwritten by 'ggplot2':
## method from
## [.quosures rlang
## c.quosures rlang
## print.quosures rlanglibrary(ggrepel)
result <- ggplot(bp,aes(x=Woman_prevalence,y=Man_prevalence,col=bp$Category,legend.title=NULL))+ geom_ribbon(aes(x=luas,ymin=0,ymax=luas), fill="#E9F2F7",alpha=0.4,show.legend=FALSE,inherit.aes = FALSE)+
geom_point(size=2.5)+geom_text_repel(data=bp,aes(label=Text),color="black")
result<- result + theme_minimal()+
labs(
title="Matters of the heart",
subtitle="Prevalance of raised blood pressure*,by sex,2015,%",
caption="Source: MCD Risk Factor Collaboration",
x="Woman",
y="Man"
)
result<-result+scale_x_continuous(breaks=seq(0,40,by=10))+scale_y_continuous(breaks=seq(0,40,by=10))
result<-result+expand_limits(y=c(0,40),x=c(0,40))+theme(panel.grid.minor=element_blank(),panel.grid.major=element_line(colour="#dbe2e7",size=0.5),legend.position="top",legend.title=element_blank())
result<-result+geom_abline(intercept=0,slope=1,linetype="dashed",color="#95acb8")
result<-result+scale_color_manual(values=c("#f15b40","#eca221","#00526d","#b0c6d2"))
#result<-result+geom_text(aes(x=x1,y=y1,label=texthere),data.frame(x1=30,y1=10,texthere="Woman more likely to have high blood pressure"))
library(grid)
grob = grobTree(textGrob("Women more likely \n to have high blood \n pressure \n", x=0.75, y=0.25, just = "centre", gp=gpar(col="#628495", fontsize=12)))
grob1 = grobTree(textGrob("Men more likely \n to have high blood \n pressure \n", x=0.25, y=0.875, just = "centre", gp=gpar(col="#628495", fontsize=12)))
luas <- seq(0.2,40, by=0.2)
result+ annotation_custom(grob1) + annotation_custom(grob) 