rm(list = ls())
library("ggplot2")
library("tidyr")
## Warning: package 'tidyr' was built under R version 4.0.4
library("magrittr")
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:tidyr':
##
## extract
library("dplyr")
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
#install.packages("showtext")
#install.packages("Cairo")
library("showtext")
## Warning: package 'showtext' was built under R version 4.0.5
## Loading required package: sysfonts
## Warning: package 'sysfonts' was built under R version 4.0.5
## Loading required package: showtextdb
## Warning: package 'showtextdb' was built under R version 4.0.5
library("Cairo")
#font_add("myfont","msyh.ttc")
mydata<-data.frame(
index=c("all jobs","jobs at the same level",
"jobs at the same level\nand the same company",
"jobs at the same level,\ncompany and function"),
Britain=c(28.6,9.3,2.6,0.8),
France=c(17.0,4.0,3.1,2.7),
Germany=c(15.1,3.6,3.1,3.0))
########################### rectangle data
rect_data<-mydata %>% gather(class,Value,-index)
rect_data<-within(rect_data,{
x_start=NA
x_end=NA
y_start=NA
y_end=NA
x_start[class=="Britain"]=35-Value[class=="Britain"]/2
x_end[class=="Britain"] =35+Value[class=="Britain"]/2
x_start[class=="France"]=60-Value[class=="France"]/2
x_end[class=="France"] =60+Value[class=="France"]/2
x_start[class=="Germany"]=80-Value[class=="Germany"]/2
x_end[class=="Germany"] =80+Value[class=="Germany"]/2
y_start=(c(50,35,20,5) -2.5) %>% rep(.,3)
y_end =(c(50,35,20,5) +2.5) %>% rep(.,3)
})
head(rect_data)
## index class Value y_end y_start
## 1 all jobs Britain 28.6 52.5 47.5
## 2 jobs at the same level Britain 9.3 37.5 32.5
## 3 jobs at the same level\nand the same company Britain 2.6 22.5 17.5
## 4 jobs at the same level,\ncompany and function Britain 0.8 7.5 2.5
## 5 all jobs France 17.0 52.5 47.5
## 6 jobs at the same level France 4.0 37.5 32.5
## x_end x_start
## 1 49.30 20.70
## 2 39.65 30.35
## 3 36.30 33.70
## 4 35.40 34.60
## 5 68.50 51.50
## 6 62.00 58.00
dim(rect_data) #[1] 12 7
## [1] 12 7
#################################plot rectangle
paltte1<-c("#038980","#00A1D7","#ED594D")
ggplot()+
geom_rect(data=rect_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end,fill=class))+
scale_fill_manual(values=paltte1)+
theme_void()
#################################ploygon data
ploygon=function(mydata) {
Bartain=mydata %>% filter(class=="Britain") %>% select(x_start,x_end) %>% as.matrix(.,nrow=4) %>% as.numeric() %>% .[c(1,5,6,2,2,6,7,3,3,7,8,4)]
France =mydata %>% filter(class=="France") %>% select(x_start,x_end) %>% as.matrix(.,nrow=4) %>% as.numeric() %>% .[c(1,5,6,2,2,6,7,3,3,7,8,4)]
Germany=mydata %>% filter(class=="Germany") %>% select(x_start,x_end) %>% as.matrix(.,nrow=4) %>% as.numeric() %>% .[c(1,5,6,2,2,6,7,3,3,7,8,4)]
long=c(Bartain,France,Germany)
lat= mydata %>% .[1:4,] %>% select(y_end,y_start) %>% as.matrix(.,nrow=4) %>% as.numeric() %>% .[c(5,5,2,2,6,6,3,3,7,7,4,4)] %>% rep(3)
ploygon=rep(LETTERS[1:9],each=4)
label=rep(c("Britain","France","Germany"),each=12)
return(data.frame(long,lat,ploygon,label))
}
ploygon_data=ploygon(rect_data)
head(ploygon_data)
## long lat ploygon label
## 1 20.70 47.5 A Britain
## 2 49.30 47.5 A Britain
## 3 39.65 37.5 A Britain
## 4 30.35 37.5 A Britain
## 5 30.35 32.5 B Britain
## 6 39.65 32.5 B Britain
dim(ploygon_data) #[1] 36 4
## [1] 36 4
##############################plot ploygon
paltte2<-c("#7EB9B5","#77CCEB","#F7AA8C")
ggplot()+
geom_polygon(data=ploygon_data,aes(x=long,y=lat,group=ploygon,fill=label))+
scale_fill_manual(values=paltte2)+
theme_void()
#######################################backgroud
raster_data<-data.frame(
x_start=0,
x_end =90,
y_start=c(0,15,30,45),
y_end=c(10,25,40,55)
)
ggplot()+
geom_rect(data=raster_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end),fill="#E8F2F4")+
theme_void()
####################################
ggplot()+
geom_rect(data=raster_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end),fill="#E8F2F4")+
geom_rect(data=rect_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end,fill=class))+
geom_polygon(data=ploygon_data,aes(x=long,y=lat,group=ploygon,fill=label))+
scale_fill_manual(values=paltte1)+
scale_fill_manual(values=paltte2)+
theme_void()
## Scale for 'fill' is already present. Adding another scale for 'fill', which
## will replace the existing scale.
####################################
CairoPNG(file="funnel_chart.png",width=1200,height=700)
showtext.begin()
## 'showtext.begin()' is now renamed to 'showtext_begin()'
## The old version still works, but consider using the new function in future code
ggplot()+
#底纹图层
geom_rect(data=raster_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end),fill="#E8F2F4")+
#条形图图层
geom_rect(data=rect_data,aes(xmin=x_start,xmax=x_end,ymin=y_start,ymax=y_end,fill=class),show.legend = FALSE)+
#三个图层共同描绘条形图之间的连接带
geom_polygon(data=ploygon_data[ploygon_data$label=="Britain",],aes(x=long,y=lat,group=ploygon),fill=paltte2[1])+
geom_polygon(data=ploygon_data[ploygon_data$label=="France",], aes(x=long,y=lat,group=ploygon),fill=paltte2[2])+
geom_polygon(data=ploygon_data[ploygon_data$label=="Germany",], aes(x=long,y=lat,group=ploygon),fill=paltte2[3])+
#左侧解释性文本
geom_text(data=NULL,aes(x=0.5,y=c(5,20,35,50),label=rev(mydata$index)),hjust=0,size=6.5,lineheight=.8)+
#国家分类标签
geom_text(data=NULL,aes(x=c(35,60,80),y=57.5,label=c("Britain","France","German")),hjust=.5,size=8)+
#数据标签
geom_text(data=rect_data,aes(x=x_start+(x_end-x_start)/2,y=y_start+(y_end-y_start)/2,label=Value),size=6,colour="white")+
scale_fill_manual(values=paltte1)+
annotate("text", x = 6, y = 57.5, label = "Pay gap for:",size=9)+
labs(
title="like-for-like",
subtitle="Pay gap between women and men,2016,% of men's wages*",
caption="Sour:Korn Ferry"
)+
xlim(0,90)+
ylim(0,60)+
theme_void(base_size=20,base_family = "myfont") %+replace%
theme(
plot.title = element_text(hjust=0.045,lineheight=3,size=32),
plot.subtitle = element_text(hjust = 0.08,lineheight=3),
plot.caption = element_text(hjust=0.05),
plot.margin = unit(c(1,0,1,0), "lines")
)
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family 'myfont' not found, will use 'sans' instead
showtext.end()
## 'showtext.end()' is now renamed to 'showtext_end()'
## The old version still works, but consider using the new function in future code
dev.off()
## png
## 2
#ref https://zhuanlan.zhihu.com/p/30631439
#install.packages("eoffice")
library(eoffice)
## Warning: package 'eoffice' was built under R version 4.0.5
## Bioconductor version '3.11' is out-of-date; the current release version '3.13'
## is available with R version '4.1'; see https://bioconductor.org/install
topptx(filename ="funnel.pptx")