Как я могу показать реальные значения (%) моих данных в ggtern?

Question

Я хотел бы получить примерно такой же результат, как показано в примере ниже.Я колеблюсь между этими двумя функциями, чтобы получить этот результат: geom_crosshair_tern и scale_X_continuous.

Гамильтон, Небраска, и Ферри, М. (2018).ggtern: троичные диаграммы с использованием ggplot2.Журнал статистического программного обеспечения, 87 (1), 1-17.https://doi.org/10.18637/jss.v087.c03

Вот сценарий, который я написал до сих пор:

points1 <- data.frame(
            rbind(c( 1,45,30,25),
                  c( 2,33,33,34),
                  c( 3,15,75,10)
            )
          )
colnames(points1) = c("IDPoint","X","Y","Z")

#geom_crosshair_tern version
base1 = ggtern(data=points1,aes(X,Y,Z)) +
  theme_bw() +
  tern_limits(labels=c(20,40,60,80,100), breaks=seq(0.2,1,by=0.2)) +
  theme_clockwise() +
  theme_showarrows() +
  labs(title  = "Test",Tarrow = "% X",Larrow = "% Y",Rarrow = "% Z") +
  theme(tern.axis.arrow=element_line(size=1,color="black")) +
  geom_point(shape=21,size=5,col="black",bg="slategray1") +
  geom_text(aes(label=IDPoint),color="black") +
  geom_crosshair_tern(lty=2)

Вот что я получаю с geom_crosshair_tern, но у меня есть две проблемы:

1. Я не знаю, как показать реальные значения моих данных;
2. Я не знаю, как поставить свои очки над geom_crosshair_tern.

Является ли scale_X_continuous функция более подходящая?Я безуспешно пробовал следующий скрипт.

points1 <- data.frame(
            rbind(c( 1,45,30,25),
                  c( 2,33,33,34),
                  c( 3,15,75,10)
            )
          )
colnames(points1) = c("IDPoint","X","Y","Z")

labFnc <- function(x,digits=2) format(round(unique(x),digits),digits=digits)

base1 = ggtern(data=points1,aes(X,Y,Z)) +
  scale_T_continuous(breaks=unique(points1$y),labels=labFnc(points1$y)+
  scale_L_continuous(breaks=unique(points1$x),labels=labFnc(points1$x)+
  scale_R_continuous(breaks=unique(points1$z),labels=labFnc(points1$z)+
  theme_bw() +
  tern_limits(labels=c(20,40,60,80,100), breaks=seq(0.2,1,by=0.2)) +
  theme_clockwise() +
  theme_showarrows() +
  labs(title  = "Test",Tarrow = "% X",Larrow = "% Y",Rarrow = "% Z") +
  theme(tern.axis.arrow=element_line(size=1,color="black")) +
  geom_point(shape=21,size=5,col="black",bg="slategray1") +
  geom_text(aes(label=IDPoint),color="black")

Answer 1

Вот еще один подход:

#Duplicate Original Data Frame
df = points1

#New Data frame
#NEW Variable to be used in text label
df$label = apply(df,1,function(row){
  sprintf("[%s,%s,%s]",row[2],row[3],row[4])
})

#NEW Color Variable to be mapped
df$color = as.factor(df$IDPoint)

#NEW Fill Variable to be mapped
df$fill  = as.factor(df$IDPoint)

#geom_crosshair_tern version
base2 = ggtern(data=df,aes(X,Y,Z,color=color,fill=fill)) + ## << color and fill global mappings
  theme_bw() +
  tern_limits(labels=c(20,40,60,80,100), breaks=seq(0.2,1,by=0.2)) +
  theme_clockwise() +
  theme_showarrows() +
  labs(title  = "Test",Tarrow = "% X",Larrow = "% Y",Rarrow = "% Z") +
  theme(tern.axis.arrow=element_line(size=1,color="black")) +

  geom_crosshair_tern(lty=2) +  ## <<< Order brought forward, so that the crosshair is under the points

  geom_point(shape=21,size=5,color='black') + ## << Black border on points
  geom_text(aes(label=IDPoint),color="black") +
  geom_text(aes(label=IDPoint),color="black") +

  geom_text(aes(label=sprintf("   %s",label)),size=3,hjust=0) + ## << NEW Text Geometry

  guides(fill='none',color='none') ## << Turn off legends for colour/fill

print(base2)

Answer 2

Исправьте вторую проблему размещения точек над geom_crosshair_tern, вам нужно изменить порядок геометрий, начав с geom_crosshair_tern, а затем точек.Чтобы печатать за пределами треугольника, вам нужно добавить theme_nomask к вызовам при построении графика, тогда нужно поиграться с vjust и hjust для правильного размещения этикетки.

library(ggtern)

points1 <- data.frame(
  rbind(c( 1,45,30,25),
        c( 2,33,33,34),
        c( 3,15,75,10)
  )
)
colnames(points1) = c("IDPoint","X","Y","Z")

labFnc <- function(x,digits=2) format(round(unique(x),digits),digits=digits)

#geom_crosshair_tern version


base2 = ggtern(data=points1,aes(X,Y,Z)) +
  theme_bw() +
  geom_crosshair_tern(lty=2)+
  tern_limits(labels=c(20,40,60,80,100), breaks=seq(0.2,1,by=0.2)) +
  theme_clockwise() +
  theme_showarrows() +
  theme_nomask() + 
  labs(title  = "Test",Tarrow = "% Y",Larrow = "% X",Rarrow = "% Z") +
  theme(tern.axis.arrow=element_line(size=1,color="black")) +
  geom_point(shape=21,size=5,col="black",bg="slategray1") +
  geom_text(aes(label=IDPoint), color="black") +
    annotate(geom  = 'text',
                x     = points1$X,
                y     = c(0),
                z     = 100-points1$X,
                vjust = c(-0., -0., -0.),
                hjust = c(-0.25, -0.25, -0.25),
                angle = c(-60,-60,-60),
                label = paste("X=",points1$X)) +
    annotate(geom  = 'text',
           x     = 100-points1$Y,
           y     = points1$Y,
           z     = c(0),
           vjust = c(+0.25, 0.25, 0.25),
           hjust = c(1, +1, 1),
           label = paste("Y=",points1$Y)) +
    annotate(geom  = 'text',
           x     = c(0), 
           y     = 100-points1$Z,
           z     = points1$Z,
           vjust = c(+0.3, 0.3, 0.3),
           hjust = c(-0.25, -0.25, -0.25),
           angle = c(60,60,60),
           label = paste("Z=",points1$Z))  

print(base2)