Given a term representation of an edge of a graph, i.e.:
edge(a, b).
edge(b, c).
I would like to construct a predicate path/1 which succeeds iff its sole argument is a valid path in this graph (that is, for every two adjacent terms X, Y, edge(X, Y) holds). Given a variable, it should enumerate all walks (which could have repeated nodes). My first try:
path([X, Y]) :- edge(X, Y).
path([X, Y, Z | T]) :-
path([Y, Z | T]),
edge(X, Y).
It works as intended except for the case where it is supplied an acyclic graph - path finds all solutions and then halts, unable to construct any other path. On the other hand, swapping first and second term will result in many walks being skipped, due to the DFS nature of Prolog resolution.
My second attempt:
path(P) :- length(P, L), L >= 2, (path(P, L) *-> true ; (!, fail)).
path([X, Y], 2) :- edge(X, Y).
path([X, Y, Z | T], L) :-
L >= 3,
L1 is L - 1,
edge(X, Y),
path([Y, Z | T], L1).
It works as intended, but using a soft cut feels a bit forced. I was wondering if there was an easier way to accomplish this, perhaps a simpler simulation of a soft cut is possible in this particular scenario?
Testing your first solution, after finding three paths ([a,b],[a,c],[a,b,c]), it loops. One super quick way to avoid this is to use tabling wich is available in XSB, SWI and YAP. In case of SWI just add :- table path/1. as first directive to avoid loops. Otherwise you need to remember all path and there are plenty of answers you can look at (like this).
Given your graph definition:
edge(a, b).
edge(b, c).
Something like ought to do you:
path(P) :-
node(X),
walk(X,_,P)
.
walk(A,B,P) :-
walk(A,B,[],V),
reverse(V,R),
P = [A|R]
.
walk( A, B, T, V ) :-
edge(A,X),
not( member(X,T) ),
(
( B = X , V = [B|T] )
;
walk( X, B, [A|T], V )
)
.
%
% enumerate the distinct nodes in edge/2 via backtracking
%
node(N) :-
setof( X , edge(X,_);edge(_,X) , Ns ),
node( Ns , N )
.
node( [N|_] , N ).
node( [_|Ns] , N ) :- ( Ns , N ).
Related
I like the idea of lazy_findall as it helps me with keeping predicates separated and hence program decomposition.
What are the cons of using lazy_findall and are there alternatives?
Below is my "coroutine" version of the branch and bound problem.
It starts with the problem setup:
domain([[a1, a2, a3],
[b1, b2, b3, b4],
[c1, c2]]).
price(a1, 1900).
price(a2, 750).
price(a3, 900).
price(b1, 300).
price(b2, 500).
price(b3, 450).
price(b4, 600).
price(c1, 700).
price(c2, 850).
incompatible(a2, c1).
incompatible(b2, c2).
incompatible(b3, c2).
incompatible(a2, b4).
incompatible(a1, b3).
incompatible(a3, b3).
Derived predicates:
all_compatible(_, []).
all_compatible(X, [Y|_]) :- incompatible(X, Y), !, fail.
all_compatible(X, [_|T]) :- all_compatible(X, T).
list_price(A, Threshold, P) :- list_price(A, Threshold, 0, P).
list_price([], _, P, P).
list_price([H|T], Threshold, P0, P) :-
price(H, P1),
P2 is P0 + P1,
P2 =< Threshold,
list_price(T, Threshold, P2, P).
path([], []).
path([H|T], [I|Q]) :-
member(I, H),
path(T, Q),
all_compatible(I, Q).
The actual logic:
solution([], Paths, Paths, Value, Value).
solution([C|D], Paths0, Paths, Value0, Value) :-
( list_price(C, Value0, V)
-> ( V < Value0
-> solution(D, [C], Paths, V, Value)
; solution(D, [C|Paths0], Paths, Value0, Value)
)
; solution(D, Paths0, Paths, Value0, Value)
).
The glue
solution(Paths, Value) :-
domain(D),
lazy_findall(P, path(D, P), Paths0),
solution(Paths0, [], Paths, 5000, Value).
Here is an alternative no-lazy-findall solution by #gusbro: https://stackoverflow.com/a/68415760/1646086
I am not familiar with lazy_findall but I observe two "drawbacks" with the presented approach:
The code is not as decoupled as one might want, because there is still a mix of "declarative" and "procedural" code in the same predicate. I am putting quotes around the terms because they can mean a lot of things but here I see that path/2 is concerned with both generating paths AND ensuring that they are valid. Similarly solution/5 (or rather list_price/3-4) is concerned with both computing the cost of paths and eliminating too costly ones with respect to some operational bound.
The "bounding" test only happens on complete paths. This means that in practice all paths are generated and verified in order to find the shortest one. It does not matter for such a small problem but might be important for larger instances. Ideally, one might want to detect for instance that the partial path [a1,?,?] will never bring a solution less than 2900 without trying all values for b and c.
My suggestion is to instead use clpfd (or clpz, depending on your system) to solve both issues. With clpfd, one can first state the problem without concern for how to solve it, then call a predefined predicate (like labeling/2) to solve the problem in a (hopefully) clever way.
Here is an example of code that starts from the same "setup" predicates as in the question.
state(Xs,Total):-
domain(Ds),
init_vars(Ds,Xs,Total),
post_comp(Ds,Xs).
init_vars([],[],0).
init_vars([D|Ds],[X|Xs],Total):-
prices(D,P),
length(D,N),
X in 1..N,
element(X, P, C),
Total #= C + Total0,
init_vars(Ds,Xs,Total0).
prices([],[]).
prices([V|Vs],[P|Ps]):-
price(V,P),
prices(Vs,Ps).
post_comp([],[]).
post_comp([D|Ds],[X|Xs]):-
post_comp0(Ds,D,Xs,X),
post_comp(Ds,Xs).
post_comp0([],_,[],_).
post_comp0([D2|Ds],D1,[X2|Xs],X1):-
post_comp1(D1,1,D2,X1,X2),
post_comp0(Ds,D1,Xs,X1).
post_comp1([],_,_,_,_).
post_comp1([V1|Vs1],N,Vs2,X1,X2):-
post_comp2(Vs2,1,V1,N,X2,X1),
N1 is N+1,
post_comp1(Vs1,N1,Vs2,X1,X2).
post_comp2([],_,_,_,_,_).
post_comp2([V2|Vs2],N2,V1,N1,X2,X1):-
post_comp3(V2,N2,X2,V1,N1,X1),
N3 is N2 + 1,
post_comp2(Vs2,N3,V1,N1,X2,X1).
post_comp3(V2,N2,X2,V1,N1,X1) :-
( ( incompatible(V2,V1)
; incompatible(V1,V2)
)
-> X2 #\= N2 #\/ X1 #\= N1
; true
).
Note that the code is relatively straightforward, except for the (quadruple) loop to post the incompatibility constraints. This is due to the way I wanted to reuse the predicates in the question. In practice, one might want to change the way the data is presented.
The problem can then be solved with the following query (in SWI-prolog):
?- state(Xs, T), labeling([min(T)], Xs).
T = 1900, Xs = [2, 1, 2] ?
In SICStus prolog, one can write instead:
?- state(Xs, T), minimize(labeling([], Xs), T).
Xs = [2,1,2], T = 1900 ?
Another short predicate could then transform back the [2,1,2] list into [a2,b1,c2] if that format was expected.
I want to find the minimum value of all permutations called from main predicate. For simplicity, I have removed my entire code, assume that I just want to find the minimum of head elements of all permutations.
appendlist([], X, X).
appendlist([T|H], X, [T|L]) :- appendlist(H, X, L).
permutation([], []).
permutation([X], [X]) :-!.
permutation([T|H], X) :- permutation(H, H1), appendlist(L1, L2, H1), appendlist(L1, [T], X1), appendlist(X1, L2, X).
%min(X, A, B) X is the minimum of A, B
min(X, X, Y) :- X =< Y.
min(Y, X, Y) :- Y < X.
solve([Head|Rest], Head):-
writeln([Head|Rest]).
main :-
Sort = [1, 2, 3],
PrvAns is 1000,
permutation(Sort, X),
solve(X, Here),
min(Ans, Here, PrvAns),
writeln(Ans),
PrvAns = Ans,
!, fail;
true,
writeln(PrvAns).
I want to calculate the minimum on fly for each permutation. Now, permute is working fine, and you can see that solve prints all permutations and even returns the first value Head properly, but PrvAns = Ans is wrong.
Expected output PrvAns : 1
I'm sorry if I didn't understand properly (and tell me, so I can help you), but, you mean something like this?
findMinHead(X,Z):-
findall( Y, ( permutation(X,[Y|_]) ), Z1 ),
min_list(Z1,Z).
in this predicate we find all the Y values where Y is the head of a permutation of X, put all that values in a bag, and then find the min.
I have a database composed of symptoms of a disease and the disease to which these symptoms belongs as follows.
disease([dordecabeca,febre,dormuscular,dorgarganta,cansaco],gripe).
disease([febre,dordecabeca,dorolhos,manchas,nauseas],dengue).
disease([febre,coceira,dordecabeca,dordebarriga,perdadeapetite],catapora).
disease([febre,dordecabeca,fadiga,perdadeapetite,inchacorosto],caxumba).
disease([congestaonasal,gargantairritada,espirros,febre,tosse],resfriado).
treatment([evitarmedicamentosdeaspirina,respouso],dengue).
treatment([evitarmedicamentosdeaspirina,repouso,paracetamol],dengue).
treatment([repouso,evitarpessoas,semmedicamento],catapora).
treatment([repouso,evitarpessoas,medicamento],catapora).
treatment([repouso,evitarpessoas],caxumba).
treatment([repouso,boaalimentacao],gripe).
treatment([repouso,boalimentacao,medicamentos],gripe).
treatment([repouso,boaalimentacao,semmedicamentos],refriado).
treatment([repouso,boaalimentacao,medicamento],resfriado).
symptoms(L1,X):-disease(L1,X).
treatdisease(L1,L2,Y):-symptoms(L1,Y),treatment(L2,Y).
With the symptons predicate, I can visualize all the symptoms and the corresponding disease. And with the predicate treatdisease, I can see the treatment based on the disease common to the two bases.
symptoms(L1,X):-disease(L1,X).
treatdisease(L1,L2,Y):-symptoms(L1,Y),treatment(L2,Y).
But what if I were to compare an entry list with the underlying disease like I would?
If it was just a list I already have the predicate, but on a multidimensional basis I have no idea how to go.
For example if I came in with:
?searchdisease([dordecabeca,febre,dormuscular,dorgarganta],Disease).
How do I go through the bases using this list with the database?
So I have predicates to pick up the different elements between two lists and a predicate to get the equal elements between two lists, but I do not know how to use them when the list is in a subset. Follow the predicates.
%---------------------------------------------------------
%Predicate to pick up equal elements between two lists.
equalelements([],[]).
equalelements([X|Xs0],Ys0) :-
tpartition(=(X),Xs0,Es,Xs),
if_(Es=[], Ys0=Ys, Ys0=[X|Ys]),
equalelements(Xs,Ys).
tpartition(P_2,List,Ts,Fs) :-
tpartition_ts_fs_(List,Ts,Fs,P_2).
tpartition_ts_fs_([],[],[],_).
tpartition_ts_fs_([X|Xs0],Ts,Fs,P_2) :-
if_(call(P_2,X), (Ts = [X|Ts0], Fs = Fs0),
(Ts = Ts0, Fs = [X|Fs0])),
tpartition_ts_fs_(Xs0,Ts0,Fs0,P_2).
if_(If_1, Then_0, Else_0) :-
call(If_1, T),
( T == true -> call(Then_0)
; T == false -> call(Else_0)
; nonvar(T) -> throw(error(type_error(boolean,T),_))
; /* var(T) */ throw(error(instantiation_error,_))
).
=(X, Y, T) :-
( X == Y -> T = true
; X \= Y -> T = false
; T = true, X = Y
; T = false,
dif(X, Y) % ISO extension
% throw(error(instantiation_error,_)) % ISO strict
).
equal_t(X, Y, T):-
=(X, Y, T).
%------------------------------------------------------------
%Predicate to pick up different elements between two lists.
displaydifference([],[],[]).
displaydifference(L1,L2,L4):-concatenate(L1,L2,L3), remove_dups(L3,L4).
concatenate(L1, L2, NL) :-
append(L1, L2, L12),
msort(L12, NL).
remove_dups([], []).
remove_dups([X], [X]).
remove_dups([X,Y|T], [X|R]) :-
X \= Y,
remove_dups([Y|T], R).
remove_dups([X,X|T], R) :-
skip(X, T, WithoutX),
remove_dups(WithoutX, R).
skip(_,[],[]).
skip(X, [X|T], T).
skip(X, [Y|T], [Y|T]) :- X \= Y.
Not sure to understand what do you exactly want obtain with searchdisease/2.
I suppose that you want a predicate that, given a list of symptoms, unifies the second parameter with one or more diseases with symptoms that are a superset of the first parameter.
In that case, I propose
subList([], _).
subList([H | T], S) :-
member(H, S),
subList(T, S).
searchdisease(Symptoms, Disease) :-
disease(Ls, Disease),
subList(Symptoms, Ls).
If you call searchdisease([dordecabeca,febre,dormuscular,dorgarganta],Disease), you unify Disease with gripe because [dordecabeca,febre,dormuscular,dorgarganta] is a subset of the symptoms of gripe.
If you call searchdisease([febre],D), you unify D with gripe and, trying again with backtracking, dengue, catapora, caxumba and resfriado, because febre is a symptom of all of this five diseases.
En passant: I don't understand the usefulness of symptoms/2; why don't you simply use disease/2?
how can i simulate this code in Prolog?
// L = an existing list ;
// function foo(var X, var Y)
result = new List();
for(int i=0;i<L.length;i++)
for(int j=0;j<L.length;j++){
result.add(foo(L.get(i), L.get(j));
}
nested loops are basically joins between sequences, and most of lists processing in Prolog is best expressed without indexing:
?- L=[a,b,c], findall(foo(X,Y), (member(X,L),member(Y,L)), R).
L = [a, b, c],
R = [foo(a, a), foo(a, b), foo(a, c), foo(b, a), foo(b, b), foo(b, c), foo(c, a), foo(c, b), foo(..., ...)].
edit
Sometime integers allow to capture the meaning in a simple way. As an example, my solution for one of the easier of Prolog context quizzes.
icecream(N) :-
loop(N, top(N)),
left, loop(N+1, center), nl,
loop(N+1, bottom(N)).
:- meta_predicate loop(+, 1).
loop(XH, PR) :-
H is XH,
forall(between(1, H, I), call(PR, I)).
top(N, I) :-
left, spc(N-I+1), pop,
( I > 1
-> pop,
spc(2*(I-2)),
pcl
; true
),
pcl, nl.
bottom(N, I) :-
left, spc(I-1), put(\), spc(2*(N-I+1)), put(/), nl.
center(_) :- put(/), put(\).
left :- spc(4).
pop :- put(0'().
pcl :- put(0')).
spc(Ex) :- V is Ex, forall(between(1, V, _), put(0' )).
Running in SWI-Prolog:
?- icecream(3).
()
(())
(( ))
/\/\/\/\
\ /
\ /
\ /
\/
true.
?- forall(loop(3,[X]>>loop(2,{X}/[Y]>>writeln(X-Y))),true).
1-1
1-2
2-1
2-2
3-1
3-2
true.
You can define a forto/4 meta-predicate easily. An example, taken from the Logtalk library loop object:
:- meta_predicate(forto(*, *, *, 0)).
forto(Count, FirstExp, LastExp, Goal) :-
First is FirstExp,
Last is LastExp,
forto_aux(Count, First, Last, 1, Goal).
:- meta_predicate(forto_aux(*, *, *, *, 0)).
forto_aux(Count, First, Last, Increment, Goal) :-
( First =< Last ->
\+ \+ (Count = First, call(Goal)),
Next is First + Increment,
forto_aux(Count, Next, Last, Increment, Goal)
; true
).
Example goal:
?- loop::forto(I, 1, 2, loop::forto(J, 1, 3, (write(I-J), nl))).
1-1
1-2
1-3
2-1
2-2
2-3
true.
Some Prolog compilers also provide built-in or library support for "logical loops" with good expressive power. Examples are (in alphabetic order) B-Prolog, ECLiPSe, and SICStus Prolog. Check the documentation of those systems for details. If you need a portable solution across most Prolog systems, check Logtalk's library documentation. Or simply take the above examples and define your own loop meta-predicates.
you can use this predicate using SICStus-prolog for looping variables I,J until N and get all of them inside fact foo/2 mentioned below successively ;
Code
loop(N) :- for(I,0,N),param(N) do
for(J,0,N),param(I) do
write(foo(I,J)),nl.
Result
| ?- loop(2).
foo(0,0)
foo(0,1)
foo(0,2)
foo(1,0)
foo(1,1)
foo(1,2)
foo(2,0)
foo(2,1)
foo(2,2)
yes
I need help reversing a list.
fun(a, [b, d]).
fun(b, [c]).
fun(c, []).
fun(d, [e]).
fun(e, [f]).
fun(f, [g]).
fun(g, []).
xyz(X, Y):-
fun(X, Z) -> findall([A|B], (member(A, Z), xyz(A, B)), L),
flatten(L, F), sort(F, Y); Y = [].
The query xyz(a,X). gives me X = [b,c,d,e,f,g].
However, I would like it to give me X = [g,f,e,d,c,b].
I have tried different attempts at reversing the list, but I am not having any luck.
I have tried adding an additional predicate right after this, but it didn't work either:
xyz2(X,Y):-
xyz(X,Y),
reverse(Y,Z),
Z\=0.
Credit goes to CapelliC for the approach to the implementation above found at my other post here.
Recursion in PROLOG?
You can avoid some difficult programming, and make your program easier to read by re-defining your problem. Say the f/2 describes a directed graph, with edges from the first argument to each of the elements in the second argument, so:
a ---> b
a ---> d
b ---> c
% etc
Then, your question is, which nodes in the graph are reachable from a given node? You can define the solution with the help of library(ugraphs).
To make all edges from an f/2:
edge(From-To) :-
f(From, L),
member(To, L).
You can now collect the edges, make a graph, and find which nodes are reachable from a starting node:
foo(X, L) :-
findall(E, edge(E), Edges),
vertices_edges_to_ugraph([], Edges, G),
reachable(X, G, All),
once(select(X, All, R)), % remove the node you start from
reverse(R, L).
Per definition, a node is always reachable from itself, so you need to pick it out of the list of reachable nodes.
?- foo(a, X).
X = [g, f, e, d, c, b].
?- foo(e, X).
X = [g, f].
?- foo(g, X).
X = [].
I don't exactly understand why the order of the elements is significant. This feels a bit like a code smell.