diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2024-02-21 22:13:32 +0100 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2024-02-23 21:50:24 +0100 |
| commit | ad04e23250080bfc5e03f8159fd8ff3e5a5bc4e7 (patch) | |
| tree | 83cdf3b1534be2fad95e4b7d5d5e1b0a56485c75 | |
| parent | da664c025eeb01397e74c61b2af119f1fe1e68e7 (diff) | |
| download | perlweeklychallenge-club-ad04e23250080bfc5e03f8159fd8ff3e5a5bc4e7.tar.gz perlweeklychallenge-club-ad04e23250080bfc5e03f8159fd8ff3e5a5bc4e7.tar.bz2 perlweeklychallenge-club-ad04e23250080bfc5e03f8159fd8ff3e5a5bc4e7.zip | |
Solution to task 1
| -rwxr-xr-x | challenge-257/jo-37/perl/ch-1.pl | 81 |
1 files changed, 81 insertions, 0 deletions
diff --git a/challenge-257/jo-37/perl/ch-1.pl b/challenge-257/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..93bd7fb00c --- /dev/null +++ b/challenge-257/jo-37/perl/ch-1.pl @@ -0,0 +1,81 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0 '!float'; +use PDL; +use PDL::NiceSlice; +use Benchmark 'cmpthese'; + +our ($tests, $examples, $benchmark); + +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... + list of numbers + +EOS + + +### Input and Output + +say sdc(@ARGV); + + +### Implementation + +sub sdc { + my $l = long @_; + my $si = $l->qsorti; + cat($si, sequence($l) - $l->($si)->dummy(0)->enumvec) + ->xchg(0,1)->qsortvec->((1)); +} + +sub sdc_full { + my $l = long @_; + ($l < $l->dummy(0))->sumover; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is sdc(5, 2, 1, 6)->unpdl, [2, 1, 0, 3], 'example 1'; + is sdc(1, 2, 0, 3)->unpdl, [1, 2, 0, 3], 'example 2'; + is sdc(0, 1)->unpdl, [0, 1], 'example 3'; + is sdc(9, 4, 9, 2)->unpdl, [2, 1, 2, 0], 'example 4'; + + } + + SKIP: { + skip "tests" unless $tests; + } + + SKIP: { + skip "benchmark" unless $benchmark; + + my $n = 10000; + my $l = ($n * random $n)->long; + ok all(sdc_full($l) == sdc($l)), 'cross-check'; + + cmpthese(0, { + full => sub {sdc_full($l)}, + rank => sub {sdc($l)} + }); + + } + + done_testing; + exit; +} |
