aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-202/ealvar3z/README2
-rw-r--r--challenge-202/ealvar3z/blog.txt1
-rw-r--r--challenge-202/ealvar3z/go/.gitignore1
-rw-r--r--challenge-202/ealvar3z/rust/.gitignore3
-rw-r--r--challenge-202/ealvar3z/rust/src/main.rs63
-rw-r--r--challenge-205/bruce-gray/blog.txt1
-rw-r--r--challenge-205/bruce-gray/perl/ch-1.pl16
-rw-r--r--challenge-205/bruce-gray/perl/ch-2.pl24
-rw-r--r--challenge-205/bruce-gray/raku/ch-1.raku13
-rw-r--r--challenge-205/bruce-gray/raku/ch-2.raku36
-rw-r--r--challenge-205/cheok-yin-fung/perl/ch-1.pl29
-rw-r--r--challenge-205/cheok-yin-fung/perl/ch-2.pl21
-rwxr-xr-xchallenge-205/jo-37/perl/ch-1.pl81
-rwxr-xr-xchallenge-205/jo-37/perl/ch-2.pl238
-rw-r--r--challenge-205/wambash/raku/ch-1.raku21
-rw-r--r--challenge-205/wambash/raku/ch-2.raku20
16 files changed, 568 insertions, 2 deletions
diff --git a/challenge-202/ealvar3z/README b/challenge-202/ealvar3z/README
index a50c065308..d35a294b26 100644
--- a/challenge-202/ealvar3z/README
+++ b/challenge-202/ealvar3z/README
@@ -1 +1 @@
-Solution by ealvar3z
+Solution by ealvar3z. Run `cargo test` to check them.
diff --git a/challenge-202/ealvar3z/blog.txt b/challenge-202/ealvar3z/blog.txt
new file mode 100644
index 0000000000..c849c43be3
--- /dev/null
+++ b/challenge-202/ealvar3z/blog.txt
@@ -0,0 +1 @@
+https://eax.bearblog.dev/perl-weekly-challenge-205/
diff --git a/challenge-202/ealvar3z/go/.gitignore b/challenge-202/ealvar3z/go/.gitignore
deleted file mode 100644
index 654da7a30f..0000000000
--- a/challenge-202/ealvar3z/go/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-go.mod
diff --git a/challenge-202/ealvar3z/rust/.gitignore b/challenge-202/ealvar3z/rust/.gitignore
new file mode 100644
index 0000000000..9a30948bdd
--- /dev/null
+++ b/challenge-202/ealvar3z/rust/.gitignore
@@ -0,0 +1,3 @@
+/target
+Cargo.toml
+Cargo.lock
diff --git a/challenge-202/ealvar3z/rust/src/main.rs b/challenge-202/ealvar3z/rust/src/main.rs
new file mode 100644
index 0000000000..0a38c837a5
--- /dev/null
+++ b/challenge-202/ealvar3z/rust/src/main.rs
@@ -0,0 +1,63 @@
+#[cfg(test)]
+mod tests {
+ use super::*;
+
+ #[test]
+ pub fn test_task_one() {
+ let a = [5,3,4];
+ let b = [5,6];
+ let c = [5,4,4,3];
+
+ assert_eq!(task_one(&a), 3);
+ assert_eq!(task_one(&b), 6);
+ assert_eq!(task_one(&c), 3);
+ }
+
+ #[test]
+ pub fn test_task_two() {
+ let a = [1,2,3,4,5,6,7];
+ let b = [2,4,1,3];
+ let c = [10,5,7,12,8];
+
+ assert_eq!(task_two(&a), 7);
+ assert_eq!(task_two(&b), 7);
+ assert_eq!(task_two(&c), 15);
+ }
+}
+
+pub fn task_one(arr: &[i32]) -> i32 {
+ let highest = arr.iter().max().cloned().unwrap_or_default();
+ let x = arr.iter().filter(|&i| *i != highest);
+ let snd_highest = x.clone().max().cloned().unwrap_or_default();
+ let third_highest = x.filter(|&i| *i != snd_highest);
+ return *third_highest.max().unwrap_or(&highest);
+}
+
+pub fn task_two(arr: &[i32]) -> i32 {
+ arr.iter()
+ .enumerate()
+ .fold(0, |max_xor, (i, &x)| {
+ arr[i+1..]
+ .iter()
+ .fold(max_xor, |max_xor, &y| {
+ let xor = x ^ y;
+ return xor.max(max_xor)
+ })
+ })
+}
+
+fn main() {
+ #[cfg(test)]
+ mod test_runner {
+ use super::tests;
+
+ pub fn run() {
+ tests::test_task_one();
+ tests::test_task_two();
+ }
+ }
+
+ #[cfg(test)]
+ test_runner::run();
+}
+
diff --git a/challenge-205/bruce-gray/blog.txt b/challenge-205/bruce-gray/blog.txt
new file mode 100644
index 0000000000..b9b0d6392a
--- /dev/null
+++ b/challenge-205/bruce-gray/blog.txt
@@ -0,0 +1 @@
+https://blogs.perl.org/users/bruce_gray/2023/02/twc-205-exclusive-third-or-first.html
diff --git a/challenge-205/bruce-gray/perl/ch-1.pl b/challenge-205/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..a6d723c0f1
--- /dev/null
+++ b/challenge-205/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,16 @@
+use v5.36;
+use List::Util qw<uniq>;
+sub task1 ( $ns ) {
+ my ( $x1, $x2, $x3 ) = sort { $b <=> $a } uniq @{$ns};
+ return $x3 // $x1;
+}
+
+
+my @tests = (
+ [ [ 5, 3, 4 ], 3 ], # 5 4 3
+ [ [ 5, 6 ], 6 ], # 6 5 * Third highest is missing, so maximum is returned.
+ [ [ 5, 4, 4, 3 ], 3 ], # 5 4 3 (Aha! ties!)
+);
+use Test::More;
+plan tests => 0+@tests;
+is task1($_->[0]), $_->[1] for @tests;
diff --git a/challenge-205/bruce-gray/perl/ch-2.pl b/challenge-205/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..9e2861bf96
--- /dev/null
+++ b/challenge-205/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,24 @@
+use v5.36;
+use ntheory qw<forcomb>;
+use List::Util qq<max>;
+
+# See my Raku solution for a faster algorithm.
+sub task2 ( @ns ) {
+ my $r = 0;
+
+ forcomb {
+ $r = max( $r, $ns[$_[0]] ^ $ns[$_[1]] );
+ } @ns, 2;
+
+ return $r;
+}
+
+
+my @tests = (
+ [ [ 1, 2, 3, 4, 5, 6, 7 ], 7 ], # 1 xor 6 = 7
+ [ [ 2, 4, 1, 3 ], 7 ], # 4 xor 3 = 7
+ [ [ 10, 5, 7, 12, 8 ], 15 ], # 10 xor 5 = 15
+);
+use Test::More;
+plan tests => 0+@tests;
+is task2(@{$_->[0]}), $_->[1] for @tests;
diff --git a/challenge-205/bruce-gray/raku/ch-1.raku b/challenge-205/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..8af9db5649
--- /dev/null
+++ b/challenge-205/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,13 @@
+sub task1 ( @ns ) {
+ return (.elems == 3 ?? .head !! .tail) given @ns.sort.squish.tail(3);
+}
+
+
+my @tests =
+ ( ( 5, 3, 4 ), 3 ), # 5 4 3
+ ( ( 5, 6 ), 6 ), # 6 5 * Third highest is missing, so maximum is returned.
+ ( ( 5, 4, 4, 3 ), 3 ), # 5 4 3 (Aha! ties!)
+;
+use Test;
+plan +@tests;
+is task1(.[0]), .[1] for @tests;
diff --git a/challenge-205/bruce-gray/raku/ch-2.raku b/challenge-205/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..2b98b2d10c
--- /dev/null
+++ b/challenge-205/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,36 @@
+# In Raku, we can solve the task in one line:
+sub task2_short { @_.unique.combinations(2).map({ [+^] .list }).max }
+
+# But with a bit of analysis, we can go *much* faster!
+# See blog post for explanation of the algorithm.
+sub task2_fast ( @ns ) {
+ sub hi-bit ( UInt $n ) { $n.log2.floor }
+
+ my %grouped = @ns.unique.classify(&hi-bit);
+
+ my ($top_group, @lesser_groups) = %grouped.sort(-*.key).map(*.value);
+
+ if !@lesser_groups {
+ my $removes_hi-bit = 1 +< hi-bit($top_group[0]);
+ return task2_fast( $top_group.list »-» $removes_hi-bit );
+ }
+ else {
+ return [max] @lesser_groups.map: {
+ ($top_group.list X+^ .list).max;
+ }
+ }
+}
+
+
+# my &task2 = &task2_short;
+my &task2 = &task2_fast;
+my @tests =
+ ( ( 1, 2, 3, 4, 5, 6, 7 ), 7 ), # 1 xor 6 = 7
+ ( ( 2, 4, 1, 3 ), 7 ), # 4 xor 3 = 7
+ ( ( 10, 5, 7, 12, 8 ), 15 ), # 10 xor 5 = 15
+
+ ( [ flat(1 .. 4095) ], 4095 ), # short=113sec, fast=5sec !!!
+;
+use Test;
+plan +@tests;
+is task2(.[0]), .[1] for @tests;
diff --git a/challenge-205/cheok-yin-fung/perl/ch-1.pl b/challenge-205/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..5fb7319342
--- /dev/null
+++ b/challenge-205/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,29 @@
+# The Weekly Challenge 205
+# Task 1 Third Highest
+use v5.30.0;
+use warnings;
+use List::Util qw/max uniq/;
+
+sub th {
+ my @arr = @_;
+ @arr = uniq @arr;
+ my $max = $arr[0];
+ my $scmax = $arr[1];
+ return $max if !defined($scmax);
+ my $thmax = $arr[2];
+ ($max, $scmax) = ($scmax, $max) if $scmax > $max;
+ return $max if !defined($thmax);
+ for my $i (2..$#arr) {
+ $thmax = $arr[$i] if $arr[$i] > $thmax;
+ ($thmax, $scmax) = ($scmax, $thmax) if $thmax > $scmax;
+ ($max, $scmax) = ($scmax, $max) if $scmax > $max;
+ }
+ return $thmax;
+}
+
+use Test::More tests=>5;
+ok th(5,3,4) == 3;
+ok th(5,6) == 6;
+ok th(5,4,4,3) == 3;
+ok th(1,1,1,1) == 1;
+ok th(1,2,3,4) == 2;
diff --git a/challenge-205/cheok-yin-fung/perl/ch-2.pl b/challenge-205/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..1f6802ae84
--- /dev/null
+++ b/challenge-205/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,21 @@
+# The Weekly Challenge 205
+# Task 2 Maximum XOR
+use v5.30.0;
+use warnings;
+use List::Util qw/max/;
+
+sub mx {
+ my @arr = @_;
+ my @xor;
+ for my $i (0..$#arr) {
+ for my $j ($i+1..$#arr) {
+ push @xor, $arr[$i] ^ $arr[$j]
+ }
+ }
+ return max @xor;
+}
+
+use Test::More tests=>3;
+ok mx(1,2,3,4,5,6,7) == 7;
+ok mx(2,4,1,3) == 7;
+ok mx(10,5,7,12,8) == 15;
diff --git a/challenge-205/jo-37/perl/ch-1.pl b/challenge-205/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..9df8da3d12
--- /dev/null
+++ b/challenge-205/jo-37/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0 '!float';
+use PDL;
+use PDL::NiceSlice;
+use List::Util 'uniqnum';
+
+our ($tests, $examples, $n);
+
+$n //= 3;
+
+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=N
+ find N-th largest element. Default: 3
+
+N...
+ list of integers
+
+EOS
+
+
+### Input and Output
+
+say nth_max($n, @ARGV);
+
+
+### Implementation
+
+# Keep N in the "N-th" largest element variable.
+
+sub nth_max {
+ my $n = shift;
+ # Not using PDL's "uniq" because it would sort the data. There's a
+ # significant difference in running time for larger lists.
+ my $l = pdl uniqnum @_;
+
+ # The "otherwise" branch: there is no n-th maximal element.
+ return max $l if $l->nelem < $n;
+
+ # Find the indices of the n largest elements. Populates the second
+ # argument in its given size.
+ maximum_n_ind $l, my $max_ind = zeroes indx, $n;
+
+ # Pick the element indexed by the last in list, which is the n-th
+ # largest.
+ $l($max_ind(-1))->sclr;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+
+ is nth_max(3, (5, 3, 4)), 3, 'example 1';
+ is nth_max(3, (5, 6)), 6, 'example 2';
+ is nth_max(3, (5, 4, 4, 3)), 3, 'example 3';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+
+ is nth_max(3, (3, 4, 3, 4, 3)), 4, 'not enought unique numbers';
+ }
+
+
+ done_testing;
+ exit;
+}
diff --git a/challenge-205/jo-37/perl/ch-2.pl b/challenge-205/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..a30457dd8c
--- /dev/null
+++ b/challenge-205/jo-37/perl/ch-2.pl
@@ -0,0 +1,238 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0 '!float';
+use Math::Prime::Util qw(todigits fromdigits);
+use PDL;
+use PDL::NiceSlice;
+use Benchmark 'cmpthese';
+
+our ($tests, $examples, $verbose, $benchmark);
+
+run_tests() if $tests || $examples || $benchmark; # does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [-benchmark] [-verbose] [N...]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+-verbose
+ trace processing
+
+-benchmark
+ compare implementations. Needs about 4GB RAM.
+
+N...
+ list of integers
+
+EOS
+
+
+### Input and Output
+
+say max_xor_intersect(@ARGV);
+
+
+### Implementation
+
+# This is just an simplistic brute-force implementation with a time
+# complexity of O(N^2). Though is very fast, it is very memory
+# consuming.
+sub max_xor_cartesian {
+ my $l = long @_;
+ # Take the maximum of all pairwise xor'ed numbers.
+ ($l->dummy(0) ^ $l->dummy(1))->maxover->maxover->sclr;
+}
+
+# The memory footprint of the above implementation may be reduced
+# drastically by using two nested loops, performing an XOR between two
+# elements and comparing the result to the current found maximum.
+# Implementing this in pure Perl slows it down remarkably, though.
+sub max_xor_pure {
+ my $max = 0;
+ for my $i (0 .. $#_ - 1) {
+ for my $k ($i + 1 .. $#_) {
+ my $xor = $_[$i] ^ $_[$k];
+ $max = $xor if $xor > $max;
+ }
+ }
+ $max;
+}
+
+# There should be a way to find the maximum other than by processing all
+# element pairs.
+#
+# To reduce the number of pair operations, we maintain a list of set
+# pairs holding indices into the number list.
+# At each step of the procedure, any member from the first set of a
+# pair, when XORed with any member of the second set, will result in
+# a maximum value over some bits, starting with the most significant.
+#
+# The starting list is a single pair of sets with the first set holding
+# the indices to all elements having a higest significant bit set and
+# the second with this bit unset. The bit position is the higest where
+# both sets are not empty.
+#
+# Given a list of set pairs, for each pair two new pairs are
+# constructed, such that the XOR over the next bit becomes maximal.
+# Only pairs with both sets not empty are considered.
+# If there is such an nonempty pair, the bit position in the final
+# result is one and the new constructes list of pairs is carried to the
+# next bit position. Otherwise the final result has a zero at this bit
+# position and the original list of set pairs remains unaltered.
+#
+# As all sets in any list of set pairs are pairwise disjoint,
+# the complexity of this algorithm is O(N * K) with N as the number of
+# elements and K as the number of significant bits over all numbers.
+# For constant K this would be O(N).
+#
+# For smaller lists, the full scan is much faster than this procedure.
+# However, with 32K elements the set based approach outruns the full
+# scan, which already needs about 4GB for a list of this size. Beyond
+# that, the scan approach seems to follow the linear increase but has no
+# competitors any longer. See benchmark results below.
+#
+
+sub max_xor_intersect {
+ # Convert numbers to their binary digits.
+ my $bits = byte(map [reverse(todigits($_, 2))], @_)->(-1:0);
+ say "bits: $bits" if $verbose;
+
+ my $pairlist;
+ my @num;
+ my $val;
+ # Loop over bit positions.
+ for my $bit ($bits->xchg(0, 1)->dog) {
+ say "bits: $bit" if $verbose;
+ # Create initial pair list.
+ if (!$pairlist) {
+ my @which = which_both $bit;
+ if (!$which[0]->isempty && !$which[1]->isempty) {
+ if ($verbose) {
+ say "startpair:";
+ say for @which;
+ }
+ $pairlist = [[@which]];
+ push @num, 1;
+ }
+ next;
+ }
+ my $newpairs;
+ my $val = 0;
+ # Loop over set pairs.
+ for my $pair (@$pairlist) {
+ if ($verbose) {
+ say "processing pair:";
+ say $_ for @$pair;
+ }
+ # Build two new pairs of sets, keep only non-empty pairs.
+ for (0, 1) {
+ my $newpair = [$pair->[0]->where($_ ^ $bit($pair->[0])),
+ $pair->[1]->where(!$_ ^ $bit($pair->[1]))];
+ if (!$newpair->[0]->isempty && !$newpair->[1]->isempty) {
+ if ($verbose) {
+ say "found new pair:";
+ say for @$newpair;
+ }
+ push @$newpairs, $newpair;
+ $val = 1;
+ }
+ }
+ }
+ # Use the new pair list if it not empty.
+ if ($val) {
+ $pairlist = $newpairs;
+ }
+ # Record the bit value for the result.
+ push @num, $val
+ }
+ say "numbits: [@num]" if $verbose;
+ return fromdigits \@num, 2;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+
+ is max_xor_intersect(1, 2, 3, 4, 5, 6, 7), 7, 'example 1';
+ is max_xor_intersect(2, 4, 1, 3), 7, 'example 2';
+ is max_xor_intersect(10,5,7,12,8), 15, 'example 3';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+
+ my @test = qw(87 103 119 115 119 118 71 71 67 83 82 86);
+ is max_xor_intersect(@test), max_xor_cartesian(@test), 'cross check';
+ }
+
+ SKIP: {
+ skip "benchmark" unless $benchmark;
+
+ {
+ no warnings 'once';
+ $PDL::BIGPDL ||= 1;
+ }
+ local $verbose;
+ for my $p (9, 12, 15) {
+ say "N=", 2**$p;
+ my @test = long(2**31 * random 2**$p)->list;
+ my $max_xor_intersect = max_xor_intersect(@test);
+ say "max=$max_xor_intersect";
+ is $max_xor_intersect, max_xor_cartesian(@test), 'cross check 1';
+ is max_xor_pure(@test), $max_xor_intersect, 'cross check 2';
+ cmpthese(0, {
+ cartesian => sub {max_xor_cartesian(@test)},
+ intersect => sub {max_xor_intersect(@test)},
+ pure => sub {max_xor_pure(@test)},
+ });
+ print "\n";
+ }
+ }
+
+ done_testing;
+ exit;
+}
+
+__DATA__
+# Seeded srand with seed '20230226' from local date.
+ok 1 - skipped test # skip examples
+ok 2 - skipped test # skip tests
+N=512
+max=2147478155
+ok 3 - cross check 1
+ok 4 - cross check 2
+ Rate intersect pure cartesian
+intersect 33.0/s -- -65% -99%
+pure 95.0/s 188% -- -96%
+cartesian 2584/s 7729% 2620% --
+
+N=4096
+max=2147483128
+ok 5 - cross check 1
+ok 6 - cross check 2
+ Rate pure intersect cartesian
+pure 1.51/s -- -67% -95%
+intersect 4.53/s 201% -- -86%
+cartesian 33.4/s 2120% 638% --
+
+N=32768
+max=2147483643
+ok 7 - cross check 1
+ok 8 - cross check 2
+ (warning: too few iterations for a reliable count)
+ (warning: too few iterations for a reliable count)
+ (warning: too few iterations for a reliable count)
+ s/iter pure cartesian intersect
+pure 43.2 -- -94% -96%
+cartesian 2.39 1704% -- -20%
+intersect 1.91 2162% 25% --
+
+1..8
diff --git a/challenge-205/wambash/raku/ch-1.raku b/challenge-205/wambash/raku/ch-1.raku
new file mode 100644
index 0000000000..4b7507bdc9
--- /dev/null
+++ b/challenge-205/wambash/raku/ch-1.raku
@@ -0,0 +1,21 @@
+#!/usr/bin/env raku
+
+sub third-highest (+@list) {
+ @list
+ andthen .sort
+ andthen .reverse
+ andthen .squish
+ andthen .[2]//.[0]
+}
+
+multi MAIN (Bool :test($)!) {
+ use Test;
+ is third-highest(5,3,4),3;
+ is third-highest(5,6),6;
+ is third-highest(5,4,4,3),3;
+ done-testing;
+}
+
+multi MAIN (+@list) {
+ say third-highest @list
+}
diff --git a/challenge-205/wambash/raku/ch-2.raku b/challenge-205/wambash/raku/ch-2.raku
new file mode 100644
index 0000000000..d86a1ce2fb
--- /dev/null
+++ b/challenge-205/wambash/raku/ch-2.raku
@@ -0,0 +1,20 @@
+#!/usr/bin/env raku
+
+sub maximum-xor (+@list) {
+ @list
+ andthen .combinations: 2
+ andthen .map: -> (\x,\y) {x +^ y}\
+ andthen .max
+}
+
+multi MAIN (Bool :test($)!) {
+ use Test;
+ is maximum-xor(1..7),7;
+ is maximum-xor(2,4,1,3),7;
+ is maximum-xor(10,5,7,12,8),15;
+ done-testing;
+}
+
+multi MAIN (*@list) {
+ say maximum-xor @list
+}