Merge pull request #12575 from pjcs00/wk336

Week 336 - Grouping and scoring

3 files changed, 107 insertions, 0 deletions

diff --git a/challenge-336/peter-campbell-smith/blog.txt b/challenge-336/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..7a62a30439
--- /dev/null
+++ b/challenge-336/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/336
diff --git a/challenge-336/peter-campbell-smith/perl/ch-1.pl b/challenge-336/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..7b5751faa7
--- /dev/null
+++ b/challenge-336/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-08-25
+use utf8;     # Week 336 - task 1 - Equal group
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+equal_group(1, 1, 2, 2, 2, 2);
+equal_group(1, 1, 1, 2, 2, 2, 3, 3);
+equal_group(5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7);
+equal_group();
+equal_group(42);
+equal_group(77, 77);
+equal_group(-1, -1, -1, -1, -1, -1, -1, -1, -1, -1);
+
+sub equal_group {
+	
+	my (@array, $result, $size, $groups, $group, $start, $member, $output);
+	
+	# initialise
+	@array = @_;
+	$result = 'false';
+	
+	# loop down over possible group sizes
+	SIZE: for ($size = scalar @array; $size >= 2; $size --) {
+		
+		# check for integral number of groups
+		$groups = scalar @array / $size;
+		next SIZE unless $groups == int($groups);
+		
+		# check each group
+		$output = '(';
+		for $group (0 .. $groups - 1) {
+			$start = $group * $size;
+			
+			# check each member
+			for $member (0 .. $size - 1) {
+				next SIZE unless $array[$start + $member] == $array[$start];
+				$output .= qq[$array[$start + $member], ];
+			}
+			$output = substr($output, 0, -2) . '), (';
+		}
+		$result = qq[true - ] . substr($output, 0, -3);
+		last;
+	}
+	
+	say qq[\nInput:  (] . join(', ', @array) . ')';
+	say qq[Output: $result];
+}
diff --git a/challenge-336/peter-campbell-smith/perl/ch-2.pl b/challenge-336/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..a8e0f02c01
--- /dev/null
+++ b/challenge-336/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-08-25
+use utf8;     # Week 336 - task 2 - Final score
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+final_score('5', '2', 'C', 'D', '+');
+final_score('5', '-2', '4', 'C', 'D', '9', '+', '+');
+final_score('7', 'D', 'D', 'C', '+', '3');
+final_score('-5', '-10', '+', 'D', 'C', '+');
+final_score('3', '6', '+', 'D', 'C', '8', '+', 'D', '-2', 'C', '+');
+final_score('C', '1', '2');
+final_score('D', '1', '2');
+final_score('+', '1', '2');
+final_score('1', '+', '2');
+final_score('1', 'C', '2', 'C');
+
+sub final_score {
+	
+	my (@scores, $total, $prev1, $prev2, $score, $i);
+	
+	say qq[\nInput:  ('] . join(qq[', '], @_) . q[')];	
+	
+	# get rid of C and scores preceding a C
+	$scores[0] = $_[0];
+	for ($i = 1; $i < scalar @_; $i ++) {
+		if ($_[$i] eq 'C') {
+			pop @scores;
+		} else {
+			push @scores, $_[$i];
+		}
+	}
+	
+	# bad input
+	if (scalar @scores == 0 or $scores[0] !~ m|^-?\d+$| or $scores[1] eq '+') {
+		say qq[Output: bad data];
+		return;
+	}
+
+	# handle D and +
+	for $i (1 .. $#scores) {
+		if ($scores[$i] eq '+' and $i >= 2) { 
+			$scores[$i] = $scores[$i - 1] + $scores[$i - 2];
+		} elsif ($scores[$i] eq 'D') { 
+			$scores[$i] = $scores[$i - 1] * 2;
+		}
+	}
+	$total += $_ for @scores;
+	say qq[Output: $total];
+}