R语言实现各种数据可视化的超详细教程
WSKH0929 人气:01 主成分分析可视化结果
1.1 查看莺尾花数据集(前五行,前四列)
iris[1:5,-5] ## Sepal.Length Sepal.Width Petal.Length Petal.Width ## 1 5.1 3.5 1.4 0.2 ## 2 4.9 3.0 1.4 0.2 ## 3 4.7 3.2 1.3 0.2 ## 4 4.6 3.1 1.5 0.2 ## 5 5.0 3.6 1.4 0.2
1.2 使用莺尾花数据集进行主成分分析后可视化展示
library("ggplot2") library("ggbiplot") ## 载入需要的程辑包:plyr ## 载入需要的程辑包:scales ## 载入需要的程辑包:grid res.pca = prcomp(iris[,-5],scale=TRUE) ggbiplot(res.pca,obs.scale=1,var.scale=1,ellipse=TRUE,circle=TRUE)
#添加组别颜色 ggbiplot(res.pca,obs.scale=1,var.scale=1,ellipse=TRUE,circle=TRUE,groups=iris$Species)
#更改绘制主题 ggbiplot(res.pca, obs.scale = 1, var.scale = 1, ellipse = TRUE,groups = iris$Species, circle = TRUE) + theme_bw() + theme(panel.grid = element_blank()) + scale_color_brewer(palette = "Set2") + labs(title = "新主题",subtitle = "好看吗!",caption ="绘于:桂林")
2 圆环图绘制
#构造数据 df <- data.frame( group = c("Male", "Female", "Child"), value = c(10, 20, 30)) #ggpubr包绘制圆环图 library("ggpubr") ## ## 载入程辑包:'ggpubr' ## The following object is masked from 'package:plyr': ## ## mutate ggdonutchart(df, "value", label = "group", fill = "group", color = "white", palette = c("#00AFBB", "#E7B800", "#FC4E07") )
3 马赛克图绘制
3.1 构造数据
library(ggplot2) library(RColorBrewer) library(reshape2) #提供melt()函数 library(plyr) #提供ddply()函数,join()函数 df <- data.frame(segment = c("A", "B", "C","D"), Alpha = c(2400 ,1200, 600 ,250), Beta = c(1000 ,900, 600, 250), Gamma = c(400, 600 ,400, 250), Delta = c(200, 300 ,400, 250)) melt_df<-melt(df,id="segment") df ## segment Alpha Beta Gamma Delta ## 1 A 2400 1000 400 200 ## 2 B 1200 900 600 300 ## 3 C 600 600 400 400 ## 4 D 250 250 250 250 #计算出每行的最大,最小值,并计算每行各数的百分比。ddply()对data.frame分组计算,并利用join()函数进行两个表格连接。 segpct<-rowSums(df[,2:ncol(df)]) for (i in 1:nrow(df)){ for (j in 2:ncol(df)){ df[i,j]<-df[i,j]/segpct[i]*100 #将数字转换成百分比 } } segpct<-segpct/sum(segpct)*100 df$xmax <- cumsum(segpct) df$xmin <- (df$xmax - segpct) dfm <- melt(df, id = c("segment", "xmin", "xmax"),value.name="percentage") colnames(dfm)[ncol(dfm)]<-"percentage" #ddply()函数使用自定义统计函数,对data.frame分组计算 dfm1 <- ddply(dfm, .(segment), transform, ymax = cumsum(percentage)) dfm1 <- ddply(dfm1, .(segment), transform,ymin = ymax - percentage) dfm1$xtext <- with(dfm1, xmin + (xmax - xmin)/2) dfm1$ytext <- with(dfm1, ymin + (ymax - ymin)/2) #join()函数,连接两个表格data.frame dfm2<-join(melt_df, dfm1, by = c("segment", "variable"), type = "left", match = "all") dfm2 ## segment variable value xmin xmax percentage ymax ymin xtext ytext ## 1 A Alpha 2400 0 40 60 60 0 20 30.0 ## 2 B Alpha 1200 40 70 40 40 0 55 20.0 ## 3 C Alpha 600 70 90 30 30 0 80 15.0 ## 4 D Alpha 250 90 100 25 25 0 95 12.5 ## 5 A Beta 1000 0 40 25 85 60 20 72.5 ## 6 B Beta 900 40 70 30 70 40 55 55.0 ## 7 C Beta 600 70 90 30 60 30 80 45.0 ## 8 D Beta 250 90 100 25 50 25 95 37.5 ## 9 A Gamma 400 0 40 10 95 85 20 90.0 ## 10 B Gamma 600 40 70 20 90 70 55 80.0 ## 11 C Gamma 400 70 90 20 80 60 80 70.0 ## 12 D Gamma 250 90 100 25 75 50 95 62.5 ## 13 A Delta 200 0 40 5 100 95 20 97.5 ## 14 B Delta 300 40 70 10 100 90 55 95.0 ## 15 C Delta 400 70 90 20 100 80 80 90.0 ## 16 D Delta 250 90 100 25 100 75 95 87.5
3.2 ggplot2包的geom_rect()函数绘制马赛克图
ggplot()+ geom_rect(aes(ymin = ymin, ymax = ymax, xmin = xmin, xmax = xmax, fill = variable),dfm2,colour = "black") + geom_text(aes(x = xtext, y = ytext, label = value),dfm2 ,size = 4)+ geom_text(aes(x = xtext, y = 103, label = paste("Seg ", segment)),dfm2 ,size = 4)+ geom_text(aes(x = 102, y = seq(12.5,100,25), label = c("Alpha","Beta","Gamma","Delta")), size = 4,hjust = 0)+ scale_x_continuous(breaks=seq(0,100,25),limits=c(0,110))+ theme(panel.background=element_rect(fill="white",colour=NA), panel.grid.major = element_line(colour = "grey60",size=.25,linetype ="dotted" ), panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ), text=element_text(size=15), legend.position="none")
3.3 vcd包的mosaic()函数绘制马赛克图
library(vcd) table<-xtabs(value ~variable+segment, melt_df) mosaic( ~segment+variable,table,shade=TRUE,legend=TRUE,color=TRUE)
包的mosaic()函数绘制马赛克图
library(vcd) table<-xtabs(value ~variable+segment, melt_df) mosaic( ~segment+variable,table,shade=TRUE,legend=TRUE,color=TRUE)
3.4 graphics包的mosaicplot()函数绘制马赛克图
library(graphics) library(wesanderson) #颜色提取 mosaicplot( ~segment+variable,table, color = wes_palette("GrandBudapest1"),main = '')
4 棒棒糖图绘制
4.1 查看内置示例数据
library(ggplot2) data("mtcars") df <- mtcars # 转换为因子 df$cyl <- as.factor(df$cyl) df$name <- rownames(df) head(df) ## mpg cyl disp hp drat wt qsec vs am gear carb ## Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 ## Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 ## Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 ## Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 ## Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 ## Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 ## name ## Mazda RX4 Mazda RX4 ## Mazda RX4 Wag Mazda RX4 Wag ## Datsun 710 Datsun 710 ## Hornet 4 Drive Hornet 4 Drive ## Hornet Sportabout Hornet Sportabout ## Valiant Valiant
4.2 绘制基础棒棒糖图(使用ggplot2)
ggplot(df,aes(name,mpg)) + # 添加散点 geom_point(size=5) + # 添加辅助线段 geom_segment(aes(x=name,xend=name,y=0,yend=mpg))
4.2.1 更改点的大小,形状,颜色和透明度
ggplot(df,aes(name,mpg)) + # 添加散点 geom_point(size=5, color="red", fill=alpha("orange", 0.3), alpha=0.7, shape=21, stroke=3) + # 添加辅助线段 geom_segment(aes(x=name,xend=name,y=0,yend=mpg)) + theme_bw() + theme(axis.text.x = element_text(angle = 45,hjust = 1), panel.grid = element_blank())
4.2.2 更改辅助线段的大小,颜色和类型
ggplot(df,aes(name,mpg)) + # 添加散点 geom_point(aes(size=cyl,color=cyl)) + # 添加辅助线段 geom_segment(aes(x=name,xend=name,y=0,yend=mpg), size=1, color="blue", linetype="dotdash") + theme_classic() + theme(axis.text.x = element_text(angle = 45,hjust = 1), panel.grid = element_blank()) + scale_y_continuous(expand = c(0,0)) ## Warning: Using size for a discrete variable is not advised.
4.2.3 对点进行排序,坐标轴翻转
df <- df[order(df$mpg),] # 设置因子进行排序 df$name <- factor(df$name,levels = df$name) ggplot(df,aes(name,mpg)) + # 添加散点 geom_point(aes(color=cyl),size=8) + # 添加辅助线段 geom_segment(aes(x=name,xend=name,y=0,yend=mpg), size=1, color="gray") + theme_minimal() + theme( panel.grid.major.y = element_blank(), panel.border = element_blank(), axis.ticks.y = element_blank() ) + coord_flip()
4.3 绘制棒棒糖图(使用ggpubr)
library(ggpubr) # 查看示例数据 head(df) ## mpg cyl disp hp drat wt qsec vs am gear carb ## Cadillac Fleetwood 10.4 8 472 205 2.93 5.250 17.98 0 0 3 4 ## Lincoln Continental 10.4 8 460 215 3.00 5.424 17.82 0 0 3 4 ## Camaro Z28 13.3 8 350 245 3.73 3.840 15.41 0 0 3 4 ## Duster 360 14.3 8 360 245 3.21 3.570 15.84 0 0 3 4 ## Chrysler Imperial 14.7 8 440 230 3.23 5.345 17.42 0 0 3 4 ## Maserati Bora 15.0 8 301 335 3.54 3.570 14.60 0 1 5 8 ## name ## Cadillac Fleetwood Cadillac Fleetwood ## Lincoln Continental Lincoln Continental ## Camaro Z28 Camaro Z28 ## Duster 360 Duster 360 ## Chrysler Imperial Chrysler Imperial ## Maserati Bora Maserati Bora
4.3.1 使用ggdotchart函数绘制棒棒糖图
ggdotchart(df, x = "name", y = "mpg", color = "cyl", # 设置按照cyl填充颜色 size = 6, # 设置点的大小 palette = c("#00AFBB", "#E7B800", "#FC4E07"), # 修改颜色画板 sorting = "ascending", # 设置升序排序 add = "segments", # 添加辅助线段 add.params = list(color = "lightgray", size = 1.5), # 设置辅助线段的大小和颜色 ggtheme = theme_pubr(), # 设置主题 )
4.3.2 自定义一些参数
ggdotchart(df, x = "name", y = "mpg", color = "cyl", # 设置按照cyl填充颜色 size = 8, # 设置点的大小 palette = "jco", # 修改颜色画板 sorting = "descending", # 设置降序排序 add = "segments", # 添加辅助线段 add.params = list(color = "lightgray", size = 1.2), # 设置辅助线段的大小和颜色 rotate = TRUE, # 旋转坐标轴方向 group = "cyl", # 设置按照cyl进行分组 label = "mpg", # 按mpg添加label标签 font.label = list(color = "white", size = 7, vjust = 0.5), # 设置label标签的字体颜色和大小 ggtheme = theme_pubclean(), # 设置主题 )
5 三相元图绘制
5.1 构建数据
test_data = data.frame(x = runif(100), y = runif(100), z = runif(100)) head(test_data) ## x y z ## 1 0.79555379 0.1121278 0.90667083 ## 2 0.12816648 0.8980756 0.51703604 ## 3 0.66631357 0.5757205 0.50830765 ## 4 0.87326608 0.2336119 0.05895517 ## 5 0.01087468 0.7611424 0.37542833 ## 6 0.77126494 0.2682030 0.49992176
5.1.1 R-ggtern包绘制三相元图
library(tidyverse) ## -- Attaching packages --------------------------------------- tidyverse 1.3.1 -- ## v tibble 3.1.3 v dplyr 1.0.7 ## v tidyr 1.1.3 v stringr 1.4.0 ## v readr 2.0.1 v forcats 0.5.1 ## v purrr 0.3.4 ## -- Conflicts ------------------------------------------ tidyverse_conflicts() -- ## x dplyr::arrange() masks plyr::arrange() ## x readr::col_factor() masks scales::col_factor() ## x purrr::compact() masks plyr::compact() ## x dplyr::count() masks plyr::count() ## x purrr::discard() masks scales::discard() ## x dplyr::failwith() masks plyr::failwith() ## x dplyr::filter() masks stats::filter() ## x dplyr::id() masks plyr::id() ## x dplyr::lag() masks stats::lag() ## x dplyr::mutate() masks ggpubr::mutate(), plyr::mutate() ## x dplyr::rename() masks plyr::rename() ## x dplyr::summarise() masks plyr::summarise() ## x dplyr::summarize() masks plyr::summarize() library(ggtern) ## Registered S3 methods overwritten by 'ggtern': ## method from ## grid.draw.ggplot ggplot2 ## plot.ggplot ggplot2 ## print.ggplot ggplot2 ## -- ## Remember to cite, run citation(package = 'ggtern') for further info. ## -- ## ## 载入程辑包:'ggtern' ## The following objects are masked from 'package:ggplot2': ## ## aes, annotate, ggplot, ggplot_build, ggplot_gtable, ggplotGrob, ## ggsave, layer_data, theme_bw, theme_classic, theme_dark, ## theme_gray, theme_light, theme_linedraw, theme_minimal, theme_void library(hrbrthemes) ## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes. ## Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and ## if Arial Narrow is not on your system, please see https://bit.ly/arialnarrow library(ggtext) test_plot_pir <- ggtern(data = test_data,aes(x, y, z))+ geom_point(size=2.5)+ theme_rgbw(base_family = "") + labs(x="",y="", title = "Example Density/Contour Plot: <span style='color:#D20F26'>GGtern Test</span>", subtitle = "processed map charts with <span style='color:#1A73E8'>ggtern()</span>", caption = "Visualization by <span style='color:#DD6449'>DataCharm</span>") + guides(color = "none", fill = "none", alpha = "none")+ theme( plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black", size = 20, margin = margin(t = 1, b = 12)), plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15), plot.caption = element_markdown(face = 'bold',size = 12), ) test_plot_pir
5.1.2 优化处理
test_plot <- ggtern(data = test_data,aes(x, y, z),size=2)+ stat_density_tern(geom = 'polygon',n = 300, aes(fill = ..level.., alpha = ..level..))+ geom_point(size=2.5)+ theme_rgbw(base_family = "") + labs(x="",y="", title = "Example Density/Contour Plot: <span style='color:#D20F26'>GGtern Test</span>", subtitle = "processed map charts with <span style='color:#1A73E8'>ggtern()</span>", caption = "Visualization by <span style='color:#DD6449'>DataCharm</span>") + scale_fill_gradient(low = "blue",high = "red") + #去除映射属性的图例 guides(color = "none", fill = "none", alpha = "none")+ theme( plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black", size = 20, margin = margin(t = 1, b = 12)), plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15), plot.caption = element_markdown(face = 'bold',size = 12), ) test_plot ## Warning: stat_density_tern: You have not specified a below-detection-limit (bdl) value (Ref. 'bdl' and 'bdl.val' arguments in ?stat_density_tern). Presently you have 2x value/s below a detection limit of 0.010, which acounts for 2.000% of your data. Density values at fringes may appear abnormally high attributed to the mathematics of the ILR transformation. ## You can either: ## 1. Ignore this warning, ## 2. Set the bdl value appropriately so that fringe values are omitted from the ILR calculation, or ## 3. Accept the high density values if they exist, and manually set the 'breaks' argument ## so that the countours at lower densities are represented appropriately.
6 华夫饼图绘制
6.1 数据准备
#相关包 library(ggplot2) library(RColorBrewer) library(reshape2) #数据生成 nrows <- 10 categ_table <- round(table(mpg$class ) * ((nrows*nrows)/(length(mpg$class)))) sort_table<-sort(categ_table,index.return=TRUE,decreasing = FALSE) Order<-sort(as.data.frame(categ_table)$Freq,index.return=TRUE,decreasing = FALSE) df <- expand.grid(y = 1:nrows, x = 1:nrows) df$category<-factor(rep(names(sort_table),sort_table), levels=names(sort_table)) Color<-brewer.pal(length(sort_table), "Set2") head(df) ## y x category ## 1 1 1 2seater ## 2 2 1 2seater ## 3 3 1 minivan ## 4 4 1 minivan ## 5 5 1 minivan ## 6 6 1 minivan
6.1.1 ggplot 包绘制
ggplot(df, aes(x = y, y = x, fill = category)) + geom_tile(color = "white", size = 0.25) + #geom_point(color = "black",shape=1,size=5) + coord_fixed(ratio = 1)+ #x,y 轴尺寸固定, ratio=1 表示 x , y 轴长度相同 scale_x_continuous(trans = 'reverse') +#expand = c(0, 0), scale_y_continuous(trans = 'reverse') +#expand = c(0, 0), scale_fill_manual(name = "Category", #labels = names(sort_table), values = Color)+ theme(#panel.border = element_rect(fill=NA,size = 2), panel.background = element_blank(), plot.title = element_text(size = rel(1.2)), axis.text = element_blank(), axis.title = element_blank(), axis.ticks = element_blank(), legend.title = element_blank(), legend.position = "right") ## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
6.1.2 点状华夫饼图ggplot绘制
library(ggforce) ggplot(df, aes(x0 = y, y0 = x, fill = category,r=0.5)) + geom_circle(color = "black", size = 0.25) + #geom_point(color = "black",shape=21,size=6) + coord_fixed(ratio = 1)+ scale_x_continuous(trans = 'reverse') +#expand = c(0, 0), scale_y_continuous(trans = 'reverse') +#expand = c(0, 0), scale_fill_manual(name = "Category", #labels = names(sort_table), values = Color)+ theme(#panel.border = element_rect(fill=NA,size = 2), panel.background = element_blank(), plot.title = element_text(size = rel(1.2)), legend.position = "right") ## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
6.1.3 堆积型华夫饼图
library(dplyr) nrows <- 10 ndeep <- 10 unit<-100 df <- expand.grid(y = 1:nrows, x = 1:nrows) categ_table <- as.data.frame(table(mpg$class) * (nrows*nrows)) colnames(categ_table)<-c("names","vals") categ_table<-arrange(categ_table,desc(vals)) categ_table$vals<-categ_table$vals /unit tb4waffles <- expand.grid(y = 1:ndeep,x = seq_len(ceiling(sum(categ_table$vals) / ndeep))) regionvec <- as.character(rep(categ_table$names, categ_table$vals)) tb4waffles<-tb4waffles[1:length(regionvec),] tb4waffles$names <- factor(regionvec,levels=categ_table$names) Color<-brewer.pal(nrow(categ_table), "Set2") ggplot(tb4waffles, aes(x = x, y = y, fill = names)) + #geom_tile(color = "white") + # geom_point(color = "black",shape=21,size=5) + # scale_fill_manual(name = "Category", values = Color)+ xlab("1 square = 100")+ ylab("")+ coord_fixed(ratio = 1)+ theme(#panel.border = element_rect(fill=NA,size = 2), panel.background = element_blank(), plot.title = element_text(size = rel(1.2)), #axis.text = element_blank(), #axis.title = element_blank(), #axis.ticks = element_blank(), # legend.title = element_blank(), legend.position = "right") ## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
6.1.4 waffle 包绘制(一个好用的包,专为华夫饼图做准备的)
#waffle(parts, rows = 10, keep = TRUE, xlab = NULL, title = NULL, colors = NA, size = 2, flip = FALSE, reverse = FALSE, equal = TRUE, pad = 0, use_glyph = FALSE, glyph_size = 12, legend_pos = "right") #parts 用于图表的值的命名向量 #rows 块的行数 #keep 保持因子水平(例如,在华夫饼图中获得一致的图例) library("waffle") parts <- c(One=80, Two=30, Three=20, Four=10) chart <- waffle(parts, rows=8) print(chart)
7 三维散点图绘制
7.1 简单绘制
library("plot3D") #以Sepal.Length为x轴,Sepal.Width为y轴,Petal.Length为z轴。绘制箱子型box = TRUE;旋转角度为theta = 60, phi = 20;透视转换强度的值为3d=3;按照2D图绘制正常刻度ticktype = "detailed";散点图的颜色设置bg="#F57446" pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1)) #改版画布版式大小 with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length, pch = 21, cex = 1.5,col="black",bg="#F57446", xlab = "Sepal.Length", ylab = "Sepal.Width", zlab = "Petal.Length", ticktype = "detailed",bty = "f",box = TRUE, theta = 60, phi = 20, d=3, colkey = FALSE) )
7.2 加入第四个变量,进行颜色分组
7.2.1 方法一
#可以将变量Petal.Width映射到数据点颜色中。该变量是连续性,如果想将数据按从小到大分成n类,则可以使用dplyr包中的ntile()函数,然后依次设置不同组的颜色bg=colormap[iris$quan],并根据映射的数值添加图例颜色条(colkey())。 library(tidyverse) iris = iris %>% mutate(quan = ntile(Petal.Width,6)) colormap <- colorRampPalette(rev(brewer.pal(11,'RdYlGn')))(6)#legend颜色配置 pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1)) # 绘图 with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length,pch = 21, cex = 1.5,col="black",bg=colormap[iris$quan], xlab = "Sepal.Length", ylab = "Sepal.Width", zlab = "Petal.Length", ticktype = "detailed",bty = "f",box = TRUE, theta = 60, phi = 20, d=3, colkey = FALSE) ) colkey (col=colormap,clim=range(iris$quan),clab = "Petal.Width", add=TRUE, length=0.4,side = 4)
7.2.2 方法二
#将第四维数据映射到数据点的大小上(cex = rescale(iris$quan, c(.5, 4)))这里我还“得寸进尺”的将颜色也来反应第四维变量,当然也可以用颜色反应第五维变量。 pmar <- par(mar = c(5.1, 4.1, 4.1, 6.1)) with(iris, scatter3D(x = Sepal.Length, y = Sepal.Width, z = Petal.Length,pch = 21, cex = rescale(iris$quan, c(.5, 4)),col="black",bg=colormap[iris$quan], xlab = "Sepal.Length", ylab = "Sepal.Width", zlab = "Petal.Length", ticktype = "detailed",bty = "f",box = TRUE, theta = 30, phi = 15, d=2, colkey = FALSE) ) breaks =1:6 legend("right",title = "Weight",legend=breaks,pch=21, pt.cex=rescale(breaks, c(.5, 4)),y.intersp=1.6, pt.bg = colormap[1:6],bg="white",bty="n")
7.3 用rgl包的plot3d()进行绘制
library(rgl) #数据 mycolors <- c('royalblue1', 'darkcyan', 'oldlace') iris$color <- mycolors[ as.numeric(iris$Species) ] #绘制 plot3d( x=iris$`Sepal.Length`, y=iris$`Sepal.Width`, z=iris$`Petal.Length`, col = iris$color, type = 's', radius = .1, xlab="Sepal Length", ylab="Sepal Width", zlab="Petal Length")
总结
加载全部内容