【无标题】111411141114

最新推荐文章于 2024-07-13 20:30:24 发布

Eureka998

最新推荐文章于 2024-07-13 20:30:24 发布

阅读量187

点赞数 1

文章标签：数学建模

本文链接：https://blog.csdn.net/weixin_68838306/article/details/131260097

版权

第一章表

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

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

##第二章2.3，2.4###########################
#2.3 11个图布局
layout(matrix(c(1,2,3,4,5,6,7,8,9,10,11,11),nrow=4,ncol=3,byrow=TRUE),
       widths=c(1,1,1),heights=c(1,1,1,1))
layout.show(11)
#2.4 条形图
score<-c(85,82,78,91,75)
subject<-c("经济","会计","营销","金融","管理")
layout(matrix(c(1,2),nrow=2,ncol=1,byrow=T))#页面布局
par(mai=c(0.4,0.5,0.3,0.1),cex.main=0.9,font.main=1)
barplot(score,names=subject,col=rainbow(8),ylab="分数")#1
barplot(score,names=subject,col=topo.colors(8),ylab="分数")#2
dev.off##清除页面布局
par(mfrow = c(1,1))#清除页面布局2

cols<-ifelse(score>90,"red","blue")#3
barplot(score,names=subject,col=cols,ylab="分数")
##2.4标准答案################################
#(1)
library(RColorBrewer)
x<-c(85,82,78,91,75)
a<-c("经济","会计","营销","金融","管理")

par(mfrow=c(1,2),mai=c(1.2,1.2,0.4,0.4),cex=0.7)
barplot(x,names=a,col=rainbow(5),xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="使用rainbow函数")
barplot(x,names=a,col=topo.colors(5),xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="使用topo.colors函数")

#(2)条形图
palette1<-brewer.pal(5,"Reds")
palette2<-brewer.pal(5,"Set1")
palette3<-brewer.pal(5,"RdBu")
par(mfrow=c(1,3),mai=c(0.7,0.5,0.4,0.4),cex=0.7)
barplot(x,names=a,col=palette1,xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="红色连续型调色板")
barplot(x,names=a,col=palette2,xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="离散型调色板")
barplot(x,names=a,col=palette3,xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="红蓝色极端值调色板")

#(3)条形图颜色
par(mfrow=c(1,1),mai=c(1.2,1.2,0.4,0.4),cex=0.7)
cols<-ifelse(x>90,"red","blue")
barplot(x,names=a,col=cols,xlab="专业",ylab="平均分数",
        cex.main=0.7,cex.lab=0.7,main="分数大于90红色，否则蓝色")

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

#第三章#######################
#第三章3.5#######################
###3.51并列条形图堆叠条形图
data3<-Untable(Titanic)
tab1<-table(data3$Survived,data3$Sex)##二维表
library(vcd)
tab1<-structable(Survived~Sex,data=Titanic)
addmargins(tab1)##二维表
library(DescTools)
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)
##垂直并列
b1<-barplot(tab1,beside=TRUE,xlab = "生还情况",ylab="人数",main="(a)垂直并列",
            col=c("#7CCBFF","#FF5F07"),
            ylim=c(0,1800),
            legend=rownames(tab1),
            args.legend=list(x=4,y=1900,
                             ncol=2,cex=0.5,box.col="grey80"))
BarText(tab1,b=b1,beside=TRUE,cex=0.5,top=TRUE)
#b水平并列
tab1<-structable(Survived~Sex,data=Titanic)
addmargins(tab1)
b2<-barplot(tab1,beside=TRUE,horiz=TRUE,xlab = "生还情况",ylab="人数",main="(b)水平并列",
            col=c("#7CCBFF","#FF5F07"),
            legend=rownames(tab1),
            args.legend=list(x=165,y=10.5,
                             ncol=2,cex=0.5,box.col="grey80"))
BarText(tab1,b=b2,beside=TRUE,horiz=TRUE,cex=0.5,top=FALSE)

#c水平堆叠
b3<-barplot(tab1,horiz=TRUE,xlab = "生还情况",ylab="人数",main="(c)水平堆叠",
            col=c("#7CCBFF","#FF5F07"),
            legend=rownames(tab1),
            args.legend=list(x=750,y=4.5,
                             ncol=2,cex=0.5,box.col="grey80"))
BarText(tab1,b=b3,horize=TRUE,col="black",cex=0.5)
#d垂直堆叠
b4<-barplot(tab1,xlab = "生还情况",ylab="人数",main="(d)垂直堆叠",
            col=c("#7CCBFF","#FF5F07"),
            legend=rownames(tab1),
            args.legend=list(x=3.6,y=950,
                             ncol=2,cex=0.5,box.col="grey80"))
BarText(tab1,b=b4,cex=0.5)
#```{r 第2题}
#第二题code绘制Class的帕累托图
#帕累托图
par(mfrow = c(1,1))
library(sjPlot)
x<-sort(table(data3$Class),decreasing=TRUE)##生成一维表并降序排列
bar<-barplot(x,xlab="class",ylab="num",col=RColorBrewer::brewer.pal(3,"Reds"),
             ylim=c(0,1000))
text(bar,x,labels=x,pos=3,col="black")
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=1)
#```{r 第3题}
#第三题code绘制Class和Survived的脊形图
#脊形图
spineplot(factor(Class)~factor(Survived),data=data3,
          col=c("#FB8072","blue"),
          xlab="幸存",ylab="船舱等级", main="(a)船舱等级与幸存")
#```{r 第4题}
#第四题code绘制Class、Sex、Age和Survived4个变量条形树状图和矩形树状图
#大小树状图
library(plotrix)
cols<-list(c("#9EC545","#47cb4a","#95eb00","#7ba237"),c("#F5E866","#F8D695"),
           c("#EFB06A","#E2460E"),c("#EE3768","#fe8bd9"))
sizetree(data3,col=cols,showval=TRUE,showcount=TRUE,stacklabels=TRUE,
         border="black",base.cex=0.7)
#矩形树状图
library(treemap)
tab<-ftable(data3)#多维数据框
d11<-as.data.frame(tab)#变成有频数的数据框
df<-data.frame(d11[,-5],频数=d11$Freq)#改名字
treemap::treemap(df,index=c("Class","Sex","Age","Survived"),
                 vSize="频数",vColor="频数",
                 type="value",fontsize.labels=8,title="")
#```{r 第5题}
#第五题code绘制Class、Sex、Age和Survived4个变量独立性检验的P值图
##独立性检验p值图用数据框带频数的
library(sjPlot)
sjp.chi2(d11,show.legend=T,legend.title="p值色标",title="pearson检验")
##相关图用二维表
par(mfrow=c(2,2),mai=c(0.7,0.7,0.3,0.1),cex=0.7,cex.main=1,font.main=1)
#survived~class
assocplot(table(data3$Survived,data3$Class),col=c("black","red"),main="(a) 幸存和船舱等级")
box(col="grey50")
#```{r 第6题}
#第六题code绘制Class、Sex、Age和Survived4个变量的马赛克图，并在图中显示观测频
##马赛克图用多维表
par(mfrow = c(1,1))
library(vcd)
p<-mosaic(tab,shade=TRUE,labeling=labeling_values,
          return_grob=TRUE,main="(a) 观测频数马赛克")

#```{r 第7题}
#第七题code绘制Class和Survived2个变量的气球图、热图和南丁格尔玫瑰图
##气球图
library(ggpubr)
df<-as.data.frame(tab)
my_cols<-c("#B9F5D4","#55C4C3","#2B6C6D","#378B6B","#9DFDC7","#86c036")
ggballoonplot(df,x="Class",y="Survived",shape=21,
              size="Freq",fill="Freq",rotate.x.text=FALSE,
              ggtheme=scale_fill_gradientn(colors=my_cols))
##热图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
p72<-ggHeatmap(data3,aes(x=Class,y=Survived),
               addlabel=TRUE,palette="Reds")+ggtitle("(a1)矩形热图")
p72
#南丁格尔玫瑰图
library(ggiraphExtra);library(ggplot2);library(gridExtra)

df<-data.frame(d11[,-5],频数=d11$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"))

p73<-ggRose(df,aes(x=Class,y=频数,fill=Survived),stat="identity",reverse=TRUE)+
  ggtitle("(a2)玫瑰图")+mytheme
p73

#```{r 第8题}
#第八题code绘制Class的饼图、扇形图、环形图和弧形图
##饼图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
p81<-ggPie(data=data3,aes(pies=Class),title="(a)船舱等级")
p81
#扇形图
library(plotrix)
tab82<-table(data3$Class)
name<-names(tab82)

percent<-prop.table(tab82)*100
labs<-paste(name," ",round(percent,2),"%",sep="")
fan.plot(tab82,labels=labs,max.span=0.91*pi,
         shrink=0.06,radius=1.2,
         label.radius=1.4,ticks=200,
         col=c("#268AFF","#FF5126","#F5E866","#A08FD5"))
#环形图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
p83<-ggDonut(data3,aes(donuts=Class),labelposition=1,
             labelsize=2.5,
             xmin=2,xmax=4,title="(a)环形图")
p83
#弧形图
library(ggpol);library(ggplot2);library(gridExtra)
tab84<-ftable(data3$Class)
d84<-as.data.frame(tab84)
df84<-data.frame(船舱等级=d84$Var1,频数=d84$Freq)
p84<-ggplot(df84)+geom_arcbar(aes(x=船舱等级,shares=频数,fill=船舱等级,r0=5,r1=10),
                              sep=0.05,show.legend=TRUE)+coord_fixed()+
  ggtitle("(a)弧形图")+theme_void()
p84

#```{r 第9题}
#第九题code绘制Class和Sex2个变量的饼环图
#饼环图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
p91<-ggPieDonut(data=data3,aes(pies=Class,donuts=Sex),
                title="(a)饼环图")
p91

第四章

##########第四章###############################
# 第一题code
#直方图
library(graphics)
library(lattice);library(sjPlot);library(epade)
hist(faithful$eruptions,prob=TRUE,breaks=20,col="#5EB63A",
     xlab="喷发持续时间",ylab="时间",main="(a)")
rug(jitter(faithful$eruptions))#加线条
curve(dnorm(x,mean(faithful$eruptions),sd(faithful$eruptions)),col="#DC2B14",add=TRUE)
#第二题code
###叠加直方图先标准化了
#df4<-scale(faithful[,1:2])
#df44<-data.frame(df4)
sc_eruptions<-scale(faithful$eruptions, center = TRUE, scale = TRUE)
sc_waiting<-scale(faithful$waiting, center = TRUE, scale = TRUE)
hist(sc_eruptions,prob=TRUE,breaks=25,
     xlab="指标值",ylab="密度",col="#9EC545",main="")
hist(sc_waiting,prob=TRUE,breaks=25,
     xlab="",ylab="",col="#A08FD5",density=40,main="",add=TRUE)
legend("topright",legend=c("持续时间","等待时间"),
       col=c("#9EC545","#A08FD5"),density=c(200,60),
       fill=c("#9EC545","#A08FD5"),cex=0.5)
# 第三题code
##核密度比较图
library(ggplot2)
library(reshape2)
mydata <- data.frame(sc_eruptions,sc_waiting)#标准化数据组成数据框
df<-melt(mydata,variable.name="指标",value.name="指标值")#融合变量变成长数据
mytheme<-theme(plot.title = element_text(size="9"),
               axis.title=element_text(size="9"),
               axis.text = element_text(size="8"),
               legend.position = "right",
               legend.text = element_text(size="7"))

p1<-ggplot(df)+aes(x=指标值)+
  geom_density(aes(group=指标,color=指标,fill=指标),alpha=0)+mytheme+
  ggtitle("a")
p1
# 第四题code
##箱线图
boxplot(mydata,col=c("#9EC545","#EEB0AC"),main="a")
##小提琴图
library(vioplot)
vioplot(mydata,col=c("#9EC545","#EEB0AC"),name=c("持续时间","等待时间"))
# 第五题code
##茎叶图
library(aplpack)
stem.leaf.backback(mydata$sc_eruptions,mydata$sc_waiting)
# 第六题code
##点图
library(reshape2);library(ggiraphExtra);require(ggplot2)
p61<-ggDot(df,aes(x=指标,y=指标值,fill=指标),
           stackdir="center",method="dotdensity",boxfill="white",
           position=0,binwidth=0.05,boxwidth=0.5)+
  ggtitle("a")
p61
##带状图
stripchart(mydata$sc_eruptions,method="overplot",at=1.2,
           pch="A",cex=0.6,col="#FF5126")
stripchart(mydata$sc_waiting,method="jitter",at=0.95,
           pch="P",cex=0.6,col="#26A7FF",add=T)
# 第七题code
##分布概要图
library(aplpack)
plotsummary(mydata,types=c("stripes","ecdf","density","boxplot"),
            y.size=4:1,design="chessboard",
            mycols="RB",main="")

第五章

#########第五章#############################
##1散点图
plot(mtcars$mpg,mtcars$wt,pch=19,col="green4",xlab="英里数",ylab="汽车自重")
abline(lm(mtcars$mpg~mtcars$wt),lwd=2,col="red")
#有置信区间
da5<-data.frame(mtcars)
head(da5)
library(investr)
fit<-lm(mpg~wt,data=da5)
plotFit(fit,interval="confidence",level=0.95,
        shade=T,col.conf="lightskyblue2",col.fit="red",
        main="A")
##散点图矩阵
library(car)
scatterplotMatrix(da5[,1:11],
                  diagonal = TRUE,
                  ellipse=TRUE,
                  col="#162C9a",gap=0.5,cex=0.5,
                  oma=c(3,3,3,3))
##相关系数矩阵
mtcars[1:5,11]
library(sjPlot)
sjp.corr(da5,corr.method="pearson",
         show.values=TRUE,
         show.legend=TRUE,
         p.numeric=TRUE)

####3D散点
library(scatterplot3d)
s3d<-scatterplot3d(x=da5$mpg,y=da5$hp,z=da5$wt,
                   col.axis="blue",col.grid="lightblue",pch=16,highlight.3d=TRUE,
                   type="h",box=TRUE,
                   xlab="英里数",ylab="总马力",zlab="汽车自重",
                   cex.lab=0.7,main="3D散点图")
fit<-lm(da5$mpg~da5$hp+da5$wt)#没画出来
s3d$plane3d(fit,col="grey30")
##气泡
library(DescTools)
PlotBubble(x=da5$hp,y=da5$wt,area=da5$hp,
           panel.first=grid(),
           cex=0.006,col=SetAlpha("green3",0.2),
           xlab="总马力",ylab="汽车自重")
mtext("气泡大小=行驶英里数",line=-2,cex=0.8,adj=0.1)
BubbleLegend("bottomright",area=c(5,3,1),frame=TRUE,
             cols=SetAlpha("blue2",0.3),bg="grey95",
             labels=c(15,10,5),cex=0.8,cols.lbl=c("red","yellow","green"))
##条件散点图
fcyl<-factor(da5$cyl)#转换因子
da55<-data.frame(fcyl,da5)
head(da55)
coplot(data=da55,hp~wt|fcyl,
       panel=panel.smooth,
       col="blue",bg=5,pch=21,
       bar.bg=c(fac="pink"),
       rows=1,columns=3)
class(da55$fcyl)
##广义配对图要因子
library(GGally);library(ggplot2)
ggpairs(da55[,c(1,2,5,7)],
        aes(color= fcyl,alpha=0.6))+
  theme(axis.text=element_text(size=8))

第六章

#######第六章#############################
##按照species分组的轮廓图，species本来就是因子
library(ggiraphExtra);require(ggplot2)
ggPair(iris,aes(color=Species))+
  theme(axis.text=element_text(size=7),
        legend.position=c(0.6,0.87),
        legend.direction="horizontal",
        legend.text=element_text(size="7"))
##雷达图
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'))
##星图
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=1)
##聚类图
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)

第七章

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