Нанесіть мітки на кінці рядків

76

У мене є такі дані ( temp.datдив. Кінцеву примітку для повних даних)

   Year State     Capex
1  2003   VIC  5.356415
2  2004   VIC  5.765232
3  2005   VIC  5.247276
4  2006   VIC  5.579882
5  2007   VIC  5.142464
...

і я можу скласти таку діаграму:

ggplot(temp.dat) + 
  geom_line(aes(x = Year, y = Capex, group = State, colour = State))

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

Замість легенди я хотів би, щоб були етикетки

  1. забарвлений так само, як і серія
  2. праворуч від останньої точки даних для кожної серії

Я помітив коментарі баптиста у відповіді в наступному посиланні, але коли я намагаюся адаптувати його код ( geom_text(aes(label = State, colour = State, x = Inf, y = Capex), hjust = -1)), текст не з'являється.

ggplot2 - анотувати поза сюжетом

temp.dat <- structure(list(Year = c("2003", "2004", "2005", "2006", "2007", 
"2008", "2009", "2010", "2011", "2012", "2013", "2014", "2003", 
"2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", 
"2012", "2013", "2014", "2003", "2004", "2005", "2006", "2007", 
"2008", "2009", "2010", "2011", "2012", "2013", "2014", "2003", 
"2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", 
"2012", "2013", "2014"), State = structure(c(1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("VIC", 
"NSW", "QLD", "WA"), class = "factor"), Capex = c(5.35641472365348, 
5.76523240652641, 5.24727577535625, 5.57988239709746, 5.14246402568366, 
4.96786288162828, 5.493190785287, 6.08500616799372, 6.5092228474591, 
7.03813541623157, 8.34736513875897, 9.04992300432169, 7.15830329914056, 
7.21247045701994, 7.81373928617117, 7.76610217197542, 7.9744994967006, 
7.93734452080786, 8.29289899132255, 7.85222269563982, 8.12683746325074, 
8.61903784301649, 9.7904327253813, 9.75021175267288, 8.2950673974226, 
6.6272705639724, 6.50170524635367, 6.15609626379471, 6.43799637295979, 
6.9869551384028, 8.36305663640294, 8.31382617231745, 8.65409824343971, 
9.70529678167458, 11.3102788081848, 11.8696420977237, 6.77937303542605, 
5.51242844820827, 5.35789621712839, 4.38699327451101, 4.4925792218211, 
4.29934654081527, 4.54639175257732, 4.70040615159951, 5.04056109514957, 
5.49921208937735, 5.96590909090909, 6.18700407463007)), class = "data.frame", row.names = c(NA, 
-48L), .Names = c("Year", "State", "Capex"))
r  ggplot2  legend 
— Х'ю
джерело
Я хотів би просто створити окремий фрейм даних, лише з тими даними, які ви хочете скласти так, geom_text(data = temp.dat[cumsum(table(temp.dat$State)), ], aes(label = State, colour = State, x = Year, y = Capex))але може бути і більше gg-способу робити
— rawr

Відповіді:

89

Щоб скористатися ідеєю Батіста, потрібно відключити відсікання. Але коли ви це робите, ви отримуєте сміття. Крім того, вам потрібно придушити легенду та, наприклад geom_text, вибрати Capex на 2014 рік та збільшити запас, щоб дати місце міткам. (Або ви можете налаштувати hjustпараметр для переміщення міток всередині панелі графіку.) Щось приблизно так:

library(ggplot2)
library(grid)

p = ggplot(temp.dat) + 
  geom_line(aes(x = Year, y = Capex, group = State, colour = State)) + 
  geom_text(data = subset(temp.dat, Year == "2014"), aes(label = State, colour = State, x = Inf, y = Capex), hjust = -.1) +
  scale_colour_discrete(guide = 'none')  +    
  theme(plot.margin = unit(c(1,3,1,1), "lines")) 

# Code to turn off clipping
gt <- ggplotGrob(p)
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)

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

Але для цього ідеально підходить сюжет directlabels.

library(ggplot2)
library(directlabels)

ggplot(temp.dat, aes(x = Year, y = Capex, group = State, colour = State)) + 
  geom_line() +
  scale_colour_discrete(guide = 'none') +
  scale_x_discrete(expand=c(0, 1)) +
  geom_dl(aes(label = State), method = list(dl.combine("first.points", "last.points")), cex = 0.8)

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

Редагувати Щоб збільшити простір між кінцевою точкою та мітками:

ggplot(temp.dat, aes(x = Year, y = Capex, group = State, colour = State)) + 
  geom_line() +
  scale_colour_discrete(guide = 'none') +
  scale_x_discrete(expand=c(0, 1)) +
  geom_dl(aes(label = State), method = list(dl.trans(x = x + 0.2), "last.points", cex = 0.8)) +
  geom_dl(aes(label = State), method = list(dl.trans(x = x - 0.2), "first.points", cex = 0.8))
— Сенді Муспратт
джерело
4
Не знав про directlabelsпакет. Я не міг побачити в документації способу вручну збільшити горизонтальний простір між кінцевими точками та текстовою міткою. Який найкращий спосіб це зробити?
— Х'ю,
Я додав редагування. Див. Поширені запитання (номер 5) на http://directlabels.r-forge.r-project.org/
— Сенді Муспратт,
Спроба встановити пакет: package ‘directlabels’ is not available (for R version 3.3.2). Я також не можу знайти веб-сайт із поширеними запитаннями щодо пакету. Це ще живе?
— MERose
@MERose Хм. Я не впевнений, що відбувається. Посилання все ще живе. "Часті запитання" знаходиться на першій сторінці. І я щойно перевірив cran - прямі ярлики доступні.
— Sandy Muspratt
@slhck, схоже, він не встановлений. Ви пробували встановити quadprog?
— Сенді
74

Новішим рішенням є використання ggrepel:

library(ggplot2)
library(ggrepel)
library(dplyr)

temp.dat %>%
  mutate(label = if_else(Year == max(Year), as.character(State), NA_character_)) %>%
  ggplot(aes(x = Year, y = Capex, group = State, colour = State)) + 
  geom_line() + 
  geom_label_repel(aes(label = label),
                  nudge_x = 1,
                  na.rm = TRUE)

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

— Х'ю
джерело
7
Ідеально - але я додав "scale_color_discrete (guide = FALSE)", щоб видалити тепер непотрібні легенди із зовнішньої сторони діаграми (збереження важливої ​​нерухомості екрану)
— juhariis
Привіт, ти можеш розширити його до цього випадку: stackoverflow.com/questions/48487713/… ?
— Геркулес Апергіс
25

Це питання давнє, але золоте, і я даю ще одну відповідь для втомлених людей ggplot.

Принцип цього рішення можна застосувати досить загально.

Plot_df <- 
  temp.dat %>% mutate_if(is.factor, as.character) %>%  # Who has time for factors..
  mutate(Year = as.numeric(Year))

І тепер ми можемо підгрупувати наші дані

ggplot() + 
geom_line(data = Plot_df, aes(Year, Capex, color = State)) +
geom_text(data = Plot_df %>% filter(Year == last(Year)), aes(label = State, 
                                                           x = Year + 0.5, 
                                                           y = Capex, 
                                                           color = State)) + 
          guides(color = FALSE) + theme_bw() + 
          scale_x_continuous(breaks = scales::pretty_breaks(10))

Остання частина pretty_breaks полягає лише у фіксації осі нижче.

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

— Нік
джерело
8

Не впевнений, що це найкращий спосіб, але ви можете спробувати наступне (трохи пограйте, xlimщоб правильно встановити обмеження):

library(dplyr)
lab <- tapply(temp.dat$Capex, temp.dat$State, last)
ggplot(temp.dat) + 
    geom_line(aes(x = Year, y = Capex, group = State, colour = State)) +
    scale_color_discrete(guide = FALSE) +
    geom_text(aes(label = names(lab), x = 12, colour = names(lab), y = c(lab), hjust = -.02))

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

— DatamineR
джерело
2
З’являється повідомлення про помилку: «Помилка: Естетика повинна бути довжиною 1 або такою ж, як дані (48): x, y, label, hjust»
— invictus
3

Ви не імітували розчин @ Baptiste на 100%. Вам потрібно використовувати annotation_customта прокрутити всі ваші Capex:

library(ggplot2)
library(dplyr)
library(grid)

temp.dat <- structure(list(Year = c("2003", "2004", "2005", "2006", "2007", 
"2008", "2009", "2010", "2011", "2012", "2013", "2014", "2003", 
"2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", 
"2012", "2013", "2014", "2003", "2004", "2005", "2006", "2007", 
"2008", "2009", "2010", "2011", "2012", "2013", "2014", "2003", 
"2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", 
"2012", "2013", "2014"), State = structure(c(1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("VIC", 
"NSW", "QLD", "WA"), class = "factor"), Capex = c(5.35641472365348, 
5.76523240652641, 5.24727577535625, 5.57988239709746, 5.14246402568366, 
4.96786288162828, 5.493190785287, 6.08500616799372, 6.5092228474591, 
7.03813541623157, 8.34736513875897, 9.04992300432169, 7.15830329914056, 
7.21247045701994, 7.81373928617117, 7.76610217197542, 7.9744994967006, 
7.93734452080786, 8.29289899132255, 7.85222269563982, 8.12683746325074, 
8.61903784301649, 9.7904327253813, 9.75021175267288, 8.2950673974226, 
6.6272705639724, 6.50170524635367, 6.15609626379471, 6.43799637295979, 
6.9869551384028, 8.36305663640294, 8.31382617231745, 8.65409824343971, 
9.70529678167458, 11.3102788081848, 11.8696420977237, 6.77937303542605, 
5.51242844820827, 5.35789621712839, 4.38699327451101, 4.4925792218211, 
4.29934654081527, 4.54639175257732, 4.70040615159951, 5.04056109514957, 
5.49921208937735, 5.96590909090909, 6.18700407463007)), class = "data.frame", row.names = c(NA, 
-48L), .Names = c("Year", "State", "Capex"))

temp.dat$Year <- factor(temp.dat$Year)

color <- c("#8DD3C7", "#FFFFB3", "#BEBADA", "#FB8072")

gg <- ggplot(temp.dat) 
gg <- gg + geom_line(aes(x=Year, y=Capex, group=State, colour=State))
gg <- gg + scale_color_manual(values=color)
gg <- gg + labs(x=NULL)
gg <- gg + theme_bw()
gg <- gg + theme(legend.position="none")

states <- temp.dat %>% filter(Year==2014)

for (i in 1:nrow(states))  {
  print(states$Capex[i])
  print(states$Year[i])
  gg <- gg + annotation_custom(
    grob=textGrob(label=states$State[i], 
                    hjust=0, gp=gpar(cex=0.75, col=color[i])),
    ymin=states$Capex[i],
    ymax=states$Capex[i],
    xmin=states$Year[i],
    xmax=states$Year[i])
}    

gt <- ggplot_gtable(ggplot_build(gg))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.newpage()
grid.draw(gt)

(Ви захочете змінити жовтий, якщо збережете білий фон.)

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

— hrbrmstr
джерело
3

Я хотів би додати рішення для випадків, коли у вас довші імена міток. У всіх запропонованих рішеннях мітки знаходяться в полотні сюжету, але якщо у вас довші імена, вони відрізаться. Ось як я вирішив цю проблему:

library(tidyverse)

# Make the "State" variable have longer levels
temp.dat <- temp.dat %>% 
    mutate(State = paste0(State, '-a-long-string'))

ggplot(temp.dat, aes(x = Year, y = Capex, color = State, group = State)) + 
    geom_line() +
    # Add labels at the end of the line
    geom_text(data = filter(temp.dat, Year == max(Year)),
              aes(label = State),
              hjust = 0, nudge_x = 0.1) +
    # Allow labels to bleed past the canvas boundaries
    coord_cartesian(clip = 'off') +
    # Remove legend & adjust margins to give more space for labels
    # Remember, the margins are t-r-b-l
    theme(legend.position = 'none',
          plot.margin = margin(0.1, 2.6, 0.1, 0.1, "cm"))

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

— jhelvy
джерело
Буду вдячний, якщо ви допоможете мені, якщо я хочу поставити якусь позначку або X або координати лише в одній точці, яка нижча (у цьому випадку, як я можу поставити якусь мітку на (2008, 5) у WA-a-long- рядок? Я буду вдячний за вашу відповідь!
— Stackuser
У своєму рішенні я фільтрую дані, щоб вибрати точні координати x та y, які я хочу для своїх міток. Оскільки я хотів, щоб вони були в кінці рядків, я використовував data = filter(temp.dat, Year == max(Year))всередині geom_text()дзвінка. У вашому випадку ви можете змінити фільтр на data = filter(temp.dat, Year == 2008, State = "WA"), який дасть вам лише мітку "WA" в позиції x 2008 року, і ви можете відрегулювати положення y, налаштувавши nudge_yпараметр уgeom_text()
— jhelvy
Я не розглядаю це як покращення, оскільки жорстке встановлення полів не є практичним. Наступне моє рішення нижче: temp.dat <- temp.dat%>% mutate (State = paste0 (State, '-a-long-string')) Plot_df <- temp.dat%>% mutate_if (is.factor, as .character)%>% mutate (Year = as.numeric (Year)) ggplot () + geom_line (data = Plot_df, aes (Year, Capex, color = State)) + geom_text (data = Plot_df%>% filter (Year == останній (Рік)), aes (мітка = Штат, x = Рік + 3, y = Капіт, колір = Штат), hjust = 1) + напрямні (color = FALSE) + theme_bw () + масштаб_x_безперервний (розриви = масштаби :: pretty_breaks (10))
— Нік
Не дуже впевнений, що робить поля жорсткого налаштування менш практичними, ніж обмеження жорсткого налаштування. Найкраще рішення змінює поля сюжету. Більша різниця, яку я бачу між своїм рішенням та вашим, полягає в тому, що в моєму рішенні вісь x зупиняється в останній точці даних, тоді як у вашій вона продовжується настільки, наскільки це необхідно, так що ім'я мітки поміщається всередині межі ділянки, де немає даних балів.
— jhelvy
@jhelvy Дві речі. По-перше, жорстке встановлення полів не простіше, ніж збільшення полів x (один вхід - 3 роки, що є інтуїтивно зрозумілим та простим. Поля - це 4 входи та неінтуїтивний). До останньої точки ви хочете, щоб вісь фігури розширилася - інакше ваші імена виходять за межі ваших тем, як у вашому рішенні (саме те, що ви не хочете). У моєму рішенні - назва все ще у вашій темі, ваша виходить на вулицю. Звичайно, це не ідеально. Рішення з найвищим рейтингом датоване (набагато обтяжливіше, ніж інші рішення тут) - а також має назви, що виходять за межі вибору теми.
— Нік
1

Я прийшов до цього питання, прагнучи позначити встановлену лінію (наприклад loess()) в останній встановленій точці, а не в останній точці даних. Врешті-решт я розробив підхід для цього, в основному заснований на tidyverse. Він також повинен працювати для лінійної регресії з декількома модифікаціями, тому я залишаю це тут для нащадків.

library(tidyverse)

temp.dat$Year <- as.numeric(temp.dat$Year)
temp.dat$State <- as.character(temp.dat$State)

#example of loess for multiple models
#https://stackoverflow.com/a/55127487/4927395

models <- temp.dat %>%
  tidyr::nest(-State) %>%
  dplyr::mutate(
    # Perform loess calculation on each CpG group
    m = purrr::map(data, loess,
                   formula = Capex ~ Year, span = .75),
    # Retrieve the fitted values from each model
    fitted = purrr::map(m, `[[`, "fitted")
  )

# Apply fitted y's as a new column
results <- models %>%
  dplyr::select(-m) %>%
  tidyr::unnest()

#find final x values for each group
my_last_points <- results %>% group_by(State) %>% summarise(Year = max(Year, na.rm=TRUE))

#Join dataframe of predictions to group labels
my_last_points$pred_y <- left_join(my_last_points, results)

# Plot with loess line for each group
ggplot(results, aes(x = Year, y = Capex, group = State, colour = State)) +
  geom_line(alpha = I(7/10), color="grey", show.legend=F) +
  #stat_smooth(size=2, span=0.3, se=F, show_guide=F)
  geom_point(size=1) +
  geom_smooth(se=FALSE)+
  geom_text(data = my_last_points, aes(x=Year+0.5, y=pred_y$fitted, label = State))

direct_label

— Марк Ніл
джерело
Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.