aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTorgny Lyon <torgny@abc.se>2024-09-04 20:23:11 +0200
committerTorgny Lyon <torgny@abc.se>2024-09-07 15:25:19 +0200
commit22f5e6e0162a58a1564ed5cf41ec2143e52ede85 (patch)
treec27ffabebcfb434efce4f7c952557e57d5dade96
parent0c9d8d680098f5515616488eceedbcfae8c5fea7 (diff)
downloadperlweeklychallenge-club-22f5e6e0162a58a1564ed5cf41ec2143e52ede85.tar.gz
perlweeklychallenge-club-22f5e6e0162a58a1564ed5cf41ec2143e52ede85.tar.bz2
perlweeklychallenge-club-22f5e6e0162a58a1564ed5cf41ec2143e52ede85.zip
Add solutions for week 285
Also add a blog link.
-rw-r--r--challenge-285/torgny-lyon/blog.txt1
-rwxr-xr-xchallenge-285/torgny-lyon/perl/ch-1.pl14
-rwxr-xr-xchallenge-285/torgny-lyon/perl/ch-2.pl44
3 files changed, 59 insertions, 0 deletions
diff --git a/challenge-285/torgny-lyon/blog.txt b/challenge-285/torgny-lyon/blog.txt
new file mode 100644
index 0000000000..8bcedb064c
--- /dev/null
+++ b/challenge-285/torgny-lyon/blog.txt
@@ -0,0 +1 @@
+https://www.abc.se/~torgny/pwc.html#285
diff --git a/challenge-285/torgny-lyon/perl/ch-1.pl b/challenge-285/torgny-lyon/perl/ch-1.pl
new file mode 100755
index 0000000000..411ec12964
--- /dev/null
+++ b/challenge-285/torgny-lyon/perl/ch-1.pl
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+
+use v5.40;
+
+use Test::More tests => 2;
+
+sub get_no_connection {
+ my ($c) = my %r = map { $_->[0], $_->[1] } @_;
+ $c = $r{$c} while $r{$c};
+ return $c;
+}
+
+is(get_no_connection([ 'B', 'C' ], [ 'D', 'B' ], [ 'C', 'A' ]), 'A');
+is(get_no_connection([ 'A', 'Z' ]), 'Z');
diff --git a/challenge-285/torgny-lyon/perl/ch-2.pl b/challenge-285/torgny-lyon/perl/ch-2.pl
new file mode 100755
index 0000000000..908ec5172a
--- /dev/null
+++ b/challenge-285/torgny-lyon/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use v5.40;
+
+use List::Util qw(first);
+use Test::More tests => 3;
+
+my %coins = (
+ 50 => [ [ 25, 25 ], [ 10, 10, 10, 10, 10 ] ],
+ 25 => [ [ 10, 10, 5 ] ],
+ 10 => [ [ 5, 5 ] ],
+ 5 => [ [ 1, 1, 1, 1, 1 ] ],
+ 1 => [ [1] ],
+);
+
+sub make_change {
+ my $n = shift;
+ my @l;
+ while ($n > 0) {
+ my $coin = first { $_ <= $n } sort { $b <=> $a } keys %coins;
+ push @l, $coin;
+ $n -= $coin;
+ }
+ return f([@l], {});
+}
+
+sub f {
+ my @l = sort @{ $_[0] };
+ my $h = $_[1];
+ return if exists $h->{"@l"};
+ $h->{"@l"} = 1;
+ foreach my $i (grep { $l[$_] != 1 } 0..$#l) {
+ foreach (@{ $coins{ $l[$i] } } ) {
+ my @a = @l;
+ splice @a, $i, 1, @{$_};
+ f([@a], $h);
+ }
+ }
+ return keys %$h;
+}
+
+is(make_change(9), 2);
+is(make_change(15), 6);
+is(make_change(100), 292);