Merge pull request #8827 from demerphq/master

Challenge #237 - Seize The Day and Maximum Greatness

8 files changed, 369 insertions, 0 deletions

diff --git a/challenge-237/demerphq/README.md b/challenge-237/demerphq/README.md
new file mode 100644
index 0000000000..66d2bdc1ca
--- /dev/null
+++ b/challenge-237/demerphq/README.md
@@ -0,0 +1,139 @@
+# Challenge 237 - Seize The Day and Maximise Greatness
+
+## Seize The Day - Simple Rules The Day
+
+My solution was based on using Time::Local to compute the epoch for noon
+on the first day of the month, and then stepping forward by day until
+the required day of week has been found, and then stepping forward by
+week until the required repetition of that day has been found, or we ran
+off the end of the calender month. Using noon instead of midnight is IMO
+a prudent guard against issues related leap seconds, but probably isn't
+really necessary but doesn't hurt either.
+
+## Maximise Greatness - Permutation Misdirection
+
+Task #2 is more difficult and IMO more interesting. The problem is
+stated as the following: "Maximise Greatness: You are given an array of
+integers. Write a script to permute the give[n] array such that you get
+the maximum possible greatness. To determine greatness, [count pairs
+that satisfy] nums[i] < perm[i] where 0 <= i < nums.length", and then
+gives the example of
+
+    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]
+
+I think this is a fun little problem and a good example of the kind of
+problem that gets posed in the perl-weekly challenge. Simple input,
+simple output, simple description, but a deeper problem than it might
+seem at first blush.
+
+The reason I say deeper is that way the problem is stated it makes it
+seem like we need to compute a permutation, and that the solution to the
+problem might be `O(N!)` or `O(N**2)`. But on closer inspection we can
+see that we need not compute a permutation at all, and we only need to
+do so if we want to visually debug that our answer is correct. It
+actually turns out that all we need to do is find the count of the most
+frequently occuring number in the array. The maximum greatness will be
+the number of elements in the array minus the count of the most
+frequently occuring element in the array.
+
+A complete proof of this is a bit beyond this document. But we can get
+the general idea by considering a sorted array. Lets say we have an
+array with duplicates, such that `A[0] < A[1] < A[2] ... < A[n-1]`. It
+is obvious that the maximum element in the array is the only one that
+cannot be paired with something larger than it. We can view this as a
+rotation of the array:
+
+```
+    | 1, 2, 3 |
+    | 2, 3, 1 | <- rotate left by 1.
+    | X  X    |  <- Which columns satisfy the constraint
+```
+
+In this case it is obvious that the maximum greatness is 1 less than
+number of elements in the array, and 1 is the count of the most
+frequently occuring element. If we then duplicate one of the elements
+and we rotate the array by different numbers of elements we can see
+maximum is the same regardless of which element is duplicated, and that
+the rotating any more than the number of duplicates causes the number of
+pairs that satisify the constraint to reduce.
+
+```
+    | 1, 1, 2, 3 | 1, 2, 2, 3 | 1, 2, 3, 3 |
+    | 1, 2, 3, 1 | 2, 2, 3, 1 | 2, 3, 3, 1 | <- rotate 1
+    | X  X       | X     X    | X  X       |
+
+    | 1, 1, 2, 3 | 1, 2, 2, 3 | 1, 2, 3, 3 |
+    | 2, 3, 1, 1 | 2, 3, 1, 2 | 3, 3, 1, 2 | <- rotate 2
+    | X  X       | X  X       | X  X       |
+
+    | 1, 1, 2, 3 | 1, 2, 2, 3 | 1, 2, 3, 3 |
+    | 3, 1, 1, 2 | 3, 1, 2, 2 | 3, 1, 2, 3 | <- rotate 3
+    | X          | X          | X          |
+```
+
+The same pattern holds if the array contains two sets of duplicated
+numbers, the maximum number of pairs is found when the rotation matches
+the count of the most frequently repeated element:
+
+```
+    | 1, 1, 2, 2, 3 | 1, 2, 2, 3, 3 | 1, 1, 2, 3, 3 |
+    | 1, 2, 2, 3, 1 | 2, 2, 3, 3, 1 | 1, 2, 3, 3, 1 | <- rotate left by 1
+      X  X          | X     X       |    X  X       |
+
+    | 1, 1, 2, 2, 3 | 1, 2, 2, 3, 3 | 1, 1, 2, 3, 3 |
+    | 2, 2, 3, 1, 1 | 2, 3, 3, 1, 2 | 2, 3, 3, 1, 1 | <- rotate left by 2
+    | X  X  X       | X  X  X       | X  X  X       |
+
+    | 1, 1, 2, 2, 3 | 1, 2, 2, 3, 3 | 1, 1, 2, 3, 3 |
+    | 2, 3, 1, 1, 2 | 3, 3, 1, 2, 2 | 3, 3, 1, 1, 2 | <- rotate left by 3
+    | X  X          | X  X          | X  X          |
+```
+
+And lastly consider what happens when we have 1 unique element, 1 pair,
+and 1 triplicate:
+
+```
+    | 1, 2, 2, 3, 3, 3 | 1, 1, 2, 2, 2, 3 | 1, 1, 1, 2, 3, 3 |
+    | 2, 2, 3, 3, 3, 1 | 1, 2, 2, 2, 3, 1 | 1, 1, 2, 3, 3, 1 | <- rotate 1
+    | X     X          |    X        X    |       X  X       |
+
+    | 1, 2, 2, 3, 3, 3 | 1, 1, 2, 2, 2, 3 | 1, 1, 1, 2, 3, 3 |
+    | 2, 3, 3, 3, 1, 2 | 2, 2, 2, 3, 1, 1 | 1, 2, 3, 3, 1, 1 | <- rotate 2
+    | X  X  X          | X  X     X       |    X  X  X       |
+
+    | 1, 2, 2, 3, 3, 3 | 1, 1, 2, 2, 2, 3 | 1, 1, 1, 2, 3, 3 |
+    | 3, 3, 3, 1, 2, 2 | 2, 2, 3, 1, 1, 2 | 2, 3, 3, 1, 1, 1 | <- rotate 3
+    | X  X  X          | X  X  X          | X  X  X          |
+
+    | 1, 2, 2, 3, 3, 3 | 1, 1, 2, 2, 2, 3 | 1, 1, 1, 2, 3, 3 |
+    | 3, 3, 1, 2, 2, 3 | 2, 3, 1, 1, 2, 2 | 3, 3, 1, 1, 1, 2 | <- rotate 4
+    | X  X             | X  X             | X  X             |
+```
+
+In each case we can see that the maximum greatness is determined only
+by the number of elements in the array and the count of the most
+frequent element. Note, that there may actually be two rotations of a
+sorted array that produce the maximum greatness, that of the count of
+the most frequent element, and that of the count of the second most
+frequent element. If the counts differ then there will be two possible
+rotations that give the maximum greatness.
+
+The last point to observe is that if we **must** produce a permutation
+that would produce the maximum greatness then we can produce an array
+`S` of the indexes of the input array such that `A[S[i]] <= A[S[i+1]]`.
+We can then solve for the sorted array by rotating it left by the count
+of the most frequent element, and then use `S` to map the solution into
+the appropriate order for the actual input array.
+
+Thus if we are to compute the maximum greatness alone we can do so
+in `O(N)` steps. If we are to produce a permutation of the input
+array would produce that maximum greatness we can do so in
+`O(N log2 N)` steps.
diff --git a/challenge-237/demerphq/blog.txt b/challenge-237/demerphq/blog.txt
new file mode 100644
index 0000000000..69ae9e6708
--- /dev/null
+++ b/challenge-237/demerphq/blog.txt
@@ -0,0 +1 @@
+https://github.com/demerphq/perlweeklychallenge-club/tree/master/challenge-237/demerphq#readme
diff --git a/challenge-237/demerphq/js/.gitignore b/challenge-237/demerphq/js/.gitignore
new file mode 100644
index 0000000000..d5f19d89b3
--- /dev/null
+++ b/challenge-237/demerphq/js/.gitignore
@@ -0,0 +1,2 @@
+node_modules
+package-lock.json
diff --git a/challenge-237/demerphq/js/ch-1.js b/challenge-237/demerphq/js/ch-1.js
new file mode 100644
index 0000000000..9698ae8546
--- /dev/null
+++ b/challenge-237/demerphq/js/ch-1.js
@@ -0,0 +1,53 @@
+"use strict";
+
+function mdayForWeekDow(yearNum, month, week, dow) {
+    const initialTime = new Date(Date.UTC(yearNum, month, 1, 12, 0, 0, 0));
+    let time = Math.floor( initialTime.getTime() / 1000 );
+    let date;
+
+    while (true) {
+        date = new Date(time * 1000);
+        if (date.getUTCDay() === dow) {
+            break;
+        }
+        time += 24 * 60 * 60;
+    }
+
+    for (; week > 1; week--) {
+        time += 7 * 24 * 60 * 60;
+        date = new Date(time * 1000);
+        if (date.getUTCMonth() !== month) {
+            return 0;
+        }
+    }
+
+    return date.getUTCDate();
+}
+
+const dayNames = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"];
+const monthNames = [
+    "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+    "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
+];
+
+function numSuffix(n) {
+    return n + (n === 1 ? "st" : n === 2 ? "nd" : n === 3 ? "rd" : "th");
+}
+
+const testCases = [
+    [2024, 4, 1, 2],
+    [2025, 10, 2, 4],
+    [2026, 8, 5, 3],
+];
+
+testCases.forEach(([year, month, week, dow]) => {
+    const mday = mdayForWeekDow(year, month - 1, week, dow);
+    const dayName = dayNames[dow];
+    const monthName = monthNames[month - 1];
+    if (mday) {
+        console.log(`The ${numSuffix(week)} ${dayName} of ${year} ${monthName} is the ${numSuffix(mday)}`);
+    } else {
+        console.log(`The ${numSuffix(week)} ${dayName} of ${year} ${monthName} does not exist`);
+    }
+});
+
diff --git a/challenge-237/demerphq/js/ch-2.js b/challenge-237/demerphq/js/ch-2.js
new file mode 100644
index 0000000000..bbe196b695
--- /dev/null
+++ b/challenge-237/demerphq/js/ch-2.js
@@ -0,0 +1,51 @@
+"use strict";
+"use strict";
+const assert = require("assert");
+
+function maximumGreatness(array, permute) {
+    const seen = new Map();
+    let max = 0;
+
+    for (const value of array) {
+        if (!seen.has(value)) {
+            seen.set(value, 0);
+        }
+        const count = seen.get(value) + 1;
+        seen.set(value, count);
+        if (count > max) {
+            max = count;
+        }
+    }
+
+    if (permute) {
+        const sortedIdx = Array.from(array.keys()).sort((a, b) => {
+            return array[a] - array[b] || a - b;
+        });
+
+        for (let i = 0; i < array.length; i++) {
+            const next = (i + max) % array.length;
+            permute[sortedIdx[i]] = array[sortedIdx[next]];
+        }
+    }
+
+    return array.length - max;
+}
+
+const testCases = [
+    [4, [1, 3, 5, 2, 1, 3, 1], [2, 1, 1, 5, 3, 1, 3]],
+    [5, [1, 2, 2, 3, 3, 4, 4], [2, 3, 3, 4, 4, 1, 2]],
+    [4, [1, 2, 3, 4, 5], [2, 3, 4, 5, 1]],
+    [3, [55, 22, -33, 10], [-33, 55, 10, 22]]
+];
+
+testCases.forEach(([want, array, want_permute]) => {
+    const permute = new Array(array.length);
+    const count = maximumGreatness(array, permute);
+
+    assert.strictEqual(count, want, `Array [${array}] count should be ${want}`);
+    if (permute) {
+        assert.deepStrictEqual(permute, want_permute, `Permute [${want_permute}]`);
+    }
+});
+
+console.log("All tests passed!");
diff --git a/challenge-237/demerphq/js/package.json b/challenge-237/demerphq/js/package.json
new file mode 100644
index 0000000000..c83455d553
--- /dev/null
+++ b/challenge-237/demerphq/js/package.json
@@ -0,0 +1,5 @@
+{
+  "dependencies": {
+    "assert": "^2.1.0"
+  }
+}
diff --git a/challenge-237/demerphq/perl/ch-1.pl b/challenge-237/demerphq/perl/ch-1.pl
new file mode 100644
index 0000000000..dcd85c3ffa
--- /dev/null
+++ b/challenge-237/demerphq/perl/ch-1.pl
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+use Time::Local qw(timegm_posix);
+
+# Seize The Day
+#
+sub mday_for_week_dow {
+    my ($year_num, $month, $week, $dow)= @_;
+
+    my $time = timegm_posix( 0, 0, 12, 1, $month, $year_num );
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
+
+    while (1) {
+        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= gmtime($time);
+        last if $wday == $dow;
+        $time += (24 * 60 * 60);
+    }
+    for (;$week;$week--) {
+        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= gmtime($time);
+        return 0 if $mon != $month;
+        $time += (24 * 60 * 60) * 7;
+    }
+    return $mday+1;
+}
+
+my @day_name= qw(Sun Mon Tue Wed Thu Fri Sat);
+my @month_name= qw(Jan Feb Mar Apr May Jun Jul Aug Sept Oct Nov Dec);
+
+sub num_suffix {
+    my ($n)= @_;
+    return $n . ($n == 1 ? "st" : $n == 2 ? "nd" : $n == 3 ? "rd" : "th");
+}
+
+for my $tuple (
+    [2024,  4, 1, 2],
+    [2025, 10, 2, 4],
+    [2026,  8, 5, 3],
+
+) {
+    my ($year, $month, $week, $dow)= @$tuple;
+    my $mday = mday_for_week_dow($year, $month-1, $week, $dow);
+    printf "The %s %s of %s %s %s\n",
+          num_suffix($week),
+          $day_name[$dow],
+          $year,
+          $month_name[$month-1],
+          $mday ? "is the ".num_suffix($mday) : "does not exist";
+}
diff --git a/challenge-237/demerphq/perl/ch-2.pl b/challenge-237/demerphq/perl/ch-2.pl
new file mode 100644
index 0000000000..6bbd7877ee
--- /dev/null
+++ b/challenge-237/demerphq/perl/ch-2.pl
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+
+# Maximum greatness. Given an array of integers compute
+# the maximum number of pairs that satisfy $A[$i] < $A[$j]
+# where each possible value of $i and $j is used only once.
+# If $permute is passed in then treat it as an array ref
+# which is to be populated with the permutation of $array
+# that would produce that maximum number of pairs.
+
+sub maximum_greatness {
+    my ($array, $permute) = @_;
+
+    # Compute the number of occurrences of each unique value, keeping
+    # track of the maximum number of occurrences. If the array was large
+    # and the number of duplicates high we might get better performance
+    # by doing two loops, first over the array itself, and then over the
+    # values in the result. But for arrays with few or no duplicated
+    # values this will be faster.
+
+    my %seen;
+    my $max = 0;
+    $seen{$value}++ for @$array;
+    foreach my $value (@$array) {
+        my $count = ++$seen{$value};
+        $max = $count if $max < $count;
+    }
+
+    if ($permute) {
+        # they have asked us to compute the permutation
+        # as the count, so we have to sort the array.
+
+        # sort the indexes into the original array, not
+        # the array itself so we can use it to populate
+        # $permute as well as read from $array.
+        my @sorted_idx = sort {
+                            $array->[$a] <=> $array->[$b] ||
+                            $a <=> $b
+                        } 0 .. $#$array;
+
+        # now compute the permutation
+        for my $i (0 .. $#$array) {
+            my $next = ($i + $max) % @$array;
+            $permute->[$sorted_idx[$i]] = $array->[$sorted_idx[$next]];
+        }
+    }
+
+    return @$array - $max;
+}
+
+
+use Test::More;
+foreach my $tuple (
+    [ 4, [ 1, 3, 5, 2, 1, 3, 1 ],
+         [ 2, 1, 1, 5, 3, 1, 3 ] ],
+    [ 5, [ 1, 2, 2, 3, 3, 4, 4 ],
+         [ 2, 3, 3, 4, 4, 1, 2 ]],
+    [ 4, [ 1, 2, 3, 4, 5 ],
+         [ 2, 3, 4, 5, 1 ] ],
+    [ 3, [  55, 22, -33, 10 ],
+         [ -33, 55,  10, 22 ] ],
+) {
+    my ($want, $array, $want_permute)= @$tuple;
+    my $permute = [];
+    my $count = maximum_greatness($array, $permute);
+    is($count, $want, "Array   [@$array] count should be $want");
+    is("@$permute", "@$want_permute", "Permute [@$want_permute]")
+        if $permute;
+}
+done_testing();