Etiquetas de eje en dos líneas con variables x anidadas (año debajo de meses)
Me gustaría mostrar los meses (en forma abreviada) a lo largo del eje horizontal, con el año correspondiente impreso una vez. Sé cómo mostrar mes-año:
La repetición innecesaria del año abarrota las etiquetas. En lugar de eso me gustaría algo como esto:
excepto que el año se imprimiría debajo de los meses.
Imprimí el año encima de las etiquetas de los ejes, porque eso es lo mejor que pude hacer. Esto se debe a una limitación de la annotate()función, que se recorta si se encuentra fuera del área de trazado. Conozco posibles soluciones basadas en annotate_custom(), pero no pude hacer que funcionaran con objetos de fecha (no intenté convertir fechas en números y volver a fechas nuevamente, ya que parecía más complicado de lo que esperaba que fuera necesario).
Me pregunto si lo nuevo dup_axis()podría secuestrarse para este propósito. Si en lugar de enviar el eje duplicado al lado opuesto del panel, pudiera enviarlo unas líneas debajo del eje duplicado, entonces tal vez solo sería cuestión de configurar un eje con el espacio en panel.grid.majorblanco y las etiquetas configuradas en %b, mientras el otro eje se habría panel.grid.minorborrado y las etiquetas se habrían establecido en %Y. (un desafío adicional es que las etiquetas del año se cambiarían a octubre en lugar de enero)
Estas preguntas están relacionadas. Sin embargo, hasta donde yo sé, la annotate_custom()función y las funciones no funcionan bien con las fechas.textGrob()
¿Cómo-puedo-agregar-anotaciones-debajo-del-eje-x-en-ggplot2?
mostrando-texto-debajo-de-la-trama-generada-por-ggplot2
Datos y código básico a continuación:
library("ggplot2")
library("scales")
ggplot(data = df, aes(x = Date, y = value)) + geom_line() +
scale_x_date(date_breaks = "2 month", date_minor_breaks = "1 month", labels = date_format("%b %Y")) +
xlab(NULL)
ggplot(data = df, aes(x = Date, y = value)) + geom_line() +
scale_x_date(date_minor_breaks = "2 month", labels = date_format("%b")) +
annotate(geom = "text", x = as.Date("1719-10-01"), y = 0, label = "1719") +
annotate(geom = "text", x = as.Date("1720-10-01"), y = 0, label = "1720") +
xlab(NULL)
# data
df <- structure(list(Date = structure(c(-91455, -91454, -91453, -91452,
-91451, -91450, -91448, -91447, -91446, -91445, -91444, -91443,
-91441, -91440, -91439, -91438, -91437, -91436, -91434, -91433,
-91431, -91430, -91429, -91427, -91426, -91425, -91424, -91423,
-91422, -91420, -91419, -91418, -91417, -91416, -91415, -91413,
-91412, -91411, -91410, -91409, -91408, -91406, -91405, -91404,
-91403, -91402, -91401, -91399, -91398, -91397, -91396, -91395,
-91394, -91392, -91391, -91390, -91389, -91388, -91387, -91385,
-91384, -91382, -91381, -91380, -91379, -91377, -91376, -91375,
-91374, -91373, -91372, -91371, -91370, -91369, -91368, -91367,
-91366, -91364, -91363, -91362, -91361, -91360, -91359, -91357,
-91356, -91355, -91354, -91353, -91352, -91350, -91349, -91348,
-91347, -91346, -91345, -91343, -91342, -91341, -91340, -91339,
-91338, -91336, -91335, -91334, -91333, -91332, -91331, -91329,
-91328, -91327, -91326, -91325, -91324, -91322, -91321, -91320,
-91319, -91315, -91314, -91313, -91312, -91311, -91310, -91308,
-91307, -91306, -91305, -91304, -91303, -91301, -91300, -91299,
-91298, -91297, -91296, -91294, -91293, -91292, -91291, -91290,
-91289, -91287, -91286, -91285, -91284, -91283, -91282, -91280,
-91279, -91278, -91277, -91276, -91275, -91273, -91272, -91271,
-91270, -91269, -91268, -91266, -91265, -91264, -91263, -91262,
-91261, -91259, -91258, -91257, -91256, -91255, -91254, -91252,
-91251, -91250, -91249, -91248, -91247, -91245, -91244, -91243,
-91242, -91241, -91240, -91238, -91237, -91236, -91235, -91234,
-91233, -91231, -91230, -91229, -91228, -91227, -91226, -91224,
-91223, -91222, -91221, -91220, -91219, -91217, -91216, -91215,
-91214, -91213, -91212, -91210, -91209, -91208, -91207, -91205,
-91201, -91200, -91199, -91198, -91196, -91195, -91194, -91193,
-91192, -91191, -91189, -91188, -91187, -91186, -91185, -91184,
-91182, -91181, -91180, -91179, -91178, -91177, -91175, -91174,
-91173, -91172, -91171, -91170, -91168, -91167, -91166, -91165,
-91164, -91163, -91161, -91160, -91159, -91158, -91157, -91156,
-91154, -91153, -91152, -91151, -91150, -91149, -91147, -91146,
-91145, -91144, -91143, -91142, -91140, -91139, -91138, -91131,
-91130, -91129, -91128, -91126, -91125, -91124, -91123, -91122,
-91121, -91119, -91118, -91117, -91116, -91115, -91114, -91112,
-91111, -91110, -91109, -91108, -91107, -91104, -91103, -91102,
-91101, -91100, -91099, -91097, -91096, -91095, -91094, -91093,
-91091, -91090, -91089, -91088, -91087, -91086, -91084, -91083,
-91082, -91081, -91080, -91079, -91077, -91076, -91075, -91074,
-91073, -91072, -91070, -91069, -91068, -91065, -91063, -91062,
-91061, -91060, -91059, -91058, -91056, -91055, -91054, -91053,
-91052, -91051, -91049, -91048, -91047, -91046, -91045, -91044,
-91042, -91041, -91040, -91039, -91038, -91037, -91035, -91034,
-91033, -91032, -91031, -91030, -91028, -91027, -91026, -91025,
-91024, -91023, -91021, -91020, -91019, -91018, -91017, -91016,
-91014, -91013, -91012, -91011, -91010, -91009, -91007, -91006,
-91005, -91004, -91003, -91002, -91000, -90999, -90998, -90997,
-90996, -90995, -90993, -90992, -90991, -90990, -90989, -90988,
-90986, -90985, -90984, -90983, -90982), class = "Date"), value = c(113,
113, 113, 113, 114, 114, 114, 115, 115, 115, 116, 116, 116, 116,
117, 117, 117, 117, 116, 117, 116, 116, 116, 117, 117, 117, 117,
117, 117, 117, 116, 117, 116, 116, 116, 117, 117, 117, 117, 117,
117, 117, 116, 116, 117, 117, 117, 117, 117, 117, 117, 117, 117,
117, 117, 118, 118, 118, 118, 117, 118, 117, 117, 117, 117, 117,
117, 118, 116, 116, 116, 116, 116, 116, 116, 117, 117, 118, 118,
118, 118, 118, 119, 120, 120, 119, 119, 120, 120, 121, 121, 122,
124, 124, 122, 123, 124, 123, 123, 123, 123, 123, 124, 124, 126,
126, 126, 126, 126, 125, 125, 126, 127, 126, 126, 125, 126, 126,
126, 128, 128, 128, 130, 133, 131, 133, 134, 134, 134, 136, 136,
136, 135, 135, 135, 136, 136, 136, 136, 135, 135, 135, 135, 130,
129, 129, 130, 131, 136, 138, 155, 157, 161, 170, 174, 168, 165,
169, 171, 181, 184, 182, 179, 181, 179, 175, 177, 177, 174, 170,
174, 173, 178, 173, 178, 179, 182, 184, 184, 180, 181, 182, 182,
184, 184, 188, 195, 198, 220, 255, 275, 350, 310, 315, 320, 320,
316, 300, 310, 310, 320, 317, 313, 312, 310, 297, 285, 285, 286,
288, 315, 328, 338, 344, 345, 352, 352, 342, 335, 343, 340, 342,
339, 337, 336, 336, 342, 347, 352, 352, 351, 352, 352, 351, 352,
352, 355, 375, 400, 452, 487, 476, 475, 473, 485, 500, 530, 595,
720, 720, 770, 750, 770, 750, 735, 740, 745, 735, 700, 700, 750,
760, 755, 755, 760, 760, 765, 950, 950, 950, 875, 875, 875, 880,
880, 880, 900, 900, 900, 880, 880, 890, 895, 890, 880, 870, 870,
870, 870, 870, 860, 860, 860, 860, 850, 840, 810, 820, 810, 810,
805, 810, 805, 820, 815, 820, 805, 790, 800, 780, 760, 765, 750,
740, 820, 810, 800, 800, 775, 750, 810, 750, 740, 700, 705, 660,
630, 640, 595, 590, 570, 565, 535, 440, 400, 410, 400, 405, 390,
370, 300, 300, 180, 200, 310, 290, 260, 260, 275, 260, 270, 265,
255, 250, 210, 210, 200, 195, 210, 215, 240, 240, 220, 220, 220,
220, 210, 212, 208, 220, 210, 212, 208, 220, 215, 220, 214, 214,
213, 212, 210, 210, 195, 195, 160, 160, 175, 205, 210, 208, 197,
181, 185)), .Names = c("Date", "value"), row.names = c(NA, 393L
), class = "data.frame")
El siguiente código proporciona dos opciones potenciales para agregar etiquetas de año.
Opción 1a: Facetado
Podrías usar facetas para marcar los años. Por ejemplo:
library(ggplot2)
library(lubridate)
ggplot(df, aes(Date, value)) +
geom_line() +
scale_x_date(date_labels="%b", date_breaks="month", expand=c(0,0)) +
facet_grid(~ year(Date), space="free_x", scales="free_x", switch="x") +
theme_bw() +
theme(strip.placement = "outside",
strip.background = element_rect(fill=NA,colour="grey50"),
panel.spacing=unit(0,"cm"))
Tenga en cuenta que con este enfoque, si faltan fechas al principio o al final de un año (por "faltantes" me refiero a que las filas para esas fechas ni siquiera están presentes en los datos), entonces el eje x comenzará/finalizará en el primera/última fecha en los datos de ese año, en lugar de ir del 1 de enero al 31 de diciembre. En ese caso, deberá agregar filas para las fechas que faltan y NApara valueo interpolar value. Además, con este método no hay espacio ni línea entre el 31 de diciembre de un año y el 1 de enero del año siguiente, por lo que hay una discontinuidad entre cada año.
Opción 1b: Facetado + etiquetas de mes centradas
Para abordar el comentario de @ AF7. Puede centrar las etiquetas de los meses agregando algunos espacios antes de cada etiqueta. Pero debes elegir la cantidad de espacios manualmente, dependiendo del tamaño físico del gráfico cuando lo imprimas en un dispositivo. (Probablemente haya una manera de centrar las etiquetas mediante programación según las medidas internas del grob, pero no estoy seguro de cómo hacerlo). También eliminé las líneas de cuadrícula verticales menores y aligeré la línea entre años.
ggplot(df, aes(Date, value)) +
geom_line() +
scale_x_date(date_labels=paste(c(rep(" ",11), "%b"), collapse=""),
date_breaks="month", expand=c(0,0)) +
facet_grid(~ year(Date), space="free_x", scales="free_x", switch="x") +
theme_bw() +
theme(strip.placement = "outside",
strip.background = element_blank(),
panel.grid.minor.x = element_blank(),
panel.border = element_rect(colour="grey70"),
panel.spacing=unit(0,"cm"))
Opción 2a: editar la etiqueta del eje x
Aquí hay un método más complejo y meticuloso (aunque probablemente podría ser automatizado por alguien que entienda la estructura y los espacios entre unidades de los gráficos de cuadrícula mejor que yo) que evita los inconvenientes del método de facetado descrito anteriormente:
library(grid)
# Fake data with an extra year added for illustration
set.seed(2)
df = data.frame(Date=seq(as.Date("1718-03-01"),as.Date("1721-09-20"), by="1 day"))
df$value = cumsum(rnorm(nrow(df)))
# The plot we'll start with
p = ggplot(df, aes(Date, value)) +
geom_vline(xintercept=as.numeric(df$Date[yday(df$Date)==1]), colour="grey60") +
geom_line() +
scale_x_date(date_labels="%b", date_breaks="month", expand=c(0,0)) +
theme_bw() +
theme(panel.grid.minor.x = element_blank()) +
labs(x="")
Ahora queremos sumar los valores de los años debajo y entre junio y julio de cada año. El siguiente código lo hace modificando la etiqueta grob del eje x y está adaptado de esta respuesta SO de @SandyMuspratt.
# Get the grob
g <- ggplotGrob(p)
# Get the y axis
index <- which(g$layout$name == "axis-b") # Which grob
xaxis <- g$grobs[[index]]
# Get the ticks (labels and marks)
ticks <- xaxis$children[[2]]
# Get the labels
ticksB <- ticks$grobs[[2]]
# Edit x-axis label grob
# Find every index of Jun in the x-axis labels and add a newline and
# then a year label
junes = which(ticksB$children[[1]]$label == "Jun")
ticksB$children[[1]]$label[junes] = paste0(ticksB$children[[1]]$label[junes],
"\n ", unique(year(df$Date)))
# Put the edited labels back into the plot
ticks$grobs[[2]] <- ticksB
xaxis$children[[2]] <- ticks
g$grobs[[index]] <- xaxis
# Draw the plot
grid.newpage()
grid.draw(g)
Opción 2b: editar la etiqueta del eje x y centrar las etiquetas del mes
A continuación se muestra el único cambio que se debe realizar en la Opción 2a para centrar las etiquetas de los meses, pero, una vez más, la cantidad de espacios debe modificarse manualmente.
# Make the edit
# Center the month labels between ticks
ticksB$children[[1]]$label = paste0(paste(rep(" ",7),collapse=""), ticksB$children[[1]]$label)
# Find every index of Jun in the x-axis labels and a year label
junes = grep("Jun", ticksB$children[[1]]$label)
ticksB$children[[1]]$label[junes] = paste0(ticksB$children[[1]]$label[junes], "\n ", unique(year(df$Date)))
Me encontré con esta pregunta y pensé que tal vez pudiera agregar una solución. Podemos mostrar tanto el mes como el año en el primer mes mostrado de cada año usando una condición simple. Puedes jugar con date_breakspara eliminar enero de las etiquetas, y esto seguirá funcionando. Estoy usando month()y year()de lubridate.
library(tidyverse)
library(lubridate)
df %>%
ggplot(aes(Date, value)) +
geom_line() +
scale_x_date(date_breaks = "2 months",
labels = function(x) if_else(is.na(lag(x)) | !year(lag(x)) == year(x),
paste(month(x, label = TRUE), "\n", year(x)),
paste(month(x, label = TRUE))))
Si desea intentar crear una subetiqueta, puede convertirla en un archivo grob. Edité esto de la publicación original para crear una función que agrega subetiquetas y devuelve un gtableobjeto. Tenga en cuenta que la sublabsentrada debe tener la misma longitud que las rupturas del eje x:
library(grid)
library(gtable)
library(gridExtra)
add_sublabs <- function(plot, sublabs){
gg <- ggplotGrob(plot)
axis_num <- which(gg$layout[,"name"] == "axis-b")
xbreaks <- gg[["grobs"]][[axis_num]][["children"]][[2]][["grobs"]][[2]][["children"]][[1]]$x
if(length(xbreaks) != length(sublabs)) stop("Sub-labels must be the same length as the x-axis breaks")
to_breaks <- c(as.numeric(xbreaks),1)[which(!duplicated(sublabs, fromLast = TRUE))+1]
sublabs_x <- diff(c(0,to_breaks))
sublabs_labels <- sublabs[!duplicated(sublabs, fromLast = TRUE)]
tg <- tableGrob(matrix(sublabs_labels, nrow = 1))
tg$widths = unit(sublabs_x, attr(xbreaks,"unit"))
pos <- gg$layout[axis_num,c("t","l")]
gg2 <- gtable_add_rows(gg, heights = sum(tg$heights)+unit(4,"mm"), pos = pos$t)
gg3 <- gtable_add_grob(gg2, tg, t = pos$t+1, l = pos$l)
return(gg3)
}
#Plot and sublabels
p <- ggplot(data = df, aes(x = Date, y = value)) + geom_line() +
scale_x_date(date_breaks = "2 month", date_minor_breaks = "1 month", labels = date_format("%b")) +
xlab(NULL)
sublabs <- c(rep("1719",2),rep("1720",6))
#Draw
grid.draw(add_sublabs(p, sublabs))
