ggplot2-数据分布型图表

最新推荐文章于 2024-06-06 19:04:30 发布
最新推荐文章于 2024-06-06 19:04:30 发布
阅读量4.4k 收藏 37
点赞数 9
分类专栏： ggplot2 R
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/qq_25055921/article/details/99705275
版权
ggplot2 同时被 2 个专栏收录
6 篇文章 3 订阅
订阅专栏
R
5 篇文章 2 订阅
订阅专栏

ggplot2-数据分布型图表

沈益

8/15/2019

5.0 图表总览

a)散点抖动图

p <- ggplot(mydata, aes(Class, Value))+
  geom_jitter(fill =color[4],position = position_jitter(0.2),shape=21, size = 3)+
  scale_y_continuous(breaks=seq(0,6,1))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        axis.title.x = element_blank(),
        legend.position="none"
  )
p

c) 点状图

p <- ggplot(mydata, aes(Class, Value)) + 
  geom_dotplot(fill = color[4], binaxis = "y", stackdir = "center", dotsize = 0.8) + 
  scale_y_continuous(breaks = seq(0, 6, 1)) + 
  theme_classic() +  # 设置主题
  theme(panel.background = element_rect(fill = "white", colour = "black", size = 0.25),
        axis.line = element_line(color = "black", size = 0.25),
        axis.title = element_text(size = 13, face = "plain", color = "black"), 
        axis.text = element_text(size = 12, face = "plain", color = "black"), 
        legend.position = "none")
p

d)统计直方图

ggplot(mydata, aes(Value, fill=Value)) + 
  geom_histogram(alpha=1, fill=color[4], colour = "black", size = 0.25) +
  coord_flip() + 
  theme_classic() + 
  scale_x_continuous(breaks = seq(0, 6, 1)) + 
  theme(
    panel.background = element_rect(color = "black"), 
    text = element_text(size = 15, color = "black"), 
    plot.title = element_text(size = 15, face = "bold.italic", hjust = .5, colour = "black"), 
    legend.position = c(0.8, 0.8), 
    legend.background = element_blank()
  )

e) 核密度估计图

ggplot(mydata, aes(Value,  fill=Value))+ 
  geom_density(alpha=1,colour="black",size=0.25,fill=color[4])+
  coord_flip()+
  theme_classic()+
  scale_x_continuous(breaks=seq(0,6,1))+
  theme(
    panel.background  = element_rect(color="black"),
    text=element_text(size=15,color="black"),
    plot.title=element_text(size=15,family="myfont",face="bold.italic",hjust=.5,color="black"),
    legend.position=c(0.8,0.8),
    legend.background = element_blank()
  )

f) 带误差线的散点图

p <- ggplot(mydata, aes(Class, Value))+
  geom_dotplot(fill="white",binaxis='y', stackdir='center', dotsize = 0.8)+
  stat_summary(fill = color[4],fun.data="mean_sdl", fun.args = list(mult=1),
               geom="pointrange", color = "black",size =2 ,shape=21)+
  
  scale_y_continuous(breaks=seq(0,6,1))+
  ylab("Value")+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )
p

g) 带误差线的柱形图

p <- ggplot(mydata, aes(Class, Value))+ 
  stat_summary(fill =color[4],fun.y=mean, geom='bar',colour="black",width=.7,size=0.5) +
  stat_summary(fun.data = mean_sdl, geom='errorbar', color='black',width=.2,size=0.5) + 
  geom_jitter(fill ="white",position = position_jitter(0.2),shape=21, size = 2,alpha=0.9)+
  scale_y_continuous(breaks=seq(0,6,1))+
  ylab("Value")+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )
p

h) 梯度图

library(denstrip)
#pdf("images/four-denstrip2.pdf", width = 4, height = 4)
par(mar = c(2.1, 2.1, .1, .1))
plot(c(0.5, 1.5), range(mydata$Value), type = "n", axes = F, xlab = "Class", ylab = "Value")
rect(-10, -10, 10, 10, col = "white")
denstrip(mydata$Value, at = 1,mticks=mean(mydata$Value), hor = F, width = 0.75, bw = 0.2, colmax=brewer.pal(7,"Set2")[c(5)],
         colmin="white",mlen=1.1,mcol="black")
box()
axis(2)
axis(1, at = 1, labels = "Class")

i) 箱型图

p <- ggplot(mydata, aes(Class, Value))+ 
  geom_boxplot(fill =color[4],notch = FALSE) +
  theme_classic()+
  scale_y_continuous(breaks=seq(0,6,1))+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )
p

带凹槽的箱型图

p <- ggplot(mydata, aes(Class, Value))+ 
  geom_boxplot(fill =color[4],notch = TRUE) +
  theme_classic()+
  scale_y_continuous(breaks=seq(0,6,1))+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )
p

5.1 统计直方图和核密度估计图

ggplot2包提供了geom_histogarm()函数，绘制统计分布直方图。主要由两个参数控制分布结果：binwidth(箱型宽度)和bin(箱型总数)；

df <- read.csv("配套资源/第5章 数据分布型图表/Hist_Density_Data.csv", stringsAsFactors = FALSE)

ggplot(df, aes(x = MXSPD, fill = Location)) + 
  geom_histogram(binwidth = 1, alpha = 0.55, colour = "black", size = 0.25) + 
  theme(
    text = element_text(size = 15, color = "black"), 
    plot.title = element_text(size = 15, face = "bold.italic", hjust = .5, color = "black"), 
    legend.position = c(0.8, 0.8), 
    legend.background = element_blank()
  )

核密度估计图 ggplot2提供了geom_density（）函数绘制核密度图。主要参数是bw(带宽)和kernel(核函数)，核函数默认为高斯核函数“gaussian”，还有其他核函数，包括“epanechnikov”, “rectangular”, “trangular”, “biweigth”, “cosine”, “optcosine”.

ggplot(df, aes(x=MXSPD,  fill=Location))+ 
  geom_density(alpha=0.55,bw=1,colour="black",size=0.25)+
  theme(
    text=element_text(size=15,color="black"),
    plot.title=element_text(size=15,family="myfont",face="bold.italic",hjust=.5,color="black"),#,
    legend.position=c(0.8,0.8),
    legend.background = element_blank()
  )

*核密度估计峰峦图** 峰峦图可以很好的展示多数据系列的核密度估计结果。

library(ggplot2)
library(ggridges)
library(RColorBrewer)

ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`, fill = ..density..)) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.00,size = 0.3) + 
  scale_fill_gradientn(colours = colorRampPalette(rev(brewer.pal(11,'Spectral')))(32))

二维散点图和统计直方图 Method1: ggpubr包的ggscatterhist()函数 R中的ggpubr包的ggscatterhist()函数（选择“density”绘制核密度图，“histogram”绘制统计直方图，选择“boxplot”参数绘制箱型图，共三种类型）。ggExtra包中的ggMarginal()函数（选择“density”控制核密度估计图，选择“histogram”参数绘制统计直方图，选择“boxplot”绘制箱线图，选“violin”参数绘制小提琴图）。girdExtral包的gird.arrange()函数实现散点图核统计直方图的组合，可控性最好，但也最复杂。

library(ggpubr)
## Loading required package: magrittr
N <- 300
x1 <- rnorm(mean = 1.5, N)
y1 <- rnorm(mean = 1.6, N)
x2 <- rnorm(mean = 2.5, N)
y2 <- rnorm(mean = 2.6, N)

data1 <- data.frame(x=c(x1, x2), y=c(y1, y2))

ggscatterhist(data1, x="x", y="y", shape = 21, fill = "#00AFBB", color = "black", size = 3, alpha = 1, palette = c("#00AFBB", "#E7BB800", "#FC4E07"), margin.params = list(fill = "#00A7B800", color = "black", size = 0.2, alpha = 1), margin.plot = "histogram", legend = c(0.8, 0.8), ggtheme = theme_minimal())

二维散点图与核密度估计图

N<-200
x1 <- rnorm(mean=1.5, sd=0.5,N)
y1 <- rnorm(mean=2,sd=0.2, N)
x2 <- rnorm(mean=2.5,sd=0.5, N)
y2 <- rnorm(mean=2.5,sd=0.5, N)
x3 <- rnorm(mean=1, sd=0.3,N)
y3 <- rnorm(mean=1.5,sd=0.2, N)

data2 <- data.frame(x=c(x1,x2,x3),y=c(y1,y2,y3),class=rep(c("A","B","C"),each=200))


ggscatterhist(
  data2,  x ='x', y = 'y',  #iris
  shape=21,color ="black",fill= "class", size =3, alpha = 0.8,
  palette = c("#00AFBB", "#E7B800", "#FC4E07"),
  margin.plot =  "density",
  margin.params = list(fill = "class", color = "black", size = 0.2),
  legend = c(0.9,0.15),
  ggtheme = theme_minimal())

Mehtod2: grid.arrange()函数

library(gridExtra)
#(a) 二维散点与统计直方图

# 绘制主图散点图，并将图例去除，这里point层和path层使用了不同的数据集
scatter <- ggplot() + 
  geom_point(data=data1,aes(x=x,y=y),shape=21,color="black",size=3)+
   theme_minimal()
# 绘制上边的直方图，并将各种标注去除
hist_top <- ggplot()+
  geom_histogram(aes(data1$x),colour='black',fill='#00AFBB',binwidth = 0.3)+
  theme_minimal()+
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank())
# 同样绘制右边的直方图
hist_right <- ggplot()+
  geom_histogram(aes(data1$y),colour='black',fill='#00AFBB',binwidth = 0.3)+
  theme_minimal()+
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        #axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank())+
  coord_flip()

empty <- ggplot() +
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank())
# 要由四个图形组合而成，可以用空白图作为右上角的图形也可以，但为了好玩加上了R的logo，这是一种在ggplot中增加jpeg位图的方法
# logo <-  read.jpeg("d:\\Rlogo.jpg")
# empty <- ggplot(data.frame(x=1:10,y=1:10),aes(x,y))+
#   annotation_raster(logo,-Inf, Inf, -Inf, Inf)+
#   opts(axis.title.x=theme_blank(), 
#        axis.title.y=theme_blank(),
#        axis.text.x=theme_blank(),
#        axis.text.y=theme_blank(),
#        axis.ticks=theme_blank())
# 最终的组合
grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4,1), heights=c(1,4))

#(b) 二维散点与核密度估计图

# 绘制主图散点图，并将图例去除，这里point层和path层使用了不同的数据集
scatter <- ggplot() + 
  geom_point(data=data2,aes(x=x,y=y,fill=class),shape=21,color="black",size=3)+
  scale_fill_manual(values= c("#00AFBB", "#E7B800", "#FC4E07"))+
  theme_minimal()+
  theme(legend.position=c(0.9,0.2))
# 绘制上边的直方图，并将各种标注去除
hist_top <- ggplot()+
  geom_density(data=data2,aes(x,fill=class),colour='black',alpha=0.7)+
  scale_fill_manual(values= c("#00AFBB", "#E7B800", "#FC4E07"))+
  theme_void()+
  theme(legend.position="none")
# 同样绘制右边的直方图
hist_right <- ggplot()+
  geom_density(data=data2,aes(y,fill=class),colour='black',alpha=0.7)+
  scale_fill_manual(values= c("#00AFBB", "#E7B800", "#FC4E07"))+
  theme_void()+
  coord_flip()+
  theme(legend.position="none")

empty <- ggplot() +
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank())
# 要由四个图形组合而成，可以用空白图作为右上角的图形也可以，但为了好玩加上了R的logo，这是一种在ggplot中增加jpeg位图的方法
# logo <-  read.jpeg("d:\\Rlogo.jpg")
# empty <- ggplot(data.frame(x=1:10,y=1:10),aes(x,y))+
#   annotation_raster(logo,-Inf, Inf, -Inf, Inf)+
#   opts(axis.title.x=theme_blank(), 
#        axis.title.y=theme_blank(),
#        axis.text.x=theme_blank(),
#        axis.text.y=theme_blank(),
#        axis.ticks=theme_blank())
# 最终的组合
grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4,1), heights=c(1,4))

5.2.2 柱形分布图系列

带误差线的柱形图

#  生成模拟数据
library(SuppDists)
findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}

# 均值为3，标准差为1的正态分布
n <- rnorm(100,3,1)
# Johnson分布的偏斜度2.2和峰度13
s <- rJohnson(100, findParams(3, 1, 2., 13.1))
# Johnson分布的偏斜度0和峰度20）
k <- rJohnson(100, findParams(3, 1, 2.2, 20))
# 两个峰的均值μ1，μ2分别为1.89和3.79，σ1 = σ2 =0.31
mm <- rnorm(100, rep(c(2, 4), each = 50) * sqrt(0.9), sqrt(0.1))

mydata <- data.frame(
  Class = factor(rep(c("n", "s", "k", "mm"), each = 100),
                 c("n", "s", "k", "mm")),
  Value = c(n, s, k, mm)
)

ggplot(mydata, aes(Class, Value))+ 
  # 添加柱形图
  stat_summary(mapping=aes(fill = Class),fun.y=mean, fun.args = list(mult=1),geom='bar',colour="black",width=.7) +
  # 添加误差线
  stat_summary(fun.data = mean_sdl, fun.args = list(mult=1),geom='errorbar', color='black',width=.2) +  
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  ylim(0,7.5)+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

带误差线柱形图与抖动图

ggplot(mydata, aes(Class, Value))+ 
  # 添加散点图
  stat_summary(fun.y=mean, fun.args = list(mult=1),geom='bar',colour="black",fill="white",width=.7) +
  # 添加误差线
  stat_summary(fun.data = mean_sdl,fun.args = list(mult=1), geom='errorbar', color='black',width=.2) +    
  # 添加散点抖动
  geom_jitter(aes(fill = Class),position = position_jitter(0.2),shape=21, size = 2,alpha=0.9)+
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

5.2.3 箱型图系列

findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}

# 均值为3，标准差为1的正态分布
n <- rnorm(100,3,1)
# Johnson分布的偏斜度2.2和峰度13
s <- rJohnson(100, findParams(3, 1, 2., 13.1))
# Johnson分布的偏斜度0和峰度20
k <- rJohnson(100, findParams(3, 1, 2.2, 20))
# 两个峰的均值μ1，μ2分别为1.89和3.79，σ1 = σ2 =0.31
mm <- rnorm(100, rep(c(2, 4), each = 50) * sqrt(0.9), sqrt(0.1))

mydata <- data.frame(
  Class = factor(rep(c("n", "s", "k", "mm"), each = 100),
                 c("n", "s", "k", "mm")),
  Value = c(n, s, k, mm)
)


ggplot(mydata, aes(Class, Value))+
  geom_boxplot(aes(fill = Class),notch = FALSE)+
  geom_jitter(binaxis = "y", position = position_jitter(0.3),stackdir = "center",dotsize = 0.4)+
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

可变宽度的箱线图

freq <- 10 ^ ((1:4))
df <- data.frame(
  group = rep(letters[seq_along(freq)], freq),
  x = rnorm(sum(freq),3,1)
)

ggplot(df, aes(group,x))+
  geom_boxplot(aes(fill = group),notch = TRUE, varwidth = TRUE) +
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

多数据系列的箱型图

set.seed(141079)
data <- data.frame(BAI2013 = rnorm(300),
                 class = rep(letters[1:3], 100),
                 treatment = rep(c("elevated","ambient"),150)) 


#(a)多数据系列的箱型图
ggplot(data, aes(x = class, y = BAI2013))+
  geom_boxplot(outlier.size = 1, aes(fill=factor(treatment)),
               position = position_dodge(0.8),size=0.5) +  
  guides(fill=guide_legend(title="treatment"))+
  theme_minimal()+
  theme(axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=11,face="plain",color="black"),
        panel.background=element_rect(colour="black",fill=NA),
        panel.grid.minor=element_blank(),
        legend.position="right",
        legend.background=element_rect(colour=NA,fill=NA),
        axis.ticks=element_line(colour="black"))

带抖动散点的多数据系列箱型图

data<-transform(data,dist_cat_n=as.numeric(class),
                scat_adj=ifelse(treatment == "ambient",-0.2,0.2))

ggplot(data, aes(x =class, y = BAI2013))+
    geom_boxplot(outlier.size = 0, aes(fill=factor(treatment)),
                 position = position_dodge(0.8),size=0.4) + 
    geom_jitter(aes(scat_adj+dist_cat_n, BAI2013,fill = factor(treatment)),
                position=position_jitter(width=0.1,height=0),
                alpha=1,
                shape=21, size = 1.5)+
  guides(fill=guide_legend(title="treatment"))+
  theme_minimal()+
  theme(axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=11,face="plain",color="black"),
        panel.background=element_rect(colour="black",fill=NA),
        panel.grid.minor=element_blank(),
        legend.position="right",
        legend.background=element_rect(colour=NA,fill=NA),
        axis.ticks=element_line(colour="black"))

多数据系列的小提琴图

GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, 
                           draw_group = function(self, data, ..., draw_quantiles = NULL){
                             # Original function by Jan Gleixner (@jan-glx)
                             # Adjustments by Wouter van der Bijl (@Axeman)
                             data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x))
                             grp <- data[1,'group']
                             newdata <- plyr::arrange(transform(data, x = if(grp%%2==1) xminv else xmaxv), if(grp%%2==1) y else -y)
                             newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])
                             newdata[c(1,nrow(newdata)-1,nrow(newdata)), 'x'] <- round(newdata[1, 'x']) 
                             if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
                               stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))
                               quantiles <- create_quantile_segment_frame(data, draw_quantiles, split = TRUE, grp = grp)
                               aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE]
                               aesthetics$alpha <- rep(1, nrow(quantiles))
                               both <- cbind(quantiles, aesthetics)
                               quantile_grob <- GeomPath$draw_panel(both, ...)
                               ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob))
                             }
                             else {
                               ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...))
                             }
                           }
)

create_quantile_segment_frame <- function (data, draw_quantiles, split = FALSE, grp = NULL) {
  dens <- cumsum(data$density)/sum(data$density)
  ecdf <- stats::approxfun(dens, data$y)
  ys <- ecdf(draw_quantiles)
  violin.xminvs <- (stats::approxfun(data$y, data$xminv))(ys)
  violin.xmaxvs <- (stats::approxfun(data$y, data$xmaxv))(ys)
  violin.xs <- (stats::approxfun(data$y, data$x))(ys)
  if (grp %% 2 == 0) {
    data.frame(x = ggplot2:::interleave(violin.xs, violin.xmaxvs), 
               y = rep(ys, each = 2), group = rep(ys, each = 2)) 
  } else {
    data.frame(x = ggplot2:::interleave(violin.xminvs, violin.xs), 
               y = rep(ys, each = 2), group = rep(ys, each = 2)) 
  }
}

geom_split_violin <- function (mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...))
}

data<-transform(data,dist_cat_n=as.numeric(class),
                scat_adj=ifelse(treatment == "ambient",-0.15,0.15))
#data$scat_adj[data$treatment == "ambient"] <- -0.15
#data$scat_adj[data$treatment == "elevated"] <- 0.15

ggplot(data, aes(x = class, y = BAI2013,fill=factor(treatment)))+
  geom_split_violin(draw_quantiles = 0.5,trim = FALSE)+
  geom_jitter(aes(scat_adj+dist_cat_n, BAI2013,fill = factor(treatment)),
              position=position_jitter(width=0.1,height=0),
              alpha=1,
              shape=21, size = 1)+
  guides(fill=guide_legend(title="treatment"))+
  theme_minimal()+
  theme(axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=11,face="plain",color="black"),
        panel.background=element_rect(colour="black",fill=NA),
        panel.grid.minor=element_blank(),
        legend.position="right",
        legend.background=element_rect(colour=NA,fill=NA),
        axis.ticks=element_line(colour="black"))

多数据系列的豆状图

library(beanplot)
par(mai=c(0.5,0.5,0.25,1.2))
beanplot(BAI2013 ~treatment*class, data,col = list("#FF6B5E", "#00C3C2"),
         side = "both",xlab ="Class",ylab ="value")
legend(x=3.7,y=1.5 ,xpd=TRUE,bty="n",c("ambient", "elevated"),
       fill = c("#FF6B5E", "#00C3C2"),title="treatment")

二维散点图与箱线图组合

theme<-theme_minimal()+theme(
  axis.title=element_text(size=14,face="plain",color="black"),
  axis.text = element_text(size=12,face="plain",color="black"),
  legend.text= element_text(size=12,face="plain",color="black"),
  legend.title=element_text(size=12,face="plain",color="black"),
  legend.background=element_rect(fill=NA,colour=NA)
)

ggscatterhist(
  iris, x = "Sepal.Length", y = "Sepal.Width",  #iris
  shape=21,color ="black",fill= "Species", size =3.5, alpha = 1,
  palette = c("#00AFBB", "#E7B800", "#FC4E07"),
  margin.plot =  "boxplot",
  margin.params = list(fill = "Species", color = "black", size = 0.2),
  legend = c(0.82,0.15),
  ggtheme = theme)

子母图

library(grid)
p1 <- ggplot(iris, aes(Sepal.Length, Sepal.Width, fill = Species)) +
  geom_point(size = 4,shape=21,color="black") +
  scale_fill_manual(values= c("#00AFBB", "#E7B800", "#FC4E07"))+
  theme_minimal() +
  xlim(4, 10) +
  theme(axis.title = element_text(size = 16),
        axis.text = element_text(size = 14),
        plot.title = element_text(hjust = 0.5),
        legend.position = "none")

p2 <- ggplot(iris, aes(Species, Sepal.Width, fill = Species)) +
  geom_boxplot() +
  scale_fill_manual(values= c("#00AFBB", "#E7B800", "#FC4E07"))+
  theme_bw() +
  ggtitle("Submian: Box plot") +
  theme(plot.background = element_blank(),
        panel.background= element_blank(),
        panel.grid.minor= element_blank(),
        panel.grid.major.y= element_blank(),
         axis.title = element_blank(),
        axis.text = element_text(size = 10,colour="black"),
        plot.title = element_text(hjust = 0.5),
        legend.position = "none")

#cairo_pdf(file="子母图.pdf",width=6.56,height=5.09)
#showtext.begin()
subvp <- viewport(x = 0.78, y = 0.38, width = 0.4, height = 0.5)
p1
print(p2, vp = subvp)

#showtext.end()
#dev.off()

带显著标签的箱线图

library(ggplot2)
library(RColorBrewer)
library(SuppDists) #提供rJohnson()函数

set.seed(141079)

findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}

# 均值为3，标准差为1的正态分布
n <- rnorm(100,3,1)
# Johnson分布的偏斜度2.2和峰度13
s <- rJohnson(100, findParams(3, 1, 2., 13.1))
# Johnson分布的偏斜度0和峰度20
k <- rJohnson(100, findParams(3, 1, 2.2, 20))
# 两个峰的均值μ1，μ2分别为1.89和3.79，σ1 = σ2 =0.31
mm <- rnorm(100, rep(c(2, 4), each = 50) * sqrt(0.9), sqrt(0.1))

mydata <- data.frame(
  Class = factor(rep(c("n", "s", "k", "mm"), each = 100),
                 c("n", "s", "k", "mm")),
  Value = c(n, s, k, mm)
)

library(ggpubr) 

palette<-c(brewer.pal(7,"Set2")[c(1,2,4,5)])
ggboxplot(mydata, x = "Class", y = "Value",
          fill = "Class", palette = palette,
          add = "none",size=0.5,add.params = list(size = 0.25))+
  geom_hline(yintercept = mean(mydata$Value), linetype = 2)+               #添加均值线
  stat_compare_means(method = "anova", label.x=0.8,label.y = 7.8)+         # 添加全部数据的annova 方法的p-value
  stat_compare_means(label = "p.signif", method = "t.test",
                     ref.group = ".all.", hide.ns = TRUE,label.y = 8) +     # 添加每组变量与全部数据的显著性
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

compaired <- list(c("n", "s"), 
                  c("n","k"), 
                  c("n","mm"),
                  c("s","k"))

ggboxplot(mydata, x = "Class", y = "Value",
               fill = "Class", palette = palette,
               add = "jitter",size=0.5)+
 
  stat_compare_means(comparisons = compaired,method = "wilcox.test")+ # 添加每两组变量的显著性
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

ggplot(mydata, aes(Class, Value))+
  geom_boxplot(aes(fill = Class),notch = FALSE,outlier.alpha  =1) +
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  geom_signif(comparisons = compaired,
              step_increase = 0.1,
              map_signif_level = F,
              test = wilcox.test)+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

带连接线的双箱线图

library(ggpubr) 

set.seed(141079)
data <- data.frame(BAI2013 = rnorm(60),
                   class = rep(rep(letters[1:3], each=10),2),
                   treatment = rep(c("elevated","ambient"),each=30),
                   index=rep(seq(1,30),2)) 

palette<-c(brewer.pal(7,"Set2")[c(1,2,4,5)])

ggpaired(data, x = "treatment", y = "BAI2013",
         fill = "treatment", palette = palette, 
         line.color = "grey50", line.size = 0.15, point.size = 1.5,width=0.6,
         facet.by = "class", short.panel.labs = FALSE)+
  stat_compare_means(paired = TRUE)+
  theme_minimal()+
  theme(strip.background = element_rect(fill="grey90"),
        strip.text = element_text(size=13,face="plain",color="black"),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=11,face="plain",color="black"),
        panel.background=element_rect(colour="black",fill=NA),
        panel.grid=element_blank(),
        legend.position="none",
        legend.background=element_rect(colour=NA,fill=NA),
        axis.ticks=element_line(colour="black"))

library(RColorBrewer)
library(reshape2)
library(ggforce)
library(dplyr)
set.seed(141079)
df_point <- data.frame(BAI2013 = rnorm(60),
                   class = rep(rep(letters[1:3], each=10),2),
                   treatment = rep(c("elevated","ambient"),each=30),
                   index=rep(seq(1,30),2)) 


type<-as.character(unique(df_point$class))

df_bezier<-data.frame(matrix(ncol = 4, nrow = 0))
colnames(df_bezier)<-c("index","treatment","class","value")

for (i in 1:length(type)){
  data0<-df_point[df_point$class==type[i],]
  
  data1<-split(data0,data0$treatment)
  
  data2<-data.frame(ambient=data1$ambient[,1],
                    elevated=data1$elevated[,1],
                    index=data1$ambient[,4])
  
  colnames(data2)<-c(1,2,"index")
  data2$'1.3'<-data2$'1'
  data2$'1.7'<-data2$'2'
  
  data3<-melt(data2,id="index",variable.name ="treatment")
  data3$treatment<-as.numeric((as.character(data3$treatment)))
  
  data4<-arrange(data3,index,treatment) 
  data4$class<-type[i]
  
  df_bezier<-rbind(df_bezier,data4)
  
}

  
ggplot()+
    geom_boxplot(data=df_point,aes(x = factor(treatment), y = BAI2013,fill=factor(treatment)),
                 width=0.35,position = position_dodge(0),size=0.5,outlier.size = 0) + 
    geom_point(data=df_point,aes(x = factor(treatment), y = BAI2013,fill=factor(treatment)),
               shape=21,colour="black",size=2)+
    #geom_line(data=df_point,aes(x = factor(treatment), y = BAI2013,group=index), 
    #           size=0.25,colour="grey20")+
    geom_bezier(data=df_bezier,aes(x= treatment, y = value, group = index,linetype = 'cubic'),
                size=0.25,colour="grey20") +
  
    scale_fill_manual(values=brewer.pal(7,"Set2")[c(5,2)])+
  
    facet_grid(.~class)+
    
    labs(x="treatment",y="Value")+
    theme_minimal()+
    theme(strip.background = element_rect(fill="grey90"),
        strip.text = element_text(size=15,face="plain",color="black"),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=11,face="plain",color="black"),
        panel.background=element_rect(colour="black",fill=NA),
        panel.grid.minor=element_blank(),
        legend.position="none",
        legend.background=element_rect(colour=NA,fill=NA),
        axis.ticks=element_line(colour="black"))

中值排序显示的箱线图 未排序

library(ggplot2)
library(RColorBrewer)
library(SuppDists) 

set.seed(141079)
findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}

# 均值为3，标准差为1的正态分布
n <- rnorm(100,8,1)
# Johnson分布的偏斜度2.2和峰度13
s <- rJohnson(100, findParams(4, 1, 2., 13.1))
# Johnson分布的偏斜度0和峰度20
k <- rJohnson(100, findParams(10, 1, 2.2, 20))
# 两个峰的均值μ1，μ2分别为1.89和3.79，σ1 = σ2 =0.31
mm <- rnorm(100, rep(c(2, 4), each = 50) * sqrt(0.9), sqrt(0.1))

mydata <- data.frame(
  Class = factor(rep(c("n", "s", "k", "mm"), each = 100),
                 c("n", "s", "k", "mm")),
  Value = c(n, s, k, mm)
)
#write.csv(mydata,'Boxplot_Sort_Data.csv')
#--------------------------------未排序----------------------------------------------------

ggplot(mydata, aes(Class,Value))+
  geom_boxplot(aes(fill = Class),notch = FALSE,outlier.alpha  =1) +
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  scale_y_continuous(breaks=seq(0,15,3))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

降序处理

#------------------------------降序序处理-------------------------------------------------------
Order_Class<-with(mydata,reorder(Class,Value,median))

Order_Class<-factor(Order_Class,levels=rev(levels(Order_Class)))

ggplot(mydata, aes(Order_Class,Value))+
  geom_boxplot(aes(fill = Class),notch = FALSE,outlier.alpha  =1) +
  scale_fill_manual(values=c(brewer.pal(7,"Set2")[c(1,2,4,5)]))+
  scale_y_continuous(breaks=seq(0,15,3))+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

二维统计直方图

library(ggplot2)
library(RColorBrewer)
colormap<- rev(brewer.pal(11,'Spectral'))

# Create normally distributed data for plotting
x1 <- rnorm(mean=1.5, 5000)
y1 <- rnorm(mean=1.6, 5000)
x2 <- rnorm(mean=2.5, 5000)
y2 <- rnorm(mean=2.2, 5000)
x<-c(x1,x2)
y<-c(y1,y2)
df <- data.frame(x,y)

#--------------------------图5-3-1 不同类型的二维统计直方图------------------
ggplot(df, aes(x,y))+ 
  stat_bin2d(bins=40) + scale_fill_gradientn(colours=colormap)+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="right"
  )

ggplot(df, aes(x,y))+
  stat_binhex(bins=40) + scale_fill_gradientn(colours=colormap)+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="right"
  )

二维核密度估计图

library(ggplot2)
library(RColorBrewer)
colormap<- rev(brewer.pal(11,'Spectral'))

# Create normally distributed data for plotting
x1 <- rnorm(mean=1.5, 5000)
y1 <- rnorm(mean=1.6, 5000)
x2 <- rnorm(mean=2.5, 5000)
y2 <- rnorm(mean=2.2, 5000)
x<-c(x1,x2)
y<-c(y1,y2)
df <- data.frame(x,y)


#------------------------------------图5-3-2 不同类型的二维核密度统计图-----------------
ggplot(df, aes(x,y))+
  stat_density_2d(geom ="raster",aes(fill = ..density..),contour = F)+# "polygon")+#geom_raster(aes(fill = density)) +
  scale_fill_gradientn(colours=colormap)+#, trans="log"scale_fill_gradientn(colours=c("#CEF5FF","#00B8E5","#005C72"),name = "Frequency",na.value=NA)+
  #scale_fill_gradientn(colours=c(brewer.pal(7,"Set2")[3],"white",brewer.pal(7,"Set2")[2]),na.value=NA)+
  #geom_contour(acolour = "white") +
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="right"
  )

ggplot(df, aes(x, y)) + 
  stat_density2d(geom ="polygon",aes(fill = ..level..),bins=30 )+#alpha=..level..,aes( fill=..level..), size=2, bins=10, geom="polygon") + 
  #stat_density_2d(geom = "point", aes(size = ..density..), n = 20, contour = FALSE)
  scale_fill_gradientn(colours=colormap)+#scale_fill_gradient(low = "yellow", high = "red") +
  #scale_alpha(range = c(0.00, 0.5), guide = FALSE) +
  #geom_density2d( colour=NA,bins=30) +#
  #geom_point() +
  guides(alpha=FALSE) +
  xlim(-2,6)+
  ylim(-2,6)+
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="right"
  )

三维统计直方图

library(plot3D)

N<-300
x1 <- rnorm(mean=1.5, N)
y1 <- rnorm(mean=1.6, N)
x2 <- rnorm(mean=2.5, N)
y2 <- rnorm(mean=2.2, N)

data <- data.frame(x=c(x1,x2),y=c(y1,y2))


#图5-3-3 (a) 三维统计直方图
library(gplots) #提供hist2d()函数
df_hist<-hist2d(df$x,df$y, nbins=30)

pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1))
hist3D(x=df_hist$x,y=df_hist$y,z=df_hist$counts,
       col = colormap, border = "black",space=0,alpha = 1,lwd=0.1,
       xlab = "x", ylab = "y",zlab = "Count", clab="Count",
       ticktype = "detailed",bty = "f",box = TRUE,#cex.axis= 1e-09,
       theta = 65, phi = 20, d=3,
       colkey = list(length = 0.5, width = 1))

三维核密度估计图

library(MASS) #提供kde2d ()函数
df_density <- kde2d(df$x,df$y, n = 50, h = c(width.SJ(df$x), width.SJ(df$y)))
pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1))
persp3D (df_density$x, df_density$y, df_density$z,
         theta = 60, phi = 20, d=3,
         col = colormap, border = "black", lwd=0.1,
         bty = "f",box = TRUE,ticktype = "detailed",
         xlab = "x", ylab = "y",zlab = "desnity",clab="desnity",
         colkey = list(length = 0.5, width = 1))

二维直方图+一维直方图

library(ggplot2)
library(ellipse)
library(gridExtra)
library(plyr)
library(RColorBrewer)

Colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)

N<-300
x1 <- rnorm(mean=1.5, N)
y1 <- rnorm(mean=1.6, N)
x2 <- rnorm(mean=2.5, N)
y2 <- rnorm(mean=2.2, N)

data <- data.frame(x=c(x1,x2),y=c(y1,y2))

# 绘制上边的直方图，并将各种标注去除
hist_top <- ggplot()+
  geom_histogram(aes(data$x),colour='black',fill='#5E4FA2',binwidth = 0.3)+
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank(),
        axis.line=element_blank())
# 同样绘制右边的直方图
hist_right <- ggplot()+
  geom_histogram(aes(data$y),colour='black',fill='#5E4FA2',binwidth = 0.3)+
  theme(panel.background=element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank(),
        axis.line=element_blank())+
  coord_flip()

#ggplot(diamonds, aes(carat, price))
scatter<-ggplot(data, aes(x,y)) +
  stat_binhex(bins = 15,na.rm=TRUE,color="black")+#colour="black",
  scale_fill_gradientn(colours=Colormap)+#, trans="log"
  #geom_point(colour="white",size=1,shape=21) +
  theme_classic()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position=c(0.10,0.80),
        legend.background=element_blank()
  )
# 最终的组合
grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4,1), heights=c(1,4))

二维核密度估计图+一维核密度估计图

hist_top <- ggplot(data, aes(x)) +
  geom_density(colour="black",fill='#5E4FA2',size=0.25)+
  theme_void()
# 同样绘制右边的直方图
hist_right <- ggplot(data, aes(y)) +
  geom_density(colour="black",fill='#5E4FA2',size=0.25)+
  theme_void()+
  coord_flip()

scatter<-ggplot(data, aes(x, y)) + 
  stat_density2d(geom ="polygon",aes(fill = ..level..),bins=30 )+#alpha=..level..,aes( fill=..level..), size=2, bins=10, geom="polygon") + 
  scale_fill_gradientn(colours=Colormap)+#, trans="log"
  #geom_point(size=1) +
  theme_minimal()+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        #panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
        #text=element_text(size=15),
        #plot.title=element_text(size=15,family="myfont",hjust=.5),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position=c(0.9,0.22),
        legend.background=element_blank()
  )
# 最终的组合
grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4,1), heights=c(1,4))

镜面图

library(ggplot2)
#-----------------------------------------------(a1)-------------------------------------------
df<-read.csv("配套资源/第5章 数据分布型图表/Population_Pyramid_Data.csv",header=TRUE)
df[df$gender == "female",]$pop<--df[df$gender == "female",]$pop
df$age<-factor(df$age,levels=df$age[seq(1,nrow(df)/2,1)])

ggplot(data = df, aes(x =age , y = pop, fill = gender)) +
  geom_bar(stat = "identity",position = "identity",color="black",size=0.25) +
  
  scale_y_continuous(labels = abs, limits = c(-400, 400), breaks = seq(-400, 400, 100)) +
 
  coord_flip() +
  theme_light()+
  theme(
    #axis.text.x = element_text(angle=60, hjust=1),
    panel.grid.minor=element_blank(),
    #text=element_text(size=15,face="plain",color="black"),
    axis.title=element_text(size=15,face="plain",color="black"),
    axis.text = element_text(size=10,face="plain",color="black"),
    legend.title=element_text(size=14,face="plain",color="black"),
    legend.text=element_text(size=12,face="plain",color="black"),
    legend.background=element_blank(),
    legend.position = c(0.9,0.88)
  )

ggplot(data = df, aes(x =age , y = pop, fill = gender)) +
  geom_bar(stat = "identity",position = "identity",color="black",size=0.25) +
  
  scale_y_continuous(labels = abs, limits = c(-400, 400), breaks = seq(-400, 400, 100)) +
  theme_light()+
  theme(
    axis.text.x = element_text(angle=60, hjust=1),
    panel.grid.minor=element_blank(),
    #text=element_text(size=15,face="plain",color="black"),
    axis.title=element_text(size=15,face="plain",color="black"),
    axis.text = element_text(size=10,face="plain",color="black"),
    legend.title=element_text(size=14,face="plain",color="black"),
    legend.text=element_text(size=12,face="plain",color="black"),
    legend.background=element_blank(),
    legend.position = c(0.9,0.88)
  )

#df<-read.csv("Population_Pyramid_Data.csv",header=TRUE)

#df[df$gender == "female",]$pop<--df[df$gender == "female",]$pop
df$age_x<-rep(seq(0, 100,5),2)


ggplot(data = df, aes(x =age_x , y = pop, fill = gender)) +

  geom_area(stat = "identity", position = "identity",color="black",size=0.25) +

  scale_fill_manual(values=c("#36BED9","#FBAD01"))+
  coord_flip() +
  scale_y_continuous(labels = abs, limits = c(-400, 400), breaks = seq(-400, 400, 100)) +
  scale_x_continuous(breaks = seq(0, 100, 5),labels=df$age[seq(1,nrow(df)/2,1)])+
  theme_light()+
  theme(
    panel.grid.minor=element_blank(),
    #text=element_text(size=15,face="plain",color="black"),
    axis.title=element_text(size=15,face="plain",color="black"),
    axis.text = element_text(size=10,face="plain",color="black"),
    legend.title=element_text(size=14,face="plain",color="black"),
    legend.text=element_text(size=12,face="plain",color="black"),
    legend.background=element_blank(),
    legend.position = c(0.9,0.88)
  )

ggplot(data = df, aes(x =age_x , y = pop, fill = gender)) +
  
  geom_area(stat = "identity", position = "identity",color="black",size=0.25) +
  
  scale_fill_manual(values=c("#36BED9","#FBAD01"))+
  #coord_flip() +
  scale_y_continuous(labels = abs, limits = c(-400, 400), breaks = seq(-400, 400, 100)) +
  scale_x_continuous(breaks = seq(0, 100, 5),labels=df$age[seq(1,nrow(df)/2,1)])+
  theme_light()+
  theme(
    axis.text.x = element_text(angle=60, hjust=1),
    panel.grid.minor=element_blank(),
    #text=element_text(size=15,face="plain",color="black"),
    axis.title=element_text(size=15,face="plain",color="black"),
    axis.text = element_text(size=10,face="plain",color="black"),
    legend.title=element_text(size=14,face="plain",color="black"),
    legend.text=element_text(size=12,face="plain",color="black"),
    legend.background=element_blank(),
    legend.position = c(0.9,0.88)
  )

shenny!
关注
  • 9
    点赞
  • 踩
  • 37
    收藏
    觉得还不错? 一键收藏
  • 2
    评论
专栏目录
R语言ggplot2可视化堆叠条形图（stacked bar plot）、并且在每个条形图的顶端使用数值标签表示整个条形的加和值（sum value above the stacked bar）
data+scenario+science+insight
06-07 1918
R语言ggplot2可视化堆叠条形图（stacked bar plot）、并且在每个条形图的顶端使用数值标签表示整个条形的加和值（sum value above the stacked bar）
一起学画图：散点图+边缘分布统计图形-密度图-直方图-箱型图-小提琴图
NewComerSyt的博客
03-10 3473
Part 1 ：散点图+变量边缘分布图形 公众号原文点我，感谢支持 许多文章的散点图中，在散点图的周围还会有额外的单变量边缘分布统计图形（如下图）。前面几期我们介绍过，散点图主要反映的是两个变量之间的关系，而额外的边缘分布图则能直观反映每个变量的分布情况。本期就来介绍实现这类图形的常见方法。 示例： Abundance of antibiotic resistance genes, intI1 gene and crAssphage in human fecal metagenomes. [1]示例图中散
ggplot2绘图入门
最新发布
BingJH2018212666的博客
06-06 1113
ggplot2 是 R 语言中的一个强大数据可视化包，基于“图层语法”（Grammar of Graphics）。图层语法将图表分解为多个可组合的元素（如数据、几何对象、统计变换等），用户可以通过叠加这些元素创建复杂且美观的图表。在 ggplot2 中，使用 aes() 函数将数据变量映射到图表的 x 轴和 y 轴。这种映射定义了数据如何在图表中呈现，并帮助观察者理解数据的关系和趋势。# 将变量 var1 映射到 x 轴，将变量 var2 映射到 y 轴。
r 语言 ggplot上添加平均值_R语言作图——Dot plot（点图）
weixin_39655085的博客
11-26 1229
原创：黄小仙2020开年不凡, 生活果然充满了惊吓，可仍然要期待惊喜呀。今天要给大家介绍的是点图（Dot plot)，点图展示的数据比较简单，但胜在好看啊。作图数据如下：Step1. 绘图数据的准备首先要把你想要绘图的数据调整成R语言可以识别的格式，建议大家在excel中保存成csv格式。Step2. 绘图数据的读取data<-read.csv(“your file path”, heade...
R语言如何绘制云雨图（20）
qq_35294674的博客
05-23 2165
1.什么是云雨图？ 云雨图，顾名思义，由2部分组成，上方的半个小提琴图形似云朵，下方的点图形似雨滴。 上方的半个小提琴图，类似于核密度曲线，其曲线下的面积是1。 下方的点图，其实是频率分布直方图的点状抽象。 2.绘图前的数据准备 ​ demo数据可以在https://www.bioladder.cn/shiny/zyp/bioladder2/demoData/rainCloud/demo.txt下载。 ​ 包含2个维度的数据，通常每一列是个样本，每一行是个基因 3. R语言怎么画云雨图 # 加载R包，没
R ggplot2 cheatsheet
03-13
ggplot2的核心思想是将数据映射到视觉元素上，并通过层叠的方式构建复杂的图表。本篇文章将重点介绍ggplot2中各种几何对象（简称Geoms）的使用方法及其属性设置。 ### Geoms的使用 Geoms是ggplot2中用于表示数据点...
Python-ggeconodist创建小型分销图表
08-10
`ggeconodist`是一个专门用于创建小型分销图表的库，它结合了`ggplot2`（一种R语言中的数据可视化库）的设计哲学和Python的便利性。在本文中，我们将深入探讨`ggeconodist`库，了解如何利用它来创建有吸引力且易于...
data-数据集
03-13
- **数据可视化**：工具如matplotlib、seaborn或ggplot2可以帮助我们创建图表，以直观地展示数据分布、相关性和趋势。 - **数据库导入**：CSV文件也可用于填充数据库，如MySQL、PostgreSQL等，以便进行更复杂的数据...
30分钟学会ggplot2
08-16
### 30分钟学会ggplot2：R语言高级绘图利器 #### ggplot2简介 ggplot2是一款基于R语言的高级绘图包，由Hadley Wickham...对于数据分析人员和研究人员来说，掌握ggplot2无疑是提高工作效率和图形质量的重要手段之一。
ggstatsplot：通过统计分析增强ggplot2图
02-05
`ggstatsplot` 是对 `ggplot2` 图形系统的扩展，`ggplot2` 是一种流行的图形系统，遵循层叠图形原则，让用户能够逐层构建复杂的可视化图表。`ggstatsplot` 添加了统计分析功能，使用户能够在生成的图表中直接展示...
【Python数据科学快速入门系列 | 10】Matplotlib数据分布图表应用总结
机器未来的博客
10-24 6396
本篇文章总结常用的数据分布图表。数据分布图表强调数据集中的数值及其频率或分布规律。常见的有统计直方图、核密度曲线图、箱形图、小提琴图等。
R绘图笔记 | 箱形图的绘制
BioInfoNotes
11-09 2173
参考前文：R绘图笔记 | R语言绘图系统与常见绘图函数及参数关于绘图图，前面介绍了一些：R绘图笔记 | 一般的散点图绘制R绘图笔记 | 柱状图绘制R绘图笔记 | 直方图和核密度估计图的绘...
R语言ggplot2可视化：ggExtra包的ggMarginal函数为散点图添加X轴和Y轴数据的边缘分布图、设置type参数为histogram在X轴和Y轴分别显示直方图
statistics+insight+vista+power
11-22 287
R语言ggplot2可视化：ggExtra包的ggMarginal函数为散点图添加X轴和Y轴数据的边缘分布图（marginal distribution plot）、设置type参数为histogram在X轴和Y轴分别显示直方图
R语言ggplot2可视化：使用ggpubr包的ggscatterhist函数可视化散点图并添加边缘密度曲线
statistics+insight+vista+power
01-19 174
R语言ggplot2可视化：使用ggpubr包的ggscatterhist函数可视化散点图并添加边缘密度曲线
R正态分布+ggplot
yjz_sdau的博客
07-11 6600
randNorm ##rnorm(3000)产生3000个正太分布数 randDensity ###dnorm(randNorm)求其密度函数值 ggplot(data.frame(x=randNorm,y=randDensity))+aes(x=x,y=y)+geom_point()+labs(x="Random Normal Varables",y="randDensity") ##
R语言ggplot2可视化绘制分面（facet_warp）密度图，然后在密度图上叠加一个正态分布，以说明基础数据离正态分布有多远
data+scenario+science+insight
12-05 1078
R语言ggplot2可视化绘制分面（facet_warp）密度图，然后在密度图上叠加一个正态分布，以说明基础数据离正态分布有多远
制作R包后，出现 "..." not available for .Call() for package "..." 错误
Kanny
09-27 1981
有一段时间没有做过 R 包了今天在尝试制作 R 包时，制作、生成、载入都没有遇到问题，但在载入 R 包内用 Rcpp 写得函数时出现了如下问题（做的包名叫 RI，调用的函数也是 RI）： Error in .Call("_RI_RI", PACKAGE = "RI", X, Y) : "_RI_RI" not available for .Call() for package "RI" 后...
R语言使用ggplot2包geom_jitter()函数绘制分组（strip plot，一维散点图）带状图（配置显示的分组）实战
data+scenario+science+insight
03-20 674
R语言使用ggplot2包geom_jitter()函数绘制分组（strip plot，一维散点图）带状图（配置显示的分组）实战 目录 R语言使用ggplot2包geom_jitter()函数绘制分组（strip plot，一维散点图）带状图（配置显示的分组）实战 #仿真数据 #geom_jitter()函数绘制分组（strip plot，一维散点图）带状图（） #仿真数据 # Convert the variable dose from a numeric to a factor v
Excel数据分析从入门到精通（十二）28个图表之分布分析
Momoko_Hanyu的博客
09-06 4929
Excel数据分析从入门到精通（十二）28个图表之分布分析1.分布分析-直方图2.分布分析-气泡矩阵图3.分布分析-箱线图4.分布分析-散点图5.分布分析-旋风图 1.分布分析-直方图 有表格如下 用户ID 年龄 001 54 002 31 003 21 004 39 005 52 006 27 007 44 008 21 009 34 010 26 选中数据区域 - 插入图表 - 直方图 点击x轴，设置坐标轴格式 - 坐标轴选项 - 箱宽度设置为1
ggplot2作频率分布曲线图
12-22
ggplot2是R语言中一款用于绘制数据可视化图表的包，可以用来生成频率分布曲线图。首先，我们需要载入ggplot2包，并准备一组数据，例如一个数值型变量。接着，可以使用ggplot()函数创建一个基础图层，指定数据和映射变量到x轴和y轴。 接下来，我们可以使用geom_density()函数添加密度曲线到图层上，这样就可以得到频率分布曲线图。如果需要对曲线进行分组，可以使用aes()函数在映射中添加分组变量。此外，还可以对曲线的外观进行修饰，例如添加颜色、填充和线条样式等。 最后，可以使用其他函数对图表进行修饰，例如添加标题、轴标签和图例等。需要注意的是，ggplot2提供了丰富的功能和选项，可以根据具体需求对图表进行个性化定制。 总之，使用ggplot2作频率分布曲线图，可以通过简洁的代码和强大的定制功能，轻松实现数据可视化的需求，帮助我们更好地理解和分析数据。
评论 2
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值