This is my sixth week participating into the weekly challenge.





Easy Challenge

“Write a program to validate given Vehicle Identification Number (VIN). For more information, please checkout wikipedia.”



I didn’t want to spend too much time on this challenge as it could possibly be solved using a CPAN module like:



https://metacpan.org/pod/Data::Validate::VIN



I got a few real vins from this site for testing:

https://randomvin.com/



I checked using regexes and applied what I think are the appropriate rules for each region. The Wiki is a bit dodgy on the details but I hope I got most of it.



The most interesting bit was testing the check digit verification, which was basically a poor man’s checksum.







Perl 5 solution

#!/usr/bin/perl # Test: ./ch1.pl use strict; use warnings; use feature qw /say/; # Check a bunch of different world VIN's # These should be valid for my $vin ( 'SCFFDAAM4EGA15321', 'JTHBA30G355101885', '1D7HA18P57J602071', 'WA1LFAFP7EA118600', '1NXBU40E39Z155675', '3VWSK69MX5M058145', 'JS3TY92V534101150', 'WDDHF5KBXEA837164') { check_vin($vin); } # These should be invalid for my $vin ( 'SCFFDAAM4EGA1$321', 'JTHBA30G3Z5101885', '1D7HA18P57J602072', '1NXBU40E79Z15567x',) { check_vin($vin); } # Check vin sub check_vin { my $vin = shift; if (_check_vin($vin)) { say "$vin is valid."; } else { say "$vin is not valid."; }; } # Check vin (the guts) sub _check_vin { my $vin = uc(shift); my $vin_re = '[A-HJ-NPR-Z0-9]'; # Check for valid World Vin return undef unless ($vin =~ / ^ # Start of string ($vin_re{3}) # World identification number ($vin_re{6}) # Vehicle descriptor section ($vin_re{8}) # Vehicle identifier section $ # End of string /x); # Capture parts of the vin my $win = $1; # World identification number my $vds = $2; # Vehicle descriptor section my $vis = $3; # Vehicle identifier section # 1st digit of the VIS can'test be a U, Z or 0 return undef if ($vis =~ /^[UZ0]/); # Need to validate check digit # compulsory for vehicles # in North America and China, if ($win =~ /^[1-5L]/) { return unless check_digit($vin); } # In america and china the last 5 # digits of the vis is numeric if ($win =~ /^[1-5L]/) { return undef unless ($vis =~ / ^ # Start of string $vin_re{3} # First 3 \d{5} # Last 5 digits $ # End of string /x); } return 1; } # Calculate the check digit sub check_digit { my $vin = shift; my $products = 0; # Transliterate my %translate = ( 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); # Weights my @weights = ( 8,7,6,5,4,3,2,10,0, 9,8,7,6,5,4,3,2 ); # Calculate the check digit my $x = 0; foreach my $char (split //, $vin) { my $val = $translate{$char} ? $translate{$char} : $char; $products += $val * $weights[$x++]; } # Calculate the check digit my $mod = $products % 11; $mod = 'X' if $mod == 10; # Check the digit my $check_digit = substr $vin, 8, 1; return $mod eq $check_digit; }

Output

SCFFDAAM4EGA15321 is valid. JTHBA30G355101885 is valid. 1D7HA18P57J602071 is valid. WA1LFAFP7EA118600 is valid. 1NXBU40E39Z155675 is valid. 3VWSK69MX5M058145 is valid. JS3TY92V534101150 is valid. WDDHF5KBXEA837164 is valid. SCFFDAAM4EGA1$321 is not valid. JTHBA30G3Z5101885 is not valid. 1D7HA18P57J602072 is not valid. 1NXBU40E79Z15567x is not valid.

Raku solution

# Test: perl6 ch1.p6 use v6.d; sub MAIN() { # Check a bunch of different world VIN's # These should be valid for ( 'SCFFDAAM4EGA15321', 'JTHBA30G355101885', '1D7HA18P57J602071', 'WA1LFAFP7EA118600', '1NXBU40E39Z155675', '3VWSK69MX5M058145', 'JS3TY92V534101150', 'WDDHF5KBXEA837164') -> $vin { check-vin($vin.uc); } # These should be invalid for ( 'SCFFDAAM4EGA1$321', 'JTHBA30G3Z5101885', '1D7HA18P57J602072', '1NXBU40E79Z15567x') -> $vin { check-vin($vin.uc); } } # Check vin sub check-vin(Str $vin) { if (_check-vin($vin)) { say "$vin is valid."; } else { say "$vin is not valid."; }; } # Check vin (the guts) sub _check-vin(Str $vin) { my $vin_re = /<[A..HJ..NPR..Z0..9]>/; # Check for valid World Vin return Nil unless ($vin ~~ / ^^ # Start of string ($vin_re ** 3) # World identification number ($vin_re ** 6) # Vehicle descriptor section ($vin_re ** 8) # Vehicle identifier section $$ # End of string /); # Capture parts of the vin my $win = $0; # World identification number my $vds = $1; # Vehicle descriptor section my $vis = $2; # Vehicle identifier section # 1st digit of the VIS can't be a U, Z or 0 return Nil if ($vis ~~ /^^<[UZ0]>/); # Need to validate check digit # compulsory for vehicles # in North America and China, if ($win ~~ /^^<[1..5L]>/) { return Nil unless check-digit($vin); } # In america and china the last 5 # digits of the vis is numeric if ($win ~~ /^^<[1..5L]>/) { return Nil unless ($vis ~~ / ^^ # Start of string $vin_re ** 3 # First 3 \d ** 5 # Last 5 digits $$ # End of string /); } return 1; } # Calculate the check digit sub check-digit(Str $vin) { my $products = 0; # Transliterate my %translate = ( 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 ); # Weights my @weights = ( 8,7,6,5,4,3,2,10,0, 9,8,7,6,5,4,3,2 ); # Calculate the check digit my $x = 0; my @chars = $vin.comb; for (0 .. @chars.end) -> $i { my $val = %translate{@chars[$i]} ?? %translate{@chars[$i]} !! @chars[$i]; $products += $val * @weights[$i]; } # Calculate the check digit my $mod = ($products % 11).Str; $mod = 'X' if $mod == 10; # Check the digit my $check_digit = substr $vin, 8, 1; return $mod eq $check_digit; }

Output

SCFFDAAM4EGA15321 is valid. JTHBA30G355101885 is valid. 1D7HA18P57J602071 is valid. WA1LFAFP7EA118600 is valid. 1NXBU40E39Z155675 is valid. 3VWSK69MX5M058145 is valid. JS3TY92V534101150 is valid. WDDHF5KBXEA837164 is valid. SCFFDAAM4EGA1$321 is not valid. JTHBA30G3Z5101885 is not valid. 1D7HA18P57J602072 is not valid. 1NXBU40E79Z15567X is not valid.

Hard Challenge

“Write a program to solve Knapsack Problem.”



There are 5 color coded boxes with varying weights and amounts in GBP. Which boxes should be choosen to maximize the amount of money while still keeping the overall weight under or equal to 15 kgs?



R: (weight = 1 kg, amount = £1)

B: (weight = 1 kg, amount = £2)

G: (weight = 2 kg, amount = £2)

Y: (weight = 12 kg, amount = £4)

P: (weight = 4 kg, amount = £10)

Bonus task, what if you were allowed to pick only 2 boxes or 3 boxes or 4 boxes? Find out which combination of boxes is the most optimal?

This is an interesting problem as the knapsack problem is quite well known in computer science.



I tackled this version my creating a meta attribute which i called value and defined it as amount/weight.



Then I sorted the boxes by value, then by weight. Then iterating through the boxes with highest value first and trying to put as many of them into the knapsack without going over the weight or maximum box allowance.





Perl 5 solution

#!/usr/bin/perl # Test: ./ch2.pl use strict; use warnings; # Box configurations my $boxes = { R => { weight => 1, amount => 1 }, B => { weight => 1, amount => 2 }, G => { weight => 2, amount => 2 }, Y => { weight => 12, amount => 4 }, P => { weight => 4, amount => 10 }, }; # knapsack with unlimited boxes and 15 kg max knapsack($boxes, 15, 0); # knapsack with 2 3 4 boxes and 15kg max knapsack($boxes, 15, 2); knapsack($boxes, 15, 3); knapsack($boxes, 15, 4); sub knapsack { my ($boxes, $max_weight, $max_boxes) = @_; my $total_weight = 0; my $total_boxes = 0; my $total_amount = 0; my $set_of_boxes; # Order the boxes by which # gives the most value, followed by weight. for my $key ( sort sort_value_weight keys %$boxes ) { my $box = $boxes->{$key}; # While there is space or weight left while (1) { # Check for space or weight last unless $total_weight + $box->{weight} <= $max_weight; last unless !$max_boxes || ($max_boxes && $total_boxes + 1 <= $max_boxes); $total_boxes++; $set_of_boxes .= $key; $total_weight += $box->{weight}; $total_amount += $box->{amount}; } } print 'Max weight: ' . $max_weight; print ', max boxes: ' . $max_boxes if ($max_boxes); print '. Boxes in knapsack: ' . $set_of_boxes; print ' ' . $total_weight . 'kg '; print '£' . $total_amount . "

"; } # Sort function to sort by value then weight sub sort_value_weight { my $value_a = $boxes->{$::a}->{amount} / $boxes->{$::a}->{weight}; my $value_b = $boxes->{$::b}->{amount} / $boxes->{$::b}->{weight}; my $weight_a = $boxes->{$::a}->{weight}; my $weight_b = $boxes->{$::b}->{weight}; if ( $value_b > $value_a ) { return 1; } elsif ( $value_b == $value_a ) { return ($weight_b > $weight_a) ? 1 : -1; } else { return -1; } }

Output

Max weight: 15. Boxes in knapsack: PPPBBB 15kg £36

Max weight: 15, max boxes: 2. Boxes in knapsack: PP 8kg £20

Max weight: 15, max boxes: 3. Boxes in knapsack: PPP 12kg £30

Max weight: 15, max boxes: 4. Boxes in knapsack: PPPB 13kg £32

Raku solution

# Test: perl6 ch2.p6 use v6.d; # Box configurations my %boxes = ( R => { weight => 1, amount => 1 }, B => { weight => 1, amount => 2 }, G => { weight => 2, amount => 2 }, Y => { weight => 12, amount => 4 }, P => { weight => 4, amount => 10 }, ); sub MAIN () { # knapsack with unlimited boxes and 15 kg max knapsack(%boxes, 15, Inf); # knapsack with 2 3 4 boxes and 15kg max knapsack(%boxes, 15, 2); knapsack(%boxes, 15, 3); knapsack(%boxes, 15, 4); } sub knapsack (%boxes, Int $max_weight, Num() $max_boxes) { my $total_weight = 0; my $total_boxes = 0; my $total_amount = 0; my $set_of_boxes = ''; for %boxes.keys.sort(&sort-value-weight) -> $key { my $box = %boxes.{$key}; # While there is space or weight left while (1) { # Check for space or weight last unless $total_weight + $box.{'weight'} <= $max_weight; last unless !$max_boxes || ($max_boxes && $total_boxes + 1 <= $max_boxes); $total_boxes++; $set_of_boxes ~= $key; $total_weight += $box.{'weight'}; $total_amount += $box.{'amount'}; } } say 'Max weight: ' ~ $max_weight ~ ', max boxes: ' ~ $max_boxes ~ '. Boxes in knapsack: ' ~ $set_of_boxes ~ ' ' ~ $total_weight ~ 'kg ' ~ '£' ~ $total_amount; } # Sort function to sort by value then weight sub sort-value-weight { my $value_a = %boxes.{$^a}.{'amount'} / %boxes.{$^a}.{'weight'}; my $value_b = %boxes.{$^b}.{'amount'} / %boxes.{$^b}.{'weight'}; my $weight_a = %boxes.{$^a}.{'weight'}; my $weight_b = %boxes.{$^b}.{'weight'}; if ( $value_b > $value_a ) { return 1; } elsif ( $value_b == $value_a ) { return ($weight_b > $weight_a) ?? 1 !! -1; } else { return -1; } }

Output

Max weight: 15, max boxes: Inf. Boxes in knapsack: PPPBBB 15kg £36

Max weight: 15, max boxes: 2. Boxes in knapsack: PP 8kg £20

Max weight: 15, max boxes: 3. Boxes in knapsack: PPP 12kg £30

Max weight: 15, max boxes: 4. Boxes in knapsack: PPPB 13kg £32