Commit solutions for perl weekly challenge 047

2 files changed, 224 insertions, 0 deletions

diff --git a/challenge-047/duane-powell/perl5/ch-1.pl b/challenge-047/duane-powell/perl5/ch-1.pl
new file mode 100755
index 0000000000..021ee1013f
--- /dev/null
+++ b/challenge-047/duane-powell/perl5/ch-1.pl
@@ -0,0 +1,201 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw( say );
+use Data::Dumper;
+
+# Problem:  https://perlweeklychallenge.org/blog/perl-weekly-challenge-047/ TASK #1
+
+my ($r1, $op, $r2) = @ARGV;
+unless (scalar @ARGV == 3) {
+	say "Usage: $0 Roman_numeral operator Roman_numeral";
+	exit;
+}
+
+my %arabic = qw(
+	I  1
+	IV 4
+	V  5
+	IX 9
+	X  10
+	XL 40
+	L  50
+	XC 90
+	C  100
+	CD 400
+	D  500
+	CM 900
+	M  1000
+);
+my %roman = reverse %arabic;
+
+my $n = arabic($r1);
+my $m = arabic($r2);
+my $a = eval "$n $op $m";
+
+my $r = roman($a);
+say $r, " (", $a, ")";
+exit;
+
+sub arabic {
+	my @roman = split(//, uc(shift));
+	return 0 unless (scalar @roman > 0);
+
+	my ($arabic, $next, $error, $min) = (0, '', '', 1000);
+	while (1) {
+		if (scalar @roman > 1) {
+			$next = $roman[0].$roman[1];
+			if ( defined($arabic{$next}) ) {
+				$arabic += $arabic{$next};
+				$error = "Roman numeral out of sequence at $next" if ($arabic{$next} > $min); 
+				$min = $arabic{$next};
+				shift @roman;
+				shift @roman;
+				next;
+	 		}				
+		} 
+		if (scalar @roman > 0) {
+			$next = $roman[0];
+			if ( defined($arabic{$next}) ) {
+				$arabic += $arabic{$next};
+				$error = "Roman numeral out of sequence at $next" if ($arabic{$next} > $min); 
+				$min = $arabic{$next};
+				shift @roman;
+				next;
+	 		}				
+			else {
+				$error = "Invalid Roman numeral at $next";
+			}
+		}
+		else {
+			last;
+		}
+
+		last if ($error);
+	}
+	if ($error) {
+		say $error;
+		exit;
+	} 
+	else {
+		return $arabic;
+	}
+}
+
+sub roman {
+	my $arabic = shift;
+	$arabic = int($arabic);
+	my $roman = '';
+	while ($arabic > 0) {
+		if ($arabic >= 1000) {
+			$roman .= $roman{1000};
+			$arabic -= 1000;
+			next;
+		}
+		if ($arabic >= 900) {
+			$roman .= $roman{900};
+			$arabic -= 900;
+			next;
+		}
+		if ($arabic >= 500) {
+			$roman .= $roman{500};
+			$arabic -= 500;
+			next;
+		}
+		if ($arabic >= 400) {
+			$roman .= $roman{400};
+			$arabic -= 400;
+			next;
+		}
+		if ($arabic >= 100) {
+			$roman .= $roman{100};
+			$arabic -= 100;
+			next;
+		}
+		if ($arabic >= 90) {
+			$roman .= $roman{90};
+			$arabic -= 90;
+			next;
+		}
+		if ($arabic >= 50) {
+			$roman .= $roman{50};
+			$arabic -= 50;
+			next;
+		}
+		if ($arabic >= 40) {
+			$roman .= $roman{40};
+			$arabic -= 40;
+			next;
+		}
+		if ($arabic >= 10) {
+			$roman .= $roman{10};
+			$arabic -= 10;
+			next;
+		}
+		if ($arabic >= 9) {
+			$roman .= $roman{9};
+			$arabic -= 9;
+			next;
+		}
+		if ($arabic >= 5) {
+			$roman .= $roman{5};
+			$arabic -= 5;
+			next;
+		}
+		if ($arabic >= 4) {
+			$roman .= $roman{4};
+			$arabic -= 4;
+			next;
+		}
+		if ($arabic >= 1) {
+			$roman .= $roman{1};
+			$arabic -= 1;
+			next;
+		}
+	}
+	return $roman;
+}
+
+
+__END__
+
+./ch-1.pl
+Usage: ./ch-1.pl Roman_numeral operator Roman_numeral
+
+./ch-1.pl ICU + I
+Invalid Roman numeral at U
+
+./ch-1.pl ICM + I
+Roman numeral out of sequence at CM
+
+./ch-1.pl I + I
+II (2)
+
+./ch-1.pl V - I
+IV (4)
+
+/ch-1.pl M / L
+XX (20)
+
+./ch-1.pl XL + XL
+LXXX (80)
+
+./ch-1.pl X \* IX
+XC (90)
+
+./ch-1.pl M / V
+CC (200)
+
+./ch-1.pl M / X
+C (100)
+
+./ch-1.pl MCMXCV + IV
+MCMXCIX (1999)
+
+./ch-1.pl MCMXCV + XXV
+MMXX (2020)
+
+./ch-1.pl MMMM - I
+MMMCMXCIX (3999)
+
+
diff --git a/challenge-047/duane-powell/perl5/ch-2.pl b/challenge-047/duane-powell/perl5/ch-2.pl
new file mode 100755
index 0000000000..da9f001aaa
--- /dev/null
+++ b/challenge-047/duane-powell/perl5/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw( say );
+
+# Problem:  https://perlweeklychallenge.org/blog/perl-weekly-challenge-047/ TASK #2
+
+my @gap;
+my $n = 100;
+while (scalar @gap < 20) {
+	my ($a,undef,$b) = split(//,$n);
+	my $x = "$a$b"; # form new number by combining first and last digit of $n
+	
+	push @gap, $n if ($n/$x == int($n/$x)); # $n is a gapped number if it is divisible by $x
+	$n++;
+}
+say join(',',@gap);
+
+__END__
+
+./ch-2.pl
+100,105,108,110,120,121,130,132,135,140,143,150,154,160,165,170,176,180,187,190
+