查看原文
其他

R语言绘制条形图

吴健 R语言中文社区 2019-04-22

       

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

作者简介

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

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



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


01


绘制基本条形图



创建数据集

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”)


02


绘制水平条形图



绘制水平条形图

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



03


绘制带纹理的条形图



绘制带纹理的条形图

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”)  )


04


绘制堆砌和分组条形图


创建数据集

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)

05


绘制双因素条形图


定义颜色

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”))



06


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


生成数据

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)




07


绘制李克特式条形图


安装加载包

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)

08


绘制带误差棒的条形图



加载数据包

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)



09


绘制存在负值的条形图


加载程序包

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))


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?")




大家都在看

2017年R语言发展报告(国内)

R语言中文社区历史文章整理(作者篇)

R语言中文社区历史文章整理(类型篇)



公众号后台回复关键字即可学习

回复 R                  R语言快速入门及数据挖掘 
回复 Kaggle案例  Kaggle十大案例精讲(连载中)
回复 文本挖掘      手把手教你做文本挖掘
回复 可视化          R语言可视化在商务场景中的应用 
回复 大数据         大数据系列免费视频教程 
回复 量化投资      张丹教你如何用R语言量化投资 
回复 用户画像      京东大数据,揭秘用户画像
回复 数据挖掘     常用数据挖掘算法原理解释与应用
回复 机器学习     人工智能系列之机器学习与实践
回复 爬虫            R语言爬虫实战案例分享

    您可能也对以下帖子感兴趣

    文章有问题?点此查看未经处理的缓存