RabbitFarm

2022-12-03

The Weekly Challenge 193 (Prolog Solutions)

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

Part 1

You are given an integer, $n > 0. Write a script to find all possible binary numbers of size $n.

Solution


binary --> [].
binary --> digit, binary.
digit  --> [0]; [1].

binary_numbers_size_n(N, BinaryNumbers):-
    length(Binary, N), 
    findall(Binary, phrase(binary, Binary), BinaryNumbers).

main:-
    binary_numbers_size_n(2, BinaryNumbers),
    write(BinaryNumbers), nl.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- main.
[[0,0],[0,1],[1,0],[1,1]]

(1 ms) yes
| ?- binary_numbers_size_n(3, BinaryNumbers).            

BinaryNumbers = [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

yes
| ?- binary_numbers_size_n(4, BinaryNumbers).

BinaryNumbers = [[0,0,0,0],[0,0,0,1],[0,0,1,0],[0,0,1,1],[0,1,0,0],[0,1,0,1],[0,1,1,0],[0,1,1,1],[1,0,0,0],[1,0,0,1],[1,0,1,0],[1,0,1,1],[1,1,0,0],[1,1,0,1],[1,1,1,0],[1,1,1,1]]

yes

Notes

This challenge presented a perfect use for a DCG, right!?!? For convenience we wrap the DCG in a predicate binary_numbers_size_n/2 to make sure we set a list of the correct size.

Part 2

You are given a list of strings of same length, @s. Write a script to find the odd string in the given list. Use positional alphabet values starting with 0, i.e. a = 0, b = 1, ... z = 25.

Solution


string_differences(String, Differences):-
    atom_codes(String, Codes),
    string_differences(Codes, [], Differences).
string_differences([_|[]], Differences, Differences).   
string_differences([C0, C1|T], DifferenceAccum, Differences):-
    Difference is C1 - C0,
    string_differences([C1|T], [Difference|DifferenceAccum], Differences).

odd_string(Strings, OddString):-
    maplist(string_differences, Strings, Differences),
    member(Difference, Differences),
    delete(Differences, Difference, UpdatedDifferences),
    length(UpdatedDifferences, UpdatedDifferencesLength),
    UpdatedDifferencesLength > 1,
    nth(N, Differences, Difference),
    nth(N, Strings, OddString).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- odd_string([adc, wzy, abc], OddString).

OddString = abc ? 

yes
| ?- odd_string([aaa, bob, ccc, ddd], OddString).

OddString = bob ? 

(1 ms) yes
| ?- odd_string([aaaa, bbob, cccc, dddd], OddString).

OddString = bbob ? 

yes

Notes

The approach here is:

1) Compute all the differences for each string using maplist/3 with string_differences/2, a helper predicate I wrote.

2) Once done we use member/2 identify a difference from the list

3) Delete the difference and see if the list has been reduced to size one.

4) If the list has not been reduced to one element then we know we have found the uniquely odd string!

5) By position, determine the OddString from the original list.

References

Challenge 193

posted at: 19:58 by: Adam Russell | path: /prolog | permanent link to this entry

The Weekly Challenge 193

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

Part 1

You are given an integer, $n > 0. Write a script to find all possible binary numbers of size $n.

Solution


use v5.36;
sub binary_numbers_size_n{
    my($n) = @_;
    my @numbers = map {
        sprintf("%0${n}b", $_)
    } 0 .. 2**$n - 1;
    return @numbers;
}

MAIN:{
    say join(", ", binary_numbers_size_n(2));
    say join(", ", binary_numbers_size_n(3));
    say join(", ", binary_numbers_size_n(4));
}

Sample Run


$ perl perl/ch-1.pl
00, 01, 10, 11
000, 001, 010, 011, 100, 101, 110, 111
0000, 0001, 0010, 0011, 0100, 0101, 0110, 0111, 1000, 1001, 1010, 1011, 1100, 1101, 1110, 1111

Notes

I think it's fair to say that sprintf is doing most of the work here! For those unfamiliar, the format string "%0${n}b" means print the number as binary of length $n, left pad with 0s.

Part 2

You are given a list of strings of same length, @s. Write a script to find the odd string in the given list. Use positional alphabet values starting with 0, i.e. a = 0, b = 1, ... z = 25.

Solution


use v5.36;
sub odd_string{
    my(@strings) = @_;
    my %differences;
    for my $string (@strings){
        my $current;
        my $previous;
        my @differences;
        map {
            unless($previous){
                $previous = $_;
            }
            else{
                $current = $_;
                push @differences, ord($current) - ord($previous);
                $previous = $current;
            }        
        } split(//, $string);
        my $key = join(",", @differences);
        my $size_before = keys %differences;
        $differences{$key} = undef;
        my $size_after = keys %differences;
        return $string if $size_before > 0 && $size_after - $size_before == 1;
    }
    return undef;
}

MAIN:{
    say odd_string(qw/adc wzy abc/);
    say odd_string(qw/aaa bob ccc ddd/);
    say odd_string(qw/aaaa bbbb cccc dddd/) || "no odd string found";
    say odd_string(qw/aaaa bbob cccc dddd/);
}

Sample Run


$ perl perl/ch-2.pl
abc
bob
no odd string found
bbob

Notes

There is one main assumption here and that is that the list of strings is going to be of length three or more. If the array has length one then can we say that single string is "odd" in and of itself? And if we have only two strings and they aren't the same which is the the odd one?

The basic steps of this solution are:

1) For each string split it into an array of characters.

2) Compute the differences. This is done in the map. I'll concede that this is a somewhat unusual use of map!

3) Transform the differences into a single string to be used as a hash key using join.

4) If we add this differences based key to the hash and the hash size changes by 1 (assuming it is a non-empty hash) then we know we have found the unique "odd string" which is then returned.

References

Challenge 193

posted at: 19:04 by: Adam Russell | path: /perl | permanent link to this entry