# 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.
```