RabbitFarm

2020-12-06

Perl Weekly Challenge 089 (Prolog solutions)

Part 1

You are given a positive integer $N. Write a script to sum GCD of all possible unique pairs between 1 and $N.

Solution


range_list(0, [0]).
range_list(N, List):-
    range_list(N, [], List).
range_list(0, List, List).
range_list(N, ListAccum, List):-
    N0 is N - 1,
    range_list(N0, [N|ListAccum], List).

unique_pairs(List, Pairs):-
    unique_pairs(List, List, [], Pairs).

unique_pairs([], [], Pairs, Pairs).
unique_pairs([_|T0], [], PairsAccum, Pairs):-
   unique_pairs(T0, T0, PairsAccum, Pairs).
unique_pairs([H0|T0], [H1|T1], PairsAccum, Pairs):-
   \+ member([H0, H1], PairsAccum),
   \+ member([H1, H0], PairsAccum),
   H0 \= H1,
   unique_pairs([H0|T0], T1, [[H0, H1]|PairsAccum], Pairs).
unique_pairs([H0|T0], [_|T1], PairsAccum, Pairs):-
   unique_pairs([H0|T0], T1, PairsAccum, Pairs).

write_gcd_pairs(Pairs):-
    write_gcd_pairs(Pairs, 0).
write_gcd_pairs([[I,J]|[]], Sum):-
    Sum0 is Sum + gcd(I, J),
    format("gcd(~d, ~d) = ~d ~n", [I, J, Sum0]).
write_gcd_pairs([[I,J]|T], Sum):-
    format("gcd(~d, ~d) + ", [I, J]),
    Sum0 is Sum + gcd(I, J),
    write_gcd_pairs(T, Sum0).

main:-
    range_list(4, L),
    unique_pairs(L, Pairs),
    write_gcd_pairs(Pairs),
    halt. 

Sample Run


$ gprolog
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
| ?- ['prolog/ch-1.p'].
compiling /home/adamcrussell/perlweeklychallenge-club/challenge-089/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/perlweeklychallenge-club/challenge-089/adam-russell/prolog/ch-1.p compiled, 36 lines read - 6945 bytes written, 52 ms

(26 ms) yes
| ?- main.
gcd(3, 4) + gcd(2, 4) + gcd(2, 3) + gcd(1, 4) + gcd(1, 3) + gcd(1, 2) = 7 

Notes

This mostly follows the approach of the Perl solution for this problem. The problem is broken down into the following pieces

Part 2

You are given m x n matrix of positive integers. Write a script to print spiral matrix as a list.

Solution


all_unique(_, []).
all_unique(L, [V|T]) :-
    fd_exactly(1, L, V),
    all_unique(L, T).

pwc_matrix(R1,R2,R3) :-
    R1 = [A, B, C],
    R2 = [D, E, F],
    R3 = [G, H, I],
    /* each element is a number from 1 to 9 */  
    fd_domain([A, B, C], 1, 9),
    fd_domain([D, E, F], 1, 9),
    fd_domain([G, H, I], 1, 9),
    /* ensure each element is unique */
    all_unique([A, B, C, D, E, F, G, H, I], [1, 2, 3, 4, 5, 6, 7, 8, 9]),
    /* row constraints */
    A + B + C #= 15,
    D + E + F #= 15,
    G + H + I #= 15,
    /* column constraints */
    A + D + G #= 15,
    B + E + H #= 15,
    C + F + I #= 15,
    /* diagonal constraints */
    A + E + I #= 15,
    C + E + G #= 15,
    /* label all variables to instantiate one solution */  
    fd_labeling([A, B, C, D, E, F, G, H, I]).  

write_rows([]).
write_rows([H|T]):-
    format('[ ~d ~d ~d ]~n', H),
    write_rows(T).

write_solutions([]). 
write_solutions([H|T]):-
   write_rows(H), 
   nl,
   write_solutions(T). 

main :-
    findall([R1,R2,R3], pwc_matrix(R1,R2,R3), Solutions),  
    write_solutions(Solutions). 

Sample Run


$ gprolog
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
| ?- ['prolog/ch-2.p'].
compiling /home/adamcrussell/perlweeklychallenge-club/challenge-089/adam-russell/prolog/ch-2.p for byte code...
/home/adamcrussell/perlweeklychallenge-club/challenge-089/adam-russell/prolog/ch-2.p compiled, 42 lines read - 6581 bytes written, 50 ms

(31 ms) yes
| ?- main.
[ 2 7 6 ]
[ 9 5 1 ]
[ 4 3 8 ]

[ 2 9 4 ]
[ 7 5 3 ]
[ 6 1 8 ]

[ 4 3 8 ]
[ 9 5 1 ]
[ 2 7 6 ]

[ 4 9 2 ]
[ 3 5 7 ]
[ 8 1 6 ]

[ 6 1 8 ]
[ 7 5 3 ]
[ 2 9 4 ]

[ 6 7 2 ]
[ 1 5 9 ]
[ 8 3 4 ]

[ 8 1 6 ]
[ 3 5 7 ]
[ 4 9 2 ]

[ 8 3 4 ]
[ 1 5 9 ]
[ 6 7 2 ]


(5 ms) yes

Notes

This is really not too tremendously different than a Sudoku, which just came up a couple of weeks ago. Obviously the constraints are different but the general approach is very similar. Here I am using Gnu Prolog’s finite domain (FD) constraint solver functions. In the past I primarily used SWI-Prolog and for this sort of problem I’d specifically make use of SWI-Prolog’s library(clpfd). Conceptually, the implementations are virtually identical which slightly different predicates. Gnu Prolog seems much faster, but I have neither confirm nor denied that with any sort of benchmarks.

posted at: 20:10 by: Adam Russell | path: /prolog | permanent link to this entry

Perl Weekly Challenge 089

Part 1

You are given a positive integer $N. Write a script to sum GCD of all possible unique pairs between 1 and $N.

Solution


use strict;
use warnings;
##
# You are given a positive integer $N. Write a script to sum GCD of all possible 
# unique pairs between 1 and $N.
##

sub all_unique_pairs{
    my($n) = @_;
    my %pairs;
    for my $i (1 .. $n){
        for my $j (1 .. $n){
            $pairs{"$i-$j"} = -1 unless $pairs{"$i-$j"} || $pairs{"$j-$i"} || $i == $j; 
        }
    }
    return sort keys %pairs;
}

sub euclid {
    my($a, $b) = @_;
    return ($b) ? euclid($b, $a % $b) : $a;
}

MAIN:{
    my $gcd_sum = 0; 
    my @values =  all_unique_pairs(3);
    for my $pair (@values[0 .. @values - 2]){
        my($i, $j) = split(/-/, $pair);
        $gcd_sum += euclid($i, $j);
        print "gcd($i, $j) + ";  
    }
    my ($i, $j) = split(/-/, $values[-1]); 
    $gcd_sum += euclid($i, $j);
    print "gcd($i, $j) = $gcd_sum\n";  

    $gcd_sum = 0; 
    @values =  all_unique_pairs(4);
    for my $pair (@values[0 .. @values - 2]){
        my($i, $j) = split(/-/, $pair);
        $gcd_sum += euclid($i, $j);
        print "gcd($i, $j) + ";  
    }
    ($i, $j) = split(/-/, $values[-1]); 
    $gcd_sum += euclid($i, $j);
    print "gcd($i, $j) = $gcd_sum\n";  

}

Sample Run


$ perl perl/ch-1.pl
gcd(1, 2) + gcd(1, 3) + gcd(2, 3) = 3
gcd(1, 2) + gcd(1, 3) + gcd(1, 4) + gcd(2, 3) + gcd(2, 4) + gcd(3, 4) = 7

Notes

Sometimes before jumping into my own solutions I do a little research on the topics at hand. In doing so for this I came across this beautifully succinct implementation of Euclid’s algorithm. I decided to use that here for the GCD computation.

Ok, with that sorted out, what is left is to generate all the unique pairs and print the results. I generate the pairs in all_unique_pairs by saving the pairs as hash heys, stringified by joining them with a ‘-’. When printing them out later it is necessary to split on the ‘-’.

Part 2

You are given m x n matrix of positive integers. Write a script to print spiral matrix as a list.

Solution


use strict;
use warnings;
##
# Write a script to display matrix as below with numbers 1 - 9. 
# Please make sure numbers are used once.
##
use boolean;
use Math::GSL::Permutation q/:all/;

sub validate {
    my($a, $b, $c, $d, $e, $f, $g, $h, $i) = @_;
    return false if ($a + $b + $c) != 15;
    return false if ($d + $e + $f) != 15;
    return false if ($g + $h + $i) != 15;
    return false if ($a + $d + $g) != 15;
    return false if ($b + $e + $h) != 15;
    return false if ($c + $f + $i) != 15;
    return false if ($a + $e + $i) != 15;
    return false if ($c + $e + $g) != 15;
    return true;
}

sub print_matrix {
    my($a, $b, $c, $d, $e, $f, $g, $h, $i) = @_;
    print "[ $a $b $c ]\n";
    print "[ $d $e $f ]\n";
    print "[ $g $h $i ]\n";
}    

MAIN:{
    my $permutation = new Math::GSL::Permutation(9);
    while(gsl_permutation_next($permutation->raw) == 0){
        my @values =  $permutation->as_list();
        @values = map { $_ + 1 } @values;
        do { 
            print_matrix(@values);
            print "\n";
        }if validate(@values);  
    }
}

Sample Run


$ perl perl/ch-2.pl
[ 2 7 6 ]
[ 9 5 1 ]
[ 4 3 8 ]

[ 2 9 4 ]
[ 7 5 3 ]
[ 6 1 8 ]

[ 4 3 8 ]
[ 9 5 1 ]
[ 2 7 6 ]

[ 4 9 2 ]
[ 3 5 7 ]
[ 8 1 6 ]

[ 6 1 8 ]
[ 7 5 3 ]
[ 2 9 4 ]

[ 6 7 2 ]
[ 1 5 9 ]
[ 8 3 4 ]

[ 8 1 6 ]
[ 3 5 7 ]
[ 4 9 2 ]

[ 8 3 4 ]
[ 1 5 9 ]
[ 6 7 2 ]

Notes

The validate function is pretty straight forward, especially so since I intentionally wrote it to be blazingly obvious what is going on!

The real work is in generating the permutations that get checked. For that I used Math::GSL::Permutation which, as the name implies, is an excellent module which wraps the Gnu Scientific Library. Well, the module is quite solid aside from the documentation which is a bit rough and often requires referring to the GSL documentation on the functions being wrapped.

The main point to know about Math::GSL::Permutation is that it only creates permutations on integers. As Perl programmers we get spoiled by being able to easily manipulate any type of data. If you are interested in permuting lists of arbitrary elements you could use Math::GSL::Permutation to permute the indices, but not the elements themselves.

One final note, having a conditional after the expression is just one of those classic examples of Perl expressiveness, but I seldom see the do/if form. A do/if allows you to have multiple statements, a whole block, execute with the if coming afterwards. Obviously just syntactic sugar for the more common if{} but I prefer it in cases like this where there is no need for an else.

References

Euclid’s Algorithm

Math::GSL

GSL

GSL Permutations Example

posted at: 17:23 by: Adam Russell | path: /perl | permanent link to this entry