Related
Say I have these DCGs:
zorbs([H|T]) --> zorb(H), zorbs(T).
zorbs([]) --> [].
zorb(a) --> [1,2].
zorb(b) --> [3].
zorb(c) --> [6,1,2,2].
I can do this:
?- phrase(zorbs(X), [1,2,3,6,1,2,2]).
X = [a, b, c] .
I can also "reverse" this by doing:
phrase(zorbs([a,b,c]), X).
X = [1, 2, 3, 6, 1, 2, 2].
Now, what I want to do is find a list of numbers with length less than 4 (for example) which these elements "parse" into, returning the rest.
So, for example, given [a,b,c], which would normally relate to [1, 2, 3, 6, 1, 2, 2], I want it to relate to [1, 2, 3] (which has length less than 4) and also give the remainder that couldn't be "reversed," so [c]. I don't really know where to start, as it seems there's no way to reason about the number of elements you've already consumed in a DCG.
Here's a sort-of solution:
X in 0..4,
indomain(X),
Q = [_|_],
prefix(Q, [a,b,c]),
length(A, X),
phrase(zorbs(Q), A).
but I think this is very inefficient, because I think it basically iterates up from nothing, and I want to find the solution with the biggest Q.
There is no direct way how to do this in this case. So your approach is essentially what can be done. That is, you are enumerating all possible solutions and (what you have not shown) selecting them accordingly.
Questions about the biggest and the like include some quantification that you cannot express directly in first order logic.
However, sometimes you can use a couple of tricks.
Sometimes, a partial list like [a,b,c|_] may be helpful.
?- Xs = [_,_,_,_|_], phrase(zorbs(Xs),[1,2,3,6,1,2,2]).
false.
So here we have proven that there is no list of length 4 or longer that corresponds to that sequence. That is, we have proven this for infinitely many lists!
And sometimes, using phrase/3 in place of phrase/2 may help. Say, you have a number sequence that doesn't parse, and you want to know how far it can parse:
?- Ys0 = [1,2,3,6,1,2,7], phrase(zorbs(Xs),Ys0,Ys).
Ys0 = [1,2,3,6,1,2,7], Xs = [], Ys = [1,2,3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "a", Ys = [3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "ab", Ys = [6,1,2,7]
; false.
(This is with the two DCG-rules exchanged)
Can use:
% Like "between", but counts down instead of up
count_down(High, Low, N) :-
integer(High),
integer(Low),
count_down_(High, Low, N).
count_down_(H, L, N) :-
compare(C, H, L),
count_down_comp_(C, H, L, N).
count_down_comp_('=', _H, L, N) :-
% All equal, final
N = L.
% Accept H as the counting-down value
count_down_comp_('>', H, _L, H).
count_down_comp_('>', H, L, N) :-
H0 is H - 1,
% Decrement H towards L, and loop
count_down_(H0, L, N).
... and then start with:
count_down(4, 1, Len), length(Lst, Len), phrase...
Another method is to use freeze to limit a list's length, element-by-element:
max_len_freeze(Lst, MaxLen) :-
compare(C, MaxLen, 0),
max_len_freeze_comp_(C, Lst, MaxLen).
max_len_freeze_comp_('=', [], 0).
max_len_freeze_comp_('>', [_|Lst], MaxLen) :-
succ(MaxLen0, MaxLen),
!,
freeze(Lst, max_len_freeze(Lst, MaxLen0)).
max_len_freeze_comp_('>', [], _).
... and then start with:
max_len_freeze(Lst, 4), phrase...
This will work to find the longest list (maximum length 4) first, since your DCG is greedy (i.e. matching [H|T] before []).
I'm new in Prolog and trying to do some programming with Lists
I want to do this :
?- count_occurrences([a,b,c,a,b,c,d], X).
X = [[d, 1], [c, 2], [b, 2], [a, 2]].
and this is my code I know it's not complete but I'm trying:
count_occurrences([],[]).
count_occurrences([X|Y],A):-
occurrences([X|Y],X,N).
occurrences([],_,0).
occurrences([X|Y],X,N):- occurrences(Y,X,W), N is W + 1.
occurrences([X|Y],Z,N):- occurrences(Y,Z,N), X\=Z.
My code is wrong so i need some hits or help plz..
Here's my solution using bagof/3 and findall/3:
count_occurrences(List, Occ):-
findall([X,L], (bagof(true,member(X,List),Xs), length(Xs,L)), Occ).
An example
?- count_occurrences([a,b,c,b,e,d,a,b,a], Occ).
Occ = [[a, 3], [b, 3], [c, 1], [d, 1], [e, 1]].
How it works
bagof(true,member(X,List),Xs) is satisfied for each distinct element of the list X with Xs being a list with its length equal to the number of occurrences of X in List:
?- bagof(true,member(X,[a,b,c,b,e,d,a,b,a]),Xs).
X = a,
Xs = [true, true, true] ;
X = b,
Xs = [true, true, true] ;
X = c,
Xs = [true] ;
X = d,
Xs = [true] ;
X = e,
Xs = [true].
The outer findall/3 collects element X and the length of the associated list Xs in a list that represents the solution.
Edit I: the original answer was improved thanks to suggestions from CapelliC and Boris.
Edit II: setof/3 can be used instead of findall/3 if there are free variables in the given list. The problem with setof/3 is that for an empty list it will fail, hence a special clause must be introduced.
count_occurrences([],[]).
count_occurrences(List, Occ):-
setof([X,L], Xs^(bagof(a,member(X,List),Xs), length(Xs,L)), Occ).
Note that so far all proposals have difficulties with lists that contain also variables. Think of the case:
?- count_occurrences([a,X], D).
There should be two different answers.
X = a, D = [a-2]
; dif(X, a), D = [a-1,X-1].
The first answer means: the list [a,a] contains a twice, and thus D = [a-2]. The second answer covers all terms X that are different to a, for those, we have one occurrence of a and one occurrence of that other term. Note that this second answer includes an infinity of possible solutions including X = b or X = c or whatever else you wish.
And if an implementation is unable to produce these answers, an instantiation error should protect the programmer from further damage. Something along:
count_occurrences(Xs, D) :-
( ground(Xs) -> true ; throw(error(instantiation_error,_)) ),
... .
Ideally, a Prolog predicate is defined as a pure relation, like this one. But often, pure definitions are quite inefficient.
Here is a version that is pure and efficient. Efficient in the sense that it does not leave open any unnecessary choice points. I took #dasblinkenlight's definition as source of inspiration.
Ideally, such definitions use some form of if-then-else. However, the traditional (;)/2 written
( If_0 -> Then_0 ; Else_0 )
is an inherently non-monotonic construct. I will use a monotonic counterpart
if_( If_1, Then_0, Else_0)
instead. The major difference is the condition. The traditional control constructs relies upon the success or failure of If_0 which destroys all purity. If you write ( X = Y -> Then_0 ; Else_0 ) the variables X and Y are unified and at that very point in time the final decision is made whether to go for Then_0 or Else_0. What, if the variables are not sufficiently instantiated? Well, then we have bad luck and get some random result by insisting on Then_0 only.
Contrast this to if_( If_1, Then_0, Else_0). Here, the first argument must be some goal that will describe in its last argument whether Then_0 or Else_0 is the case. And should the goal be undecided, it can opt for both.
count_occurrences(Xs, D) :-
foldl(el_dict, Xs, [], D).
el_dict(K, [], [K-1]).
el_dict(K, [KV0|KVs0], [KV|KVs]) :-
KV0 = K0-V0,
if_( K = K0,
( KV = K-V1, V1 is V0+1, KVs0 = KVs ),
( KV = KV0, el_dict(K, KVs0, KVs ) ) ).
=(X, Y, R) :-
equal_truth(X, Y, R).
This definition requires the following auxiliary definitions:
if_/3, equal_truth/3, foldl/4.
If you use SWI-Prolog, you can do :
:- use_module(library(lambda)).
count_occurrences(L, R) :-
foldl(\X^Y^Z^(member([X,N], Y)
-> N1 is N+1,
select([X,N], Y, [X,N1], Z)
; Z = [[X,1] | Y]),
L, [], R).
One thing that should make solving the problem easier would be to design a helper predicate to increment the count.
Imagine a predicate that takes a list of pairs [SomeAtom,Count] and an atom whose count needs to be incremented, and produces a list that has the incremented count, or [SomeAtom,1] for the first occurrence of the atom. This predicate is easy to design:
increment([], E, [[E,1]]).
increment([[H,C]|T], H, [[H,CplusOne]|T]) :-
CplusOne is C + 1.
increment([[H,C]|T], E, [[H,C]|R]) :-
H \= E,
increment(T, E, R).
The first clause serves as the base case, when we add the first occurrence. The second clause serves as another base case when the head element matches the desired element. The last case is the recursive call for the situation when the head element does not match the desired element.
With this predicate in hand, writing count_occ becomes really easy:
count_occ([], []).
count_occ([H|T], R) :-
count_occ(T, Temp),
increment(Temp, H, R).
This is Prolog's run-of-the-mill recursive predicate, with a trivial base clause and a recursive call that processes the tail, and then uses increment to account for the head element of the list.
Demo.
You have gotten answers. Prolog is a language which often offers multiple "correct" ways to approach a problem. It is not clear from your answer if you insist on any sort of order in your answers. So, ignoring order, one way to do it would be:
Sort the list using a stable sort (one that does not drop duplicates)
Apply a run-length encoding on the sorted list
The main virtue of this approach is that it deconstructs your problem to two well-defined (and solved) sub-problems.
The first is easy: msort(List, Sorted)
The second one is a bit more involved, but still straight forward if you want the predicate to only work one way, that is, List --> Encoding. One possibility (quite explicit):
list_to_rle([], []).
list_to_rle([X|Xs], RLE) :-
list_to_rle_1(Xs, [[X, 1]], RLE).
list_to_rle_1([], RLE, RLE).
list_to_rle_1([X|Xs], [[Y, N]|Rest], RLE) :-
( dif(X, Y)
-> list_to_rle_1(Xs, [[X, 1],[Y, N]|Rest], RLE)
; succ(N, N1),
list_to_rle_1(Xs, [[X, N1]|Rest], RLE)
).
So now, from the top level:
?- msort([a,b,c,a,b,c,d], Sorted), list_to_rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [[d, 1], [c, 2], [b, 2], [a, 2]].
On a side note, it is almost always better to prefer "pairs", as in X-N, instead of lists with two elements exactly, as in [X, N]. Furthermore, you should keep the original order of the elements in the list, if you want to be correct. From this answer:
rle([], []).
rle([First|Rest],Encoded):-
rle_1(Rest, First, 1, Encoded).
rle_1([], Last, N, [Last-N]).
rle_1([H|T], Prev, N, Encoded) :-
( dif(H, Prev)
-> Encoded = [Prev-N|Rest],
rle_1(T, H, 1, Rest)
; succ(N, N1),
rle_1(T, H, N1, Encoded)
).
Why is it better?
we got rid of 4 pairs of unnecessary brackets in the code
we got rid of clutter in the reported solution
we got rid of a whole lot of unnecessary nested terms: compare .(a, .(1, [])) to -(a, 1)
we made the intention of the program clearer to the reader (this is the conventional way to represent pairs in Prolog)
From the top level:
?- msort([a,b,c,a,b,c,d], Sorted), rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [a-2, b-2, c-2, d-1].
The presented run-length encoder is very explicit in its definition, which has of course its pros and cons. See this answer for a much more succinct way of doing it.
refining joel76 answer:
count_occurrences(L, R) :-
foldl(\X^Y^Z^(select([X,N], Y, [X,N1], Z)
-> N1 is N+1
; Z = [[X,1] | Y]),
L, [], R).
I'm having problem constructing a list of lists in my prolog program.
I have a predicate which gives me back a single case of a row. I have to group all the cases of this row and transform them into a list of lists. I can access them just fine but when I exit, all I'll get is the first element.
Here's the code:
sudoku3to2 :- s3to2(1).
s3to2(Line) :-
Line < 9,
Line1 is Line+1,
s3getLine(Line,0,[L]),
assert(sudoku2(Y,L])),
s3to2(Line1).
s3to2(9).
s3getLine(Line,X, , ) :-
X < 9,
X1 is X + 1,
sudoku3(Line,X, ),
s3getLine(Line,X1, , ).
s3getLine(Line,9,L,L).
sudoku3/3 will return the element at the X,Y coordinate. When I get to s3getLine(Line,9,L,L) I'll start going back. I want to keep all the elements I've gathered and not just the first one. And I'm really having trouble constructing the proper predicate calls.
findall/3 is the 'list constructor' more easily understood.
It's a builtin that list all solutions found, shaping the elements with a specified pattern. Here the pattern is really just the variable we are interested to.
I use between/3 to obtaing a correctly ordered matrix, without regard to sudoku3 rules order.
sudoku3(1, 1, a).
sudoku3(1, 2, b).
sudoku3(2, 1, c).
sudoku3(2, 2, d).
mat(M) :-
W = 2,
findall(Row,
(between(1, W, R),
findall(V, (between(1, W, C), sudoku3(R, C, V)), Row)
), M).
Result:
?- mat(M).
M = [[a, b], [c, d]].
You should change W=9.
HTH
Let's take a permutation of numbers {1,2,3,4} which has only one cycle in it. For example it can be: (2,3,4,1). I was wondering, how can I generate all such permutations using Prolog?
I know how to generate all permutations using select.
But I can't come up with an idea for how to generate only the one-cycle (i.e. single cycle) permutations.
Could someone give me a small prompt or advice?
My comment was intended as a hint for producing directly the single cycle permutations, rather than generating all permutations and filtering out the ones that consist of a single cycle.
We should perhaps clarify that two representations of permutations are frequently used. xyz writes "I know how [to] generate all permutation[s]," presumably meaning something like the code I gave in this 2006 forum post. Here all permutations are represented according to the way a list rearranges the items in some "standard order" list.
Obviously there are N! permutations of all kinds. How many of these are single cycle permutations? That question is easily answered by contemplating the other form useful for permutations, namely as a product of disjoint cycles. We need to distinguish between a cycle like (1,2,3,4) and the identity permutation [1,2,3,4]. Indeed the cycle (1,2,3,4) maps 1 to 2, 2 to 3, 3 to 4, and 4 back to 1, so rather than the identity permutation it would be [2,3,4,1] in its list representation.
Now a cycle loops back on itself, so it is arbitrary where we choose to begin the cycle notation. If we start at 1, for example, then the cycle is determined by the ordering of the following N-1 items. This shows there are (N-1)! permutations of N things that form a single cycle (necessarily of length N). Thus we can generate all single cycle permutations in cycle form easily enough, and the problem then reduces to converting from that cycle form to the list form of a permutation. [Note that in part Mog tackled the conversion going in the other direction: given a permutation as list, ferret out a cycle contained in that permutation (and see if it is full length).]
Here's my code for generating all the one-cycle list permutations of a given "standard order" list, oneCycle(Identity,Permuted):
oneCycle([H|T],P) :-
permute(T,S),
oneCycle2permute([H|S],[H|T],P).
permute([ ],[ ]) :- !.
permute(L,[H|T]) :-
omit(H,L,Z),
permute(Z,T).
omit(H,[H|T],T).
omit(X,[H|T],[H|Z]) :-
omit(X,T,Z).
oneCycle2permute(_,[ ],[ ]) :- !.
oneCycle2permute(C,[I|Is],[P|Ps]) :-
mapCycle(C,I,P),
oneCycle2permute(C,Is,Ps).
mapCycle([X],X,X) :- !.
mapCycle([H|T],X,Y) :-
mapCycleAux(H,T,X,Y).
mapCycleAux(Y,[X],X,Y) :- !.
mapCycleAux(X,[Y|_],X,Y) :- !.
mapCycleAux(_,[X,Y|_],X,Y) :- !.
mapCycleAux(H,[_|T],X,Y) :-
mapCycleAux(H,T,X,Y).
Couldn't you use the function for generating all permutations, and filter out the ones that aren't 'one-cycle permutations'? (Since I'm not at all clear on what 'one-cycle permutations' are, I'm afraid I can't help with writing that filter.)
one-cycle([H|T], Permutation) :-
permutation([H|T], Permutation),
cycle(H, [H], [H|T], Permutation, Cycle),
length(Cycle, CycleLength),
length([H|T], ListLength),
CycleLength =:= ListLength.
The cycle/5 predicate builds the cycle corresponding to the first argument you pass it. the second argument is an accumulator, initialized to [FirstArgument], the third and fourth one are the original List and Permutation, the last one is the result (the list containing the elements of the cycle).
cycle(Current, Acc, List, Permutation, Cycle) :-
The call to corresponds/4 retrieves the item that took the place of the first argument in the permutation :
corresponds(Current, List, Permutation, R),
If this item is in the cycle we're building, it means we're done building the cycle, so we unify Cycle and the accumulator (Acc).
( member(R, Acc)
-> Cycle = Acc
If not, we go on by calling recursively our predicate with the corresponding item we found and we add it to the accumulator, so that our building cycle now holds it :
; cycle(R, [R|Acc], List, Permutation, Cycle)).
corresponds(N, [N|_], [R|_], R) :-
!.
corresponds(N, [_|L], [_|P], R) :-
corresponds(N, L, P, R).
Usage :
?- one-cycle([1, 2, 3, 4], P).
P = [2, 3, 4, 1] ;
P = [3, 1, 4, 2] ;
P = [3, 4, 2, 1] ;
P = [2, 4, 1, 3] ;
P = [4, 1, 2, 3] ;
P = [4, 3, 1, 2] ;
false.
Thanks to the discussion in the answer by hardmath I was able to understand what it was all about.
It seems the solution is quite simply to replace the input list's tail with its permutation to form a cycle description, then transform that into its list representation by paring up each element with its next and sorting on the first component to get the list of the second components as the result list:
single_cycled_permutation([A|B], R) :-
permutation(B, P),
cycle_pairs(A, A, P, CP),
sort( CP, SCP),
maplist( pair, SCP, _, R).
pair( X-Y, X, Y).
cycle_pairs( A, X, [Y|Z], [X-Y|W]) :-
cycle_pairs(A, Y, Z , W ).
cycle_pairs( A, X, [ ], [X-A] ).
To easier see the cycles simply remove the last goal in single_cycled_permutation:
single_cycled_pairs([A|B], SCP) :-
permutation(B, P),
cycle_pairs(A, A, P, CP),
sort( CP, SCP).
Testing:
21 ?- forall( single_cycled_pairs([1,2,3,4], SCP),
(maplist(pair,SCP,_,R), write((SCP,R)), nl)).
[1-2,2-3,3-4,4-1],[2,3,4,1]
[1-2,2-4,3-1,4-3],[2,4,1,3]
[1-3,2-4,3-2,4-1],[3,4,2,1]
[1-3,2-1,3-4,4-2],[3,1,4,2]
[1-4,2-3,3-1,4-2],[4,3,1,2]
[1-4,2-1,3-2,4-3],[4,1,2,3]
true.
See also:
Cyclic permutation
Cycles and fixed points
I need some help writing a predicate in Prolog that, given a number as input, returns a list of lists with numbers that add up to it.
Let's call the predicate addUpList/2, it should work like this:
?- addUpList(3,P).
P = [[1,2], [2,1], [1,1,1]]. % expected result
I'm having so much trouble figuring this out I'm beginning to think it's impossible. Any ideas? Thanks in advance.
Try this:
condense([], Rs, Rs).
condense([X|Xs], Ys, Zs) :-
condense(Xs, [X|Ys], Zs).
condense([X, Y|Xs], Ys, Zs) :-
Z is X + Y,
condense([Z|Xs], Ys, Zs).
condense(Xs, Rs) :-
condense(Xs, [], Rs).
expand(0, []).
expand(N, [1|Ns]) :-
N > 0,
N1 is N - 1,
expand(N1, Ns).
addUpList(N, Zs) :-
expand(N, Xs),
findall(Ys, condense(Xs, Ys), Zs).
Let me know what marks I get. :-)
The rule num_split/2 generates ways of splitting a number into a list, where the first element X is any number between 1 and N and the rest of the list is a split of N-X.
num_split(0, []).
num_split(N, [X | List]) :-
between(1, N, X),
plus(X, Y, N),
num_split(Y, List).
In order to get all such splits, just call findall/3 on num_split/2.
add_up_list(N, Splits) :-
findall(Split, num_split(N, Split), Splits).
Usage example:
?- add_up_list(4, Splits).
Splits =
[[1, 1, 1, 1], [1, 1, 2], [1, 2, 1], [1, 3], [2, 1, 1], [2, 2], [3, 1], [4]].
See also the post by #hardmath which gives the same answer with a bit more explanation.
The example given in the Question suggests that compositions (ordered partitions) of any positive integer N ≤ 10 are wanted. Note however that the solution [3] for N=3 seems to have been omitted/overlooked. The number of compositions of N is 2^(N-1), so N=10 gives a long list but not an unmanageable one.
It is also desired to collect all such solutions into a list, something that findall/3 can do generically after we write a predicate composition/2 that generates them.
The idea is to pick the first summand, anything between 1 and N, subtract it from the total and recurse (stopping with an empty list when the total reaches zero). SWI-Prolog provides a predicate between/3 that can generate those possible first summands, and Amzi! Prolog provides a similar predicate for/4. For the sake of portability we write our own version here.
summand(Low,High,_) :-
Low > High,
!,
fail.
summand(Low,High,Low).
summand(Low,High,Val) :-
Now is Low + 1,
summand(Now,High,Val).
composition(0,[ ]).
composition(N,[H|T]) :-
summand(1,N,H),
M is N - H,
composition(M,T).
Given the above Prolog source code, compiled or interpreted, a list of all solutions can be had in this way:
?- findall(C,composition(3,C),L).
C = H126
L = [[1, 1, 1], [1, 2], [2, 1], [3]]
Of course some arrangement of such a list of solutions or the omission of the singleton list might be required for your specific application, but this isn't clear as the Question is currently worded.
There are plenty of great answers to this question already, but here is another solution to this problem for you to consider. This program differs from the others in that it is very efficient, and generates non-redundant solutions of lists which are assumed to represent sets of integers which add up to the specified number.
gen(N, L) :-
gen(N-1, N, N, FL),
dup_n(FL, L).
gen(C-F, M, M, [C-F]).
gen(C-F, S, M, [C-F|R]) :-
S < M, C > 1,
C0 is C - 1,
F0 is floor(M / C0),
S0 is S + (C0 * F0),
gen(C0-F0, S0, M, R).
gen(C-F, S, M, R) :-
F > 0,
F0 is F - 1,
S0 is S - C,
gen(C-F0, S0, M, R).
dup_n([], []).
dup_n([_-0|R], L) :-
!, dup_n(R, L).
dup_n([V-F|R], [V|L]) :-
F0 is F - 1,
dup_n([V-F0|R], L).
Your implementation of addUpList/2 can be achieved by:
addUpList(N, P) :-
findall(L, gen(N, L), P).
Which should give you the following behaviour:
?- addUpList(4,L).
L = [[4], [3, 1], [2, 2], [2, 1, 1], [1, 1, 1, 1]].
Note that the list containing one 2 and two 1s only appears once in this result set; this is because gen/4 computes unique sets of integers which add up to the specified number.
This answer is somewhere between
#Kaarel's answer and
#sharky's "efficient" answer.
Like #sharky's code, we impose an ordering relation between adjacent list items to restrict the size of the solution space---knowing how to inflate it if we ever need to. So the solution sets of break_down/2 and gen/2 by #sharky are equal (disregarding list reversal).
And as for performance, consider:
?- time((break_down(40,_),false)).
% 861,232 inferences, 0.066 CPU in 0.066 seconds (100% CPU, 13127147 Lips)
false.
?- time((gen(40,_),false)).
% 8,580,839 inferences, 0.842 CPU in 0.842 seconds (100% CPU, 10185807 Lips)
false.