# Perl Weekly Challenge 237.

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

# Task 1: Seize The Day

```
Submitted by: Mark Anderson
Given a year, a month, a weekday of month, and a day of week (1 (Mon) .. 7 (Sun)),
print the day.
Example 1
Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
Output: 16
The 3rd Tue of Apr 2024 is the 16th
Example 2
Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
Output: 9
The 2nd Thu of Oct 2025 is the 9th
Example 3
Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
Output: 0
There isn't a 5th Wed in Aug 2026
```

I’ll use some results from PWC227, namely, that (extrapolating) the Gregorian calendar to the year 0000, the first day of the year was a Saturday. Furthermore, there is a leap year every four years, except for multiples of 100 which are not leap years, except for multiples of 400 which are leap years. The length of a year is 1 modulo 7 and that of a leap year is 2 modulo 7. In PWC227 I calculated using the information above the days to the beginning of each month. For simplicity I first change to a zero based numbering of days of weeks, weeks, and months. Then I calculate the first day of the week of the year and the first day of the week of the desired month, which I subtract (modulo 7) from the desired day, I add the number of weeks times 7 days a week, check if resulting date is within month and thats it. The code can be crammed into a three and a half liner, though the full code is much easier to follow.

Example 1:

```
perl -MPOSIX=floor -E 'print "@ARGV -> ";@d=([31,28,31,30,31,30,31,31,30,31,30,31],[31,29,31,30,31,30,
31,31,30,31,30,31]);@s=([0,3,3,6,1,4,6,2,5,0,3,5],[0,3,4,0,2,5,0,3,6,1,4,6]);($y,$m,$w,$n)=@ARGV;
--$w;--$m;$n%=7;$y%=400;$l=(floor(($y+3)/4)-floor(($y+3)/100))%7;$r=($y+$l+6)%7;$g=($y==0|| ($y%100
!=0 && $y%4==0))||0;$b=($s[$g][$m]+$r)%7;$q=1+($n-$b)%7+$w*7;$q=0 if $q>$d[$g][$m];say $q;
' 2024 4 3 2
```

Results:

```
2024 4 3 2 -> 16
```

Example 2:

```
perl -MPOSIX=floor -E 'print "@ARGV -> ";@d=([31,28,31,30,31,30,31,31,30,31,30,31],[31,29,31,30,31,30,
31,31,30,31,30,31]);@s=([0,3,3,6,1,4,6,2,5,0,3,5],[0,3,4,0,2,5,0,3,6,1,4,6]);($y,$m,$w,$n)=@ARGV;
--$w;--$m;$n%=7;$y%=400;$l=(floor(($y+3)/4)-floor(($y+3)/100))%7;$r=($y+$l+6)%7;$g=($y==0|| ($y%100
!=0 && $y%4==0))||0;$b=($s[$g][$m]+$r)%7;$q=1+($n-$b)%7+$w*7;$q=0 if $q>$d[$g][$m];say $q;
' 2025 10 2 4
```

Results:

```
2025 10 2 4 -> 9
```

Example 3:

```
perl -MPOSIX=floor -E 'print "@ARGV -> ";@d=([31,28,31,30,31,30,31,31,30,31,30,31],[31,29,31,30,31,30,
31,31,30,31,30,31]);@s=([0,3,3,6,1,4,6,2,5,0,3,5],[0,3,4,0,2,5,0,3,6,1,4,6]);($y,$m,$w,$n)=@ARGV;
--$w;--$m;$n%=7;$y%=400;$l=(floor(($y+3)/4)-floor(($y+3)/100))%7;$r=($y+$l+6)%7;$g=($y==0|| ($y%100
!=0 && $y%4==0))||0;$b=($s[$g][$m]+$r)%7;$q=1+($n-$b)%7+$w*7;$q=0 if $q>$d[$g][$m];say $q;
' 2026 8 5 3
```

Results:

```
2026 8 5 3 -> 0
```

The full code is:

```
1 # Perl weekly challenge 237
2 # Task 1: Seize The Day
3 #
4 # See https://wlmb.github.io/2023/10/01/PWC237/#task-1-seize-the-day
5 use v5.36;
6 use experimental qw(for_list);
7 use POSIX qw(floor);
8 die <<~"FIN" unless @ARGV && @ARGV%4==0;
9 Usage: $0 Y1 M1 W1 D1 [Y2 M2 W2 D2...]
10 to find the number corresponding to day Dn of week (1=Monday),
11 weekday of month Wn, month Mn, year Yn
12 FIN
13 my @days_of_month=([31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31], # length of months
14 [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]); # nonleap and leap
15 my @days_to_month=([0,3,3,6,1,4,6,2,5,0,3,5], # days to start of month nonleap and leap mod7
16 [0,3,4,0,2,5,0,3,6,1,4,6]);
17 my @ordinal=qw(first second third fourth fifth);
18 my @day_name=qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
19 my @month_name=qw(January February March April May June
20 July August September October November Dececmber);
21 for my($year, $month, $weekday, $day_of_week) (@ARGV){
22 warn "Weekday should be between 1 and 5: $weekday", next unless 1<=$weekday<=5;
23 warn "Day of week should be between 1 (Mon) and 7 (Sun): $day_of_week", next
24 unless 1<=$day_of_week<=7;
25 warn "Month should be between 1 and 12", next unless 1<=$month<=12;
26 --$_ for $weekday, $month; # start at 0
27 $day_of_week%=7; # Sun is now 0
28 my $reduced_year=$year%400; # Cycle repeats after 400 years
29 my $previous_leaps=(floor(($reduced_year+3)/4)
30 -floor(($reduced_year+3)/100))%7; # Leap years before start of given year
31 my $start=($reduced_year+$previous_leaps+6)%7; # starting day of week of year, counting from sunday==0
32 my $given_is_leap=($reduced_year==0 || ($reduced_year%100!=0 && $reduced_year%4==0))||0;
33 my $beggining=($days_to_month[$given_is_leap][$month]+$start)%7; # first day of week of month
34 my $day=1+($day_of_week-$beggining)%7+$weekday*7; # desired date
35 $day=0 if $day>$days_of_month[$given_is_leap][$month]; # check it lies within month
36 say "The $ordinal[$weekday] $day_name[$day_of_week] of $month_name[$month] in $year is $day";
37 }
```

Examples:

```
./ch-1.pl 2024 4 3 2 2025 10 2 4 2026 8 5 3
```

Results:

```
The third Tuesday of April in 2024 is 16
The second Thursday of October in 2025 is 9
The fifth Wednesday of August in 2026 is 0
```

# Task 2: Maximise Greatness

```
Submitted by: Mohammad S Anwar
You are given an array of integers.
Write a script to permute the give array such that you get the maximum possible greatness.
To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
Example 1
Input: @nums = (1, 3, 5, 2, 1, 3, 1)
Output: 4
One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[3] < perm[3]
nums[4] < perm[4]
Example 2
Input: @ints = (1, 2, 3, 4)
Output: 3
One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[2] < perm[2]
```

The *greatness* of an array *X* is obtained comparing its members to
those of an optimized permuted array *Y*.
Clearly, *greatness* is invariant under an initial arbitrary
permutation of the elements of *X*. It is just necessary to perform
the same permutation on the elements of *Y*. Thus, we can put *X* in
numerical order first, yielding *X’*. Then we can build the permutted
*Y’* by going through all elements of *X’*, *x’ _{n}* in order, choosing
the smallest unused number

*y’*such that

_{n}*x’*. If not possible anymore,

_{n}<y’_{n}*greatness has been achieved*, we can count how many elements we have in

*Y’*to obtain the result, and we could finish filling

*Y’*with arbitrary unused numbers to finish the permutation, although this is unnecesary.

The code fits a one and a half liner.

Example 1:

```
perl -E '@x=sort {$a<=>$b}@ARGV;@y=@x;$x=shift @x;while(@y){$y=shift @y;push(@z, $y),
$x=shift @x if $x<$y} say "@ARGV -> ", 0+@z;
' 1 3 5 2 1 3 1
```

Results:

```
1 3 5 2 1 3 1 -> 4
```

Example 2:

```
perl -E '@x=sort {$a<=>$b}@ARGV;@y=@x;$x=shift @x;while(@y){$y=shift @y;push(@z, $y),
$x=shift @x if $x<$y} say "@ARGV -> ", 0+@z;
' 1 2 3 4
```

Results:

```
1 2 3 4 -> 3
```

The full code is very similar:

```
1 # Perl weekly challenge 237
2 # Task 2: Maximise Greatness
3 #
4 # See https://wlmb.github.io/2023/10/01/PWC237/#task-2-maximise-greatness
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2...]
8 to find the greatness of the array N1 N2...
9 FIN
10 my @copy=my @sorted=sort {$a<=>$b} @ARGV;
11 my $current=shift @sorted;
12 my @permutation;
13 while(@copy){
14 my $next=shift @copy;
15 push(@permutation, $next), $current=shift @sorted if $current<$next
16 }
17 say "@ARGV -> ", 0+@permutation;
```

Examples:

```
./ch-2.pl 1 3 5 2 1 3 1
./ch-2.pl 1 2 3 4
```

Results:

```
1 3 5 2 1 3 1 -> 4
1 2 3 4 -> 3
```