ch3-6

# 第一题code
#(1)条形图
data=data.frame(Titanic)
attach(data)
library(vcd)
tab1=structable(Freq~Sex+Survived,data = data)
par(mfrow=c(1,2),mai=c(0.7,0.7,0.7,0.7),cex=0.5)
b1=barplot(tab1,beside=T,xlab = "Survived",ylab="人数",ylim=c(0,1500),col=c('red','blue'), main = "并列条形图",legend=rownames(tab1),args.legend=list(x=8,y=1500,ncol=2,cex=0.8,box.col='grey'))  
library(DescTools)
BarText(tab1,b=b1,beside=T,top=F,cex=1,col='black')

b2=barplot(tab1,xlab = "Survived",ylab="人数",ylim=c(0,1500),col=c('red','blue'), main = "堆叠条形图",legend=rownames(tab1),args.legend=list(x=4,y=1500,ncol=2,cex=0.8,box.col='grey'))  
BarText(tab1,b=b2,cex=1,col='black',top=F)

#(2)帕累托图
par(mai=c(0.5,0.5,0.5,0.5),cex=0.5)
tab2=margin.table(Titanic,"Class")

x=sort(tab2,decreasing = TRUE)
bar=barplot(x,xlab="class",ylab="num",ylim=c(0,1000),col=rainbow(5))
text(bar,x,labels = x,pos=3)
y=cumsum(x)/sum(x)
par(new=T)
plot(y,type="b",pch=15,axes=FALSE,xlab='',ylab = '',main='')
axis(side=4)
mtext("累计频率",side=4,line=3,cex=0.8)
text(labels="累积分布曲线",x=2.4,y=0.95,cex=0.7)

#(3)脊形图
library(graphics)
par(mai=c(0.5,0.5,0.5,0.5),cex=0.5)

data2=Untable(Titanic)

spineplot(factor(data2$Class)~factor(data2$Survived),xlab='survived',ylab = 'class',main='survived与class的脊形图',col=rainbow(4))

#(4)树状图
library('plotrix')
#plot.dendrite(data,xlabels=names(data),cex=0.95,mar=c(1,0,0,0))

library(treemap)
tab3=ftable(data2)
d=as.data.frame(tab3)
df=data.frame(d[,-5],频数=d$Freq)
treemap(df,index=c("Class","Sex","Age","Survived"),vSize='频数',type = 'index',fontsize.labels = 9,position.legend = 'bottom',title = '')


#(5)p值图
library(sjPlot)
sjp.chi2(data2,show.legend =TRUE,legend.title = "P值色标",title='Pearson卡方独立性检验')

#(6)马赛克图
par(mfrow=c(1,2),mai=c(0.3,0.3,0.2,0.1),cex=0.7,cex.main=0.8) 
mosaicplot(~Class+Sex+Age+Survived,data=data2,cex.axis=0.7,col=c("blue","red"),dir=c("h","v","h","v"),main="简单马赛克图")
mosaicplot(~Class+Sex+Age+Survived,data=data2,shade=TRUE,cex.axis=0.8,off=8,dir=c("h","v","h","v"),main="扩展的马赛克图")


#(7)气球图
library(ggpubr)
ggballoonplot(d,x="Class",y="Survived",shape = 21,size = "Freq",fill="Freq",rotate.x.text = FALSE,ggtheme = scale_fill_gradientn(colors = rainbow(6)))
#热图
library(ggiraphExtra)
require(ggplot2)
library(gridExtra)
ggHeatmap(data2,aes(x=Class,y=Survived),polar = TRUE,addlabel = TRUE,palette = "Reds")+ggtitle("极坐标热图")
#南丁格尔玫瑰图
library(ggiraphExtra)
library(gridExtra)
library(ggplot2)
table7<-ftable(data2$Class,data2$Survived)
d7<-as.data.frame(table7)
df7<-data.frame(d[,-2],频数=d7$Freq)
mytheme<-theme(plot.title = element_text(size=9),axis.title=element_text(size=8), axis.text=element_text(size=7),legend.title=element_text(size=7),legend.text=element_text(size=7))
library(ggpubr)
p1<-ggBar(df7,aes(x=Class,y=频数,fill=Survived),stat="identity",reverse=TRUE)+ggtitle("堆叠条形图")+mytheme
p2<-ggRose(df7,aes(x=Class,y=频数,fill=Survived),stat="identity",reverse=TRUE)+ggtitle("玫瑰图")+mytheme
grid.arrange(p1,p2,ncol=2)
#(8)饼图
par(mai=c(0.2,0.4,0.2,0.4),cex=0.7)
tab4=table(data2$Class)

name1<-names(tab4)  
percent1<-round(prop.table(tab4)*100,digit=2)
labs1<-paste(name1," ",percent1,"%",sep="")
pie(tab4,labels = labs1,init.angle = 90,col=c("red1","green1","blue1","yellow1"),main="饼图")
#扇形图
fan.plot(tab4,labels = labs1,max.span=0.9*pi,shrink=0.06,radius=1.2,label.radius=1.4,ticks=200,main="扇形图",col=c("green","yellow","deepskyblue","pink"))

#环形图
library(ggiraphExtra)
library(ggplot2)
library(gridExtra)
ggDonut(data2,aes(donuts=Class),labelposition=1,labelsize=2.5,xmin=2,xmax=4,title="环形图")

#弧形图
library(ggpol)
d2=as.data.frame(tab4)
df2=data.frame(Class=d2$Var1,频数=d2$Freq)
ggplot(df2)+geom_arcbar(aes(x=Class,shares=频数,fill=Class,r0=5,r1=10),sep=0.05,show.legend=TRUE)+coord_fixed()+ggtitle('弧形图')+theme_void()

#(9)饼环图
p<-ggPieDonut(data=data2,aes(pies=Class,donuts=Sex),title="饼环图");p
 

####ch4

# 第一题code

attach(faithful)
hist(faithful$eruptions,freq=F,breaks=20,xlab = 'eruptions',ylab='频数',main='直方图',col='lightgreen')
rug(faithful$eruptions)
lines(density(eruptions))
rug(jitter(eruptions))

# 第2题code
library(caret)
library(dplyr)
eru=scale(eruptions)
wai=scale(waiting)  #标准化
hist(eru,prob=T,breaks=20,xlab = '指标值',ylab='密度',main='叠加直方图',col='brown')
hist(wai,prob=T,breaks=20,density=120,xlab = '',ylab='',main='',col='yellow',add=T)
legend('topright',legend = c('eruption','waiting'),ncol=1,col=c('brown','yellow'),density=c(200,60),fill=c('brown','yellow'),cex=0.8)
# 第3题code
library(reshape2)
library(ggplot2)
d=data.frame(eru,wai)
df=melt(d,variable.name = '指标',value.name = '指标值')
ggplot(df)+aes(x=指标值)+geom_density(aes(group=指标,color=指标,fill=指标),alpha=0.3)+ggtitle('核密度比较图')

# 第4题code
palette=RColorBrewer::brewer.pal(2,'Set2')
boxplot(d,col = palette,xlab='指标',ylab='指标值',main='箱线图')  
points((apply(d,2,mean)),col='black',cex=1,pch=3)

library(vioplot)
names=c('eruption','waiting')
vioplot(d,col=palette,names=names,xlab='指标',ylab='指标值',main='小提琴图')

# 第5题code
library(aplpack)
stem.leaf.backback(d$eru,d$wai)

# 第6题code
library(ggiraphExtra)
ggDot(df,aes(x=指标,y=指标值,fill=指标),stackdir="center",method="dotdensity",boxfill="white",position=0,binwidth=0.05,boxwidth=0.7)+ggtitle('威尔金森点图')
ggDot(df,aes(x=指标,y=指标值,fill=指标),stackdir="up",method="histodot",boxfill="white",position=0.2,binwidth=0.05,boxwidth=0.2)+ggtitle('威尔金森点图')

#带状图
stripchart(eru,method = 'overplot',at=1.2,pch='e',cex=0.6,col='red')
stripchart(wai,method = 'jitter',at=0.9,pch='w',cex=0.6,col='orange',add=T)
legend(x=0.5,y=0.77,legend = c('e=eruption(overplot)','w=waiting(jitter)'),col=c('red','orange'),fill=c('red','orange'),cex=0.8,box.col = 'grey')
# 第7题code
library(aplpack)
plotsummary(faithful[,1:2],types=c("stripes","ecdf","density","boxplot"),y.sizes=4:1,design="chessboard",mycols="RB",main="eruptions和waiting的分布概要图")


#####ch5

# 第一题code
plot(mtcars$mpg,mtcars$wt,pch=19,col='green4',xlab = 'mpg',ylab='wt',xlim=c(0,40),ylim=c(0,6))

#2

library(car)
scatterplotMatrix(mtcars,diagonal=T,ellipse=T,col='steelblue3',gap=0.1,cex=0.1,oma=c(1,1,1,1),cex.labels = 0.7,font.labels=2)

#3

library(corrplot)
mat=as.matrix(mtcars)
r=cor(mat)

corrplot(r,method='number',mar=c(0.2,0,0.5,0),title = '相关系数矩阵')

#4

library(scatterplot3d)
scatterplot3d(x=mtcars$mpg,mtcars$hp,mtcars$wt,col.axis='blue',col.grid='lightblue',pch=10,type='p',highlight.3d=T,cex.lab=0.7,main='3d散点图')

library(graphics)
symbols(mtcars$mpg,mtcars$hp,mtcars$wt,inches = 0.15,fg='black',bg='pink')
mtext('气泡大小=wt',line = -2,cex=0.8,adj=0.1)

#5

library(graphics)
labels=c("4","6","8")
f=factor(mtcars[,2],ordered = TRUE,levels = labels)
df<-data.frame(qgs=f,mtcars[,-2])
attach(df)
coplot(data=df,mpg~wt|qgs,panel = panel.smooth,col='blue',bg=5,pch=21,bar.bg = c(fac='pink'),rows=1,columns = 4)

#6

library(GGally)
library(ggplot2)
ggpairs(df[,c(1,2,4,6)],aes(color=qgs,alpha=0.6))+theme(axis.text=element_text(size=8))

######ch6

#1

library(DescTools)
mat=as.matrix(iris[,1:4])
rownames(mat)=iris[,5]
PlotLinesA(t(mat),xlab = '部位',ylab = '长度',args.legend = NA,col = rainbow(150),pch=21,pch.col = 1,pch.bg = 'white',pch.cex = 1)
legend(x='topright',legend = iris[,5],lty=1,col=rainbow(150),box.col = 'grey80',inset = 0.01,ncol = 4,cex=0.12)

library(ggiraphExtra)
library(ggplot2)
ggRadar(data=iris,rescale=T,aes(group=Species),alpha=0,size=1)+theme(axis.text=element_text(size=7),legend.position='right',legend.text=element_text(size='6'))
#2

matrix1=as.matrix(iris[,1:4]);rownames(matrix1)=iris[,5]
stars(matrix1,full = T,scale = T,len=1.5,draw.segments = T,key.loc = c(20,1.5,5),mar=c(0,0,0,0),cex=0.4)

library(aplpack)
faces(matrix1,face.type=1,ncol.plot=6,scale=T,cex=0.6)

#3

library(factoextra)
library(ggplot2)
d=dist(scale(matrix1),method = 'euclidean')
hc=hclust(d,method = 'ward.D2')
fviz_dend(hc,k=3,cex=0.4,horiz = F,k_colors = rainbow(3),color_labels_by_k = T,lwd=0.8,type='rectangle',rect=T,rect_lty = 1,rect_fill = T,main = '分层聚类树状图')

heatmap(matrix1,scale = 'column',margins = c(4,3),cexRow=0.6,cexCol=0.7)

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值