RabbitFarm

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

Part 1

You are given an array of strings and a check string. Write a script to find out if the check string is the acronym of the words in the given array.

Solution

acronym(Strings, CheckString):-
    maplist(nth(1), Strings, CheckStringUpperCaseCodes),
    maplist(char_code, CheckStringUpperCase, CheckStringUpperCaseCodes),
    maplist(lower_upper, CheckStringLowerCase, CheckStringUpperCase),
    atom_chars(CheckStringA, CheckStringLowerCase),
    atom_codes(CheckStringA, CheckString).

Sample Run

% gprolog --consult-file prolog/ch-1.p
| ?- acronym(["Perl", "Python", "Pascal"], "ppp"). 

true ? 

yes
| ?- acronym(["Perl", "Raku"], "rp").             

no
| ?- acronym(["Oracle", "Awk", "C"], "oac").

true ? 

yes
| ?- acronym(["Oracle", "Awk", "C"], A), atom_codes(Acronym, A).

A = [111,97,99]
Acronym = oac ? 

yes
| ?- 

Notes

In keeping with the spirit of the original, Perl centric, challenge question I use strings instead of Prolog atoms. The difference is that strings will be represented as lists of character codes, so a little extra code is required.

Chanelling the spirit of Prolog, the solution will backtrack and provide the acronym if that variable is given uninstantiated!

Part 2

You are given an array of integers. Write a script to create an array such that new[i] = old[old[i]] where 0 <= i < new.length.

Solution

build_list(_, [], []).
build_list(Old, [OldH|OldT], [NewH|NewT]):-
    succ(OldH, I),
    nth(I, Old, NewH),
    build_list(Old, OldT, NewT).

Sample Run

% gprolog --consult-file prolog/ch-2.p 
| ?- Old = [0, 2, 1, 5, 3, 4], build_list(Old, Old, New).

New = [0,1,2,4,5,3]
Old = [0,2,1,5,3,4] ? 

yes
| ?- Old = [5, 0, 1, 2, 3, 4], build_list(Old, Old, New).

New = [4,5,0,1,2,3]
Old = [5,0,1,2,3,4] ? 

yes
| ?- 

Notes

This is basically the same recursive procedure as used in the Perl solution to the same problem. I did the Perl version first, which was helpful to prototype the recursion.

References

Challenge 240

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

Part 1

You are given an array of strings and a check string. Write a script to find out if the check string is the acronym of the words in the given array.

Solution

use v5.38;
use boolean;
sub acronym{
    my($strings, $acronym) = @_;
    return boolean(join(q//, map {(split //, lc $_)[0]} @{$strings}) eq lc $acronym);
}

MAIN:{
    say acronym [qw/Perl Python Pascal/], q/ppp/;
    say acronym [qw/Perl Raku/], q/rp/;
    say acronym [qw/Oracle Awk C/], q/oac/;
}

Sample Run

$ perl perl/ch-1.pl 
1
0
1

Notes

I really wracked my brain to try and come up with a simpler solution and I couldn't!

Part 2

You are given an array of integers. Write a script to create an array such that new[i] = old[old[i]] where 0 <= i < new.length.

Solution

use v5.38;
sub build_array{ 
    push @{$_[0]}, $_[$_[@{$_[0]} + 1] + 1];
    return $_[0] if @{$_[0]} == @_ - 1;
    goto __SUB__;
}

MAIN:{
    say join q/, /, @{build_array([], 0, 2, 1, 5, 3, 4)};
    say join q/, /, @{build_array([], 5, 0, 1, 2, 3, 4)};
}

Sample Run

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

Notes

First off, yes, this code is a bit obfuscated! Writing obfuscated code is not usually something I strive to do, but I was sort of forced down this road. See, what happened is that I read E. Choroba's solution on Discord despite the spoiler warnings! Now, I didn't want his solution to influence mine so I forced myself to come up with something which would be as different as possible.

build_array uses recursion to accumulate the result in the first argument, an array reference. We use the length of the array reference as the index used to look up, and assign elements, from the original array. The original array is present as all remaining arguments in the subroutine call, so we'll need to adjust the indices by 1 to allow for the array reference accumulator as the first argument. The recursion is created using goto __SUB__ which by default retains the original array arguments. Since our accumulator is an array reference and none of the other arguments change then we can make use of this as a convenience. The recursion ends when the accumulated array is of the same length as the original array, then we know that all elements have been processed.

References

Challenge 240