Merge pull request #1150 from jaldhar/challenge-043

Challenge 43 by Jaldhar H. Vyas

5 files changed, 129 insertions, 0 deletions

diff --git a/challenge-043/jaldhar-h-vyas/blog.txt b/challenge-043/jaldhar-h-vyas/blog.txt
new file mode 100644
index 0000000000..e44e123152
--- /dev/null
+++ b/challenge-043/jaldhar-h-vyas/blog.txt
@@ -0,0 +1 @@
+https://www.braincells.com/perl/2020/01/perl_weekly_challenge_week_43.html
diff --git a/challenge-043/jaldhar-h-vyas/perl/ch-1.pl b/challenge-043/jaldhar-h-vyas/perl/ch-1.pl
new file mode 100755
index 0000000000..15ca0a94e7
--- /dev/null
+++ b/challenge-043/jaldhar-h-vyas/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use 5.010;
+
+sub permute (&@) {
+    my $code = shift;
+    my @idx = 0..$#_;
+    while ( $code->(@_[@idx]) ) {
+        my $p = $#idx;
+        --$p while $idx[$p-1] > $idx[$p];
+        my $q = $p or return;
+        push @idx, reverse splice @idx, $p;
+        ++$q while $idx[$p-1] > $idx[$q];
+        @idx[$p-1,$q]=@idx[$q,$p-1];
+    }
+}
+
+my %rings = (
+'Blue'         => 8,
+'Yellow'       => 7,
+'Green'        => 5,
+'Red'          => 9,
+);
+
+my @ringSegments = (
+    [qw/ Red Red-Green /],
+    [qw/ Green Red-Green Green-Black /],
+    [qw/ Black Green-Black Black-Yellow /],
+    [qw/ Yellow Black-Yellow Yellow-Blue /],
+    [qw/ Blue Yellow-Blue /],
+);
+
+my @unknowns = qw/ Black Red-Green Green-Black Black-Yellow Yellow-Blue /;
+my @numbers = (1, 2, 3, 4, 6);
+
+my @permutations;
+permute { push @permutations, \@_; } @numbers;
+for my $permutation (@permutations) {
+    my %try = %rings;
+    my $i = 0;
+    map { $try{$_} = $permutation->[$i++]; } @unknowns;
+    my %ringValues;
+    map {$ringValues{$_->[0]} = 0; } @ringSegments;
+
+    map {
+        my $ring = $_;
+        map { $ringValues{$ring->[0]} += $try{$_} } @{$ring};
+    } @ringSegments;
+
+    if (scalar (grep { $ringValues{$_} == 11 } keys %ringValues) == 5) {
+        map { say "$_ = $try{$_}"; } @unknowns;
+        last;
+    }
+};
\ No newline at end of file
diff --git a/challenge-043/jaldhar-h-vyas/perl/ch-2.pl b/challenge-043/jaldhar-h-vyas/perl/ch-2.pl
new file mode 100755
index 0000000000..d4220080f4
--- /dev/null
+++ b/challenge-043/jaldhar-h-vyas/perl/ch-2.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use 5.010;
+
+sub base {
+    my ($number, $base) = @_;
+    my @digits = (0 .. 9, 'A' .. 'Z');
+    my @result;
+    while ($number > ($base - 1)) {
+        my $digit = $number % $base;
+        push @result, $digits[$digit];
+        $number /=  $base;
+    }
+    push @result, $digits[$number];
+
+    return join '', reverse @result;
+}
+
+my $base = shift // die "must specify a base.\n";
+
+if (grep { $base == $_} ( 1, 2, 3, 6)) {
+    die "There is no descriptive number for base $base\n";
+}
+
+say base(($base - 4) * ($base ** ($base - 1)) + (2 * $base ** ($base - 2)) +
+    ($base ** ($base - 3)) + $base ** 3, $base);
diff --git a/challenge-043/jaldhar-h-vyas/raku/ch-1.p6 b/challenge-043/jaldhar-h-vyas/raku/ch-1.p6
new file mode 100755
index 0000000000..956888bf1f
--- /dev/null
+++ b/challenge-043/jaldhar-h-vyas/raku/ch-1.p6
@@ -0,0 +1,40 @@
+#!/usr/bin/perl6
+
+multi sub MAIN {
+    my %rings = (
+        'Blue'         => 8,
+        'Yellow'       => 7,
+        'Green'        => 5,
+        'Red'          => 9,
+    );
+
+    my @ringSegments = [
+        << Red Red-Green >>,
+        << Green Red-Green Green-Black >>,
+        << Black Green-Black Black-Yellow >>,
+        << Yellow Black-Yellow Yellow-Blue >>,
+        << Blue Yellow-Blue >>,
+    ];
+
+    my @unknowns = << Black Red-Green Green-Black Black-Yellow Yellow-Blue >>;
+    my @numbers = (1, 2, 3, 4, 6);
+
+
+    for @numbers.permutations -> @permutation {
+        my %try = %rings;
+        my $i = 0;
+        @unknowns.map({ %try{$_} = @permutation[$i++]; });
+
+        my %ringValues;
+        @ringSegments.map({%ringValues{$_[0]} = 0; });
+
+        for @ringSegments -> @ring {
+            @ring.map({ %ringValues{@ring[0]} += %try{$_} });
+        }
+
+        if (%ringValues.values.all == 11) {
+            @unknowns.map({ say "$_ = %try{$_}"; });
+            last;
+        }
+    }
+}
diff --git a/challenge-043/jaldhar-h-vyas/raku/ch-2.p6 b/challenge-043/jaldhar-h-vyas/raku/ch-2.p6
new file mode 100755
index 0000000000..5155f704ad
--- /dev/null
+++ b/challenge-043/jaldhar-h-vyas/raku/ch-2.p6
@@ -0,0 +1,6 @@
+#!/usr/bin/perl6
+
+multi sub MAIN($base where { ( 1, 2, 3, 6).any != $_; }) { #= integer base except 1,2,3 or 6
+    say (0 + ($base - 4) * ($base ** ($base - 1)) + (2 * $base ** ($base - 2)) +
+        ($base ** ($base - 3)) + $base ** 3).base($base);
+}
\ No newline at end of file