aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-210/peter-campbell-smith/blog.txt1
-rwxr-xr-xchallenge-210/peter-campbell-smith/perl/ch-1.pl86
-rwxr-xr-xchallenge-210/peter-campbell-smith/perl/ch-2.pl60
3 files changed, 147 insertions, 0 deletions
diff --git a/challenge-210/peter-campbell-smith/blog.txt b/challenge-210/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..7cf84c5730
--- /dev/null
+++ b/challenge-210/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/210
diff --git a/challenge-210/peter-campbell-smith/perl/ch-1.pl b/challenge-210/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..2a920972c1
--- /dev/null
+++ b/challenge-210/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use v5.16; # The Weekly Challenge - 2023-03-27
+use utf8; # Week 210 task 1 - Kill and win
+use strict; # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+my ($best, $max, $j, @test);
+
+kill_and_win(2, 3, 1);
+kill_and_win(1, 1, 2, 2, 2, 3);
+kill_and_win(1, 3, 5, 7);
+kill_and_win(2, 2, 2, 2);
+kill_and_win(1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
+
+# harder one - 20 random numbers in 0 .. 15
+for $j (0 .. 19) {
+ @test[$j] = int(rand(15));
+}
+kill_and_win(@test);
+
+sub kill_and_win {
+
+ # does what the challenge says
+ my (@list);
+
+ @list = @_;
+ $best = 0;
+ $max = 0;
+
+ # the max possible is the sum of all the list elements and we can stop if we find that
+ $max += $_ for @list;
+
+ # get the answer and show it
+ kill_one(\@list);
+ say qq[\nInput: \@list = (] . join(', ', @list) . qq[)];
+ say qq[Output: $best (max = $max)];
+}
+
+sub kill_one {
+
+ # finds all options of deleting one entry from list and recurses
+ my ($option, @list, $j, $k, @new_list, $score, $yes);
+ @list = @{$_[0]};
+
+ # if we've found a solution that scores $max we can stop
+ return 0 if $best == $max;
+ $score = 0;
+
+ # take an element to delete (if possible)
+ J: for $j (0 .. scalar @list - 1) {
+
+ # is this eligible for deletion as there is at least one ± 1
+ $yes = 0;
+ K: for $k (0 .. scalar @list - 1) {
+ if (abs($list[$j] - $list[$k]) == 1) {
+ $yes = 1;
+ last K;
+ }
+ }
+
+ # not eligible
+ next J unless $yes;
+
+ # so we can delete $list[$j]
+ $score = $list[$j];
+
+ # create a new list omitting $j and any element ± 1 from element $j
+ @new_list = ();
+ for $k (0 .. scalar @list - 1) {
+ next if $j == $k;
+ if (abs($list[$j] - $list[$k]) == 1) {
+ $score += $list[$k];
+ next;
+ }
+ push(@new_list, $list[$k]);
+ }
+
+ # if there are still >1 elements in $new_list, recurse
+ $score += kill_one(\@new_list) if scalar @new_list > 1;
+
+ # save the score if it's the best so far
+ $best = $score if $score > $best;
+ }
+ return $score;
+}
diff --git a/challenge-210/peter-campbell-smith/perl/ch-2.pl b/challenge-210/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..655f04f351
--- /dev/null
+++ b/challenge-210/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use v5.16; # The Weekly Challenge - 2023-03-27
+use utf8; # Week 210 task 2 - Number collision
+use strict; # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+my ($j, @list);
+
+number_collision(2, 3, -1);
+number_collision(3, 2, -4);
+number_collision(1, -1);
+number_collision(1, -1, 2, -2, 4, -4);
+number_collision(12, -2, -9, -6, -12, 10, 6, 1, 1, -12, 14);
+
+for $j (0 .. 10) {
+ $list[$j] = int(rand(15)) - 7;
+}
+number_collision(@list);
+
+
+sub number_collision {
+
+ my (@list, $last, $size, $j, $k);
+
+ # loop over all the numbers, setting them to 0 if they die
+ @list = @_;
+ while (1) {
+
+ # loop over values
+ $size = scalar @list;
+ for $j (0 .. $size - 2) {
+
+ # skip unless this is +ve and next is -ve
+ $k = $j + 1;
+ next unless ($list[$j] > 0 and $list[$k] < 0);
+
+ # same absolute value - both die
+ if (abs($list[$j]) == abs($list[$k])) {
+ $list[$j] = $list[$k] = 0;
+
+ # this kills next
+ } elsif (abs($list[$j]) < abs($list[$k])) {
+ $list[$j] = 0;
+
+ # next kills this
+ } else {
+ $list[$k] = 0;
+ }
+ }
+
+ # eliminate zeroes and exit if nothing's changed
+ @list = grep { $_ != 0 } @list;
+ last if scalar @list == $size;
+ }
+
+ # show results
+ say qq[\nInput: \@list = (] . join(', ', @_) . q[)];
+ say qq[Output: (] . join(', ', @list) . qq[)];
+}