diff options
| -rw-r--r-- | challenge-202/ealvar3z/README | 2 | ||||
| -rw-r--r-- | challenge-202/ealvar3z/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-202/ealvar3z/go/.gitignore | 1 | ||||
| -rw-r--r-- | challenge-202/ealvar3z/rust/.gitignore | 3 | ||||
| -rw-r--r-- | challenge-202/ealvar3z/rust/src/main.rs | 63 | ||||
| -rw-r--r-- | challenge-205/bruce-gray/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-205/bruce-gray/perl/ch-1.pl | 16 | ||||
| -rw-r--r-- | challenge-205/bruce-gray/perl/ch-2.pl | 24 | ||||
| -rw-r--r-- | challenge-205/bruce-gray/raku/ch-1.raku | 13 | ||||
| -rw-r--r-- | challenge-205/bruce-gray/raku/ch-2.raku | 36 | ||||
| -rw-r--r-- | challenge-205/cheok-yin-fung/perl/ch-1.pl | 29 | ||||
| -rw-r--r-- | challenge-205/cheok-yin-fung/perl/ch-2.pl | 21 | ||||
| -rwxr-xr-x | challenge-205/jo-37/perl/ch-1.pl | 81 | ||||
| -rwxr-xr-x | challenge-205/jo-37/perl/ch-2.pl | 238 | ||||
| -rw-r--r-- | challenge-205/wambash/raku/ch-1.raku | 21 | ||||
| -rw-r--r-- | challenge-205/wambash/raku/ch-2.raku | 20 |
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 +} |
