R語言繪製條形圖

       

作者：吳健 中國科學院大學 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?")

公眾號後臺回復關鍵字即可學習

回復 R                  R語言快速入門及數據挖掘 
回復 Kaggle案例  Kaggle十大案例精講（連載中）
回復 文本挖掘      手把手教你做文本挖掘
回復 可視化          R語言可視化在商務場景中的應用 
回復 大數據         大數據系列免費視頻教程 
回復 量化投資      張丹教你如何用R語言量化投資 
回復 用戶畫像      京東大數據，揭秘用戶畫像
回復 數據挖掘     常用數據挖掘算法原理解釋與應用
回復 機器學習     人工智慧系列之機器學習與實踐
回復 爬蟲            R語言爬蟲實戰案例分享