I am trying to print all solutions of the n-fractions problem for n=4:
:- lib(ic).
fractions(Digits) :-
Digits = [A,B,C,D,E,F,G,H,I,J,K,L],
Digits #:: 1..9,
ic:alldifferent(Digits),
X #= 10*B+C,
Y #= 10*E+F,
Z #= 10*H+I,
V #= 10*K+L,
A*Y*Z*V + D*X*Z*V + G*X*Y*V + J*X*Y*Z #= X*Y*Z*V,
A*Y #=< D*X,
D*Z #=< G*Y,
G*V #=< J*Z,
search(Digits,0,input_order,indomain,complete,[]).
When I run the query:
?- findall(Digits,fractions(Digits),List).
I get the following exception:
*** Overflow of the local/control stack!
You can use the "-l kBytes" (LOCALSIZE) option to have a larger stack.
Peak sizes were: local stack 105728 kbytes, control stack 25344 kbytes
I am thinking if there is a way to loop inside the program and print one solution each time, or I can't do that because the problem has too many solutions?
As has been pointed out, your code fails because the alldifferent(Digits) constraint is too restrictive. The digits must be allowed to occur between 1 and 2 times. In eclipse-clp, you can use constraints such as atleast/3, atmost/3, occurrences/3 or gcc/2 to express this.
Slightly off-topic: as you are using ECLiPSe's ic-solver (which can handle continuous domains), you can actually use a model much closer to the original specification, without introducing lots of multiplications:
:- lib(ic).
:- lib(ic_global).
fractions4(Digits) :-
Digits = [A,B,C,D,E,F,G,H,I,J,K,L],
Digits #:: 1..9,
A/(10*B+C) + D/(10*E+F) + G/(10*H+I) + J/(10*K+L) $= 1,
( for(I,1,9), param(Digits) do
occurrences(I, Digits, NOcc), NOcc #:: 1..2
),
lex_le([A,B,C], [D,E,F]), % lex-ordering to eliminate symmetry
lex_le([D,E,F], [G,H,I]),
lex_le([G,H,I], [J,K,L]),
labeling(Digits).
Apart from the main equality constraint (using $= instead of #= because we don't want to require integrality here), I've used occurrences/3 for the occurrence restrictions, and lexicographic ordering constraints as a more standard way of eliminating symmetry. Result:
?- findall(Ds, fractions4(Ds), Dss), length(Dss, NSol).
Dss = [[1, 2, 4, 3, 5, 6, 8, 1, 4, 9, 2, 7], [1, 2, 6, 5, 3, 9, 7, 1, 4, 8, 2, 4], [1, 2, 6, 5, 3, 9, 7, 8, 4, 9, 1, 2], [1, 2, 6, 7, 3, 9, 8, 1, 3, 9, 5, 4], [1, 2, 6, 8, 7, 8, 9, 1, 3, 9, 5, 4], [1, 3, 4, 5, 4, 6, 8, 1, 7, 9, 2, 3], [1, 3, 4, 7, 5, 6, 8, 1, 7, 9, 2, 4], [1, 3, 4, 8, 1, 7, 8, 5, 2, 9, 2, ...], [1, 3, 5, 6, 2, 8, 7, 1, 4, 9, ...], [1, 3, 6, 5, 2, 4, 7, 1, 8, ...], [1, 3, 6, 5, 3, 6, 7, 8, ...], [1, 3, 6, 5, 4, 5, 8, ...], [1, 3, 6, 5, 6, 3, ...], [1, 3, 6, 6, 5, ...], [1, 3, 6, 7, ...], [1, 3, 9, ...], [1, 3, ...], [1, ...], [...], ...]
NSol = 1384
Yes (82.66s cpu)
An added advantage of this model is that it can be quite easily turned into a generic model for arbitrary N.
Simply your predicate fails. If you remove all the constraints except alldifferent/1 and search/6 (just to understand the problem) and call ?- fractions(Digits). you get false because it's impossible to have a list with 12 elements (Digits = [A,B,C,D,E,F,G,H,I,J,K,L]) with domain for each element Digits #:: 1..9 and constraint those elements to be all different (ic:alldifferent(Digits)). 9 options for 12 elements: unsolvable. If you expand the domain up to 12 (Digits #:: 1..12), you get a solution:
?- fractions(Digits).
Digits = [2, 3, 4, 9, 7, 10, 12, 8, 5, 11, 1, 6]
Yes (94.00s cpu, solution 1, maybe more)
Then you can apply findall/3 and see other solutions...
Many clpfd implementations offer global_cardinality constraints which I use in this example. In the following I use SICStus Prolog 4.5.0:
:- use_module(library(clpfd)).
fractions(Digits) :-
Digits = [A,B,C,D,E,F,G,H,I,J,K,L],
domain(Digits, 1, 9),
global_cardinality(Digits, [1-N1,2-N2,3-N3,4-N4,5-N5,6-N6,7-N7,8-N8,9-N9]),
domain([N1,N2,N3,N4,N5,N6,N7,N8,N9], 1, 2),
X #= 10*B+C,
Y #= 10*E+F,
Z #= 10*H+I,
V #= 10*K+L,
Z*V #= ZV,
X*Y #= XY,
A*Y*ZV + D*X*ZV + G*XY*V + J*XY*Z #= XY*ZV,
X #=< Y, X #= Y #=> A #=< D, % break some symmetries
Y #=< Z, Y #= Z #=> D #=< G,
Z #=< V, Z #= V #=> G #=< J.
Sample use:
| ?- n_fractions(4,Zs), labeling([enum],Zs).
Zs = [2,1,2,9,1,8,7,3,5,6,4,5] ? ;
Zs = [2,1,3,7,1,8,9,2,6,5,4,5] ? ;
Zs = [2,1,3,7,1,8,9,2,6,6,5,4] ? ;
...
no
Using prolog-findall for collecting all solutions works out all right, too:
?- findall(Zs,(n _fractions(4,Zs), labeling([enum],Zs)), Zss),
length(Zss, N_sols).
Zss = [[2,1,2,9,1,8,7,3,5|...],
[2,1,3,7,1,8,9,2,6|...],
[2,1,3,7,1,8,9,2|...],
[2,1,3,8,1,5,7|...],
[2,1,3,8,1,6|...],
[2,1,3,9,1|...],
[2,1,3,9|...],
[2,1,4|...],
[2,1|...],
[...|...]|...],
N_sols = 1384 ? ;
no
Related
Basically what I want to achieve is :
Given a list of domain Variables set these Variables with a domain relative to a List of Numbers. Example:
......
List=[A1,A2,A3],
domain(List,1,5],
setDomain(List,[1,2]),
labeling([],List).
Result:
A1=1, A2=1, A3=1 or
A1=1, A2=1, A3=2 or
A1=1, A2=2, A3=1
and so on...
What I have tried:
setDomain(List,ListIntegers):-
element(X, List, Element),
member(Element,ListIntegers),
main(List):-
List=[A1,A2,A3],
domain(List,1,5],
setDomain(List,[1,2]),
labeling([],List).
but not success...
Can anyone help understand how can I accomplish this?
In your solution, you're using labeling/2 but haven't defined its arguments using CLP(FD), so it doesn't do anything for you. It's not very clear from your question or simple example, but it sounds like you want a list of a given length whose elements are each taken from a domain consisting of an arbitrary list of elements?
You could do so with something like this:
member_(List, Element) :- member(Element, List).
domain_list(Length, Domain, List) :-
length(List, Length),
maplist(member_(Domain), List).
This would give:
6 ?- domain_list(3, [1,3], L).
L = [1, 1, 1] ;
L = [1, 1, 3] ;
L = [1, 3, 1] ;
L = [1, 3, 3] ;
L = [3, 1, 1] ;
L = [3, 1, 3] ;
L = [3, 3, 1] ;
L = [3, 3, 3].
7 ?-
This also works for any kind of elements:
7 ?- domain_list(3, [tom, a(b)], L).
L = [tom, tom, tom] ;
L = [tom, tom, a(b)] ;
L = [tom, a(b), tom] ;
L = [tom, a(b), a(b)] ;
L = [a(b), tom, tom] ;
L = [a(b), tom, a(b)] ;
L = [a(b), a(b), tom] ;
L = [a(b), a(b), a(b)].
8 ?-
If you wanted to use CLP(FD), you'd need to keep a couple of things in mind. CLP(FD) is for integer domains, and CLP(FD) has its own way of specifying domains, which is not in list form.
For instance, if you wanted a list of length N whose elements were in the domain described by [1,2,3,5,6,8], you would write it as:
length(List, N),
List ins 1..3 \/ 5..6 \/ 8,
label(List).
Which would result in, for example:
2 ?- length(List, 3), List ins 1..3 \/ 5..6 \/ 8, label(List).
List = [1, 1, 1] ;
List = [1, 1, 2] ;
List = [1, 1, 3] ;
List = [1, 1, 5] ;
List = [1, 1, 6] ;
List = [1, 1, 8] ;
List = [1, 2, 1] ;
List = [1, 2, 2]
...
Using ECLiPSe Prolog you can write:
:-lib(fd).
applyDomain([],_).
applyDomain([H|T],D):-
var_fd(H,D),
applyDomain(T,D).
domainList(ListDomain,LengthList,ListOutput):-
length(ListOutput,LengthList),
list_to_dom(ListDomain,Domain),
applyDomain(ListOutput,Domain).
Query:
?- domainList([2,3,5,7,8],5,L).
L = [_530{[2, 3, 5, 7, 8]}, _547{[2, 3, 5, 7, 8]}, _564{[2, 3, 5, 7, 8]}, _581{[2, 3, 5, 7, 8]}, _598{[2, 3, 5, 7, 8]}]
Yes (0.00s cpu)
The output means that each variable (in this case _530, _547 and so on) in the list L has the specified domain {[2, 3, 5, 7, 8]}. If you want to label the list you can simply add
labeling(ListOutput).
as last line of domainList/3 and you get:
?- domainList([2, 3, 5, 7, 8], 5, L).
L = [2, 2, 2, 2, 2]
Yes (0.00s cpu, solution 1, maybe more)
L = [2, 2, 2, 2, 3]
Yes (0.00s cpu, solution 2, maybe more)
L = [2, 2, 2, 2, 5]
Yes (0.00s cpu, solution 3, maybe more)
and so on... If you want that all the list will be different, just add
alldifferent(ListOutput),
before labeling/1, and you'll get
?- domainList([2, 3, 5, 7, 8], 5, L).
L = [2, 3, 5, 7, 8]
Yes (0.00s cpu, solution 1, maybe more)
L = [2, 3, 5, 8, 7]
Yes (0.00s cpu, solution 2, maybe more)
L = [2, 3, 7, 5, 8]
Yes (0.00s cpu, solution 3, maybe more)
I usually don't use SWI prolog for clpfd problems, so i don't know if there is a similar solution in SWI...
I need some help for counting the number of combinations from which a destination node can be reached.
I found the program for finding the different paths. But in the end I need to have some query
%Edge List (Knowledge Base)
edge(1,2).
edge(1,4).
edge(2,4).
edge(3,6).
edge(3,7).
edge(4,3).
edge(4,5).
edge(5,6).
edge(5,7).
edge(6,5).
edge(7,5).
edge(8,6).
edge(8,7).
%Program
path(X,Y,[X,Y]):- edge(X,Y).
path(X,Y,[X|Xs]):- edge(X,W), path(W,Y,Xs).
-------------------------------------------------
%Query
path(1, 7, P).
%Results
Z = [1, 2, 4, 3, 6, 5, 7];
Z = [1, 2, 4, 3, 6, 5, 6, 5, 7];
.........................
But what if I want to run a query that gives me the number of these paths.
?-path(1, 7, count).
should return 2
First of all you're answer fall into cycles and does not terminate, you could keep a list of what you've visited in order to avoid visit same nodes twice:
path(X,Y,L):-path(X,Y,L,[X]).
path(X,Y,[X,Y],L):- \+member(Y,L),edge(X,Y).
path(X,Y,[X|Xs],L):- edge(X,W),\+ member(W,L) ,path(W,Y,Xs,[W|L]).
Now if you query:
?- path(1, 7, P).
P = [1, 2, 4, 3, 7] ;
P = [1, 2, 4, 3, 6, 5, 7] ;
P = [1, 2, 4, 5, 7] ;
P = [1, 4, 3, 7] ;
P = [1, 4, 3, 6, 5, 7] ;
P = [1, 4, 5, 7] ;
false.
So the valid paths are not 2, since the above six paths are valid.
Now to count the paths you could try:
findall(P, path(1,7,P), Paths), length(Paths, N).
as suggested in comments but this is not very efficient since you need first to build a list of all paths and count the length.
If you're using Swipl you could try a fail-driven loop to calculate all possible paths and use nb_getval/2 and nb_setval/2 in order to count:
count(X,Y):-
nb_setval(counter, 0),
path(X,Y,_),
nb_getval(counter, Value),
New_value is Value+1,
nb_setval(counter, New_value),
fail;
nb_getval(counter, Value),
write(Value).
Example:
?- count(1,7).
6
true.
I'm trying to make a predicate that takes two vectors/lists and uses the first one as a filter. For example:
?- L1=[0,3,0,5,0,0,0,0],L2=[1,2,3,4,5,6,7,8],filter(L1,L2,1).
L1 = [0, 3, 0, 5, 0, 0, 0, 0],
L2 = [1, 2, 3, 4, 5, 6, 7, 8] .
That's what I'm getting but I would want true or false if L2 has 3 as the second element, 5 as the fourth element, etc. The 0s are ignored, that's the "filter" condition.
What I know from the input is that L1 and L2 are always length=8 and only L1 has 0s.
My code is:
filter(_,_,9).
filter([Y|T],V2,Row):-
Y=:=0,
NewRow is Row + 1,
filter([Y|T],V2,NewRow).
filter([Y|T],V2,Row):-
Y=\=0,
nth(Row,[Y|T],X1),
nth(Row,V2,X2),
X1=:=X2,
NewRow is Row + 1,
filter([Y|T],V2,NewRow).
nth(1,[X|_],X).
nth(N,[_|T],R):- M is N-1, nth(M,T,R).
I know there are better ways of doing the function, for example comparing the first element of the first to the nth of the second and delete the head of the first with recursion but I just want to know why I'm not getting true or false, or any "return" value at all.
Can someone help me?, got it working
New code:
filter([],R,_,R).
filter([Y|T],V2,Row,R):-
Y=:=0,
NewRow is Row + 1,
filter(T,V2,NewRow,R).
filter([Y|T],V2,Row,R):-
Y=\=0,
nth(Row,V2,X2),
Y=:=X2,
NewRow is Row + 1,
filter(T,V2,NewRow,R).
Example of expected behaviour:
permutation([1,2,3,4,5,6,7,8],X),filter([1,2,3,4,0,0,0,0],X,1,R).
X = R, R = [1, 2, 3, 4, 5, 6, 7, 8] ;
X = R, R = [1, 2, 3, 4, 5, 6, 8, 7] ;
X = R, R = [1, 2, 3, 4, 5, 7, 6, 8] ;
X = R, R = [1, 2, 3, 4, 5, 7, 8, 6] .
Now i can get all the permutations that starts with 1,2,3,4.
If someone knows a better way to achieve the same, plz share, but i already got what i needed =).
seems like could be a perfect task for maplist/3
filter(L1, L2, _) :-
maplist(skip_or_match, L1, L2).
skip_or_match(E1, E2) :- E1 == 0 ; E1 == E2.
yields
?- permutation([1,2,3,4,5,6,7,8],X),filter([1,2,3,4,0,0,0,0],X,_).
X = [1, 2, 3, 4, 5, 6, 7, 8] ;
X = [1, 2, 3, 4, 5, 6, 8, 7] ;
X = [1, 2, 3, 4, 5, 7, 6, 8] ;
X = [1, 2, 3, 4, 5, 7, 8, 6] ;
...
We could do that more useful, using Prolog facilities - namely, use an anonymus variable to express don't care.
Then filter/N is a simple application of maplist:
?- permutation([1,2,3,4,5,6,7,8],X),maplist(=,[1,2,3,4,_,_,_,_],X).
X = [1, 2, 3, 4, 5, 6, 7, 8] ;
X = [1, 2, 3, 4, 5, 6, 8, 7] ;
X = [1, 2, 3, 4, 5, 7, 6, 8] ;
X = [1, 2, 3, 4, 5, 7, 8, 6] ;
...
Your code always tests the first item of the filtering list for being zero. For example, look at the case when you're checking second value:
filter([0,3,0,5,0,0,0,0], [1,2,3,4,5,6,7,8], 2).
This call will perform the following unifications:
# first case: obvious fail…
filter([0,3,0,5,0,0,0,0], [1,2,3,4,5,6,7,8], 2) =\= filter(_, _, 9).
# second case:
filter([0,3,0,5,0,0,0,0], [1,2,3,4,5,6,7,8], 2) = filter([Y|T],V2,Row).
# unification succeeds with substitutions:
Y = 0
T = [3,0,5,0,0,0,0]
V2 = [1,2,3,4,5,6,7,8]
Row = 2
# and what happens next?
Y =:= 0 # success!
You probably wanted here to check whether second element of [Y|T] is zero; instead, you're checking the first one. If you want to fix it without changing the rest of your code, you should instead perform comparisons to X1:
filter(V1,V2,Row):-
nth(Row, V1, X1),
X1 =:= 0,
NewRow is Row + 1,
filter(V1,V2,NewRow).
filter(V1,V2,Row):-
nth(Row,V1,X1),
X1=\=0,
nth(Row,V2,X2),
X1=:=X2,
NewRow is Row + 1,
filter(V1,V2,NewRow).
Also, there's one more thing that I think you might not be getting yet in Prolog. If a predicate fails, Prolog indeed prints false and stops computation. But if a predicate succeeds, there are two cases:
If there were no variables in your query, Prolog prints true.
If there were any variables in your query, Prolog does not print true. Instead, it prints values of variables instead. This also counts as true.
In your case Prolog actually “returns” true from your predicate—except that because you have used variables in your query, it printed their value instead of printing true.
For an example I need to sort:
?- mergesort([8,1,[4,6,3],2],Sorted).
The outcome should be:
Sorted = [1, 2, 8, [3, 4, 6]]
Unfortunately I'm not sure what to do. I've tried to find an answer myself, but didn't find a solution. Currently the outcome is:
Sorted = [1, 2, 8, [4, 6, 3]]
My code:
mergesort([],[]).
mergesort([A],[A]).
mergesort([A,B|R],S) :-
split([A,B|R],L1,L2),
mergesort(L1,S1),
mergesort(L2,S2),
merge(S1,S2,S).
split([],[],[]).
split([A],[A],[]).
split([A,B|R],[A|Ra],[B|Rb]) :- split(R,Ra,Rb).
merge(A,[],A).
merge([],B,B).
merge([A|Ra],[B|Rb],[A|M]) :- A #=< B, merge(Ra,[B|Rb],M).
merge([A|Ra],[B|Rb],[B|M]) :- A #> B, merge([A|Ra],Rb,M).
Big thanks in advance!
I would write a simple preprocessing step:
sortl([H|T],[Hs|Ts]) :-
( is_list(H)
-> mergesort(H,Gs),
sortl(Gs,Hs)
; Hs = H
),
sortl(T,Ts).
sortl([],[]).
then you could use it this way
?- sortl([8,1,[4,6,[3,4],[1,8],3],2,[1,3,2]],T),mergesort(T,Sorted).
T = [8, 1, [3, 4, 6, [1, 8], [3|...]], 2, [1, 2, 3]],
Sorted = [1, 2, 8, [1, 2, 3], [3, 4, 6, [...|...]|...]]
I was trying to write predicate divide(L,Len,Slist) which will be true when Slist can unify with a List of length Len allocated from List L. for example
divide([1,2,3,4,5,6,7],3,Slist).
Should give such answers
Slist=[1,2,3];
Slist=[2,3,4];
Slist=[3,4,5];
Slist=[4,5,6];
Slist=[5,6,7];
But i couldn't find a better way then length(X,Len), sublist(L,X). but it does work too slow.
How should look divide predicate?
Alternatively you could use DCG as mentionned by #false in this great answer:
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
divide(List, Length, Result) :-
length(Result, Length),
phrase((seq(_), seq(Result), seq(_)), List).
sublist/2 doesn't seems to work as expected:
?- [library(dialect/sicstus/lists)].
% library(dialect/sicstus/lists) compiled into sicstus_lists 0,00 sec, 14 clauses
true.
?- L=[1,2,3,4,5,6], length(T, 3),sublist(T,L).
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 3] ;
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 4] ;
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 5] ;
....
You could use append/3 instead:
?- L=[1,2,3,4,5,6], length(T, 3), append(_, Q, L), append(T, _, Q).
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 3],
Q = [1, 2, 3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = [2, 3, 4],
Q = [2, 3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = [3, 4, 5],
Q = [3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = Q, Q = [4, 5, 6] ;
false.
I don't think it's very fast, just essential...