33. 三元图绘制
清除当前环境中的变量
rm(list=ls())
设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/33ternary/")
使用Ternary包绘制三元图
# 安装并加载所需的R包
#install.packages("Ternary")
library(Ternary)
# 构建示例数据
coords <- list(
A = c(1, 0, 2),
B = c(1, 1, 1),
C = c(1.5, 1.5, 0),
D = c(0.5, 1.5, 1)
)
color <- c("red","blue","green","orange")
size <- c(2,3,4,5)
coords
## $A
## [1] 1 0 2
##
## $B
## [1] 1 1 1
##
## $C
## [1] 1.5 1.5 0.0
##
## $D
## [1] 0.5 1.5 1.0
color
## [1] "red" "blue" "green" "orange"
size
## [1] 2 3 4 5
# 使用TernaryPlot函数绘制基础三元图
TernaryPlot(alab = "X",blab = "Y",clab = "Z", lab.offset = 0.1,
atip = "Top", btip = "Bottom", ctip = "Right",
axis.col = "red", grid.col = "gray",grid.minor.lines = F,
col="gray90")
# 添加箭头
TernaryArrows(coords[1], coords[2:4], col='blue', length=0.2, lwd=1)
# 添加连线
AddToTernary(lines, coords, col='red', lty='dotted', lwd=4)
# 添加散点
TernaryPoints(coords, pch=20, cex=size, col=color)
# 添加文本信息
TernaryText(coords, cex=1.5, col='black', font=2, pos=1)
image.png
使用vcd包绘制三元图
# 安装并加载所需的R包
#install.packages("vcd")
library(vcd)
# 加载示例数据
data("Arthritis")
## Build table by crossing Treatment and Sex
tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis))
head(tab)
## Improved
## I(Sex:Treatment) None Some Marked
## Female:Placebo 19 7 6
## Female:Treated 6 5 16
## Male:Placebo 10 0 1
## Male:Treated 7 2 5
## Mark groups
col <- c("red", "red", "blue", "blue")
pch <- c(1, 19, 1, 19)
## 使用ternaryplot函数绘制三元图
ternaryplot(
tab,
col = col,
pch = pch,
prop_size = TRUE,
bg = "lightgray",
grid_color = "white",
labels_color = "black",
dimnames_position = "edge",
border = "red",
main = "Arthritis Treatment Data"
)
## 添加图例
grid_legend(x=0.8, y=0.7, pch, col, labels = rownames(tab), title = "GROUP")
image.png
使用ggtern包绘制三元图
# 安装并加载所需的R包
#install.packages("ggtern")
library(ggtern)
## Warning: package 'ggtern' was built under R version 3.6.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 3.6.3
## 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.
## --
##
## Attaching package: '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(ggplot2)
# 加载并查看示例数据
data(Feldspar)
head(Feldspar)
## Experiment Feldspar Ab Or An T.C P.Gpa
## 17 G5 Alkalai 0.333 0.657 0.010 700 0.3
## 18 A4 Alkalai 0.331 0.658 0.011 700 0.3
## 20 G10-9 Alkalai 0.232 0.763 0.005 650 0.3
## 38 A4 Plagioclase 0.763 0.072 0.165 700 0.3
## 40 G10-9 Plagioclase 0.772 0.060 0.168 650 0.3
## 7 K1 Alkalai 0.282 0.700 0.018 800 0.2
#使用ggtern函数绘制基础三元图
ggtern(data=Feldspar,aes(x=An,y=Ab,z=Or)) +
geom_point()
image.png
# 设置点的形状、大小和颜色
ggtern(Feldspar,aes(Ab,An,Or)) +
geom_point(size=5,aes(shape=Feldspar,fill=Feldspar),color='black') +
scale_shape_manual(values=c(21,24)) + #自定义形状和颜色
theme_rgbg() + #更换主题
labs(title = "Demonstration of Raster Annotation")
image.png
ggtern(Feldspar,aes(Ab,An,Or)) +
geom_point(size=5,aes(shape=Feldspar,fill=Feldspar),color='black') +
scale_shape_manual(values=c(21,24)) + #自定义形状和颜色
theme_bvbw() + #更换主题
labs(title = "Demonstration of Raster Annotation") +
geom_smooth_tern() #添加拟合曲线
image.png
# 加载并查看示例数据
data(Fragments)
head(Fragments)
## Watershed Position CCWI Precipitation Discharge Relief GrainSize Sample
## 1 2 Tallulah 100 173 81 0.81 Coarse A
## 2 2 Tallulah 100 173 81 0.81 Coarse B
## 3 2 Tallulah 100 173 81 0.81 Coarse C
## 4 2 Tallulah 100 173 81 0.81 Medium A
## 5 2 Tallulah 100 173 81 0.81 Medium B
## 6 2 Tallulah 100 173 81 0.81 Medium C
## Points Qm Qp Rf M
## 1 247 13.4 40.0 43.7 2.8
## 2 265 12.5 40.0 44.1 3.4
## 3 263 14.1 38.4 43.0 4.6
## 4 323 35.3 25.7 27.7 11.5
## 5 252 38.9 17.9 31.0 12.3
## 6 264 36.4 20.0 33.4 10.3
# 添加密度曲线，进行分面
ggtern(Fragments,aes(Qm+Qp,Rf,M,colour=Sample)) +
geom_point(aes(shape=Position,size=Relief)) +
theme_bw(base_size=8) +
theme_showarrows() + # 更换主题
geom_density_tern(h=2,aes(fill=..level..),
expand=0.75,alpha=0.5,bins=5) +
custom_percent('%') +
labs(title = "Grantham and Valbel Rock Fragment Data",
x = "Q_{m+p}", xarrow = "Quartz (Multi + Poly)",
y = "R_f", yarrow = "Rock Fragments",
z = "M", zarrow = "Mica") +
theme_latex() +
facet_wrap(~Sample)
image.png
library(plyr)
#Load the Data.
data(USDA)
head(USDA)
## Clay Sand Silt Label
## 1 1.00 0.00 0.00 Clay
## 2 0.55 0.45 0.00 Clay
## 3 0.40 0.45 0.15 Clay
## 4 0.40 0.20 0.40 Clay
## 5 0.60 0.00 0.40 Clay
## 6 0.55 0.45 0.00 Sandy Clay
#Put tile labels at the midpoint of each tile.
USDA.LAB <- ddply(USDA,"Label",function(df){
apply(df[,1:3],2,mean)
})
#Tweak
USDA.LAB$Angle = sapply(as.character(USDA.LAB$Label),function(x){
switch(x,"Loamy Sand"=-35,0)
})
head(USDA.LAB)
## Label Clay Sand Silt Angle
## 1 Clay 0.59000000 0.2200000 0.19000000 0
## 2 Sandy Clay 0.41666667 0.5166667 0.06666667 0
## 3 Sandy Clay Loam 0.27500000 0.5750000 0.15000000 0
## 4 Sandy Loam 0.09285714 0.6214286 0.28571429 0
## 5 Loamy Sand 0.06250000 0.8250000 0.11250000 -35
## 6 Sand 0.03333333 0.9166667 0.05000000 0
#Construct the plot.
ggtern(data=USDA,aes(Sand,Clay,Silt,color=Label,fill=Label)) +
geom_polygon(alpha=0.75,size=0.5,color="black") +
geom_mask() +
geom_text(data=USDA.LAB,aes(label=Label,angle=Angle),
color="black",size=3.5) +
theme_rgbw() +
theme_showsecondary() +
theme_showarrows() +
weight_percent() +
#guides(fill='none') +
theme_legend_position("topright") +
labs(title = "USDA Textural Classification Chart",
fill = "Textural Class",
color = "Textural Class")
image.png
sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.936
## [2] LC_CTYPE=Chinese (Simplified)_China.936
## [3] LC_MONETARY=Chinese (Simplified)_China.936
## [4] LC_NUMERIC=C
## [5] LC_TIME=Chinese (Simplified)_China.936
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] plyr_1.8.4 ggtern_3.3.0 ggplot2_3.3.2 vcd_1.4-8 Ternary_1.2.0
##
## loaded via a namespace (and not attached):
## [1] zoo_1.8-6 tidyselect_1.1.0 xfun_0.8
## [4] purrr_0.3.2 splines_3.6.0 lattice_0.20-38
## [7] latex2exp_0.4.0 colorspace_1.4-1 vctrs_0.3.2
## [10] generics_0.0.2 htmltools_0.3.6 viridisLite_0.3.0
## [13] yaml_2.2.0 mgcv_1.8-28 compositions_2.0-0
## [16] rlang_0.4.7 isoband_0.2.2 later_0.8.0
## [19] pillar_1.4.2 glue_1.4.2 withr_2.1.2
## [22] lifecycle_0.2.0 robustbase_0.93-5 stringr_1.4.0
## [25] munsell_0.5.0 gtable_0.3.0 evaluate_0.14
## [28] labeling_0.3 knitr_1.23 httpuv_1.5.1
## [31] lmtest_0.9-37 DEoptimR_1.0-8 proto_1.0.0
## [34] Rcpp_1.0.5 xtable_1.8-4 promises_1.0.1
## [37] scales_1.0.0 mime_0.7 gridExtra_2.3
## [40] tensorA_0.36.1 digest_0.6.20 stringi_1.4.3
## [43] dplyr_1.0.2 shiny_1.3.2 tools_3.6.0
## [46] magrittr_1.5 tibble_2.1.3 crayon_1.3.4
## [49] pkgconfig_2.0.2 Matrix_1.2-17 MASS_7.3-51.4
## [52] bayesm_3.1-4 rmarkdown_1.13 R6_2.4.0
## [55] nlme_3.1-139 compiler_3.6.0
