帅哥专用数据可视化闲人勿进

```{r echo=TRUE}
#Q1:绘制并列条形图和堆叠条形图，区别在于beside
##使用barplot
data("Titanic")
titan <- as.data.frame(Titanic)
tab <- xtabs(Freq~Sex+Survived,data=titan)
library(sjPlot)
b1 <- barplot(tab,xlab="Sex",ylab="Survived",legend=rownames(tab))
text(b1,tab,labels=tab,pos=3)
```
```{r echo=TRUE}
#Q2 帕累托图
data("Titanic")
titan <- as.data.frame(Titanic)
tab <- xtabs(Freq~Class,data=titan)
df <- as.data.frame(tab)
x <- sort(tab,decreasing = TRUE)
bar <- barplot(x,xlab="Class",ylab="Freq",ylim=c(0,2000),col="red")
text(bar,x,labels=x,pos=3,col="lightgreen")
y <- cumsum(x)/sum(x)
par(new=T)
plot(y,type="b",pch=15,axes=FALSE,xlab='',ylab='',main='')
axis(side=4)
mtext("Freq_sum",side=4,line=3,cex=0.8)
text(labels="Curve",x=2.4,y=0.95,cex=1)
```
```{r echo=TRUE}
#Q3 脊形图
data("Titanic")
tabs <- xtabs(Freq~Class+Survived,data = Titanic)
spineplot(tabs,col=c("lightgreen","lightblue"),xlab="class",ylab="survived")
```
```{r echo=TRUE}
#Q4 条形树状图和矩形树状图
#条形树状图
data("Titanic")
library(plotrix)
tabs <- xtabs(Freq~Class+Sex+Age+Survived,data=Titanic)
tabs <- as.data.frame.array(tabs)
sizetree(tabs,showval = TRUE,showcount = TRUE,
         stacklabels = TRUE,base.cex=0.7,border = "black")
#矩形树状图
library(treemap)
tabs <- xtabs(Freq~Class+Sex+Age+Survived,data=Titanic)
tabs <- as.data.frame(tabs)
treemap::treemap(tabs,index=c("Class","Sex","Age","Survived"),vSize="Freq",vColor="Freq",
        type="value",fontsize.labels = 8,position.legend = "bottom")
```
```{r echo=TRUE}
#Q5 独立检验P图
data("Titanic")
library(sjPlot)
titan <- as.data.frame(Titanic)
sjp.chi2(titan,show.legend = TRUE)
```
```{r echo=TRUE}
#Q6 马赛克图
library(vcd)
tab <- xtabs(Freq~Class+Sex+Age+Survived,data=Titanic)
tab1 <- structable(Titanic)
mosaic(tab1,shade = TRUE,labeling=labeling_values,return_grob=TRUE)
```
```{r echo=TRUE}
#Q7 气球图、热图、南丁格尔图
#气球图
library(ggpubr);library(RColorBrewer)
data("Titanic")
tab <- xtabs(Freq~Class+Survived,data=Titanic)
df <- as.data.frame(tab)
ggballoonplot(df,x="Class",y="Survived",size="Freq",fill="Freq",shape=23,
              rotate.x.text = FALSE)
#热图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
data("Titanic")
tab <- xtabs(Freq~Class+Survived,data=Titanic)
tabs <- as.data.frame(tab)
ggHeatmap(tabs,aes(x=Survived,y=Class,fill=Freq),addlabel=TRUE,
            palette = "Blues")
#南丁格尔
library(ggiraphExtra);library(ggplot2);library(gridExtra)
data("Titanic")
tab <- as.data.frame(xtabs(Freq~Class+Sex,data=Titanic))
ggRose(tab,aes(x=Class,y=Freq,fill=Sex),stat="identity",reverse=TRUE)
```
```{r echo=TRUE}
#饼图、扇形图、环形图和弧形图
#饼图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
data("Titanic")
titan <- as.data.frame(Titanic)
ggPie(data=titan,aes(pies="Class",count="Freq"))
#扇形图
data("Titanic")
library(plotrix)
tab <- xtabs(Freq~Class,data=Titanic)
name <- names(tab)
percent <- round(prop.table(tab)*100,3)
labs <- paste(name,"",percent,"%",sep="")
fan.plot(tab,labels = labs,
         max.span = 0.9*pi,
         shrink=0.06,radius=1.2,
         label.radius = 1.4,ticks=200,
         col=c("deepskyblue","lightgreen","lightpink"))
#环形图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
data("Titanic")
tab <- xtabs(Freq~Class,data=Titanic)
tab1 <- as.data.frame(tab)
ggDonut(tab1,aes(donuts=Class,count=Freq),labelposition = 1,
        labelsize = 2.5,xmin=2,xmax=4)
#弧形图
library(ggpol);library(ggplot2);library(gridExtra)
data("Titanic")
tab1 <- xtabs(Freq~Class,data=Titanic)
d1 <- as.data.frame(tab1)
df1 <- data.frame(Class=d1$Class,freq=d1$Freq)
ggplot(df1)+geom_arcbar(aes(x=Class,shares=freq,fill=Class,r0=4,r1=10),sep=0.05,show.legend = TRUE)+
  coord_fixed()+theme_void()

```
```{r echo=TRUE}
#饼环图
library(ggiraphExtra);require(ggplot2);library(gridExtra)
data("Titanic")
tabs <- as.data.frame(xtabs(Freq~Class+Sex,data=Titanic))
ggPieDonut(data=tabs,aes(pies=Class,donuts=Sex,count=Freq))
```

CH4

```{r echo=TRUE}
#Q1 直方图
data(faithful)
erp <- faithful$eruptions
wit <- faithful$waiting
hist(erp,breaks=10,freq=FALSE,col="lightblue",xlab="eruptions",ylab="freq")
lines(density(erp),col="darkred")
rug(jitter(erp))
```
```{r echo=TRUE}
#Q2
dfaith <- as.data.frame(faithful)
sf <- data.frame(scale(dfaith))
hist(sf$waiting,prob=TRUE,breaks = 20,xlab="value",ylab="density",col="green",main="")
hist(sf$eruptions,prob=TRUE,breaks = 20,xlab=" ",ylab=" ",col="lightblue",density=90,
     main="",add=TRUE)
legend("topright",legend=c("waiting","eruptions"),ncol=1,inset=0.04,col=c("green","lightblue"),
       density=c(100,90),
       fill=c("green","lightblue"),box.col = "yellow",cex=0.8)
```
```{r echo=TRUE}
#Q3 核密度比较图
library(ggplot2)
data(faithful)
ggplot(faithful, aes(x=eruptions, fill="eruptions")) +
  geom_density(alpha=0.3)+
  geom_density(aes(x=waiting,fill="waiting"),alpha=0.3)+
  scale_fill_manual(values = c("eruptions"="red","waiting"="green"),
                      labs(x="value",y="density"))+theme_minimal()

```
```{r echo=TRUE}
#Q4 箱线图和小提琴图
#箱线图1
data("faithful")
palette <- RColorBrewer::brewer.pal(6,"Set2")
boxplot(faithful[,1:2],col=palette,xlab="name",ylab="value")
points((apply(faithful[,1:2],2,mean)),col="black",cex=1,pch=3)
#箱线图2
df <- data.frame(faithful$eruptions,faithful$waiting)
ds <- data.frame(scale(df))
boxplot(ds,col=c("blue","green"))
#小提琴图
library(vioplot)
vioplot(faithful[,1:2],col=c("lightblue","lightgreen"),xlab="name",ylab="values")
#做对数变换
dg <- log10(faithful[,1:2])
vioplot(dg,col=c("grey","purple"))
#标准化
ds <- data.frame(scale(df))
vioplot(ds)
```
```{r echo=TRUE}
#Q5 茎叶图
library(aplpack)
stem.leaf.backback(faithful$eruptions,faithful$waiting)
stem.leaf(faithful$eruptions)
```
```{r echo=TRUE}
#Q6 点图和带状图
library("ggiraphExtra");require(ggplot2);library(gridExtra)
p1 <- dotchart(faithful$eruptions,color = "purple",xlab = "variables",
         ylab="values")
p2 <- dotchart(faithful$waiting,color = "blue",xlab = "variables",ylab="values")
grid.arrange(p1,p2,nrow=1)
ds <- data.frame(scale(faithful))
stripchart(ds$eruptions,method="stack",at=1.16,pch="+",cex=0.9,col="blue3")
stripchart(ds$waiting,method="stack",at=0.6,pch="o",cex=0.9,col="red2",add=TRUE)
```
```{r echo=TRUE}
#Q7 绘制分布概要图
library(aplpack)
plotsummary(faithful[,1:2],types=c("stripes","ecdf","hist","density","boxplot","rug"),
            y.sizes = 6:1,
            design = "chessboard",
            mycols = "RB")
```

CH5

```{r echo=TRUE}
#Q1 散点图
library(investr)
data("mtcars")
mpg <- mtcars$mpg
wt <- mtcars$wt
fit <- lm(mpg~wt)
plotFit(fit,interval="both",level=0.95,shade=TRUE,
        col.conf="lightgreen",col.pred="lightskyblue2",col.fit="purple")
```
```{r echo=TRUE}
#散点图矩阵
library(car)
scatterplotMatrix(mtcars,diagonal=TRUE,ellipse=TRUE,col="steelblue3",gap=0.5,
                  cex=0.5,oma=c(3,3,3,3))
library(corrgram)
corrgram(mtcars,order=TRUE,lower.panel=panel.pts,upper.panel=corrgram::panel.ellipse,
         diag.panel=panel.minmax)
```
```{r echo=TRUE}
#相关系数矩阵
data("mtcars")
mat <- as.matrix(mtcars);rownames(mat)=mtcars[,1]
library(corrplot)
r <- cor(mat)
corrplot(r,order="hclust",mar=c(0,0,1,0))
```
```{r echo=TRUE}
#3D散点图和气泡图
#3D散点图
data("mtcars")
attach(mtcars)
library(scatterplot3d)
sd <- scatterplot3d(x=mpg,y=hp,z=wt,col.axis = "blue",col.grid = "lightblue",pch=16,
              highlight.3d = TRUE,type="h",box=TRUE,cex.lab = 0.7)
fit <- lm(wt~mpg+hp)
sd$plane3d(fit,col="grey30")
#气泡图
library(DescTools)
data("mtcars")
attach(mtcars)
PlotBubble(x=mpg,y=wt,area=hp,panel.first=grid(),cex=0.002,
           col=SetAlpha("blue3",0.2),
           xlab="mpg",ylab="wt")
mtext("sBubble=hp",line=-2,cex=0.8,adj=0.1)
```
```{r echo=TRUE}
#条件散点图
library(ggpubr)
data("mtcars")
attach(mtcars)
ggscatter(data=mtcars,x="mpg",y="wt",size=1,
          color="cyl",
          add="reg.line",conf.int=TRUE)+
  facet_wrap(~cyl)+
  theme_bw()
```
```{r echo=TRUE}
#广义配对图
library(GGally);library(ggplot2)
data("mtcars")
ggpairs(mtcars[,c(1,2,4,6)],aes(color="cyl",alpha=0.6))+
  theme(axis.text = element_text(size=8))
ggpairs(mtcars[,c(1,2,4,6)],aes(fill="wt",color="cyl",alpha=0.6))+
  theme(axis.text=element_text(size=8))
```

CH6

```{r echo=TRUE}
#Q1 轮廓图与雷达图
#轮廓图
library(ggiraphExtra);require(ggplot2)
data("iris")
ggPair(iris,aes(color="Species"))+theme(axis.text = element_text(size = 7),
                                        legend.position = c(0.8,0.8),
                                        legend.direction = "vertical",
                                        legend.text = element_text(size="7"))
#雷达图
ggRadar(data=iris,aes(group="Species",facet="Species"),
        alpha=0.3,size=2,rescale = FALSE)+
  theme(axis.text = element_text(size=4),
        legend.text = element_text(size="6"))
```
```{r echo=TRUE}
#绘制星图和脸谱图
#星图
data(iris)
stars(iris,full=TRUE,scale=TRUE,len=1,draw.segments =
        TRUE,key.loc=c(20.5,1.8,3),mar=c(0.8,0.1,0.1,0.1),
      cex=0.7)
#脸谱图
data("iris")
library(aplpack)
mat <- as.matrix(iris[,c(1,2,3,4)]);rownames(mat)=iris[,5]
faces(mat,face.type = 2,scale = TRUE,ncol.plot=6,cex=0.6)
```
```{r echo=TRUE}
#聚类图和热图
#聚类图
library(factoextra);library(ggplot2)
data("iris")
mat <- as.matrix(iris[,c(1,2,3,4)]);rownames(mat)=iris[,5]
km <- kmeans(mat,centers=3)
fviz_cluster(km,iris[,1:4],repel=TRUE,ellipse.type = "norm",
             labelsize = 8,pointsize = 1.5)
#热图
library(gplots)
mat <- as.matrix(iris[,1:4])
gplots::heatmap.2(mat,col=bluered,tracecol="green",scale="column",
                  dendrogram = "both",cexRow = 0.6,cexCol = 0.7,margins = c(5,3),keysize=2)
```

CH7/9

```{r echo=TRUE}
#折线图
library(showtextdb)
data <- read.csv2("/Users/oh2333/Desktop/data4_1.csv",fileEncoding="GB18030",sep=",",header = TRUE)
library(reshape2);library(ggplot2)
date <- as.Date(data$日期)
d <- data.frame(date,data[,c(2,4,5,9)])
d1 <- data.frame(日期=date,data[,c(2,4,5,9)])
df <- melt(d1,id.vars = "日期",variable.name = "指标",value.name = "指标值")
ggplot(df,aes(x=日期,y=指标值,color=指标))+
  geom_line()+facet_wrap(~指标,ncol=2)+
  theme_bw()
library(openair)
timePlot(d,pollutant = c("AQI","PM2.5","PM10","臭氧浓度"),
         smooth = TRUE,key = FALSE,date.breaks = 12)
```
```{r echo=TRUE}
#面积图
library(ggplot2)
data <- read.csv("/Users/oh2333/Desktop/data4_1.csv",fileEncoding ="GB18030",sep=",")
d <- data.frame(日期=as.Date(data$日期),data[,c(2,4,5,9)])
df <- melt(d,id.vars = "日期",variable.name = "指标",value.name = "指标值")
ggplot(df,aes(x=日期,y=指标值,fill=指标))+
  geom_area()+
  facet_wrap(~指标)
```
```{r echo=TRUE}
#蒸汽图与风筝图
#蒸汽题
library(reshape2);library(ggTimeSeries);library(ggplot2)
data <- read.csv("/Users/oh2333/Desktop/data4_1.csv",fileEncoding = "GB18030",sep=",")
d <- data.frame(日期=as.Date(data$日期),data[,-c(1,2,3)])
df <- melt(d,id.vars = "日期",variable.name = "指标",value.name = "指标值")
ggplot(df,aes(x=日期,y=指标值,group=指标,fill=指标))+stat_steamgraph(color="grey",size=0.2)
#风筝图
library(plotrix)
data <- read.csv("/Users/oh2333/Desktop/data4_1.csv",fileEncoding = "GB18030",sep=",")
mat <- as.matrix(data[,c(4:9)]);rownames(mat)=data[,1]
kiteChart(t(mat),
          varscale = TRUE,
          normalize = TRUE,
          xlab="时间",ylab="指标",
          mar=c(3,3,1,2))
```
```{r echo=TRUE}
#地平线图
library(latticeExtra)
d <- data.frame(data[,-c(1,3)])
dt <- ts(d)
horizonplot(dt,main="地平线图",layout=c(1,7),colorkey=TRUE)
```
```{r echo=TRUE}
#日历图

data <- read.csv("/Users/oh2333/Desktop/data4_1.csv",
                 fileEncoding = "GB18030",
                 sep=",")
df <- data.frame(date=as.Date(data$日期),data[,-1])
library(openair)
calendarPlot(df,pollutant = "AQI",cols="heat",year=2018,
             month=c(1:12))
```
```{r echo=TRUE}
#瀑布图
library(reshape2);library(ggTimeSeries);library(ggplot2)
data <- read.csv("/Users/oh2333/Desktop/price.csv")
d <- data[1:20,]
dd <- data.frame(日期=as.Date(d$日期),d[,2])
df <- melt(dd,id.vars="日期",variable.name="指标",value.name="指标值")
ggplot_waterfall(dtData=df,cXColumnName = "日期",cYColumnName="指标值",nArrowSize = 0.15)+facet_wrap(~指标,ncol = 2)
#折线图
ggplot(df,aes(x=日期,y=指标值,color=指标))+geom_line()+facet_wrap(~指标,ncol=2)+theme_bw()
#面积图
ggplot(df,aes(x=日期,y=指标值,fill=指标))+
  geom_area()+
  facet_wrap(~指标,ncol=1)
```
```{r echo=TRUE}
#3D透视图和词云图
#3D透视图
library(plot3D)
data <- read.csv("/Users/oh2333/Desktop/data6_1.csv",
                 fileEncoding = "GB18030",
                 sep=",")
d <- data[-c(2,3)]
mat <- as.matrix(d[,2:9]);rownames(mat)=d[,1]
par(mfrow=c(2,2),mai=c(0.2,0.2,0.3,0.3),cex=0.6,mpg=c(0,1,0),
    font.main=1)
persp3D(z=t(mat),colkey=list(width=1,length=0.8,cex.axis=0.8),
        xlab="x=支出项目",ylab="y=地区",zlab="z=支出金额",
        resfac = c(1,1),theta = 45,phi = 25,
        border="blue")
```
```{r echo=TRUE}
#词云图(已统计好词频)
data <- read.csv("/Users/oh2333/Desktop/data9_3.csv",
                 fileEncoding = "GB18030",
                 sep=",")
library(wordcloud2)
wc <- wordcloud2(data=data,shape = "circle",size=0.35,
                 color=
                   ifelse(data[,2]>500,"darkblue","lightblue"),
                 backgroundColor = "lightgreen")
wc+WCtheme(1)
letterCloud(data=demoFreq,word="R",size=1,backgroundColor="white")