Как бы мне ни понравился ответ @JD Long, я положу ответ, который находится только в R / ggplot2.
Подход состоит в том, чтобы создать второй набор данных о событиях и использовать его для определения позиций.,Начиная с того, что имел @Angelo:
library(ggplot2)
data(presidential)
data(economics)
Извлеките данные о событии (президентские) и преобразуйте их.Вычислите baseline
и offset
как доли экономических данных, с которыми они будут нанесены.Установите нижнюю часть (ymin
) до базовой линии.Это где сложная часть приходит.Нам нужно иметь возможность разбивать метки, если они расположены слишком близко друг к другу.Поэтому определите расстояние между соседними метками (предполагается, что события отсортированы).Если это меньше некоторого количества (я выбрал около 4 лет для этой шкалы данных), то обратите внимание, что этот ярлык должен быть выше.Но он должен быть выше, чем тот, что после него, поэтому используйте rle
, чтобы получить длину TRUE
(то есть должно быть больше) и вычислить вектор смещения, используя это (каждая строка TRUE
должнаотсчет от его длины до 2, FALSE
с просто смещением 1).Используйте это, чтобы определить вершину баров (ymax
).
events <- presidential[-(1:3),]
baseline = min(economics$unemploy)
delta = 0.05 * diff(range(economics$unemploy))
events$ymin = baseline
events$timelapse = c(diff(events$start),Inf)
events$bump = events$timelapse < 4*370 # ~4 years
offsets <- rle(events$bump)
events$offset <- unlist(mapply(function(l,v) {if(v){(l:1)+1}else{rep(1,l)}}, l=offsets$lengths, v=offsets$values, USE.NAMES=FALSE))
events$ymax <- events$ymin + events$offset * delta
Соберите это вместе в сюжет:
ggplot() +
geom_line(mapping=aes(x=date, y=unemploy), data=economics , size=3, alpha=0.5) +
geom_segment(data = events, mapping=aes(x=start, y=ymin, xend=start, yend=ymax)) +
geom_point(data = events, mapping=aes(x=start,y=ymax), size=3) +
geom_text(data = events, mapping=aes(x=start, y=ymax, label=name), hjust=-0.1, vjust=0.1, size=6) +
scale_x_date("time") +
scale_y_continuous(name="unemployed \[1000's\]")
Выможет огранить, но это сложно с разными масштабами.Другой подход состоит в составлении двух графиков.Необходимо выполнить некоторые дополнительные действия, чтобы убедиться, что графики имеют одинаковый диапазон x, чтобы все метки помещались на нижнем графике, а также чтобы исключить ось x на верхнем графике.
xrange = range(c(economics$date, events$start))
p1 <- ggplot(data=economics, mapping=aes(x=date, y=unemploy)) +
geom_line(size=3, alpha=0.5) +
scale_x_date("", limits=xrange) +
scale_y_continuous(name="unemployed [1000's]") +
opts(axis.text.x = theme_blank(), axis.title.x = theme_blank())
ylims <- c(0, (max(events$offset)+1)*delta) + baseline
p2 <- ggplot(data = events, mapping=aes(x=start)) +
geom_segment(mapping=aes(y=ymin, xend=start, yend=ymax)) +
geom_point(mapping=aes(y=ymax), size=3) +
geom_text(mapping=aes(y=ymax, label=name), hjust=-0.1, vjust=0.1, size=6) +
scale_x_date("time", limits=xrange) +
scale_y_continuous("", breaks=NA, limits=ylims)
#install.packages("ggExtra", repos="http://R-Forge.R-project.org")
library(ggExtra)
align.plots(p1, p2, heights=c(3,1))