From bba8c72e3757d28e9d6ad06d45139b6b13b60782 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 26 Feb 2024 13:59:32 +0100 Subject: Solution to challenge 216 task 2 in Perl --- challenge-216/jo-37/perl/ch-2.pl | 96 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100755 challenge-216/jo-37/perl/ch-2.pl diff --git a/challenge-216/jo-37/perl/ch-2.pl b/challenge-216/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..b7981c2770 --- /dev/null +++ b/challenge-216/jo-37/perl/ch-2.pl @@ -0,0 +1,96 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0 '!float'; +use PDL; +use PDL::Opt::GLPK; + +our ($tests, $examples, $verbose); + +run_tests() if $tests || $examples; # does not return + +die < 1; +usage: $0 [-examples] [-tests] [-verbose] [TARGET STICKER...] + +-examples + run the examples from the challenge + +-tests + run some tests + +-verbose + show the required stickers instead of their count and print + the underlying linear program to "ch-2.lp" in CPLEX LP format + +TARGET + the word to be build from the given stickers + +STICKER + a list of stickers + +EOS + + +### Input and Output + +main: { + my ($selection, $count) = min_stickers(@ARGV); + if ($verbose) { + say "@$selection"; + } else { + say $count; + } +} + + +### Implementation + +sub min_stickers { + my $target = long map ord, split //, shift; + my $stickers = long map [map ord, split //, $_], @_; + + my ($b, $required) = $target->qsort->rle; + my $a = ($required->dummy(0)->dummy(0) == $stickers)->sumover; + my $c = ones($a->dim(1)); + + my $xopt = null; + my $fopt = null; + my $status = null; + + eval { + glpk($c, $a, $b, zeros($c), inf($c), + GLP_LO * ones($b), GLP_IV * ones($c), GLP_MIN, + $xopt, $fopt, $status, + {save_pb => $verbose, save_fn => 'ch-2.lp'}); + 1; + } || return ([], 0); + + ([map +($_[$_]) x $xopt->at($_), 0 .. $#_], $fopt); +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is scalar(min_stickers('peon' => 'perl','raku','python')), 2, + 'example 1'; + is scalar(min_stickers('goat' => 'love','hate','angry')), 3, + 'example 2'; + is scalar(min_stickers('accomodation' => 'come','nation','delta')), 4, + 'example 3'; + is scalar(min_stickers('accomodation' => 'come','country','delta')), 0, + 'example 4'; + } + + SKIP: { + skip "tests" unless $tests; + + is scalar(min_stickers('feo' => 'fee', 'foo')), 2, 'integer solution'; + } + + done_testing; + exit; +} -- cgit From 7b70995beb1aac44aa912338ae085a644530669e Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 26 Feb 2024 21:14:43 +0100 Subject: Solution to challenge 219 task 2 in Perl --- challenge-219/jo-37/perl/ch-2.pl | 109 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 109 insertions(+) create mode 100755 challenge-219/jo-37/perl/ch-2.pl diff --git a/challenge-219/jo-37/perl/ch-2.pl b/challenge-219/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..7572744852 --- /dev/null +++ b/challenge-219/jo-37/perl/ch-2.pl @@ -0,0 +1,109 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0 '!float'; +use PDL; +use PDL::NiceSlice; +use PDL::Opt::GLPK; +use experimental 'signatures'; + +our ($tests, $examples, $duration, $price, $verbose); + +run_tests() if $tests || $examples; # does not return + +die <dummy(1); + my $to = $from + $cards((0))->dummy(0); + my $valid = ($days->dummy(1) >= $from->dummy(0)) & + ($days->dummy(1) < $to->dummy(0)); + + my $a = $valid->clump(1,2)->xchg(0,1); + my $b = ones($days); + my $c = $cards((1))->dummy(0,$days->dim(0))->clump(-1); + + my $xopt = null; + my $fopt = null; + my $status = null; + + glpk($c, $a, $b, zeros($c), zeros($c), GLP_LO * ones($b), + GLP_BV * ones($c), GLP_MIN, $xopt, $fopt, $status); + + my $selection = $xopt->reshape($to->dims); + my $solution = whichND $selection; + + ($days->dice($solution((0)))->dummy(0) + ->glue(0, $cards->dice('X', $solution((1))))->qsortvec->unpdl, $fopt); +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + is scalar(travel_cost([[1, 2], [7, 7], [30, 25]], [1, 5, 6, 7, 9, 15])), + 11, 'example 1'; + + is scalar(travel_cost([[1, 2], [7, 7], [30, 25]], + [1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31])), + 20, 'example 2'; + } + + SKIP: { + skip "tests" unless $tests; + } + + done_testing; + exit; +} -- cgit From 5be40f574174bc4b73f8f0c20f6c199e439041ff Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Tue, 27 Feb 2024 18:21:19 +0100 Subject: Blog for challenges 216 and 219 --- challenge-216/jo-37/blog.txt | 1 + challenge-219/jo-37/perl/blog.txt | 1 + 2 files changed, 2 insertions(+) create mode 100644 challenge-216/jo-37/blog.txt create mode 100644 challenge-219/jo-37/perl/blog.txt diff --git a/challenge-216/jo-37/blog.txt b/challenge-216/jo-37/blog.txt new file mode 100644 index 0000000000..2d4bfc89b3 --- /dev/null +++ b/challenge-216/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2024/02/27/ch-216.html diff --git a/challenge-219/jo-37/perl/blog.txt b/challenge-219/jo-37/perl/blog.txt new file mode 100644 index 0000000000..457174aac7 --- /dev/null +++ b/challenge-219/jo-37/perl/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2024/02/27/ch-219.html -- cgit