R语言数据分析、展现与实例（04）
R语言数据分析、展现与实例（04）
利用xyplot()对散点分组——在lattice包里
> library(lattice)
> mtcars
> xyplot(mpg~disp,
+ data=mtcars,
+ groups = cyl,
+ suto.key=list(corner=c(1,1))) #生成右上角的图例
初试ggplot2包
> library(ggplot2)
> qplot(disp,mpg,data=mtcars,col=as.factor(cyl)) #横坐标，纵坐标，指定数据框，颜色按照cyl分组
使用散点形状和大小来表示分组
> qplot(disp,mpg,data=mtcars,shape=as.factor(cyl))
> qplot(disp,mpg,data=mtcars,size=as.factor(cyl))
用text()标示点
> plot(mpg~disp,data=mtcars)
> text(258,22,"Hornet") #想要标示的坐标，文字
> health <- read.csv("HealthExpenditure.csv",header=TRUE)
> plot(health$Expenditure,health$Life_Expectancy,type = "n")
> text(health$Expenditure,health$Life_Expectancy,health$Country)
例子：散点图+相关系数
> panel.cor <- function(x,y,...)
+ {
+ par(usr=c(0,1,0,1)) #用户自定义坐标轴范围
+ txt <- as.character(format(cor(x,y),digits=2)) #cor是x,y的相关系数；digits保留两位小数，as.character保存成字符串
+ text(0.5,0.5,txt,cex=6*abs(cor(x,y))) #以0.5，0.5为中心;内容;字符大小
+ }
> pairs(iris[1:4],upper.panel = panel.cor)
误差条
> plot(mpg~disp,data=mtcars)
> arrows(x0=mtcars$disp, # 误差横坐标
+ y0=mtcars$mpg*0.95, # 误差纵坐标下限
+ x1=mtcars$disp, #误差横坐标
+ y1=mtcars$mpg*1.05, #误差纵坐标上限
+ angle=90, #误差线角度
+ code=3, #箭头类型是3号
+ length=0.04, #箭头长度0.04
+ lwd=0.4) #线宽
以上 再加上横坐标误差范围
arrows(x0=mtcars$disp*0.95,
y0=mtcars$mpg,
x1=mtcars$disp*1.05,
y1=mtcars$mpg,
angle=90,
code=3,
length=0.04,
lwd=0.4)
jitter()
> x <- rbinom(1000,10,0.25) #产生1000个随机数，其均值为10*025左右
> y <- rbinom(1000,10,0.25)
> plot(x,y)
> plot(jitter(x),jitter(y)) #jitter函数，给向量加上少许噪音
线性模型：画回归之线
> plot(mtcars$mpg~mtcars$disp)
> lmfit <- lm(mtcars$mpg~mtcars$disp)
> abline(lmfit) #abline是低级作图命令非线性模型的拟合曲线
> x <- -(1:100)/10
> y <- 100+10*exp(x/2)+rnorm(x)/10
> nlmod <- nls(y ~ Const +A*exp(B*x),trace=TRUE)
> plot(x,y)
> lines(x,predict(nlmod),col="red")
lowess:局部加权回归三点平滑法
> plot(cars,main="lowess(cars)")
> lines(lowess(cars),col="blue")
> lines(lowess(cars,f=0.3),col="orange")
三维散点图
> library("scatterplot3d")
> scatterplot3d(x=mtcars$wt,y=mtcars$disp,z=mtcars$mpg)
> library("scatterplot3d")
> scatterplot3d(x=mtcars$wt,y=mtcars$disp,z=mtcars$mpg)
> scatterplot3d(x=mtcars$wt,y=mtcars$disp,z=mtcars$mpg,
+ pch=16,
+ highlight.3d=TRUE, #设置变化颜色的效果
+ angle=20, #x, y 之间的夹角
+ xlab="Weight",ylab="Displacement",zlab="Fuel Economy(mpg)",
+ type="h",
+ main= "Relationships between car specifications")
高维数据展现专业扩展包rggobi
install.packages(“rggobi”)
http://www.ggobi.org/rggobi/
动画demo
http://www.ggobi.org/demos/
QQ图
> qqnorm(mtcars$mpg)
> qqline(mtcars$mpg)判断是否正态分布（是否接近这直线）
线性回归模型的检验
> lmfit <- lm(mtcars$mpg~mtcars$disp)
> par(mfrow=c(2,2))
> plot(lmfit)
画密度函数
> x <- rnorm(1000)
> plot(density(x))
> rug(x) #通过竖线的密集程度了解数据分布情况
rug()
> metals <- read.csv("metals.csv")
> plot(Ba~Cu,data=metals,xlim=c(0,100))
> rug(metals$Cu)
> rug(metals$Ba,side=2,col="red",ticksize = 0.02) # side参数默认画到x轴，2表示画到y轴；ticksize表示小竖线的长度
> 
smoothScatter()
> n <- 10000
> n
[1] 10000
> x <- matrix(rnorm(n),ncol=2)
> y <- matrix(rnorm(n,mean=3,sd=1.5),ncol=2)
> smoothScatter(x,y) #达到一个雾化的效果
早期社交图
………………
继续数据展现
线图
> plot(rain$Tokyo,type = "b",lwd=2, #type = "b"既画点又画线
+ xaxt = "n",ylim=c(0,300),col="black", #xaxt = "n"表示x轴没有刻度
+ xlab= "Month",ylab="Rainfall(mm)",
+ main="Monthly Rainfall in major cities")
> axis(1,at=1:length(rain$Month),labels=rain$Month) #在坐标轴上加刻度，第一个参数指定位置，第二个指定刻度大小
> lines(rain$Berlin,col="red",type = "b",lwd=2)
> lines(rain$NewYork,col="orange",type = "b",lwd=2)
> lines(rain$London,col="purple",type = "b",lwd=2)
> legend("topright",legend = c("Tokyo","Berlin","NewYork","London"),
+ lty=1,lwd=2,pch=21,col=c("black","red","orange","purple"),#lty指定线的类型，lwd指定线宽，pch指定线上图标的样子
+ ncol=2,bty="n",cex=0.8, #ncol指定图标列数，bty指定是否给图标加框，cex指定字的大小
+ text.col=c("black","red","orange","purple"), #指定图标字的颜色
+ inset=0.01) #指定图例中图与字的距离
给线图增加legend（图例）
> legend(1,300,legend=c("Tokyo","Berlin","New York","London"),
+ lty=1,lwd=2,pch=21,col=c("black","red","orange","purple"),
+ horiz=TRUE,bty="n",bg="yellow",cex=1,
+ text.col=c("black","red","orange","purple"))
用线图描画时间序列——GDP的例子
> gdp <- read.table("gdp_long.txt",header = T)
> library(RColorBrewer)
> pal <- brewer.pal(5,"Set1")
> par(mar=par()$mar+c(0,0,0,2),bty="l")
> plot(Canada~Year,data=gdp,type="l",lwd=2,lty=1,ylim=c(30,60),
+ col=pal[1],main="Percentage change in GDP",ylab="")
> mtext(side=4,at=gdp$Canada[length(gdp$Canada)],text="Canada",
+ col=pal[1],line=0.3,las=2)
> lines(gdp$France~gdp$Year,col=pal[2],lwd=2)
> mtext(side=4,at=gdp$France[length(gdp$France)],text="France",
+ col=pal[2],line=0.3,las=2)
> lines(gdp$Germany~gdp$Year,col=pal[3],lwd=2)
> mtext(side=4,at=gdp$Germany[length(gdp$Germany)],text = "Germany",
+ col=pal[3],line=0.3,las=2)
> lines(gdp$Britain~gdp$Year,col=pal[4],lwd=2)
> mtext(side=4,at=gdp$Britain[length(gdp$Britain)],text = "Britain",
+ col=pal[4],line=0.3,las=2)
> lines(gdp$USA~gdp$Year,col=pal[5],lwd=2)
> mtext(side=4,at=gdp$USA[length(gdp$USA)]-1,text = "USA",
+ col=pal[5],line=0.3,las=2)
画底纹格子
> rain <- read.csv("cityrain.csv")
> plot(rain$Tokyo,type="b",lwd=2,xaxt="n",ylim=c(0,300),col="black",
+ xlab="Month",ylab="Rainfall(mm)",main="Monthly Rainfall in Tokyo")
> axis(1,at=1:length(rain$Month),labels=rain$Month)
> grid() #画底纹
> grid(nx=NA,ny=8,lwd=1,lty=2,col="blue") #nx表示x轴上的底纹，ny表示y轴上的底纹
垂直线
> rain <- read.csv("cityrain.csv")
> plot(rain$Tokyo,type="b",lwd=2,
+ xaxt="n",ylim=c(0,300),col="black",
+ xlab="Month",ylab="Rainfall (mm)",
+ main="Monthly Rainfall in Tokyo")
> axis(1,at=1:length(rain$Month),labels=rain$Month)
> abline(v=9)
> abline(h=150,col="red",lty=2) #水平线
sparkline
rain <-read.csv("cityrain.csv")
par(mfrow=c(4,1),mar=c(5,7,4,2),omi=c(0.2,2,0.2,2)) # mar,omi 图形边界距离的确定
for(i in 2:5)
{
plot(rain[,i],ann=FALSE,axes=FALSE,type = "l",col="gray",lwd=2) # ann图形注释#axes坐标轴的有无
mtext(side=2,at=mean(rain[,i]),names(rain[i]),las=2,col="black")
mtext(side=4,at=mean(rain[,i]),mean(rain[,i]),las=2,col="black")
points(which.min(rain[,i]),min(rain[,i]),pch=19,col="blue")
points(which.max(rain[,i]),max(rain[,i]),pch=19,col="red")
}
时间序列图
> sales <- read.csv("dailysales.csv")
> plot(sales$units~as.Date(sales$date,"%d/%m/%y"),type="l",
+ xlab="Date",ylab="Units Sold")
处理时间序列数据的包zoo
zoo——将一个数据框变成一个时间序列
> library(zoo)
> plot(zoo(sales$units,as.Date(sales$date,"%d/%m/%y")))
数据较多的例子
> air <- read.csv("openair.csv")
> plot(air$nox~as.Date(air$date,"%d/%m/%Y %H:%M"),type="l",
+ xlab="Time",ylab="Concentration(ppb)",
+ main="Time trend of Oxides of Nitrogen")
用zoo包实现
> plot(zoo(air$nox,as.Date(air$date,"%d/%m/%Y %H:%M")),
+ xlab="Time", ylab="Concentration (ppb)",
+ main="Time trend of Oxides of Nitrogen")
时间刻度可读化
> plot(air$nox~as.Date(air$date,"%d/%m/%Y %H:%M"),type="l",
+ xaxt="n",
+ xlab="Time", ylab="Concentration (ppb)",
+ main="Time trend of Oxides of Nitrogen")
> xlabels<-strptime(air$date, format = "%d/%m/%Y %H:%M")
> axis.Date(1, at=xlabels[xlabels$mday==1], format="%b-%Y")
标记特定的时间事件
> plot(air$nox~as.Date(air$date,"%d/%m/%Y %H:%M"),type="l",
+ xlab="Time", ylab="Concentration (ppb)",
+ main="Time trend of Oxides of Nitrogen")
> abline(v=as.Date("25/12/2003","%d/%m/%Y"))
求出均值后画时间序列
air$date = as.POSIXct(strptime(air$date, format = "%d/%m/%Y %H:%M“,"GMT"))
means <- aggregate(air["nox"], format(air["date"],"%Y-%U"),mean,na.rm = TRUE)
means$date <- seq(air$date[1], air$date[nrow(air)],length = nrow(means))
plot(means$date, means$nox, type = "l")
画股票数据
install.packages("quantmod")
install.packages("tseries")
library(quantmod)
library(tseries)抓取股票数据并画出趋势图
> aapl <-get.hist.quote(instrument = "aapl",quote=c("Cl","Vol"))
trying URL 'http://chart.yahoo.com/table.csv?s=aapl&a=0&b=02&c=1991&d=2&e=08&f=2017&g=d&q=q&y=0&z=aapl&x=.csv'
Content type 'text/csv' length unknown
downloaded 428 KB
> goog <- get.hist.quote(instrument = "goog", quote = c("Cl", "Vol"))
trying URL 'http://chart.yahoo.com/table.csv?s=goog&a=0&b=02&c=1991&d=2&e=08&f=2017&g=d&q=q&y=0&z=goog&x=.csv'
Content type 'text/csv' length unknown
downloaded 226 KB
time series starts 2004-08-19
> msft <- get.hist.quote(instrument = "msft", quote = c("Cl", "Vol"))
trying URL 'http://chart.yahoo.com/table.csv?s=msft&a=0&b=02&c=1991&d=2&e=08&f=2017&g=d&q=q&y=0&z=msft&x=.csv'
Content type 'text/csv' length unknown
downloaded 395 KB
> plot(msft$Close,main = "Stock Price Comparison",
+ ylim=c(0,800), col="red", type="l", lwd=0.5,
+ pch=19,cex=0.6, xlab="Date" ,ylab="Stock Price (USD)")
> lines(goog$Close,col="blue",lwd=0.5)
> lines(aapl$Close,col="gray",lwd=0.5)
> legend("top",horiz=T,legend=c("Microsoft","Google","Apple"),
+ col=c("red","blue","gray"),lty=1,bty="n")
使用quantmod 包的功能画图
getSymbols("AAPL",src="yahoo")
barChart(AAPL)
蜡烛图
candleChart(AAPL,theme="white")
案例：Su35
………………