ggplot2에서 ggproto 함수를 사용하여 플롯의 범례를 수정하는 방법은 무엇입니까?

Question

주성분 분석에서, 나는 산란 음모에 대한 prcomp()의 구성 요소 결과를 추출합니다. 그룹 이름의 레이블을 추가하려면 각 그룹의 중심이 MASS::cov.trob()을 사용하여 각 그룹에서 계산됩니다. 각 그룹의 레이블을 표시하기 위해 새 통계를 만들고 ggplot2::ggproto()을 사용하여 새 기하 구조를 다시 작성합니다. 그러나 새로운 그래프는 전설이 아닌 점 전설이어야하기 때문에 불합리한 전설을 가지고 있습니다. 나는이 여러 변형을 시도했지만, 그들 중 누구도 작동하지 않는 것 같습니다. 어떤 아이디어? 나는 그것이 어떤 점을 플롯하지 않기 때문에 전설에 새 통계 쇼 지점이 매우 자연있을 거라고 생각하지 않습니다

# data 
data(Cars93, package = "MASS") 
car_df <- Cars93[, c(3, 5, 13:15, 17, 19:25)] 
car_df <- subset(car_df, Type == "Large" | Type == "Midsize" | Type == "Small") 
x1 <- mean(car_df$Price) + 2 * sd(car_df$Price) 
x2 <- mean(car_df$Price) - 2 * sd(car_df$Price) 
car_df <- subset(car_df, Price > x2 | Price < x1) 
car_df <- na.omit(car_df) 

# Principal Component Analysis 
car.pca <- prcomp(car_df[, -1], scale = T) 
car.pca_pre <- cbind(as.data.frame(predict(car.pca)[, 1:2]), car_df[, 1]) 
colnames(car.pca_pre) <- c("PC1", "PC2", "Type") 
head(car.pca_pre) 

# create a new stat 
library(ggplot2) 
StatLabel <- ggproto("StatLabel" ,Stat, 
       compute_group = function(data, scales) { 
       library(MASS) 
       df <- data.frame(data$x,data$y) 
       center <- cov.trob(df)$center 
       names(center)<- NULL 
       center <- t(as.data.frame(center)) 
       center <- as.data.frame(cbind(center)) 
       colnames(center) <- c("x","y") 
       rownames(center) <- NULL 
       return(center) 
       }, 
       required_aes = c("x", "y") 
) 

stat_label <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", 
    ..., parse = FALSE, nudge_x = 0, nudge_y = 0, label.padding = unit(0.15, 
     "lines"), label.r = unit(0.15, "lines"), label.size = 0.1, 
    na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) 
{ 
    if (!missing(nudge_x) || !missing(nudge_y)) { 
     if (!missing(position)) { 
      stop("Specify either `position` or `nudge_x`/`nudge_y`", 
       call. = FALSE) 
     } 
     position <- position_nudge(nudge_x, nudge_y) 
    } 
    layer(data = data, mapping = mapping, stat = StatLabel, geom = GeomLabel, 
     position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
     params = list(parse = parse, label.padding = label.padding, 
      label.r = label.r, label.size = label.size, na.rm = na.rm, 
      ...)) 
} 

# plot 
ggplot(car.pca_pre, aes(PC1, PC2, color = Type)) + geom_point() + 
stat_label(aes(label = Type)) 

Answer 1

: 여기 내 코드입니다. 스탠드가 그렇듯이 ggplot은 포인트와 텍스트가 결합 된 전설을 가지고있을 때 텍스트 전설보다 우선 순위가 높습니다. 가장 간단한 해결책은 기본적으로 레이블 통계에 대한 범례가없는 것입니다.

기능을 변경하여 show.legend = FALSE을 기본값으로 설정하면 플롯에 포인트 범례가 표시됩니다.

stat_label <- function (mapping = NULL, 
         data = NULL, 
         stat = "identity", 
         position = "identity", 
         ..., 
         parse = FALSE, 
         nudge_x = 0, nudge_y = 0, 
         label.padding = unit(0.15, "lines"), 
         label.r = unit(0.15, "lines"), 
         label.size = 0.1, 
         na.rm = FALSE, 
         show.legend = FALSE,  ## <--- change 
         inherit.aes = TRUE) 
{ 
    if (!missing(nudge_x) || !missing(nudge_y)) { 
    if (!missing(position)) { 
     stop("Specify either `position` or `nudge_x`/`nudge_y`", 
      call. = FALSE) 
    } 
    position <- position_nudge(nudge_x, nudge_y) 
    } 
    layer(data = data, mapping = mapping, stat = StatLabel, geom = GeomLabel, 
     position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
     params = list(parse = parse, label.padding = label.padding, 
         label.r = label.r, label.size = label.size, na.rm = na.rm, 
         ...)) 
} 

# plot 
ggplot(car.pca_pre, aes(PC1, PC2, color = Type)) + geom_point() + 
    stat_label(aes(label = Type))