diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2024-09-08 21:14:56 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2024-09-08 21:14:56 +0100 |
| commit | 316afc1486285c67d08f4a6899f69c1baaae95bf (patch) | |
| tree | e881eed861ed227c5226cfd17036f81777f7a792 | |
| parent | eb9aba50ba382919330c9aa54bdafaee365a7ddc (diff) | |
| parent | c4516fa48d5d9f3fc8e432280477d490a3b70fe4 (diff) | |
| download | perlweeklychallenge-club-316afc1486285c67d08f4a6899f69c1baaae95bf.tar.gz perlweeklychallenge-club-316afc1486285c67d08f4a6899f69c1baaae95bf.tar.bz2 perlweeklychallenge-club-316afc1486285c67d08f4a6899f69c1baaae95bf.zip | |
Merge pull request #10793 from jo-37/contrib
Alternative solution to challenge 284 task 2
| -rw-r--r-- | challenge-284/jo-37/blog1.txt | 1 | ||||
| -rwxr-xr-x | challenge-284/jo-37/perl/ch-2a.pl | 71 |
2 files changed, 72 insertions, 0 deletions
diff --git a/challenge-284/jo-37/blog1.txt b/challenge-284/jo-37/blog1.txt new file mode 100644 index 0000000000..f5149c4012 --- /dev/null +++ b/challenge-284/jo-37/blog1.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2024/09/08/ch-284.html diff --git a/challenge-284/jo-37/perl/ch-2a.pl b/challenge-284/jo-37/perl/ch-2a.pl new file mode 100755 index 0000000000..1b20624871 --- /dev/null +++ b/challenge-284/jo-37/perl/ch-2a.pl @@ -0,0 +1,71 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0; +use Tree::RB::XS ':cmp'; +use experimental 'signatures'; + +our $examples; + +run_tests() if $examples; # does not return + +die <<EOS unless @ARGV == 2; +usage: $0 [-examples] [N1,N2,... M1,M2,...] + +-examples + run the examples from the challenge + +-tests + run some tests + +N1,N2,... + numbers in \@list1, comma and/or space separated + +M1,M2,... + numbers in \@list2, comma and/or space separated + +EOS + + +### Input and Output + +say "(@{relative_sort(map [split /[, ] */, $_], @ARGV)})"; + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2024/09/08/ch-284.html#task-2 + +sub relative_sort ($list1, $list2) { + my $part1 = Tree::RB::XS->new(compare_fn => CMP_INT, track_recent => 1); + my $part2 = Tree::RB::XS->new(compare_fn => CMP_INT); + $part1->insert($_, 0) for @$list2; + ${\($part1->get($_) // $part2->get_or_add($_))}++ for @$list1; + + [ + map +($_->key) x $_->value, + $part1->iter_newer->next('*'), + $part2->iter->next('*') + ]; +} + +### Examples and tests + +sub run_tests { + + is relative_sort([2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5], + [2, 1, 4, 3, 5, 6]), [2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9], + 'example 1'; + is relative_sort([3, 3, 4, 6, 2, 4, 2, 1, 3], + [1, 3, 2]), + [1, 3, 3, 3, 2, 2, 4, 4, 6], + 'example 2'; + is relative_sort([3, 0, 5, 0, 2, 1, 4, 1, 1], + [1, 0, 3, 2]), + [1, 1, 1, 0, 0, 3, 2, 4, 5], + 'example 3'; + done_testing; + + exit; +} |
