Perl Weekly Challenge 227.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 227.
Task 1: Friday 13th
Submitted by: Peter Campbell Smith
You are given a year number in the range 1753 to 9999.
Write a script to find out how many dates in the year are Friday 13th,
assume that the current Gregorian calendar applies.
Example
Input: $year = 2023
Output: 2
Since there are only 2 Friday 13th in the given year 2023 i.e. 13th Jan and 13th Oct.
We may find how many previous leap years there have been since, say, year 0, which extrapolates to a leap year. To that end, I use the Gregorian rule that says that multiples of 4 are leap years, unless they are multiples of 100, which are not leap years, unless they are multiples of 400 which are leap years. I also have to determine if the given year is a leap year. Then I have to count how many days are in leap and non-leap years. I may use modular arithmetic modulo 7, as I only care for weekdays. Some useful results are that the number of days in a 400 year cicle is zero (is congruent with 0 modulo 7), the number of days in one year is 1 and in a leap year 2, as we can verify with the following code:
perl -E 'local $,=" "; say "Days in year=",365%7,", in leap=", 366%7, ", in 400 years=",(400*365+24*4+1)%7'
Results:
Days in year= 1 , in leap= 2 , in 400 years= 0
I may calculate the number of days from the start of a year to the start of a month with the following two-liner code using PDL:
perl -MPDL -E '$d=pdl(0,31,28,31,30,31,30,31,31,30,31,30)->dummy(1,12);
$l=($n=($d*($d->yvals>=$d->xvals))->sumover%7)->copy; $l->slice("2:11")+=1; $l%=7;
say "Days before month start:$n, along leap years:$l";'
Results:
Days before month start:[0 3 3 6 1 4 6 2 5 0 3 5], along leap years:[0 3 4 0 2 5 0 3 6 1 4 6]
The first day of the year 2000 (and the extrapolated year 0000) was a Saturday, so it is convenient to count weekdays from Saturday, starting at 0. Friday is then weekday 6. For those months that have a Friday 13, weekday 6 corresponds to month-day 12 (counting from 0), and also to month-day 12%7=5, so month-day 0 would correspond to weekday 1 and the first week-day of the month is 1. Therefore, the result is obtained by counting how many months start in the weekday 1 (I repeat, with Saturday corresponding to 0). This may be done with a three-liner:
perl -MPDL -E '
$d=pdl[[0,3,3,6,1,4,6,2,5,0,3,5],[0,3,4,0,2,5,0,3,6,1,4,6]]; for(@ARGV){$y=$_%400;
$l=(floor(($y+3)/4)-floor(($y+3)/100));$s=($y+$l)%7; $t=(!$y||($y%100 &&!!($y%4)))?1:0;
$b=($d->slice("",[$t,0,0])+$s)%7;say "$_->", ($b==1)->sumover}
' 2023 2000 1999
Results:
2023->3
2000->1
1999->2
This may be verified with the following command:
for j in 2023 2000 2009; do for i in `seq 12`; do date -d "$j-$i-13"; done; done|grep "Fri"
Results:
Fri Jan 13 12:00:00 AM CST 2023
Fri Oct 13 12:00:00 AM CST 2023
Fri Oct 13 12:00:00 AM CDT 2000
Fri Feb 13 12:00:00 AM CST 2009
Fri Mar 13 12:00:00 AM CST 2009
Fri Nov 13 12:00:00 AM CST 2009
which shows the two Friday 13’s of 2023, the single one of 2000 and the three of 2009.
The full code is similar, but clearer and with a few comments.
1 # Perl weekly challenge 227
2 # Task 1: Friday 13th
3 #
4 # See https://wlmb.github.io/2023/07/24/PWC227/#task-1-friday-13th
5 use v5.36;
6 use PDL;
7 my $days_to_month=pdl[[0,3,3,6,1,4,6,2,5,0,3,5], # days to start of month nonleap and leap
8 [0,3,4,0,2,5,0,3,6,1,4,6]];
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 Y1 [Y2...]
11 to find how many Friday 13 are in the years Y1, Y2...
12 FIN
13 for(@ARGV){
14 my $year=$_%400; # Cycle repeats after 400 years
15 my $previous_leaps=(floor(($year+3)/4)-floor(($year+3)/100))%7; # Leap years before start of given year
16 my $start=($year+$previous_leaps)%7; # starting weekday of year, counting from saturday=0
17 my $given_is_leap=($year==0 || ($year%100!=0 && $year%4==0))||0;
18 my $begginings=($days_to_month->slice("",[$given_is_leap,0,0])+$start)%7;
19 say "$_->", ($begginings==1)->sumover;
20 }
Example:
./ch-1.pl 2023 2000 2009
Results:
2023->2
2000->1
2009->3
Task 2: Roman Maths
Submitted by: Peter Campbell Smith
Write a script to handle a 2-term arithmetic operation expressed in Roman numeral.
Example
IV + V => IX
M - I => CMXCIX
X / II => V
XI * VI => LXVI
VII ** III => CCCXLIII
V - V => nulla (they knew about zero but didn't have a symbol)
V / II => non potest (they didn't do fractions)
MMM + M => non potest (they only went up to 3999)
V - X => non potest (they didn't do negative numbers)
The problem would be easy if the input were decimal numbers. Thus,
I translate the input to decimal, perform the given operation and then
translate back to Roman. I make a very simple calculator that reads an
operand, an operator and a second operand and I use a hash %ops to map
operators to code references. I use eval to initialize all code
references without unnecessary repetitions. I used the cpan module Text::Roman to
handle the conversions. This allows a three-liner:
perl -MPOSIX=floor -MText::Roman=:all -E '
%o=map{$_=>eval "sub(\$x,\$y){\$x$_\$y}"} qw(+ - * / ** %); say "$_ ->", r($_) for(@ARGV);
sub r($e){($x,$o,$y)=split " ", $e; $r=$o{$o}->(map {roman2int($_)}($x,$y));
return $r==0?"nulla":($r>3999||$r<0||$r!=floor $r)?"non potest":int2roman($r)}
' "IV + V" "M - I" "X / II" "XI * VI" "VII ** III" "V - V" "V / II" "MMM + M" "V - X" "XXV % IV"
Results:
IV + V ->IX
M - I ->CMXCIX
X / II ->V
XI * VI ->LXVI
VII ** III ->CCCXLIII
V - V ->nulla
V / II ->non potest
MMM + M ->non potest
V - X ->non potest
XXV % IV ->I
Notice that I assumed that the input expressions are space separated
strings of the form “operand operator operand” provided in @ARGV..
For the full code I avoided the canned solution and made my own
translation to and from roman, just for fun.
I use try/catch to
throw exceptions with malformed numbers. The conversions from and to
roman are done in the routines toD and toR. In toD I use a regular
expression to identify the thousands, hundreds, tens and units, and a
table driven conversion that checks for a 9, 90, or 900, a 4, 40, or
400, and a 5, 50, or 500, as well as the remaining ones, tens, or
hundreds. In toR I use a table driven conversion to identify the
‘nines’ (IX, XC, CM), ‘fours’ (IV, XL, CD) or ‘fives’ (V, L, D), and
the 0 to 3 remaining ‘ones’ (I, X, C, M).
1 # Perl weekly challenge 227
2 # Task 2: Roman Maths
3 #
4 # See https://wlmb.github.io/2023/07/24/PWC227/#task-2-roman-maths
5 use v5.36;
6 use experimental qw(try);
7 use POSIX qw(floor);
8 use List::Util qw(sum);
9 my %ops= # generate code for several binary operators
10 map{$_ => eval "sub(\$x, \$y){\$x $_ \$y}"}
11 qw(+ - * / ** %); # add here your favorite binop
12
13 die <<~"FIN" unless @ARGV;
14 Usage: $0 "x1 op1 y1" ["x2 op2 y2"...]
15 to perform operations op_n between pairs numbers x_n and y_n expressed
16 in Roman numerals.
17 FIN
18 for(@ARGV){
19 try{say "$_ ->", evaluate($_)}
20 catch($e){say "$_ failed: $e"}
21 }
22
23 sub evaluate($exp){
24 my ($x, $op, $y)=split " ", $exp;
25 die "Undefined operation $op" unless defined $ops{$op};
26 my $result=$ops{$op}->(map {toD($_)}($x,$y));
27 return $result==0 ?"nulla"
28 :($result>3999||$result<0||$result!=floor $result)?"non potest"
29 :toR($result)
30 }
31
32 sub toD($R){ # Roman to decimal
33 $R=~/^ # Identify components
34 (M{0,3}) # thousands
35 (CM|CD|D?(C{0,3})) # Hundreds
36 (XC|XL|L?(X{0,3})) # tens
37 (IX|IV|V?(I{0,3})) # units
38 $/x
39 or die "Failed to convert $R to decimal";
40 my($FM, $M,$D,$C,$L,$X,$V,$I)=map {$_//""} (undef, $1,$2,$3,$4,$5,$6,$7);
41 my $result= sum map {
42 my ($fives, $ones, $mult,$nine, $four, $five)=@$_;
43 local $_=$fives;
44 $mult*((m/^$nine/?9:m/^$four/?4:m/^$five/?5:0)+split "",$ones);
45 } (
46 [$FM,$M, 1000, qr/MX/, qr/MX/, qr/X/],
47 [$D, $C, 100, qr/CM/, qr/CD/, qr/D/],
48 [$L, $X, 10, qr/XC/, qr/XL/, qr/L/],
49 [$V, $I, 1, qr/IX/, qr/IV/, qr/V/],
50 );
51 return $result; #$thousands+$hundreds+$tens+$units;
52 }
53
54 sub toR($N){ # decimal to roman
55 return "non potest" if $N>3999 or $N < 0 or $N!=floor $N; # too large, negative, non integer
56 return "nulla" if $N==0;
57 return
58 join "",
59 map {
60 my ($div, $nine, $five, $four, $one)=@$_;
61 my $n=($N%(10*$div))/$div;
62 my $r0=$n>=9?$nine:$n>=5?$five:$n>=4?$four:"";
63 $n%=5;
64 my $r1=$n<4? $one x $n: "";
65 "$r0$r1";
66 }
67 (
68 [1000, "MX", "X", "MX", "M"],
69 [ 100, "CM", "D", "CD", "C"],
70 [ 10, "XC", "L", "XL", "X"],
71 [ 1, "IX", "V", "IV", "I"],
72 )
73 }
74
Example:
./ch-2.pl "IV + V" "M - I" "X / II" "XI * VI" "VII ** III" "V - V" "V / II" "MMM + M" "V - X" \
"XXV % IV" "IX * XXC"
Results:
IV + V ->IX
M - I ->CMXCIX
X / II ->V
XI * VI ->LXVI
VII ** III ->CCCXLIII
V - V ->nulla
V / II ->non potest
MMM + M ->non potest
V - X ->non potest
XXV % IV ->I
IX * XXC failed: Failed to convert XXC to decimal at ./ch-2.pl line 34.