Thanks to this piece on wired I learnt about conway's doomsday algorithm to get the day of the week of any date.
Trying to wrap my head around the algorithm I decided to implement it as a learning exercise.
Here is the code, enjoy :D
Update, now with use strict!
#!/usr/bin/perl
use 5.14.2;
use warnings;
use strict;
use autodie;
if(!defined($ARGV[0])){
die "gimme a date DD/MM/YYYY!\n";
}
my $date = $ARGV[0];
my($day,$month,$year);
if(!($date =~ m#(?<day>\d\d)/(?<month>\d\d)/(?<year>\d\d\d\d)#)){
print "$date did not match format DD/MM/YYYY\n";
die;
}
else{
$day = $+{day};
$month = $+{month};
$year = $+{year};
}
my $isleap;
if( $year =~ m/\d\d00/){
my $century = $year / 100;
$isleap = $century % 4 == 0;
}
elsif($year =~ m/\d\d(?<decade>\d\d)/){
$isleap = $+{decade} % 4 == 0;
}
if(!$isleap && $month == 02 && $day == 29){
die "this ain't a leap year so $date is wrong!\n";
}
my $century_anchor_day = ((5 * (($year/100)%4))%7);
my $decade;
if($year =~ m/\d\d(?<decade>\d\d)/){
$decade = $+{decade};
}
if($decade % 2 == 0){
$decade /= 2;
}
else{
$decade += 11;
$decade /=2;
}
if($decade %2 == 0){
$decade %= 7;
}
else{
$decade += 11;
$decade %= 7;
}
my $anchorday_drift = 7- $decade;
my @anchorday_week;
my $year_anchor_day = ($century_anchor_day+$anchorday_drift)%7;
given ($year_anchor_day){
when(0){@anchorday_week = qw(tuesday wednesday thursday friday sat
+urday
sunday monday );}
when(1){@anchorday_week = qw(wednesday thursday friday saturday su
+nday
monday tuesday);}
when(2){@anchorday_week=qw(thursday friday saturday sunday monday
+tuesday
wednesday);}
when(3){@anchorday_week=qw(friday saturday sunday monday tuesday w
+ednesday
thursday);}
when(4){@anchorday_week=qw(saturday sunday monday tuesday wednesda
+y
thursday friday);}
when(5){@anchorday_week=qw(sunday sunday monday tuesday wednesday
+friday
saturday);}
when(6){@anchorday_week = qw(monday tuesday wednesday thursday fri
+day
saturday sunday);}
}
my $doomsdates = {
'01'=>3,
'02'=>28,
'03'=>0,
'04'=>4,
'05'=>9,
'06'=>6,
'07'=>11,
'08'=>8,
'09'=>5,
'10'=>10,
'11'=>7,
'12'=>12,
};
if($isleap){
$doomsdates->{'01'} = 4;
$doomsdates->{'02'} = 29;
}
my $diff_to_doomsdates = $day - $doomsdates->{"$month"};
if($diff_to_doomsdates < 0){
$diff_to_doomsdates *= -1;
}
my $nbdays = $diff_to_doomsdates % 7;
print "$ARGV[0] was a $anchorday_week[$nbdays]\n";</readmore>
|
Re: Doomsday algorithm
by u65 (Chaplain) on Sep 06, 2015 at 14:22 UTC
|
Just a brief glance--methinks adding use strict; would show some problems. Also I believe $isleap should be initialized.
| [reply]
[d/l]
[select] |
|
|
I know, I corrected that in the second script, the quizz one.
| [reply] |
Re: Doomsday algorithm
by soonix (Canon) on Sep 07, 2015 at 13:56 UTC
|
@anchorday_week = qw(tuesday wednesday thursday friday saturday sunday
+ monday);
my @tmp = splice @anchorday_week, 0, $year_anchor_day;
push @anchorday_week, @tmp;
(see splice). Probably there are more elegant solutions, but at least it is shorter and won't warn you about given/when …
Update: even simpler: drop that complete @anchorday_week, and then change the calculation of your $nbdays to my $nbdays = ($diff_to_doomsdates + $year_anchor_day) % 7;
return qw(tuesday wednesday thursday friday saturday sunday monday)[$n
+bdays];
| [reply]
[d/l]
[select] |
|
|
@anchor_day_week = qw(tuesday wednesday thursday friday saturday sunda
+y monday)
[$year_anchor_day+1..6,0..$year_anchor_day];
...though I dislike repeating $year_anchor_day. This just changes the repetition:
push @anchor_day_week, splice @anchor_day_week, 0, $year_anchor_day;
...so a function to do this for you would be appropriate, even if it's only used once.
-QM
--
Quantum Mechanics: The dreams stuff is made of
| [reply]
[d/l]
[select] |
|
|
Yes, that's what I meant with "more elegant solution". The next step would be to further "normalize" that $nbdays such that Sunday is the usual 0 or 7 (like in strftime %u or %w) by calculating
my $nbdays = ($diff_to_doomsdates + $year_anchor_day + 2) % 7; # or -5
| [reply]
[d/l]
[select] |
|
|
| [reply] |
Re: Doomsday algorithm
by QuillMeantTen (Friar) on Sep 06, 2015 at 14:49 UTC
|
And now the quizz script :
Update, added use strict and now get a warning about given when being experimenta
| [reply]
[d/l] |
|
|
Hello QuillMeantTen,
Thanks for drawing attention to the Doomsday algorithm, it looks interesting.
Given that your code was written as a learning exercise, I will highlight one aspect that stands out as a problem: the use of subroutine prototypes.
First, Perl prototypes don’t function as a programmer coming from C or Java might expect them to, and they’re mostly unneeded anyway. This is explained at length in Tom Christiansen’s article “Far More Than Everything You’ve Ever Wanted to Know about Prototypes in Perl,” which is reprinted as a PerlMonks tutorial here.
But, second, none of the subroutine prototypes in your code is ever actually used — because the & sigil prepended to a subroutine call disables them! See perlsub#Prototypes. Unless you have a good reason to disable prototypes, you should call a subroutine like this:
frobnicate();
and not like this:
&frobnicate;
The latter form is seen mainly in legacy code dating from Perl’s earlier days.
Update: Fixed typo.
Hope that helps,
| [reply]
[d/l]
[select] |
|
|
Well sir I thank you very much for your comment and shall start reading at once!
To be honest I once saw that way of writing subs and decided to use it because it reminded me of C and made subs somewhat easier to understand (like, from the first line I know what kind of parameters this sub wants).
I honestly hadn't the foggiest regarding the depth of their role and will start plumbing it right away.
| [reply] |
|
|
| [reply]
[d/l] |
|
|
| [reply] |
|
|
