Группировка уровней фактора, чтобы избежать перекрытия в ggplot2

Я делаю своего рода линейный график с помощью ggplot2 и сталкиваюсь с проблемой наложения текстовых меток друг на друга. Я также использовал пакет geom_text_repel, чтобы избежать наложения текста, но он становится все более беспорядочным, так как все больше и больше уровней факторов имеют смежные средние значения. Я предоставил ниже пример кода, а также данные, используемые в основном.

Category    Dimension1
AcademicWriting -0.7
Brd.Discussions 0.6
Brd.Interviews  -2.4
Brd.News    8.3
Brd.Talks   0
BusinessLetters 2.4
ClassLessons    0.2
Commentaries    -12.9
Comments    -1.2
CreativeWriting 1.4
Documentaries   -1.4
F2FConversations    -1.8
FBGroups    0.4
FBSt.Updates    -1
Ind.Blogs   0.1
Inst.Writing    0.9
NBrd.Talks  -0.1
NewsBlogs   0.4
NewsReports 7.1
Pol.Debates -1.4
PopularWriting  0.5
PressEditorials 1.8
SocialLetters   0.6
Speeches    3
StudentWriting  -2
TechBlogs   1.7
ThesesPresentations -0.8
Tweets  -2.8

И код:

library(ggplot2)
library(ggrepel)
library(extrafont)
loadfonts(device = "win")
plot_graph <- function(d1, label_below = "", label_above = "")
{
  d1 <- d1[order(-d1[,2]),]
  d1$X <- rep(0, each=length(d1$Dimension1))
  attach(d1)
  plot1 <- ggplot(data=d1, aes(x=X, y=Dimension1, label=Category)) +
    geom_point() +
    geom_text_repel(aes(label=Category), direction = "x", family="Times New Roman", size=4, max.iter = 2e2) +
    theme_bw()+
    theme(axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))+
    theme(text=element_text(family="Times New Roman"), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), axis.text.x = element_blank(), axis.ticks.x = element_blank()) +
    geom_vline(xintercept = 0, linetype = 1) +
    coord_cartesian(xlim = c(-3, 3)) +
    geom_segment(aes(x = -2, y = 5+min(Dimension1), xend = -2, yend = max(Dimension1)-5), arrow = arrow(ends = "both"), alpha=0.5, size=0.5) +
    geom_text(aes(x = -2, y = 6+min(Dimension1), label = label_below)) +
    geom_text(aes(x = -2, y = max(Dimension1)-4, label = label_above))
  detach(d1)
  plot1
}

plot4 <- plot_graph(d1 = d1, label_below = "", label_above = "")
plot4

В результате получается следующий график: введите здесь описание изображения Посмотрев несколько похожих тем, я не знаю, есть ли решение этой проблемы. Но у меня есть идея сгруппировать уровни факторов, то есть метки в соответствии с их соседними средними баллами, например. AcademicWriting, FBSt.Updates (1-й и 7-й уровни фактора в примере) могут быть сгруппированы вместе после округления их соответствующих средних баллов до -1. И они могли отображаться в горизонтальной строке, разделенной запятой. Но я не могу придумать, как их сгруппировать. Вот почему я прошу вашей помощи или любого другого способа решить проблему перекрытия.


r graph ggplot2 ggrepel
person Shakir    schedule 01.11.2017    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Вот идея:

разрежьте столбец Dimension1 на столько групп, сколько хотите, сгруппируйте по сформированной переменной разреза, вставьте имена категорий и рассчитайте координату y. Я сопоставил текст и точки одного цвета, но это не обязательно.

library(tidyverse)

d1 %>% 
  arrange(desc(Dimension1)) %>%
  mutate(cut = cut(Dimension1, 32),
         X = 0) %>%
  group_by(cut) %>%
  mutate(label = paste(Category, collapse = ", "),
         coord = mean(Dimension1),
         label2 = ifelse(duplicated(label), NA, label)) %>%
  ungroup() %>%
  ggplot(aes(x=X, y=Dimension1, label=Category, color = label)) +
  geom_segment(aes(x = -0.25, y = 5 + min(Dimension1), xend = -0.25, yend = max(Dimension1)-5), arrow = arrow(ends = "both"), alpha=0.5, size=0.5)+
  geom_point() +
  geom_text(aes(label=label2, x = X+0.05, y = coord, color = label), family="Times New Roman", size=4, hjust = 0) +
  theme_bw()+
  theme(axis.text.x = element_text(colour="black"),
        axis.text.y = element_text(colour="black"))+
  theme(text=element_text(family="Times New Roman"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        legend.position="none") +
  geom_vline(xintercept = 0, linetype = 1) +
  coord_cartesian(xlim = c(-0.5, 3))

введите здесь описание изображения

person missuse    schedule 01.11.2017
comment
Спасибо. Я посмотрю на это, чтобы увидеть, что еще я могу сделать. - person Shakir; 01.11.2017