devbox
码创造者
这个屌丝很懒，什么也没留下！
关注作者
热门标签
热门文章
当前位置:   article > 正文

【无标题】111411141114_ggradar包的雷达图library(ggiraphextra)

作者：码创造者 | 2024-07-05 05:27:12

赞

踩

ggradar包的雷达图library(ggiraphextra)

第一章表

  1. #第一章#############################
  2. ##习题1.5频数表
  3. #（1）Titanic二维变量表加边际和
  4. class(Titanic)
  5. Titanic
  6. library(DescTools)
  7. d1<-Untable(Titanic)#原数据是列联表，用Untable转化成数据框
  8. d1
  9. mt1<-table(d1$Sex,d1$Survived)#二维列联表
  10. addmargins(my1)#边际和
  11. mt1
  12. #（2）4个变量的多为列联表
  13. library(vcd)
  14. mt2<-structable(d1)
  15. mt2
  16. #(3)把2转化为带类别频数的数据框
  17. d13<-as.data.frame(mt2)
  18. d13

 第二章页面布局，简单调颜色

  1. ##第二章2.3，2.4###########################
  2. #2.3 11个图布局
  3. layout(matrix(c(1,2,3,4,5,6,7,8,9,10,11,11),nrow=4,ncol=3,byrow=TRUE),
  4.        widths=c(1,1,1),heights=c(1,1,1,1))
  5. layout.show(11)
  6. #2.4 条形图
  7. score<-c(85,82,78,91,75)
  8. subject<-c("经济","会计","营销","金融","管理")
  9. layout(matrix(c(1,2),nrow=2,ncol=1,byrow=T))#页面布局
  10. par(mai=c(0.4,0.5,0.3,0.1),cex.main=0.9,font.main=1)
  11. barplot(score,names=subject,col=rainbow(8),ylab="分数")#1
  12. barplot(score,names=subject,col=topo.colors(8),ylab="分数")#2
  13. dev.off##清除页面布局
  14. par(mfrow = c(1,1))#清除页面布局2
  15.  
  16. cols<-ifelse(score>90,"red","blue")#3
  17. barplot(score,names=subject,col=cols,ylab="分数")
  18. ##2.4标准答案################################
  19. #(1)
  20. library(RColorBrewer)
  21. x<-c(85,82,78,91,75)
  22. a<-c("经济","会计","营销","金融","管理")
  23.  
  24. par(mfrow=c(1,2),mai=c(1.2,1.2,0.4,0.4),cex=0.7)
  25. barplot(x,names=a,col=rainbow(5),xlab="专业",ylab="平均分数",
  26.         cex.main=0.7,cex.lab=0.7,main="使用rainbow函数")
  27. barplot(x,names=a,col=topo.colors(5),xlab="专业",ylab="平均分数",
  28.         cex.main=0.7,cex.lab=0.7,main="使用topo.colors函数")
  29.  
  30. #(2)条形图
  31. palette1<-brewer.pal(5,"Reds")
  32. palette2<-brewer.pal(5,"Set1")
  33. palette3<-brewer.pal(5,"RdBu")
  34. par(mfrow=c(1,3),mai=c(0.7,0.5,0.4,0.4),cex=0.7)
  35. barplot(x,names=a,col=palette1,xlab="专业",ylab="平均分数",
  36.         cex.main=0.7,cex.lab=0.7,main="红色连续型调色板")
  37. barplot(x,names=a,col=palette2,xlab="专业",ylab="平均分数",
  38.         cex.main=0.7,cex.lab=0.7,main="离散型调色板")
  39. barplot(x,names=a,col=palette3,xlab="专业",ylab="平均分数",
  40.         cex.main=0.7,cex.lab=0.7,main="红蓝色极端值调色板")
  41.  
  42. #(3)条形图颜色
  43. par(mfrow=c(1,1),mai=c(1.2,1.2,0.4,0.4),cex=0.7)
  44. cols<-ifelse(x>90,"red","blue")
  45. barplot(x,names=a,col=cols,xlab="专业",ylab="平均分数",
  46.         cex.main=0.7,cex.lab=0.7,main="分数大于90红色，否则蓝色")

第三章类别数据可视化，很多图，

  1. #第三章#######################
  2. #第三章3.5#######################
  3. ###3.51并列条形图堆叠条形图
  4. data3<-Untable(Titanic)
  5. tab1<-table(data3$Survived,data3$Sex)##二维表
  6. library(vcd)
  7. tab1<-structable(Survived~Sex,data=Titanic)
  8. addmargins(tab1)##二维表
  9. library(DescTools)
  10. par(mfrow=c(2,2),mai=c(0.2,0.5,0.3,0.2),cex.main=0.8,cex.axis=0.8,cex.lab=0.8)
  11. ##垂直并列
  12. b1<-barplot(tab1,beside=TRUE,xlab = "生还情况",ylab="人数",main="(a)垂直并列",
  13.             col=c("#7CCBFF","#FF5F07"),
  14.             ylim=c(0,1800),
  15.             legend=rownames(tab1),
  16.             args.legend=list(x=4,y=1900,
  17.                              ncol=2,cex=0.5,box.col="grey80"))
  18. BarText(tab1,b=b1,beside=TRUE,cex=0.5,top=TRUE)
  19. #b水平并列
  20. tab1<-structable(Survived~Sex,data=Titanic)
  21. addmargins(tab1)
  22. b2<-barplot(tab1,beside=TRUE,horiz=TRUE,xlab = "生还情况",ylab="人数",main="(b)水平并列",
  23.             col=c("#7CCBFF","#FF5F07"),
  24.             legend=rownames(tab1),
  25.             args.legend=list(x=165,y=10.5,
  26.                              ncol=2,cex=0.5,box.col="grey80"))
  27. BarText(tab1,b=b2,beside=TRUE,horiz=TRUE,cex=0.5,top=FALSE)
  28.  
  29. #c水平堆叠
  30. b3<-barplot(tab1,horiz=TRUE,xlab = "生还情况",ylab="人数",main="(c)水平堆叠",
  31.             col=c("#7CCBFF","#FF5F07"),
  32.             legend=rownames(tab1),
  33.             args.legend=list(x=750,y=4.5,
  34.                              ncol=2,cex=0.5,box.col="grey80"))
  35. BarText(tab1,b=b3,horize=TRUE,col="black",cex=0.5)
  36. #d垂直堆叠
  37. b4<-barplot(tab1,xlab = "生还情况",ylab="人数",main="(d)垂直堆叠",
  38.             col=c("#7CCBFF","#FF5F07"),
  39.             legend=rownames(tab1),
  40.             args.legend=list(x=3.6,y=950,
  41.                              ncol=2,cex=0.5,box.col="grey80"))
  42. BarText(tab1,b=b4,cex=0.5)
  43. #```{r 第2题}
  44. #第二题code绘制Class的帕累托图
  45. #帕累托图
  46. par(mfrow = c(1,1))
  47. library(sjPlot)
  48. x<-sort(table(data3$Class),decreasing=TRUE)##生成一维表并降序排列
  49. bar<-barplot(x,xlab="class",ylab="num",col=RColorBrewer::brewer.pal(3,"Reds"),
  50.              ylim=c(0,1000))
  51. text(bar,x,labels=x,pos=3,col="black")
  52. y<-cumsum(x)/sum(x)
  53. par(new=T)
  54. plot(y,type="b",pch=15,axes=FALSE,xlab='',ylab='',main='')
  55. axis(side=4)
  56. mtext("累积频率",side=4,line=3,cex=0.8)
  57. text(labels="累积分布曲线",x=2.4,y=0.95,cex=1)
  58. #```{r 第3题}
  59. #第三题code绘制Class和Survived的脊形图
  60. #脊形图
  61. spineplot(factor(Class)~factor(Survived),data=data3,
  62.           col=c("#FB8072","blue"),
  63.           xlab="幸存",ylab="船舱等级", main="(a)船舱等级与幸存")
  64. #```{r 第4题}
  65. #第四题code绘制Class、Sex、Age和Survived4个变量条形树状图和矩形树状图
  66. #大小树状图
  67. library(plotrix)
  68. cols<-list(c("#9EC545","#47cb4a","#95eb00","#7ba237"),c("#F5E866","#F8D695"),
  69.            c("#EFB06A","#E2460E"),c("#EE3768","#fe8bd9"))
  70. sizetree(data3,col=cols,showval=TRUE,showcount=TRUE,stacklabels=TRUE,
  71.          border="black",base.cex=0.7)
  72. #矩形树状图
  73. library(treemap)
  74. tab<-ftable(data3)#多维数据框
  75. d11<-as.data.frame(tab)#变成有频数的数据框
  76. df<-data.frame(d11[,-5],频数=d11$Freq)#改名字
  77. treemap::treemap(df,index=c("Class","Sex","Age","Survived"),
  78.                  vSize="频数",vColor="频数",
  79.                  type="value",fontsize.labels=8,title="")
  80. #```{r 第5题}
  81. #第五题code绘制Class、Sex、Age和Survived4个变量独立性检验的P值图
  82. ##独立性检验p值图用数据框带频数的
  83. library(sjPlot)
  84. sjp.chi2(d11,show.legend=T,legend.title="p值色标",title="pearson检验")
  85. ##相关图用二维表
  86. par(mfrow=c(2,2),mai=c(0.7,0.7,0.3,0.1),cex=0.7,cex.main=1,font.main=1)
  87. #survived~class
  88. assocplot(table(data3$Survived,data3$Class),col=c("black","red"),main="(a) 幸存和船舱等级")
  89. box(col="grey50")
  90. #```{r 第6题}
  91. #第六题code绘制Class、Sex、Age和Survived4个变量的马赛克图，并在图中显示观测频
  92. ##马赛克图用多维表
  93. par(mfrow = c(1,1))
  94. library(vcd)
  95. p<-mosaic(tab,shade=TRUE,labeling=labeling_values,
  96.           return_grob=TRUE,main="(a) 观测频数马赛克")
  97.  
  98. #```{r 第7题}
  99. #第七题code绘制Class和Survived2个变量的气球图、热图和南丁格尔玫瑰图
  100. ##气球图
  101. library(ggpubr)
  102. df<-as.data.frame(tab)
  103. my_cols<-c("#B9F5D4","#55C4C3","#2B6C6D","#378B6B","#9DFDC7","#86c036")
  104. ggballoonplot(df,x="Class",y="Survived",shape=21,
  105.               size="Freq",fill="Freq",rotate.x.text=FALSE,
  106.               ggtheme=scale_fill_gradientn(colors=my_cols))
  107. ##热图
  108. library(ggiraphExtra);require(ggplot2);library(gridExtra)
  109. p72<-ggHeatmap(data3,aes(x=Class,y=Survived),
  110.                addlabel=TRUE,palette="Reds")+ggtitle("(a1)矩形热图")
  111. p72
  112. #南丁格尔玫瑰图
  113. library(ggiraphExtra);library(ggplot2);library(gridExtra)
  114.  
  115. df<-data.frame(d11[,-5],频数=d11$Freq)
  116. mytheme<-theme(plot.title=element_text(size="9"),
  117.                axis.title=element_text(size="8"),
  118.                axis.text=element_text(size="7"),
  119.                legend.title=element_text(size="7"),
  120.                legend.text=element_text(size="7"))
  121.  
  122. p73<-ggRose(df,aes(x=Class,y=频数,fill=Survived),stat="identity",reverse=TRUE)+
  123.   ggtitle("(a2)玫瑰图")+mytheme
  124. p73
  125.  
  126. #```{r 第8题}
  127. #第八题code绘制Class的饼图、扇形图、环形图和弧形图
  128. ##饼图
  129. library(ggiraphExtra);require(ggplot2);library(gridExtra)
  130. p81<-ggPie(data=data3,aes(pies=Class),title="(a)船舱等级")
  131. p81
  132. #扇形图
  133. library(plotrix)
  134. tab82<-table(data3$Class)
  135. name<-names(tab82)
  136.  
  137. percent<-prop.table(tab82)*100
  138. labs<-paste(name," ",round(percent,2),"%",sep="")
  139. fan.plot(tab82,labels=labs,max.span=0.91*pi,
  140.          shrink=0.06,radius=1.2,
  141.          label.radius=1.4,ticks=200,
  142.          col=c("#268AFF","#FF5126","#F5E866","#A08FD5"))
  143. #环形图
  144. library(ggiraphExtra);require(ggplot2);library(gridExtra)
  145. p83<-ggDonut(data3,aes(donuts=Class),labelposition=1,
  146.              labelsize=2.5,
  147.              xmin=2,xmax=4,title="(a)环形图")
  148. p83
  149. #弧形图
  150. library(ggpol);library(ggplot2);library(gridExtra)
  151. tab84<-ftable(data3$Class)
  152. d84<-as.data.frame(tab84)
  153. df84<-data.frame(船舱等级=d84$Var1,频数=d84$Freq)
  154. p84<-ggplot(df84)+geom_arcbar(aes(x=船舱等级,shares=频数,fill=船舱等级,r0=5,r1=10),
  155.                               sep=0.05,show.legend=TRUE)+coord_fixed()+
  156.   ggtitle("(a)弧形图")+theme_void()
  157. p84
  158.  
  159. #```{r 第9题}
  160. #第九题code绘制Class和Sex2个变量的饼环图
  161. #饼环图
  162. library(ggiraphExtra);require(ggplot2);library(gridExtra)
  163. p91<-ggPieDonut(data=data3,aes(pies=Class,donuts=Sex),
  164.                 title="(a)饼环图")
  165. p91

第四章

  1. ##########第四章###############################
  2. # 第一题code
  3. #直方图
  4. library(graphics)
  5. library(lattice);library(sjPlot);library(epade)
  6. hist(faithful$eruptions,prob=TRUE,breaks=20,col="#5EB63A",
  7.      xlab="喷发持续时间",ylab="时间",main="(a)")
  8. rug(jitter(faithful$eruptions))#加线条
  9. curve(dnorm(x,mean(faithful$eruptions),sd(faithful$eruptions)),col="#DC2B14",add=TRUE)
  10. #第二题code
  11. ###叠加直方图先标准化了
  12. #df4<-scale(faithful[,1:2])
  13. #df44<-data.frame(df4)
  14. sc_eruptions<-scale(faithful$eruptions, center = TRUE, scale = TRUE)
  15. sc_waiting<-scale(faithful$waiting, center = TRUE, scale = TRUE)
  16. hist(sc_eruptions,prob=TRUE,breaks=25,
  17.      xlab="指标值",ylab="密度",col="#9EC545",main="")
  18. hist(sc_waiting,prob=TRUE,breaks=25,
  19.      xlab="",ylab="",col="#A08FD5",density=40,main="",add=TRUE)
  20. legend("topright",legend=c("持续时间","等待时间"),
  21.        col=c("#9EC545","#A08FD5"),density=c(200,60),
  22.        fill=c("#9EC545","#A08FD5"),cex=0.5)
  23. # 第三题code
  24. ##核密度比较图
  25. library(ggplot2)
  26. library(reshape2)
  27. mydata <- data.frame(sc_eruptions,sc_waiting)#标准化数据组成数据框
  28. df<-melt(mydata,variable.name="指标",value.name="指标值")#融合变量变成长数据
  29. mytheme<-theme(plot.title = element_text(size="9"),
  30.                axis.title=element_text(size="9"),
  31.                axis.text = element_text(size="8"),
  32.                legend.position = "right",
  33.                legend.text = element_text(size="7"))
  34.  
  35. p1<-ggplot(df)+aes(x=指标值)+
  36.   geom_density(aes(group=指标,color=指标,fill=指标),alpha=0)+mytheme+
  37.   ggtitle("a")
  38. p1
  39. # 第四题code
  40. ##箱线图
  41. boxplot(mydata,col=c("#9EC545","#EEB0AC"),main="a")
  42. ##小提琴图
  43. library(vioplot)
  44. vioplot(mydata,col=c("#9EC545","#EEB0AC"),name=c("持续时间","等待时间"))
  45. # 第五题code
  46. ##茎叶图
  47. library(aplpack)
  48. stem.leaf.backback(mydata$sc_eruptions,mydata$sc_waiting)
  49. # 第六题code
  50. ##点图
  51. library(reshape2);library(ggiraphExtra);require(ggplot2)
  52. p61<-ggDot(df,aes(x=指标,y=指标值,fill=指标),
  53.            stackdir="center",method="dotdensity",boxfill="white",
  54.            position=0,binwidth=0.05,boxwidth=0.5)+
  55.   ggtitle("a")
  56. p61
  57. ##带状图
  58. stripchart(mydata$sc_eruptions,method="overplot",at=1.2,
  59.            pch="A",cex=0.6,col="#FF5126")
  60. stripchart(mydata$sc_waiting,method="jitter",at=0.95,
  61.            pch="P",cex=0.6,col="#26A7FF",add=T)
  62. # 第七题code
  63. ##分布概要图
  64. library(aplpack)
  65. plotsummary(mydata,types=c("stripes","ecdf","density","boxplot"),
  66.             y.size=4:1,design="chessboard",
  67.             mycols="RB",main="")

第五章

  1. #########第五章#############################
  2. ##1散点图
  3. plot(mtcars$mpg,mtcars$wt,pch=19,col="green4",xlab="英里数",ylab="汽车自重")
  4. abline(lm(mtcars$mpg~mtcars$wt),lwd=2,col="red")
  5. #有置信区间
  6. da5<-data.frame(mtcars)
  7. head(da5)
  8. library(investr)
  9. fit<-lm(mpg~wt,data=da5)
  10. plotFit(fit,interval="confidence",level=0.95,
  11.         shade=T,col.conf="lightskyblue2",col.fit="red",
  12.         main="A")
  13. ##散点图矩阵
  14. library(car)
  15. scatterplotMatrix(da5[,1:11],
  16.                   diagonal = TRUE,
  17.                   ellipse=TRUE,
  18.                   col="#162C9a",gap=0.5,cex=0.5,
  19.                   oma=c(3,3,3,3))
  20. ##相关系数矩阵
  21. mtcars[1:5,11]
  22. library(sjPlot)
  23. sjp.corr(da5,corr.method="pearson",
  24.          show.values=TRUE,
  25.          show.legend=TRUE,
  26.          p.numeric=TRUE)
  27.  
  28. ####3D散点
  29. library(scatterplot3d)
  30. s3d<-scatterplot3d(x=da5$mpg,y=da5$hp,z=da5$wt,
  31.                    col.axis="blue",col.grid="lightblue",pch=16,highlight.3d=TRUE,
  32.                    type="h",box=TRUE,
  33.                    xlab="英里数",ylab="总马力",zlab="汽车自重",
  34.                    cex.lab=0.7,main="3D散点图")
  35. fit<-lm(da5$mpg~da5$hp+da5$wt)#没画出来
  36. s3d$plane3d(fit,col="grey30")
  37. ##气泡
  38. library(DescTools)
  39. PlotBubble(x=da5$hp,y=da5$wt,area=da5$hp,
  40.            panel.first=grid(),
  41.            cex=0.006,col=SetAlpha("green3",0.2),
  42.            xlab="总马力",ylab="汽车自重")
  43. mtext("气泡大小=行驶英里数",line=-2,cex=0.8,adj=0.1)
  44. BubbleLegend("bottomright",area=c(5,3,1),frame=TRUE,
  45.              cols=SetAlpha("blue2",0.3),bg="grey95",
  46.              labels=c(15,10,5),cex=0.8,cols.lbl=c("red","yellow","green"))
  47. ##条件散点图
  48. fcyl<-factor(da5$cyl)#转换因子
  49. da55<-data.frame(fcyl,da5)
  50. head(da55)
  51. coplot(data=da55,hp~wt|fcyl,
  52.        panel=panel.smooth,
  53.        col="blue",bg=5,pch=21,
  54.        bar.bg=c(fac="pink"),
  55.        rows=1,columns=3)
  56. class(da55$fcyl)
  57. ##广义配对图要因子
  58. library(GGally);library(ggplot2)
  59. ggpairs(da55[,c(1,2,5,7)],
  60.         aes(color= fcyl,alpha=0.6))+
  61.   theme(axis.text=element_text(size=8))

第六章

  1. #######第六章#############################
  2. ##按照species分组的轮廓图，species本来就是因子
  3. library(ggiraphExtra);require(ggplot2)
  4. ggPair(iris,aes(color=Species))+
  5.   theme(axis.text=element_text(size=7),
  6.         legend.position=c(0.6,0.87),
  7.         legend.direction="horizontal",
  8.         legend.text=element_text(size="7"))
  9. ##雷达图
  10. library(ggiraphExtra)
  11. library(ggplot2)
  12. 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'))
  13. ##星图
  14. matrix1=as.matrix(iris[,1:4]);rownames(matrix1)=iris[,5]
  15. 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)
  16. ##脸谱图
  17. library(aplpack)
  18. faces(matrix1,face.type=1,ncol.plot=6,scale=T,cex=1)
  19. ##聚类图
  20. library(factoextra)
  21. library(ggplot2)
  22. d=dist(scale(matrix1),method = 'euclidean')
  23. hc=hclust(d,method = 'ward.D2')
  24. 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 = '分层聚类树状图')
  25. ##热图
  26. heatmap(matrix1,scale = 'column',margins = c(4,3),cexRow=0.6,cexCol=0.7)

第七章

  1. #######第七章￥######################
  2. ##折线图
  3. library(ggplot2)
  4. da7<-read.csv("D:/bjyx/Desktop/dashuju/数据可视化分析—基于R语言 例题数据和习题数据/（02）习题数据/exercise/chap07/exercise7_4.csv")
  5. head(da7)
  6. Vhead(CO2)iew(da7)
  7. class(da7$日期)
  8. da77<-as.Date(da7$日期)
  9. d7<-data.frame(日期=da77,指标值=da7[,2])
  10. head(d7)
  11. class(d7$日期)
  12. mytheme<-theme(legend.position="none",
  13.                axis.title=element_text(size=10),
  14.                axis.text=element_text(size=8))
  15. ggplot(d7,aes(x=日期,y=指标值))+geom_line()+theme_bw()+mytheme
  16. #观测值图，成分分解图
  17. plot(retail.ts,type="o",col="red2",
  18.      xlab="时间",ylab="co2排放",main="a")
  19. retail.m<-decompose(co2,type="multiplicative")
  20. par(mar=c(0.5,0.7,0.1,0.1),cex.lab=0.8,cex.main=1,font.main=1)
  21. plot(retail.m,type="o",col="red4")
  22. #winter预测
  23. retail.fit<-ets(co2,model="MAA")
  24. retail.f<-forecast(retail.fit,h=24)
  25. par(mfrow=c(1,2),mai=c(0.5,0.5,0.2,0.1),lab=c(10,5,1),font.main=1)
  26. plot(retail.f,type="o",xlab="时间",ylab="零售额",cex=0.8)
  27. dev.off
  28. par(mfrow = c(1,1))

声明：本文内容由网友自发贡献，不代表【wpsshop博客】立场，版权归原作者所有，本站不承担相应法律责任。如您发现有侵权的内容，请联系我们。转载请注明出处：https://www.wpsshop.cn/w/码创造者/article/detail/789321
推荐阅读
相关标签

Copyright © 2003-2013 www.wpsshop.cn 版权所有，并保留所有权利。

  

闽ICP备14008679号