Related
I am currently working on implementing a source-removal topological sorting algorithm for a directed graph. Basically the algorithm goes like this:
Find a node in a graph with no incoming edges
Remove that node and all edges coming out from it and write its value down
Repeat 1 and 2 until you eliminate all nodes
So, for example, the graph
would have a topological sort of a,e,b,f,c,g,d,h. (Note: topological sorts aren't unique and thus there can be a different topological sort as well)
I am currently working on a Prolog implementation of this with the graph being represented in list form as follows:
[ [a,[b,e,f]], [b,[f,g]], [c,[g,d]], [d,[h]], [e,[f]], [f,[]],
[g,[h]], [h,[]] ]
Where the [a, [b,e,f] ] term for example represents the edges going from a to b, e, and f respectively, and the [b, [f,g] ] term represents the edges going from b to f and g. In other words, the first item in the array "tuple" is the "from" node and the following array contains the destinations of edges coming from the "from" node.
I am also operating under assumption that there is one unique name for each vertex and thus when I find it, I can delete it without worrying about any potential duplicates.
I wrote the following code
% depends_on shows that D is adjacent to A, i.e. I travel from A to D on the graph
% returns true if A ----> D
depends_on(G,A,D) :- member([A,Ns],G), member(D,Ns).
% doesnt_depend_on shows that node D doesnt have paths leading to it
doesnt_depend_on(G, D) :- \+ depends_on(G, _, D).
% removes node from a graph with the given value
remove_graph_node([ [D,_] | T], D, T). % base case -- FOUND IT return the tail only since we already popped it
remove_graph_node([ [H,Ns] | T], D, R) :- \+ H=D,remove_graph_node( T, D, TailReturn), append([[H,Ns]], TailReturn, R).
%----------------------------------------------------
source_removal([], []]). % Second parameter is empty list due to risk of a cycle
source_removal(G,Toposort):-member([D,_], G),
doesnt_depend_on(G,D),
remove_graph_node(G,D,SubG),
source_removal(SubG, SubTopoSort),
append([D], SubTopoSort, AppendResult),
Toposort is AppendResult.
And I tested the depends_on, doesnt_depend_on, and remove_graph_node by hand using the graph [ [a,[b,e,f]], [b,[f,g]], [c,[g,d]], [d,[h]], [e,[f]], [f,[]], [g,[h]], [h,[]] ] and manually changing the parameter variables (especially when it comes to node names like a, b, c and etc). I can vouch after extensive testing that they work.
However, my issue is debugging the source_removal command. In it, I repeatedly remove a node with no directed edge pointing towards it along with its outgoing edges and then try to add the node's name to the Toposort list I am building.
At the end of the function's running, I expect to get an array of output like [a,e,b,f,c,g,d,h] for its Toposort parameter. Instead, I got
?- source_removal([ [a,[b,e,f]], [b,[f,g]], [c,[g,d]], [d,[h]], [e,[f]], [f,[]], [g,[h]], [h,[]] ], Result).
false.
I got false as an output instead of the list I am trying to build.
I have spent hours trying to debug the source_removal function but failed to come up with anything. I would greatly appreciate it if anyone would be willing to take a look at this with a different pair of eyes and help me figure out what the issue in the source_removal function is. I would greatly appreciate it.
Thanks for the time spent reading this post and in advance.
The first clause for source_removal/2 contained a typo (one superfluous closing square bracket).
The last line for the second clause in your code says Toposort is AppendResult. Note that is is used in Prolog to denote the evaluation of an arithmetic expression, e.g., X is 3+4 yields X = 7 (instead of just unifying variable X with the term 3+4). When I change that line to use = (assignment, more precisely unification) instead of is (arithmetic evaluation) like so
source_removal([], []). % Second parameter is empty list due to risk of a cycle
source_removal(G,Toposort):-member([D,_], G),
doesnt_depend_on(G,D),
remove_graph_node(G,D,SubG),
source_removal(SubG, SubTopoSort),
append([D], SubTopoSort, AppendResult),
Toposort = AppendResult.
I get the following result:
?- source_removal([ [a,[b,e,f]], [b,[f,g]], [c,[g,d]], [d,[h]], [e,[f]], [f,[]], [g,[h]], [h,[]] ], Result).
Result = [a, b, c, d, e, f, g, h] ;
Result = [a, b, c, d, e, g, f, h] ;
Result = [a, b, c, d, e, g, h, f] ;
Result = [a, b, c, d, g, e, f, h] ;
Result = [a, b, c, d, g, e, h, f] ;
Result = [a, b, c, d, g, h, e, f] ;
Result = [a, b, c, e, d, f, g, h] ;
Result = [a, b, c, e, d, g, f, h] ;
Result = [a, b, c, e, d, g, h, f] ;
Result = [a, b, c, e, f, d, g, h] ;
Result = [a, b, c, e, f, g, d, h] ;
...
Result = [c, d, a, e, b, g, h, f] ;
false.
(Shortened, it shows 140 solutions in total.)
Edit: I didn't check all the solutions, but among the ones it finds is the one you gave in your example ([a,e,b,f,c,g,d,h]), and they look plausible in the sense that each either starts with a or with c.
I found a 3 year old question that helps me count the number of occurrences of variables within a list. The question had the answer below. The code works. But I can't understand how, can someone help me make sense of this?
Here is the answer with the code I found, writing in quotation marks is part of the answer:
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z).
'However note that the second argument X is supposed to be instantiated. So e.g. count([2,23,3,45,23,44,-20],23,C) will unify C with 2. If you want the count for every element use'
:- use_module(library(lists)).
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z)
countall(List,X,C) :-
sort(List,List1),
member(X,List1),
count(List,X,C).
'Then you get'
?- countall([2,23,3,45,23,44,-20],X,Y).
X = -20,
Y = 1 ;
X = 2,
Y = 1 ;
X = 3,
Y = 1 ;
X = 23,
Y = 2 ;
X = 44,
Y = 1 ;
X = 45,
Y = 1 ;
no
I am very new to Prolog, I only understand one part of this code, and it is this
sort(List,List1),
member(X,List1),
I would appreciate an explanation of this the whole thing, especially how Y is being printed.
About counting, first try to think about the meaning of the code.
list_member_occ([], _, 0). % list is empty, 0 occurrences
list_member_occ([X|Xs], X, N) :- % list has the element at the head
list_member_occ(Xs, X, N0), % count number of elements in the tail
succ(N0, N). % the number of occurrences is the
% next natural number
list_member_occ([Y|Xs], X, N) :-
dif(X, Y), % head and the element are different
list_member_occ(Xs, X, N). % occurrences in the tail of the list
% is the total number
In this code, succ(N0, N) is (arguably) a better way to say "N is the natural number after N0" than N is N0 + 1. One reason is that succ/2 was meant to be used in every direction:
?- succ(2, 3).
true.
?- succ(X, 4).
X = 3.
?- succ(1, X).
X = 2.
... while is/2 should be used with unbound left operand. Take this query
?- list_member_occ([1,1,2,1], X, 3).
... for an example of N being a number instead of a free variable.
Using the predicate:
?- list_member_occ([1,2,1], X, N).
X = 1,
N = 2 ;
X = 2,
N = 1 ;
N = 0,
dif(X, 1),
dif(X, 2),
dif(X, 1).
One interesting property of dif/2, as opposed to \=/2, is that it imposes a constraint on the variable X in the last solution: X cannot, from now on, take any of the values 1, or 2.
For the reason why you get all answers using dif/2, consider:
?- X = Y. % unify X and Y and succeed
X = Y.
?- X \= Y. % succeed if you cannot unify X and Y
false.
?- dif(X, Y). % succeed if X and Y are and will be different
dif(X, Y).
When you use X \= Y, Prolog tries to unify its arguments and fails if the unification succeeds. This means that you only get the solution in which all free variables have been unified to each other, but you miss solutions where free variables are different from each other.
About the Y = ..., when you make a query at the top level, it reports to you all new variable bindings that were made during successful proofs of this query. As the most simple example:
Which numbers are between 3 and 5, both including?
?- between(3, 5, X).
X = 3 ;
X = 4 ;
X = 5.
You don't need, of course, to print out the values of X by hand; just type a semicolon to get the next answer. After the last answer you get a full stop and return to the ?- prompt.
About the sorting: it sorts the whole list, but only shows you the first 9 elements of the sorted list. See this FAQ page from SWI-Prolog. In a nutshell, the easiest is to type ; true after your query, to make sure that there is at least one choice point, and use w and p to switch between showing the whole term and only some of it.
?- string_chars("the quick brown fox jumps over the lazy dog", Cs), sort(Cs, S) ; true.
Cs = [t, h, e, ' ', q, u, i, c, k|...],
S = [' ', a, b, c, d, e, f, g, h|...] [write]
Cs = [t, h, e, ' ', q, u, i, c, k, ' ', b, r, o, w, n, ' ', f, o, x, ' ', j, u, m, p, s, ' ', o, v, e, r, ' ', t, h, e, ' ', l, a, z, y, ' ', d, o, g],
S = [' ', a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z] .
?- string_chars("the quick brown fox jumps over the lazy dog", Cs), sort(Cs, S) ; true.
Cs = [t, h, e, ' ', q, u, i, c, k, ' ', b, r, o, w, n, ' ', f, o, x, ' ', j, u, m, p, s, ' ', o, v, e, r, ' ', t, h, e, ' ', l, a, z, y, ' ', d, o, g],
S = [' ', a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z] [print]
Cs = [t, h, e, ' ', q, u, i, c, k|...],
S = [' ', a, b, c, d, e, f, g, h|...] .
Hope this helps.
My assignment is this: Write a program that reads an integer x and a list of integers L; then locate the list of all positions of x into L, and return the resulting list. For example, for x=2 and L=[1,2,3,4,2,5,2,6] the program should return the list R=[2,5,7].
So far, I've been able to write an indexOf predicate:
indexOf([E|_], E, 1).
indexOf([_|T], E, I) :- indexOf(T, E, I2), I is I2 + 1.
However, this doesn't "return" a list. So:
indexOf([a,b,c,a,d], a, R).
R = 1;
R = 4
I'd like to do something like this:
findAll([a,b,c,a,d], a, R).
R = [1, 4]
But I'm not sure how to collect the values into a list.
This is a school assignment, so I'd appreciate just a nudge in the right direction.
A nudge: you find the indices, but you don't collect them.
indices(List, E, Is) :-
indices_1(List, E, Is, 1).
For an empty list, the list of indices is empty,
and the element doesn't matter
indices_1([], _, [], _).
If the element is like the head, collect the index.
indices_1([E|Xs], E, [I|Is], I) :-
I1 is I + 1,
indices_1(Xs, E, Is, I1).
This needs another clause to work properly.
EDIT:
One way to do it would be:
indices_1([X|Xs], E, Is, I) :- dif(X, E),
I1 is I + 1,
indices_1(Xs, E, Is, I1).
In the previous clause, the head of the list and the Element are unified. In this clause, they are explicitly different. This means that only one of the two clauses can be true for an element of the list in the first arguemnt.
EDIT:
Another way to do that is to use findall and nth1:
indices(List, E, Is) :-
findall(N, nth1(N, List, E), Is).
Any ideas how to retrieve the maximally repeated element in a list.
i.e. something like below,
?- maxRepeated([1,2,7,3,6,1,2,2,3],M).
M = 2.
I like so much the relational Prolog power:
maxRepeated(L, M) :-
sort(L, S),
maplist(count(L), S, C),
keysort(C, [_-M|_Ms]).
count(L, S, I-S) :-
aggregate(count, member(S, L), C), I is -C.
test:
?- maxRepeated([1,2,7,3,6,1,2,2,3],M).
M = 2.
edit and now, still more compact!
maxRepeated(L, M) :-
setof(I-E, C^(aggregate(count, member(E, L), C), I is -C), [_-M|_]).
This solution sorts the list, granting elements to appear sequentially -- there's no need to maintain all elements, once they're not repeating later.
Your prolog interpreter must have the function msort(), which sorts a list maintaining duplicated entries.
maxRepeated([], []).
maxRepeated(L, E) :-
msort(L, [H|T]),
maxRepeated(T, H, H, 1, 0, E).
maxRepeated([], H, _, C1, C2, H) :- C1 >= C2.
maxRepeated([], _, X, C1, C2, X) :- C1 < C2.
maxRepeated([H|T], H, LastF, C1, C2, E) :-
maxRepeated(T, H, LastF, C1 + 1, C2, E).
maxRepeated([X|T], H, LastF, C1, C2, E) :-
(
C1 > C2
-> maxRepeated(T, X, H, 1, C1, E)
; maxRepeated(T, X, LastF, 1, C2, E)
).
The complexity is given by the sort used, usually O(n log n), once, after the sort, the list is traversed only once, aggregating the elements and keeping track of the most frequent one.
Regards!
If you know the max value that Ai can take and if this Amax is such that you can create an array as large as Amax then there is a method by which you can find the most repeated element in O(n) time.
int A[max+1]; // set all elements to 0
int S[n]; // Set S
for (i=0;i<n;i++) A[ S[i] ]++;
int m=0, num; // num is the number to be found
for (i=1;i<=max;i++)
if (A[i] > m)
{
m = A[i];
num = i;
}
print (num)
Here is a quick and dirty answer. I constrained the problem to a set of allowed elements. Works but needs elaboration.
maxRepeated([],_,Current,_,Current).
maxRepeated([H|T],L,Current,MaxCount,X) :-
(
count(L,H,N),
N > MaxCount,
maxRepeated(T,L,H,N,X)
)
;
maxRepeated(T,L,Current,MaxCount,X).
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z).
The creole of Paradise Island has 14 words: "abandon", "abalone", "anagram", "boat", "boatman", "child", "connect", "elegant", "enhance", "island", "man", "sand", "sun", and "woman".
The Paradise Times have
published this crossword:
The crossword contains some of the 14 words but no other words.
Write
a Prolog program that starts from
word(X) :-
member(X,
[
[a,b,a,n,d,o,n], [a,b,a,l,o,n,e], [a,n,a,g,r,a,m],
[b,o,a,t], [b,o,a,t,m,a,n], [c,h,i,l,d],
[c,o,n,n,e,c,t], [e,l,e,g,a,n,t], [e,n,h,a,n,c,e],
[i,s,l,a,n,d], [m, a, n], [s,a,n,d],
[s,u,n], [w, o, m, a, n]
]).
solution(H1,H2,H3,V1,V2,V3) :-
and defines the predicate solution in such a way that
solution(H1,H2,H3,V1,V2,V3)
is true if and only if H1, H2, H3, V1, V2, and V3 are valid words of Paradise
Island which form a valid crossword when written into the grid given above.
(For example, the second letter of H1 should coincide with the second letter
of V1.)
Use the query
?- solution(H1,H2,H3,V1,V2,V3).
to solve the crossword. Find all solutions to the crossword.
Hint: You might want to start from a smaller crossword and a less rich
lexicon.
Just look at the picture, words are written with letters, you have everything in the picture, translaste it in Prolog lines (my solution has 12 lines, 2 lines for one word).
[EDIT] As every body gives its own solution, here is mine :
solution(H1,H2,H3,V1,V2,V3) :-
H1 = [_,A2,_,A4,_,A6,_],
H2 = [_,B2,_,B4,_,B6,_],
H3 = [_,C2,_,C4,_,C6,_],
V1 = [_,A2,_,B2,_,C2,_],
V2 = [_,A4,_,B4,_,C4,_],
V3 = [_,A6,_,B6,_,C6,_],
maplist(word, [H1,H2,H3,V1,V2,V3]).
PS I originally
wrote word(H1),
word(H2) ...
Uniquely domain-selecting select/2 does the trick:
select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_).
words(X) :- X = [
[a,b,a,n,d,o,n], [a,b,a,l,o,n,e], [a,n,a,g,r,a,m],
[b,o,a,t], [b,o,a,t,m,a,n], [c,h,i,l,d],
[c,o,n,n,e,c,t], [e,l,e,g,a,n,t], [e,n,h,a,n,c,e],
[i,s,l,a,n,d], [m, a, n], [s,a,n,d],
[s,u,n], [w, o, m, a, n]
].
solve(Crossword):- words(Words),
Crossword = [ [_,A2,_,A4,_,A6,_],
[_,B2,_,B4,_,B6,_],
[_,C2,_,C4,_,C6,_],
[_,A2,_,B2,_,C2,_],
[_,A4,_,B4,_,C4,_],
[_,A6,_,B6,_,C6,_] ],
select(Crossword, Words).
solve:- solve(Crossword),
maplist(writeln, Crossword), writeln(';'), fail
; writeln('No more solutions!').
Test:
7 ?- solve.
[a, b, a, n, d, o, n]
[e, l, e, g, a, n, t]
[e, n, h, a, n, c, e]
[a, b, a, l, o, n, e]
[a, n, a, g, r, a, m]
[c, o, n, n, e, c, t]
;
[a, b, a, l, o, n, e]
[a, n, a, g, r, a, m]
[c, o, n, n, e, c, t]
[a, b, a, n, d, o, n]
[e, l, e, g, a, n, t]
[e, n, h, a, n, c, e]
;
No more solutions!
This solution only allows for unique words to be used in the puzzle (no duplicates are allowed). This might or might not be what you intended.
Not a Prolog program per se, but a solution using Constraint Logic Programming can be found in Hakan Kjellerstrand's excellent blog on CP. It's in ECLiPSe, but easily adaptable to other Prolog systems with finite domain solvers. Using CLP instead of pure Prolog will make the search much faster.
solution(H1, H2, H3, V1, V2, V3) :-
crosswordize([H1,H2,H3], [V1,V2,V3]),
maplist(word, [H1,H2,H3,V1,V2,V3]).
crosswordize([], [[_],[_],[_]]).
crosswordize([[_, X1, _, X2, _, X3, _]|Lines],
[[_, X1|R1], [_, X2|R2], [_, X3|R3]]) :-
crosswordize(Lines, [R1,R2,R3]).
The algorithm isn't hard to get:
we build the grid through the crosswordize/2 predicate call
we tell prolog that every list is a word
The crosswordize/2 predicate is going through the columns two cells at a time while building lines. If you don't get it you still can "hardcode" it as Will did, it works too!
The theory here is to check for the letters which correspond to themselves in vertical and horizontal words. This can be achieved by using placeholders in the word rule. Checkout this gist https://gist.github.com/ITPol/f8f5418d4f95015b3586 it gives an answer which claims has no repetitions. However, coming from SQL, I think to properly curb repetitions will require a solution along the lines of V1 #< V2; because just using a "not equals to" is just not sufficient enough. Pardon the multiple "[k]nots"; it's actually not that complicated. Pun intended (: