美文网首页R语言学习基因组数据绘图
R语言可视化(三十三):三元图绘制

R语言可视化(三十三):三元图绘制

作者: Davey1220 | 来源:发表于2020-11-14 14:45 被阅读0次

    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
    

    相关文章

      网友评论

        本文标题:R语言可视化(三十三):三元图绘制

        本文链接:https://www.haomeiwen.com/subject/gqcwbktx.html