RabbitFarm

2024-03-09

Representing a graph in Prolog

The standard way that graphs are taught in Prolog is to represent the graph edges in the Prolog database and then, as needed, manipulate the database using assertz/1 and retract/1. There really is nothing wrong with this for many applications. However, when dealing with large graphs the overhead of writing to the database may not be worth the performance gain (via indexing) when querying. Especially in cases when the amount of querying may be low, there may not be any “return on investment”.

An alternative method, promoted by Markus Triska, is the use of attributed variables. In this way a variable represents a graph node and the attributes represent edges. Additionally, beyond that basic representation, additional attributes can be used for other information on the node and to add attributes to the edges such as a weight or other information on the relationship between nodes.

To be clear, attributed variables are primarily intended for use when building libraries, such as for constraint logic programming. There the default Prolog unification algorithm is less convenient than an extended version using attributed variables. In these cases hooks are used to determine, say, domain constraints on variables. Here will not concern ourselves with such advanced topics!

Not all Prologs provide attributed variables. Scryer and SWI are among those that do. All of our code is implemented and tested using SWI-Prolog.

Examples

Let’s start off with the most basic example: a small set of otherwise meaningless nodes connected at random.

PIC

This small graph, adapted from an example in Clocksin’s Clause and Effect, can be represented in Prolog in the traditional way as follows.

Example Graph (Standard) 1 ⟩≡


edge(g, h).
edge(d, a).
edge(g, d).
edge(e, d).
edge(h, f).
edge(e, f).
edge(a, e).
edge(a, b).
edge(b, f).
edge(b, c).
edge(f, c).

Fragment referenced in 14.

As needed additional edges can be added and removed from the Prolog database dynamically using assertz/1 and retract/1.

How might we change this to an attributed variables representation?

First off, we need to keep in mind that only an uninstantiated variable can have an attribute set unless we also provide an attribute hook. Since we otherwise have no need for a hook, we will restrict ourselves to having only uninstantiated variables as nodes. Of course, we need to maintain information for each node and edge. In both cases the node information and the edge information are kept as attributes. At first this sounds more complicated than it really is. Let’s see how it comes together in practice.

To build a bridge from the old to the new we will first create a predicate, edges_attributed/2 which converts a list of edges (e.g. [edge(a, b), edge(b, f), edge(f, c)]) to a list of attributed variables where the edges are attributes on the nodes. The attributes on each node are a list of edges to other node and, also, an attribute containing the node label.

For now we are only concerning ourselves with simple graphs like the example, so nodes are just unique atoms (e.g. a, b, c, ...). We’re also assuming that all edges are directed as given.

Convert list of edges to attributed variables. 2 ⟩≡


edges_attributed(Edges, Attributed):-
Extract the nodes from all edges. 3
Create a unique list of nodes. 4
Make the list of K-V pairs for the nodes. 5
Construct a graph of attributed variables. 6

Fragment referenced in 14.

Extract the nodes from all edges. 3 ⟩≡


maplist(edge_nodes, Edges, Nodes),

Fragment referenced in 2.

Create a unique list of nodes. 4 ⟩≡


flatten(Nodes, NodesFlattened),
sort(NodesFlattened, UniqueNodes),

Fragment referenced in 2.

Make the list of K-V pairs for the nodes. 5 ⟩≡


maplist(node_var_pair, UniqueNodes, _, NodePairs),

Fragment referenced in 2.

Construct a graph of attributed variables. 6 ⟩≡


maplist(graph_attributed(Edges, NodePairs), NodePairs, Attributed).

Fragment referenced in 2.

A lot of work is happening in helper predicates via maplist/3. For the most part these are just one or two lines each.

Helper predicate for extracting nodes from edges. 7 ⟩≡


edge_nodes(edge(U, V), [U, V]).

Fragment referenced in 14.

Create a K-V pair for each node. 8 ⟩≡


node_var_pair(N, V, N-V):-
put_attr(V, node, N).

Fragment referenced in 14.

Generate attribute edge list. 9 ⟩≡


edge_list_attribute(Node, NodePairs, Target, Edge):-
memberchk(Target-T, NodePairs),
Edge = edge(Weight, Node, T),
put_attr(Weight, weight, 1).

Fragment referenced in 14.

The lengthiest of the predicates used in a maplist/3 is graph_attributed/3. This is where the final assembly of the graph of attributed variables takes place.

From the node pairs, create the graph of attributed variables. 10 ⟩≡


graph_attributed(Edges, NodePairs, K-V, K-V):-
findall(Target, member(edge(K, Target), Edges), Targets),
maplist(edge_list_attribute(K-V, NodePairs), Targets, EdgeAttributes),
put_attr(V, edges, EdgeAttributes).

Fragment referenced in 14.

Testing this predicate out, with just a small set of edges, we can get a sense of this new representation. A weight attribute, with default value of 1, has been added to demonstrate the possibility of attributed edge variables, but we won’t make any further use of this here.

?- Edges = [edge(a, b), edge(b, c), edge(b, d)], 
edges_attributed(Edges, Attributed). 
Edges = [edge(a, b), edge(b, c), edge(b, d)], 
Attributed = [a-_A, b-_B, c-_C, d-_D], 
put_attr(_A, node, a), 
put_attr(_A, edges, [edge(_E, a-_A, _B)]), 
put_attr(_B, node, b), 
put_attr(_B, edges, [edge(_F, b-_B, _C), edge(_G, b-_B, _D)]), 
put_attr(_C, node, c), 
put_attr(_C, edges, []), 
put_attr(_D, node, d), 
put_attr(_D, edges, []), 
put_attr(_E, weight, 1), 
put_attr(_F, weight, 1), 
put_attr(_G, weight, 1).

That looks nice, but let’s put it to work with a basic traversal.

To start with, let’s defines a predicate to determine if any two nodes are connected by a directed edge. If one or both of the two node arguments are uninstantiated then member/2 will find one for us, otherwise this will just confirm they are in the Graph, which we will be passed to all predicates that need it. This small amount of extra bookkeeping is part of the trade-off for no longer using the dynamic database.

Also, speaking of extra bookkeeping, we’ll try and maintain a level of encapsulation around the use of attributed variables. For example, in the following predicates we only need worry about the handling of attributes when determining connectedness. When building on this code for more complex purposes that is an important part of the design to keep in mind: encapsulate the low level implementation details and provide predicates which have a convenient higher level of interface.

Determine if two nodes are connected by a directed edge. 11 ⟩≡


connected_directed(Graph, S-U, T-V):-
member(S-U, Graph),
member(T-V, Graph),
S \== T,
get_attr(U, edges, UEdges),
member(edge(_, _, X), UEdges),
get_attr(X, node, XN),
XN == T.

Fragment referenced in 14.

In the spirit of building a big example, the following code does the same connectedness check, but for undirected edges. We’re not worrying too much about such graphs, but this is one way to do it.

Determine if two nodes are connected by an undirected edge. 12 ⟩≡


connected_undirected(Graph, S-U, T-V):-
member(S-U, Graph),
member(T-V, Graph),
S \== T,
get_attr(U, edges, UEdges),
get_attr(V, edges, VEdges),
((member(edge(_, _, X), UEdges),
get_attr(X, node, XN),
XN == T);
(member(edge(_, _, X), VEdges),
get_attr(X, node, XN),
XN == S)).

Fragment referenced in 14.

Finally we can use this connectedness check to define path finding predicates that look a lot like any standard Prolog example of path finding you may have seen before!

Find a path between any two nodes, if such a path exists. 13 ⟩≡


path(Graph, S, T, Path):-
path(Graph, S, T, [S, T], P),
Path = [S|P].

path(Graph, S, T, _, Path):-
connected_directed(Graph, S, T),
Path = [T].

path(Graph, S, T, Visited, Path):-
connected_directed(Graph, S, U),
\+ member(U, Visited),
path(Graph, U, T, [U|Visited], P),
Path = [U|P].

Fragment referenced in 14.

Closing

At this point you should understand how to build a graph using attribute variables in Prolog. The example code here can be further extended as needed. You’ll find that this approach can take on quite a good deal of complexity!

All the code above is structured in a single file as shown. A link to this is in the References section.

"graph.p" 14


Example Graph (Standard) 1
Helper predicate for extracting nodes from edges. 7
Create a K-V pair for each node. 8
Generate attribute edge list. 9
From the node pairs, create the graph of attributed variables. 10
Convert list of edges to attributed variables. 2
Determine if two nodes are connected by a directed edge. 11
Determine if two nodes are connected by an undirected edge. 12
Find a path between any two nodes, if such a path exists. 13

Indices

Files

"graph.p" Defined by 14.

Fragments

Construct a graph of attributed variables. 6 Referenced in 2.

Convert list of edges to attributed variables. 2 Referenced in 14.

Create a K-V pair for each node. 8 Referenced in 14.

Create a unique list of nodes. 4 Referenced in 2.

Determine if two nodes are connected by a directed edge. 11 Referenced in 14.

Determine if two nodes are connected by an undirected edge. 12 Referenced in 14.

Example Graph (Standard) 1 Referenced in 14.

Extract the nodes from all edges. 3 Referenced in 2.

Find a path between any two nodes, if such a path exists. 13 Referenced in 14.

From the node pairs, create the graph of attributed variables. 10 Referenced in 14.

Generate attribute edge list. 9 Referenced in 14.

Helper predicate for extracting nodes from edges. 7 Referenced in 14.

Make the list of K-V pairs for the nodes. 5 Referenced in 2.

References

This method has been promoted by Markus Triska on Stack Overflow, but publicly available examples are rare. Hopefully this page will be useful to any interested persons looking for more information.

Stack Overflow Post #1

Stack Overflow Post #2

Strongly Connected Components An implementation of Tarjan’s strongly connected components algorithm which uses this graph representation.

graph.p

posted at: 00:34 by: Adam Russell | path: /prolog | permanent link to this entry

2023-12-03

The Weekly Challenge 245 (Prolog Solutions)

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

Part 1

You are given two array of languages and its popularity. Write a script to sort the language based on popularity.

Solution


make_pairs(K, V, K-V).

sort_language(Languages, Popularity, SortedLanguages):-
    maplist(make_pairs, Popularity, Languages, PopularityLanguages),
    keysort(PopularityLanguages, SortedPopularityLanguages),
    findall(Language,  member(_-Language, SortedPopularityLanguages), SortedLanguages).

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- sort_language([2, 1, 3], [perl, c, python], SortedLanguages). 

SortedLanguages = [1,2,3]

yes
| ?- 

Notes

A pretty standard Prolog convention is the - separated Pair. So here all we need do is generate the pairs of popularity and language, and then use keysort/2 to get everything in the right order.

Part 2

You are given an array of integers >= 0. Write a script to return the largest number formed by concatenating some of the given integers in any order which is also multiple of 3. Return -1 if none found.

Solution


largest_of_three(Numbers, LargestOfThree):-
    findall(Number,(
        sublist(SubList, Numbers),
        \+ SubList = [],
        permutation(SubList, SubListPermutation),
        number_codes(Number, SubListPermutation),
        0 is Number mod 3), NumbersOfThree),
    ((NumbersOfThree = [], LargestOfThree = -1);
     (max_list(NumbersOfThree, LargestOfThree))). 

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- largest_of_three("819", LargestOfThree).

LargestOfThree = 981

yes
| ?- largest_of_three("86710", LargestOfThree).

LargestOfThree = 8760

(1 ms) yes
| ?- largest_of_three("1", LargestOfThree).    

LargestOfThree = -1 ? 

yes
| ?- 

Notes

This is perhaps the most naive solution to the problem: generate sublists and sort the matching permutations of those sublists.

References

Challenge 245

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

2023-11-26

The Weekly Challenge 244 (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 integers. Write a script to calculate the number of integers smaller than the integer at each index.

Solution


smaller([], _, 0).
smaller([H|Integers], X, Y):-
    smaller(Integers, X, Y0),
    ((X > H, succ(Y0, Y));
     (X =< H, Y = Y0)).

count_smaller(Integers, CountSmaller):-
    maplist(smaller(Integers), Integers, CountSmaller).

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- count_smaller([2, 2, 2], CountSmaller). 

CountSmaller = [0,0,0]

yes
| ?- count_smaller([6, 5, 4, 8], CountSmaller).

CountSmaller = [2,1,0,3] ? 

yes
| ?- count_smaller([8, 1, 2, 2, 3], CountSmaller).

CountSmaller = [4,0,1,1,3] ? 

yes
| ?- 

Notes

Probably this is the most obvious way to count up smaller elements as required. In order to cut down on the recursion I call smaller/3 via a maplist/3.

Part 2

You are given an array of integers representing the strength. Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest.

Solution


group_hero(Group, GroupHero):-
    findall(Hero, (
        sublist(SubList, Group),
        max_list(SubList, Maximum),
        min_list(SubList, Minimum),
        Hero #= Maximum**2 * Minimum
    ), Heroes),
    sum_list(Heroes, GroupHero). 

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- group_hero([2, 1, 4], GroupHero).

GroupHero = 141

yes
| ?-

Notes

The core of this problem is to enumerate all the Power Sets of the Group list. In other programming languages enumerating all sublists of a list is straightforward enough, but requires much more code. Here, with Prolog, we need only call sublist/2 with backtracking. We use a findall/3 to generate all the necessary backtracking and create the list of intermediate sums, which are then all summed for the final solution.

References

Challenge 244

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

2023-11-19

The Weekly Challenge 243 (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 integers. Write a script to return the number of reverse pairs in the given array.

Solution


reverse_pair(X, Y, Z):-
    (X =\= Y, X > Y + Y, Z = 1, !); Z = 0.
reverse_pairs([], 0).    
reverse_pairs([H|T], ReversePairs):-
    reverse_pairs(T, R),
    maplist(reverse_pair(H), T, RP),
    sum_list(RP, Sum),
    ReversePairs is R + Sum.  

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- reverse_pairs([1, 3, 2, 3, 1], ReversePairs).  

ReversePairs = 2

yes
| ?- reverse_pairs([2, 4, 3, 5, 1], ReversePairs).  

ReversePairs = 3

yes
| ?- 

Notes

reverse_pair/3 implements the reverse pair criteria and is called via a maplist/3 in reverse_pairs/3 which recurses over the list and counts up all Reverse Pairs found.

Part 2

You are given an array of positive integers (>=1). Write a script to return the floor sum.

Solution


floor_sum_pair(X, Y, Z):-
    Z is floor(X / Y).

floor_sum(Integers, FloorSum):-
    floor_sum(Integers, Integers, FloorSum).
floor_sum([], _, 0).    
floor_sum([H|T], L, FloorSum):-
    floor_sum(T, L, F),
    maplist(floor_sum_pair(H), L, FS),
    sum_list(FS, Sum),
    FloorSum is F + Sum.  

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- floor_sum([2, 5, 9], FloorSum).

FloorSum = 10

yes
| ?- floor_sum([7, 7, 7, 7, 7, 7, 7], FloorSum).

FloorSum = 49

(1 ms) yes
| ?- 

Notes

The process here is, co-incidentally, much the same as the first part above. We recurse over the list and use a maplist/3 to build an incremental sum at each step.

References

Challenge 243

posted at: 17:33 by: Adam Russell | path: /prolog | permanent link to this entry

2023-11-11

The Weekly Challenge 242 (Prolog Solutions)

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

Part 1

You are given two arrays of integers. Write a script to find out the missing members in each other arrays.

Solution


missing(L, E, Member):-
    (member(E, L), Member = nil);
    (\+ member(E, L), Member = E).
missing_members([List1, List2], [Missing1, Missing2]):-
    maplist(missing(List2), List1, Missing1Nil),
    delete(Missing1Nil, nil, Missing1),
    maplist(missing(List1), List2, Missing2Nil),
    delete(Missing2Nil, nil, Missing2). 

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- missing_members([[1, 2, 3], [2, 4, 6]] ,Missing).

Missing = [[1,3],[4,6]] ? 

yes
| ?- missing_members([[1, 2, 3, 3], [1, 1, 2, 2]] ,Missing).

Missing = [[3,3],[]] ? 

yes
| ?- missing_members([[1, 2, 3, 3], [1, 1, 2, 2]], Missing), maplist(sort, Missing, MissingNoDuplicates). 

Missing = [[3,3],[]]
MissingNoDuplicates = [[3],[]] ? 

yes
| ?- 

Notes

missing/3 is used in a maplist/3 to determine which elements are missing from an array. If they are not missing a nil is set for it. By deleting the nil elements all that remain are the ones that are missing. This solution doesn't itself remove duplicate missing elements that are identified. That said, as you can see in the example above that can be added, say, using sort/2.

Part 2

You are given n x n binary matrix. Write a script to flip the given matrix as below.

Solution


flip(B, F):-
    F is \ B /\ 1.
flip_matrix([], []).    
flip_matrix([Row|Matrix], [RowFlipped|MatrixFlipped]):-
    reverse(Row, RowReversed),
    maplist(flip, RowReversed, RowFlipped),
    flip_matrix(Matrix, MatrixFlipped).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- flip_matrix([[1, 1, 0], [1, 0, 1], [0, 0, 0]], FlippedMatrix).

FlippedMatrix = [[1,0,0],[0,1,0],[1,1,1]]

yes
| ?- flip_matrix([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]], FlippedMatrix).

FlippedMatrix = [[1,1,0,0],[0,1,1,0],[0,0,0,1],[1,0,1,0]]

yes
| ?- 

Notes

For the given matrix we need only recursively consider each row, reverse it, do the necessary bit flips, and then assemble the newly flipped rows into the completed Flipped Matrix.

References

Challenge 242

posted at: 21:44 by: Adam Russell | path: /prolog | permanent link to this entry

2023-11-05

The Weekly Challenge 241 (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 (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the given rules.

Solution


arithmetic_triplets(Numbers, Difference, TripletCount):-
    length(Triplet, 3),  
    member(I, Triplet),      
    member(J, Triplet),      
    member(K, Triplet),      
    fd_domain(Triplet, Numbers),  
    fd_all_different(Triplet), 
    Difference #= J - I,
    Difference #= K - J,  
    I #< J,
    J #< K,
    findall(Triplet, fd_labeling(Triplet), Triplets),
    length(Triplets, TripletCount).  

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- arithmetic_triplets([0, 1, 4, 6, 7, 10], 3, TripletCount).

TripletCount = 2 ? 

yes
| ?- arithmetic_triplets([4, 5, 6, 7, 8, 9], 2, TripletCount). 

TripletCount = 2 ? 

yes
| ?- 

Notes

The rules for arithmetic triples are a) i < j < k b) nums[j] - nums[i] == diff and c) nums[k] - nums[j] == diff, where diff is a provided parameter. The code above implements these rules directly, letting Prolog do all the work for us!

Part 2

You are given an array of unique positive integers greater than 2. Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

Solution


prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

kvf_insert_sort(List,Sorted):-
    i_sort(List,[],Sorted).

i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
    kvf_insert(H,Acc,NAcc),
    i_sort(T,NAcc,Sorted).

kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 > V1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 = V1,
    K0 > K1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 = V1,
    K0 < K1.    
kvf_insert(K0-V0, [], [K0-V0]).

write_factor_sorted([K-_|[]]):-
    write(K),
    nl.
write_factor_sorted([K-_|T]):-
    write(K),
    write(', '),
    write_factor_sorted(T).

factor_counter(Number, Number-FactorCount):-
    prime_factors(Number, Factors),
    length(Factors, FactorCount).

factor_sorter(Numbers, FactorsSorted):-
    maplist(factor_counter, Numbers, Factors),
    kvf_insert_sort(Factors, FactorsSorted).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- factor_sorter([11, 8, 27, 4], FactorsSorted), write_factor_sorted(FactorsSorted).
11, 4, 8, 27

FactorsSorted = [11-1,4-2,8-3,27-3] ? 

yes
| ?- 

Notes

This code is build mainly from pieces from previous challenges. The prime factorization code is something I've used several times and the modified Insertion Sort is a minor modification of code from TWC 233.

References

Challenge 241

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

2023-10-29

The Weekly Challenge 240 (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 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

posted at: 16:41 by: Adam Russell | path: /prolog | permanent link to this entry

2023-10-23

The Weekly Challenge 239 (Prolog Solutions)

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

Part 1

You are given two arrays of strings. Write a script to find out if the word created by concatenating the array elements is the same.

Solution


concatenate_all([], '').
concatenate_all([H|T], Concatenated):-
    concatenate_all(T, C),
    atom_concat(H, C, Concatenated).

same_string(L0, L1):-
    concatenate_all(L0, C0),
    concatenate_all(L1, C1),
    C0 == C1. 

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- same_string([ab, c], [a, bc]).

yes
| ?- same_string([ab, c], [ac, b]). 

no
| ?- same_string([ab, cd, e], [abcde]).

yes
| ?- 

Notes

The problem is given as strings, which I interpret here as meaning atoms, in which case we need to concatenate all the atoms together and then check to see if they are equal.

If, instead, I had strictly used strings (arrays of character codes) then there would be no need to actually concatenate anything. In that case we could just flatten the lists and then check to see if the lists were the same.

Part 2

You are given an array of strings and allowed string having distinct characters. A string is consistent if all characters in the string appear in the string allowed. Write a script to return the number of consistent strings in the given array.

Solution


consistent(Allowed, String, Consistent):-
    subtract(String, Allowed, Subtracted),
    length(Subtracted, SubtractedLength),
    ((SubtractedLength == 0, Consistent = 1);
     (SubtractedLength == 1, Consistent = 0)).

consistent_strings(Strings, Allowed, ConsistentStringsCount):-
    maplist(consistent(Allowed), Strings, ConsistentStrings),
    sum_list(ConsistentStrings, ConsistentStringsCount).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- consistent_strings(["ad", "bd", "aaab", "baa", "badab"], "ab", ConsistentStrings).

ConsistentStrings = 2 ? 

(1 ms) yes
| ?- consistent_strings(["a", "b", "c", "ab", "ac", "bc", "abc"], "abc", ConsistentStrings).

ConsistentStrings = 7 ? 

yes
| ?- consistent_strings(["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad", ConsistentStrings).

ConsistentStrings = 4 ? 

yes
| ?- 

Notes

Here I count up all the consistent strings by using a maplist/3 to create a list of 0s and 1s. 0 if the string is not consistent, 1 if it is consistent. The check for if a string is consistent is done in a helper predicate which works by removing all the allowed characters and then checking if all characters have been removed, which satisfies the criteria.

References

Challenge 239

posted at: 00:37 by: Adam Russell | path: /prolog | permanent link to this entry

2023-09-07

The Weekly Challenge 233 (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 words made up of alphabets only. Write a script to find the number of pairs of similar words. Two words are similar if they consist of the same characters.

Solution


similar(A, B, Similar):-
    atom_codes(A, ACodes),
    sort(ACodes, ASorted),
    atom_codes(B, BCodes),
    sort(BCodes, BSorted),
    (ASorted = BSorted, Similar = 1);
    Similar = 0.

count_similar_pairs([], 0).
count_similar_pairs([Word|Words], PairsSimilar):-
    count_similar_pairs(Words, P), 
    maplist(similar(Word), Words, Similar), !,
    sum_list(Similar, SimilarCount),
    PairsSimilar is P + SimilarCount.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- count_similar_pairs([aba, aabb, abcd, bac, aabc], PairsSimilar).

PairsSimilar = 2

yes
| ?- count_similar_pairs([aabb, ab, ba], PairsSimilar).              

PairsSimilar = 3

(1 ms) yes
| ?- count_similar_pairs([nba, cba, dba], PairsSimilar).             

PairsSimilar = 0

yes
| ?- 

Notes

Similarity of words is determined by doing a pairwise comparison of the unique character codes. I've gotten into the habit of counting things by using maplist with a predicate that provides a list of 0 and 1 elements. The count is done by summing the list. Here the counting is done in this way by similar/3. count_similar_pairs/2 recursively considers all pairs.

Part 2

You are given an array of integers. Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.

Solution


kvf_insert_sort(List,Sorted):-
    i_sort(List,[],Sorted).

i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
    kvf_insert(H,Acc,NAcc),
    i_sort(T,NAcc,Sorted).

kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 > V1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 = V1,
    K0 < K1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 = V1,
    K0 > K1.    
kvf_insert(K0-V0, [], [K0-V0]).

frequency_writer(_-0).
frequency_writer(K-F):-
    write(K),
    write(', '),
    succ(X, F),
    frequency_writer(K-X).

write_frequencies([K-F|[]]):-
    succ(X, F),
    frequency_writer(K-X),
    write(K),
    nl.
write_frequencies([H|T]):-
    frequency_writer(H),
    write_frequencies(T).

frequency_counter(Numbers, Number, Number-Count):-
    length(Numbers, StartCount),
    delete(Numbers, Number, NumberDeleted),
    length(NumberDeleted, EndCount),
    Count is StartCount - EndCount.

frequency_sorter(Numbers, FrequencySorted):-
    sort(Numbers, UniqueNumbers),
    maplist(frequency_counter(Numbers), UniqueNumbers, Frequencies),
    kvf_insert_sort(Frequencies, FrequencySorted).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- frequency_sorter([1, 1, 2, 2, 2, 3], Sorted), write_frequencies(Sorted).
3, 1, 1, 2, 2, 2

Sorted = [3-1,1-2,2-3] ? 

(1 ms) yes
| ?- frequency_sorter([2, 3, 1, 3, 2], Sorted), write_frequencies(Sorted).
1, 3, 3, 2, 2

Sorted = [1-1,3-2,2-2] ? 

(1 ms) yes
| ?- frequency_sorter([-1, 1, -6, 4, 5, -6, 1, 4, 1], Sorted), write_frequencies(Sorted).
5, -1, 4, 4, -6, -6, 1, 1, 1

Sorted = [5-1,-1-1,4-2,-6-2,1-3] ? 

(1 ms) yes
| ?- 

Notes

First off, we get a count of the frequencies of each number in the list, via a maplist with frequency_counter/3. After that is when we hit the real complexity of the problem. This problem requires a somewhat unique idea of sorting frequencies! The frequencies have been built as key-value pairs but an ordinary sort or key sort won't work here for these unique requirements. All the required unique sort logic is contained in the kvf_insert_sort/2 and related predicates. This is a modification of insertion sort found in Roman Barták's Guide to Prolog Programming.

With the list of frequencies sorted all that is left is to print the result as specified, which is the work of write_frequencies/1. Those somewhat lengthy looking predicates expand the key-value pairs from the sorted result and print them in the new order.

References

Sort Algorithms in Prolog

Challenge 233

posted at: 17:09 by: Adam Russell | path: /prolog | permanent link to this entry

2023-08-21

The Weekly Challenge 231 (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 distinct integers. Write a script to find all elements that is neither minimum nor maximum. Return -1 if you can’t.

Solution


not_min_max(Numbers, NotMinMax):-
    min_list(Numbers, Minimum),
    max_list(Numbers, Maximum),
    delete(Numbers, Minimum, NumbersNoMinimum),
    delete(NumbersNoMinimum, Maximum, NumbersNoMinimumNoMaximum),
    ((length(NumbersNoMinimumNoMaximum, 0), NotMinMax = -1), !;
     (NotMinMax = NumbersNoMinimumNoMaximum)).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- not_min_max([3, 2], NotMinMax).  

NotMinMax = -1

yes
| ?- not_min_max([3, 2, 1, 4], NotMinMax). 

NotMinMax = [3,2]

yes
| ?- not_min_max([1, 3, 2], NotMinMax).

NotMinMax = [2]

yes

Notes

This is about as straightforward a solution as you can get in Prolog. All the details can be handled by built in predicates. That is, finding the minimum and maximum values, removing those values from consideration are all done for us. The only complication comes fromt he stipulation that we should return -1 instead of the empty list. This isn't a very Prolog thing to do! These problems are not written with Prolog in mind, however, and we make it work easily enough anyway.

Part 2

You are given a list of passenger details in the form “9999999999A1122”, where 9 denotes the phone number, A the sex, 1 the age and 2 the seat number. Write a script to return the count of all senior citizens (age >= 60).

Solution


passenger_senior(Passenger, Senior):-
    length(AgeSeat, 4),
    length(Age, 2),
    atom_chars(Passenger, PassengerChars),
    suffix(AgeSeat, PassengerChars),
    prefix(Age, AgeSeat),
    number_chars(A, Age),
    ((A >= 60, Senior = 1); Senior = 0).

count_senior_citizens(Passengers, CountSeniorCitizens):-
    maplist(passenger_senior, Passengers, SeniorCitizens), !,
    sum_list(SeniorCitizens, CountSeniorCitizens).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- count_senior_citizens(['7868190130M7522', '5303914400F9211', '9273338290F4010'], Count).

Count = 2

(1 ms) yes
| ?- count_senior_citizens(['1313579440F2036', '2921522980M5644'], Count).   

Count = 0

yes
| ?-

Notes

Since the passenger details are given in strings with fixed width fields we can chop up and find what we need using lists. Since the information we seek (the age) is at the end of the passenger details we can work from the suffix. First we get the details as characters, then we get the final four characters. Of these final four the first two are the age.

This is all done by way of maplist/3. Only those passengers that meet the age criteria are given a value of one, the rest zero. The final count is taken via sum_list/2.

References

Challenge 231

posted at: 20:38 by: Adam Russell | path: /prolog | permanent link to this entry

2023-08-20

The Weekly Challenge 230 (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 positive integers. Write a script to separate the given array into single digits.

Solution


clone(X, [X]).

separate(Number, Digits):-
    number_chars(Number, Chars),
    maplist(clone, Chars, DigitChars),
    maplist(number_chars, Digits, DigitChars).

separate_digits(Numbers, Digits):-
    maplist(separate, Numbers, D),
    flatten(D, Digits).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- separate_digits([1, 34, 5, 6], Digits).

Digits = [1,3,4,5,6] ? 

yes

Notes

For a long time I really never embraced the full power of maplist. At present I can't seem to get enough! In this solution to TWC230.1 we use maplist to first create a singleton list for each digit character in each of the given numbers, we then use maplist to convert these singleton lists to single digit numbers as required.

Part 2

You are given an array of words made up of alphabetic characters and a prefix. Write a script to return the count of words that starts with the given prefix.

Solution


prefix_match(Prefix, Word, Match):-
    atom_chars(Prefix, PrefixChars),
    atom_chars(Word, WordChars),
    ((prefix(PrefixChars, WordChars), Match = 1);
     (\+ prefix(PrefixChars, WordChars), Match = 0)).

count_words(Prefix, Words, Count):-
    maplist(prefix_match(Prefix), Words, Matches),
    sum_list(Matches, Count).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- count_words(at, [pay, attention, practice, attend], Count).

Count = 2 ? 

yes
| ?- count_words(ja, [janet, julia, java, javascript], Count).  

Count = 3 ? 

(1 ms) yes
| ?- 

Notes

Another nice use of maplist, but a bit less gratuitous. In this solution to TWC230.2 we use maplist to generate a list of 0s or 1s, depending on whether a given word starts with the given prefix. The count of matching words is then the sum_list/2 of those results.

References

Challenge 230

posted at: 21:40 by: Adam Russell | path: /prolog | permanent link to this entry

2023-07-23

The Weekly Challenge 226 (Prolog Solutions)

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

Part 1

You are given a string and an array of indices of same length as string. Write a script to return the string after re-arranging the indices in the correct order.

Solution


letter_shuffle(Shuffled, Letter, Index):-
    nth(Index, Shuffled, Letter).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- length(L, 9), maplist(letter_shuffle(L), "lacelengh", [4, 3, 1, 6, 5, 9, 7, 8, 2]), atom_codes(A, L).

A = challenge
L = [99,104,97,108,108,101,110,103,101]

yes

Notes

Many Prologs, including GNU Prolog, treat double quoted strings as lists of the character codes representing each letter. So here maplist/3 is presented such a list as well as the given list of indices. We give a letter_shuffle/3 an empty list of the right length and all that is left is for nth/3 to assign the letters as needed.

Part 2

You are given an array of non-negative integers, @ints. Write a script to return the minimum number of operations to make every element equal zero.

Solution


subtract_minimum(Minimum, X, Y):-
    Y is X - Minimum.

zero_array(Numbers, Operations):-
    delete(Numbers, 0, NumbersNoZero),
    zero_array(NumbersNoZero, 0, Operations).
zero_array([], Operations, Operations).    
zero_array(Numbers, OperationsCounter, Operations):-
    delete(Numbers, 0, NumbersNoZero),
    min_list(NumbersNoZero, Minimum),
    maplist(subtract_minimum(Minimum), NumbersNoZero, NumbersSubtracted),
    succ(OperationsCounter, OperationsCounterNext), 
    delete(NumbersSubtracted, 0, NumbersSubtractedNoZero),
    zero_array(NumbersSubtractedNoZero, OperationsCounterNext, Operations).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- zero_array([1, 5, 0, 3, 5], Operations).

Operations = 3 ? 

yes
| ?- zero_array([0], Operations).

Operations = 0 ? 

yes
| ?- zero_array([2, 1, 4, 0, 3], Operations).

Operations = 4 ? 

yes
| ?- 

Notes

A convenient issue with this problem is that once a list entry is zero we can ignore it. Since we can ignore it we can delete/3 it and thereby reduce the list eventually to the empty list, the base of our recursion. Each time we recurse we find the minimum element, subtract it from all others, and increment the number of operations.

References

Challenge 226

posted at: 16:52 by: Adam Russell | path: /prolog | permanent link to this entry

2023-07-13

The Weekly Challenge 225 (Prolog Solutions)

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

Part 1

You are given a list of sentences. Write a script to find out the maximum number of words that appear in a single sentence.

Solution


check_and_read(32, [], _):-
    !.
check_and_read(46, [], _):-
    !. 
check_and_read(-1, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

sentence_atoms(Sentence, Atoms):-
    open_input_codes_stream(Sentence, Stream),
    read_data(Stream, Atoms).

max_sentence_length(Sentences, MaxLength):-
    maplist(sentence_atoms, Sentences, SentenceAtoms),
    maplist(length, SentenceAtoms, Lengths),
    max_list(Lengths, MaxLength).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- max_sentence_length(["Perl and Raku belong to the same family.", "I love Perl.", "The Perl and Raku Conference."], MaxLength).            

MaxLength = 8 ? 

yes
| ?- max_sentence_length(["The Weekly Challenge.", "Python is the most popular guest language.", "Team PWC has over 300 members."], MaxLength).

MaxLength = 7 ? 

yes
| ?- 

Notes

Since these are programming challenges which are designed with Perl in mind the inputs sometimes require a little manipulation to make them more Prolog friendly. In this case the sentence strings need to be turned into lists of atoms. This is done here by use of Stream processing!

I don't think I've had much occasion to use open_input_codes_stream/2 before. What this does is take the double quoted string, which is seen by Prolog as a list of character codes, and open this as a Stream. We can then process this in the same way as we'd process any other input stream, more typically a file. In fact, much of the code for processing this Stream is re-used from other such code.

The solution, then, is that max_sentence_length/2 will take a list of sentences, call senetence_atoms/2 via a maplist/3 to get a list of list of atoms, then again with a maplist/3 get the lengths of the atom lists, and then finally get the maximum sentence length (the result) from max_list/2.

Part 2

You are given an array of integers. Write a script to return left right sum difference array.

Solution


difference(X, Y, Z):-
    Z is abs(X - Y).

differences(_, 0, LeftAccum, RightAccum, LeftRightDifferences):-
    maplist(difference, LeftAccum, RightAccum, LeftRightDifferences).
differences(Numbers, Index, LeftAccum, RightAccum, LeftRightDifferences):-
    length(Numbers, L),
    Left is Index - 1,
    Right is L - Index,
    length(Prefix, Left),
    length(Suffix, Right),
    prefix(Prefix, Numbers),
    suffix(Suffix, Numbers),
    sum_list(Prefix, LeftSum),
    sum_list(Suffix, RightSum),
    succ(IndexNext, Index),
    differences(Numbers, IndexNext, [LeftSum|LeftAccum], [RightSum|RightAccum], LeftRightDifferences).

left_right_differences(Numbers, LeftRightDifferences):-
    length(Numbers, L),
    differences(Numbers, L, [], [], LeftRightDifferences).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- left_right_differences([10, 4, 8, 3], LeftRightDifferences).

LeftRightDifferences = [15,1,11,22] ? 

yes
| ?- left_right_differences([1], LeftRightDifferences). 

LeftRightDifferences = [0] ? 

yes
| ?- left_right_differences([1, 2, 3, 4, 5], LeftRightDifferences).

LeftRightDifferences = [14,11,6,1,10] ? 

(1 ms) yes
| ?- 

Notes

The problem statement may be a little confusing at first. What we are trying to do here is to get two lists the prefix sums and suffix sums, also called the left and right sums. We then pairwise take the absolute values of each element in these lists to get the final result. Recursively iterating over the list the prefix sums are the partial sums of the list elements to the left of the current element. The suffix sums are the partial sums of the list elements to the right of the current element.

Once the problem is understood the components of the solution start to come together:

  1. Iterate over the original list and build up the partial sums. prefix/2, suffix/2, and sum_list/2 are very helpful here!
  2. When we are done building the lists of partial sums take the pairwise differences. This could also be done iteratively, but more elegantly we can make use of maplist/4.
  3. Our use of maplist/4 uses the small utility predicate difference/3.

References

Challenge 225

posted at: 16:52 by: Adam Russell | path: /prolog | permanent link to this entry

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

2023-01-15

The Weekly Challenge 199 (Prolog Solutions)

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

Part 1

You are given a list of integers, @list. Write a script to find the total count of Good airs.

Solution


good_pair(Numbers, Pair):-
    length(Numbers, L),
    fd_domain(I, 1, L),
    fd_domain(J, 1, L),
    I #<# J,
    fd_labeling([I, J]), 
    fd_element(I, Numbers, Ith),  
    fd_element(J, Numbers, Jth), 
    Ith #= Jth,
    Pair = [I, J].   

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- good_pair([1, 2, 3, 1, 1, 3], Pair).

Pair = [1,4] ? a

Pair = [1,5]

Pair = [3,6]

Pair = [4,5]

no
| ?- good_pair([1, 2, 3], Pair).         

no
| ?- good_pair([1, 1, 1, 1], Pair).

Pair = [1,2] ? a

Pair = [1,3]

Pair = [1,4]

Pair = [2,3]

Pair = [2,4]

Pair = [3,4]

yes
| ?- 

Notes

I take a clpfd approach to this problem and the next. This allows a pretty concise solution. Here we get the length of the list of numbers, constrain the indices for the pair and then specify the additional conditions of a Good Pair.

Part 2

You are given an array of integers, @array and three integers $x,$y,$z. Write a script to find out total Good Triplets in the given array.

Solution


good_triplet(Numbers, X, Y, Z, Triplet):-
    length(Numbers, I),
    fd_domain(S, 1, I),
    fd_domain(T, 1, I),
    fd_domain(U, 1, I),
    S #<# T, T #<# U,   
    fd_labeling([S, T, U]),   
    fd_element(S, Numbers, Sth),  
    fd_element(T, Numbers, Tth),  
    fd_element(U, Numbers, Uth), 
    Ast is abs(Sth - Tth), Ast #=<# X,     
    Atu is abs(Tth - Uth), Atu #=<# Y,     
    Asu is abs(Sth - Uth), Asu #=<# Z, 
    Triplet = [Sth, Tth, Uth].   

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- good_triplet([3, 0, 1, 1, 9, 7], 7, 2, 3, Triplet).

Triplet = [3,0,1] ? a

Triplet = [3,0,1]

Triplet = [3,1,1]

Triplet = [0,1,1]

no
| ?- good_triplet([1, 1, 2, 2, 3], 0, 0, 1, Triplet).   

no
| ?-

Notes

Again for part 2 a clpfd solution ends up being fairly concise. In fact, the approach here is virtually identical to part 1. The differences are only that we are looking for a triple, not a pair, and slightly different criteria.

References

Challenge 199

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

2023-01-08

The Weekly Challenge 198 (Prolog Solutions)

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

Part 1

You are given a list of integers, @list. Write a script to find the total pairs in the sorted list where 2 consecutive elements has the max gap. If the list contains less then 2 elements then return 0.

Solution


largest_gap(Numbers, LargestGap):-
    largest_gap(Numbers, -1, LargestGap).  
largest_gap([], LargestGap, LargestGap).  
largest_gap([_|[]], LargestGap, LargestGap).  
largest_gap([A, B|Numbers], Gap, LargestGap):-
    G is B - A,
    (G > Gap, largest_gap([B|Numbers], G, LargestGap));
    largest_gap([B|Numbers], Gap, LargestGap).

gap_pairs(Numbers, GapPairs):-
    length(Numbers, L),
    L =< 2,
    GapPairs = 0.
gap_pairs(Numbers, GapPairs):-
    length(Numbers, L),
    L > 2, 
    largest_gap(Numbers, LargestGap),
    gap_pairs(Numbers, LargestGap, 0, GapPairs).
gap_pairs([], _, GapPairs, GapPairs).
gap_pairs([_|[]], _, GapPairs, GapPairs).
gap_pairs([A, B|Numbers], LargestGap, Pairs, GapPairs):-
    LargestGap #= B - A,
    succ(Pairs, P),
    gap_pairs([B|Numbers], LargestGap, P, GapPairs).
gap_pairs([A, B|Numbers], LargestGap, Pairs, GapPairs):-
    LargestGap #\= B - A,
    gap_pairs([B|Numbers], LargestGap, Pairs, GapPairs). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- gap_pairs([3], Pairs).

Pairs = 0 ? 

(1 ms) yes
| ?- gap_pairs([2, 5, 8, 1], Pairs).

Pairs = 2 ? 

yes
| ?- 

Notes

At first glance this code may look more complex than it really is. All we are doing is , first, computing the largest gap between any two adjacent numbers. Then, second, seeing which pairs have exactly this gap.

Part 2

You are given an integer $n > 0. Write a script to print the count of primes less than $n.

Solution


primes_under_n(N, NumberPrimes):-
    findall(Prime, (between(2, N, I), fd_prime(I), Prime = I), Primes),
    length(Primes, NumberPrimes).  

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- primes_under_n(10, Primes).

Primes = 4

yes
| ?- primes_under_n(15, Primes).

Primes = 6

yes
| ?- primes_under_n(1, Primes). 

Primes = 0

yes
| ?- primes_under_n(25, Primes).

Primes = 9

yes

Notes

This solution is short and sweet! No reason or the writeup to be longer than the code itself, right?

References

Challenge 198

posted at: 13:29 by: Adam Russell | path: /prolog | permanent link to this entry

2022-12-18

The Weekly Challenge 195 (Prolog Solutions)

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

Part 1

You are given a positive integer, $n > 0. Write a script to print the count of all special integers between 1 and $n.

Solution


code2digit(C, D):-
    number_codes(D, [C]).

special(N):-
    number_codes(N, NCodes),
    maplist(code2digit, NCodes, Digits),
    sort(Digits, DigitsSorted),
    length(Digits, NumberDigits),
    length(DigitsSorted, NumberDigits).

number_special(N, NumberSpecial):-
    findall(I, (between(1, N, I), special(I)), Specials),
    length(Specials, NumberSpecial). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- number_special(15, NumberSpecial).

NumberSpecial = 14

(1 ms) yes
| ?- number_special(35, NumberSpecial).

NumberSpecial = 32

(1 ms) yes
| ?- 

Notes

The definition of a special integer for this problem is an integer whose digits are unique. To determine this specialness we split the number into its digits using number_codes/2 and a maplist/3 which uses a small helper predicate to convert the codes back to the corresponding digit.

After getting set with identifying special integers all the is left is to count up all the ones found in the given range.

Part 2

You are given a list of numbers, @list. Write a script to find most frequent even numbers in the list. In case you get more than one even numbers then return the smallest even integer. For all other case, return -1.

Solution


even(N, Even):-
    (0 is mod(N, 2), Even = N);
    (Even = nil).

frequency(ListNumbers, N, Frequency):-
    delete(ListNumbers, N, ListDeleted),
    length(ListNumbers, L),
    length(ListDeleted, LD),
    Frequency is L - LD. 

most_frequent_even(ListNumbers, MostFrequentEven):-
    maplist(even, ListNumbers, EN),
    delete(EN, nil, EvenNumbers), 
    length(EvenNumbers, LengthEvens),
    LengthEvens > 0,
    maplist(frequency(ListNumbers), EvenNumbers, Frequencies),      
    msort(Frequencies, FS), 
    reverse(FS, FrequenciesSorted), 
    ((
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 \== F2,
         nth(N, Frequencies, F1),  
         nth(N, EvenNumbers, MostFrequentEven)  
     );
     (
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 == F2,
         findall(MFE, (member(FX, FrequenciesSorted), FX == F1, nth(N, Frequencies, FX), nth(N, EvenNumbers, MFE)), MostFrequentEvens),   
         sort(MostFrequentEvens, MostFrequentEvensSorted), 
         nth(1, MostFrequentEvensSorted, MostFrequentEven)
     ) 
    ), !.

most_frequent_even(_, MostFrequentEven):-
    MostFrequentEven = -1, !. 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- most_frequent_even([1, 1, 2, 6, 2], MostFrequentEven).

MostFrequentEven = 2

yes
| ?- most_frequent_even([1, 3, 5, 7], MostFrequentEven).   

MostFrequentEven = -1

yes
| ?- most_frequent_even([6, 4, 4, 6, 1], MostFrequentEven).

MostFrequentEven = 4

yes
| ?- 

Notes

The code here may look a bit more convoluted than it really is. Well my use of the disjunction in most_frequent/2 may only be against my own personal sense of aesthetics! Also, in balance the use of maplist/3 cleans things up a bit.

The main ideas here are:

  1. Remove all odd numbers and check to see if any numbers remain.

  2. Compute the frequency of each remaining even number.

  3. Sort and see if there is a tie for most frequent.

  4. If there is no tie in (3) then we're done in the first part of the disjunction. Otherwise, in the second part of the disjunction, find the smallest of the numbers tied for most frequent.

References

Challenge 195

posted at: 16:05 by: Adam Russell | path: /prolog | permanent link to this entry

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

2022-11-27

The Weekly Challenge 192 (Prolog Solutions)

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

Part 1

You are given a positive integer, $n. Write a script to find the binary flip.

Solution


bits(N, Bits):-
    bits(N, [], Bits).    
bits(0, Bits, Bits):-!.
bits(N, BitsAccum, Bits):-
    B is N /\ 1,
    N0 is N >> 1,
    bits(N0, [B|BitsAccum], Bits).

bits_reverse(B, RB):-
    Flipped is xor(B, 1),
    number_chars(Flipped, [RB]).

binary_flip(N, NBitsReversed):-
    bits(N, Bits), 
    maplist(bits_reverse, Bits, BitsReversed),
    number_chars(NBitsReversed, ['0','b'|BitsReversed]).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- binary_flip(5, BinaryFlip).

BinaryFlip = 2

yes
| ?- binary_flip(4, BinaryFlip).

BinaryFlip = 3

yes
| ?- binary_flip(6, BinaryFlip).

BinaryFlip = 1

yes

Notes

I learned a slightly obscure bit (no pun intended!) of information about Prolog's handling of binary numbers this week. If you prepend '0','b' to a list of characters, or the ascii code equivalents to a list of codes, representing binary digits then number_chars/2 (or number_codes/2) will automatically convert to decimal.

The solution to the whole problem is:

Part 2

You are given a list of integers greater than or equal to zero, @list. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print -1.

Solution


:-dynamic(moves/1).
moves(0).

equal_distribution(ListIntegers, _):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F \== C,
    fail.
equal_distribution(ListIntegers, ListEqualDistribution):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F == C,
    length(ListEqualDistribution, L),
    equal_distribution(ListIntegers, F, ListEqual),
    delete(ListEqual, F, ListEqualAverageDeleted),
    length(ListEqualAverageDeleted, ListEqualAverageDeletedLength),
    ((ListEqualAverageDeletedLength == 0,
      ListEqualDistribution = ListEqual);
    equal_distribution(ListEqual, ListEqualDistribution)), !.

distribute(Average, [X, Y], [S, T]):-
    X < Average,
    X < Y,
    S is X + 1,
    T is Y - 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    X > Average,
    X > Y,
    S is X - 1,
    T is Y + 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    ((X == Average; X == Y);
     (X < Average, X > Y)
    ),
    S = X,
    T = Y.    

equal_distribution([A, B|[]], Average, [X, Y|[]]):-
    maplist(distribute(Average),[[A, B]], [[X, Y]]).
equal_distribution(ListIntegers, Average, [X|T]):-
    append([A, B], RestIntegers, ListIntegers),
    maplist(distribute(Average),[[A, B]], [[X, Y]]),
    equal_distribution([Y|RestIntegers], Average, T).

main(ListIntegers, Moves):-
    retract(moves(_)),
    asserta(moves(0)),
    (equal_distribution(ListIntegers, _), moves(Moves), !);
    Moves = -1.

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- main([1, 0, 5], Moves).

Moves = 4

(1 ms) yes
| ?- main([0, 2, 0], Moves).

Moves = -1

yes
| ?- main([0, 3, 0], Moves).

Moves = 2

yes

Notes

The rules that must be followed are:

1) You can only move a value of '1' per move

2) You are only allowed to move a value of '1' to a direct neighbor/adjacent cell.

This code ended up being a little more complex than I had originally thought it would be. At the heart of the solution is what I consider a pretty nice application of maplist/3 to drive the distribution/3, which is the implementation of the given rules.

We need to track the number of moves taken, not just the final resulting list. Rather than track the moves using a variable passed to the various predicates handling the re-distribution it seemed a bit cleaner to me to instead not have so many variables and asserta/1 and retract/1 the updated number of moves.

I generally try and avoid the use of the disjunction (;)/2 with the exception of small cases where to use it would unnaturally increase the amount of code. In this problem there are several such small cases such as whether we set the number of Moves to -1 in the case of an impossible re-distribution or the condition for detecting that we are done re-distributing.

References

Challenge 192

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

2022-11-20

The Weekly Challenge 191 (Prolog Solutions)

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

Part 1

You are given an encoded string consisting of a sequence $s of numeric characters: 0..9. Write a script to find the all valid different decodings in sorted order.

Solution


twice_greater(X, Y, TwiceGreater):-
    X \== Y,
    TwiceY is 2 * Y,
    X >= TwiceY,
    TwiceGreater = -1.
twice_greater(X, Y, TwiceGreater):-
    TwiceY is 2 * Y,
    X < TwiceY,
    TwiceGreater = 1.

twice_largest(List):-
    max_list(List, Max),
    maplist(twice_greater(Max), List, TwiceGreater),
    delete(TwiceGreater, -1, TwiceGreaterOneDeleted), 
    length(TwiceGreaterOneDeleted, TwiceGreaterOneDeletedLength),
    TwiceGreaterOneDeletedLength == 1, !.

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- twice_largest([1, 2, 3, 4]).

no
| ?- twice_largest([1, 2, 0, 5]).

yes
| ?- twice_largest([2, 6, 3, 1]).

yes
| ?- twice_largest([4, 5, 2, 3]).

no

Notes

There are a few ways one could approach this problem. I thought this implementation was nice and concise, albeit unconventional. maplist/3 is used to generate a list with entries corresponding to whether or not the respective element, times two, in the original List was more or less than the List Max. If we find only one element fails this, the List Max itself, then twice_largest/1 is true.

Part 2

You are given an integer, 0 < $n <= 15. Write a script to find the number of orderings of numbers that form a cute list.

Solution


cute(_, _) --> [].
cute(N, CuteList) --> [X], {between(1, N, X), \+ member(X, CuteList), 
                            length(CuteList, CuteListLength),
                            succ(CuteListLength, I),
                            (0 is mod(X, I); 0 is mod(I, X)),
                            append(CuteList, [X], CuteListUpdated)}, 
                            cute(N, CuteListUpdated).

main:-
    N = 15, 
    findall(Cute, (length(Cute, N), phrase(cute(N, []), Cute)), C), 
    sort(C, CuteList), 
    length(CuteList, NumberCuteList),
    write(NumberCuteList), nl.         

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- main.
24679

Notes

This is a somewhat convoluted use of a DCG and, in turn, the DCG code itself might be a bit convoluted. Here the DCG will generate all lists which conform to the given rules. There ends up being some duplication which is natural given the condition. To remove the duplicates I sort/2 the results.

References

Challenge 191

posted at: 16:05 by: Adam Russell | path: /prolog | permanent link to this entry

2022-11-13

The Weekly Challenge 190 (Prolog Solutions)

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

Part 1

You are given a string with alphabetic characters only: A..Z and a..z. Write a script to find out if the usage of Capital is appropriate if it satisfies at least one of the rules.

Solution


all_small([]).
all_small([H|T]):-
    H >= 97,
    H =< 122,   
    all_small(T).

all_capitals([]).
all_capitals([H|T]):-
    H >= 65,
    H =< 90,   
    all_capitals(T).

capital_detection([]).
capital_detection([H|T]):-
    H >= 65,
    H =< 90,
    all_capitals(T).
capital_detection([H|T]):-
    H >= 65,
    H =< 90,
    all_small(T).    
capital_detection([H|T]):-
    H >= 97,
    H =< 122,
    all_small(T).    

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- capital_detection("Perl").

true ? 

yes
| ?- capital_detection("TPF"). 

true ? 

(1 ms) yes
| ?- capital_detection("PyThon").

no
| ?- capital_detection("raku").  

yes

Notes

The rules to be satisfied are:

1) Only first letter is capital and all others are small.

2) Every letter is small.

3) Every letter is capital.

While I know it is not everyone's favorite way of handling strings in Prolog, I prefer to stick with the codes representation of double quotes strings. Here the solution is pretty straightforward, with the code being in most ways a direct translation of the rules.

Part 2

You are given an encoded string consisting of a sequence $s of numeric characters: 0..9. Write a script to find the all valid different decodings in sorted order.

Solution


digits([1, 2]).

alphabet(1, 'A').
alphabet(2, 'B').
alphabet(3, 'C').
alphabet(4, 'D').
alphabet(5, 'E').
alphabet(6, 'F').
alphabet(7, 'G').
alphabet(8, 'H').
alphabet(9, 'I').
alphabet(10,'J').
alphabet(11, 'K').
alphabet(12, 'L').
alphabet(13, 'M').
alphabet(14, 'N').
alphabet(15, 'O').
alphabet(16, 'P').
alphabet(17, 'Q').
alphabet(18, 'R').
alphabet(19, 'S').
alphabet(20, 'T').
alphabet(21, 'U').
alphabet(22, 'V').
alphabet(23, 'W').
alphabet(24, 'X').
alphabet(25, 'Y').
alphabet(26, 'Z').

list_chunks(_, [], []).
list_chunks(List, [H|T], [PrefixNumber|RestNumbers]):-
    length(Prefix, H),
    prefix(Prefix, List),
    append(Prefix, Rest, List),
    number_codes(PrefixNumber, Prefix),
    list_chunks(Rest, T, RestNumbers).

sum(Digits, Length):-
    sum([], Digits, Length, 0).

sum(Digits, Digits, _, _). 
sum(Partial, Digits, Length, Sum):-   
    Sum < Length, 
    digits(L),
    member(X, L),
    S is Sum + X,
    sum([X | Partial], Digits, Length, S). 

decode(Encoded, Decoded):-
    number_codes(Encoded, EncodedCodes),
    length(EncodedCodes, EncodedLength),
    findall(Digits,(
        sum(Digits, EncodedLength), 
        sum_list(Digits, EncodedLength)), DigitList),
    findall(Chunks, (
        member(ChunkSizes, DigitList),
        list_chunks(EncodedCodes, ChunkSizes, Chunks)), ChunkList),
    findall(DecodedChunk,(
        member(C, ChunkList),
        maplist(alphabet, C, DecodedChunkChars),
        atom_chars(DecodedChunk, DecodedChunkChars)), Decoded).  

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- decode(11, Decoded).

Decoded = ['AA','K']

yes
| ?- decode(1115, Decoded).

Decoded = ['AAAE','KAE','AKE','AAO','KO']

(1 ms) yes
| ?- decode(127, Decoded). 

Decoded = ['ABG','LG']

yes

Notes

There is an element of this task which reminded me of a much older problem presented back in TWC 075. In brief, the question was how many ways could coins be used in combination to form a target sum. My solution used a mix of Prolog and Perl since Prolog is especially well suited for elegant solutions to these sorts of combinatorial problems.

I recognized that this week we have a similar problem in how we may separate the given encoded string into different possible chunks for decoding. Here we know that no chunk may have value greater than 26 and so we can only choose one or two digits at a time. How many ways we can make these one or two digit chunks is the exact same problem, somewhat in hiding, as in TWC 075!

For the Perl Solutions to this problem I re-used much of that older code mentioned above. Also, that Prolog code which was embedded in the Perl code was used as the basis for this pure Prolog solution.

decode/2 is the main predicate. We need to work across all possible splits of the list of the number and it's easiest to use findall/3 to cover the splitting of the number, the chunking, and the final decoding of all possible combinations.

References

Challenge 190

posted at: 21:12 by: Adam Russell | path: /prolog | permanent link to this entry

2022-11-06

The Weekly Challenge 189 (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 characters (a..z) and a target character. Write a script to find out the smallest character in the given array lexicographically greater than the target character.

Solution


greater_than_character(Target, C0, C1):-
    C0 > Target,
    C1 = C0.   
greater_than_character(Target, C0, C1):-
    \+ C0 > Target,
    C1 = nil.  

greater_character(Characters, Target, Greater):-
    maplist(greater_than_character(Target), Characters, GreaterCharacters),
    delete(GreaterCharacters, nil, GreaterCharactersNonNil),
    length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
    GreaterCharactersNonNilLength > 0,
    min_list(GreaterCharactersNonNil, GreaterChar),
    char_code(Greater, GreaterChar), !.    
greater_character(Characters, [Target], Greater):-
    maplist(greater_than_character(Target), Characters, GreaterCharacters),
    delete(GreaterCharacters, nil, GreaterCharactersNonNil),
    length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
    GreaterCharactersNonNilLength == 0,
    char_code(Greater, Target), !.    

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- greater_character("emug", "b", LeastGreaterCharacter).

LeastGreaterCharacter = e

(1 ms) yes
| ?- greater_character("dcef", "a", LeastGreaterCharacter).

LeastGreaterCharacter = c

yes
| ?- greater_character("jar", "o", LeastGreaterCharacter). 

LeastGreaterCharacter = r

(1 ms) yes
| ?- greater_character("dcaf", "a", LeastGreaterCharacter).

LeastGreaterCharacter = c

(1 ms) yes
| ?- greater_character("tgal", "v", LeastGreaterCharacter).

LeastGreaterCharacter = v

yes

Notes

First off, I should note that the use of double quoted strings here might confuse some people. To clarify, in GNU Prolog what look like double quoted strings are handled as lists of character codes. Character codes, not characters! So the use of Character in some variable names may seem a little distracting. They are accurate in intent, but if you are unaware of what's going on it may seem a little strange.

For the solution itself I use a trick with maplist/3 that I have used previously. greater_than_character/3 will either return the character greater than the target or nil otherwise. min_list/2 is then used to get the smallest character which is greater than the target, as required. Also, note that in the case no character is found to be greater than the target we instead supply the target itself.

Part 2

You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.

Solution


array_degree(Array, Degree):-
    array_degree(Array, Array, 0, Degree), !.
array_degree([], _, Degree, Degree).    
array_degree([H|T], Array, DegreeAccum, Degree):-
    length(Array, ArrayLength),
    delete(Array, H, ArrayWithout),    
    length(ArrayWithout,ArrayWithoutLength),
    CurrentDegree is ArrayLength - ArrayWithoutLength,
    CurrentDegree > DegreeAccum,
    array_degree(T, Array, CurrentDegree, Degree).
array_degree([H|T], Array, DegreeAccum, Degree):-
    length(Array, ArrayLength),
    delete(Array, H, ArrayWithout),    
    length(ArrayWithout,ArrayWithoutLength),
    CurrentDegree is ArrayLength - ArrayWithoutLength,
    \+ CurrentDegree > DegreeAccum,
    array_degree(T, Array, DegreeAccum, Degree).    

least_slice_degree(Array, LeastDegreeSlice):-
    array_degree(Array, ArrayDegree),
    findall(Sublist, (prefix(Prefix, Array), suffix(Suffix, Array), 
                      sublist(Sublist, Array), length(Sublist, SublistLength), 
                      SublistLength >= 2, flatten([Prefix, Sublist, Suffix], Array)), Sublists),
    sort(Sublists, Slices),                  
    findall(DegreeSlice, (member(Slice, Slices), array_degree(Slice, Degree), DegreeSlice = Degree-Slice), DegreeSlices),
    findall(MatchingSlice, (member(DegreeSlice, DegreeSlices), ArrayDegree-MatchingSlice = DegreeSlice), MatchingSlices),
    findall(LengthSlice, (member(MatchingDegreeSlice, MatchingSlices), length(MatchingDegreeSlice, MatchingDegreeSliceLength), LengthSlice = MatchingDegreeSliceLength-MatchingDegreeSlice), LengthSlices),
    keysort(LengthSlices),
    [_-LeastDegreeSlice|_] = LengthSlices. 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- least_slice_degree([1, 3, 3, 2], LeastDegreeSlice).   

LeastDegreeSlice = [3,3]

(6 ms) yes
| ?- least_slice_degree([1, 2, 1, 3], LeastDegreeSlice). 

LeastDegreeSlice = [1,2,1]

(6 ms) yes
| ?- least_slice_degree([1, 3, 2, 1, 2], LeastDegreeSlice). 

LeastDegreeSlice = [2,1,2]

(19 ms) yes
| ?- least_slice_degree([1, 1, 2, 3, 2], LeastDegreeSlice). 

LeastDegreeSlice = [1,1]

(19 ms) yes
| ?- least_slice_degree([2, 1, 2, 1, 1], LeastDegreeSlice).       

LeastDegreeSlice = [1,2,1,1]

(20 ms) yes

Notes

This is the most I've used findall/3 in a long time! The main complexity here, I feel, is in that we must compute all contiguous slices of the original list. sublist/2 is not useful by itself here as it returns sublists which are not contiguous, only ordered. With the help of prefix/2 and suffix/2 we are able to identify contiguous sublists.

findall/3 is used, then, to obtain and then process all of these contiguous slices to ultimately identify the one that meets all criteria. First we identify all slices, then we obtain all degree/slice pairs, and then finally we examine the lengths.

References

Challenge 189

posted at: 20:57 by: Adam Russell | path: /prolog | permanent link to this entry

2022-10-30

The Weekly Challenge 188 (Prolog Solutions)

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

Part 1

You are given list of integers @list of size $n and divisor $k. Write a script to find out count of pairs in the given list that satisfies a set of rules.

Solution


divisible_pair(Numbers, K, Pair):-
    length(Numbers, NumbersLength),
    between(1, NumbersLength, I),
    succ(I, INext),
    between(INext, NumbersLength, J),
    nth(I, Numbers, Ith),
    nth(J, Numbers, Jth),
    IJModK is (Ith + Jth) mod K,
    IJModK == 0,
    Pair = [I, J].

divisible_pairs(Numbers, K, Pairs):-
    findall(Pair, divisible_pair(Numbers, K, Pair), Pairs).    

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- divisible_pairs([4, 5, 1, 6], 2, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[2,3]]

(1 ms) yes
| ?- divisible_pairs([1, 2, 3, 4], 2, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,3],[2,4]]

(1 ms) yes
| ?- divisible_pairs([1, 3, 4, 5], 3, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[3,4]]

yes
| ?- divisible_pairs([5, 1, 2, 3], 4, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[2,4]]

yes
| ?- divisible_pairs([7, 2, 4, 5], 4, Pairs), length(Pairs, NumberPairs).

NumberPairs = 1
Pairs = [[1,4]]

yes

Notes

The rules, if not clear from the above code are : the pair (i, j) is eligible if and only if

There really is not too much here beyond translating the rules into Prolog. The first condition on i and j are handled by default using between/3. Once we define how to find one such pair we use findall/3 to obtain them all.

Part 2

You are given two positive integers $x and $y. Write a script to find out the number of operations needed to make both ZERO.

Solution


count_zero(X, Y, Count):-
    count_zero(X, Y, 0, Count), !.
count_zero(0, 0, Count, Count).    
count_zero(X, Y, CountAccum, Count):-
    X > Y,
    XNew is X - Y,
    succ(CountAccum, CountAccumSucc), 
    count_zero(XNew, Y, CountAccumSucc, Count).
count_zero(X, Y, CountAccum, Count):-
    Y > X,
    YNew is Y - X,
    succ(CountAccum, CountAccumSucc), 
    count_zero(X, YNew, CountAccumSucc, Count).    
count_zero(X, Y, CountAccum, Count):-
    X == Y,
    XNew is X - Y,
    YNew is Y - X,
    succ(CountAccum, CountAccumSucc), 
    count_zero(XNew, YNew, CountAccumSucc, Count).   

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- count_zero(5, 4, Count).

Count = 5

(1 ms) yes
| ?- count_zero(4, 6, Count).

Count = 3

yes
| ?- count_zero(2, 5, Count).

Count = 4

yes
| ?- count_zero(3, 1, Count).

Count = 3

yes
| ?- count_zero(7, 4, Count).

Count = 5

yes

Notes

The operations are dictated by these rules:

or

Be carefully examining the rules we can see that we can arrange count_zero/4 predicates in a somewhat concise way. I find this preferable to Prolog's if/else syntax which absolutely could have been used here. I would argue that the slightly longer form here is worthwhile in that it is much more readable.

One thing I found especially convenient was that due to the immutable nature of Prolog variables we don;t have to do any extra accounting for the possibly changed value of X when computing an updated Y. The Perl solution to this requires a temporary variable, for example.

References

Challenge 188

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

2022-10-23

The Weekly Challenge 187 (Prolog Solutions)

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

Part 2

You are given a list of positive numbers, @n, having at least 3 numbers. Write a script to find the triplets (a, b, c) from the given list that satisfies a set of rules.

Solution


magical_triple_sum(Numbers, Triple, TripleSum):-
    sublist([A, B, C], Numbers),
    A + B > C,
    B + C > A,
    A + C > B,
    Triple = [A, B, C],
    sum_list(Triple, TripleSum).

magical_triple(Numbers, Triple):-
    fd_maximize(magical_triple_sum(Numbers, Triple, TripleSum), TripleSum). 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- magical_triple([4, 2, 3], Triple).

Triple = [4,2,3] ? 

(1 ms) yes
| ?- magical_triple([1, 3, 2], Triple). 

no
| ?- magical_triple([1, 1, 3, 2], Triple).

no
| ?- magical_triple([1, 2, 3, 2], Triple).

Triple = [2,3,2] ? 

yes

Notes

The "magical" rules, if not clear from the above code are:

I don't routinely do a lot of constraint programming, but I don't think a smaller solution for this can be written! Indeed, the code here is largely a rewriting of the given rules in slightly modified Prolog form.

References

Challenge 187

posted at: 17:25 by: Adam Russell | path: /prolog | permanent link to this entry

2022-10-16

The Weekly Challenge 186 (Prolog Solutions)

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

Part 1

You are given two lists of the same size. Write a predicate that merges the two lists.

Solution


zip([], [], []).
zip([Ha|Ta], [Hb|Tb], [Ha, Hb|Tc]):-
    zip(Ta, Tb, Tc).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- zip([1,2,3],[a,b,c],C).

C = [1,a,2,b,3,c]

Notes

This is a great simple example of recursion in Prolog. If there is any doubt about what is happening here is what trace/0 shows:


| ?- trace.
The debugger will first creep -- showing everything (trace)

yes
{trace}
| ?- zip([1,2,3],[a,b,c],C).
      1    1  Call: zip([1,2,3],[a,b,c],_38) ? 
      2    2  Call: zip([2,3],[b,c],_73) ? 
      3    3  Call: zip([3],[c],_102) ? 
      4    4  Call: zip([],[],_131) ? 
      4    4  Exit: zip([],[],[]) ? 
      3    3  Exit: zip([3],[c],[3,c]) ? 
      2    2  Exit: zip([2,3],[b,c],[2,b,3,c]) ? 
      1    1  Exit: zip([1,2,3],[a,b,c],[1,a,2,b,3,c]) ? 

Given that we know the lists are of the same size we have an extremely elegant solution. That is, we state that the first argument is an element, followed by the rest of the list, and the same goes for the second argument. For the third argument we state that its head is the combined initial two elements from the first and second lists and this unifies our uninstantiated variable.

References

Challenge 186

posted at: 20:00 by: Adam Russell | path: /prolog | permanent link to this entry

2022-09-04

The Weekly Challenge 180 (Prolog Solutions)

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

Part 1

You are given a string. Write a script to find out the first unique character in the given string and print its index (0-based).

Solution


index_first_unique(Words, IndexUnique):-
    index_first_unique(Words, 0, IndexUnique).
index_first_unique(String, I, IndexUnique):-
    succ(I, Index),
    length(String, Length),
    nth(Index, String, Character),
    delete(String, Character, Deleted),
    length(Deleted, LengthDeleted),
    LengthDifference is Length - LengthDeleted,
    LengthDifference == 1, !, 
    IndexUnique = I.
index_first_unique(String, I, IndexUnique):-
    succ(I, Index),
    length(String, Length),
    nth(Index, String, Character),
    delete(String, Character, Deleted),
    length(Deleted, LengthDeleted),
    LengthDifference is Length - LengthDeleted,
    \+ LengthDifference == 1,
    succ(I, X),
    index_first_unique(String, X, IndexUnique).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- index_first_unique("Long Live Perl", IndexUnique). 

IndexUnique = 1

yes
| ?- index_first_unique("Perl Weekly Challenge", IndexUnique).

IndexUnique = 0

yes
| ?- index_first_unique("aabbcc", IndexUnique).

no
| ?- index_first_unique("Prolog Solution to Perl Weekly Challenge", IndexUnique). 

IndexUnique = 7

yes

Notes

The main steps here are to check to see if after a character is deleted from the list if the new list length only varies from the original by 1. If so, then we are done. In the case the list is exhausted without finding a unique character the predicate simply fails.

Also note that GNU Prolog's nth/3 assumes 1 indexing and so to get the correct 0 based answer we do an extra succ/2.

Part 2

You are given list of numbers and an integer. Write a script to trim the given list when an element is less than or equal to the given integer.

Solution


trimmer(X, Y, Z):-
    X < Y,
    Z = Y.
trimmer(X, Y, Z):-
    X >= Y,
    Z = 'trimmed'.

trim_list(Numbers, I, TrimmedList):-
    maplist(trimmer(I), Numbers, PartialTrimmedList),
    delete(PartialTrimmedList, 'trimmed', TrimmedList).

Sample Run


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

TrimmedList = [4,5] ? 

yes
| ?- trim_list([9, 0, 6, 2, 3, 8, 5], 4, TrimmedList).

TrimmedList = [9,6,8,5] ? 

yes

Notes

maplist/3 is always tempting to use when required to process a list. In order to get the effect that we want, however, requires that the predicate used in the maplist succeed for each value of the list to be processed. Here trimmer/3 will either succeed with the numerical value that passes that comparison or succeed and provide the atom trimmed for values in the list that fail the comparison. The resulting list is then used with delete/3 to get the final list containing only the numerical values required.

References

Challenge 180

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

2022-08-14

The Weekly Challenge 177 (Prolog Solutions)

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

Part 1

You are given a positive number, $n. Write a script to validate the given number against the included check digit.

Solution


damm_matrix(0, [0, 7, 4, 1, 6, 3, 5, 8, 9, 2]).
damm_matrix(1, [3, 0, 2, 7, 1, 6, 8, 9, 4, 5]).
damm_matrix(2, [1, 9, 0, 5, 2, 7, 6, 4, 3, 8]).
damm_matrix(3, [7, 2, 6, 0, 3, 4, 9, 5, 8, 1]).
damm_matrix(4, [5, 1, 8, 9, 0, 2, 7, 3, 6, 4]).
damm_matrix(5, [9, 5 ,7, 8, 4, 0, 2, 6, 1, 3]).
damm_matrix(6, [8, 4, 1, 3, 5, 9, 0, 2, 7, 6]).
damm_matrix(7, [6, 8, 3, 4, 9, 5, 1, 0, 2, 7]).
damm_matrix(8, [4, 6, 5, 2, 7, 8, 3, 1, 0, 9]).
damm_matrix(9, [2, 3, 9, 6, 8, 1, 4, 7, 5, 0]).

damm_validate(N):-
    number_chars(N, NChars),
    damm_validate(NChars, 0).
damm_validate([], InterimDigit):-
    InterimDigit == 0.    
damm_validate([H|T], InterimDigit):-
    number_chars(N, [H]),
    damm_matrix(N, DammRow),
    succ(InterimDigit, I),
    nth(I, DammRow, NextInterimDigit),
    damm_validate(T, NextInterimDigit). 

Sample Run


| ?- damm_validate(5727).

(1 ms) no
| ?- damm_validate(5724).

yes

Notes

The beauty of Prolog is when it's implicit features such as backtracking and unification are exclusively leveraged to obtain a beautiful solution. This is not one of those cases! This is pure recursion, more functional than logical. I can't think of a more elegant way to express this Damm Validation process, however. Essentially we are performing a series of lookups from a table. I could see this being done with a DCG, perhaps. But in that case we wouldn't really be making anything more elegant, I would argue, just removing the explicit recursion while still having to do the same sort of lookups. It would probably end up being more code than this!

Anyway, Damm Validation is pretty succinctly expressed, it's just that the algorithm doesn't seem to really lend itself to being made much more logically implemented.

Part 2

Write a script to generate first 20 Palindromic Prime Cyclops Numbers.

Solution


cyclops(X):-
    number_chars(X, XChars),
    length(XChars, XCharsLength),
    XCharsLengthMinusOne is XCharsLength - 1,
    delete(XChars, '0', XCharsNoZero),
    length(XCharsNoZero, NoZeroLength),
    NoZeroLength == XCharsLengthMinusOne,
    append(Beginning, ['0'|End], XChars),
    length(Beginning, BeginningLength),
    length(End, EndLength),
    BeginningLength == EndLength.

palindrome(X):-
    number_codes(X, C),
    reverse(C, CR),
    number_codes(X, CR).

palindrome_prime(Prime):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(100, MAX_INTEGER, Prime),
    palindrome(Prime),
    fd_prime(Prime).

palindromic_prime_cyclops(_) --> [].
palindromic_prime_cyclops(Seen) --> [X], {palindrome_prime(X), cyclops(X), \+ member(X, Seen)}, palindromic_prime_cyclops([X|Seen]).

main:-
    length(PalindromicPrimeCyclops, 5),
    phrase(palindromic_prime_cyclops([]), PalindromicPrimeCyclops),
    write(PalindromicPrimeCyclops), nl.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
| ?- length(PalindromicPrimeCyclops, 20), phrase(palindromic_prime_cyclops([]), PalindromicPrimeCyclops).

PalindromicPrimeCyclops = [101,16061,31013,35053,38083,73037,74047,91019,94049,1120211,1150511,1160611,1180811,1190911,1250521,1280821,1360631,1390931,1490941,1520251] ? 

Notes

This borrows a quite a bit of code from previous challenges! Probably the newest thing here is the checking of the cyclops condition. In cyclops/1 we first check to see if there is a single zero. This is done by removing all zeroes with delete/3 and then confirming, by checking lengths, that only one was removed. After that we split the list around the '0' using append/3 and if the sublists before and after the '0' are of the same size we know we have a cyclops number. Notice that it only matters that they are equal. Whether they are of even length or odd length doesn't matter since we know we have just a single '0' and so the length of the entire list is necessarily of odd length, as required.

References

Challenge 177

posted at: 17:37 by: Adam Russell | path: /prolog | permanent link to this entry

2022-08-07

The Weekly Challenge 176 (Prolog Solutions)

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

Part 1

Write a script to find the smallest integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

Solution


permuted(X, Y):-
    number_chars(X, XChars),
    number_chars(Y, YChars),
    msort(XChars, XCharsSorted),
    msort(YChars, YCharsSorted),
    XCharsSorted == YCharsSorted.

permuted_multiple(Permuted):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, X),
    X2 is 2 * X,
    X3 is 3 * X,
    X4 is 4 * X,
    X5 is 5 * X,
    X6 is 6 * X,
    permuted(X, X2), permuted(X2, X3), 
    permuted(X3, X4), permuted(X4, X5), permuted(X5, X6),
    Permuted = X.

Sample Run


| ?- permuted_multiple(Permuted).

Permuted = 142857 ? 

(2150 ms) yes

Notes

I implemented solutions for this problem in multiple languages and compared side by side on the same system this Prolog solution ran the fastest. I think that's because in Prolog the logic can be (naturally!) expressed very succinctly and so the underlying instructions getting executed are most efficient. Other implementations seem to require a bit more overhead, such as when deconstructing an integer into a list of digits for example.

The task here is for us to generate the smallest integer with this permutable property. Technically the code here will generate all such numbers, however in search of other solutions it seems there is just the one found before we exceed the bounds of MAX_INTEGER.

Part 2

Write a script to find out all Reversible Numbers below 100.

Solution


all_odd([]).
all_odd([H|T]):-
    number_chars(Digit, [H]),
    M is mod(Digit, 2),
    M == 1,
    all_odd(T).

reversible(X):-
    number_chars(X, XChars),
    reverse(XChars, XCharsReversed),
    number_chars(R, XCharsReversed),
    Sum is X + R, 
    number_chars(Sum, SumChars),
    all_odd(SumChars).

reversible_under_n(N, Reversible):-
    between(1, N, X),
    reversible(X),
    Reversible = X.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
| ?- reversible_under_n(100, Reversibles).

Reversibles = 10 ? a

Reversibles = 12

Reversibles = 14

Reversibles = 16

Reversibles = 18

Reversibles = 21

Reversibles = 23

Reversibles = 25

Reversibles = 27

Reversibles = 30

Reversibles = 32

Reversibles = 34

Reversibles = 36

Reversibles = 41

Reversibles = 43

Reversibles = 45

Reversibles = 50

Reversibles = 52

Reversibles = 54

Reversibles = 61

Reversibles = 63

Reversibles = 70

Reversibles = 72

Reversibles = 81

Reversibles = 90

(10 ms) no

Notes

Here we also use Prolog's ability to identify multiple solutions to generate all solutions less than 100, as required.

References

Challenge 176

posted at: 11:54 by: Adam Russell | path: /prolog | permanent link to this entry

2022-07-24

The Weekly Challenge 174 (Prolog Solutions)

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

Part 1

Write a script to generate the first 19 Disarium Numbers.

Solution


disariums(_) --> [].
disariums(Seen) --> [X], {disarium(X), \+ member(X, Seen)}, disariums([X|Seen]).

sum_power(Digits, Sum):-
    sum_power(Digits, 0, 0, Sum).
sum_power([], _, Sum, Sum).
sum_power([H|T], I, PartialSum, Sum):-   
    succ(I, N),
    number_chars(X, [H]),
    Partial is PartialSum + round(X ** N),
    sum_power(T, N, Partial, Sum).

disarium(X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(0, MAX_INTEGER, X),
    number_chars(X, Chars),
    sum_power(Chars, Sum),
    Sum == X.

n_disariums(N, Disariums):-
    length(Disariums, N), 
    phrase(disariums([]), Disariums). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- n_disariums(19, Diariums).

Diariums = [0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798] ? 

References

Challenge 174

Disarium Numbers

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

2022-07-03

The Weekly Challenge 171 (Prolog Solutions)

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

Part 1

Write a script to generate the first twenty Abundant Odd Numbers.

Solution


proper_divisors(X, Divisors):-
    Half is X // 2,
    findall(Divisor,(
        between(1, Half, Divisor),
        M is mod(X, Divisor),
        M == 0
    ), Divisors).

abundants_odd(_) --> [].
abundants_odd(Previous) --> [X], {abundant_odd(Previous, X)}, abundants_odd(X).

abundant_odd(Previous, X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(Previous, MAX_INTEGER, X),
    X > Previous,
    M is mod(X, 2),
    M == 1,
    proper_divisors(X, Divisors),
    sum_list(Divisors, DivisorsSum),
    DivisorsSum > X.

n_abundants(N, Abundants):-
    length(Abundants, N), 
    phrase(abundants_odd(-1), Abundants). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- n_abundants(20, Abundants).  

Abundants = [945,1575,2205,2835,3465,4095,4725,5355,5775,5985,6435,6615,6825,7245,7425,7875,8085,8415,8505,8925] ? 

Notes

The use of a DCG here seems appropriate as we are generating a sequence of numbers of a DCG will allow us to reason on such lists. The logic for inclusion in the sequence is a bit complex and so it further seems natural to break that into its own predicate.

Part 2

Create sub compose($f, $g) which takes in two parameters $f and $g as subroutine refs and returns subroutine ref i.e. compose($f, $g)->($x) = $f->($g->($x)).

Solution


f(S, T):-
    T is S + S.

g(S, T):-
    T is S * S.

compose(F, G, H):-
    asserta((h(X, Y) :- call(G, X, X0), call(F, X0, Y))),
    H = h.

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- compose(f, g, H), A =.. [H, 7, X], A.

A = h(7,98)
H = h
X = 98

yes
| ?- 

Notes

This challenge is posed as being Perl specific and while most any language is able to do more or less what is asked for, this is a bit of a strange thing to do in Prolog.

In general, Prolog would dicate the use of a meta-interpreter for this sort of thing, instead of this sort of Functional Programming practice. Sticking to the letter of the challenge I was able to cobble something together with asserta/1 and the univ operator (=..)/2.

An assumption made in my code is that we know ahead of time the number of arguments to predicates F and G and that we also know which variables are instantiated or not. Those assumptions greatly simplify things and we can compose the two predicates in this way. Without that assumption the code would explode in complexity as we would need to examine whether variables are instantiated or not and then make possibly incorrect new assumptions that they, in fact, should have been or not.

References

Challenge 171

A Couple of Meta-interpreters in Prolog

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

2022-06-19

The Weekly Challenge 169 (Prolog Solutions)

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

Part 1

Write a script to generate the first 20 Brilliant Numbers.

Solution


prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

brilliants(_) --> [].
brilliants(Seen) --> [X], {brilliant(X), \+ member(X, Seen)}, brilliants([X|Seen]).

brilliant(X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, X),
    prime_factors(X, Factors),
    length(Factors, 2),
    nth(1, Factors, First),
    nth(2, Factors, Second),
    number_chars(First, FirstChars),
    number_chars(Second, SecondChars),
    length(FirstChars, FirstCharsLength),
    length(SecondChars, SecondCharsLength),
    FirstCharsLength == SecondCharsLength.

n_brilliants(N, Brilliants):-
    length(Brilliants, N), 
    phrase(brilliants([]), Brilliants). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- n_brilliants(20, Brilliants).

Brilliants = [4,6,9,10,14,15,21,25,35,49,121,143,169,187,209,221,247,253,289,299] ? 

Notes

The use of a DCG here seems appropriate as we are generating a sequence of numbers of a DCG will allow us to reason on such lists. The logic for inclusion in the sequence is a bit complex and so it further seems natural to break that into its own predicate. That is not required, of course, but in terms of pure style it seems the DCG starts to look clunky or overstuffed when containing a lot of Prolog code in curly braces. Perhaps that is especially true here where we further need additional predicates for computing the prime factors.

Part 2

Write a script to generate the first 20 Achilles Numbers.

Solution


prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

powerful(N, X):-
    M is mod(N, X * X),
    M == 0.

imperfect(N):-
    Sqrt is round(sqrt(N)),
    S is Sqrt - 1,
    length(I, S),
    fd_domain(I, 2, Sqrt),
    fd_all_different(I),
    fd_labeling(I),!,
    maplist(imperfect(N), I).
imperfect(N, X):-
    D is log(N) / log(X),
    Check is abs(D - round(D)),
    \+ Check < 0.000001.

achilles(_) --> [].
achilles(Seen) --> [X], {current_prolog_flag(max_integer, MAX_INTEGER), 
                         between(2, MAX_INTEGER, X), \+ member(X, Seen), achilles(X)}, 
                   achilles([X|Seen]).

achilles(X):-
    prime_factors(X, Factors), 
    maplist(powerful(X), Factors),
    imperfect(X).

n_achilles(N, Achilles):-
    length(Achilles, N), 
    phrase(achilles([]), Achilles). 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- n_achilles(20, Achilles).

Achilles = [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152,1323,1352,1372,1568,1800] ? 

Notes

The approach here for the second task is similar to that of the first. Somewhat surprisingly while the conditions of this sequence are more complex the code itself is represented in a cleaner way. I attribute that to the use of maplist/2 which streamlines the checking of lists for the two criteria of Achilles numbers: that they are powerful but imperfect.

References

Challenge 169

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

2022-06-12

The Weekly Challenge 168 (Prolog Solutions)

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

Part 1

Calculate the first 13 Perrin Primes.

Solution


perrin_primes(A, B, C) --> {D is B + A, fd_not_prime(D)}, 
                           perrin_primes(B, C, D).
perrin_primes(A, B, C) --> {D is B + A, fd_prime(D), D \== C}, 
                           [D], perrin_primes(B, C, D).
perrin_primes(A, B, C) --> {D is B + A, fd_prime(D), D == C}, 
                           [], perrin_primes(B, C, D).                           
perrin_primes(_, _, _) --> [], !.

n_perrin_primes(N, PerrinPrimes):-
    length(PerrinPrimes, N), 
    phrase(perrin_primes(3, 0, 2), PerrinPrimes). 

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- n_perrin_primes(13, PerrinPrimes).

PerrinPrimes = [3,2,5,7,17,29,277,367,853,14197,43721,1442968193,792606555396977] ? 

Notes

This is a pretty cut and dry use of a DCG to generate this interesting mathematical sequence. A couple of things that stand out are (1) the condition that D \== C which is to remove the duplicate 5 which occurs naturally at the beginning of the sequence. Afterwards all of the terms strictly increase. Also, (2) although the first two terms are indeed 3, 2 it is a convention to sort these and present them as 2, 3 although I did not happen to do so here.

Part 2

You are given an integer greater than 1. Write a script to find the home prime of the given number.

Solution


prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

factor_concat(Factors, Atom):-
    factor_concat(Factors, '', Atom).
factor_concat([], Atom, Atom).
factor_concat([H|T], AtomAccum, Atom):-
    number_atom(H, A),
    atom_concat(AtomAccum, A, UpdatedAtomAccum),
    factor_concat(T, UpdatedAtomAccum, Atom).

home_prime(N, HomePrime):-
    prime_factors(N, Factors),
    factor_concat(Factors, A),
    number_atom(Number, A),
    fd_not_prime(Number),
    home_prime(Number, HomePrime).    
home_prime(N, HomePrime):-
    prime_factors(N, Factors),
    factor_concat(Factors, A),
    number_atom(Number, A),
    fd_prime(Number),
    HomePrime = Number. 

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- home_prime(16, HomePrime).

HomePrime = 31636373 ? 

(4 ms) yes
| ?- home_prime(54, HomePrime). 

HomePrime = 2333 ? 

(1 ms) yes
| ?- home_prime(108, HomePrime).

HomePrime = 23971 ? 

yes

Notes

Here we are asked to compute the Home Prime of any given number. The process for doing so is, given N to take the prime factors for N and concatenate them together. If the result is prime then we are done, that is the Home Prime of N, typically written HP(N). This is an easy process to repeat, and in many cases the computation is a very quick one. However, in some cases, the size of the interim numbers on the path to HP(N) grow extremely large and the computation bogs down. I have used the prime factorization code here in several other weekly challenges and it is quite performant but even this runs rather slowly as we are faced with extremely large numbers.

References

Challenge 168

Home Prime

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

2022-05-22

The Weekly Challenge 165 (Prolog Solutions)

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

Part 1

Plot lines and points in SVG format.

Solution


svg-->svg_begin, svg_body, svg_end.
svg_body-->[].
svg_body-->svg_line(_, _, _, _), svg_body.
svg_body-->svg_point(_, _), svg_body.
svg_begin-->['<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">'].
svg_point(X, Y)-->['<circle cx="', X,'" cy="', Y, '" r="1" />'].
svg_line(X1, Y1, X2, Y2)-->['<line x1="', X1, '" x2="', X2, '" y1="', Y1, '" y2="', Y2, '" style="stroke:#006600;" />'].
svg_end-->[''].

plot([], SVGAccum, SVG):-
    phrase(svg_begin, Begin),
    flatten([Begin|SVGAccum], SVG).
plot([H|T], SVGAccum, SVG):-
    length(H, 2),
    [X, Y] = H,
    phrase(svg_point(X, Y), Point),
    plot(T, [Point|SVGAccum], SVG).
plot([H|T], SVGAccum, SVG):-
    length(H, 4),
    [X1, Y1, X2, Y2] = H,
    phrase(svg_line(X1, Y1, X2, Y2), Line),
    plot(T, [Line|SVGAccum], SVG).
plot(Lines, SVG):-
    phrase(svg_end, End),
    plot(Lines, [End], SVG).

main:-
     plot([[53,10], [53, 10, 23, 30], [23, 30]], SVG),
     maplist(write, SVG), nl,
     halt.

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"><circle cx="23" cy="30" r="1" /><line x1="53" x2="23" y1="10" y2="30" /><circle cx="53" cy="10" r="1" /></svg>

Notes

SVG is an XML based format, and so the use of a DCG like this may be unexpected. After all, the "grammar" is really dictated by a known XML schema. Still, the DCG is helpful in that we can describe the sequence and formatting of the statements we expect. From this we can generate the required SVG and even do some basic validation.

Part 2

Given a list of numbers, generate the skip summations.

Solution


avg_difference(Avg, V, Difference):-
    Difference is V - Avg.

square(X, XSquared):-
    XSquared is X * X.

xy(X, Y, XY):-
    XY is X * Y.

linear_regression(Points, RegressionLineEndpoints):-
    length(Points, NumberPoints),
    % 1. Calculate average of your X variable.
    maplist(nth(1), Points, Xs),
    msort(Xs, XSorted),
    nth(NumberPoints, XSorted, XMax),
    sum_list(Xs, XSum),
    XAvg is XSum / NumberPoints,
    % 2. Calculate the difference between each X and the average X.
    maplist(avg_difference(XAvg), Xs, XDifferences),
    % 3. Square the differences and add it all up. This is Sx.
    maplist(square, XDifferences, XDifferencesSquared),
    sum_list(XDifferencesSquared, Sx), 
    % 4. Calculate average of your Y variable.
    maplist(nth(2), Points, Ys),
    sum_list(Ys, YSum),
    YAvg is YSum / NumberPoints,
    % 5. Multiply the differences (of X and Y from their respective averages) and add them all together.  This is Sxy.
    maplist(avg_difference(YAvg), Ys, YDifferences),
    maplist(xy, XDifferences, YDifferences, XY),
    sum_list(XY, Sxy),
    % 6. Using Sx and Sxy, you calculate the intercept by subtracting Sx / Sxy * AVG(X) from AVG(Y).
    M is Sxy / Sx,
    B is YAvg - (Sxy / Sx * XAvg),
    EndX is XMax + 10,
    EndY is M * EndX + B,
    RegressionLineEndpoints = [0, B, EndX, EndY].

main:-
     Points = [[333,129], [39, 189], [140, 156], [292, 134], [393, 52], [160, 166], [362, 122], [13, 193], [341, 104], [320, 113], [109, 177], [203, 152], [343, 100], [225, 110], [23, 186], [282, 102], [284, 98], [205, 133], [297, 114], [292, 126], [339, 112], [327, 79], [253, 136], [61, 169], [128, 176], [346, 72], [316, 103], [124, 162], [65, 181], [159, 137], [212, 116], [337, 86], [215, 136], [153, 137], [390, 104], [100, 180], [76, 188], [77, 181], [69, 195], [92, 186], [275, 96], [250, 147], [34, 174], [213, 134], [186, 129], [189, 154], [361, 82], [363, 89]],
     linear_regression(Points, RegressionLine),
     write(RegressionLine), nl.

Sample Run


$ gprolog --consult-file prolog/ch-1.p --consult-file prolog/ch-2.p
| ?- Points = [[333,129], [39, 189], [140, 156], [292, 134], [393, 52], [160, 166], [362, 122], [13, 193], [341, 104], [320, 113], [109, 177], [203, 152], [343, 100], [225, 110], [23, 186], [282, 102], [284, 98], [205, 133], [297, 114], [292, 126], [339, 112], [327, 79], [253, 136], [61, 169], [128, 176], [346, 72], [316, 103], [124, 162], [65, 181], [159, 137], [212, 116], [337, 86], [215, 136], [153, 137], [390, 104], [100, 180], [76, 188], [77, 181], [69, 195], [92, 186], [275, 96], [250, 147], [34, 174], [213, 134], [186, 129], [189, 154], [361, 82], [363, 89]],
     linear_regression(Points, RegressionLine), append(Points, [RegressionLine], PointsLine), plot(PointsLine, SVG), maplist(write, SVG), nl. 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"><line x1="0" x2="403" y1="200.13227253558171" y2="79.249802930305563" style="stroke:#006600;" /><circle cx="363" cy="89" r="1" /><circle cx="361" cy="82" r="1" /><circle cx="189" cy="154" r="1" /><circle cx="186" cy="129" r="1" /><circle cx="213" cy="134" r="1" /><circle cx="34" cy="174" r="1" /><circle cx="250" cy="147" r="1" /><circle cx="275" cy="96" r="1" /><circle cx="92" cy="186" r="1" /><circle cx="69" cy="195" r="1" /><circle cx="77" cy="181" r="1" /><circle cx="76" cy="188" r="1" /><circle cx="100" cy="180" r="1" /><circle cx="390" cy="104" r="1" /><circle cx="153" cy="137" r="1" /><circle cx="215" cy="136" r="1" /><circle cx="337" cy="86" r="1" /><circle cx="212" cy="116" r="1" /><circle cx="159" cy="137" r="1" /><circle cx="65" cy="181" r="1" /><circle cx="124" cy="162" r="1" /><circle cx="316" cy="103" r="1" /><circle cx="346" cy="72" r="1" /><circle cx="128" cy="176" r="1" /><circle cx="61" cy="169" r="1" /><circle cx="253" cy="136" r="1" /><circle cx="327" cy="79" r="1" /><circle cx="339" cy="112" r="1" /><circle cx="292" cy="126" r="1" /><circle cx="297" cy="114" r="1" /><circle cx="205" cy="133" r="1" /><circle cx="284" cy="98" r="1" /><circle cx="282" cy="102" r="1" /><circle cx="23" cy="186" r="1" /><circle cx="225" cy="110" r="1" /><circle cx="343" cy="100" r="1" /><circle cx="203" cy="152" r="1" /><circle cx="109" cy="177" r="1" /><circle cx="320" cy="113" r="1" /><circle cx="341" cy="104" r="1" /><circle cx="13" cy="193" r="1" /><circle cx="362" cy="122" r="1" /><circle cx="160" cy="166" r="1" /><circle cx="393" cy="52" r="1" /><circle cx="292" cy="134" r="1" /><circle cx="140" cy="156" r="1" /><circle cx="39" cy="189" r="1" /><circle cx="333" cy="129" r="1" /></svg>

Notes

This is mainly an implementation of the same linear regression procedure as used in the Perl solution to the same problem. By consulting the solution to the first problem we can then re-use the same plotting code.

References

Challenge 165

Linear Regression Calculation

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

2022-05-15

The Weekly Challenge 164 (Prolog Solutions)

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

Part 1

Write a script to find all prime numbers less than 1000, which are also palindromes in base 10.

Solution


:-initialization(main).

palindrome(X):-
    fd_labeling(X),
    number_codes(X, C),
    reverse(C, CR),
    number_codes(X, CR).

palindrome_primes(N, PalindromePrimes, NumberPrimes):-
    fd_labeling(NumberPrimes),
    length(Primes, NumberPrimes),
    fd_domain(Primes, 1, N),
    fd_all_different(Primes),
    maplist(palindrome, Primes),
    maplist(fd_prime, Primes),
    fd_labeling(Primes),
    PalindromePrimes = Primes.

palindrome_primes(N, Primes):- 
    NP is N // 2,
    fd_domain(NumberPrimes, 1, NP),
    fd_maximize(palindrome_primes(N, Primes, NumberPrimes), NumberPrimes).

palindrome_prime(N, Prime):-
    between(1, N, Prime),
    palindrome(Prime),
    fd_prime(Prime).

pp(_, _) --> [].
pp(N, Seen) --> [X], {palindrome_prime(N, X), \+ member(X, Seen)}, pp(N, [X|Seen]).

main:-
    findall(Prime, palindrome_prime(1000, Prime), PalindromePrimes),
    write(PalindromePrimes), nl.

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
[2,3,5,7,11,101,131,151,181,191,313,353,373,383,727,757,787,797,919,929]
| ?- phrase(pp(1000, []), PalindromePrimes).

PalindromePrimes = [] ? ;

PalindromePrimes = [2] ? ;

PalindromePrimes = [2,3] ? ;

PalindromePrimes = [2,3,5] ? ;

PalindromePrimes = [2,3,5,7] ? ;

PalindromePrimes = [2,3,5,7,11] ? ;

PalindromePrimes = [2,3,5,7,11,101] ? ;

PalindromePrimes = [2,3,5,7,11,101,131] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181,191] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181,191,313] ? 
.
.
.

Notes

I experimented with a few different ways to generate Palindrome Primes. The quickest and most efficient way is what is used in main/0. Now, suppose we wanted to reason about lists of such numbers versus just generating them there is also a DCG option as shown which will generate or validate all possible lists of Palindrome Primes. Finally, there is the extremely inefficient method using constraints to maximize the size of the list of Palindrome Primes under 1000. This works! Now, does it work "well"? Absolutely not! This is not a very good method for performing the task and is many orders of magnitude slower than the other two. I will admit to an odd satisfaction to getting this unusual approach work, however.

Part 2

Given a list of numbers, generate the skip summations.

Solution


:-initialization(main).

pdi(0, Total, Total). 
pdi(N, Total_, Total):-
    N_ is N // 10,
    Total__ is Total_ + round(mod(N, 10) ** 2), 
    pdi(N_, Total__, Total).
pdi(N, Total):-
    pdi(N, 0, Total).

happy(1, _).
happy(N, Seen):-
    \+ member(N, Seen),
    pdi(N, Total),!,
    N_ is Total,
    happy(N_, [N|Seen]).
happy(N):-
    happy(N, []).

happy(_) --> [].
happy(Seen) --> [X], {between(1, 100, X), \+ member(X, Seen), happy(X)}, happy([X|Seen]).

main:-
    length(Happy, 8),
    phrase(happy([]), Happy),
    write(Happy), nl.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
[1,7,10,13,19,23,28,31]

Notes

As with the code in the first part I also implemented this as a DCG. Here a DCG is more practical since we are asked specifically to generate a list of the first 8 Happy Numbers. This is more of a "list reasoning" task than how the Palindrome Prime question was asked.

References

Challenge 164

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

2022-05-08

The Weekly Challenge 163 (Prolog Solutions)

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

Part 1

You are given a list of numbers. Write a script to calculate the sum of the bitwise & operator for all unique pairs.

Solution


and(N, X, And):-
    And is N /\ X.
sum_and([], 0).
sum_and([H|T], SumAnd):-
    sum_and(T, Sum),
    maplist(and(H), T, Ands),
    sum_list(Ands, AndSum),
    SumAnd is Sum + AndSum.

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- sum_and([1, 2, 3], SumAnd).

SumAnd = 3

yes
| ?- sum_and([2, 3, 4], SumAnd).   

SumAnd = 2

yes
| ?- sum_and([1, 2, 3], 99).    

no
| ?- sum_and([1, 2, 3], 3). 

yes

Notes

It is not too often you see the bitwise operators used in Prolog code! I am kind of a fan of the /\ operator, I mean, it even looks like an upper case 'A', right?

Other than the novelty of the bitwise and I found this task to be well suited for the use of maplist/3 for computing the pairwise and operations across the list of numbers. This is something of a "nested loop" in the sense that recursively the head of the list of numbers is removed and upon each recursive step the maplist is re-performed on the increasingly shorter list.

Part 2

Given a list of numbers, generate the skip summations.

Solution


skip_sum(Numbers, N, Sum):-
    append(Left, [N|_], Numbers),
    sum_list(Left, SumLeft),
    Sum is N + SumLeft.

skip_summations(Numbers, Summations):-
    skip_summations(Numbers, [Numbers], Summations).
skip_summations([], Summations, Summations).
skip_summations([_|T], SummationsAccum, Summations):-
    maplist(skip_sum(T), T, Sums),
    skip_summations(Sums, [Sums|SummationsAccum], Summations).

print_summation(S):-
    write(S),
    write(' ').
print_summations([]).
print_summations([H|T]):-
    print_summations(T),
    maplist(print_summation, H), nl.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
| ?- skip_summations([1, 2, 3, 4, 5], Summations), print_summations(Summations).
1 2 3 4 5 
2 5 9 14 
5 14 28 
14 42 
42 


Summations = [[],[42],[14,42],[5,14,28],[2,5,9,14],[1,2,3,4,5]] ? 

yes
| ?- skip_summations([1, 3, 5, 7, 9], Summations), print_summations(Summations).      
1 3 5 7 9 
3 8 15 24 
8 23 47 
23 70 
70 


Summations = [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,7,9]] ? 

yes
| ?- skip_summations([1, 3, 5, 7, 9], [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,27,9]]).

no
| ?- skip_summations([1, 3, 5, 7, 9], [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,7,9]]). 

true ? 

yes

Notes

Much like the task above we use a maplist/3 within a recursive step. Here the maplist/3 is used to do the partial sums for each "line" of the output. There is also a maplist/2 used to print the output lines with a space between each element.

Satisfyingly, as shown above, the same code not only generates the skip summations but also validates them as well. This sort of intrinsic Prolog behavior brings joy!

References

Challenge 163

posted at: 13:52 by: Adam Russell | path: /prolog | permanent link to this entry

2022-05-01

The Weekly Challenge 162 (Prolog Solutions)

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

Part 1

Write a script to generate the check digit of a given ISBN-13 code.

Solution


weight(-1, 1).
weight(1, 3).

check_sum([], _, 0).
check_sum([H|T], I, CheckSum):-
    N is I * -1,
    check_sum(T, N, C),
    weight(I, Weight),
    CheckSum is H * Weight + C.
isbn_check_digit(ISBN, CheckDigit):-
    check_sum(ISBN, -1, CheckSum),
    Check is mod(CheckSum, 10),
    CheckDigit is 10 - Check.

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], CheckDigit).

CheckDigit = 7

(1 ms) yes

$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], 3).    

(1 ms) no

$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], 7).         

yes

Notes

Sometimes when writing this sort of code I feel the urge to really unleash the power of Prolog and make the most general solution. What would that mean here though? Generate ISBNs for which a given check digit would be valid? While possible it seems like a kind of weird thing to do. Is it interesting to reason about ISBNs in this way? I seem to think that is unlikely.

This code does what seems to reasonable: generate a check digit given an ISBN, or, given both an ISBN and a check digit confirm that the given check digit is the correct one.

References

Challenge 162

posted at: 14:34 by: Adam Russell | path: /prolog | permanent link to this entry

2022-04-24

The Weekly Challenge 161 (Prolog Solutions)

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

Part 1

Output or return a list of all abecedarian words in the dictionary, sorted in decreasing order of length.

Solution


check_and_read(10, [] ,_):-
    !.
check_and_read(13, [], _):-
    !.
check_and_read(32, [], _):-
    !.
check_and_read(44, [], _):-
    !.
check_and_read(end_of_file, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

abecedarian(Words, Abecedarian):-
    member(Word, Words),
    atom_chars(Word, Chars),
    sort(Chars, SortedChars),
    atom_chars(W, SortedChars),
    W = Word,
    Abecedarian = Word.

word_length(Word, LengthWord):-
    atom_chars(Word, Chars),
    length(Chars, Length),
    LengthWord = Length-Word. 

abecedarians(Words, Abecedarians):-
    findall(Abecedarian, abecedarian(Words, Abecedarian), A),
    maplist(word_length, A, AL), 
    keysort(AL, ALSorted),
    reverse(ALSorted, Abecedarians).

main:-
    open('dictionary', read, Stream),
    read_data(Stream, Dictionary),
    close(Stream),
    abecedarians(Dictionary, Abecedarians),
    write(Abecedarians), nl, 
    halt.

Sample Run


$ gprolog --consult-file prolog/ch-1.p --entry-goal main
[6-chintz,6-chimps,6-begins,6-almost,6-abhors,5-glory,5-ghost,5-forty,5-flops,5-first,5-filmy,5-films,5-empty,5-dirty,5-deity,5-chops,5-chips,5-chins,5-chimp,5-below,5-begin,5-befit,5-aglow,5-adopt,5-adept,5-abort,5-abhor,4-nosy,4-most,4-mops,4-lost,4-lops,4-know,4-knot,4-imps,4-host,4-hops,4-hips,4-hint,4-hims,4-hilt,4-gory,4-glow,4-gist,4-gins,4-gilt,4-foxy,4-fort,4-flux,4-flow,4-flop,4-fist,4-firs,4-fins,4-film,4-envy,4-elms,4-egos,4-dirt,4-dips,4-dins,4-dims,4-deny,4-dent,4-dens,4-defy,4-deft,4-crux,4-cost,4-copy,4-cops,4-clot,4-city,4-chow,4-chop,4-chip,4-chin,4-cent,4-blow,4-blot,4-bins,4-best,4-bent,4-belt,4-begs,4-amps,4-alms,4-airy,4-airs,4-aims,4-ails,4-ahoy,4-aces,4-ably,4-abet,3-pry,3-opt,3-now,3-not,3-nor,3-mow,3-mop,3-low,3-lot,3-lop,3-joy,3-jot,3-ivy,3-ins,3-imp,3-how,3-hot,3-hop,3-hit,3-his,3-hip,3-him,3-guy,3-got,3-gnu,3-gin,3-fry,3-fox,3-for,3-fly,3-flu,3-fix,3-fit,3-fir,3-fin,3-elm,3-ego,3-dry,3-dot,3-dos,3-dip,3-din,3-dim,3-dew,3-den,3-cry,3-coy,3-cox,3-cow,3-cot,3-cop,3-chi,3-buy,3-boy,3-box,3-bow,3-bop,3-bit,3-bin,3-bet,3-beg,3-art,3-apt,3-any,3-ant,3-amp,3-air,3-aim,3-ail,3-ago,3-ads,3-ado,3-act,3-ace,2-qt,2-ox,2-or,2-no,2-my,2-mu,2-ms,2-ix,2-iv,2-it,2-(is),2-in,2-ho,2-hi,2-go,2-em,2-eh,2-do,2-cs,2-by,2-be,2-ax,2-at,2-as,2-an,2-am,2-ah,2-ad,1-x,1-m,1-a]

Notes

Most of the code here is just for reading the provided dictionary of words. Once that is complete Prolog really shines. abecedarian/2 is the majority of the logic: if a word's characters when sorted and re-assembled are the original word then it is an Abecedarian.

abecedarians/2 is necessary only to fulfill the requirements of the problem specification which is that all Abecedarians be sorted by length and returned in descending order.

References

Challenge 161

posted at: 14:27 by: Adam Russell | path: /prolog | permanent link to this entry

2022-04-17

The Weekly Challenge 160 (Prolog Solutions)

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

Part 1

You are given a positive number, $n < 10. Write a script to generate english text sequence starting with the English cardinal representation of the given number, the word "is" and then the English cardinal representation of the count of characters that made up the first word, followed by a comma. Continue until you reach four.

Solution


cardinal(1, one).
cardinal(2, two).
cardinal(3, three).
cardinal(4, four).
cardinal(5, five).
cardinal(6, six).
cardinal(7, seven).
cardinal(8, eight).
cardinal(9, nine).
cardinal(10, ten).

four_is_magic(N) --> {between(1, 9, N), \+N == 4, 
                      cardinal(N, Cardinal), 
                      atom_codes(Cardinal, Codes), 
                      length(Codes, Count)}, 
                      [N-Count], four_is_magic(Count).
four_is_magic(N) -->  {between(1, 9, N), N == 4}, [N-magic].

print_magic([]):-
    nl.
print_magic([H|T]):-
    N-Count = H,
    \+ N == 4,
    cardinal(N, Cardinal),
    cardinal(Count, CountCardinal), 
    format("~a is ~a, ", [Cardinal, CountCardinal]), 
    print_magic(T).
print_magic([H|T]):-
    N-_ = H,
    N == 4,
    cardinal(N, Cardinal),
    format("~a is ~a", [Cardinal, magic]), 
    print_magic(T).

main(N) :-
    phrase(four_is_magic(N), FourIsMagic), 
    print_magic(FourIsMagic).    

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- main(6).
six is three, three is five, five is four, four is magic

true ? 

(1 ms) yes
| ?- main(_).
one is three, three is five, five is four, four is magic

true ? ;
two is three, three is five, five is four, four is magic

true ? ;
three is five, five is four, four is magic

true ? ;
five is four, four is magic

true ? ;
six is three, three is five, five is four, four is magic

true ? ;
seven is five, five is four, four is magic

true ? ;
eight is five, five is four, four is magic

true ? 

(1 ms) yes

Notes

Prolog has an interesting history of generating text. This is one of the more simple applications I will admit. Here I use a DCG to generate the sequence and then a recursive set of predicates to print the associated text.

In typical Prolog fashion, as shown in the sample output, we can not only generate a sequence with a specified starting point, but all such sequences.

Part 2

You are give an array of integers, @n. Write a script to find out the Equilibrium Index of the given array, if found.

Solution


equilibrium_index(Numbers, I):-
    member(N, Numbers),
    append(Left, [N|Right], Numbers),
    sum_list(Left, SumLeft),
    sum_list(Right, SumRight),
    SumLeft == SumRight,
    nth(I, Numbers, N).

main:-
    (equilibrium_index([1, 3, 5, 7, 9], I), format("~d~n", [I]); format("-1~n", _)),
    (equilibrium_index([1, 2, 3, 4, 5], J), format("~d~n", [J]); format("-1~n", _)),
    (equilibrium_index([2, 4, 2], K), format("~d~n", [K]); format("-1~n", _)), halt.   

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- main.
4
-1
2

Notes

This problem was very "Prolog shaped" in my opinion! Just from reading the problem statement I could picture the standard Prolog predicates that could be used here. Prolog is not a language which naturally lends itself to code golf contests but in terms of simple elegance this is quite a compact solution!

References

Challenge 160

posted at: 09:59 by: Adam Russell | path: /prolog | permanent link to this entry

2022-03-20

The Weekly Challenge 156 (Prolog Solutions)

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

Part 1

Write a script to generate the first 10 Pernicious Numbers.

Solution


pernicious(_) --> [].
pernicious(Seen) --> [X], x(Seen, X), {set_bits(X, Bits), fd_prime(Bits)}, pernicious([X|Seen]).
x(Seen, X) --> {between(1, 100, X), \+ member(X, Seen)}. 

set_bits(N, X):-
    set_bits(N, 0, X).
set_bits(0, X, X).
set_bits(N, X_Acc, X):-
    B is N /\ 1,
    X0 is X_Acc + B,
    N0 is N >> 1,
    set_bits(N0, X0, X), !.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- length(Pernicious, 10), phrase(pernicious([]), Pernicious).

Pernicious = [3,5,6,7,9,10,11,12,13,14] ? 

(115 ms) yes
| ?- phrase(pernicious([]), [3, 5, 6]).

true ? 

(95 ms) yes

Notes

DCGs are great aren't they? The ability to have two modes, one to test and the other to create is a joy! The logic here is pretty straightforward and more or less follows straight fromt he definition.

Part 2

Write a script to compute the first 10 distinct Padovan Primes.

Solution


weird(_) --> [].
weird(Seen) --> [X], x(Seen, X), {
    findall(F, factor(X, F), Factors), flatten([1, Factors], FlatFactors),
    sum_list(FlatFactors, FactorSum), 
    FactorSum > X, 
    powerset(FlatFactors, FactorSets),
    maplist(sum_list, FactorSets, FactorSetSums),
    \+ member(X, FactorSetSums)
    }, 
    weird([X|Seen]).
x(Seen, X) --> {between(1, 1000, X), \+ member(X, Seen)}. 

powerset(X,Y):- bagof(S, subseq(S,X), Y).
subseq([], []).
subseq([], [_|_]).
subseq([X|Xs], [X|Ys] ):- subseq(Xs, Ys).
subseq([X|Xs], [_|Ys] ):- append(_, [X|Zs], Ys), subseq(Xs, Zs).

factor(N, Factors):-
    S is round(sqrt(N)),
    fd_domain(X, 2, S),
    R #= N rem X,
    R #= 0,
    Q #= N // X,
    Q #\= X,
    fd_labeling([Q, X]),
    Factors = [Q, X].
factor(N, Factors):-
    S is round(sqrt(N)),
    fd_domain(X, 2, S),
    R #= N rem X,
    R #= 0,
    Q #= N // X,
    Q #= X,
    fd_labeling([Q]),
    Factors = [Q].   

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- phrase(weird([]), [70]).               

true ? 

yes
| ?- length(Weird, 1), phrase(weird([]), Weird).

Weird = [70] ? 

(4 ms) yes

Notes

This solution follows the same generate and test approach I used in the Perl Solution, as far as the testing of the powerset of divisors is concerned anyway. (I'll admit I was too lazy to write my own powerset code so I grabbed someone else's. See the references for a link to the source.)

In my ongoing attempts to improve my DCG skills I implemented this as a DCG which is a bit of overkill for this problem, but it is always nice to be able to generate the sequence as well as validate.

References

Challenge 156

Pernicious Number

Weird Number

Power Set

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

2022-03-06

The Weekly Challenge 154 (Prolog Solutions)

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

Part 1

Write a script to compute the first 10 distinct Padovan Primes.

Solution


:-initialization(main).

make_lists([], []).
make_lists([Word|Words], [List|Rest]):-
    atom_chars(Word, List),
    make_lists(Words, Rest).

missing_permutation(Word, Permutations, Missing):-
    atom_chars(Word, Chars),
    permutation(Chars, Permutation),
    \+ member(Permutation, Permutations),
    atom_chars(Missing, Permutation).

main:-
    make_lists(['PELR', 'PREL', 'PERL', 'PRLE', 'PLER', 'PLRE', 'EPRL', 'EPLR', 'ERPL',
                'ERLP', 'ELPR', 'ELRP', 'RPEL', 'RPLE', 'REPL', 'RELP', 'RLPE', 'RLEP',
                'LPER', 'LPRE', 'LEPR', 'LRPE', 'LREP'], Permutations),
    missing_permutation('PERL', Permutations, Missing),
    write(Missing), nl,
    halt.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
LERP

Notes

This is a nice place where Prolog really shines compared to the Perl solution to the same problem. That approach requires a good deal of care to properly generalize. The Prolog solution is completely general without any extra work! Here we need only split the starting word into characters and then backtrack through any possible missing permutations with permutation/2 and member/2. Elegant!

Part 2

Write a script to compute the first 10 distinct Padovan Primes.

Solution


padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_not_prime(D)}, [A], padovan_primes(Size, Primes, PrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L < Size}, [A], padovan_primes(Size, Primes, NewPrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, _) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L >= Size, Primes = NewPrimesAccum}, [D].

n_padovan_primes(N, Primes):-
    succ(N, X),
    phrase(padovan_primes(X, PadovanPrimes, [], 1, 1, 1), _),
    [_|Primes] = PadovanPrimes.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
| ?- n_padovan_primes(7, Primes).

Primes = [2,3,5,7,37,151,3329] ? 

(113 ms) yes
| ?-

Notes

If you watch any of the videos on The Power of Prolog YouTube channel you'll learn from Markus Triska that a DCG is the preferable way to handle this sort of problem. Not just because DCGs are a convenient way to process a list in Prolog, but because they can be used to both generate and test solutions. Excellent advice! This code above shows this for a somewhat complicated problem. We must generate the sequence and also determine which of the sequence terms are prime. Primality testing is performed by GNU Prolog's fd_prime/1 and fd_not_prime/1. As the primes are found they are added, along with the most recently computed three sequence terms, as extra arguments.

This solution is very similar to a previous bit of code for Fibonacci Strings.

References

Challenge 154

Padovan Sequence

The Power of Prolog: YouTube Channel

The Power of Prolog

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