Merge pull request #8446 from pjcs00/wk227

Week 227

3 files changed, 118 insertions, 0 deletions

diff --git a/challenge-227/peter-campbell-smith/blog.txt b/challenge-227/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..852ea64419
--- /dev/null
+++ b/challenge-227/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://ccgi.campbellsmiths.force9.co.uk/challenge/227
diff --git a/challenge-227/peter-campbell-smith/perl/ch-1.pl b/challenge-227/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..b2138c403a
--- /dev/null
+++ b/challenge-227/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-07-24
+use utf8;     # Week 227 task 1 - Friday 13th
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+friday_13th(2023);
+friday_13th(1945);
+friday_13th(2012);
+friday_13th(1753);
+friday_13th(9999);
+
+sub friday_13th {
+	
+	my ($target, $offset, $thirteenths);
+	
+	# 1 Jan is:      sun     mon     tue     wed     thu     fri     sat
+	$thirteenths = [[2, 3], [2, 2], [2, 1], [1, 2], [3, 2], [1, 1], [1, 1]];
+	
+	$target = $_[0];
+	$offset = -1;
+	
+	# 1 Jan moves forward 1 day, or 2 days if previous year was leap
+	$offset += is_leap($_- 1) ? 2 : 1 for 1753 .. $target;
+
+	say qq[\nInput:  $target\nOutput: ] . $thirteenths->[$offset % 7]->[is_leap($target)];
+}
+
+sub is_leap {  # returns 1 for leap year, 0 for non-leap
+	
+	#                      non-century year      century year 
+	return ($_[0] % 100 ? ($_[0] % 4 ? 0 : 1) : ($_[0] % 400 ? 0 : 1));
+}	
+
diff --git a/challenge-227/peter-campbell-smith/perl/ch-2.pl b/challenge-227/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..4c730c8af5
--- /dev/null
+++ b/challenge-227/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-07-24
+use utf8;     # Week 227 task 2 - Roman maths
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+roman_maths('IV + V');
+roman_maths('M - I');
+roman_maths('X / II');
+roman_maths('XI * VI');
+roman_maths('VII ** III');
+roman_maths('V - V');
+roman_maths('V / II');
+roman_maths('V - X');
+roman_maths('LXXX * L');
+roman_maths('XLIII * XCIII');
+
+sub roman_maths {
+	
+	my ($first, $op, $second, $result);
+	say qq[\nInput:  $_[0]];
+	
+	# split input string into operands and operator
+	if ($_[0] =~ m|^\s*([IVXLCDM]+)\s*(\S{1,2})\s*([IVXLCDM]+)\s*$|) {
+		($first, $op, $second) = ($1, $2, $3);
+		
+		# if the operator is valid, evaluate the operation
+		if ($op =~ m!^-|\+|\*|/|\*\*$!) {
+			$result = encode_roman(eval(decode_roman($first) .  $op  . decode_roman($second)));
+			say qq[Output: $result];
+		}
+	}
+	say qq[invalid input] unless defined $result;
+}
+
+sub decode_roman {
+	
+	# convert roman to arabic
+	my (@bits, $roman, $arabic, $n);
+	
+	# roman fragments and equivalents
+	@bits = ('IV', 4, 'IX', 9, 'XL', 40, 'XC', 90, 'CD', 400, 'CM', 900,
+		'I', 1, 'V', 5, 'X', 10, 'L', 50, 'C', 100, 'D', 500, 'M', 1000);
+	
+	# successively delete bits from $roman and add them to $arabic
+	$roman = $_[0];
+	$arabic = 0;
+	for ($n = 0; $n < @bits; $n += 2) {
+		$arabic += $bits[$n + 1] * $roman =~ s|$bits[$n]||g;
+	}
+	return $arabic;
+}
+
+sub encode_roman {
+	
+	# convert arabic to roman
+	my (@bits, $n, $arabic, $roman);
+	
+	# roman fragments and equivalents
+	@bits = ('M', 1000, 'CM', 900, 'D', 500, 'CD', 400, 'C', 100, 'XC', 90,
+		'L', 50, 'XL', 40, 'X', 10, 'IX', 9, 'V', 5, 'IV', 4, 'I', 1);
+		
+	# special cases
+	$arabic = $_[0];
+	return 'nulla' if $arabic == 0;
+	return 'non potest' if ($arabic < 0 or $arabic > 3999 or $arabic != int($arabic));
+	
+	# successively subtract bits from $arabic and add them to $roman
+	$roman = '';
+	for ($n = 0; $n < @bits; $n += 2) {
+		if ($arabic >= $bits[$n + 1]) {
+			
+			# may have to repeat some roman symbols - eg XXX
+			while ($arabic >= $bits[$n + 1]) {
+				$roman .= $bits[$n];
+				$arabic -= $bits[$n + 1];
+			}
+		}					
+	}
+	return $roman;
+}