[R] How to assign week numbers to a time-series

[David Winsemius]

On Mar 5, 2010, at 4:46 PM, David Winsemius wrote:

>
> On Mar 5, 2010, at 4:23 PM, Hosack, Michael wrote:
>
>> Hello everyone,
>>
>> My progress has stalled on finding a way of creating a somewhat  
>> complicated variable to add to my existing dataframe and I am  
>> hoping one of you could help me out. The dataframe below contains  
>> only a fraction of the data of my complete dataframe, but all of  
>> the variables. What I want to do is add another variable named  
>> 'WEEK' to this dataframe that is assigned 1 for row 1 and remains 1  
>> until the first SAT (i.e. Saturday) under variable 'DOW' (day of  
>> week) occurs, at which point variable 'WEEK' is now assigned 2.  
>> 'WEEK' should continue to be assigned 2 until the following SAT  
>> under variable 'DOW' at which variable 'WEEK' will now be assigned  
>> 3, and so on. In this scheme, weekdays are such that SAT=1, SUN=2,  
>> MON=3,.....FRI=7. I am basically trying to assign week numbers to  
>> potential sampling days in a survey season for use in a program  
>> that will generate a fisheries creel survey schedule. I should note  
>> that if element 1 happens to have DOW=SAT (that is the case this  
>> year, since!
>> the first day of our survey 05/01 is a Saturday), then WEEK 1  
>> begins on day 1 (05/01/2010) and WEEK 2 will begin on the first SAT  
>> under variable DOW. I hope I explained this clearly enough, if not  
>> let me know. If this sent twice, I apologize.
>>
>> Mike
>>
>>        MM DD YR DOW DOW. DTYPE  TOD  TOD. SITENUM       DESC
>> 1         05 01 2010 SAT        1     2            MORN    1      
>> 101         WALNUT.CK
>> 185    05 01 2010 SAT         1     2            MORN    1      
>> 102           LAMPE
>> 369    05 01 2010 SAT         1     2            MORN    1      
>> 103          EAST.AVE
>> 553    05 01 2010 SAT         1     2           MORN    1      
>> 104          NORTH.EAST
>> 737    05 01 2010 SAT         1     2          AFTN       2      
>> 101           WALNUT.CK
>> 921    05 01 2010 SAT         1     2          AFTN       2      
>> 102            LAMPE
>> 1105 05 01 2010 SAT          1     2         AFTN       2      
>> 103           EAST.AVE
>> 1289 05 01 2010 SAT         1     2          AFTN       2      
>> 104           NORTH.EAST
>> 2        05 02 2010 SUN        2     2          MORN    1      
>> 101           WALNUT.CK
>> 186   05 02 2010 SUN        2     2          MORN    1      
>> 102            LAMPE
>> 370   05 02 2010 SUN        2     2          MORN    1      
>> 103            EAST.AVE
>> 554   05 02 2010 SUN         2     2         MORN    1      
>> 104           NORTH.EAST
>> 738   05 02 2010 SUN         2     2         AFTN      2      
>> 101            WALNUT.CK
>> 922   05 02 2010 SUN         2     2          AFTN     2      
>> 102              LAMPE
>> 1106 05 02 2010 SUN          2     2       AFTN       2      
>> 103            EAST.AVE
>> 1290 05 02 2010 SUN        2     2          AFTN      2      
>> 104            NORTH.EAST
>> 3        05 03 2010 MON        3     1        MORN    1      
>> 101           WALNUT.CK
>> 187   05 03 2010 MON    3     1           MORN    1      
>> 102               LAMPE
>> 371   05 03 2010 MON      3     1          MORN    1      
>> 103           EAST.AVE
>> 555   05 03 2010 MON      3     1          MORN    1      
>> 104           NORTH.EAST
>> 739   05 03 2010 MON    3     1           AFTN      2      
>> 101            WALNUT.CK
>> 923   05 03 2010 MON      3     1          AFTN      2      
>> 102               LAMPE
>> 1107 05 03 2010 MON      3     1          AFTN      2      
>> 103            EAST.AVE
>> 1291 05 03 2010 MON         3     1      AFTN      2      
>> 104            NORTH.EAST
>> 4        05 04 2010 TUE          4     1         MORN    1      
>> 101           WALNUT.CK
>> 188   05 04 2010 TUE         4     1           MORN    1      
>> 102           LAMPE
>> 372   05 04 2010 TUE          4     1        MORN     1      
>> 103            EAST.AVE
>> .          .    .       .           .           .       .               .            .           .                    .
>
> You could trunc() the results of this function applied to your dates  
> and "2010-05-01":
>
> > diffweek <- function(x,y) {difft <- difftime( x , y)/7;  
> attr(difft, "units") <- "weeks"; difft}
> > diffweek(Sys.Date() , as.Date("2010-01-01") )
> Time difference of 9 weeks
> > diffweek(Sys.Date()+1 , as.Date("2010-01-01") )
> Time difference of 9.142857 weeks
>
> There is also a week function in the tis package.
>
> Perhaps (untested):
>
> dfrm$weeknum <- trunc(apply(dfrm, 1, function(x)  
> diffweek(as.Date(x[4], x[2], x[3], sep="-") ,
>                                                     
> as.Date("2010-05-01")
>                                                   )
>                      )     )
>

Well, testing shows that it fails. I didn't get an apply() based  
solution to work and needed to vectorize diffweek:

diffweekV <- Vectorize(diffweek)
seqwk <-  with(dfrm , as.Date(paste(YR, MM, DD, sep="-")) )
dfrm$weeknum <- 1+ trunc(diffweekV(seqwk,  as.Date("2010-05-01")   ) )

(Which looks clearer anyway.)
I did throw a few other values at the function to see if it had  
sensible return values.

> -- 
>
> David Winsemius, MD
> West Hartford, CT
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.

David Winsemius, MD
West Hartford, CT