Perl Weekly Challenge 227.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 227.

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

``````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  #
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.
``````
Written on July 24, 2023