使用ggrepel标记单个点

yv5phkfx 于 2023-11-14 发布在其他

关注(0)|答案(3)|浏览(147)

我尝试使用geom_label_repel为图上的几个数据点添加标签。在这种情况下，它们恰好是箱线图上的离群值。我已经运行了大部分代码，我可以标记离群值，但由于某种原因，我得到了多个标签（等于整个数据集的样本大小）Map到该点。我希望这个离群值只有一个标签。
示例：

以下是我的数据：

dput(sus_dev_data)
structure(list(time_point = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L), .Label = c("3", "8", "12"), class = "factor"), 
    days_to_pupation = c(135L, 142L, 143L, 155L, 149L, 159L, 
    153L, 171L, 9L, 67L, 53L, 49L, 72L, 67L, 55L, 64L, 60L, 122L, 
    53L, 51L, 49L, 53L, 50L, 56L, 44L, 47L, 60L)), row.names = c(1L, 
2L, 3L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 
17L, 18L, 20L, 21L, 22L, 23L, 24L, 26L, 27L, 28L, 29L, 30L), class = "data.frame")

字符串
我的代码

####################################################################################################
# Time to pupation statistical analysis
####################################################################################################
## linear model
pupation_Model=lm(sus_dev_data$days_to_pupation~sus_dev_data$time_point)
pupationANOVA=aov(pupation_Model)
summary(pupationANOVA)
# Tukey test to study each pair of treatment :
pupationTUKEY <- TukeyHSD(x=pupationANOVA, which = 'sus_dev_data$time_point', 
                          conf.level=0.95)
## Function to generate significance labels on box plot
generate_label_df <- function(pupationTUKEY, variable){
  # Extract labels and factor levels from Tukey post-hoc 
  Tukey.levels <- pupationTUKEY[[variable]][,4]
  Tukey.labels <- data.frame(multcompLetters(Tukey.levels, reversed = TRUE)['Letters'])
  #I need to put the labels in the same order as in the boxplot :
  Tukey.labels$treatment=rownames(Tukey.labels)
  Tukey.labels=Tukey.labels[order(Tukey.labels$treatment) , ]
  return(Tukey.labels)
}
#generate labels using function
labels<-generate_label_df(pupationTUKEY , "sus_dev_data$time_point")
#rename columns for merging
names(labels)<-c('Letters','time_point')
# obtain letter position for y axis using means
pupationyvalue<-aggregate(.~time_point, data=sus_dev_data, max)
#merge dataframes
pupationfinal<-merge(labels,pupationyvalue) 
####################################################################################################
# Time to pupation plot
####################################################################################################
# Plot of data
(pupation_plot <- ggplot(sus_dev_data, aes(time_point, days_to_pupation)) +
  Alex_Theme +
  geom_boxplot(fill = "grey80", outlier.size = 0.75) +
  geom_text(data = pupationfinal, aes(x = time_point, y = days_to_pupation, 
                                      label = Letters),vjust=-2,hjust=.5, size = 4) +
  #ggtitle(expression(atop("Days to pupation"))) +
  labs(y = 'Days to pupation', x = 'Weeks post-hatch') +
  scale_y_continuous(limits = c(0, 200)) +
  scale_x_discrete(labels=c("3" = "13", "8" = "18",
                              "12" = "22")) +
    geom_label_repel(aes(x = 1, y = 9), 
                     label = '1')
)

型

来源：https://stackoverflow.com/questions/59687572/labeling-a-single-point-with-ggrepel

3条答案

按热度按时间

kknvjkwl1#

这里有一个简短的例子来演示这是怎么回事。本质上，你的标签是beng回收到与数据相同的长度。

df = data.frame(x=1:5, y=1:5)
ggplot(df, aes(x,y, color=x)) +
  geom_point() +
  geom_label_repel(aes(x = 1, y = 1), label = '1')

字符串

的数据
您可以通过为ggrepel提供新数据来覆盖它

ggplot(df, aes(x,y, color=x)) +
  geom_point() +
  geom_label_repel(data = data.frame(x=1, y=1), label = '1')

型

展开查看全部

赞(0）回复(0）举报 2023-11-14

igsr9ssn2#

根据您的数据，您有3个离群值（每组一个），您可以通过应用John Tukey对离群值的经典定义（上限：Q3+1.5IQR和下限：Q1-1.5IQR）手动识别它们（但您可以自由设置自己的规则来定义离群值）。您可以使用函数quantile和IQR来获得这些点。
在这里，我使用dplyr包将它们合并到管道序列中：

library(tidyverse)
Outliers <- sus_dev_data %>% group_by(time_point) %>% 
  mutate(Out_up = ifelse(days_to_pupation > quantile(days_to_pupation,0.75)+1.5*IQR(days_to_pupation), "Out","In"))%>%
  mutate(Out_Down = ifelse(days_to_pupation < quantile(days_to_pupation,0.25)-1.5*IQR(days_to_pupation), "Out","In")) %>%
  filter(Out_up == "Out" | Out_Down == "Out")
# A tibble: 3 x 4
# Groups:   time_point [3]
  time_point days_to_pupation Out_up Out_Down
  <fct>                 <int> <chr>  <chr>   
1 3                         9 In     Out     
2 8                       122 Out    In      
3 12                       60 Out    In

字符串
正如@dww所提到的，如果你想让你的离群值被单个标记，你需要传递一个新的嵌套框给geom_label_repel。所以，这里我们使用嵌套框Outliers来填充geom_label_repel函数：

library(ggplot2)
library(ggrepel)
ggplot(sus_dev_data, aes(time_point, days_to_pupation)) +
  #Alex_Theme +
  geom_boxplot(fill = "grey80", outlier.size = 0.75) +
  geom_text(data = pupationfinal, aes(x = time_point, y = days_to_pupation, 
                                      label = Letters),vjust=-2,hjust=.5, size = 4) +
  #ggtitle(expression(atop("Days to pupation"))) +
  labs(y = 'Days to pupation', x = 'Weeks post-hatch') +
  scale_y_continuous(limits = c(0, 200)) +
  scale_x_discrete(labels=c("3" = "13", "8" = "18",
                            "12" = "22")) +
  geom_label_repel(inherit.aes = FALSE, 
                   data = Outliers,
                   aes(x = time_point, y = days_to_pupation, label = "Out"))

型
你会得到下面的图表：
x1c 0d1x的数据
我希望它能帮助你弄清楚如何标记你所有的离群值。

展开查看全部

赞(0）回复(0）举报 2023-11-14

uqdfh47h3#

@asd-tm的答案given here很好，但是标签隐藏了一些点。为了避免这种情况，技巧在于为其他点添加一个空标签

library(ggplot2)
library(ggrepel)
dat <- rbind(
  mtcars[, c("wt", "mpg")],
  `my car` = c(2.5, 23.92395)
)
dat$label <- "" # the trick
dat$label[nrow(dat)] <- "My car prediction"
ggplot(dat, aes(wt, mpg, label = label)) +
  geom_point() + 
  geom_label_repel()

字符串
x1c 0d1x的数据

展开查看全部

赞(0）回复(0）举报 2023-11-14

我来回答

使用ggrepel标记单个点

3条答案

相关问题

热门标签

最新问答