Week 254

3 files changed, 114 insertions, 0 deletions

diff --git a/challenge-254/peter-campbell-smith/blog.txt b/challenge-254/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..b262c241a9
--- /dev/null
+++ b/challenge-254/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/254
diff --git a/challenge-254/peter-campbell-smith/perl/ch-1.pl b/challenge-254/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..199f4bd952
--- /dev/null
+++ b/challenge-254/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-01-29
+use utf8;     # Week 254 task 1 - Three power
+use strict;   # Peter Campbell Smith
+use warnings; 
+binmode STDOUT, ':utf8';
+
+three_power(27);
+three_power(0);
+three_power(6);
+three_power(1);
+three_power(1853020188851840);
+three_power(1853020188851841);
+three_power(2197000000000000);
+three_power(205891132094649);
+
+
+sub three_power {
+	
+	# initialise
+	my ($n, $j, $try, $limit);
+	$n = shift;
+	say qq[\nInput:  $n];
+	if ($n > 2197000000000000) {
+		say qq[-- too big (max is 2197000000000000)];
+		return;
+	}
+	
+	# powers of 3
+	$try = 1;
+	for $j (0 .. 33) {
+		if ($try == $n) {
+			say qq[Output: true,  $n is 3 ** $j];
+			last;
+		} elsif ($try > $n) {
+			say qq[Output: false, $n is not a power of 3];
+			last;
+		}
+		$try *= 3;
+	}
+	
+	# cubes
+	for $j (0 .. 130000) {
+		$try = $j ** 3;
+		if ($try == $n) {
+			say qq[        true,  $n is $j ** 3];
+			last;
+		} elsif ($try > $n) {
+			say qq[        false, $n is not a perfect cube];
+			last;
+		}
+	}
+}
\ No newline at end of file
diff --git a/challenge-254/peter-campbell-smith/perl/ch-2.pl b/challenge-254/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..f1cc5cf9b4
--- /dev/null
+++ b/challenge-254/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-01-29
+use utf8;     # Week 254 task 2 - Reverse vowels
+use strict;   # Peter Campbell Smith
+use warnings; 
+binmode STDOUT, ':utf8';
+
+reverse_vowels('triumvirate');
+reverse_vowels('bcdf');
+reverse_vowels('bcdfa');
+reverse_vowels('abcdf');
+reverse_vowels('aeiou');
+reverse_vowels('aeiiou');
+reverse_vowels('supercalifragilisticexpialidocious');
+
+sub reverse_vowels {
+	
+	my ($s, $p1, $p2, $x, @letters);
+	
+	# initialise
+	$s = lc(shift);	
+	@letters = split('', $s);
+	$p1 = 0;
+	$p2 = scalar(@letters) - 1;
+	
+	# loop while left pointer left of right pointer
+	LOOP: while ($p1 < $p2) {
+		
+		# if left pointer has found a vowel
+		if ($letters[$p1] =~ m|[aeiou]|) {
+			
+			# wind back right pointer until it meets a vowel or left pointer
+			while ($p1 < $p2) {
+				
+				# right pointer has found a vowel, so switch left and right
+				if ($letters[$p2] =~ m|[aeiou]|) {
+					$x = $letters[$p2];
+					$letters[$p2 --] = $letters[$p1];
+					$letters[$p1 ++] = $x;
+					next LOOP;
+				
+				# not a vowel, move right pointer to the left
+				} else {
+					$p2 --;
+				}
+			}
+			
+		# not a vowel, so move left pointer to the right	
+		} else {
+			$p1 ++;
+		}
+	}	
+	say qq[\nInput:  \$s = '$s'\nOutput:      '] . join('', @letters), qq['];	
+}
\ No newline at end of file