ggplot2, facet_wrap: tracer des données deux fois dans différentes facettes

Question

Dire que j'ai une trame de données comme ceci: entre 2001 et 2003

df <- data.frame(year_day = rep(1:365, 3), 
       year = rep(2001:2003, each = 365), 
       value = sin(2*pi*rep(1:365, 3)/365)) 

Il représente une certaine valeur (value) pour chaque jour de l'année (year_day). Je voudrais tracer chaque année et utiliser ggplot2 pour le faire.

ggplot(df) + geom_point(aes(year_day, value)) + facet_wrap(~year, ncol=1) 

Cela me donne:

Grand. Maintenant, disons que je veux étendre un peu ma région de traçage, de sorte que chaque année inclut 3 mois de l'année précédente et 3 mois de l'année suivante (si ces données existent). Cela signifie que certaines données seront tracées deux fois. Par exemple, les trois premiers mois de 2003 apparaîtront dans les graphiques pour 2002 et 2003. Donc, je pourrais dupliquer ces lignes et les attribuer à 2002, mais avec year-day s 366 à 485. Cela fonctionne, mais est cludgy. Y a-t-il une solution plus élégante?

Answer 1

édité pour enlever et remplacer ancienne version

C'est quelque chose que j'avais pensé pendant un certain temps, donc ce fut une assez bonne raison d'essayer de le mettre en œuvre. Cela implique toujours la duplication des lignes, ce qui est kludgy, mais c'est la meilleure façon de penser.

Ceci est une fonction pipe-able bien ordonnée qui prend une dataframe (même une groupée) comme premier argument, et une colonne de dates comme seconde. Il y a un troisième argument facultatif pour étendre la portée de chaque fenêtre (par défaut à 0,25 ou 3 mois). Le quatrième argument serait pour des choses comme des années fiscales ou académiques qui ne sont pas Jan-Jan, mais je n'ai pas encore réfléchi profondément à ça.

La sortie est la même trame de données, avec les lignes dupliquées pour les queues des années, avec des colonnes supplémentaires doy_wrapped pour le jour de l'année (passant de négatifs à> 365), et nominal_yr, qui est la année où chaque fenêtre est centrée.

exemple, en utilisant l'ensemble de données ggplot2::economics:

library(dplyr) 
library(lubridate) 

economics %>% 
    filter(year(date) > 2007) 

# A tibble: 88 x 6 
     date  pce pop psavert uempmed unemploy 
     <date> <dbl> <int> <dbl> <dbl> <int> 
1 2008-01-01 9963.2 303506  3.4  9.0  7685 
2 2008-02-01 9955.7 303711  3.9  8.7  7497 
3 2008-03-01 10004.2 303907  4.0  8.7  7822 
4 2008-04-01 10044.6 304117  3.5  9.4  7637 
5 2008-05-01 10093.3 304323  7.9  7.9  8395 
6 2008-06-01 10149.4 304556  5.6  9.0  8575 
7 2008-07-01 10151.1 304798  4.4  9.7  8937 
8 2008-08-01 10140.3 305045  3.7  9.7  9438 
9 2008-09-01 10083.2 305309  4.4 10.2  9494 
10 2008-10-01 9983.3 305554  5.4 10.4 10074 
# ... with 78 more rows 

---

economics %>% 
    filter(year(date) > 2007) %>% 
    wrap_years(date, expand = 3/12) 

# A tibble: 136 x 8 
# Groups: nominal_yr [8] 
     date  pce pop psavert uempmed unemploy nominal_yr doy_wrapped 
     <date> <dbl> <int> <dbl> <dbl> <int>  <dbl>  <dbl> 
1 2008-01-01 9963.2 303506  3.4  9.0  7685  2008   1 
2 2008-02-01 9955.7 303711  3.9  8.7  7497  2008   32 
3 2008-03-01 10004.2 303907  4.0  8.7  7822  2008   61 
4 2008-04-01 10044.6 304117  3.5  9.4  7637  2008   92 
5 2008-05-01 10093.3 304323  7.9  7.9  8395  2008   122 
6 2008-06-01 10149.4 304556  5.6  9.0  8575  2008   153 
7 2008-07-01 10151.1 304798  4.4  9.7  8937  2008   183 
8 2008-08-01 10140.3 305045  3.7  9.7  9438  2008   214 
9 2008-09-01 10083.2 305309  4.4 10.2  9494  2008   245 
10 2008-10-01 9983.3 305554  5.4 10.4 10074  2009   -90 
# ... with 126 more rows 

Cela le déstabilise quelque peu; il triplie les lignes dans leur ordre, puis les réaffecte aux années voisines. Il préserve le regroupement d'origine tout en en ajoutant un pour le nouveau nominal_yr (pour supprimer les queues éventuellement orphelines, lorsque les données de l'année centrale sont manquantes).

economics %>% 
    filter(year(date) > 2007) %>% 
    wrap_years(date, expand = 3/12) %>% 
    ggplot(aes(doy_wrapped, unemploy)) + 
    geom_line() + facet_wrap(~nominal_yr, ncol = 3) 

Et puis un trucs couple pour l'habiller et corriger l'axe:

economics %>% 
    filter(year(date) > 2007) %>% 
    wrap_years(date, expand = 3/12) %>% 
    ggplot(aes(doy_wrapped + ymd("1900-01-01") - 1, unemploy)) + 
    geom_line() + facet_wrap(~nominal_yr, ncol = 2) + 
    geom_vline(xintercept = as.numeric(c(ymd("1900-01-01"), ymd("1901-01-01")))) + 
    scale_x_date(date_breaks = "2 months",date_labels = "%b", 
       name = NULL, expand = c(0,0) + 
    theme_minimal() + 
    theme(panel.spacing.x = unit(1, "cm")) 

Le + ymd("1900-01-01") - 1 dans le aes(...) est arbitraire, vous voulez juste à la ligne avec un Janvier 1 afin que chaque année a les bons mois. Ensuite, vous correspondez à la xintercept = dans les lignes verticales.

Idéalement, ce serait éventuellement faire partie d'une famille de wrap_* fonctions, pour les trimestres, des mois, des heures, des décennies, etc.

code de la fonction:

wrap_years <- function(df, datecol, expand = 0.25, offset = "2001-01-01") { 

    if(!is.data.frame(df)) {return(df)} 

    datecol <- enquo(datecol) 

    if(expand > 1) { 
    warning(paste0("Window expansions of > 1 are not supported.")) 
    return(df) 
    } 


    if(!(quo_name(datecol) %in% names(df))) { 
    warning(paste0("Column '", quo_name(datecol), "' not found in data.")) 
    return(df) 
    } 

    # offset <- as_date(offset) 
    # warning(paste0("Using ", stamp("August 26", orders = "md")(offset), 
    #    " as start of year. Not yet implemented.")) 

    if(!is.Date(df %>% pull(!!datecol))) { 
    warning(paste0("Use lubridate functions to parse '", 
        quo_name(datecol), 
        "' before proceeding.")) 
    return(df) 
    } 

    df %>% 
    mutate(adj_wrap = list(-1:1)) %>% 
    tidyr::unnest() %>% 
    mutate(nominal_yr = year(!!datecol) -  adj_wrap, 
      doy_wrapped = yday(!!datecol) + 365*adj_wrap) %>% 
    filter(between(doy_wrapped, -expand * 365, (1 + expand) * 365)) %>% 
    select(-adj_wrap) %>% 
    group_by(nominal_yr, add = T) %>% 
    filter(sum(year(!!datecol) != nominal_yr) != length(nominal_yr)) 

} 

I J'avais supposé que copier le plus petit nombre de lignes allait être la méthode la plus rapide, ce qui était le paradigme derrière mon premier coup de poignard. En y réfléchissant plus tard, je me suis rendu compte qu'une approche plus naïve consisterait simplement à copier toutes les lignes, ce qui s'avère beaucoup plus rapide. Ensuite, l'étape de filtrage est faite avec between, qui est également rapide. Cette version de la fonction est environ 2x la vitesse de la version précédente (mais environ 0.01x la vitesse de traçage des données brutes).