RabbitFarm

2025-04-27

The Weekly Challenge 318 (Prolog Solutions)

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

Part 1: Group Position

You are given a string of lowercase letters. Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return “” if none found.

We can do this in a single predicate which uses maplist to get the groupings with a small utility predicate.

⟨utility predicate for finding groups 1 ⟩≡


group(Letters, Letter, Group):-
length(Letters, LengthLetters),
delete(Letters, Letter, Deleted),
length(Deleted, LengthDeleted),
Difference is LengthLetters - LengthDeleted,
Difference >= 3,
length(G1, Difference),
maplist(=(Letter), G1),
append(G1, _, G2),
append(_, G2, Letters),
atom_codes(Group, G1).
group(_, _, nil).
◇

Fragment referenced in 3.

⟨groupings 2 ⟩≡


groupings(Word, Groupings):-
sort(Word, UniqueLetters),
maplist(group(Word), UniqueLetters, Groups),
delete(Groups, nil, Groupings).
◇

Fragment referenced in 3.

The rest of the code just wraps this single predicate into a file.

"ch-1.p" 3≡


⟨utility predicate for finding groups 1 ⟩
⟨groupings 2 ⟩
◇

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- groupings("abccccd", Groupings). 
 
Groupings = [cccc] ? 
 
yes 
| ?- groupings("aaabcddddeefff", Groupings). 
 
Groupings = [aaa,dddd,fff] ? 
 
yes 
| ?- groupings("abcdd", Groupings). 
 
Groupings = [] 
 
yes 
| ?-

Part 2: Reverse Equals

You are given two arrays of integers, each containing the same elements as the other. Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.

This is going to be a quick one, but there’s going to be a few pieces we need to take care of. First we will check that we can subtract/3 the two words (character code lists) and obtain an empty list. Then we’ll check in which places the words differ. If they differ in one place or more then we’re done. Otherwise we’ll test the reversal of the sublist.

⟨test elements 4 ⟩≡


subtract(List1, List2, []),
◇

Fragment referenced in 8.

Uses: List1 8, List2 8.

⟨find differences 5 ⟩≡


length(List1, Length),
findall(I, (
between(1, Length, I),
nth(I, List1, C1),
nth(I, List2, C2),
\+ C1 = C2
), DifferenceIndices),
◇

Fragment referenced in 8.

Defines: DifferenceIndices 6, 8.

Uses: List1 8, List2 8.

⟨get sublists 6 ⟩≡


length(DifferenceIndices, NumberDifferences),
NumberDifferences > 0,
nth(1, DifferenceIndices, FirstIndex),
last(DifferenceIndices, LastIndex),
findall(E, (
between(FirstIndex, LastIndex, I),
nth(I, List1, E)
), SubList1),
findall(E, (
between(FirstIndex, LastIndex, I),
nth(I, List2, E)
), SubList2),
◇

Fragment referenced in 8.

Defines: SubList1 7, SubList2 7.

Uses: DifferenceIndices 5, List1 8, List2 8.

⟨test sublists and their reversals 7 ⟩≡


reverse(SubList1, Reverse1),
reverse(SubList2, Reverse2),
append(SubList1, Suffix1, S1),
append(SubList2, Suffix2, S2),
append(Reverse1, Suffix1, S3),
append(Reverse2, Suffix2, S4),
append(Prefix1, S1, List1),
append(Prefix2, S2, List2),
(append(Prefix1, S3, List2); append(Prefix2, S4, List1))
◇

Fragment referenced in 8.

Uses: List1 8, List2 8, SubList1 6, SubList2 6.

All these pieces will be assembled into reverse_equals/2.

⟨reverse equals 8 ⟩≡


reverse_equals(List1, List2):-
⟨test elements 4 ⟩
⟨find differences 5 ⟩
⟨get sublists 6 ⟩
⟨test sublists and their reversals 7 ⟩.
reverse_equals(List1, List2):-
⟨test elements 4 ⟩
⟨find differences 5 ⟩
length(DifferenceIndices, NumberDifferences),
NumberDifferences = 0.
◇

Fragment referenced in 9.

Defines: List1 4, 5, 6, 7, List2 4, 5, 6, 7.

Uses: DifferenceIndices 5.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 9≡


⟨reverse equals 8 ⟩
◇

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- reverse_equals([3, 2, 1, 4], [1, 2, 3, 4]). 
 
true ? 
 
yes 
| ?- reverse_equals([1, 3, 4], [4, 1, 3]). 
 
no 
| ?- reverse_equals([2], [2]). 
 
yes 
| ?-

References

The Weekly Challenge 318
Generated Code

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

Group Position Reversals

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

Part 1: Group Position

You are given a string of lowercase letters. Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return “” if none found.

Here’s our one subroutine, this problem requires very little code.

⟨groupings 1 ⟩≡


sub groupings{
my($s) = @_;
my @groups;
my @group;
my($current, $previous);
my @letters = split //, $s;
$previous = shift @letters;
@group = ($previous);
do {
$current = $_;
if($previous eq $current){
push @group, $current;
}
if($previous ne $current){
if(@group >= 3){
push @groups, [@group];
}
@group = ($current);
}
$previous = $current;
} for @letters;
if(@group >= 3){
push @groups, [@group];
}
my @r = map {q/"/␣.␣join(q//,␣@{$_}) . q/"/␣}␣@groups;
return join(q/, /, @r) || q/""/;
}
◇

Fragment referenced in 2.

Putting it all together...

"ch-1.pl" 2≡


⟨preamble 3 ⟩
⟨groupings 1 ⟩
⟨main 4 ⟩
◇

⟨preamble 3 ⟩≡


use v5.40;
◇

Fragment referenced in 2, 7.

The rest of the code just runs some basic tests.

⟨main 4 ⟩≡


MAIN:{
say groupings q/abccccd/;
say groupings q/aaabcddddeefff/;
say groupings q/abcdd/;
}
◇

Fragment referenced in 2.

Sample Run
$ perl perl/ch-1.pl 
"cccc" 
"aaa", "dddd", "fff" 
""

Part 2: Reverse Equals

You are given two arrays of integers, each containing the same elements as the other. Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.

Here’s the process we’re going to follow.

  1. scan both arrays and check where and how often they differ
  2. if they differ in zero places return true!
  3. if they differ in one or more places check to see if the reversal makes the two arrays equal

⟨scan both arrays 5 ⟩≡


my $indices_different = [];
for my $i (0 .. @{$u} - 1){
push @{$indices_different}, $i unless $u->[$i] eq $v->[$i];
}
◇

Fragment referenced in 7.

Defines: $indices_different 6.

Uses: $u 7, $v 7.

Now let’s check and see how many differences were found.

⟨review the differences found 6 ⟩≡


return 1 if @{$indices_different} == 0;
$indices_different = [sort {$a <=> $b} @{$indices_different}];
my $last_i = $indices_different->[@{$indices_different} - 1];
my $length = 1 + $last_i - $indices_different->[0];
my @u_ = reverse @{$u}[$indices_different->[0] .. $last_i];
my @v_ = reverse @{$v}[$indices_different->[0] .. $last_i];
splice @{$u}, $indices_different->[0], $length, @u_;
splice @{$v}, $indices_different->[0], $length, @v_;
return 1 if join(q/,/, @{$u}) eq join(q/,/, @{$t});
return 1 if join(q/,/, @{$v}) eq join(q/,/, @{$s});
return 0;
◇

Fragment referenced in 7.

Uses: $indices_different 5, $s 7, $t 7, $u 7, $v 7.

The rest of the code combines the previous steps and drives some tests.

"ch-2.pl" 7≡


⟨preamble 3 ⟩
sub reverse_equals{
my($u, $v) = @_;
my($s, $t) = ([@{$u}], [@{$v}]);
⟨scan both arrays 5 ⟩
⟨review the differences found 6 ⟩
}
⟨main 8 ⟩
◇

Defines: $s 6, $t 6, $u 5, 6, $v 5, 6.

⟨main 8 ⟩≡


MAIN:{
say reverse_equals [3, 2, 1, 4], [1, 2, 3, 4];
say reverse_equals [1, 3, 4], [4, 1, 3];
say reverse_equals [2], [2];
}
◇

Fragment referenced in 7.

Sample Run
$ perl perl/ch-2.pl 
1 
0 
1

References

The Weekly Challenge 318
Generated Code

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