ggolt2数据分析与图形艺术 学习记录

library(ggplot2)
dsmall<-diamonds[sample(nrow(diamonds),100),]


qplot(carat,price,data=dsmall,shape=cut,colour=color)
ggplot(dsmall,aes(x=carat,y=price,shape=cut,colour=color))+geom_point()
# 点图中shape控制点形状,shape后跟分类属性,可使得不同属性下点形状不同
# Error: A continuous variable can not be mapped to shape
# 将shape从变量cut改成固定值21以后,会报错:连续的数值不能映射成形状
# 但是将shape从aes里面拿出来,放在外层,则执行成功,点被赋成了统一的圆形
# shape在外层的时候,赋值cut,结果是失效的。
ggplot(dsmall,aes(x=carat,y=price,shape=21,colour=color))+geom_point() 
ggplot(dsmall,aes(x=carat,y=price,colour=color),shape=21)+geom_point() 
ggplot(dsmall,aes(x=carat,y=price,colour=color),shape=cut)+geom_point() 


# 点图中colour属性控制点颜色,colour后面跟分类属性,则不同属性下点颜色不同
# alpha属性控制透明度,后面跟<1分数,I(1/10)表示10个相同位置的点可以使某个位置变成全不透明
qplot(carat,price,data=diamonds,alpha=I(1/10))
qplot(carat,price,data=diamonds,alpha=I(1/100))
ggplot(diamonds,aes(x=carat,y=price,colour=color))+geom_point(alpha=I(1/10))


# use geom,default is "point",also "smooth","boxplot","path","line","histogram","freqpoly","density","bar"
# geom 属性后面跟字符串(或字符串向量),geom=c("point","smooth") 用同一份数据表示画2个图,点图和光滑曲线
qplot(carat,price,data=diamonds,geom=c("point","smooth")) 
# when excute this sentence,sys return `geom_smooth()` using method = 'loess'
# this not error,only declares "smooth" line produced by method "loess"


qplot(carat,price,data=dsmall,geom=c("point","smooth"),span=1) 
# attribute span be used to control smooth degree
# loess ~O(n^2) ,offen use "gam"
qplot(carat,price,data=dsmall,geom=c("point","smooth"),method="gam",formula=y~s(x))
# when the amount of data is quite big,use:
qplot(carat,price,data=dsmall,geom=c("point","smooth"),method="gam",formula=y~s(x),bs="cs")
# also can use spline curve, y~ns(x,5) the number 5 ,bigger then curve more sharpe
library(splines)
qplot(carat,price,data=dsmall,geom=c("point","smooth"),method="lm",formula=y~ns(x,5))
# method="rlm" alike "lm".but it's more stable,not sensitive to abnormal value and need library(MASS)




# 箱线图
qplot(color,price/carat,data=diamonds,geom="boxplot")
# jitter图:和箱线图表达的意思差不多
qplot(color,price/carat,data=diamonds,geom="jitter",alpha=I(1/5))


ggplot(diamonds,aes(x=color,y=price/carat))+geom_jitter(alpha=I(1/5))
ggplot(diamonds,aes(x=color,y=price/carat))+geom_boxplot()




# 柱状图,计数用,连续型变量自动分箱
qplot(carat,data=diamonds,geom="histogram",fill=color)
# 连续型单变量用概率密度图表示分布:
qplot(carat,data=diamonds,geom="density",color=color)


ggplot(diamonds,aes(x=carat,fill=color))+geom_histogram()
ggplot(diamonds,aes(x=carat,color=color))+geom_density()




# 离散型变量计数,weight means weighting(加权)
qplot(color,data=diamonds,geom="bar")
qplot(color,data=diamonds,geom="bar",weight=carat)+scale_y_continuous("carat")


# 连续型变量histogram和bar效果类似,离散型单变量只能用bar
ggplot(diamonds,aes(x=color))+geom_bar()
ggplot(diamonds,aes(x=color,weight=carat))+geom_bar()


# 画线图
qplot(date,unemploy/pop,data=economics,geom="line")
qplot(date,unemploy,data=economics,geom="line")


ggplot(economics,aes(x=date,y=unemploy/pop))+geom_line()


# 点图和线图的结合
qplot(unemploy/pop,uempmed,data=economics,geom=c("point","path"))
ggplot(economics,aes(x=unemploy/pop,y=uempmed))+
  geom_point()+
  geom_path()




year <- function(x) as.POSIXlt(x)$year+1900 
# 为什么先取出年份后2位数字再加上1900,直接取year不行么
# scale_x_date(date_breaks = "1 month",date_labels = "%m")
# 坐标轴是时间倒是可以通过设置date_labels控制显示日期的部分
qplot(unemploy/pop,uempmed,data=economics,geom="path",colour=year(date))


# 控制x轴显示的值域xlim后面加个向量表示范围,同样有ylim
qplot(carat,data=diamonds,facets=color~.,geom="histogram",binwidth=0.1,xlim=c(0,3))


ggplot(diamonds,aes(x=carat))+
  facet_grid(color~.)+ #交换color和.的位置,改变输出分面的行列
  geom_histogram(binwidth=0.1)+
  xlim(0,3)


ggplot(diamonds,aes(x=carat))+
  facet_grid(.~color)+
  geom_histogram(binwidth=0.1)+
  xlim(0,3)


# "facets" makes group pictures in a canvas
qplot(carat,data=diamonds,facets=color~.,geom="histogram",binwidth=0.1,xlim=c(0,3))
# ..density.. is new grammar,tell R to present density not counts on canvas:
qplot(carat,..density..,data=diamonds,facets=color~.,geom="histogram",binwidth=0.1,xlim=c(0,3))


# other parameters: 
# log,tell which axis use log,example: log="x" == log(varx),log="xy" == x-axis y-axis both log
# main="plot title"
qplot(carat,price,data=dsmall,xlab="Price($)",ylab="Weight(carats)",main="Price-weight relationship",log="xy")
# plot 函数和qplot函数之间的区别:qplot不是泛型函数:当不同类型的R对象传入qplot时,它并不会匹配默认的函数调用。
# 需要注意的是,ggplot()是一个泛型函数,以它为起点,你可以对任意类型的R进行可视化操作。
# 一般而言,你可以将一个变量传递给你感兴趣的图形属性,这样该变量将进行标度转换并显示在图例上。
# 如果想让点颜色变成红色 可以用I()函数:colour=I("red")
# ggplot2中的图形属性名称(如colour,shape,size)比基础绘图系统中的名称(如col,pch,cex)更直观,更容易记忆
# 在基础绘图系统中,你可以通过points(),lines()和text()函数来向已有的图形添加更多的元素。
# 在ggplot2中,不需要在当前的图形中加入额外的图层




# 图层:不同的图层是可以使用不同数据集(这里先按下不表)
qplot(displ,hwy,data=mpg,facets=.~year)+geom_smooth()
# 平滑曲线层与散点层的不同点在于它没有展示原数据,而是展示了统计变换后的数据。
# 一个图形可能含有很多图层,比如上面例子中将平滑曲线层添加到一个散点图层上。


# 其他好用的数据结构语句:print(),ggsave(),summary(),save()
p <- qplot(displ,hwy,data=mpg,colour=factor(cyl))
summary(p) # 查看画图的一些基本信息
save(p,file="plot.rdata") #保存图形
load("plot.rdata") #读入图形对象
ggsave("plot.png",width=5,height=5) #将图片保存成png格式


# qplot只能用一个数据集和一组图形属性映射,解决这个问题的办法是使用图层
# 每个图层可以有自己的数据集和图形属性映射,附加的数据元素可以通过图层添加到图形中
p <- ggplot(diamonds,aes(carat,price,colour=cut))
# 这个图形对象在加上图层之前无法显示,因此什么都看不见
# 给图形对象添加一个点几何对象
p <- p + layer(geom="point") # 执行是失败的,可以换成 p+geom_point()
# 使用+ 来添加图层的,该图层使用了默认的数据集和图形属性映射
# 并且使用了另外2个可选参数的默认值:统计变换和位置调整。
# layer 更多的参数:layer(geom,geom_params,stat,stat_params,data,mapping,position)
p <- ggplot(diamonds,aes(x=carat))
p <- p + layer(geom="bar",geom_params=list(fill="steelblue"),stat="bin",stat_params=list(binwidth=2))
p
# 上面的代码块 繁琐且执行错误,简化后如下:
p <- ggplot(diamonds,aes(x=carat))
p <- p + geom_histogram(binwidth=2,fill="steelblue")
p


# geom_histogram 称为快捷函数,类似的快捷函数还有 geom_XXX 或者 stat_XXX
# geom_XXX(mapping,data,...,stat,position)
# stat_XXX(mapping,data,...,geom,position)
# mapping(可选):一组图形属性映射,通过aes()函数来设定
# data(可选):一个数据集,它会修改默认的数据集。大部分情况下该参数被省略掉,默认数据集将被调用
#  ...:geom或stat的参数,例如直方图的组距(binwidth)或者loess光滑曲线的带宽


# geom或stat(可选):可以修改geom默认的stat值,或stat默认的geom值。他们是一组字符串,包含了要将使用的几何对象或者统计变换的名称。
# position(可选):选择一种调整对象重合的方式
ggplot(msleep,aes(sleep_rem/sleep_total,awake))+geom_point()
# 等价于
qplot(sleep_rem/sleep_total,awake,data=msleep)


# qplot 也可以添加图层
qplot(sleep_rem/sleep_total,awake,data=msleep)+ geom_smooth()
# 等价于
qplot(sleep_rem/sleep_total,awake,data=msleep,geom=c("point","smooth"))
## 或
ggplot(msleep,aes(sleep_rem/sleep_total,awake))+geom_point()+geom_smooth()


# 下面的例子时 不同的图形配上相同的图层,因为图层也可以当做变量存储,这种方式简化了代码
library(scales)
bestfit <- geom_smooth(method ="lm",se=F,colour =alpha("steelblue",0.5),size=2)
qplot(sleep_rem,sleep_total,data=msleep)+bestfit
qplot(awake,brainwt,data=msleep,log="y")+bestfit
qplot(bodywt,brainwt,data=msleep,log="xy")+bestfit


# 数据 ggplot2 对于数据集的要求是必须是个数据框 dataframe
# 这限制方便我们使用相同代码、不同数据集画图,只需要改变数据集就可以
# 下面例子是使用 %+% 来添加新的数据集以代替原来的数据集
# 注意到ggplot是需要aes ,qplot不需要aes可以把各个属性写在一级括号里
p <- ggplot(mtcars,aes(mpg,wt,colour=cyl))+geom_point()
p
mtcars <- transform(mtcars,mpg2=mpg^2) # 修改现有数据集字段
p %+% mtcars


# 图形属性映射 
# aes() 函数用来将数据变量映射到图形中,从而使变量成为被感知的图形属性
# aes()函数里面有图形参数
# aes(x=weight,y=height,colour=age)
# 可以使用函数 : aes(x=weight,y=height,colour=sqrt(age))


p<-ggplot(mtcars,aes(x=mpg,y=wt))
p+geom_point()
p+geom_point(aes(colour=factor(cyl)))
p+geom_point(aes(y=disp))
# 可以用+对图层进行添加修改删除,原理是后来的属性覆盖前面对应属性的值: eg
# 操作 层图形 结果
# 添加 aes(colour=cyl) aes(mpg,wt,colour=cyl)
# 修改 aes(colour=disp) aes(mpg,disp)
# 删除 aes(y=NULL) aes(mpg)


# 颜色可以指定为常量或变量
p <- ggplot(mtcars,aes(mpg,wt))
p + geom_point(colour="darkblue") 


library(ggplot2)
library(nlme) # 添加测试用的数据集所在
# 一个分组的例子
boysbox <- ggplot(Oxboys,aes(Occasion,height)) +geom_boxplot()
boysbox + geom_line(aes(group=Subject),colour="#3366FF")


# 匹配图形属性和图形对象:“群组几何对象的另一个重要议题是,如何将个体的图形属性映射给整体的图形属性”
# 对于个体几何对象而言这不是个问题,因为每一条观测都被一个单一的图形元素所表示。
# 然而,高密度数据将会使得区别单个的点变得困难(或者不可能),这也意味着如果单个点几何对象,就变成了一大团点
# 统计变换 简称为stat ,就是根据数据进行统计变换,通常以某种方式对数据进行信息汇总
# 看直方图 stat_bin 统计变换会生成如下变量:
# count 每个组里观测值的数目
# density 每个组里观测值的密度(占整体的百分数/组宽)
# x 组的中心位置
# 这些生成变量(generated variable ) 可以被直接调用。


ggplot(diamonds,aes(carat))+geom_histogram(aes(y=..density..),binwidth=0.1)
# 等价的gplot语句:
qplot(carat,..density..,data=diamonds,geom="histogram",binwidth=0.1)


# 位置调整,即对该层中的元素位置进行微调。一般离散型数据需要位置调整,因为容易出现完全重叠的问题
# 名称 描述
# dodge 避免重叠,并排放置
# fill 堆叠图形元素并将高度标准化为1
# identity 不做任何调整
# jitter 给点添加扰动避免重合 (选择后图像明显)
# stack 将图形元素堆叠起来
# position="dodge"
d <- ggplot(diamonds,aes(carat))+xlim(0,3)
d+stat_bin(aes(ymax=..count..),binwidth=0.1,geom="area")
d+stat_bin(aes(size=..density..),binwidth=0.1,geom="point",position="identity")
d+stat_bin(aes(y=1,fill=..count..),binwidth=0.1,geom="tile",position="identity")




# 如果已经汇总过的数据,想直接使用它,而不进行其他的统计变换,可以使用stat_identity()
# 然后将合适的变量映射到相应的图形属性中
require(nlme,quiet=TRUE,warn.conflicts=FALSE)
model<- lme(height~age,data=Oxboys,random=~1+age|Subject)
oplot <- ggplot(Oxboys,aes(age,height,group=Subject))+geom_line()
age_grid<-seq(-1,1,length=10)
subjects<-unique(Oxboys$Subject)


preds <-expand.grid(age=age_grid,Subject=subjects)
preds$height <-predict(model,preds)
oplot+geom_line(data=preds,colour="#3366FF",size=0.4)
# 示例中注意,ggplot和geom_line的data赋的是不同的值




# 下面给出用图层控制数据展示图形的例子
df<-data.frame(
  x=c(3,1,5),
  y=c(2,4,6),
  label=c("a","b","c")
)


p<-ggplot(df,aes(x,y))+xlab(NULL)+ylab(NULL)
p+geom_point()+labs(title="geom_point")
p+geom_bar(stat="identity")+labs(title="geom_bar(stat=\"identity\")") # ”显示需要转义\
p+geom_line()+labs(title="geom_line")
p+geom_area()+labs(title="geom_area")
p+geom_path()+labs(title="geom_path")
p+geom_text(aes(label=label))+labs(title="geom_text")
p+geom_tile()+labs(title="geom_tile")
p+geom_polygon()+labs(title="geom_polygon")


# 展示数据分布:
depth_dist<-ggplot(diamonds,aes(depth))+xlim(58,68)
depth_dist+geom_histogram(aes(y=..density..),binwidth = 0.1)+facet_grid(cut~.) #分片柱状图
depth_dist+geom_histogram(aes(fill=cut),binwidth = 0.1,position="fill") # 热力图?
depth_dist+geom_freqpoly(aes(y=..density..,colour=cut),binwidth=0.1) #分色密度曲线


# 再来些图的例子:
qplot(cut,depth,data=diamonds,geom="boxplot")
qplot(carat,depth,data=diamonds,geom="boxplot",group=round_any(carat,0.1,floor),xlim=c(0,3))


qplot(class,cty,data=mpg,geom = "jitter")
qplot(class,drv,data=mpg,geom = "jitter")


# 按照cut填充颜色的时候,也默认了按照cut分组
qplot(depth,data=diamonds,geom="density",xlim=c(54,70))
qplot(depth,data=diamonds,geom="density",xlim=c(54,70),fill=cut,alpha=I(0.2))


# 二维分布的例子:
df<-data.frame(x=rnorm(2000),y=rnorm(2000))
norm<-ggplot(df,aes(x,y))
norm+geom_point()
norm+geom_point(shape=1)
norm+geom_point(shape=".")


norm+geom_point(colour="black",alpha=1/3)
norm+geom_point(colour="black",alpha=1/5)
norm+geom_point(colour="black",alpha=1/10)


td<-ggplot(diamonds,aes(table,depth))+xlim(50,70)+ylim(50,70)
td+geom_point()
td+geom_jitter()
jit<-position_jitter(width = 0.5)
td+geom_jitter(position = jit)
td+geom_jitter(position = jit,colour="black",alpha=1/10)
td+geom_jitter(position = jit,colour="black",alpha=1/50)
td+geom_jitter(position = jit,colour="black",alpha=1/200)


# 展示二维分布的密度,theme(legend.position = "none") 表示图例中的标签说明不显示
d<-ggplot(diamonds,aes(carat,price))+xlim(1,3)+theme(legend.position = "none")
d+stat_bin2d()
d+stat_bin2d(bins=10) # 调整格子大小
d+stat_bin2d(binwidth = c(0.02,200))
library(hexbin)
d+stat_binhex()  # 六边形的密度展示
d+stat_binhex(bins=10) # 调整六边形格子的粗粒
d+stat_binhex(binwidth = c(0.02,200))


# 二维密度分布图
d <- ggplot(diamonds,aes(carat,price))+xlim(1,3)+theme(legend.position = "none")
d + geom_point()+geom_density2d()
d + stat_density2d(geom="point",aes(size=..density..),contour = F)+scale_size_area()
d + stat_density2d(geom="tile",aes(fill=..density..),contour = F)
last_plot()+scale_fill_gradient(limits=c(1e-5,8e-4))


# 画地图
library(maps)
data("us.cities")
big_cities<-subset(us.cities,pop>500000)
qplot(long,lat,data=big_cities)+borders("state",size=0.5)
tx_cities<-subset(us.cities,country.etc=="TX")
ggplot(tx_cities,aes(long,lat))+borders("county","texas",colour="grey70")+geom_point(colour="black",alpha=0.5)


library(maps)
states<-map_data("state")
arrests<-USArrests
names(arrests)<-tolower(names(arrests))
arrests$region<-tolower(rownames(USArrests))
choro<-merge(states,arrests,by="region")
choro<-choro[order(choro$order),]
qplot(long,lat,data=choro,group=group,fill=assault,geom="polygon")
qplot(long,lat,data=choro,group=group,fill=assault/murder,geom="polygon")


# 注意第五行是要连着一起写的
library(plyr)
ia<-map_data("county","iowa")
mid_range<-function(x) mean(range(x,na.rm=TRUE))
centres<-ddply(ia,.(subregion),colwise(mid_range,.(lat,long)))
ggplot(ia,aes(long,lat))+geom_polygon(aes(group=group),fill=NA,colour="grey60")+geom_text(aes(label=subregion),data=centres,size=2,angle=45)



d<-subset(diamonds,carat<2.5 & rbinom(nrow(diamonds),1,0.2)==1)
d$lcarat<-log10(d$carat)
d$lprice<-log10(d$price)


detrend<-lm(lprice~lcarat,data=d)
d$lprice2<-resid(detrend)
mod<-lm(lprice2~lcarat*color,data=d)


library(effects)
effectdf<-function(...){
  suppressWarnings(as.data.frame(effect(...)))
}


color<-effectdf("color",mod)
both1<-effectdf("lcarat:color",mod)
carat<-effectdf("lcarat",mod,default.levels=50)
both2<-effectdf("lcarat:color",mod,default.levels=3)


qplot(lcarat,lprice,data=d,colour=color)
qplot(lcarat,lprice2,data=d,colour=color)


fplot <- ggplot(mapping=aes(y=fit,ymin=lower,ymax=upper))+ylim(range(both2$lower,both2$upper))
fplot %+% color+aes(x=color)+geom_point()+geom_errorbar()
fplot %+% both2+aes(x=color,colour=lcarat,group=interaction(color,lcarat))+geom_errorbar()+geom_line(aes(group=lcarat))+scale_colour_gradient()
fplot %+% carat+aes(x=lcarat)+geom_smooth(stat="identity")


ends<-subset(both1,lcarat==max(lcarat))
fplot %+% both1+aes(x=lcarat,colour=color)+geom_smooth(stat="identity")+scale_colour_hue()+theme(legend.position = "none")+geom_text(aes(label=color,x=lcarat+0.02),ends)


# 下面的执行失败??书中没找到m2的出处
midm<-function(x) mean(x,trim=0.5)
m2 +
  stat_summary(aes(colour="trimmed"),fun.y=midm,geom="point")+
  stat_summary(aes(colour="raw"),fun.y=mean,geom="point")+
  scale_color_hue("Mean")




iqr<-function(x,...){
  qs<-quantile(as.numeric(x),c(0.25,0.75),na.rm=T)
  names(qs)<-c("ymin","ymax")
  qs
}  
m+stat_summary(fun.data="iqr",geom="ribbon")


# 给时序图添加垂直线
(unemp<-qplot(date,unemploy,data=economics,geom="line",xlab="",ylab="No.unemployed(1000s)"))
presidential<-presidential[-(1:3),]
yrng<-range(economics$unemploy)
xrng<-range(economics$date)
unemp+geom_vline(aes(xintercept=as.numeric(start)),data=presidential)  
# 也是用了不同的数据集。下面还给不同区域添加颜色 fill=party
library(scales)
unemp+geom_rect(aes(NULL,NULL,xmin=start,xmax=end,fill=party),ymin=yrng[1],ymax=yrng[2],data=presidential,alpha=0.2)+scale_fill_manual(values=c("blue","red"))
last_plot()+geom_text(aes(x=start,y=yrng[1],label=name),data=presidential,size=3,hjust=0,vjust=0)
caption<-paste(strwrap("Unemployment rates in the US have varied a lot over the years",40),collapse = "\n")
unemp+geom_text(aes(x,y,label=caption),data=data.frame(x=xrng[2],y=yrng[2]),hjust=1,vjuest=1,size=4)
# 标记最大值
highest<-subset(economics,unemploy==max(unemploy))
unemp+geom_point(data=highest,size=3,colour="red",alpha=0.5)


# 含权数据
qplot(percwhite,percbelowpoverty,data=midwest)
qplot(percwhite,percbelowpoverty,data=midwest,size=poptotal/1e6)+scale_size_area("Population\n(millions)",breaks=c(0.5,1,2,4))
qplot(percwhite,percbelowpoverty,data=midwest,size=area)+scale_size_area()
# 通过修改weight 图形属性可以表现权重
lm_smooth<-geom_smooth(method=lm,size=1)
qplot(percwhite,percbelowpoverty,data=midwest)+lm_smooth
qplot(percwhite,percbelowpoverty,data=midwest,weight=popdensity,size=popdensity)+lm_smooth
# 再来一个权重的例子:
qplot(percbelowpoverty,data=midwest,binwidth=1)
qplot(percbelowpoverty,data=midwest,weight=poptotal,binwidth=1)+ylab("population")


plot<-qplot(cty,hwy,data=mpg)
plot+aes(x=drv) # 如果这句报错,就是因为变量类型和默认的数值不匹配
plot+aes(x=drv)+scale_x_discrete() # 指定离散就好了




# 标度的学习:
plot<-qplot(cty,hwy,data=mpg)
plot+aes(x=drv) # 如果这句报错,就是因为变量类型和默认的数值不匹配
plot+aes(x=drv)+scale_x_discrete() # 指定离散就好了


# 显示添加默认标度
p<-qplot(sleep_total,sleep_cycle,data=msleep,colour=vore)
p+scale_color_hue() # 显示添加默认标度
# 下面这句将上面那句里面的标度显示文字修改了:原本是herbi,carni,omni,NA,变成了plants,meat,both,don't know
# breaks控制着显示在坐标轴或者图例上的值,即,坐标轴上应该显示那些刻度线
# labels 指定了应在断点处显示的标签,若设置了labels ,则必须同时指定breaks
p+scale_color_hue("What does\nit eat?",breaks=c("herbi","carni","omni",NA),labels=c("plants","meat","both","don't know")) 
p+scale_colour_brewer(palette = "Set1") # 使用一种不同的标度


# 坐标轴怎么写
p<-qplot(cty,hwy,data=mpg,colour=displ)
p
p+scale_x_continuous("City mpg")
p+xlab("City mpg")
p+ylab("Highway mpg")
p+labs(x="city mpg",y="Highway",colour="Displacement")
p+xlab(expression(frac(miles,gallon))) # 显示一个分数表达式


p <- qplot(cyl,wt,data=mtcars)
p
p + scale_x_continuous(breaks=c(5.5,6.5)) #breaks 指定了必须显示的刻度
p+scale_x_continuous(limits=c(5.5,6.5)) #指定范围


p<-qplot(wt,cyl,data=mtcars,colour=cyl)
p+scale_colour_gradient(breaks=c(5.5,6.5))
p+scale_colour_gradient(limits=c(5.5,6.5))


# xlim(10,20):一个从10到20的连续型变量
# ylim(20,10): 一个从20到10的反转后连续型标度
# xlim("a","b","c") :一个离散型标度
# xlim(as.Date(c("2008-05-01","2008-08-01"))): 一个从2008年5月1日到8月1日的日期型标度
# 在ggplot2中,任何在limits意外的数据不会被绘制,也不会被包括在统计变换过程中
# 要使用coord_cartesian()函数的参数xlim和ylim 实现局部放大


# 连续型位置标度是 scale_x_continuous和scale_y_continuous 他们均将数据映射到x轴和y轴
# 每个连续型标度均可以接受一个trans参数,允许指定若干种线性或非线性变换
# scale_x_log10() 与 scale_x_continuous(trans="log10") 等价,参数trans对任意的连续型标度均有效,
# 包括下文中描述的颜色梯度


# 下面2个例子是将x,y 都log10 但是图片显示的刻度不同
qplot(log10(carat),log10(price),data=diamonds)
qplot(carat,price,data=diamonds)+scale_x_continuous()+scale_y_continuous()


# 日期和时间属于连续型,但是标注坐标轴仅支持date类型的日期和属于POSIXct类的时间值
library(scales)
plot<-qplot(date,psavert,data=economics,geom="line")+ylab("Presonal savings rate")+geom_line(xintercept=0,colour="grey50")
plot
plot+scale_x_date(breaks=date_breaks("10 years")) 
plot+scale_x_date(limits=as.Date(c("2004-01-01","2005-01-01")),labels=date_format("%Y-%m-%d"))


# 离散型位置标度顺序可以通过参数breaks 进行控制,不想要的水平可以使用limits(或者使用xlim()或者ylim()) 进行丢弃




# hue色相 是0~360之间的一个角度值
# luminance明度,颜色的明暗程度
# chroma 色彩的纯度
# 根据颜色梯度中的色彩数量进行划分,公有三类连续型颜色梯度:
# scale_colour_gradient() scale_fill_gradient():双色梯度。顺序从低到高 参数low high控制梯度2断的颜色
# scale_colour_gradient2()和 scale_fill_gradient2(): 三色梯度。顺序为低中高,参数low,high作用同上。中间点默认值为0,也可以使用midpoint色织
# scale_colour_gradientn() 和 scale_fill_gradientn() 自定义n色梯度,需要赋给参数colours一个颜色向量


# 画梯度图的例子:
f2d <- with(faithful,MASS::kde2d(eruptions,waiting,h=c(1,10),n=50))
df <- with(f2d,cbind(expand.grid(x,y),as.vector(z)))
names(df) <- c("eruptions","waiting","density") 
erupt <- ggplot(df,aes(waiting,eruptions,fill=density))+geom_tile()+scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0))
erupt + scale_fill_gradient(limits=c(0,0.04))
erupt + scale_fill_gradient(limits=c(0,0.04),low="white",high="black")
erupt + scale_fill_gradient2(limits=c(-0.04,0.04),midpoint=mean(df$density))
# 自己定义调色板 需要导入library(vcd)
library(vcd) # library(grid)
fill_gradn <- function(pal){
  scale_fill_gradientn(colours=pal(7),limits=c(0,0.04))
}


library(colorspace) # rainbow_hcl,diverge_hcl,heat_hcl 就是出自这个包
erupt +fill_gradn(rainbow_hcl)
erupt +fill_gradn(diverge_hcl)
erupt +fill_gradn(heat_hcl)


# 离散型的调色板
point <- qplot(brainwt,bodywt,data=msleep,log="xy",color=vore)
area <- qplot(log10(brainwt),data=msleep,fill=vore,binwidth=1)
point + scale_color_brewer(palette = "Set1")
point + scale_color_brewer(palette = "Set2")
point + scale_color_brewer(palette = "Pastel1")


# 手动离散型标度
plot <- qplot(brainwt,bodywt,data=msleep,log="xy")
plot + aes(colour=vore)+scale_colour_manual(values=c("red","orange","yellow","green","blue"))
colours <- c(carni="red","NA"="orange",insecti="yellow",herbi="green",omni="blue")
plot+aes(colour=vore)+scale_colour_manual(values=colours)
plot+aes(shapre=vore)+scale_shape_manual(values=c(1,2,6,0,23))


# 画时间序列的例子
huron <- data.frame(year=1875:1972,level = LakeHuron)
ggplot(huron,aes(year))+geom_line(aes(y=level-5),colour="blue")+geom_line(aes(y=level+5),colour="red")
ggplot(huron,aes(year))+geom_line(aes(y=level-5,colour="below"))+geom_line(aes(y=level+5,colour="above"))


ggplot(huron,aes(year))+geom_line(aes(y=level-5,colour="below"))+geom_line(aes(y=level+5,colour="above"))+scale_colour_manual("Direction",values=c("below"="blue","above"="red"))


# 分面
mpg2 <- subset(mpg,cyl!=5&drv %in% c("4","f"))
qplot(cty,hwy,data=mpg2)+facet_null() # 不分面


qplot(cty,hwy,data=mpg2)+facet_grid(.~cyl) #图显示一行多列
qplot(cty,hwy,data=mpg2)+facet_grid(cyl~.) #图显示一列多行
qplot(cty,data=mpg2,geom="histogram",binwidth=2)+facet_grid(cyl~.) #图显示一列多行
qplot(cty,hwy,data=mpg2)+facet_grid(drv~cyl) #图显示有行有列


# 边际图
p <- qplot(displ,hwy,data=mpg2)+geom_smooth(method="lm",se=F)
p+facet_grid(cyl~drv)
p+facet_grid(cyl~drv,margins=T) # 相当于在上面语句显示的图上,增加边际图(类似概率密度和边界密度)


qplot(displ,hwy,data=mpg2)+geom_smooth(aes(colour=drv),method="lm",se=F)+facet_grid(cyl~drv,margins=T)


library(plyr)
movies$decade<-round_any(movies$year,10,floor)
qplot(rating,..density..,data=subset(movies,decade>1890),geom="histogram",binwidth=0.5)+facet_wrap(~decade,ncol=6)
# facet_wrap 默认将图形面板尽可能摆成方形,可以通过设置ncol,nrow来更新默认设置
# 但是这个例子不能执行,movies数据不知出处


# 标度控制:
# scale="fixed":x和y的标度在所有面板中相同
# scale="free":x和y的标度在每个面板都可以变化
# scale="free_x":x的标度可以变,y的尺度固定
# scale="free_y":y的标度可变,x的尺度固定
p<-qplot(cty,hwy,data=mpg)
p+facet_wrap(~cyl)
p+facet_wrap(~cyl,scales="free")


em<-melt(economics,id="date") # library(reshape2)
qplot(date,value,data=em,geom="line",group=variable)+facet_grid(variable~.,scale="free_y")


mpg3<-within(mpg2,{model<-reorder(model,cty) 
manufacturer <-reorder(manufacturer,-cty)})
models<-qplot(cty,model,data=mpg3)
models
models+facet_grid(manufacturer~.,scales="free",space="free")+theme(strip.text.y=element_text())


# 分组和分面
xmaj<-c(0.3,0.5,1.3,5)
xmin<-as.vector(outer(1:10,10^c(-1,0)))
ymaj<-c(500,1000,5000,10000)
ymin<-as.vector(outer(1:10,10^c(2,3,4)))+
  dplot<-ggplot(subset(diamonds,color %in% c("D","E","G","J")),aes(carat,price,colour=color))+scale_x_log10(breaks=xmaj,labels=xmaj,minor=xmin)+scale_y_log10(breaks=ymaj,labels=ymaj,minor=ymin)+scale_colour_hue(limits=levels(diamonds$color))+theme(legend.position="none")
dplot+geom_point()
dplot+geom_point()+facet_grid(.~color)
dplot+geom_smooth(method=lm,se=F,fullrange=T)
dplot+geom_smooth(method=lm,se=F,fullrange=T)+facet_grid(.~color)


# 并列玉分面
qplot(color,data=diamonds,geom="bar",fill=cut,position="dodge")
qplot(cut,data=diamonds,geom="bar",fill=cut)+facet_grid(.~color)+theme(axis.text.x=element_text(angle=90,hjust=1,size=8,colour="grey50"))


mpg4<-subset(mpg,manufacturer %in% c("audi","volkswagen","jeep"))
mpg4$manufacturer<-as.character(mpg4$manufacturer)
mpg4$model<-as.character(mpg4$model)


base <-ggplot(mpg4,aes(fill=model))+geom_bar(position="dodge")+theme(legend.position="none")
base + aes(x=model)+facet_grid(.~manufacturer)
last_plot()+facet_grid(.~manufacturer,scales="free_x",space="free")
base + aes(x=manufacturer)



mpg2$disp_ww<-cut_interval(mpg2$displ,length=1)
mpg2$disp_wn<-cut_interval(mpg2$displ,n=6)
mpg2$disp_nn<-cut_number(mpg2$displ,n=6)


plot<-qplot(cty,hwy,data=mpg2)+labs(x=NULL,y=NULL)
plot+facet_wrap(~disp_ww,nrow=1)
plot+facet_wrap(~disp_wn,nrow=1)
plot+facet_wrap(~disp_nn,nrow=1)


# 坐标系 coord_cartesian()
# ggplot2中可用坐标系 coord_equal,coord_flip,coord_trans 本质都是笛卡尔坐标系,coord_map,coord_polar
(p<-qplot(disp,wt,data=mtcars)+geom_smooth())
p+scale_x_continuous(limits=c(325,500))
p+coord_cartesian(xlim=c(325,500))


(d<-ggplot(diamonds,aes(carat,price))+stat_bin2d(bins=25,colour="grey70")+theme(legend.position="none"))
d+scale_x_continuous(limits=c(0,2))
d+coord_cartesian(xlim=c(0,2))


# 坐标轴翻转 coord_flip 调换x和y
qplot(displ,cty,data=mpg)+geom_smooth()
qplot(cty,displ,data=mpg)+geom_smooth()
qplot(cty,displ,data=mpg)+geom_smooth()+coord_flip()


# 变换
qplot(carat,price,data=diamonds,log="xy")+geom_smooth(method="lm")
last_plot()+coord_trans(x=exp_trans(10),y=exp_trans(10))


# 堆叠图
(pie <-ggplot(mtcars,aes(x=factor(1),fill=factor(cyl)))+geom_bar(width=1))
# 饼图
pie+coord_polar(theta="y")
# 牛眼图
pie+coord_polar()


# 主题: 全局性设置 theme_set(theme_gray()) 或者 theme_set(theme_bw())
# theme_set() 返回先前的主题,可存储以备后用
hgram<-qplot(rating,data=movies,binwidth=1)
hgram


previous_theme<-theme_set(theme_bw())
theme_set(previous_theme) # 永久性存储初始主题


hgram<-qplot(displ,data=mpg,binwidth=1)
hgram


previous_theme<-theme_set(theme_bw())
theme_set(previous_theme) #


hgramt <- hgram + labs(title="This is a histogram")
hgramt
hgramt + theme(plot.title = element_text(size=20))
hgramt
hgramt + theme(plot.title = element_text(size=20))
hgramt + theme(plot.title = element_text(size=20,colour = "red"))
hgramt + theme(plot.title = element_text(size=20,hjust=0))
hgramt + theme(plot.title = element_text(size=20,face="bold"))
hgramt + theme(plot.title = element_text(size=20,angle = 180))


hgramt + theme(panel.grid.major = element_line(colour="red"))
hgramt + theme(panel.grid.major = element_line(size=2))
hgramt + theme(panel.grid.major = element_line(linetype = "dotted"))
hgramt + theme(axis.line = element_line())
hgramt + theme(axis.line = element_line(colour = "red"))
hgramt + theme(axis.line = element_line(size=0.5,linetype = "dashed"))


hgramt + theme(plot.background = element_rect(fill="grey80",colour = NA))
hgramt + theme(plot.background = element_rect(size=2))
hgramt + theme(plot.background = element_rect(colour="red"))
hgramt + theme(panel.background = element_rect())
hgramt + theme(panel.background = element_rect(colour = NA))
hgramt + theme(panel.background = element_rect(linetype = "dotted"))


# element_blank() 表示空主题
last_plot()+theme(panel.grid.minor = element_blank())
last_plot()+theme(panel.grid.major = element_blank())
last_plot()+theme(panel.background = element_blank())
last_plot()+theme(axis.title = element_blank(),axis.title.y = element_blank())
last_plot()+theme(axis.line = element_line())


# 使用theme_get() 可得到当前主题的设置。theme()可在一幅图中对某些元素进行局部性地修改
# theme_update() 可为后面图形的绘制进行全局性地修改


old_theme <- theme_update(plot.background=element_rect(fill="#3366FF"),
                          panel.background=element_rect(fill="#003DF5"),
                          axis.text.x = element_text(colour = "#CCFF33"),
                          axis.text.y = element_text(colour = "#CCFF33",hjust=1),
                          axis.title.x = element_text(colour = "#CCFF33",face = "bold"),
                          axis.title.y = element_text(colour = "#CCFF33",face = "bold",angle=90))


qplot(cut,data=diamonds,geom="bar")
qplot(cty,hwy,data=mpg)
theme_set(old_theme) # 执行完这句后,再重复执行上面2句画图语句,观察图片变化


# 自定义标度:重新定义或者ggplot2中已经定义的可选方法覆盖控制相应图形属性的标度函数
# 该函数的命名方法通常是 scale_aesthetics_continuous 或者 scale_aesthetics_discrete 可将aesthetics替换成 color,fill,size等
p <- qplot(mpg,wt,data=mtcars,colour=factor(cyl))
p
scale_colour_discrete <- scale_colour_brewer 
p


# 几何对象和统计变换
update_geom_defaults("point",aes(colour="darkblue"))
qplot(mpg,wt,data=mtcars)
update_stat_defaults("bin",aes(y=..density..))
qplot(displ,data=mpg,geom="histogram",binwidth=1) 


# 如果想将2幅图存在一个文件中,需要打开设备打印图形,然后关闭设备
qplot(mpg,wt,data=mtcars)
ggsave(file="output.pdf")  # 直接将刚才画的图存成1pdf




pdf(file="output.pdf",width=6,height=6) #首先打开一个文件,不一定存在
qplot(mpg,wt,data=mtcars)
qplot(wt,mpg,data=mtcars)
dev.off() # 将刚才plot的2个存成2页pdf在一个文件里 


# 一页多图
(a<-qplot(date,unemploy,data=economics,geom="line"))
(b<-qplot(uempmed,unemploy,data=economics)+geom_smooth(se=F))
(c<-qplot(uempmed,unemploy,data=economics,geom="path"))


vp1<-viewport(width=1,height =1,x=0.5,y=0.5)
vp1<-viewport()
vp2<-viewport(width=0.5,height=0.5,x=0.5,y=0.5)
vp2<-viewport(width=0.5,height=0.5)
vp3<-viewport(width=unit(2,"cm"),height=unit(3,"cm"))
vp4<-viewport(x=1,y=1,just=c("top","right"))
vp5<-viewport(x=0,y=0,just=c("bottom","right"))


pdf("output1.5.pdf",width = 4,height = 4)
subvp<-viewport(width=0.4,height = 0.4,x=0.75,y=0.35)
b
print(c,vp=subvp)
dev.off()


csmall<-c+theme_gray(9)+labs(x=NULL,y=NULL)+theme(plot.margin = unit(rep(0,4),"lines"))
pdf("output2.pdf",width = 4,height = 4)
b
print(csmall,vp=subvp)
dev.off()


# 需要一个个设置视图窗口:这是把a,b,c画在一页上了
pdf("output4.pdf",width=8,height=6)
grid.newpage()
pushViewport(viewport(layout=grid.layout(2,2)))
vplayout<-function(x,y)
  viewport(layout.pos.row=x,layout.pos.col=y)
print(a,vp=vplayout(1,1:2))
print(b,vp=vplayout(2,1))
print(c,vp=vplayout(2,2))
dev.off()




# 改变离散点的顺序
df <- data.frame(
  x=c("label","a long label","an even long label"),
  y=1:3
)


ggplot(df,aes(x,y))+
  geom_point()+
  scale_x_discrete(limits=c("label","a long label","an even long label"),
                   breaks=c("label","a long label","an even long label"),
                   labels=c("label","a long label","an even long label"))

  


脸谱图

library(aplpack)

bball<-read.csv("http://datasets.flowingdata.com/ppg2008.csv",header=TRUE)

faces(bball[,2:16],labels=bball$Name)



评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值