Merge pull request #8768 from pjcs00/wk236

Week 236 submission

3 files changed, 125 insertions, 0 deletions

diff --git a/challenge-236/peter-campbell-smith/blog.txt b/challenge-236/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..fcbc342f69
--- /dev/null
+++ b/challenge-236/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/236
diff --git a/challenge-236/peter-campbell-smith/perl/ch-1.pl b/challenge-236/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..c39ea506e6
--- /dev/null
+++ b/challenge-236/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-09-25
+use utf8;     # Week 236 task 1 - Exact change
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+exact_change(5, 5, 5, 10, 20);
+exact_change(5, 5, 10, 10, 20);
+exact_change(5, 5, 5, 20);
+exact_change(5, 5, 10, 20);
+
+sub exact_change {
+	
+	my (@bills, $bill, $change, @till, $ok, $explain, $j);
+	
+	# initialise
+	@bills = @_;
+	$ok = 'true';
+	
+	# till starts empty
+	$till[5] = $till[10] = $till[20] = 0;
+	
+	# loop over customers
+	for $bill (@bills) {
+		$explain .= qq[\n   \$$bill paid];
+		$change = $bill - 5;
+		
+		# customer presents $5 - no change needed
+		if ($change == 0) {
+			$explain .= q[, no change due];
+		
+		# customer presents $10 so give him $5 change if we have a $5
+		} elsif ($change == 5) {
+			if ($till[5] > 0) {
+				$till[5] --;
+				$explain .= q[, $5 change];
+			} else {
+				$ok = 'false'; # we don't
+			}
+		
+		# customer presents $20 so give her a $10 and a $5, or 3 x $5
+		} elsif ($change == 15) {
+			if ($till[10] > 0 and $till[5] > 0) {
+				$till[10] --;
+				$till[5] --;
+				$explain .= q[, $10 + $5 change];
+			} elsif ($till[5] >= 3) {
+				$till[5] -= 3;
+				$explain .= q[, 3 x $5 change];
+			} else {
+				$ok = 'false'; # we have neither
+			}
+		}
+		
+		# oh dear!
+		unless ($ok eq 'true') {
+			$explain .= q[, sorry, I don't have change];
+			last;
+		}
+			
+		# add customer's payment to till
+		$till[$bill] ++;
+		$explain .= qq[, till now $till[5] x \$5, $till[10] x \$10 $till[20] x \$20 = \$] .
+			($till[5] * 5 + $till[10] * 10 + $till[20] * 20);
+	}		
+	
+	say qq[\nInput: \@bills = (] . join(', ', @bills) . ')';
+	say qq[Output: $ok$explain];
+}
diff --git a/challenge-236/peter-campbell-smith/perl/ch-2.pl b/challenge-236/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..31b01d5b91
--- /dev/null
+++ b/challenge-236/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-09-25
+use utf8;     # Week 236 task 2 - Array loops
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+array_loops(4, 6, 3, 8, 15, 0, 13, 18, 7, 16, 14, 19, 17, 5, 11, 1, 12, 2, 9, 10);
+array_loops(0, 1, 13, 7, 6, 8, 10, 11, 2, 14, 16, 4, 12, 9, 17, 5, 3, 18, 15, 19);
+array_loops(9, 8, 3, 11, 5, 7, 13, 19, 12, 4, 14, 10, 18, 2, 16, 1, 0, 15, 6, 17);
+
+# generate bigger example
+my ($j, @used, @ints, $count);
+while (1) {
+	$j = int(rand(100));
+	next if $used[$j];
+	push(@ints, $j);
+	$used[$j] = 1;
+	last if ++$count == 100;
+}
+array_loops(@ints);
+
+sub array_loops {
+	
+	my (@ints, $j, $k, $m, $loops, $loop, $explain);
+	
+	# initialise
+	@ints = @_;
+	$loops = 0;
+	
+	# loop over next unused number
+	for $j (0 .. scalar @ints - 1) {
+		next unless defined $ints[$j];
+		
+		# loop over members of a loop, undefining numbers used
+		$k = $j;
+		while (1) {
+			$m = $ints[$k];
+			undef $ints[$k];
+			$k = $m;
+			last unless defined $k;
+			$loop .= qq[$k ];
+		}
+		
+		# details of this loop
+		$loops ++;
+		$explain .= qq/   [/ . substr($loop, 0, -1) . qq/]\n/;
+		$loop = '';
+	}
+	
+	# output results
+	say qq[\nInput:  \@ints = (] . join(', ', @_) . ')';
+	say qq[Output: $loops\n]  . substr($explain, 0, -1);
+}