条形图可以通过垂直或水平的条形展示类别型变量的分布。熟悉R语言的用户应该都可以熟练的绘制条形图,但在实际应用中,我们常常会根据数据展示的需求对条形图进行调整,这就需要我们花费大量时间了解条形图绘制函数的一些参数及高级方法。基于此,本文整理出一些常用的条形图绘制代码,希望可以为大家带来一些方便。
绘制基本条形图
创建数据集my_vector <- c(3,="" 12,="" 5,="" 18,="">-> names(my_vector) <- c(“a”,="" “b”,="" “c”,="" “d”,="">-> 绘制基本条形图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="">-> colnames(data) <->-> rownames(data) <->-> 堆砌条形图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”,="">-> 读取数据path <->-> 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,="">-> colnames(A) <- c(“obsid”,="" “cat”,="" “pi”,="" “target”,="" “ra”,="" “dec”,="" “t.exp”,="" “n”,="" “pri”,="">-> 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="">-> number <- sample(seq(4,39)="" ,="" 12="" ,="" replace="">-> data <->-> 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)="=">-> head(items28) head(pisaitems) 绘制条形图l28 <->-> summary(l28) plot(l28)
绘制带误差棒的条形图
加载数据包library(ggplot2) 新建数据data <->-> 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,="">-> rr2 <- c(-2.3,="" -1.8,="" -4,="" -5.7,="" -7.2,="" 0,="" 0,="" 0,="" 0,="" 0,="">-> dat <->-> 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="">-> #排序数据 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?')
|