Solutions to challenge 260

3 files changed, 188 insertions, 0 deletions

diff --git a/challenge-260/jo-37/blog.txt b/challenge-260/jo-37/blog.txt
new file mode 100644
index 0000000000..a92aa48e2b
--- /dev/null
+++ b/challenge-260/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2024/03/15/ch-260.html
diff --git a/challenge-260/jo-37/perl/ch-1.pl b/challenge-260/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..ecb30e6b94
--- /dev/null
+++ b/challenge-260/jo-37/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use List::Util 'pairvalues';
+use List::MoreUtils qw(frequency duplicates);
+
+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
+
+-verbose
+    enable trace output
+
+N...
+    list of numbers
+
+EOS
+
+
+### Input and Output
+
+say 0 + uniq_occur(@ARGV);
+
+
+### Implementation
+
+sub uniq_occur {
+    ! duplicates pairvalues frequency @_;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        ok  uniq_occur(1,2,2,1,1,3),            'example 1';
+        ok !uniq_occur(1,2,3),                  'example 2';
+        ok  uniq_occur(-2,0,1,-2,1,1,0,1,-2,9), 'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-260/jo-37/perl/ch-2.pl b/challenge-260/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..3f30044988
--- /dev/null
+++ b/challenge-260/jo-37/perl/ch-2.pl
@@ -0,0 +1,128 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use bigint;
+use Math::Prime::Util qw(vecsum vecprod factorial vecreduce);
+use List::AllUtils qw(sort_by count_by pairs);
+use experimental qw(refaliasing signatures);
+
+our ($tests, $examples, $benchmark);
+
+run_tests() if $tests || $examples || $benchmark;	# does not return
+
+die <<EOS unless @ARGV == 1;
+usage: $0 [-examples] [-tests] [W]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-benchmark
+    run benchmark
+
+W
+    a word
+
+EOS
+
+
+### Input and Output
+
+say 1 + dictionary_rank(shift);
+
+
+### Implementation
+
+sub dictionary_rank {
+    no bigint;
+    my @chars = split //, shift;
+    my @freq = sort_by {$_->[0]} pairs count_by {$_} @chars;
+    (\my %chartoidx)->@{map $_->[0], @freq} = 0 .. $#freq;
+    my @mperm = @chartoidx{@chars};
+    my @mset = map $_->[1], @freq;
+    
+    use bigint;
+    my $mult = factorial(@mperm) / vecprod map factorial($_), @mset;
+    multipermtonum(0->copy, $mult, \@mperm, \@mset);
+}
+
+sub multipermtonum ($, $, $perm, $set) {
+    \my $num = \$_[0];
+    \my $mult = \$_[1];
+    my $n = @$perm;
+    return $num if $n == 1;
+    my $first = shift @$perm;
+
+    $num += vecreduce {
+        $a + $mult * $set->[$b] / $n;
+    } 0, grep $set->[$_], 0 .. $first - 1;
+
+    $mult = $mult * $set->[$first]-- / $n;
+
+    goto &multipermtonum;
+}
+
+# for cross check and benchmarking
+use Math::Prime::Util qw(formultiperm lastfor);
+sub count_rank {
+    my $word = shift;
+    my @word = split //, $word;
+    my $rank = 0;
+    local $" = '';
+    formultiperm {"@_" lt $word ? $rank++ : lastfor} \@word;
+    $rank;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is dictionary_rank('cat'), 2, 'example 1';
+        is dictionary_rank('google'), 87, 'example 2';
+        is dictionary_rank('secret'), 254, 'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        my $word;
+        $word = join '', reverse 'a' .. 'z';
+        is dictionary_rank($word), factorial(26) - 1, $word;
+        $word = join '', map $_ x 2, reverse 'a' .. 'p';
+        is dictionary_rank($word), factorial(32) / 2**16 - 1, $word;
+	}
+
+    SKIP: {
+        use Benchmark 'cmpthese';
+        skip "benchmark" unless $benchmark;
+
+        # cross check against enumeration
+        my @alphabet = qw(e o t h a s i n r d);
+        my @word;
+        push @word, $alphabet[rand @alphabet] for 0 .. 9;
+        my $word = join '', @word;
+
+        my $rank;
+        is $rank = dictionary_rank($word), count_rank($word),
+            "rank('$word') = $rank";
+
+        cmpthese(0, {
+                count => "count_rank($word)",
+                calc => "dictionary_rank($word)"
+            });
+    }
+
+    done_testing;
+    exit;
+}
+
+__DATA__
+        Rate   count    calc
+count 1.89/s      --   -100%
+calc  1907/s 100981%      --