Etiquetas de eje en dos líneas con variables x anidadas (año por 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:

introduzca la descripción de la imagen aquí

La repetición innecesaria del año estorba las etiquetas. En su lugar me gustaría algo como esto:

introduzca la descripción de la imagen aquí

Excepto que el año se imprimiría debajo de los meses.

Imprimí el año por encima de las etiquetas del eje, porque eso es lo mejor que pude hacer. Esto sigue una limitación de la función annotate(), que se recorta si se encuentra fuera del área de la gráfica. Soy consciente de posibles soluciones basadas en annotate_custom(), pero no pude hacerlas funcionar con objetos de fecha (no traté de convertir fechas a números y volver a fechas de nuevo, ya que parecía más complicado de lo que espero que sea necesario)

Me pregunto si el nuevo dup_axis() podría ser secuestrado para este propósito. Si en lugar de enviar el eje duplicado al lado opuesto de el panel, podría enviarlo unas pocas líneas por debajo del eje duplicado, entonces tal vez solo sería cuestión de configurar un eje con panel.grid.major en blanco y las etiquetas establecidas en %b, mientras que el otro eje tendría panel.grid.minor en blanco y las etiquetas establecidas en %Y. (un desafío adicional es que las etiquetas de año se cambiarían a octubre en lugar de enero)

Estas preguntas están relacionadas. Sin embargo, las funciones annotate_custom() y textGrob() no funcionan bien con las fechas, por lo que puedo decir.

How-can-i-add-annotations-below-the-x-axis-in-ggplot2

Displaying-text-below-the-plot-generated-by-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")
Author: Henrik, 2017-06-18

4 answers

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"))

introduzca la descripción de la imagen aquí

Tenga en cuenta que con este enfoque, si faltan fechas al principio o al final de un año (por "faltantes", me refiero a filas para esas fechas ni siquiera están presentes en los datos), entonces el eje x comenzará / terminará en la primera / última fecha en los datos para ese año, en lugar de ir desde Enero-1 al 31 de diciembre. En ese caso, tendría que agregar filas para las fechas faltantes y NA para value o interpolar value. Además, con este método no hay espacio o 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 a través de cada año.

Opción 1b: Facetado + etiquetas mensuales centradas

Para abordar el comentario de @AF7. Puede centrar las etiquetas del mes agregando algunos espacios antes de cada etiqueta. Pero tienes que elegir el número de espacios manualmente, dependiendo del tamaño físico de la gráfica cuando se imprime en un dispositivo. (Probablemente hay una manera de centrar las etiquetas programáticamente en función de las mediciones internas de grob, pero no estoy seguro de cómo hacerlo. También he eliminado las líneas verticales menores y aligerado 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"))

introduzca la descripción de la imagen aquí

Opción 2a: Editar la etiqueta del eje x grob

Aquí hay un método más complejo y meticuloso (aunque probablemente podría ser automatizado por alguien que entiende la estructura y los espaciamientos de las unidades de gráficos de cuadrícula mejor que yo) que evita las trampas 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="")

introduzca la descripción de la imagen aquí

Ahora queremos agregar los valores del año a continuación y entre junio y julio de cada año. El siguiente código lo hace modificando la etiqueta del eje x grob y está adaptado de esto para responder por @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)

introduzca la descripción de la imagen aquí

Opción 2b: Editar la etiqueta del eje x grob y centrar las etiquetas del mes

A continuación se muestra el único cambio que se debe hacer a la opción 2a para centrar las etiquetas de mes, pero, una vez más, el número de espacios debe ser ajustado 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))) 

introduzca la descripción de la imagen aquí

 36
Author: eipi10,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-06-20 15:12:22

Si quieres intentar hackear una subetiqueta, puedes convertirla a grob. Edité esto desde el post original para crear una función que agrega las subletiquetas y devuelve un objeto gtable. Tenga en cuenta que la entrada sublabs debe tener la misma longitud que sus saltos 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))

introduzca la descripción de la imagen aquí

 8
Author: Mike H.,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-06-18 18:06:46

Me encontré con esta pregunta y pensé que tal vez podría 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. Puede jugar con date_breaks para 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))))

introduzca la descripción de la imagen aquí

 4
Author: pasipasi,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2018-05-01 13:26:57

Una forma de evitar las complejidades sería cambiar la producción requerida para que enero sea reemplazado por el año.

La función lab devuelve las etiquetas dadas las rupturas. Inesperadamente, ggplot pasará NAs a él por lo que en la primera línea del cuerpo de la función reemplazamos aquellos con alguna fecha not no importa qué fecha ya que dichos valores no son utilizados posteriormente por ggplot. Finalmente formateamos la fecha como año o mes abreviado dependiendo de si el mes es enero (que corresponde al componente POSIXlt mon igual a 0) o no.

library(ggplot2)
library(scales)

lab <- function(b) {
  b[is.na(b)] <- Sys.Date()
  format(b, ifelse(as.POSIXlt(b)$mon == 0, "%Y", "%b"))
}

ggplot(df, aes(Date, value)) + 
   geom_line() +
   scale_x_date(date_breaks = "month", labels = lab)

pantallazo

Nota: He agregado el problema 2182 a la lista de problemas de github de ggplot2 con respecto al NAS que se pasan a la función label. Si las versiones posteriores de ggplot2 ya no pasan por el NAS, entonces se podría omitir la primera línea del cuerpo de lab.

Actualización: arreglado.

 2
Author: G. Grothendieck,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-07-11 23:50:35