《R语言实战》绘图代码记录

<pre name="code" class="java"><pre name="code" class="plain">#数据准备------------
install.packages("vcd")
library(vcd)

#6.1 条形图-------------
#6.1.1 简单条形图----------
(counts <- table(Arthritis$Improved))
barplot(counts,main="Simple Bar Plot",xlab = "Improved",ylab = "Frequency")
barplot(counts,main = "Horizontal Bar Plot",xlab = "Frequency",ylab = "Improved",
        horiz = T)
#6.1.2 堆积和分组条形图-------
(counts <- table(Arthritis$Improved,Arthritis$Treatment))
barplot(counts,main = "Stacked Bar Plot",xlab = "Treatment",ylab = "Frequency",
        col = c("red","yellow","green"),legend = rownames(counts))
barplot(counts,main = "Grouped Bar Plot",xlab = "Treatment",ylab = "Frequency",
        col = c("red","yellow","green"),legend = rownames(counts),beside = T)

#6.1.3 均值条形图-----------
states <- data.frame(state.region,state.x77)
(means <- aggregate(states$Illiteracy,by = list(states$state.region),mean))
(means <- means[order(means$x),])
barplot(means$x,names.arg = means$Group.1)
title("Mean Illiteracy Rate")
#6.1.4 条形图微调----------
library(vcd)
par(mar = c(5,8,4,2))
par(las = 2)
(counts <- table(Arthritis$Improved))
barplot(counts,main = "Treament Outcome",horiz = T,cex.names = 0.8,
        names.arg = c("No Improvement","Some Improvement","Marked Improvement"))
#6.1.5 棘状图（堆叠条形图，但是高度为1）------------
library(vcd)
attach(Arthritis)
counts <- table(Treatment,Improved)
spine(counts,main = "Spinogram Example")
detach(Arthritis)

#6.2 饼图----------
par(mfrow = c(2,2))
par(mar = c(5.1,4.1,4.1,2.1))
slices <- c(10,12,4,16,8)
lbls <- c("US","UK","Australia","Germany","France")
pie(slices,labels = lbls,main = "Simple Pie Chart")
#
pct <- round(slices/sum(slices)*100)
(lbls2 <- paste(lbls," ",pct,"%",sep = ""))
pie(slices,labels = lbls2,col = rainbow(length(slices)),
    main = "Pie Chart With Percentages")
#使用plotrix包做3D饼图
install.packages("plotrix")
library(plotrix)
pie3D(slices,labels = lbls,explode = 0.1,main = "3D Pie Chart")
#使用table做pie图
mytable <- table(state.region)
lbls3 <- paste(names(mytable),"\n",mytable,sep="")
pie(mytable,labels = lbls3,main = "Pie Chart from a Table\n (with sample sizes)")
#扇形图
fan.plot(slices,labels = lbls,main = "Fan Plot")

#6.3 直方图---------
par(mfrow = c(2,2))
hist(mtcars$mpg)
#breaks参数，将横轴分成多少分
hist(mtcars$mpg,breaks = 12,col = "red",xlab = "Miles Per Gallon",
     main = "Colored histogram with 12 bins")
#注意下面的参数freq，freq设置为FALSE之后，y轴表示的是百分比，不是频数
hist(mtcars$mpg,freq = F,breaks = 12,col = "red",xlab = "Miles Per Gallon",
     main = "Histogram,rug polt,density curve")
rug(jitter(mtcars$mpg))
lines(density(mtcars$mpg),col = "blue",lty = 2)
#将图形付给参数，可以得到图形的细节,h <- hist(....)
x <- mtcars$mpg
h <- hist(x,breaks = 12,col = "red",xlab = "Miles Par Gallon",
          main = "Histogram with normal curve and box")
(xfit <- seq(min(x),max(x),length = 40))
yfit <-dnorm(xfit,mean = mean(x),sd = sd(x))
yfit <- yfit*diff(h$mids[1:2])*length(x)
lines(xfit,yfit,col = "blue",lty = 2)
box()

#6.4 核密度图--------------
par(mfrow = c(2,1))
d <- density(mtcars$mpg)
plot(d)
plot(d,main = "Kernal Density of Miles Per Gallon")
polygon(d,col = "red",border = "blue")
rug(mtcars$mpg,col = "brown")
#使用sm包在一个图中做多组密度图
par(mfrow = c(1,1))
par(lwd=2)
install.packages("sm")
library(sm)
attach(mtcars)
(cyl.f <- factor(cyl,levels = c(4,6,8),labels = c("4 cylinder","6 cylinder","8 cylinder")))
sm.density.compare(mpg,cyl,xlab = "Miles Per Gallon")
title(main = "MPG Distribution by Car Cylinders")
colfill <- c(2:length(levels(cyl.f)))
legend(locator(1),levels(cyl.f),fill = colfill)
detach(mtcars)

#6.5 箱线图---------
boxplot(mtcars$mpg,main = "Box Plot",ylab = "Miles per Gallon")
#输出箱图的信息
boxplot.stats(mtcars$mpg)
#6.5.1 使用箱图进行比较--------
boxplot(mpg~cyl,data = mtcars,main = "Car Mileage Data",xlab = "Number of Cylinders",
        ylab = "Miles Per Gallon")
#varwidth=T使得箱图的宽度和他们的容量成正比
boxplot(mpg~cyl,data = mtcars,main = "Car Mileage Data",xlab = "Number of Cylinders",
        ylab = "Miles Per Gallon",notch = TRUE,varwidth = T,col = "red")
#交叉因子箱图
mtcars$cyl.f <- factor(mtcars$cyl,levels = c(4,6,8),labels = c("4","6","8"))
mtcars$am.f <- factor(mtcars$am,levels = c(0,1),labels = c("auto","standard"))
boxplot(mpg~cyl.f*am.f,data = mtcars,varwidth = T,col = c("gold","darkgreen"),
        main = "MPG Distribution by Auto Type",xlab = "Auto Type")
#6.5.2 小提琴图----------
#这里使用到的包是vioplot
install.packages("vioplot")
library(vioplot)
x1 <- mtcars$mpg[mtcars$cyl == 4]
x2 <- mtcars$mpg[mtcars$cyl == 6]
x3 <- mtcars$mpg[mtcars$cyl == 8]
vioplot(x1,x2,x3,names = c("4 cyl","6 cyl","8 cyl"),col = "gold")
title("Violin Plots of Miles Per Gallon")

#6.6 点图----------
#cex参数的作用是设置问文本的尺寸
dotchart(mtcars$mpg,labels = row.names(mtcars),cex = .7,
         main = "Gas Mileage for Car Models",xlab = "Miles Per Gallon")
#分组、排序、着色后的点图
x <- mtcars[order(mtcars$mpg),]
x$cyl <- factor(x$cyl)
x$color[x$cyl == 4] <- "red"
x$color[x$cyl == 6] <- "blue"
x$color[x$cyl == 8] <- "darkgreen"
dotchart(x$mpg,labels = row.names(x),cex = .7,groups = x$cyl,
         gcolor = "black",#gcolor 参数表示groupcolor
         color = x$color,pch = 19,#pch参数设置点的类型
         main = "Gas Mileage for Car Models\ngrouped by cylinder",
         xlab = "Miles Per Gallon")

#11.1 散点图--------
attach(mtcars)
plot(wt,mpg,main = "Basic Scatter plot of MPG vs. Weight",xlab = "Car Weight (lbs/1000)",
     ylab = "Miles Per Gallon",pch = 10)
abline(lm(mpg~wt),col = "red",lwd = 2,lty = 1)
lines(lowess(wt,mpg),col = "blue",lwd = 2,lty = 2)
#使用car包做更加复杂的散点图,这个图比较难看懂，没什么用
install.packages("car")
library(car)
scatterplot(mpg~wt|cyl,data = mtcars,
            lwd = 2,
            main = "Scatter Plot of MPG vs. Weight # Cylinders",
            xlab = "Weight of Car (lbs/1000)",
            ylab = "Miles Per Gallon",
            legend.plot = T,
            id.method = "identify",
            labels = row.names(mtcars),
            boxplots = "xy")
#11.1.1 散点图矩阵-------
#upper.panel = NULL 设置矩阵只显示下矩阵
pairs(~mpg+disp+drat+wt,data = mtcars,main = "Basic Scatter Plot Matrix",upper.panel = NULL)
#car包中的scatterplotMatrix() 函数也可以生成散点图矩阵，并有以下可选操作：
#?1以某个因子为条件绘制散点图矩阵；
#?2包含线性和平滑拟合曲线；
#?3在主对角线放置箱线图、密度图或者直方图；
#?4在各单元格的边界添加轴须图。
library(car)
scatterplotMatrix(~mpg+disp+drat+wt,data = mtcars,spread = F,lty.smoooth = 2,
                  main = "Scatter Polt Matrix via car Package")
scatterplotMatrix(~mpg+disp+drat+wt|cyl,data = mtcars,spread = F,
                  diagonal = "histogram",#diagonal设置对角线类型
                  main = "Scatter Polt Matrix via car Package")
#gclus包中的cpairs() 函数提供了一个有趣的散点图矩阵变种。
#它含有可以重排矩阵中变量位置的选项，可以让相关性更高的变量更靠近主对角线。
#该函数还能对各单元格进行颜色编码来展示变量间的相关性大小
install.packages("gclus")
library(gclus)
mydata <- mtcars[c(1,3,5,6)]
mydata.corr <- abs(cor(mydata))
mycolors <- dmat.color(mydata.corr)
myorder <- order.single(mydata.corr)
cpairs(mydata,myorder,panel.colors = mycolors,gap = .5,
       main = "Variables Ordered and Colorsed by Correlation")
#11.1.2 高密度散点图(热力图)----------
set.seed(1234)
n <- 10000
c1 <- matrix(rnorm(n,0,.5),ncol = 2)
c2 <- matrix(rnorm(n,3,2),ncol = 2)
mydata <- rbind(c1,c2)
mydata <- as.data.frame(mydata)
names(mydata) <- c("x","y")
with(mydata,
     plot(x,y,pch = 19,main = "Scatter Plot with 10,000 Obervations"))
with(mydata,
     smoothScatter(x,y,main = "Scatterplot Colored by Smoothed Densities"))
#hexbin包中的hexbin() 函数将二元变量的封箱放到六边形单元格中（图形比名称更直观）。示例如下
install.packages("hexbin")
library(hexbin)
with(mydata,{
  bin  <- hexbin(x,y,xbins = 50)
  plot(bin,main = "Hexagonal Binning with 10,000 Obervations")
})
#IDPmisc包中的iplot() 函数也可通过颜色来展示点的密度（在某特定点上数据点的数目）
install.packages("IDPmisc")
library(IDPmisc)
with(mydata,
     iplot(x,y,main = "Image Scatter Plot with Color Indicating Density"))
#11.1.3 三维散点图-----
#使用scatterplot3d包
install.packages("scatterplot3d")
library(scatterplot3d)
attach(mtcars)
scatterplot3d(wt,disp,mpg,main = "Basic 3D Scatter plot")
#在3d图中增加z轴线
scatterplot3d(wt,disp,mpg,pch = 16,highlight.3d = T,type =  "h",
              main = "Basic 3D Scatter plot")
#在3d图中增加一个回归面
s3d <- scatterplot3d(wt,disp,mpg,pch = 16,highlight.3d = T,type =  "h",
                     main = "Basic 3D Scatter plot")
fit <- lm(mpg~wt+disp)
s3d$plane3d(fit)
#交互式3维散点图
#使用rgl包，交互性的，可以用鼠标
install.packages("rgl")
library(rgl)
plot3d(wt,disp,mpg,col = "red",size = 5)
#以下使用Rcmdr包，旋转
install.packages("Rcmdr")
library(Rcmdr)
scatter3d(wt,disp,mpg)
#11.1.4 气泡图------
r <- sqrt(disp/pi)
symbols(mtcars$wt,mtcars$mpg,circles = r,
        inches = .3,#inches参数控制圆圈基准大小，默认1英寸
        fg = "white",
        bg = "lightblue",
        main = "Bubble Plot with point size proportional to displacement",
        ylab = "Miles Per Gallon",
        xlab = "Weight of Car (lbs/1000)")
text(mtcars$wt,mtcars$mpg,rownames(mtcars),cex = .6)
detach(mtcars)

#11.2 折线图---------
oper <- par(no.readonly = T)
par(mfrow = c(1,2))
t1 <- subset(Orange,Tree == 1)
plot(t1$age,t1$circumference,xlab = "Age (days)",
     ylab = "Circumference (mm)",main = "Orange Tree 1 Growth")
plot(t1$age,t1$circumference,xlab = "Age (days)",
     ylab = "Circumference (mm)",main = "Orange Tree 1 Growth",type = "b")
par(oper)
#在一幅图中画多个折线图
Orange$Tree <- as.numeric(Orange$Tree)
ntrees <- max(Orange$Tree)
xrange <- range(Orange$age)
yrange <- range(Orange$circumference)
plot(xrange,yrange,type = "n",xlab = "Age (days)",ylab = "Circumference (mm)")
colors <- rainbow(ntrees)
linetype <- 1:ntrees
plotchar <- 18:(18+ntrees)
for (i in 1:ntrees) {
  tree <- subset(Orange,Tree == i)
  lines(tree$age,tree$circumference,type = "b",
        lwd = 2,lty = linetype[i],col = colors[i],pch = plotchar[i])
}
title("Tree Growth","example of line polt")
legend(xrange[1],yrange[2],1:ntrees,cex=.8,col = colors,
       pch = plotchar,lty = linetype,title = "Tree")

#11.3 相关图(不常用)---------
#使用到corrgram包
options(digits = 2)
install.packages("corrgram")
library(corrgram)
corrgram(mtcars,order = T,lower.panel = panel.shade,upper.panel = panel.pie,
         text.panel = panel.txt,main = "Correlogram of mtcars intercorrelations")

#11.4 马赛克图--------
ftable(Titanic)
library(vcd)
mosaic(Titanic,shade = T,legend = T)
mosaic(~Class+Sex+Age+Survived,Titanic,shade = T,legend = T)

#16.2 lattic包---------
library(lattice)
histogram(~height|voice.part,data = singer,
          main = "Distribution of Heights by Voice Pitch",
          xlab = "Height (inches)")
contourplot(volcano)
levelplot(volcano)
cloud(volcano)
wireframe(volcano)
bwplot(mtcars$mpg)
parallelplot(mtcars[1:3])
stripplot(mtcars$mpg~factor(mtcars$cyl))
splom(mtcars[c(1,3,4,5)])
#16.2.1 条件变量---------
(displacement <- equal.count(mtcars$disp,number = 3,overlap = 0))#overlap设置重叠部分
xyplot(mtcars$mpg~mtcars$wt|displacement,
       main = "Miles per Gallon vs. Weight by Engine Displacement",
       xlab = "Weight",ylab = "Mile per Gallon",
       layout = c(3,1),aspect = 1.5)
#16.2.2 面板函数-----------
mypanel <-function(x,y){
  panel.xyplot(x,y,pch=19)
  panel.rug(x,y)
  panel.grid(h=-1,v=-1)
  panel.lmline(x,y,col = "red",lwd = 1,lty = 2)
}
xyplot(mtcars$mpg~mtcars$wt|displacement,
       main = "Miles per Gallon vs. Weight by Engine Displacement",
       scales = list(cex=.8,col = "red"),
       xlab = "Weight",ylab = "Mile per Gallon",
       layout = c(3,1),aspect = 1.5,panel = mypanel,index.cond = list(c(2,1,3)))
#16.2.3 分组变量---------
mtcars$transmission <- factor(mtcars$am,levels = c(0,1),labels = c("Automatic","Manual"))
colors <- c("red","blue")
lines <- c(1,2)
points <- c(16,17)
key.trans <- list(title = "Trasmission",space = "bottom",columns = 2,
                  text = list(levels(mtcars$transmission)),
                  points = list(pch = points,col = colors),
                  lines = list(col = colors,lty = lines),
                  cex.title = 1,cex = .9)
densityplot(~mpg,data = mtcars,groups = transmission,
            main = "MPG Distribution by Transmission Type",
            xlab = "Mile per Gallon",
            pch = points,lty = lines,col = colors,lwd = 2,jitter = .005,
            key = key.trans)
#16.2.5 页面摆放-----------
graph1 <- histogram(~height|voice.part,data = singer,
                    main = "Heights of Choral Singers by Voice Part")
graph2 <- densityplot(~height,data = singer,groups = voice.part,
                      plot.points = F,auto.key = list(columns = 4))
plot(graph1,split = c(1,1,1,2))
plot(graph2,split = c(1,2,1,2),#split 参数说明，c(列位置号码,行位置号码，列数，行数)
     newpage = F)
plot(graph1,position = c(0,.3,1,1))
plot(graph2,position = c(0,0,1,.3),#position = c(xmin, ymin, xmax, ymax) 
     newpage = F)

#16.3 ggplot2包---------
install.packages("ggplot2")
library(ggplot2)
mtcars$cylinder <- as.factor(mtcars$cyl)
qplot(cylinder,mpg,data = mtcars,geom = c("boxplot","jitter"),fill = cylinder,
      main = "Box plots with superimposed data points",
      xlab = "Number of Cylinder",ylab = "Miles per Gallon")
transmission <- factor(mtcars$am,levels = c(0,1),labels = c("Automatic","Manual"))
qplot(wt,mpg,data = mtcars,color = transmission,shape = transmission,
      gemo = c("point","smooth"),
      method = lm,formula = y~x,
      xlab = "Weight",ylab = "Miles Per Gallon",
      main = "Regiession Example")
qplot(wt,mpg,data = mtcars,facets = transmission~cylinder,size = hp)
data(singer,package = "lattice")
qplot(height,data = singer,geom = c("density"),
      facets = voice.part~.,fill = voice.part)

#16.4 交互式图形-----------
plot(mtcars$wt,mtcars$mpg)
identify(mtcars$wt,mtcars$mpg,labels = row.names(mtcars))