Merge pull request #12057 from pjcs00/wk322

Week 322 - More strings and arrays

3 files changed, 88 insertions, 0 deletions

diff --git a/challenge-322/peter-campbell-smith/blog.txt b/challenge-322/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..98e3fc43ac
--- /dev/null
+++ b/challenge-322/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/322
diff --git a/challenge-322/peter-campbell-smith/perl/ch-1.pl b/challenge-322/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..437c74bb98
--- /dev/null
+++ b/challenge-322/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-05-19
+use utf8;     # Week 322 - task 1 - String format
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+string_format('ABC-D-E-F', 3);
+string_format('A-BC-D-E', 2);
+string_format('-A-B-CD-E', 4);
+
+string_format('AAA', 1);
+string_format('TEA-TEA-TEA-TEA', 3);
+string_format('pe-rlwe-ek03-22ta-sk00-01', 4);
+string_format('---', 1);
+
+sub string_format {
+	
+	my($string, $count, $result);
+	
+	# initialise
+	($string, $count) = @_;
+	say qq[\nInput:  \$string = '$string', \$count = $count];
+	$result = '';
+	
+	# get rid of existing '-' characters
+	$string =~ s|-||g;
+	
+	if ($string) {
+	
+		# add successive groups of final $count letters to $result
+		$result = qq[-$1$result] while $string =~ s|(\w{$count})$||g;
+		
+		# if anything left, add it, else remove leading '-'
+		$result = $string ? qq[$string$result] : substr($result, 1);
+	}
+	say qq[Output: '$result'];
+}
diff --git a/challenge-322/peter-campbell-smith/perl/ch-2.pl b/challenge-322/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..14a2e34900
--- /dev/null
+++ b/challenge-322/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-05-19
+use utf8;     # Week 322 - task 2 - Rank array
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+use List::Util 'min';
+
+rank_array(55, 22, 44, 33);
+rank_array(10, 10, 10);
+rank_array(5, 1, 1, 4, 3);
+rank_array(0);
+rank_array(-3, -3, -3, -2, -2, -1, 0);
+
+# bigger example
+my @array;
+push @array, int(rand(100)) for 0 .. 25;
+rank_array(@array);
+
+sub rank_array {
+	
+	my (@array, @rank, @ranking, $n, $j, %numbers, $min);
+	
+	# initialise
+	@array = @_;
+	
+	# to cope with -ve numbers
+	$min = min(@array);
+	
+	# make # with keys of unique numbers
+	$numbers{$_} = 1 for @array;
+	
+	# rank the numbers smallest to largest
+	$j = 1;
+	$rank[$_ - $min] = $j ++ for sort {$a <=> $b} keys %numbers;
+	
+	# assign the ranks to @ranking in the original order
+	$ranking[$_] = $rank[$array[$_] - $min] for 0 .. $#array;
+	
+	say qq[\nInput:  (] . join(', ', @array) . q[)];
+	say qq[Output: (] . join(', ', @ranking) . q[)];
+}
+