如何使用 ggtern 包在三元图中的轴上添加标签?
How to add labels on axis in ternary diagram using ggtern package?
三元图如下图所示。我想在 R 中使用 ggtern 包添加 Z=60、Z=90 和 Y=60 的标签。
R代码link是
一个相当 "raw" 的解决方案是使用 grobs。
在找到包含 x、y 和 z 标签(最初放置在三角形的顶点)的文本 grobs 后,我们将每个标签移动到所需位置。
library(ggtern)
library(grid)
g <- data.frame(y=c(1,0,0),
x=c(0,1,.4),
z=c(0,0,.6), Series="Green")
p <- data.frame(y=c(1,0.475,0.6),
x=c(0,0.210,0),
z=c(0,0.315,.4), Series="Red")
q <- data.frame(y=c(0.575,0.475,0.0,0.0),
x=c(0.040,0.210,0.4,0.1),
z=c(0.385,0.315,0.6,0.9), Series="Yellow")
f <- data.frame(y=c(0.6,0.575,0.0,0.0),
x=c(0.0,0.040,0.1,0.0),
z=c(0.4,0.385,0.9,1.0), Series="Blue")
DATA = rbind(g, p, q, f)
p <- ggtern(data=DATA,aes(x,y,z)) +
geom_polygon(aes(fill=Series),alpha=.5,color="black",size=0.25) +
scale_fill_manual(values=as.character(unique(DATA$Series))) +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Region",title="Sample Filled Regions")+
xlab("X=60")+ylab("Y=60")+zlab("Z=90")
gt <- ggplot_gtable(ggplot_build(p))
grobPanel <- gt$grobs[[which(gt$layout$name == "panel")]]
grobLabels <- grobPanel$children[[length(grobPanel$children)]]
# X-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$x <- unit(0.6,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$y <- unit(0.1,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$gp$fontsize <- 14
# Y-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$x <- unit(0.7,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$y <- unit(0.6,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$gp$fontsize <- 14
# Z-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$x <- unit(0.75,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$y <- unit(0.1,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$gp$fontsize <- 14
grid.draw(gt)
这不是完美的答案,但我尝试通过 annotate
实现您想要的结果,如下所示:
ggtern(data=DATA,aes(x,y,z)) +
geom_polygon(aes(fill=Series),alpha=.5,color="black",size=0.25) +
scale_fill_manual(values=as.character(unique(DATA$Series))) +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Region",title="Sample Filled Regions") +
annotate(geom = 'text',
x = c(0.1, 1/3, 0.0),
y = c(0.0, 0.0, 1.5),
z = c(0.5, 1/3, 1.0),
angle = c(0, 0, 0),
vjust = c(2.5, 2.5, -1.5),
hjust = c(0.0, -0.2, 0.0),
label = c("Z=90","Z=60","Y=60"),
color = c("black","gray",'orange')) + # for inspection
theme_nomask() # allows drawing beyond the borders
这会产生下图:
三元图如下图所示。我想在 R 中使用 ggtern 包添加 Z=60、Z=90 和 Y=60 的标签。
R代码link是
一个相当 "raw" 的解决方案是使用 grobs。
在找到包含 x、y 和 z 标签(最初放置在三角形的顶点)的文本 grobs 后,我们将每个标签移动到所需位置。
library(ggtern)
library(grid)
g <- data.frame(y=c(1,0,0),
x=c(0,1,.4),
z=c(0,0,.6), Series="Green")
p <- data.frame(y=c(1,0.475,0.6),
x=c(0,0.210,0),
z=c(0,0.315,.4), Series="Red")
q <- data.frame(y=c(0.575,0.475,0.0,0.0),
x=c(0.040,0.210,0.4,0.1),
z=c(0.385,0.315,0.6,0.9), Series="Yellow")
f <- data.frame(y=c(0.6,0.575,0.0,0.0),
x=c(0.0,0.040,0.1,0.0),
z=c(0.4,0.385,0.9,1.0), Series="Blue")
DATA = rbind(g, p, q, f)
p <- ggtern(data=DATA,aes(x,y,z)) +
geom_polygon(aes(fill=Series),alpha=.5,color="black",size=0.25) +
scale_fill_manual(values=as.character(unique(DATA$Series))) +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Region",title="Sample Filled Regions")+
xlab("X=60")+ylab("Y=60")+zlab("Z=90")
gt <- ggplot_gtable(ggplot_build(p))
grobPanel <- gt$grobs[[which(gt$layout$name == "panel")]]
grobLabels <- grobPanel$children[[length(grobPanel$children)]]
# X-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$x <- unit(0.6,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$y <- unit(0.1,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[2]]$gp$fontsize <- 14
# Y-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$x <- unit(0.7,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$y <- unit(0.6,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[1]]$gp$fontsize <- 14
# Z-axes label
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$x <- unit(0.75,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$y <- unit(0.1,"npc")
gt$grobs[[which(gt$layout$name == "panel")]]$children[[length(grobPanel$children)]]$children[[3]]$gp$fontsize <- 14
grid.draw(gt)
这不是完美的答案,但我尝试通过 annotate
实现您想要的结果,如下所示:
ggtern(data=DATA,aes(x,y,z)) +
geom_polygon(aes(fill=Series),alpha=.5,color="black",size=0.25) +
scale_fill_manual(values=as.character(unique(DATA$Series))) +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Region",title="Sample Filled Regions") +
annotate(geom = 'text',
x = c(0.1, 1/3, 0.0),
y = c(0.0, 0.0, 1.5),
z = c(0.5, 1/3, 1.0),
angle = c(0, 0, 0),
vjust = c(2.5, 2.5, -1.5),
hjust = c(0.0, -0.2, 0.0),
label = c("Z=90","Z=60","Y=60"),
color = c("black","gray",'orange')) + # for inspection
theme_nomask() # allows drawing beyond the borders
这会产生下图: