RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given integers 0 <= $m <= 255 and 1 <= $n <= 8. Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.

Solution

use strict;
use warnings;
sub flip_bit_n{
    my($x, $n) = @_;
    my $bits = substr(unpack("B32", pack("N", $x)), 24, 8);
    my @bits = split(//, $bits);
    $bits[@bits - $n] ^= 1;
    my $flipped_decimal = unpack("N", pack("B32", substr("0" x 32 . join("", @bits), -32)));
    return $flipped_decimal;
}

MAIN:{
    my($M, $N);
    $M = 12;
    $N = 3;
    print flip_bit_n($M, $N) . "\n";
    $M = 18;
    $N = 4;
    print flip_bit_n($M, $N) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
8 
26

Notes

This code re-uses much of the code from last week's challenge solution. The only difference is that this week we flip the specified nth bit using the XOR operator. I think that this may be the first time I have ever used a ^= operation!

Part 2

You are given a NxN matrix containing the distances between N cities. Write a script to find a round trip of minimum length visiting all N cities exactly once and returning to the start.

Solution

use strict;
use warnings;
use boolean;
use AI::Genetic;

use constant N => 7;

my @matrix= ([0, 5, 2, 7],
             [5, 0, 5, 3],
             [3, 1, 0, 6],
             [4, 5, 4, 0]);

sub fitness{
    my($genes) = @_;
    my $cost = 0;
    return -1 if $genes->[0] != $genes->[@{$genes} - 1];
    my @path = sort {$a <=> $b} @{$genes}[0 .. @{$genes} - 2];
    for my $i (0 .. (@path - 2)){
        return -1 if $path[$i] == $path[$i + 1];
    }
    for my $i (0 .. @{$genes} - 2){
        $cost += $matrix[$genes->[$i]][$genes->[$i + 1]];
    }
    return 1/$cost;
}

sub terminate{
    return true;
}

MAIN:{
    srand(121);
    my $aig = new AI::Genetic(
        -fitness    => \&fitness,
        -type       => "rangevector",
        -population => 500,
        -crossover  => 0.9,
        -mutation   => 0.1,
    );
    my $genes = [];
    for (0 .. N + 1){
        push @{$genes}, [0, N];
    }
    @matrix = ();
    for (0 .. N){
        my $row = [];
        for my $i (0 .. N){
            push @{$row}, int(rand(N * 2 + 1));
        }
        push @matrix, $row;
    }
    $aig->init(
        $genes
    );
    $aig->evolve("tournamentUniform", 100000);
    my $path = $aig->getFittest()->genes();
    print join(",", @{$path}) . "\n";
    my $cost;
    for my $i (0 .. @{$path} - 2){
        $cost += $matrix[$path->[$i]][$path->[$i + 1]];
    }
    print "cost: $cost\n";
}

Sample Run

$ perl perl/ch-2.pl
3,0,1,2,3
cost: 10
$ perl perl/ch-2.pl
3,1,7,5,4,6,0,2,3
cost: 24

Notes

I have used Genetic Algorithm (GA) approaches to a bunch of these challenge problems in the past. I will admit that in some cases the GA approach is more for fun than as a good example of the sorts of problems GA is good for. This time, however, we have a somewhat classic use case!

The Travelling Salesman Problem is well known to be NP-Hard and Genetic Algorithms are a well studied approach to tackling these beasts.

I first tested this solution with the example in the original problem statement, hardcoded here in @matrix and obtained a result which matched the known correct one. Then, testing with increasingly larger values of N to generate random matrices I continued to get seemingly correct results. I did not verify these by hand. Instead I set a random seed with srand and verified that I got the same cost results over several runs. As needed I would adjust the number of generations in the evolve() method call upwards until again getting results which converged on the same cost value.

For a 20 x 20 matrix I seem to be getting correct results, but runtimes are quite lengthy and I ran out of time to test this further. However, I am very confident that a correct path is obtainable this way although perhaps some additional slight adjustment of parameters is necessary.

(Hopefully nobody is too terribly confused by this, but please do notice that the size of the matrix is actually N + 1. That is, in order to obtain a matrix like the one given in the problem statement you specify an N of 3, although obviously this is a 4 x 4 matrix. This is just in keeping with the city labels starting with 0.)

References

Challenge 121

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given integers 0 <= $m <= 255 and 1 <= $n <= 8. Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.

Solution

:-initialization(main).

pad(Bits, Padded):-
    length(Bits, L),
    PadLength is 8 - L,
    length(Padding, PadLength),
    maplist(=(0), Padding),
    append(Padding, Bits, Padded).

bits(N, Bits):-
    bits(N, [], Bits).
bits(0, Bits, Bits).
bits(N, Bit_Accum, Bits):-
    B is N /\ 1,
    N0 is N >> 1,
    bits(N0, [B|Bit_Accum], Bits).

flip_nth_bit(N, Bits, NthFlipped):-
    N0 is 9 - N,
    N1 is 8 - N,
    nth(N0, Bits, B),
    Flipped is xor(B, 1),
    length(Bits0, N1),
    append(Bits0, [B|T], Bits),
    append(Bits0, [Flipped|T], NthFlipped).

decimal(Bits, Decimal):-
    decimal(Bits, 0, Decimal).
decimal([], Decimal, Decimal).
decimal([H|T], DecimalAccum, Decimal):-
    length([H|T], B),
    D is (H * 2 ** (B - 1)) + DecimalAccum,
    decimal(T, D, Decimal).

main:-
    bits(12, B),
    pad(B, Padded),
    flip_nth_bit(3, Padded, Flipped),
    decimal(Flipped, Decimal),
    write(Decimal), nl,
    halt.

Sample Run

$ gprolog --consult-file prolog/ch-1.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
Copyright (C) 1999-2020 Daniel Diaz
| ?- consult('prolog/ch-1.p').
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-121/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-121/adam-russell/prolog/ch-1.p compiled, 41 lines read - 4756 bytes written, 48 ms
8.0

Notes

This re-uses much code from last week. What is different here is flip_nth_bit/3 which finds the Nth bit specified, XORs it, and then sets the updated list.

References

Challenge 121