Stop Map von der Umwandlung von Daten in Ziffern

Question

Ich habe eine Funktion, die den ersten Tag der Woche für ein bestimmtes Datum finden. In diesem speziellen Problem beginnen die Wochen am Donnerstag.

Die Funktion funktioniert gut für einzelne Daten.

week_commencing <- function(date) { 
    weekday <- lubridate::wday(date) 
    if (weekday >= 5) { 
    return(date - lubridate::days(weekday) + lubridate::days(5)) 
    } else { 
    return(date - lubridate::days(weekday) - lubridate::days(2)) 
    } 
} 

Nun würde Ich mag es, ein Rohr mit dplyr verwenden. Also habe ich es geändert, um Spalten mit Map zu akzeptieren.

week_commencing <- function(dates) { 
    Map(function(date) { 
    weekday <- lubridate::wday(date) 
    if (weekday >= 5) { 
     return(date - lubridate::days(weekday) + lubridate::days(5)) 
    } else { 
     return(date - lubridate::days(weekday) - lubridate::days(2)) 
    } 
    },dates) 
} 

Ich denke, die Funktion arbeitet, sondern auch einig seltsamen Zwang zu den Terminen anwenden, weil ich mit stellige Daten enden.

> test <- data.frame(datetime=seq.Date(as.Date("2016-06-01"),as.Date("2016-06-10"), by='day')) 
> test 
    datetime 
1 2016-06-01 
2 2016-06-02 
3 2016-06-03 
4 2016-06-04 
5 2016-06-05 
6 2016-06-06 
7 2016-06-07 
8 2016-06-08 
9 2016-06-09 
10 2016-06-10 

> test %>% mutate(datetime=week_commencing(datetime)) 
    datetime 
1  16947 
2  16954 
3  16954 
4  16954 
5  16954 
6  16954 
7  16954 
8  16954 
9  16961 
10 16961 

Irgendwelche Ideen, wie man mit normalem Datumobjekt endet? Wird die Karte immer unter Zwang angewendet?

Answer 1

Ich weiß nicht, warum das class Attribut hier fallengelassen wird (das gleiche passiert, wenn Sie andere * apply Funktionen verwenden). - Die Frage, tief unten scheint zu sein, dass unlist Klassen fällt:

> unlist(list(structure(1, class = 'foo'))) 
[1] 1 

Aber die Lösung ist einfach genug: die Klasse am Ende gesetzt.

Außerdem würde ich vorschlagen, nicht Map (die eine list zurückgibt), sondern vapply. Dann sind wir nach links mit:

week_commencing <- function(dates) { 
    wc <- function(date) { 
    weekday <- lubridate::wday(date) 
    if (weekday >= 5) { 
     return(date - lubridate::days(weekday) + lubridate::days(5)) 
    } else { 
     return(date - lubridate::days(weekday) - lubridate::days(2)) 
    } 
    } 

    structure(vapply(dates, wc, numeric(1)), class = 'Date') 
} 

Sie auch Vectorize auf die Funktion verwenden können, aber das beseitigt auch die class Attribut.

Answer 2

Oder könnten Sie es in der dplyr Familie halten:

week_commencing <- function(date) { 
    weekday <- lubridate::wday(date) 
    dplyr::if_else(weekday >= 5, 
       date - lubridate::days(weekday) + lubridate::days(5), 
       date - lubridate::days(weekday) - lubridate::days(2)) 
}