Edited alte Version zu entfernen und
Das ist etwas zu ersetzen, das ich für eine Weile darüber nachzudenken, gewesen war, so war dies ein guter Grund, um zu versuchen, sie umzusetzen. Es geht immer noch darum, Zeilen zu duplizieren, was kludgy ist, aber es ist der beste Weg, an den ich denken könnte.
Dies ist eine ordentliche Pipe-fähige Funktion, die ein Dataframe (auch ein gruppiertes) als erstes Argument und eine Datumsspalte als zweites verwendet. Es gibt ein optionales drittes Argument, um die Ausdehnung jedes Fensters zu erweitern (standardmäßig auf 0,25 oder 3 Monate). Das vierte Argument wäre für Dinge wie fiskalische oder akademische Jahre, die nicht Jan-Jan sind, aber ich habe noch nicht tief durchdacht.
Der Ausgang ist der gleiche Datenrahmen, mit den duplizierten Zeilen für den Schwanz der Jahre, mit zusätzlichen Spalten für den Tag des Jahres doy_wrapped (von Negativ zu> 365 gehen) und nominal_yr, das ist die Jahr, auf das jedes Fenster zentriert ist.
Beispiel, unter Verwendung des Datensatzes 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
Das macht es etwas kaputt; es verdreifacht Reihen in ihrer Reihenfolge und weist sie dann den benachbarten Jahren zu. Es behält die ursprüngliche Gruppierung bei und fügt eine für die neue nominal_yr hinzu (um möglicherweise verwaiste Schwänze zu entfernen, wenn die Daten zum zentralen Jahr fehlen).
economics %>%
filter(year(date) > 2007) %>%
wrap_years(date, expand = 3/12) %>%
ggplot(aes(doy_wrapped, unemploy)) +
geom_line() + facet_wrap(~nominal_yr, ncol = 3)
Und dann ein paar Tricks es sich zu verkleiden und korrigieren, die die Achse:
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"))
Die + ymd("1900-01-01") - 1 im aes(...) willkürlich ist, Sie wollen, dass es nur mit einem Line-Up 1. Januar, so dass jedes Jahr die richtigen Monate hat. Dann passen Sie es an die xintercept = in den vertikalen Linien an.
Im Idealfall würde dies schließlich Teil einer Familie von wrap_* Funktionen sein, für die Quartale, Monate, Stunden, Jahrzehnte usw.
-Code für die Funktion:
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 Ich hatte angenommen, dass das Kopieren der geringsten Zeilen die schnellste Methode sein würde. Das war das Paradigma, das hinter meinem ersten Versuch steckte. Als ich später darüber nachdachte, wurde mir klar, dass ein naiverer Ansatz wäre, einfach alle Zeilen zu kopieren, was sich als viel schneller herausstellte. Dann wird der Filterschritt mit between gemacht, was auch schnell ist. Diese Version der Funktion ist etwa doppelt so schnell wie die vorherige Version (aber etwa das 0,01-fache der Geschwindigkeit beim Zeichnen der Rohdaten).
