- Added solutions by Laurent Rosenfeld.

9 files changed, 237 insertions, 0 deletions

diff --git a/challenge-036/laurent-rosenfeld/blog.txt b/challenge-036/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..9583b47370
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/12/perl-weekly-challenge-36-vehicle-identification-numbers-vin-and-the-knapsack-problem.html
diff --git a/challenge-036/laurent-rosenfeld/perl5/ch-1.pl b/challenge-036/laurent-rosenfeld/perl5/ch-1.pl
new file mode 100644
index 0000000000..79de77e9c0
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl5/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub validate {
+    my $vin = shift;
+    return 0 if $vin =~ /[OIQ]/;
+    return 0 unless $vin =~ /^[A-Z0-9]{17}$/;
+    return check_digit($vin);
+}
+
+sub check_digit {
+    my $vin = shift;
+    my %translations = (
+     A => 1, B => 2, C => 3, D => 4, E => 5, F => 6, G => 7, H => 8,
+     J => 1, K => 2, L => 3, M => 4, N => 5, P => 7, R => 9, S => 2,
+     T => 3, U => 4, V => 5, W => 6, X => 7, Y => 8, Z => 9,
+    );
+    $translations{$_} = $_ for 0..9;
+
+    my @weights =
+        (8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2);
+    my $i = 0;
+    my $sum = 0;
+    for my $char (split //, $vin) {
+        $sum += $translations{$char} * $weights[$i++];
+    }
+    my $mod = $sum % 11;
+    $mod = 'X' if $mod == 10;
+    return 1 if $mod eq substr $vin, 8, 1;
+    return 0;
+}
+
+my $vin = shift // "1M8GDM9AXKP042788";
+say validate($vin) ? "Correct" : "Wrong";
diff --git a/challenge-036/laurent-rosenfeld/perl5/ch-1a.pl b/challenge-036/laurent-rosenfeld/perl5/ch-1a.pl
new file mode 100644
index 0000000000..8d497424fe
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl5/ch-1a.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+use Test::More tests => 16;
+
+sub validate {
+    my $vin = shift;
+    return 0 if $vin =~ /[OIQ]/;
+    return 1 if $vin =~ /^[A-Z0-9]{17}$/;
+    return 0;
+}
+
+ok validate("A" x 17),  "17 A's";
+ok validate(1 x 17)  ,  "17 digits";
+is validate("AEIOU")   , 0, "Five vowels";
+is validate(1234567890), 0, "Ten digits";
+is validate("1234AEIOU5678901"),   0, "Sixteen digits or letters";
+is validate("12345678901234567"),  1, "17 digits";
+is validate("1234567890123456Q"),  0, "16 digits and a Q";
+is validate("1234567890123456O"),  0, "16 digits and a O";
+is validate("1234567890123456I"),  0, "16 digits and a I";
+is validate("Q1234567890123456"),  0, "A Q and 16 digits";
+is validate("I1234567890123456"),  0, "An I and 16 digits";
+is validate("ABCD4567890123456"),  1, "17 digits and letters";
+is validate("ABef4567890123456"),  0, "Digits and some lower case letters";
+is validate("ABE?4567890123456"),  0, "A non alphanumerical character";
+is validate("ABCD4567 90123456"),  0, "A space";
+is validate("ABCD45678901234567"), 0, "More than 17 characters";
diff --git a/challenge-036/laurent-rosenfeld/perl5/ch-2.pl b/challenge-036/laurent-rosenfeld/perl5/ch-2.pl
new file mode 100644
index 0000000000..ec907bcaa8
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl5/ch-2.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+my %boxes = (
+    "R" => { "w" => 1,  val => 1  },
+    "B" => { "w" => 1,  val => 2  },
+    "G" => { "w" => 2,  val => 2  },
+    "Y" => { "w" => 12, val => 4  },
+    "P" => { "w" => 4,  val => 10 },
+);
+my $start_nb_boxes = shift // 5;
+my $max_val = 0;
+my $max_boxes;
+
+sub try_one {
+    my ($cur_weight, $cur_val, $num_boxes, $boxes_used, $last_box_used, @boxes_left) = @_;
+    if ($cur_val > $max_val) {
+        $max_val = $cur_val;
+        $max_boxes = $boxes_used;
+    }
+    for my $box (@boxes_left) {
+        next if $box lt $last_box_used;
+        my $new_cur_weight = $cur_weight + $boxes{$box}{w};
+        next if $new_cur_weight > 15 or $num_boxes <= 0;
+        my @new_boxes_left = grep $_ ne $box, @boxes_left;
+        my $new_box_used = $boxes_used ? $boxes_used . "-$box" : $box;
+        try_one ($new_cur_weight, $cur_val + $boxes{$box}{val}, $num_boxes -1, $new_box_used, $box, @new_boxes_left);
+    }
+}
+try_one (0, 0, $start_nb_boxes, "", "A", sort keys %boxes);
+say "Max: $max_val, Boxes:  $max_boxes";
diff --git a/challenge-036/laurent-rosenfeld/perl5/ch-2a.pl b/challenge-036/laurent-rosenfeld/perl5/ch-2a.pl
new file mode 100644
index 0000000000..d43ed32ba9
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl5/ch-2a.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+my %boxes = (
+    "R" => { "w" => 1,  val => 1  },
+    "B" => { "w" => 1,  val => 2  },
+    "G" => { "w" => 2,  val => 2  },
+    "Y" => { "w" => 12, val => 4  },
+    "P" => { "w" => 4,  val => 10 },
+);
+my $start_nb_boxes = shift // 5;
+my $max_val = 0;
+my $max_boxes;
+
+sub try_one {
+    my ($cur_weight, $cur_val, $num_boxes, $boxes_used, @boxes_left) = @_;
+    if ($cur_val > $max_val) {
+        $max_val = $cur_val;
+        $max_boxes = $boxes_used;
+    }
+    for my $box (@boxes_left) {
+        my $new_cur_weight = $cur_weight + $boxes{$box}{w};
+        next if $new_cur_weight > 15 or $num_boxes <= 0;
+        my @new_boxes_left = grep $_ ne $box, @boxes_left;
+        my $new_box_used = $boxes_used ? $boxes_used . "-$box" : $box;
+        try_one ($new_cur_weight, $cur_val + $boxes{$box}{val}, $num_boxes -1, $new_box_used, @new_boxes_left);
+    }
+}
+try_one (0, 0, $start_nb_boxes, "", keys %boxes);
+say "Max: $max_val, Boxes:  $max_boxes";
diff --git a/challenge-036/laurent-rosenfeld/perl6/ch-1.p6 b/challenge-036/laurent-rosenfeld/perl6/ch-1.p6
new file mode 100644
index 0000000000..48376006e2
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl6/ch-1.p6
@@ -0,0 +1,26 @@
+use v6;
+
+sub validate (Str $vin) {
+    return False if $vin ~~ /<[OIQ]>/;
+    return False unless $vin ~~ /^ <[A..Z0..9]> ** 17 $/;
+    return check-digit $vin;
+}
+
+sub check-digit (Str $vin) {
+    my %translations =
+     A => 1, B => 2, C => 3, D => 4, E => 5, F => 6, G => 7, H => 8,
+     J => 1, K => 2, L => 3, M => 4, N => 5, P => 7, R => 9, S => 2,
+     T => 3, U => 4, V => 5, W => 6, X => 7, Y => 8, Z => 9;
+    %translations{$_} = $_ for 0..9;
+    my @weights = 8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2;
+    my $i = 0;
+    my $sum = sum map { %translations{$_} * @weights[$i++]}, $vin.comb;
+    my $mod = $sum % 11;
+    $mod = 'X' if $mod == 10;
+    return True if $mod eq substr $vin, 8, 1;
+    return False;
+}
+
+sub MAIN (Str $vin = "1M8GDM9AXKP042788") {
+    say validate($vin) ?? "Correct" !! "Wrong";
+}
diff --git a/challenge-036/laurent-rosenfeld/perl6/ch-1a.p6 b/challenge-036/laurent-rosenfeld/perl6/ch-1a.p6
new file mode 100644
index 0000000000..13d306ee2d
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl6/ch-1a.p6
@@ -0,0 +1,27 @@
+use v6;
+use Test;
+
+sub validate ($vin) {
+    return False if $vin ~~ /<[OIQ]>/;
+    return True if $vin ~~ /^ <[A..Z0..9]> ** 17 $/;
+    return False;
+}
+
+plan 16;
+
+ok  validate("A" x 17),   "17 A's";
+ok  validate(1 x 17),     "17 digits";
+nok validate("AEIOU"),    "Five vowels";
+nok validate(1234567890), "Ten digits";
+nok validate("1234AEIOU5678901"),   "sixteen digits or letters";
+ok  validate("12345678901234567"),  "17 digits";
+nok validate("1234567890123456Q"),  "16 digits and a Q";
+nok validate("1234567890123456O"),  "16 digits and a O";
+nok validate("1234567890123456I"),  "16 digits and a I";
+nok validate("Q1234567890123456"),  "A Q and 16 digits";
+nok validate("I1234567890123456"),  "An I and 16 digits";
+ok  validate("ABCD4567890123456"),  "17 digits and letters";
+nok validate("ABef4567890123456"),  "Digits and some lower case letters";
+nok validate("ABE?4567890123456"),  "A non alphanumerical character";
+nok validate("ABCD4567 90123456"),  "A space";
+nok validate("ABCD45678901234567"), "More than 17 characters";
diff --git a/challenge-036/laurent-rosenfeld/perl6/ch-2.p6 b/challenge-036/laurent-rosenfeld/perl6/ch-2.p6
new file mode 100644
index 0000000000..109f2a0ba8
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl6/ch-2.p6
@@ -0,0 +1,20 @@
+use v6;
+
+constant %boxes = (
+    "R" => { "w" => 1,  val => 1  },
+    "B" => { "w" => 1,  val => 2  },
+    "G" => { "w" => 2,  val => 2  },
+    "Y" => { "w" => 12, val => 4  },
+    "P" => { "w" => 4,  val => 10 },
+);
+sub MAIN (UInt $max-nb = 5) {
+    my ($best, $max) = find-best %boxes.keys.combinations: 1..$max-nb;
+    say "Max: $max; ", $best;
+}
+sub find-best (@candidates) {
+    my @valid-candidates = gather for @candidates -> $cand {
+        take [ $cand, $cand.map({ %boxes{$_}{'val'}}).sum ]
+            if $cand.map({ %boxes{$_}{'w'}}).sum <= 15;
+    }
+    return  @valid-candidates.max({$_[1]});
+}
diff --git a/challenge-036/laurent-rosenfeld/perl6/ch-2a.p6 b/challenge-036/laurent-rosenfeld/perl6/ch-2a.p6
new file mode 100644
index 0000000000..3926ba62e5
--- /dev/null
+++ b/challenge-036/laurent-rosenfeld/perl6/ch-2a.p6
@@ -0,0 +1,33 @@
+use v6;
+
+constant %boxes = (
+    "R" => { "w" => 1,  val => 1  },
+    "B" => { "w" => 1,  val => 2  },
+    "G" => { "w" => 2,  val => 2  },
+    "Y" => { "w" => 12, val => 4  },
+    "P" => { "w" => 4,  val => 10 },
+);
+
+sub MAIN (UInt $start-nb-boxes = 5) {
+    my @boxes = keys %boxes;
+    my $*max-val = 0;
+    my $*max-boxes = "";
+    try-one(0, 0, $start-nb-boxes, "", "A", @boxes);
+    say "Max: $*max-val, Boxes:  $*max-boxes";
+    say now - INIT now;
+}
+
+sub try-one ($cur-weight, $cur-val, $num-boxes, $boxes-used, $last-box-used, @boxes-left) {
+    if $cur-val > $*max-val {
+        $*max-val = $cur-val;
+        $*max-boxes = $boxes-used;
+    }
+    for @boxes-left -> $box {
+        next if $box lt $last-box-used;
+        my $new-cur-weight = $cur-weight + %boxes{$box}{'w'};
+        next if $new-cur-weight > 15 or $num-boxes <= 0;
+        my @new-boxes-left = grep { $_ ne $box}, @boxes-left;
+        my $new-box-used = $boxes-used ?? $boxes-used ~ "-$box" !! $box;
+        try-one $new-cur-weight, $cur-val + %boxes{$box}{'val'}, $num-boxes -1, $new-box-used, $box, @new-boxes-left;
+    }
+}