Merge pull request #8672 from jo-37/contrib

Solutions to challenge 233

2 files changed, 125 insertions, 0 deletions

diff --git a/challenge-233/jo-37/perl/ch-1.pl b/challenge-233/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..9ba9847d3d
--- /dev/null
+++ b/challenge-233/jo-37/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use List::Util qw(uniq reduce);
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [WORD...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+WORD...
+    list of words
+
+EOS
+
+
+### Input and Output
+say similar_words(@ARGV);
+
+
+### Implementation
+
+# Count the words having unique sorted characters.  In every group, all
+# the words are pairwise similar.  Calculate the number of pairs in
+# every group and sum these.
+sub similar_words {
+    my %similar;
+    $similar{join '', uniq sort split //}++ for @_;
+    reduce {$a + $b * ($b - 1) / 2} 0, values %similar;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is similar_words("aba", "aabb", "abcd", "bac", "aabc"), 2, 'example 1';
+        is similar_words("aabb", "ab", "ba"), 3, 'example 2';
+        is similar_words("nba", "cba", "dba"), 0, 'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-233/jo-37/perl/ch-2.pl b/challenge-233/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..ef0ad2a6d8
--- /dev/null
+++ b/challenge-233/jo-37/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0 '!float';
+use PDL;
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [--] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N...
+    list of numbers
+
+EOS
+
+
+### Input and Output
+
+say "(@{frequency_sort(@ARGV)})";
+
+
+### Implementation
+
+# Sort the numbers, run length encode them, create a single piddle from
+# the run lengths and values, pair run lengths and values, invert the
+# values for descending sort, lexically sort the pairs, re-invert the
+# values, separate run lengths and values into separate piddles and run
+# length decode them.
+sub frequency_sort {
+    state $inv = long 1, -1;
+    rld(
+        cat(long(@_)->qsort->rle)
+        ->xchg(0, 1)->mult($inv, 0)->qsortvec->mult($inv, 0)->xchg(0, 1)
+        ->dog
+    )->unpdl;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is frequency_sort(1,1,2,2,2,3), [3,1,1,2,2,2], 'example 1';
+        is frequency_sort(2,3,1,3,2), [1,3,3,2,2], 'example 2';
+        is frequency_sort(-1,1,-6,4,5,-6,1,4,1), [5,-1,4,4,-6,-6,1,1,1], 
+            'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}