在ggplot循环R中标记前10％的值

Question

更新 我将问题缩小到循环 i。因为如果我只在下面的代码中使用特定的列（“b”），它就可以工作。有谁知道 i 有什么问题以及为什么循环不起作用？

我有一个大型数据集，我在其中循环多个列以创建图表。我想在图中为 i 标记前 10% 的点（然后是最低的 10%）。我已经尝试了很多，但无法弄清楚如何只标记热门歌曲。标签名称应与“标签”列对应

在示例中，我使用 gghighlight 进行了尝试，但不起作用。

## loading packages
library("ggplot2")
library("purrr")
library("ggbeeswarm")
library("gghighlight")

## creating data
group <- c("Control", "PAD", "Control", "PAD", "PAD", "Control", "PAD", "Control", "PAD", "PAD", "Control", "PAD", "Control", "PAD", "PAD")
label <- (1:15)
b <- round(runif(15, 1, 7))
c <- round(runif(15, 1, 3))
d <- round(runif(15, 3, 8))
e <- round(runif(15, 1, 5))
event <- c("no event", "event", "no event", "no event", "no event", "no event", "event", "no event", "no event", "no event", "no event", "no event", "no event", "event", "event")

df <- data.frame(group, label, b, c, d, e, event)
df

rm(group, label, b, c, d, e, event)

# add color coding to the dataset
df$color <- "color"
for (i in 1:dim(df)[1]) {
  if (df$group[i] == "Control") {
    df$color[i] <- "Control"
  }
}
for (i in 1:dim(df)[1]) {
  if (df$group[i] == "PAD" && df$event[i] == "event") {
    df$color[i] <- "PAD with event"
  }
}
for (i in 1:dim(df)[1]) {
  if (df$group[i] == "PAD" && df$event[i] == "no event") {
    df$color[i] <- "PAD without event"
  }
}

rm(i)
## this is where i am having issues
for (i in names(df)[1:4]){
ggplot(df, aes_string("group", "b")) + 
  geom_boxplot(show.legend = F) + 
  geom_beeswarm(aes(color = color), size=2) +
  scale_color_manual(values= c("Control"="#107f40", "PAD with event" = "#D85622", "PAD without event"="#2D416D")) +
  geom_text(aes(label=ifelse(b>quantile(b, 0.9, type=2, na.rm = TRUE), as.numeric(label),'')))

}

我没有收到错误消息，但它标记了所有值，而不仅仅是顶部匹配。此外，标签未设置为“标签”列，而是设置为分组。
请在下面找到一个示例我希望如何查看标签的示例（仅在热门点击中）

Answer 1

也许以下内容可以满足问题的要求。
它首先重新格式化数据，然后在构面中绘制所有箱须图。
要点是使用ggrepel::geom_label_repel 使标签远离点。

library(tidyverse)
library(ggplot2)
library(ggrepel)

df2 <- df %>%
  select(-event) %>%
  gather(key, value, -group, -label, -color) %>%
  group_by(group, key) %>%
  mutate(flag = value >= quantile(value, 0.9, type = 2))

g <- ggplot(df2, aes(x = group, y = value, color = color)) + 
  geom_boxplot(show.legend = FALSE) + 
  scale_color_manual(values= c("Control"="#107f40", "PAD with event" = "#D85622", "PAD without event"="#2D416D")) +
  geom_point(data = df2 %>% filter(flag), show.legend = FALSE) +
  geom_label_repel(data = df2 %>% filter(flag) %>% unique(), 
             aes(label = label),
             color = "black") +
  facet_wrap(~ key)

g

数据创建代码。

我重新发布问题中的代码，以通过设置 RNG 种子使其可重现。

set.seed(1234)    # Make the results reproducible

group <- c("Control","PAD","Control","PAD","PAD", "Control","PAD","Control","PAD","PAD", "Control","PAD","Control","PAD","PAD")
label <- 1:15
b <- round(runif(15, 1, 7)) 
c <- round(runif(15, 1, 3)) 
d <- round(runif(15, 3, 8)) 
e <- round(runif(15, 1, 5))
event <- c("no event", "event" , "no event" , "no event" , "no event", "no event", "event", "no event", "no event" , "no event" , "no event" , "no event", "no event", "event", "event")

df <- data.frame(group, label, b,c,d, e, event)
df

rm(group, label, b, c, d, e, event)

df$color <- "color"
for (i in 1:dim(df)[1]){
  if (df$group[i]=="Control") {
    df$color[i] <- "Control" 
  }
  if (df$group[i] == "PAD" && df$event[i] == "event") {
    df$color[i] <- "PAD with event" 
  }
  if (df$group[i] == "PAD" && df$event[i] == "no event") {
    df$color[i] <- "PAD without event"
  }
}

Answer 2

pdf("labels_test.pdf", width = 15)
for(i in 1:42) {
print(ggplot(df2, aes(x = event, y = value, color = color)) + 
  geom_boxplot(show.legend = FALSE) + 
  scale_color_manual(values= c("PAD with event" = "#D85622", "PAD without event"="#2D416D")) +
  geom_point(data = df2 %>% filter(flag), show.legend = FALSE) +
  geom_label_repel(data = df2 %>% filter(flag) %>% unique(), 
                   aes(label = Study_no),
                   color = "black") +
  facet_wrap_paginate(~ key, ncol = 2, nrow = 2, page = i))
}
dev.off()