RabbitFarm

2023-01-29

The Weekly Challenge 201 (Prolog Solutions)

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

Part 1

You are given an array of unique numbers. Write a script to find out all missing numbers in the range 0..$n where $n is the array size.

Solution


missing_number(Numbers, Missing):-
    length(Numbers, NumbersLength),
    between(0, NumbersLength, Missing),
    \+ member(Missing, Numbers). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- missing_number([0, 1, 3], Missing).

Missing = 2 ? 

(1 ms) yes
| ?- missing_number([0, 1], Missing).   

Missing = 2

yes
| ?- 

Notes

missing_number/2 will only find one missing number at a time. In the examples that come with the original problem statement there is only ever one missing number. If multiple missing numbers are required backtracking with findall/3 is all you need!

Part 2

You are given an integer, $n > 0. Write a script to determine the number of ways of putting $n pennies in a row of piles of ascending heights from left to right.

Solution


sum(Coins):-
    sum([], Coins, 0).

sum(Coins, Coins, 5). 

sum(Partial, Coins, Sum):-   
    Sum < 5, 
    between(1, 5, X),
    S is Sum + X,
    sum([X | Partial], Coins, S).  

main:-
    findall(Coins, sum(Coins), C),
    maplist(msort, C, CS),
    sort(CS, CoinsSorted),
    write(CoinsSorted), nl,
    halt.  

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- main.
[[1,1,1,1,1],[1,1,1,2],[1,1,3],[1,2,2],[1,4],[2,3],[5]]

Notes

The approach here is the same that I used for the Coins Sum problem from TWC 075. The same as for the Perl solution to the same problem.

References

Challenge 201

posted at: 18:39 by: Adam Russell | path: /prolog | permanent link to this entry

How Many Missing Coins?

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

Part 1

You are given an array of unique numbers. Write a script to find out all missing numbers in the range 0..$n where $n is the array size.

Solution


use v5.36;
use boolean;
sub missing_numbers{
    my @numbers = @_;
    my %h;
    do { $h{$_} = undef } for @numbers;
    my @missing = grep { !exists($h{$_}) } 0 .. @numbers;
    return @missing;
}

MAIN:{
    say q/(/ . join(q/, /, missing_numbers(0, 1, 3)) . q/)/;
    say q/(/ . join(q/, /, missing_numbers(0, 1)) . q/)/;
    say q/(/ . join(q/, /, missing_numbers(0, 1, 2, 2)) . q/)/;
}

Sample Run


$ perl perl/ch-1.pl 
(2)
(2)
(3, 4)

Notes

This problem was a nice refresh on exists, which is often confused with defined. Here we want to see if the hash key exists at all and so the use is appropriate. If we had wanted to see if the value keyed was defined, well, that is the use for defined!

Part 2

You are given an integer, $n > 0. Write a script to determine the number of ways of putting $n pennies in a row of piles of ascending heights from left to right.

Solution


use v5.36;
use AI::Prolog;
use Hash::MultiKey;

MAIN:{
    my $S = $ARGV[0];
    my $C = "[" . $ARGV[1] . "]";

    my $prolog = do{
        local $/;
        <DATA>;
    }; 
    $prolog =~ s/_COINS_/$C/g;
    $prolog =~ s/_SUM_/$S/g;
    $prolog = AI::Prolog->new($prolog); 
    $prolog->query("sum(Coins).");
    my %h;
    tie %h, "Hash::MultiKey";
    while(my $result = $prolog->results){
        my @s = sort @{$result->[1]};
        $h{\@s} = undef;
    }
    for my $k ( sort { @{$b} <=> @{$a} } keys %h){
        print "(" . join(",", @{$k}) . ")";
        print "\n";
    }
}

__DATA__
member(X,[X|_]).
member(X,[_|T]) :- member(X,T).

coins(_COINS_).

sum(Coins):-
    sum([], Coins, 0).

sum(Coins, Coins, _SUM_). 

sum(Partial, Coins, Sum):-   
    Sum < _SUM_, 
    coins(L),
    member(X,L),
    S is Sum + X,
    sum([X | Partial], Coins, S). 

Sample Run


$ perl perl/ch-2.pl 5 1,2,3,4,5
(1,1,1,1,1)
(1,1,1,2)
(1,2,2)
(1,1,3)
(1,4)
(2,3)
(5)

Notes

The approach here is the same that I used for the Coins Sum problem from TWC 075. The only change is the added sort by the length of the "piles".

References

Challenge 201

posted at: 18:30 by: Adam Russell | path: /perl | permanent link to this entry