如何使用 R 或 ggplot2 在六邊形中繪制散點圖？

Question

測試數據：

set.seed(123)
Data <- data.frame(Pro=rnorm(20), Cla=rnorm(20), Neu=rnorm(20))

我想將每個樣本（行）繪制為六邊形（上圖）中的點。 點的位置基於三個坐標，它們之間有 120 個角度（下圖）。

（圖來自 Anoop P. Patel等人，Science ，2014 年）

Answer 1

我不知道有任何特殊方法可以自動執行此操作，但您可以使用一些三角法來計算正確的坐標。

請參閱下面的解決方案

set.seed(123)
Data <- data.frame(Pro=rnorm(20), Cla=rnorm(20), Neu=rnorm(20))

library(tidyverse)
#> Loading tidyverse: ggplot2
#> Loading tidyverse: tibble
#> Loading tidyverse: tidyr
#> Loading tidyverse: readr
#> Loading tidyverse: purrr
#> Loading tidyverse: dplyr
#> Warning: package 'dplyr' was built under R version 3.4.2
#> Conflicts with tidy packages ----------------------------------------------
#> filter(): dplyr, stats
#> lag():    dplyr, stats
Data %>%
  # Separating the S1, S2 and S3 axes into their x-y components is done using simple trigonometry.
  # S1 is the trivial case as it only has y component.
  # S2 and S3 are both 30 degrees (pi/6 radians) below the x-axis
  mutate(S1_x = Pro*cos(pi/2), S1_y = Pro*sin(pi/2), # Deconvolve S1 axis into cartesian coordinates (x,y)
         S2_x = Cla*cos(pi/6), S2_y = -Cla*sin(pi/6), # Deconvolve S2 axis into cartesian coordinates (x,y)
         S3_x = -Neu*cos(pi/6), S3_y = -Neu*sin(pi/6)) %>%  # Deconvolve S3 axis into cartesian coordinates (x,y)
  mutate(x = S1_x + S2_x + S3_x, y = S1_y + S2_y + S3_y) %>% # Combine x and y compononts from S1, S2 and S3
  ggplot(aes(x = x, y=y))+geom_point()

# Just to prove that the maths works, plot the hexagon described by unit length
path <- data.frame(Pro = c(1,1,0,0,0,1,1), Cla = c(0,1,1,1,0,0,0), Neu = c(0,0,0,1,1,1,0))
path %>%
  mutate(S1_x = Pro*cos(pi/2), S1_y = Pro*sin(pi/2), 
         S2_x = Cla*cos(pi/6), S2_y = -Cla*sin(pi/6), 
         S3_x = -Neu*cos(pi/6), S3_y = -Neu*sin(pi/6)) %>% 
  mutate(x = S1_x + S2_x + S3_x, y = S1_y + S2_y + S3_y) %>%
  ggplot(aes(x = x, y=y))+geom_path()

Answer 2

實現目標的更標准方法是使用三元圖。 我理解六邊形是否與您想要顯示數據的方式更相關，但是這個圖更容易構造，因為它有一個ggplot包。

require(ggplot2)
require(ggtern)

ggtern(Data, aes(Pro, Cla,Neu))+
  geom_point()+
  theme_tropical(base_size=14)

Answer 3

我需要創建一個三元圖的六邊形版本，其中我的數據中有六列總是加起來為 1，我需要繪制樣本，以便一列中值為 1 的樣本將繪制在一個角落的六邊形。 我最終只是修改了一個用於繪制三元圖的腳本：

library(tidyverse)
library(ggforce)
library(ggrepel)

t=read.table("https://pastebin.com/raw/5BVbJ4E9",row.names=1) # hexagon
# t=read.table("https://pastebin.com/raw/XNV7Xmmj",row.names=1) # square
# t=read.table("https://pastebin.com/raw/QvdWWvwx",row.names=1) # triangle

corners=rbind(c(.5,sqrt(3)/2),c(1,0),c(.5,-sqrt(3)/2),c(-.5,-sqrt(3)/2),c(-1,0),c(-.5,sqrt(3)/2)) # hexagon
# corners=rbind(c(0,1),c(1,0),c(0,-1),c(-1,0)) # diamond
# corners=rbind(c(1,1),c(1,-1),c(-1,-1),c(-1,1)) # square
# corners=rbind(c(0,sqrt(3)/2),c(-1,-sqrt(3)/2),c(1,-sqrt(3)/2)) # triangle

xy=as.data.frame(as.matrix(t)%*%corners)

# for hexagon
grid=as.data.frame(rbind(cbind(corners,rbind(corners[-1,],corners[1,])),cbind(corners,matrix(rep(0,12),ncol=2))))

# for diamond or square plot
# grid=apply(rbind(c(1,2,4,3),c(1,4,2,3),c(1,2,1,4),c(3,2,3,4),c(4,1,4,3),c(2,1,2,3)),1,function(x)cbind(
#   seq(corners[x[1],1],corners[x[2],1],length.out=11),
#   seq(corners[x[1],2],corners[x[2],2],length.out=11),
#   seq(corners[x[3],1],corners[x[4],1],length.out=11),
#   seq(corners[x[3],2],corners[x[4],2],length.out=11)
# )%>%as.data.frame)%>%bind_rows

# for ternary plot (triangle)
# grid=apply(rbind(c(1,2,3,2),c(1,3,2,3),c(2,1,3,1)),1,function(x)cbind(
#   seq(corners[x[1],1],corners[x[2],1],length.out=11),
#   seq(corners[x[1],2],corners[x[2],2],length.out=11),
#   seq(corners[x[3],1],corners[x[4],1],length.out=11),
#   seq(corners[x[3],2],corners[x[4],2],length.out=11)
# )%>%as.data.frame)%>%bind_rows

pop=sub(":.*","",rownames(xy))
centers=aggregate(xy,by=list(pop),mean)
xy$pop=pop

set.seed(1234)
color=as.factor(sample(seq(1,length(unique(xy$pop)))))
col=rbind(c(60,80),c(25,95),c(30,70),c(70,50),c(60,100),c(20,50),c(15,40))
hues=max(ceiling(length(color)/nrow(col)),8)
pal1=as.vector(apply(col,1,function(x)hcl(seq(15,375,length=hues+1)[1:hues],x[1],x[2])))
pal2=as.vector(apply(col,1,function(x)hcl(seq(15,375,length=hues+1)[1:hues],ifelse(x[2]>50,.8*x[1],.2*x[1]),ifelse(x[2]>50,.3*x[2],100))))

# add a small random factor so geom_voronoi_tile won't fail because of too many overlapping points
xy$V1=xy$V1+runif(nrow(xy))/1e3
xy$V2=xy$V2+runif(nrow(xy))/1e3

ggplot(xy,aes(x=V1,y=V2,group=-1L))+
geom_segment(data=grid,aes(x=V1,y=V2,xend=V3,yend=V4),color="gray90",size=.3)+
geom_voronoi_tile(aes(fill=color[as.factor(pop)],color=color[as.factor(pop)]),size=.07,max.radius=.05)+
# geom_point(data=centers,aes(x=V1,y=V2,color=color,fill=color),shape=21,size=2)+
# geom_label(data=centers,aes(x=V1,y=V2,label=Group.1,color=color,fill=color),alpha=.7,size=2.2,label.r=unit(.07,"lines"),label.padding=unit(.07,"lines"),label.size=0)+
geom_label_repel(data=centers,aes(x=V1,y=V2,label=Group.1,color=color,fill=color),max.overlaps=Inf,point.size=0,size=2.2,label.r=unit(.1,"lines"),label.padding=unit(.1,"lines"),label.size=.1,box.padding=0)+
coord_fixed(xlim=c(-1.08,1.08),ylim=c(-1.08,1.08),expand=F)+
scale_fill_manual(values=pal1)+
scale_color_manual(values=pal2)+
theme(
  axis.text=element_blank(),
  axis.ticks=element_blank(),
  axis.title=element_blank(),
  legend.position="none",
  panel.background=element_rect(fill="white"),
  plot.margin=margin(0,0,0,0,"cm")
)

ggsave("a.png",width=7,height=7)

ggforce用於使用 Voronoi 鑲嵌繪制點： https : ggforce 。 當我嘗試安裝ggforce ，它首先失敗了，因為它的依賴units安裝失敗。 通過運行install.packages("units") ，我發現我需要運行brew install udunits （在 Debian 上運行libudunits2-dev ，在 RPM 上運行udunits2-devel ）。

Answer 4

我有同樣的困難。 我想繪制一個六邊形圖，如下圖所示，旋轉6個三元圖形成六邊形。 有人能幫我嗎？ 是否可以使用 plotly.express 或 ggtern 庫？

[在此處輸入圖片描述][1] [1]：https://i.stack.imgur.com/nPoGL.jpg

library(shiny)
library(colourpicker)
library(ggplot2)
library(ggtern)


ui <- fluidPage(
    
    titlePanel("TernaryPlot"),
    fileInput("csv_file", "source", multiple = FALSE, accept = "csv",
              width = NULL, buttonLabel = "Browse...",
              placeholder = "No file selected"),
    
    selectInput("x_val", "Choose x values:", choices=c()),
    selectInput("y_val", "Choose y values:", choices=c()),
    selectInput("z_val", "Choose z values:", choices=c()),
    selectInput("a_val", "Choose a values:", choices=c()),
    selectInput("b_val", "Choose b values:", choices=c()),
    selectInput("c_val", "Choose c values:", choices=c()),
    selectInput("d_val", "Choose d values:", choices=c()),
    
    checkboxInput("show_point", "points", value = FALSE, width = NULL),
    checkboxInput("show_dens", "density", value = FALSE, width = NULL),
    plotOutput("ggtern")
)

server <- function(session,input, output) {
    
    selectedData <- reactive({
        inFile <- input$csv_file
        if (is.null(inFile))
            return(NULL)
        df <- read.csv(inFile$datapath,na.strings = c("", "NA", "#N/A"))
        updateSelectInput(session,"x_val","x series",colnames(df))
        updateSelectInput(session,"y_val","y series",colnames(df))
        updateSelectInput(session,"z_val","z series",colnames(df))
        updateSelectInput(session,"a_val","a series",colnames(df))
        updateSelectInput(session,"b_val","b series",colnames(df))
        updateSelectInput(session,"c_val","c series",colnames(df))
        updateSelectInput(session,"d_val","d series",colnames(df))
        return(df)
    })
    
    output$ggtern <- renderPlot({
        
        if (is.null(selectedData()))
            return(NULL)
        
        req(input$x_val)
        req(input$y_val)
        req(input$z_val)
        req(input$a_val)
        req(input$b_val)
        req(input$c_val)
        req(input$d_val)
        
    obj1 <- ggtern(data=selectedData(), aes_string(x = input$x_val, y = input$y_val, z = input$z_val)) + geom_point()
    obj2 <- ggtern(data=selectedData(), aes_string(x = input$z_val, y = input$y_val, z = input$a_val)) + geom_point() + theme_rotate(degrees = 45 )
    obj3 <- ggtern(data=selectedData(), aes_string(x = input$a_val, y = input$y_val, z = input$b_val)) + geom_point() + theme_rotate(degrees = 130 )
    obj4 <- ggtern(data=selectedData(), aes_string(x = input$b_val, y = input$y_val, z = input$c_val)) + geom_point() + theme_rotate(degrees = 180 )
    obj5 <- ggtern(data=selectedData(), aes_string(x = input$c_val, y = input$y_val, z = input$d_val)) + geom_point() + theme_rotate(degrees = 230 )
    obj6 <- ggtern(data=selectedData(), aes_string(x = input$d_val, y = input$y_val, z = input$x_val)) + geom_point() + theme_rotate(degrees = 300 )
    
    print(obj1)
    print(obj2)
    print(obj3)
    print(obj4)
    print(obj5)
    print(obj6)

    })
}
shinyApp(ui = ui, server = server)