R語言繪圖基礎(chǔ)一

迷途中小小書童 2018-12-30

展開全文

1 R語言—基礎(chǔ)繪圖

plot(c(0:5), col = 'white')
text(2,4, labels = 'font=1:正常字體（默認(rèn)）', font = 1)
text(3,3, labels = 'font=2:粗體字體',font = 2)
text(4,2,labels = 'font=3:斜體字體',font = 3)
text(5,1,labels = 'font=4:粗斜體字體',font=4)

1.1 字體大小

plot(c(0:6),col='white',xlim = c(1,8))
text(2,5,labels = 'cex=0.5:放大0.5倍',cex=0.5)
text(3,4,labels = 'cex=0.8:放大0.8倍',cex=0.8)
text(4,3,labels = 'cex=1(默認(rèn)):正常大小',cex=1)
text(5,2,labels = 'cex=1.2:放大1.2倍',cex=1.2)
text(6,1,labels = 'cex=1.5:放大1.5倍',cex=1.5)

1.2 點的樣式

par(mar=c(0,0,0,0))
plot(1,col='white',xlim = c(1,9),ylim = c(1,7))
for(i in 0:25){
  x <- (i%/%5)*1+1
  y <- 6-(i%%5)
  if(length(which(c(21:25)==i)>=1)){
    #21--25的點格式可以設(shè)置背景色
    points(x,y,pch=i,bg='red',cex=2)
  }else{
    points(x,y,pch=i,cex=2)
  }
  text(x+0.2,y+0.3,labels = paste('pch=',i),cex=0.8)
}
points(6,5,pch='*',cex=2);text(6.2,5.3,labels = paste('pch=\'*\''),cex=0.8)
points(6,4,pch='.',cex=2);text(6.2,4.3,labels = paste('pch=\'.\''),cex=0.8)
points(6,3,pch='o',cex=2);text(6.2,3.3,labels = paste('pch=\'o\''),cex=0.8)
points(6,2,pch='O',cex=2);text(6.2,2.3,labels = paste('pch=\'O\''),cex=0.8)
points(7,6,pch='0',cex=2);text(7.2,6.3,labels = paste('pch=\'0\''),cex=0.8)
points(7,5,pch='+',cex=2);text(7.2,5.3,labels = paste('pch=\'+\''),cex=0.8)
points(7,4,pch='-',cex=2);text(7.2,4.3,labels = paste('pch=\'-\''),cex=0.8)
points(7,3,pch='|',cex=2);text(7.2,3.3,labels = paste('pch=\'|\''),cex=0.8)

1.3 線的樣式

par(mar=c(0,0,0,0))
data = matrix(rep(rep(1:7),10),ncol = 10, nrow = 7)
plot(data[1,],type = 'l',lty=0,ylim = c(1,8),xlim = c(-2,10),axes = F,
     xlab = '', ylab = '')
text(-1,1,labels = paste('lty=0',':不畫線'))
id = c('不畫線','實線','虛線','點線','長畫線','點畫線','點長畫線')
for(i in 2:7){
  lines(data[i,],lty=i-1)
  text(-1,i,labels = paste('lty=',i,':',id[i]))
}

1.4 線的寬度

par(mar=c(0,0,0,0))
data = matrix(rep(rep(1:5),10),ncol = 10, nrow = 5)
plot(data[1,],type = 'l',lwd=0.5,ylim = c(1,6),xlim = c(-2,10),axes = F,
     xlab = '', ylab = '')
text(0,1,labels = 'lwd=0.5')
lines(data[2,],lwd=0.8);text(0,2,labels = 'lwd=0.8')
lines(data[3,],lwd=1);text(0,3,labels = 'lwd=1')
lines(data[4,],lwd=2);text(0,4,labels = 'lwd=2')
lines(data[5,],lwd=4);text(0,5,labels = 'lwd=4')

1.5 坐標(biāo)軸的密度分布展示

plot(cars$speed,cars$dist)
rug(cars$speed)
rug(cars$dist,side = 2)

1.6 邊框

x.text <- c('1月','2月','3月','4月','5月','6月','7月','8月','9月','10月','11月','12月')
sales.volume <- c(158721,190094,108441,88092,68709,50116,90117,160044,186045,
                  106334,89092,104933)
id <- c('o','l','7','c','u',']')
par(mfrow=c(2,3))
for (i in 1:length(id)){
  plot(sales.volume,type = 'b',ylim = c(20000,250000),xaxt='n',yaxt='n',
       bty = id[i], main = paste('bty取',id[i],sep=''),xlab='月份',ylab='銷量')
  axis(1,at=1:12,labels = x.text,tick = FALSE);axis(2,tick = FALSE)
}

box()函數(shù)也可以設(shè)置各邊框的線條樣式，bty-邊框，col-顏色，lwd-線寬，lty-線樣

1.7 網(wǎng)格線

plot(sales.volume,type = 'b',ylim = c(20000,250000),xaxt='n',yaxt='n',
     main = '月銷量趨勢圖',xlab='月份',ylab='銷量（元）')
axis(1,at=1:12,labels = x.text,tick = FALSE)
grid(nx=NA, ny=8, lwd=1, col='skyblue')

1.8 點

x <- 2:9;y <- 2:9
par(mfrow=c(3,3),mar=c(2,2,2,2))
ida <- c('p','l','b','c','o','h','s','S','n')
for(i in 1:length(ida)){
  plot(1,1,ylim=c(1,10),xlim = c(1,10),col='white',
       main = paste('type=',ida[i],sep = ''))
  points(x,y,type=ida[i])
}

1.9 線

pv <- sample(100,10)
uv <- sample(1000,10)
sol <- lm(pv~uv)
plot(pv~uv,xlab=R.version.string,ylab = Sys.time())
abline(sol)

1.10 線段

pv <- sample(100,10)
uv <- sample(1000,10)
plot(pv,uv,xlab=R.version.string,ylab = Sys.time())
segments(pv[1],uv[1],pv[5],uv[5])

1.11 箭頭

plot(1,xlim = c(0,10),ylim = c(0,8),col='white')
arrows(1,1,8,1,angle = 90);text(9,1,'angle=90')
arrows(1,3,8,3,angle = 60);text(9,3,'angle=60')
arrows(1,5,8,5,angle = 30);text(9,5,'angle=30')
arrows(1,7,8,7,angle = 0);text(9,7,'angle=0')

1.12 多邊形

par(mfrow = c(2,1))
plot(0,xlim = c(0,10),ylim = c(0,10),col='white')
polygon(x=c(1,1,9,9),y=c(9,1,1,9),col = 'orange',border = 'blue')
plot(0,xlim = c(0,10),ylim = c(0,10),col='white')
polygon(x=c(1,1,9,9),y=c(9,1,9,1),col = 'orange',border = 'blue')

par(mfrow = c(1,1))
n <- 100
xx <- c(0:n, n:0)
yy <- c(c(0, cumsum(stats::rnorm(n))), rev(c(0, cumsum(stats::rnorm(n)))))
plot   (xx, yy, type = "n", xlab = "Time", ylab = "Distance")
polygon(xx, yy, col = "gray", border = "red")
title("Distance Between Brownian Motions")

1.13 氣泡圖

id <- c('手機數(shù)碼','食品飲料','電腦辦公','家居用品','母嬰玩具','家用電器','服裝鞋帽','日用百貨','虛擬商品','箱包禮品')
conver <- c(0.012,0.02,0.015,0.014,0.018,0.013,0.01,0.025,0.045,0.011)
pv <- c(23.19,10.89,15.09,12.11,9.6,20.29,40.56,28.66,20.43,13.84)
price <- c(3509,59,2501,509,411,3011,476,81,379,610)

library(RColorBrewer)
col <- brewer.pal(11,'Spectral')[2:11]

cex.max <- 12
cex.min <- 3
a <- c(cex.max-cex.min)/(max(price)-min(price))
b <- cex.min-a*min(price)
cex2 <- a*price+b
#cex2 <- price/max(price)

plot(pv,conver,col=col,cex=cex2,pch=16,ylim = c(0,0.06),xlab = '頁面瀏覽量（萬）',ylab = '轉(zhuǎn)化率',main=list('各類目轉(zhuǎn)化率-頁面瀏覽量-客單價',cex=1.5),yaxt='n')
legend('topleft',legend = id,pch=16,col=col,bty='n',cex=0.75,ncol=5)
axis(2,labels = paste(seq(0,5,1),'%',sep = ''),at=seq(0,0.05,0.01))
text(x=pv,y=conver,labels = price,cex=0.8)
text(x=38,y=0.055,labels = 'Z-客單價',cex=1.1)

1.14 曲線圖

x.text <- c('1月','2月','3月','4月','5月','6月','7月','8月','9月','10月','11月','12月')
sales.1 <- c(49.9,71.5,106.4,129.2,144,176,135.6,148.5,216.4,194.1,95.6,54.4)
sales.2 <- c(83.6,78.8,98.5,93.4,106.0,84.5,105,104.3,91.2,83.5,106.6,92.3)
sales.3 <- c(48.9,38.8,39.3,42.4,47,48.3,62,59.6,52.4,65.2,59.3,53)
sales.4 <- c(42.4,33.2,34.5,39.7,52.6,70.5,57.4,62,47.6,39.1,46.8,51.1)
id <- c('帆布鞋','T恤','皮包','沖鋒衣')
col <-c('green','yellow','brown','gray')
plot(sales.1,type = 'b',xaxt='n',ylim = c(0,300),col=col[1],main = '月銷量趨勢圖',xlab = '月份',ylab = '銷量（萬）')
axis(1,at=1:12,labels = x.text,tick = FALSE)
legend('topleft',legend = id,horiz = T,pch=15,col=col,cex=0.8,bty='n')
grid(nx=NA,ny=8,lwd=1,lty=2,col='skyblue')

lines(sales.2,type = 'b',col=col[2])
lines(sales.3,type = 'b',col=col[3])
lines(sales.4,type = 'b',col=col[4])

1.15 柱狀圖

id <- LETTERS[1:11]
month.3 <- c(25746,8595,12832,10910,7034,2978,6934,4770,1137,1164,6926)
month.4 <- c(46496,20150,19682,14177,20703,8434,9560,5113,1804,1468,11156)
month.5 <- c(53346,26547,23271,16909,14786,12733,11545,7483,2506,1743,11869)
data <- matrix(c(month.3,month.4,month.5),ncol = 3)

library(RColorBrewer)
col <- brewer.pal(11,'Spectral')[1:11]

barplot(data,col = col,xaxt='n',beside = TRUE,ylim = c(0,60000))
title(main = list('訂單取消原因',cex=1.5),sub = '月份：3-4 品類：鞋',
      ylab='訂單月取消數(shù)目')
legend('topleft',legend = id,pch = 15,col = col,ncol = 2,cex = 0.8)
axis(1,labels = c('3月份','4月份','5月份'),at=c(6,18,30),tick = FALSE)

per100 <- function(x){
  x <- x/sum(x)
  result <- paste(round(x*10000)/100,'%',sep='')
  result
}

text(labels = c(per100(month.3),per100(month.4),per100(month.5)),cex=0.6,
                x=c(seq(from=1.5,by=1,length.out = 11),seq(from=13.5,by=1,
                length.out=11),seq(from=25.5,by=1,length.out = 11)),
     y=c(month.3,month.4,month.5)+1000)

1.16 條形圖

id <- LETTERS[1:18]
pv <- sort(sample(30000,18),decreasing = TRUE)

library(RColorBrewer)
col <- c(brewer.pal(9,'YlOrRd')[1:9],brewer.pal(9,'Blues')[1:9])

barplot(pv,col = col,horiz = TRUE,xlim = c(-3e3,3e4))
title(main = list('ASDFGHJKL',cex=1.5),sub = R.version.string,
      ylab = Sys.time())
text(y=seq(from=0.7,length.out = 18,by=1.2),x=-1500,labels = id)
legend('topright',legend = rev(id),pch = 15,col = rev(col),ncol = 2,cex = 0.5)

text(labels=paste(round(1e4*pv/sum(pv))/100,'%',sep=''),cex=0.65,
     y=seq(from=0.7,length.out = 18,by=1.2),x=pv+1000)

1.17 餅圖

data <- LETTERS[1:7]
num <- runif(7)
library(RColorBrewer)
col <- brewer.pal(11,'Dark2')[3:11]

## Warning in brewer.pal(11, "Dark2"): n too large, allowed maximum for palette Dark2 is 8
## Returning the palette you asked for with that many colors

pie(num,col = col,xaxt='n',labels=paste(id,':',round(num*1000)/100,'%',sep=''))
title(main = list('ZXCVBNM',cex=1.5),sub = Sys.Date())

1.18 雙坐標(biāo)圖

data <- data.frame(pre=c(113,134,123,145,137,196,187),
                   now=c(129,122,134,149,146,215,208))

ylim.max <- 550
col <- c('green','yellow')
barplot(as.matrix(rbind(data$pre,data$now)),
        beside = TRUE, ylim = c(0, ylim.max), col = col, axes = F)
axis(2,col.axis='red',col='orange',col.ticks = 'skyblue')
#設(shè)置坐標(biāo)
title(main = list('主標(biāo)題',cex=1.5,col='red',font=3),
      sub = paste('副標(biāo)題','\n',R.version.string,Sys.time()),
      ylab = 'y軸標(biāo)題')
#設(shè)置圖列
text.legend = c('上周PV','本周PV','pv同比增長','PV環(huán)比增長')
col2 = c('black','blue')
legend('topleft',pch=c(15,15,16,16),legend = text.legend, col=c(col,col2),
       bty = 'n',horiz = TRUE,cex =0.65,x.intersp=0.5,pt.cex=0.5)

#添加x軸坐標(biāo)
text.x <- c('周一','周二','周三','周四','周五','周六','周日')
axis(side = 1,c(2,5,8,11,14,17,20),labels = text.x, tick = FALSE, cex.axis=0.75)

#添加副坐標(biāo)
axis(4,at=seq(from = 250, length.out = 7, by =40),
     labels = c('-60%','-40%','-20%','0','20%','40%','60%'))

#同比增長=（now[t]-pre[t]）/pre[t]
same.per.growth <- (data$now - data$pre)/data$pre
#環(huán)比增長 = （now[t]-now[t-1]）/now[t-1]
ring.growth <- c(NA,diff(data$now)/data$now[1:(length(data$now) -1)])
a <- 200;b <- 370
lines(c(2,5,8,11,14,17,20),a*same.per.growth+b,type = 'b',lwd=1)
lines(c(2,5,8,11,14,17,20),a*ring.growth+b,type = 'b',lwd=1,col='blue')

#在同比和環(huán)比曲線上添加文字
j <- 1
for(i in 1:length(data[,1])){
  text(3*i-1,a*same.per.growth[i]+b-5,paste(round(same.per.growth[i]*10000)
    /100,'%',sep = ''),cex = 0.65);j=j+1
  text(3*i-1,a*ring.growth[i]+b-5,paste(round(ring.growth[i]*10000)/100,
      '%',sep = ''),col='blue',cex = 0.65);j=j+2
}

#為柱形圖添加文字
j <- 1
for(i in 1:length(data[,1])){
  text(j+0.5,data$pre[i]+10,data$pre[i],col = 'green');j <- j+1
  text(j+0.5,data$now[i]+10,data$now[i],col ='yellow');j <- j+2
}

1.19 圖形的局部放大

id <- LETTERS[1:9]
num <- c(0.053,0.46,0.087,0.213,0.078,0.042,0.031,0.026,0.01)
data <- data.frame(id=id,num=num)
split <- 6  #設(shè)置分割變量
max.bar2 <- 0.4 #設(shè)置副柱狀圖高度變量

bar.data1 = matrix(rev(c(rep(NA, split+1),num[1:split],sum(num[-(1:split)]))),
                  ncol = 2, nrow = split+1)


bar.data2 = matrix(c(rep(NA, split+1),rev(num[-(1:split)]),
                     rep(NA,nrow(data)-split-1)), ncol = 2, nrow = split+1)

## Warning in matrix(c(rep(NA, split + 1), rev(num[-(1:split)]), rep(NA,
## nrow(data) - : 數(shù)據(jù)長度[12]不是矩陣行數(shù)[7]的整倍

library(RColorBrewer)
col <- brewer.pal(12,'Set1')

## Warning in brewer.pal(12, "Set1"): n too large, allowed maximum for palette Set1 is 9
## Returning the palette you asked for with that many colors

barplot(bar.data1,col = c('azure3',col[1:split]),axes = FALSE,ylim = c(0,1),
        xlim = c(0,4.5),border = 'azure3')
barplot(bar.data2*(max.bar2/sum(num[-(1:split)])),col = col[-(1:split)],
        axes = FALSE, add = TRUE, border = 'azure3')
polygon(x=c(1.2,1.2,1.4,1.4),y = c(0,sum(num[-(1:split)]),max.bar2,0),
        col='azure3',border = 'azure3')

labels=paste(round(num*10000)/100,'%',sep = '')
y1 <- 0
for(i in 1:split){
  y1[i] = sum(num[-(1:i)])
}

text(x=1,y=y1+0.02,labels[1:split],cex=0.8)
y2 <- 0
for(i in 1:(nrow(data)-split-1)){
  y2[i] <- sum(num[(split+i+1):nrow(data)])
}
y2 <- c(y2,0)
y2 <- y2*(max.bar2/sum(num[-(1:split)]))
text(x=2,y=y2+0.02,labels[-(1:split)],cex = 0.8)

legend('topright',legend =id,pch=15,col=c(rev(col[1:split]),
            rev(col[-(1:split)])),ncol = 2,bty = 'n')

title(main = list('ASDFGHJKL',cex=1.5),sub = Sys.time())

sessionInfo()

## R version 3.4.4 (2018-03-15)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 17134)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.936 
## [2] LC_CTYPE=Chinese (Simplified)_China.936   
## [3] LC_MONETARY=Chinese (Simplified)_China.936
## [4] LC_NUMERIC=C                              
## [5] LC_TIME=Chinese (Simplified)_China.936    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] RColorBrewer_1.1-2 rticles_0.5       
## 
## loaded via a namespace (and not attached):
##  [1] compiler_3.4.4  backports_1.1.2 magrittr_1.5    rprojroot_1.3-2
##  [5] tools_3.4.4     htmltools_0.3.6 yaml_2.2.0      Rcpp_0.12.18   
##  [9] stringi_1.1.7   rmarkdown_1.10  knitr_1.20      stringr_1.3.1  
## [13] digest_0.6.15   evaluate_0.11