Merge pull request #11525 from pjcs00/wk307

Week 307 - Orders and anagrams

3 files changed, 85 insertions, 0 deletions

diff --git a/challenge-307/peter-campbell-smith/blog.txt b/challenge-307/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..d255ab1f0b
--- /dev/null
+++ b/challenge-307/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/307
diff --git a/challenge-307/peter-campbell-smith/perl/ch-1.pl b/challenge-307/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..29f37f02bf
--- /dev/null
+++ b/challenge-307/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-02-03
+use utf8;     # Week 307 - task 1 - Check order
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+check_order(5, 2, 4, 3, 1);
+check_order(1, 2, 1, 1, 3);
+
+my @ints;
+push @ints, int(rand(10)) for 0 .. 49;
+check_order(@ints);
+
+sub check_order {
+	
+	my (@ints, @sorted, @different, $j);
+	
+	# sort the list
+	@ints = @_;
+	@sorted = sort {$a <=> $b} @ints;
+	
+	# find indices where original and sorted differ
+	for $j (0 .. $#ints) {
+		push @different, $j if $ints[$j] != $sorted[$j];
+	}		
+	
+	say qq[\nInput:  \@ints =      (] . join(', ', @ints) . ')';
+	say qq[        \@sorted =    (] . join(', ', @sorted) . ')';
+	say qq[Output: \@different = (] . join(', ', @different) . ')';
+}
diff --git a/challenge-307/peter-campbell-smith/perl/ch-2.pl b/challenge-307/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..b38ffe8789
--- /dev/null
+++ b/challenge-307/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-02-03
+use utf8;     # Week 307 - task 2 - Find anagrams
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+find_anagrams('acca', 'dog', 'god', 'perl', 'repl');
+find_anagrams('abba', 'baba', 'aabb', 'ab', 'ab');
+find_anagrams(qw[abcd abdc acbd acdb adbc adcb bacd badc 
+	bcad bcda mouse bdac bdca cabd cadb cbad cbda cdab 
+	cdba dabc dacb dbac dbca dcab dcba]); 
+
+sub find_anagrams {
+	
+	my (@words, $point);
+	
+	@words = @_;
+	say qq[\nInput:  \@words = ('] . join(q[', '], @words) . q[')];
+	
+	# sort each word alphabetically
+	$words[$_] = join('', sort(split('', $words[$_]))) for 0 .. $#words;
+	
+	# walk along the array
+	$point = 0;
+	while (1) {
+		
+		# finished
+		last if $point == $#words;
+		
+		# word followed by anagram
+		if ($words[$point] eq $words[$point + 1]) {
+			
+			# .. followed by no more words
+			if ($point + 2 > $#words) {
+				@words = @words[0 .. $point];
+				
+			# .. followed by more words
+			} else {
+				@words = (@words[0 .. $point], @words[$point + 2 .. $#words]);
+			}
+		
+		# word not followed by anagram
+		} else {
+			$point ++;
+		}
+	}	
+	say qq[Output: ] . scalar(@words);
+}