Bestimmen Sie die Jahreszeit von Datum mit Lubridate in R

Question

Ich habe eine sehr große Datenmenge mit einer DateTime Spalte, die POSIXct-Werte enthält. Ich muss die Jahreszeit (Winter - Sommer) basierend auf der Spalte DateTime bestimmen. Ich habe eine Funktion erstellt, die auf einem kleinen Datensatz gut funktioniert, aber abstürzt, wenn ich sie auf dem großen Datensatz verwende. Kann jemand meinen Fehler sehen?

Ich habe 4 Funktionen erstellt:

• 3 Unterfunktionen so dass ich logische Vergleiche tun kann, und Auswahl mit * an Funktionen
• 1 Funktion der Saison

Hier sind zu bestimmen, die Funktionen:

require(lubridate) 

# function for logical comparison (to be used in *apply) 
greaterOrEqual <- function(x,y){ 
    ifelse(x >= y,T,F) 
} 

# function for logical comparison (to be used in *apply) 
less <- function(x,y){ 
    ifelse(x < y,T,F) 
} 

# function for logical comparison (to be used in *apply) 
selFromLogic <- function(VecLogic,VecValue){ 
    VecValue[VecLogic] 
} 

# Main Function to determine the season 
getTwoSeasons <- function(input.date) { 
    Winter1Start <- as.POSIXct("2000-01-01 00:00:00", tz = "UTC") 
    Winter1End <- as.POSIXct("2000-04-15 23:59:59", tz = "UTC") 

    SummerStart <- Winter1End + 1 
    SummerEnd <- as.POSIXct("2000-10-15 23:59:59", tz = "UTC") 

    Winter2Start <- SummerEnd + 1 
    Winter2End <- as.POSIXct("2000-12-31 00:00:00", tz = "UTC") 

    year(input.date) <- year(Winter1Start) 
    attr(input.date, "tzone") <- attr(Winter1Start, "tzone") 

    SeasonStart <- c(Winter1Start,SummerStart,Winter2Start) 
    SeasonsEnd <- c(Winter1End,SummerEnd,Winter2End) 
    Season_names <- as.factor(c("WinterHalfYear","SummerHalfYear","WinterHalfYear")) 

    Season_select <- sapply(SeasonStart, greaterOrEqual, x = input.date) & sapply(SeasonsEnd, less, x = input.date) 
    Season_return <- apply(Season_select,MARGIN = 1,selFromLogic,VecValue = Season_names) 

    return(Season_return) 
} 

Und hier ist ein Weg zu Testen Sie die Funktion:

dates <- Sys.time() + seq(0,10000,10) 
getTwoSeasons(dates) 

Ich wäre dankbar für jede Hilfe, das macht mich verrückt!

Answer 1

I verpackt @ Lars Arne Jordanger ist viel eleganter Ansatz in eine Funktion:

getTwoSeasons <- function(input.date){ 
    numeric.date <- 100*month(input.date)+day(input.date) 
    ## input Seasons upper limits in the form MMDD in the "break =" option: 
    cuts <- base::cut(numeric.date, breaks = c(0,415,1015,1231)) 
    # rename the resulting groups (could've been done within cut(...levels=) if "Winter" wasn't double 
    levels(cuts) <- c("Winter", "Summer","Winter") 
    return(cuts) 
} 

Testing es auf einige Beispieldaten scheint gut zu funktionieren:

getTwoSeasons(as.POSIXct("2016-01-01 12:00:00")+(0:365)*(60*60*24)) 

Answer 2

Nach mehreren Stunden Debuggen Ich habe meinen Fehler gefunden, und es ist ziemlich absurd wirklich:

Wenn eine Saison für eine Datetimevalue nicht gefunden wurde, kehrte applylist -Objekt anstelle eines vector (dies war der Fall wenn der DateTime-Wert gleich 2000-12-31 00:00:00 war). Die Rückgabe einer Liste führte zu einem überproportionalen Anstieg der Rechenzeit und der beschriebenen Abstürze. Hier ist eine der Fixcode:

# input date and return 2 season 
getTwoSeasons <- function(input.date) { 
    Winter1Start <- as.POSIXct("2000-01-01 00:00:00", tz = "UTC") 
    Winter1End <- as.POSIXct("2000-04-15 23:59:59", tz = "UTC") 

    SummerStart <- Winter1End + 1 
    SummerEnd <- as.POSIXct("2000-10-15 23:59:59", tz = "UTC") 

    Winter2Start <- SummerEnd + 1 
    Winter2End <- as.POSIXct("2001-01-01 00:00:01", tz = "UTC") 

    SeasonStart <- c(Winter1Start,SummerStart,Winter2Start) 
    SeasonsEnd <- c(Winter1End,SummerEnd,Winter2End) 
    Season_names <- factor(c("WinterHalf","SummerHalf","WinterHalf")) 

    year(input.date) <- year(Winter1Start) 
    attr(input.date, "tzone") <- attr(Winter1Start, "tzone") 

    Season_selectStart <- vapply(X = SeasonStart,function(x,y){x <= input.date},FUN.VALUE = logical(length(input.date)),y = input.date) 
    Season_selectEnd <- vapply(X = SeasonsEnd,function(x,y){x > input.date},FUN.VALUE = logical(length(input.date)),y = input.date) 
    Season_selectBoth <- Season_selectStart & Season_selectEnd 
    Season_return <- apply(Season_selectBoth,MARGIN = 1,function(x,y){y[x]}, y = Season_names) 
    return(Season_return) 
} 

Die „sub“ -Funktionen jetzt in der Hauptfunktion integriert sind und zwei sapply Funktionen mit vapply ersetzt.

PS: Es gibt immer noch ein Problem mit der Zeitzone, da c() die Zeitzone entfernt. Ich werde den Code aktualisieren, wenn ich ihn behebe.

Answer 3

Die folgende Strategie kann auch verwendet werden: Die Grund Beobachtung ist, dass substr kann den Monat und den Tag Informationen extrahieren wir um müssen entscheiden, ob es Sommer oder Winter ist. Die Idee ist dann, dies in Zahlen des Formulars Monat.Datum zu konvertieren, und der Test für Sommer ist dann kocht auf eine Nummer größer als 4,15, aber kleiner als 10,16.

Das folgende Beispiel zeigt, wie dies erreicht werden kann, wenn ein Vektor von Terminen zuerst in die alternative Darstellung oben beschrieben transformiert werden, und dann ein Vektor, der, wenn er sagt Sommer ist „TRUE“ oder Winter „FALSCH“ wird basierend darauf erstellt werden.

DateTime <- as.POSIXct(x = "2000-01-01 00:00:00", 
         tz = "UTC") + 
    (0:1000)*(60*60*24) 

DateTime_2 <- as.numeric(paste(
    substr(x = DateTime, 
      start = 6, 
      stop = 7), 
    substr(x = DateTime, 
      start = 9, 
      stop = 10), 
    sep = ".")) 

.season <- (DateTime_2 > 4.15) & (DateTime_2 < 10.16) 

Answer 4

Und wenn Sie‘ Wieder interessiert vier Jahreszeiten, hier ist Code, um das zu tun:

library(lubridate) 
getSeason <- function(input.date){ 
    numeric.date <- 100*month(input.date)+day(input.date) 
    ## input Seasons upper limits in the form MMDD in the "break =" option: 
    cuts <- base::cut(numeric.date, breaks = c(0,319,0620,0921,1220,1231)) 
    # rename the resulting groups (could've been done within cut(...levels=) if "Winter" wasn't double 
    levels(cuts) <- c("Winter","Spring","Summer","Fall","Winter") 
    return(cuts) 
} 

Einheit Test:

getSeason(as.POSIXct("2016-01-01 12:00:00")+(0:365)*(60*60*24))