From ad64925b28fbe6f6a9743b053151f45a01776bbd Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 27 May 2024 15:50:50 +0200 Subject: Solution to task 1 --- challenge-271/jo-37/perl/ch-1.pl | 59 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100755 challenge-271/jo-37/perl/ch-1.pl diff --git a/challenge-271/jo-37/perl/ch-1.pl b/challenge-271/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..b218d44fec --- /dev/null +++ b/challenge-271/jo-37/perl/ch-1.pl @@ -0,0 +1,59 @@ +#!/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 < Date: Mon, 27 May 2024 15:51:06 +0200 Subject: Solution to task 2 --- challenge-271/jo-37/perl/ch-2.pl | 119 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 119 insertions(+) create mode 100755 challenge-271/jo-37/perl/ch-2.pl diff --git a/challenge-271/jo-37/perl/ch-2.pl b/challenge-271/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..9076839b31 --- /dev/null +++ b/challenge-271/jo-37/perl/ch-2.pl @@ -0,0 +1,119 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0 '!float'; +use PDL; +use PDL::NiceSlice; +use Benchmark 'cmpthese'; + +our ($tests, $examples, $benchmark); + +die "IV size of at least 48 bit required\n" if 48 > unpack '%b*', pack 'j', -1; + +run_tests() if $tests || $examples || $benchmark; # does not return + +die <[1], + sort {$a->[0] <=> $b->[0] || $a->[1] <=> $b->[1]} + map [unpack('%b*', pack 'l', $_), $_], @_; +} + +sub sort_by_one_bits_idx { + my @bc = unpack '(%b32)*', pack 'l*', @_; + + @_[sort {$bc[$a] <=> $bc[$b] || $_[$a] <=> $_[$b]} 0 .. $#_]; +} + +sub sort_by_one_bits_comp { + my @bc = unpack '(%b32)*', pack 'l*', @_; + + unpack 'l*', pack 'L*', + sort {$a <=> $b} + map shift(@bc) << 40 | ($_ > 0) << 32 | (2**32 - 1) & $_, @_; +} + +sub sort_by_one_bits_pdl { + my $n = long @_; + my $bc = long unpack '(%b32)*', $n->get_dataref->$*; + + $bc->dummy(0)->append($n->dummy(0))->qsortvec->((1)); +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is [sort_by_one_bits(0 .. 8)], [0, 1, 2, 4, 8, 3, 5, 6, 7], + 'example 1'; + + is [sort_by_one_bits(1024, 512, 256, 128, 64)], + [64, 128, 256, 512, 1024], 'example 2'; + } + + SKIP: { + skip "tests" unless $tests; + + my $given = [0, 1, 3, -2**31, -2**30]; + my @given = (0, 1, 3, -2**31, -2**30); + my $expected = [0, -2**31, 1, -2**30, 3]; + is [sort_by_one_bits(@given)], $expected, 'straight'; + is [sort_by_one_bits_idx(@given)], $expected, 'index sort'; + is [sort_by_one_bits_comp(@given)], $expected, 'composite key'; + is sort_by_one_bits_pdl(@given)->unpdl, $expected, 'pdl'; + } + + + SKIP: { + skip "benchmark" unless $benchmark; + + my @n = (-2**15 .. 2**15-1); + my $expected = [sort_by_one_bits(@n)]; + is [sort_by_one_bits_comp(@n)], $expected, 'cross comp'; + is [sort_by_one_bits_idx(@n)], $expected, 'cross idx'; + is sort_by_one_bits_pdl(@n)->unpdl, $expected, 'cross pdl'; + + cmpthese(0, { + st => sub {sort_by_one_bits(@n)}, + idx => sub {sort_by_one_bits_idx(@n)}, + comp => sub {sort_by_one_bits_comp(@n)}, + pdl => sub {sort_by_one_bits_pdl(@n)}, + }); + + pass 'tests'; + } + + done_testing; + exit; +} -- cgit From 5f5036cd46617b57eb3cc48abed147531cd87eae Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 27 May 2024 15:51:20 +0200 Subject: Blog for challenge 271 --- challenge-271/jo-37/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-271/jo-37/blog.txt diff --git a/challenge-271/jo-37/blog.txt b/challenge-271/jo-37/blog.txt new file mode 100644 index 0000000000..45abfcb6bd --- /dev/null +++ b/challenge-271/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2024/05/31/ch-271.html -- cgit