R语言绘制条形图

最新推荐文章于 2024-06-04 15:55:30 发布

R语言中文社区

最新推荐文章于 2024-06-04 15:55:30 发布

阅读量9.9k

点赞数 3

点击上方蓝色字体，关注我们

作者简介

作者：吴健中国科学院大学 R语言、统计学爱好者，尤其擅长R语言和Arcgis在生态领域的应用分享

个人公众号：统计与编程语言

条形图可以通过垂直或水平的条形展示类别型变量的分布。熟悉R语言的用户应该都可以熟练的绘制条形图，但在实际应用中，我们常常会根据数据展示的需求对条形图进行调整，这就需要我们花费大量时间了解条形图绘制函数的一些参数及高级方法。基于此，本文整理出一些常用的条形图绘制代码，希望可以为大家带来一些方便。

—

绘制基本条形图

创建数据集

my_vector <- c(3, 12, 5, 18, 45)
names(my_vector) <- c(“A”, “B”, “C”, “D”, “E”)

绘制基本条形图

barplot(my_vector, col=rgb(0.2, 0.4, 0.6, 0.6), xlab=”category”)

—

绘制水平条形图

绘制水平条形图

barplot(my_vector, col=rgb(0.2, 0.4, 0.6, 0.6), horiz=T, las=1)

—

绘制带纹理的条形图

绘制带纹理的条形图

barplot( c(2,5,4,6) , density=c(5,10,20,30) , angle=c(0,45,90,11) ,
col=”brown” , names.arg=c(“A”,”B”,”C”,”D”) )

—

绘制堆砌和分组条形图

创建数据集

set.seed(112)
data <- matrix(sample(1:30,15) , nrow=3)
colnames(data) <- c(“A”,”B”,”C”,”D”,”E”)
rownames(data) <- c(“var1”,”var2”,”var3”)

堆砌条形图

barplot(data, col=colors()[c(23,89,12)] , border=”white”, space=0.04, font.axis=2, xlab=”group”, ylim=c(0,70))

分组条形图

barplot(data, col=colors()[c(23,89,12)] , border=”white”, font.axis=2, beside=T, legend=rownames(data), xlab=”group”, font.lab=2)

—

绘制双因素条形图

定义颜色

colset <- c(“#B3E2CD”, “#FDCDAC”, “#CBD5E8”)

读取数据

path <- “http://www.sr.bham.ac.uk/~ajrs/R/datasets“
file <- paste(path, “ao7_otac_by_radec.txt”, sep=”/“)
A <- read.fwf(file, widths=c(8, -3, 1, -3, 31, 18, 10, -2, 10, -3, 6, -4, 1, -4, 1, -9, 1))
colnames(A) <- c(“obsid”, “cat”, “PI”, “target”, “ra”, “dec”, “t.exp”, “N”, “pri”, “fix”)
head(A)

在绘图窗口绘制两个布局

layout(matrix(1:2, 2, 1, byrow=TRUE), heights=c(1, 0.4))

绘制双因素条形图

par(las=1)
par(mar=c(5, 4, 4, 2.2) + 0.1)
plot(pri ~ cat, data=A, col=colset, main=”XMM AO7 accepted proposals”,
xlab=”Science Category”, ylab=”Priority”)

在底部添加标签

par(mar=c(0, 1, 0, 1))
plot.new()
legend(x=”topleft”, cex=0.7, c(“A: Stars, White Dwarfs and Solar System”,
“B: White Dwarf Binaries, Neutron Star Binaries, Cataclysmic Variables, ULXs and Black Holes”,
“C: Supernovae, Supernova Remnants, Diffuse (galactic) Emission and Isolated Neutron Stars”,
“D: Galaxies and Galactic Surveys”,”E: Active Galactic Nuclei, Quasars and BL-Lac Objects”,
“F: Groups of Galaxies, Clusters of Galaxies and Superclusters”,
“G: Cosmology, Extragalactic Deep Fields and Area Surveys”))

—

绘制附带样本观测数的条形图

生成数据

name <- c(“DD”,”with himself”,”with DC”,”with Silur” ,”DC”,”with himself”,”with DD”,”with Silur” ,”Silur”,”with himself”,”with DD”,”with DC” )
average <- sample(seq(1,10) , 12 , replace=T)
number <- sample(seq(4,39) , 12 , replace=T)
data <- data.frame(name,average,number)
attach(data)

绘制基础条形图

my_bar <- barplot(average , border=F , names.arg=name , las=2 , col=c(rgb(0.3,0.1,0.4,0.6) , rgb(0.3,0.5,0.4,0.6) , rgb(0.3,0.9,0.4,0.6) , rgb(0.3,0.9,0.4,0.6)) , ylim=c(0,11) , main=”” )
abline(v=c(4.9 , 9.7) , col=”grey”)

添加文本

text(my_bar, average+0.4 , paste(“n = “,number,sep=””) ,cex=1)

生成图例

legend(“topleft”, legend = c(“Alone”,”with Himself”,”With other genotype” ) ,
col = c(rgb(0.3,0.1,0.4,0.6) , rgb(0.3,0.5,0.4,0.6) , rgb(0.3,0.9,0.4,0.6) , rgb(0.3,0.9,0.4,0.6)) ,
bty = “n”, pch=20 , pt.cex = 2, cex = 0.8, horiz = FALSE, inset = c(0.05, 0.05))
detach(data)

—

绘制李克特式条形图

安装加载包

install.packages(“likert”)
library(likert)

使用自定义数据集

data(pisaitems)
items28 <- pisaitems[, substr(names(pisaitems), 1, 5) == “ST24Q”]
head(items28)
head(pisaitems)

绘制条形图

l28 <- likert(items28)
summary(l28)
plot(l28)

—

绘制带误差棒的条形图

加载数据包

library(ggplot2)

新建数据

data <- data.frame(
name=letters[1:5],
value=sample(seq(4,15),5),
sd=c(1,0.2,3,2,4)
)

绘制条形图

ggplot(data) +geom_bar( aes(x=name, y=value), stat=”identity”, fill=”skyblue”, alpha=0.7)+geom_errorbar( aes(x=name, ymin=value-sd, ymax=value+sd), width=0.4, colour=”orange”, alpha=0.9, size=1.3)

—

绘制存在负值的条形图

加载程序包

library(ggplot2)

构建数据集，将正负值拆分成两套数据

rr1 <- c(0, 0, 0, 0, 0, 10, 8.8, 6.2, 4.5, 4, 3.4)
rr2 <- c(-2.3, -1.8, -4, -5.7, -7.2, 0, 0, 0, 0, 0, 0)
dat <- data.frame(
group = rep(c(“rr1”,”rr2”), each=11),
x = rep(-5:5, 2),
y = c(rr1, rr2)
)

绘制条形图

ggplot(dat, aes(x=x, y=y)) +
geom_bar(stat=”identity”, position=”identity”, width=0.25,aes(fill=group)) +
scale_x_continuous(breaks=-5:5) +
scale_y_continuous(breaks=seq(-10,10,2.5), limits=c(-10,10))

—

绘制棒棒糖状条形图（可强调重点）

#加载程序包

library(tidyverse)

#生成数据

set.seed(1000)

data <- data.frame(x=LETTERS[1:26], y=abs(rnorm(26)))

#排序数据

data <- data %>% arrange(y) %>% mutate(x=factor(x,x))

#绘图

p <- ggplot(data, aes(x=x, y=y)) +

geom_segment( aes(x=x, xend=x, y=0, yend=y ), color=ifelse(data$x %in% c("A","D"), "orange", "grey"), size=ifelse(data$x %in% c("A","D"), 1.3, 0.7) ) +

geom_point( color=ifelse(data$x %in% c("A","D"), "orange", "grey"), size=ifelse(data$x %in% c("A","D"), 5, 2) ) +

theme_light() +

coord_flip() +

theme(

legend.position="none",

panel.grid.major.y = element_blank(),

panel.border = element_blank(),

axis.ticks.y = element_blank()

) +

xlab("") +

ylab("Value of Y")

print(p)

#添加注记

p +

annotate("text", x = grep("D", data$x), y = data$y[which(data$x=="D")]*1.2, label = "Group D is very impressive", color="orange", size=4 , angle=0, fontface="bold", hjust=0) +

annotate("text", x = grep("A", data$x), y = data$y[which(data$x=="A")]*1.2, label = paste("Group A is not too bad (val=",data$y[which(data$x=="A")] %>% round(2),")",sep="" ) , color="orange", size=4 , angle=0, fontface="bold", hjust=0) +

ggtitle("How did groups A and D perform?")