Kevin Colyer's thoughts and ponderings

Semi-random rambles

Perl Weekly Challenge – Week 36

Leave a comment

I have been enjoying completing the Perl Weekly Challenges over the last six months or so. Solutions in other programming languages are welcomed by the way. I have been using the challenge to develop my Raku (formerly Perl 6) skills.  I was crowned champion of week 30!

I have learnt much from the challenges and also from the blogs others have written detailing their solutions. It is all about sharing an appreciation of the Raku language and fostering a wider adoption.

Please take my solutions in the Perl spirit of “There Is More Than One Way To Do It”: this is my way.

So on to the tasks:

Task 1

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

After a quick review of the wikipedia page I decided I would verify the general form with the checksum, just to keep things simple. I am sure there are modules already written that are more correct than I could write anyway.

A VIN has 17 digits. The 9th is a checksum digit (ranging from 0 to 10, with X substituting for 10) Letter I, O, and Q not valid. The checksum digit can be ignored in the checking part and compared once calculated.

I started by creating the tables that the validation algorithm would require.

my %value=
    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, "_" => 0,
    0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9;

my @weight=8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2;

The validateVIN function does all the hard work returning ‘valid’ if correct or an explanation if not.  See numbered notes below:

sub validateVIN($vin is copy) { #1
    my @v= $vin.uc.comb; #2
    return "invalid vin character: I,O or Q"     if $vin ~~ m:i/ <[ I O Q ]>+ /;
    return "invalid vin length {$vin.chars}" if $vin.chars != 17;

    my $check=@v[8]; #3
    $check = 0 if $check eq '_';
    $check = 10 if $check eq 'X'; #4
    my $i=0;

    for ^17 {
        $i += %value{@v[$_]} * @weight[$_]; #5
    };

    return $i % 11 == $check ?? "valid" !! "invalid - failed checksum" ; #6
}
  1. $vin is marked as a copy. This allows the sub to change its value without having to worry about changing the original value it was called with or needing to be copied to a new variable.
  2. The @v array is filled with the $vin, converted to uppercase and ‘combed’ into individual letters as elements of the array.
  3. We capture the check digit here.
  4. The check digit is converted from base 11.
  5. A simple loop counts ^17 (up to 17) passing the value into the for loops code block as the topic variable $_. The sum is calculated from the product of the value of each digit looked up in the hash and the corresponding weight in the table. The checksum weight is zero handily removing it from the calculation.
  6. The newly calculated checksum is divided modular 11 and compared with the original check digit.

 

#| Enter a Vehicle Identification Number to validate
multi MAIN(Str $vin) {
    say validateVIN($vin);
}

The MAIN function is a great tool to create a CLI easily. Here the comment #| gives extra usage information.

It is declared as a multi sub so I can also run tests too.

multi MAIN('test') {
    is validateVIN("111111111111111i1"),"invalid vin character: I,O or Q","invalid vin character: I,O or Q";
    is validateVIN("111111111111111111"),"invalid vin length 18","invalid vin length 18";
    is validateVIN("11111111111111111"),"valid","Vin is valid = all 1's'";
    is validateVIN("1M8GDM9A_KP042788"),"invalid - failed checksum","invalid - failed checksum";
    is validateVIN("1M8GDM9AXKP042788"),"valid","Vin is valid = wikipedia example";
done-testing;
}

I used the is function from the Test module as I like the way that if your test fails it prints both the expected and received values. done-testing declares Testing is done and makes the test results clearer. I find that easier than pre-declaring the number of tests to run.

Task 2

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?

I took this task to mean there were only 5 boxes in total. This is what wikipedia describes as the 0-1 Knapsack problem I think. (Having submitted my entry I noted that others had solved the Unbounded Knapsack problem: UKP. I ran out of time here and wrote this blog instead!)

class box {
    has Str $.colour;
    has Int $.weight;
    has Int $.amount;
}

my @boxes=
    box.new(colour => 'R', weight => 1 , amount => 1 ),
    box.new(colour => 'B', weight => 1 , amount => 2 ),
    box.new(colour => 'G', weight => 2 , amount => 2 ),
    box.new(colour => 'Y', weight => 12, amount => 4 ),
    box.new(colour => 'P', weight => 4 , amount => 10),
;

I started creating a small class to encapsulate the concept of the box. Then I filled a array with one of each. This is used so I can use an index to refer to boxes and not have to create many objects.

my @combinations=(^@boxes.elems).combinations;

my $max_weight=15;
my $max_boxes=@boxes.elems;

I then used a method called combinations that creates all the possible combinations of the initial list (which is started with the ^@boxes.elems, shorthand for a range of numbers from 0 up to the number of elements in boxes -1. Just what I need for combinations of indices later.

The knapsack sub does the main work.

sub knapsack(@combinations,@boxes,$max_weight,$max_boxes) {
    my @cands= gather for @combinations -> @c { #1
        next unless @c.elems <= $max_boxes; #2
        
        my $w= @boxes[@c]>>.weight.sum; #3
        
        next unless $w <= $max_weight; #4
        
        my %wv= comb => @c, w => $w, v => @boxes[@c]>>.amount.sum; #5
        take %wv; #6
    }
    @cands.=sort({$^a<v> <= $^b<v>}); #7
    
    return @cands[0];
}
  1. The candidates for best solution are ‘gathered’ into the array @cands using a for loop over the possible combinations.
  2. Jump to the next iteration of the loop if the number of combination are more than we are allowed.
  3. $w is assigned by taking an array slice of the indices given by the combination. This could be 1,3,4 for example. The >> is a hyper operator that passes all the boxes taking their .weight value and summing all the values together. This saves a simple loop here.
  4. Skip along if we are already overweight…
  5. Store this in a hash this for later, especially the .amount which is the GBP value.
  6. We take the hash. This passes it back to the gather, but immediately continues the loop (in this case starting the next turn around.)
  7. Finally we sort the candidates by value in descending order. All that remains is to return the best one, at the head of the array.

Finally we print the solution

my %best_value= knapsack(@combinations, @boxes, $max_weight, $max_boxes);
say "(max boxes $max_boxes, max weight $max_weight)";
say "Best boxes are "~ (@boxes[$_].colour for flat %best_value<comb>).sort.join(" ");
say "total weight: {%best_value<w>}Kg, value: £{%best_value<v>}";

The most complex part is the printing of the colours of the boxes. This required a ‘flattening’ of the list the hash containing the solution otherwise it was treated not as a list of integer indices but as a list containing a single item (a list of integers). Caused a bit of head scratching that.

The Bonus part of the challenge was fairly simple given that the knapsack was solved in a sub. I looped over the max boxes and kept track of the maximum amount value.

my $best_num_boxes=0;
my $best_GBP_value=0;
my %best;

for 2..4 -> $max_boxes {
    my %best_value = knapsack(@combinations, @boxes, $max_weight, $max_boxes);
    if %best_value<v> > $best_GBP_value {
        $best_GBP_value = %best_value<v>;
        %best=%best_value;
        $best_num_boxes = $max_boxes;
    }
}

say "\nBonus\nOptimal number of boxes to maximise value for 2 to 4 boxes is: \n$best_num_boxes with {%best<w>}Kg, value: £{%best<v>}";

I hope that helps. Errors, omissions and improvements welcomed!

Author: kevincolyer

I was born somewhere in England. Kevin and Nicki were joined in wedded bliss in September 1994. I have four wonderful Children. I am a minister in the Church of England, about half-way through my curacy: I'm vicar who can start churches for people who are not really churchy. I desire to start lots of these culturally relevant churches all over. I am a strong supporter of Free/Libre Open Source Software. I have been known to enjoy high quality Belgian beer. I like trying to speak Dutch. I like to think I can speak French. I lived in Belgium for 10 wonderful years and still miss it. Currently living in Maidenhead, UK.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s