develooper Front page | perl.datetime | Postings from January 2003

Weeks

Thread Next
From:
Matthew Simon Cavalletto
Date:
January 11, 2003 19:55
Subject:
Weeks
Message ID:
B5B8ABBA-25E1-11D7-A525-003065AFEA5E@cavalletto.org
 From the TODO list for Perl module DateTime:

> - week number of year

I've attached an initial implementation for this below, for discussion 
and possible inclusion in DateTime.pm.

As with many calendar issues, there's more than one way to calculate 
week numbers; I think the ISO model of starting with the week that 
contains January 4 is a reasonable baseline, but there does seem to be 
some debate, and I can imagine people wanting to use a different 
algorithm for more specific purposes.

It would be nice to come up with some slick way of handling the related 
ISO-vs-legacy "does the week start on Sunday or Monday" debate, but I 
haven't had any revelations yet... I personally prefer "starts on 
Monday," but I'm reluctant to alienate the majority.

I've also included a test script with a bunch of edge cases; at first 
glance, they seem to be handled correctly.

Here's some reference material about week numbering I found useful:
   http://www.tondering.dk/claus/cal/node6.html
   http://www.cl.cam.ac.uk/~mgk25/iso-time.html
   http://www.panix.com/~wlinden/weeks.cgi
   Date::ISO::to_iso()

-Simon

---

=head2 week

   ($week_year, $week_number, $week_day) = $dt->week

Returns information about the calendar week which contains this
datetime object. The values returned by this method are also
available separately through the week_year, week_number, and week_day
methods, below.

The first week of the year is defined as the one which contains
the fourth of January, which is equivalent to saying that it's the
first week to overlap the new year by at least four days.

Typically the week_year will be the same as the year that the
datetime object is in, but dates at the very begining of a calendar
year often end up in the last week of the prior year, and similarly,
the final few days of the year may be placed in the first week of
the next year.

=head2 week_year

Returns the year of the week, such as 1968 or 2003.

=head2 week_number

Returns the week of the year as a number in the range 1..53.

=head2 week_day

Returns the day of the week as a number in the range 1..7.

=cut

sub week {
     my $self = shift;

     my $week_day = $self->day_of_week;

     my $mid_week = $self->clone;
     $mid_week->add( day => 4 - $week_day );
     my $week_year = $mid_week->year;

     my $jan_four = greg2jd( $week_year, 1, 4 );
     my $first_week = $jan_four - ( $jan_four % 7 );
     my $week_number = int( ($self->{julian} - $first_week) / 7 ) + 1;

     return( $week_year, $week_number, $week_day );
}

sub week_year { ( (shift)->week() )[0] }
sub week_number  { ( (shift)->week() )[1] }
*week_day = \&day_of_week;

---

use Test::More qw(no_plan);

BEGIN { use_ok( 'DateTime' ); }

my @tests = (
   [ [ 1971,  9,  7 ], [ 1971, 36, 3 ] ],
   [ [ 1971, 10, 25 ], [ 1971, 43, 2 ] ],
   [ [ 2001,  4, 28 ], [ 2001, 17, 7 ] ],
   [ [ 2001,  8,  2 ], [ 2001, 31, 5 ] ],
   [ [ 2001,  9, 11 ], [ 2001, 37, 3 ] ],
   [ [ 2002, 12, 25 ], [ 2002, 52, 4 ] ],
   [ [ 2002, 12, 31 ], [ 2003,  1, 3 ] ],
   [ [ 2003,  1,  1 ], [ 2003,  1, 4 ] ],
   [ [ 2003, 12, 31 ], [ 2003, 53, 4 ] ],
   [ [ 2004,  1,  1 ], [ 2003, 53, 5 ] ],
   [ [ 2004, 12, 31 ], [ 2004, 52, 6 ] ],
   [ [ 2005,  1,  1 ], [ 2004, 52, 7 ] ],
   [ [ 2005, 12, 31 ], [ 2005, 52, 7 ] ],
   [ [ 2006,  1,  1 ], [ 2006,  1, 1 ] ],
   [ [ 2006, 12, 31 ], [ 2007,  1, 1 ] ],
   [ [ 2007,  1,  1 ], [ 2007,  1, 2 ] ],
   [ [ 2007, 12, 31 ], [ 2008,  1, 2 ] ],
   [ [ 2008,  1,  1 ], [ 2008,  1, 3 ] ],
   [ [ 2008, 12, 31 ], [ 2008, 53, 4 ] ],
   [ [ 2009,  1,  1 ], [ 2008, 53, 5 ] ],
);

foreach my $test ( @tests ) {
   my @args = @{ $test->[0] };
   my @results = @{ $test->[1] };
   my $dt = DateTime->new( year=>$args[0], month=>$args[1], 
day=>$args[2] );
   my ($year, $week, $day) = $dt->week();
   is( "$year-W$week-$day", "$results[0]-W$results[1]-$results[2]" );
}


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About