Solutions 043 challenge.

2 files changed, 95 insertions, 0 deletions

diff --git a/challenge-043/wanderdoc/perl/ch-1.pl b/challenge-043/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..bf35bf9b06
--- /dev/null
+++ b/challenge-043/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+There are 5 rings in the Olympic Logo as shown below. They are color coded as in Blue, Black, Red, Yellow and Green. We have allocated some numbers to these rings as below: Blue: 8, Yellow: 7, Green: 5, Red: 9. The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.
+=cut
+
+
+use constant { BLUE => 8, YELLOW => 7, GREEN => 5, RED => 9, SUM => 11};
+use List::Util qw(reduce all);
+use Algorithm::Combinatorics qw(permutations);
+
+
+my %var;
+my @col2search = qw(red_green green_black black black_yellow yellow_blue);
+@var{@col2search} = (undef) x 5;
+my @red     = (RED,                \$var{red_green});
+my @green   = (GREEN,              \$var{red_green},     \$var{green_black});
+my @black   = (\$var{green_black}, \$var{black},         \$var{black_yellow});
+my @yellow  = (YELLOW,             \$var{black_yellow},  \$var{yellow_blue});
+my @blue    = (BLUE, \$var{yellow_blue});
+
+my @olympic = ( \@red, \@green, \@black, \@yellow, \@blue );
+
+my @numbers = (1, 2, 3, 4, 6);
+
+
+my $iter = permutations(\@numbers);
+
+while (my $i = $iter->next())
+{
+     @var{@col2search} = @$i;
+
+     next unless ( all { is_valid($_) } @olympic );
+     print join(' => ', $_, $var{$_}), $/ for @col2search; 
+}
+
+
+
+sub ring_sum
+{
+     my @ring = @{$_[0]};
+
+     my $sum = reduce { ('SCALAR' eq ref $a ? $$a : $a) + ('SCALAR' eq ref $b ? $$b : $b) } @ring;
+     return $sum;
+}
+
+
+sub is_valid
+{
+     return SUM == ring_sum($_[0]);
+}
+
diff --git a/challenge-043/wanderdoc/perl/ch-2.pl b/challenge-043/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..4ff80aafad
--- /dev/null
+++ b/challenge-043/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to generate Self-descriptive Numbers in a given base.
+In mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b - 1) counts how many instances of digit n are in m.
+=cut
+
+=theory
+A self-descriptive number has the number of digits equal to the base. In base 7 and above a self-descriptive number has a following form: (base - 4) at the position 0, ones at positions 2 and (base - 4), two at the position 1 (reflecting the above mentioned ones) and zeros at all the rest positions.
+=cut
+
+# https://en.wikipedia.org/wiki/List_of_numeral_systems
+my %digits; @digits{0 .. 63} = ('0'..'9', 'A'..'Z', 'a' .. 'z', '-', '_');
+
+sub descr_create
+{
+     my $base = $_[0];
+     if ( $base <= 3 or $base == 6 ) { return "Does not exist!" }
+     if ( $base == 4 ) { return "1210 or 2020"; }
+     if ( $base == 5 ) { return "21200"; }
+     if ( $base > 64 ) { return "Is not implemented!"; }
+
+     my @number = (0) x $base;
+
+     $number[0] = $base - 4;
+     $number[1] = 2;
+     $number[2] = 1;
+     $number[$#number - 3] = 1;
+     my $num_str = join('', map $digits{$_}, @number);
+     return $num_str;
+}
+
+for my $base ( 1 .. 64 )
+{
+     my $descr_num = descr_create($base);
+     print join("\t", $base, $descr_num), $/; 
+}
+
+