RabbitFarm

2025-03-16

The Weekly Challenge 312 (Prolog Solutions)

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

Part 1: Minimum Time

You are given a typewriter with lowercase english letters a to z arranged in a circle. Typing a character takes 1 sec. You can move pointer one character clockwise or anti-clockwise. The pointer initially points at a. Write a script to return minimum time it takes to print the given string.

All the logic for computing the shortest move us contained in a single predicate.

⟨compute minumum number of moves to get to the next letter 1 ⟩≡

: compute_moves(Current, Next, Moves):-
X is Current - 96,
Y is Next - 96,
XH is X + 13,
YH is Y + 13,
((Y >= XH, Moves is X + 26 - Y);
(Y >= X, Y =< XH, Moves is Y - X);
(X >= YH, Moves is Y + 26 - X);
(X >= Y, X =< YH, Moves is X - Y)).
◇

: Fragment referenced in 3.

We’ll use a DCG to process the list of letters (we’re using ASCII codes).

⟨process letters 2 ⟩≡

: minimum_time([Current, Next|Letters]) --> [Time], {
compute_moves(Current, Next, Moves),
succ(Moves, Time)}, minimum_time([Next|Letters]).
minimum_time([_]) --> [].
◇

: Fragment referenced in 3.

Finally, let’s combine the previous predicates into a file along with a predicate minimum_time/2 that ties everything together.

"ch-1.p" 3≡

: ⟨compute minumum number of moves to get to the next letter 1 ⟩
⟨process letters 2 ⟩
minimum_time(S, MinimumTime):-
append([97], S, S0),
phrase(minimum_time(S0), Times),
sum_list(Times, MinimumTime), !.
◇

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- minimum_time("abc", MinimumTime). 
 
MinimumTime = 5 
 
yes 
| ?- minimum_time("bza", MinimumTime). 
 
MinimumTime = 7 
 
yes 
| ?- minimum_time("zjpc", MinimumTime). 
 
MinimumTime = 34 
 
yes 
| ?-

Part 2: Balls and Boxes

There are $n balls of mixed colors: red, blue or green. They are all distributed in 10 boxes labelled 0-9. You are given a string describing the location of balls. Write a script to find the number of boxes containing all three colors. Return 0 if none found.

We’ll use a DCG here in Part 2, althought it’ll be just a little bit more intricate.

First off, we’ll be passing the state around via some helper predicates. At the end of processing we’ll have a set of pairs that hold the contents of each box.

⟨state of the content of the boxes 4 ⟩≡

: boxes(Boxes), [Boxes] --> [Boxes].
boxes(Box, Boxes), [Boxes] --> [Box].
◇

: Fragment referenced in 7.

Now the DCG. For each record given we’ll process each Ball/Box pair.

⟨process the record of box contents as a list 5 ⟩≡

: box_record([]) --> [].
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
var(B), B = Box-[Color], append([], [B], Boxes)},
box_record(T).
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
nonvar(B), member(Box-Colors, B), delete(B, Box-Colors, B0),
append([Color], Colors, Colors0), append([Box-Colors0], B0, Boxes)},
box_record(T).
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
nonvar(B), \+ member(Box-_, B), append([Box-[Color]], B, Boxes)},
box_record(T).
◇

: Fragment referenced in 7.

⟨helper predicate for checking if a box has all three colors 6 ⟩≡

: full_box(_-Colors, Full):-
sort(Colors, ColorsSorted),
length(ColorsSorted, NumberColors),
((NumberColors == 3, Full = true);
(Full = false)).
◇

: Fragment referenced in 7.

Finally, let’s assemble our completed code into a single file. We’ll also add a predicate to co-orindate calling the DCG and processing the final result.

"ch-2.p" 7≡

: ⟨state of the content of the boxes 4 ⟩
⟨process the record of box contents as a list 5 ⟩
⟨helper predicate for checking if a box has all three colors 6 ⟩
full_boxes(BallsBoxes, CountFullBoxes):-
phrase(box_record(BallsBoxes), [_], [Boxes]),
maplist(full_box, Boxes, Full),
delete(Full, false, FullBoxes),
length(FullBoxes, CountFullBoxes), !.
◇

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- full_boxes("G0B1R2R0B0", FullBoxes). 
 
FullBoxes = 1 
 
yes 
| ?- full_boxes("G1R3R6B3G6B1B6R1G3", FullBoxes). 
 
FullBoxes = 3 
 
yes 
| ?- full_boxes("B3B2G1B3", FullBoxes). 
 
FullBoxes = 0 
 
yes 
| ?-

References

The Weekly Challenge 312
Generated Code

posted at: 15:35 by: Adam Russell | path: /prolog | permanent link to this entry

Minimum Time in the Box

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

Part 1: Minimum Time

The complete solution is contained in one file that has a simple structure.

"ch-1.pl" 1≡

: ⟨preamble 2 ⟩
⟨minimum time to type 3 ⟩
⟨main 4 ⟩
◇

For this problem we do not need to include very much. We’re just specifying to use the current version of Perl, for all the latest features in the language. This fragment is also used in Part 2.

⟨preamble 2 ⟩≡

: use v5.40;
◇

: Fragment referenced in 1 , 6.

All the work is in one subroutine. We use the ASCII values of each character to compute the new value.

⟨minimum time to type 3 ⟩≡

: sub minimum_time{ my($s) = @_; my @c = split //, lc($s); my $time = 0; my $moves; my $current = q/a/; { my $next = shift @c; my($x, $y) = (ord($current) - 96, ord($next) - 96); $moves = ($x + 26) - $y if $y >= ($x + 13); $moves = $y - $x if $y <= ($x + 13) && $y >= $x; $moves = ($y + 26) - $x if $x >= ($y + 13); $moves = $x - $y if $x <= ($y + 13) && $x >= $y; $time += $moves; $time++; $current = $next; redo if @c > 0; } return $time; }
◇

: Fragment referenced in 1.

Now all we need are a few lines of code for running some tests.

⟨main 4 ⟩≡

: MAIN:{
say minimum_time q/abc/;
say minimum_time q/bza/;
say minimum_time q/zjpc/;
}
◇

: Fragment referenced in 1.

Sample Run

$ perl perl/ch-1.pl 
5 
7 
34

Part 2: Balls and Boxes

We’re going to use Parse::Yapp for this problem. Writing parsers is fun! This problem is providing an excuse to write one. This approach has been used in past weeks, for example TWC 259 from this time last year. For simplicity, to start with, here is all the code that Parse::Yapp will use as it’s input.

"ch-2.yp" 5≡

: %token LETTER
%token NUMBER
%{
my %boxes = ();
%}

%%

records: record {\%boxes}
| records record
;

record: LETTER NUMBER {push @{$boxes{qq/$_[2]/}}, $_[1]}
;

%%

sub lexer{
my($parser) = @_;
defined($parser->YYData->{INPUT}) or return(’’, undef);
##
# send tokens to parser
##
for($parser->YYData->{INPUT}){
s/^([0-9])// and return (q/NUMBER/, $1);
s/^([A-Z])// and return (q/LETTER/, $1);
}
}

sub error{
exists $_[0]->YYData->{ERRMSG}
and do{
print $_[0]->YYData->{ERRMSG};
return;
};
print "syntax␣error\n";
}

sub parse{
my($self, $input) = @_;
$input =~ tr/\t/ /s;
$input =~ tr/ //s;
$self->YYData->{INPUT} = $input;
my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
return $result;
}
◇

"ch-2.pl" 6≡

: ⟨preamble 2 ⟩
use Ch2;
⟨parse the input and check the results 7 ⟩
⟨main 8 ⟩
◇

To solve this problem we are going to pass the input string to the parser. The parser is going to return a hash reference which we’ll check to see which boxes contain all the balls, as described in the problem statement.

⟨parse the input and check the results 7 ⟩≡

: sub parse_boxes{
my($record) = @_;
my $parser = Ch2->new();
my $boxes = $parser->parse($record);
my $full = 0;
for my $box (keys %{$boxes}){
$full++ if 1 <= (grep { $_ eq q/R/ } @{$boxes->{$box}}) &&
1 <= (grep { $_ eq q/G/ } @{$boxes->{$box}}) &&
1 <= (grep { $_ eq q/B/ } @{$boxes->{$box}});
}
return $full;
}
◇

: Fragment referenced in 6.

Finally, we need to confirm everything is working right.

⟨main 8 ⟩≡

: MAIN:{
say parse_boxes $ARGV[0];
}
◇

: Fragment referenced in 6.

Sample Run

$ yapp -m Ch2 perl/ch-2.yp; mv Ch2.pm perl 
$ perl -I perl perl/ch-2.pl G0B1R2R0B0 
1 
$ perl -I perl perl/ch-2.pl G1R3R6B3G6B1B6R1G3 
3 
$ perl -I perl perl/ch-2.pl B3B2G1B3 
0

References

The Weekly Challenge 312
Generated Code

posted at: 01:29 by: Adam Russell | path: /perl | permanent link to this entry