R語言與醫學統計圖形【4】直方圖、金字塔圖

R語言基礎繪圖系統

基礎圖形——直方圖、金字塔圖

3.直方圖

參數設置及比較。

op <- par(mfrow=c(2,3))
data <- rnorm(100,10,5)

hist(data,col = 'light green') #默認分組
hist(data,col = 'sky blue',breaks = 15) #分成15組
hist(data,col = 'orange',breaks = seq(-5,25,1)) #自定義組距
hist(data,col = 'pink',breaks = seq(-5,25,1),density = T)

hist(data,col = 'pink',breaks = seq(-5,25,1),freq = F) #freq繪制概率密度圖
lines(density(data),col='blue',lty=1,lwd=2) #添加曲線

par(op)

直方圖疊加。

#泰坦尼克號不同年齡與生存關系
library(effects)
data("TitanicSurvival")
hist(TitanicSurvival$age,main = 'Passenger survial by age',
     xlab = 'Age',col = 'sky blue',breaks = seq(0,80,2))
hist(TitanicSurvival$age[which(TitanicSurvival$survived=="no")],
     col='orange',breaks=seq(0,80,2),add=TRUE) #add添加死亡直方圖

背靠背直方圖（back to back histogram）。

df=data.frame(x=rnorm(100),x2=rnorm(100,mean = 2))
#將兩個直方圖存入對象
h1=hist(df$x,plot = F)
h2=hist(df$x2,plot = F)
#將h2的值反轉
h2$counts=-h2$counts
#找到y軸取值范圍
hmax=max(h1$counts)
hmin=min(h2$counts)
#找到x軸取值范圍
X=c(h1$breaks,h2$breaks)
xmax=max(X)
xmin=min(X)

plot(h1,ylim = c(hmin,hmax),col='green',
     xlim = c(xmin,xmax),
     main = '背靠背直方圖')
#用低級繪圖函數將h2添加上去。
lines(h2,col='blue')

鏡面圖（mirror plot）

與背靠背直方圖類似，只是展示的是概率密度曲線或其他曲線，而非條柱。

x1=rnorm(100)
x2=rnorm(100,mean = 2)
par(mfrow=c(2,1))

#設置第一張畫布大小，為在同一張畫布中容下兩張圖
par(mar=c(0,5,3,3))
plot(density(x1),main = "",xlab = "",
     ylim=c(0,1),xaxt="n", #是否設置x軸，n不繪制
las=1,col='slateblue1',lwd=4)

#設置第二張畫布大小
par(mar=c(5,5,0,3))
plot(density(x2),main = "",xlab = "Value of variable",
     ylim=c(1,0), #范圍應與第一張一致
     las=1,col='tomato3',lwd=4)

4.金字塔圖

如展示不同年齡組男女人口數的分布情況。

library(DescTools)
par(mfrow=c(1,3))
m.pop <- runif(18,0,4)
f.pop <- runif(18,0,4)
age <- c('1-5','6-10','11-15','16-20','21-25','26-30',
         '31-35','36-40','41-45','46-50','51-55','56-60',
         '61-65','66-70','71-75','76-80','81-85','86+')
#左側圖
DescTools::PlotPyramid(m.pop,f.pop,
            ylab=age,space=0,
            col=c('cornflowerblue','indianred'),
            main='Age distribution at baseline',
            lxlab='male',rxlab='female') #左右兩邊x軸標簽
#中間圖
PlotPyramid(m.pop,f.pop,
            ylab = age,space=0,
            col=c('cornflowerblue','indianred'),
            xlim=c(-5,5),
            main = 'Age distribution at baseline',
            lxlab='male',rxlab='female',
            gapwidth = 0,ylab.x = -5)#將y軸移到x=-5位置,無gap
#右側圖
PlotPyramid(c(1,3,5,2,0.5),c(2,4,6,1,0),
            ylab = LETTERS[1:5],space=0.3, #每個條柱左邊留一定空隙
            col=rep(rainbow(5),each=2),
            xlim = c(-10,10),args.grid = NA,
            cex.names = 1.5,adj = 1,
            lxlab = 'Group A',rxlab = 'Group B',
            gapwidth = 0,ylab.x = -8,xaxt = 'n')