SICStus Prolog: Find all solutions - prolog

Is there a way one can show all solutions and/or find how many there are in SICSTus prolog? For instance, the code below maybe used to solve the map colouring problem.
:- use_module(library(clpfd)).
solve_AUSTRALIA(WA,NT,Q,SA,NSW,V):-
domain([WA,NT,Q,SA,NSW,V], 1, 4),%colours represented by integers from 1 to 4
WA #\= NT,
WA #\= SA,
NT #\= SA,
NT #\= Q,
SA #\= Q,
SA #\= NSW,
SA #\= V,
Q #\= NSW,
NSW #\= V,
labeling([],[WA,NT,Q,SA,NSW,V]).
At the moment,I am typing ; every time to see further solutions till Prolog says no. Is there a way I can tell prolog to show all solutions at once, or better, a way I can find how many there. Like prolog tells me there are five solutions to the problem.

The following is for counting the number of answers. When you ask a query or execute a predicate, what you get back from Prolog are answers. Sometimes these answers are solutions, may contain more than one solution, infinitely many solutions, and sometimes even no solution at all.
The simplest way to go is to say findall(t, Goal_0, Ts), length(Ts, N). The only disadvantage is that this requires space proportional to the number of answers counted.
If you want to go one step further you need some kind of counter. Currently in SICStus 4.3.3 you can do this like so:
:- meta_predicate count_answers(0, ?).
:- meta_predicate count_answers1(0, +, ?). % internal
:- use_module(library(types),[must_be/4]).
:- use_module(library(structs),
[new/2,
dispose/1,
get_contents/3,
put_contents/3]).
count_answers(G_0, N) :-
( nonvar(N)
-> must_be(N, integer, count_answers(G_0, N), 2)
; true
),
new(unsigned_64, Ref),
call_cleanup(count_answers1(G_0, Ref, N), dispose(Ref) ).
count_answers1(G_0, Ref, N) :-
( call(G_0),
get_contents(Ref, contents, N0),
N1 is N0+1,
put_contents(Ref, contents, N1),
fail
; get_contents(Ref, contents, N)
).
See this answer how counters can be implemented in other systems. Example use:
| ?- count_answers(member(_,"abcde"),Ans).
Ans = 5 ? ;
no

Is there a way I can tell Prolog to show all solutions at once
This part of your question is related to the prolog-toplevel. In Prolog IV all answers (not necessarily solutions) were shown by default. The top level loop of a couple of Prolog systems permits to enter a to see all answers at once:
GNU-Prolog (originator)
Trealla-Prolog
Scryer-Prolog

Related

Prolog how to count the number of facts without using a built in

Given a number of facts is there a way to count them without using a built in function I have tried doing so with the below code but could no get it work. I hope someone can help me out.
For example the following facts:
stops(jubilee,bondstreet,1).
stops(jubilee,waterloo,2).
stops(jubilee,bakerstreet,3).
The code have got so far is:
findStops(X) :- stops(X,_, N), N1 is N+1, stopsX,_,N1).
I would like to make it so that N1 is the counter of how stops the jubilee line has.
A simple solution would be to count the number of stops/3 facts that have the atom jubilee in the first argument. Assuming all clauses for the stops/3 predicate have a bound first argument, you could write:
?- findall(1, stops(jubilee,_,_), List), length(List, Count).
In this query, findall/3 is a standard Prolog predicate and length/2 is a de facto standard predicate, usually available as a built-in predicate or as a library predicate.
Can you convert this query into a predicate that takes the station as an argument (instead of a hardcoded station as jubilee) and returns the count for that station?
The question isn't totally clear since it hasn't been defined what is allowed in terms of "built in" predicates. Such a problem cannot be solved without using some kind of predefined predicate.
Here are a couple of other ideas.
Using assertz and retract:
count_stops(Count) :-
assertz(num_stops(0)),
count_stops_aux(Count).
count_stops_aux(_) :-
stops(_, _, _),
retract(num_stops(C)),
C1 is C + 1,
assertz(num_stops(C1)),
fail.
count_stops_aux(Count) :-
retract(num_stops(Count)).
You could also probably do something similar with SWI Prolog's b_setval/2 and b_getval/2.
Here's a recursive solution that uses a list to check whether we've counted a particular fact already:
count_stops(Count) :-
count_stops_aux([], 0, Count).
count_stops_aux(L, Count, Total) :-
stops(A, B, C),
\+ member(stops(A,B,C), L),
C is Count + 1,
count_stops_aux([stops(A,B,C)|L], C, Total), !.
count_stops_aux(_, Total, Total).
Or similarly, but using length/2 as well:
count_stops(Count) :-
count_stops_aux([], Facts),
length(Facts, Count).
count_stops_aux(L, Facts) :-
stops(A, B, C),
\+ member(stops(A,B,C), L),
count_stops_aux([stops(A,B,C)|L], Facts), !.
count_stops_aux(Facts, Facts).
The first solution will count redundant facts (if an identical fact exists more than once), and assertz and retract are slow operations. The second and third solutions won't count redundant facts, but are really just clunky, verbose versions of Paulo's solution to avoid using findall. This is all why Prolog has predicates such as findall/3 and bagof/3.

Counting the number of elements in a list: how affectation works

I was working on a Prolog problem consisting in counting the number of elements of a list:
count([], 0).
count([H|T], N) :-
count(T, X),
N is X+1,
N > 0.
I can understand why it's written like that but I don't understand why we can't replace N is X+1 by X is N-1 ?
Thanks a lot!
Your question is very legitimate, +1.
The reason for this seemingly arbitrary choice is that (is)/2 is a comparatively low-level predicate and only works in very specific cases that can only be understood procedurally, not declaratively. Therefore, (is)/2 is extremely hard to understand for beginners and should better be avoided because it destroys many relational properties we want to enjoy when using Prolog.
The declarative solution is to use constraints, where you can do exactly what you say. For relations over integers, simply replace (is)/2 by (#=)/2 to enjoy the relational properties you intuitively expect.
For example, using GNU Prolog:
count([], 0).
count([_|Ls], N) :-
count(Ls, X),
X #= N - 1,
N #> 0.
In other systems like SICStus Prolog and SWI, you currently still need to use library(clpfd) for this. In addition, I highly recommend a more declarative name for this relation, making clear which argument denotes what:
:- use_module(library(clpfd)).
list_length([], 0).
list_length([_|Ls], N) :-
list_length(Ls, X),
X #= N - 1,
N #> 0.
Sample queries:
?- list_length([_,_,_], N).
N = 3.
?- list_length(Ls, 2).
Ls = [_G602, _G605] .
I leave improving the termination properties of this predicate as an easy exercise.

How to find useless states in a finite state machine Prolog

I have been thinking of a solution for finding all the useless states defined in a particular automaton and I know that one approach is to start moving from the start state and then ask for the following state all of these stored in the Prolog predicate database. I have had no luck in writing the code very well because I am learning Prolog. I wish someone could help me out with this. Here I leave what I have.
The finite state machine structure. fa_start -> the initial state, fa_move -> the valid move from one state to another, fa_final -> the final state.
% Start State
:- assert(fa_start(fa_1, s_0)).
% Final States
:- assert(fa_final(fa_1, s_5)).
:- assert(fa_move(fa_1, s_0, s_1, a)).
:- assert(fa_move(fa_1, s_1, s_4, b)).
:- assert(fa_move(fa_1, s_0, s_2, c)).
:- assert(fa_move(fa_1, s_2, s_4, d)).
:- assert(fa_move(fa_1, s_2, s_5, e)).
:- assert(fa_move(fa_1, s_0, s_3, f)).
:- assert(fa_move(fa_1, s_3, s_5, g)).
:- assert(fa_move(fa_1, s_6, s_3, h)).
:- assert(fa_move(fa_1, s_6, s_7, i)).
:- assert(fa_move(fa_1, s_7, s_8, j)).
Now, here is the code I have been writing. The idea is to start with fa_start and then keep moving using valid fa_move until it cannot reach fa_final.
adjacent(fa, N, M):-
fa_move(fa, N, M, _).
adjacent_recursive(fa, N, L):-
fa_start(fa, N),
findall(l,adjacent(fa,N,_),L).
find_paths(fa):-
adjacent_recursive(fa,s_0,_).
Thank you in advance for all the help.
I know it's difficult to find accurate information related to my specific question. I have been working on it and finally found a solution, may it not be the best, but makes the deal. I owe the idea to this site. If you find bugs, it'd be welcome.
Now, the following code prints the useless states given a finite state automata implemented as above.
find_useless_states(FA):- retractall(utiles(_)),retractall(visited(_)),
forall(fa_final(FA,S),assert(utiles(S))),
find_useless_states2(FA).
find_useless_states2(FA):- retract(utiles(S)),
not(visited(S)), assert(visited(S)),
forall((fa_move(FA,Y,S,_), not(visited(Y))),(asserta(utiles(Y)))),
find_useless_states2(FA).
find_useless_states2(_).
difference(L1, L2, R) :- intersection(L1, L2, I),
append(L1, L2, All),
subtract(All, I, R).
find_all_states_as_list(FA,L):- findall(X,fa_move(FA,X,_,_),M),findall(Y,fa_move(FA,_,Y,_),N),merge(M,N,LL),sort(LL,L).
find_useful_states_as_list(L):- findall(X,visited(X),L).
print_useless_states(FA):- find_all_states_as_list(FA,L),find_useful_states_as_list(M), difference(L,M,R), length(R,D),write(R),nl,write(D).
Hope it helps other people. Some code ideas have been used from questions posted here in stackoverflow. I thank the people who answered those.
It is possible to use the dynamic database for all such things, but it easily gets very difficult to maintain. I'd rather compile the file with your definitions, thus avoid to perform assertz/1 manually.
uselessstate(Aut, Usl) :-
setof(S0, S^( closure0(adjacent(Aut), S0,S), fa_final(Aut,S) ), S0s),
setof(t, A^B^( adjacent(Aut, A,B), (Usl=A;Usl=B) ), _),
non_member(Usl, S0s).
unreachable(Aut, Usl) :-
setof(S, S0^( fa_start(Aut, S0), closure0(adjacent(Aut), S0,S) ), Ss),
setof(t, A^B^( adjacent(Aut, A,B), (Usl=A;Usl=B) ), _),
non_member(Usl, Ss).
The definition of closure0/3 and non_member/2 is found in another answer.

How to prevent Prolog from backtracking where it shouldn't

I'm trying to solve a CSP where I need to distribute cocktails over bartenders so that each bartender has at most one cocktail and all cocktails are given a bartender. I solved it by creating a list of clpfd variables,first giving them the full domain of all bartenders and then removing all bartenders that don't know how to make that cocktail.
My code works, but there is one problem: it's too slow. If I look in the profiler, remove_domain gets called 2000 times(for the input I'm giving my program), while it's Redo statistic is >100 000.
What do I need to change in one of these functions(or both) so that prolog doesn't need to backtrack?
produce_domains(_,_,[],[]) :- !.
produce_domains(Bartenders,NBartenders,[Cocktail|Cocktails],[Var|Vars]) :-
Var in 1..NBartenders,
remove_domain(Bartenders,NBartenders,Cocktail,Var),!,
produce_domains(Bartenders,NBartenders,Cocktails,Vars),!.
remove_domain([],0,_,_) :- !.
remove_domain([Bartender|Bartenders],NBartenders,Cocktail,Var) :-
(\+ member(Cocktail,Bartender) -> Var #\= NBartenders;!),!,
NNBartenders is NBartenders - 1,
remove_domain(Bartenders,NNBartenders,Cocktail,Var),!.
I have already read this related question, but I am using the latest Windows build of SWI-Prolog(5.10.5), so that shouldn't be the problem here.
You do not need so many !/0: Prolog can often tell that your predicates are deterministic.
Let me first offer the following version of your code. It uses names that are more relational, contains no !/0 and uses higher-order predicates to make the code shorter.
:- use_module(library(clpfd)).
bartenders_cocktails_variables(Bs, Cs, Vs) :-
length(Bs, LBs),
maplist(bartenders_cocktail_variable(Bs, LBs), Cs, Vs).
bartenders_cocktail_variable(Bs, N, C, V) :-
V in 1..N,
foldl(compatible_bartender(C,V), Bs, 1, _).
compatible_bartender(C, V, Cs, N0, N1) :-
( member(C, Cs) -> true
; V #\= N0
),
N1 #= N0 + 1.
Notice that I am counting upwards instead of downwards to enumerate the bartenders (which are just lists of cocktails they are able to mix), since this seems more natural. I was also able to omit a (\+)/1 by simply switching the branches of the if-then-else.
Example query, showing that the predicate is deterministic in this use case:
?- bartenders_cocktails_variables([[a,b],[a,b],[x,y]], [x,a,b], Vars).
Vars = [3, _G1098, _G1101],
_G1098 in 1..2,
_G1101 in 1..2.
We see: Cocktail x must be mixed by the third bartender etc.
I think this part of your program may not be responsible for the slow performance you are describing. Maybe other parts of your program are (unintentionally) not deterministic? Maybe try different labeling strategies or other constraints? We may be able to help you more if you post more context.

Predicate that succeeds if two or more results are returned

How to implement rule1 that succeeds iff rule2 returns two or more results?
rule1(X) :-
rule2(X, _).
How can I count the results, and then set a minimum for when to succeed?
How can I count the results, and then set a minimum for when it's true?
It is not clear what you mean by results. So I will make some guesses. A result might be:
A solution. For example, the goal member(X,[1,2,1]) has two solutions. Not three. In this case consider using either setof/3 or a similar predicate. In any case, you should first understand setof/3 before addressing the problem you have.
An answer. The goal member(X,[1,2,1]) has three answers. The goal member(X,[Y,Z]) has two answers, but infinitely many solutions.
So if you want to ensure that there are at least a certain number of answers, define:
at_least(Goal, N) :-
\+ \+ call_nth(Goal, N).
with call_nth/2 defined in another SO-answer.
Note that the other SO-answers are not correct: They either do not terminate or produce unexpected instantiations.
you can use library(aggregate) to count solutions
:- use_module(library(aggregate)).
% it's useful to declare this for modularization
:- meta_predicate at_least(0, +).
at_least(Predicate, Minimum) :-
aggregate_all(count, Predicate, N),
N >= Minimum.
example:
?- at_least(member(_,[1,2,3]),3).
true.
?- at_least(member(_,[1,2,3]),4).
false.
edit here is a more efficient way, using SWI-Prolog facilities for global variables
at_least(P, N) :-
nb_setval(at_least, 0),
P,
nb_getval(at_least, C),
S is C + 1,
( S >= N, ! ; nb_setval(at_least, S), fail ).
with this definition, P is called just N times. (I introduce a service predicate m/2 that displays what it returns)
m(X, L) :- member(X, L), writeln(x:X).
?- at_least(m(X,[1,2,3]),2).
x:1
x:2
X = 2.
edit accounting for #false comment, I tried
?- call_nth(m(X,[1,2,3]),2).
x:1
x:2
X = 2 ;
x:3
false.
with call_nth from here.
From the practical point of view, I think nb_setval (vs nb_setarg) suffers the usual tradeoffs between global and local variables. I.e. for some task could be handly to know what's the limit hit to accept the condition. If this is not required, nb_setarg it's more clean.
Bottom line: the better way to do would clearly be using call_nth, with the 'trick' of double negation solving the undue variable instantiation.

Resources