Cycle route program in prolog - prolog

I have created a program in prolog which should give me all possible routes between two stations. In each route each station should only get visited once. My code so far is:
% facts
connection(s1,s2).
connection(s1,s4).
connection(s2,s3).
connection(s2,s5).
connection(s3,s4).
connection(s4,s5).
connection(s5,s6).
connection(s6,s1).
% predicates
direction1(X,Y) :- connection(X,Y).
direction2(X,Y) :- connection(Y,X).
route1(X,Y,R):- route1(X,Y,[],R).
route1(X,Y,_,[X,Y]) :- direction1(X,Y).
route1(X,Y,L,R) :- \+direction1(X,Y), direction1(X,Z), \+member(Z,L), route1(Z,Y,[Z|L],RZ), R=[X|RZ].
route2(X,Y,R):- route2(X,Y,[],R).
route2(X,Y,_,[X,Y]) :- direction2(X,Y).
route2(X,Y,L,R) :- \+direction2(X,Y), direction2(X,Z), \+member(Z,L), route2(Z,Y,[Z|L],RZ), R=[X|RZ].
route(X,Y,R) :- route1(X,Y,R); route2(X,Y,R).
The problem is that prolog doesn't give me all routes, for exampel when I ask for route[s1,s4,R], prolog doesn't give me the route [s1,s2,s3,s4]. I think it is caused by "+direction1(X,Y)" and "+direction2(X,Y)". But I need this to prevent prolog visiting a station multiple times in a route. Any ideas how to fix this?
Thanks in advance!

A minimally invasive fix would be to remove the \+direction1(X,Y) that you correctly identified as the source of this failure, and to add another \+ member(X, L) guard in the definition of route1/4.
EDIT: The above does not suffice. Here is a cleaner rewrite of the whole thing, with more readable formatting and variable names:
route1(X,Y,R):- route1(X,Y,[X],R). % note that X is visited immediately
route1(X,Y,_,[X,Y]) :- direction1(X,Y).
route1(X, Y, Visited, Route) :-
direction1(X, Z),
Z \= Y,
\+ member(Z, Visited),
route1(Z, Y, [Z|Visited], Route1),
Route = [X|Route1].
You should then probably unify the two variants of the route predicates: One of them only finds routes that are only along "direction 1" edges and the other only the ones along "direction 2" edges. In general, you will want to be able to traverse any edge in any direction.

Related

List processing calculation in Prolog to find a destination friends will visit

I'm trying to write a predicate that calculates which destination a group of friends will visit.
The friends list their countries of preferences like this
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
I want to write a predicate called where that takes 2 arguments to perform the calculation.
The formula I have in mind is that the first country is worth 3 points, the second one is worth 2 points, and the last one is worth 1 point.
Here's an example of what I'm trying to achieve.
?- where([marie,jean,sasha,helena,emma],Country).
peru .
So far I have this
where([], X).
where([H|T], N) :- choice(H, [A|B]), where(T,N).
It lets me iterate through all the different friends and shows their choices but I can't iterate through the list of choices and assign points to the destinations.
How should I go about iterating through the list of choices for each friend and assigning points to calculate the best destination?
While this will solve your problem, I know it uses many predicates that you have not seen. So think of this an opportunity to excel and learn a lot.
Even if you don't understand it all, there is enough detail and intermediate results in the test that you should be able to navigate your way to a proper solution you create.
Also this is by no means efficient, it was just a quick proof of concept I did to see how this could be done.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
destinations(Destinations) :-
findall(D1,choice(_,D1),D2),
flatten(D2,D3),
list_to_set(D3,Destinations).
init_weights(Destinations,Weights) :-
empty_assoc(Assoc),
init_weights(Destinations,Assoc,Weights).
init_weights([],Weights,Weights).
init_weights([H|T],Assoc0,Weights) :-
put_assoc(H,Assoc0,0,Assoc1),
init_weights(T,Assoc1,Weights).
update_weights([C1,C2,C3],Weights0,Weights) :-
del_assoc(C1,Weights0,Value0,Weights1),
Value1 is Value0 + 3,
put_assoc(C1,Weights1,Value1,Weights2),
del_assoc(C2,Weights2,Value2,Weights3),
Value3 is Value2 + 2,
put_assoc(C2,Weights3,Value3,Weights4),
del_assoc(C3,Weights4,Value4,Weights5),
Value5 is Value4 + 1,
put_assoc(C3,Weights5,Value5,Weights).
person_weight(Person,Weights0,Weights) :-
choice(Person,[C1,C2,C3]),
update_weights([C1,C2,C3],Weights0,Weights).
people(People) :-
findall(Person,choice(Person,_),People).
choice(Destination) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights1),
cross_ref_assoc(Weights1,Weights),
max_assoc(Weights, _, Destination),
true.
cross_ref_assoc(Assoc0,Assoc) :-
assoc_to_list(Assoc0,List0),
maplist(key_reverse,List0,List),
list_to_assoc(List,Assoc).
key_reverse(Key-Value,Value-Key).
update_choices([],Weights,Weights).
update_choices([Person|People],Weights0,Weights) :-
person_weight(Person,Weights0,Weights1),
update_choices(People,Weights1,Weights).
Tests
:- begin_tests(destination).
test(destinations) :-
destinations([peru, greece, vietnam]).
test(init_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights),
assoc_to_list(Weights,[greece-0, peru-0, vietnam-0]).
test(update_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
update_weights([peru,greece,vietnam],Weights0,Weights),
assoc_to_list(Weights,[greece-2,peru-3,vietnam-1]).
test(person_weight) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
person_weight(jean,Weights0,Weights),
assoc_to_list(Weights,[greece-3,peru-2,vietnam-1]).
test(people) :-
people([marie,jean,sasha,helena,emma]).
test(update_choices) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights),
assoc_to_list(Weights,[greece-10,peru-12,vietnam-8]).
test(cross_ref_assoc) :-
List0 = [1-a,2-b,3-c],
list_to_assoc(List0,Assoc0),
cross_ref_assoc(Assoc0,Assoc),
assoc_to_list(Assoc,[a-1,b-2,c-3]).
test(choice) :-
choice(peru).
:- end_tests(destination).
As suggested by GuyCoder, you need an accumulator to sum each person preferences, and foldl/N allows to does exactly this.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
where(People,Where) :-
foldl([Person,State,Updated]>>(choice(Person,C),update(State,C,Updated)),
People,
[0=greece,0=peru,0=vietnam],
Pref),
aggregate(max(S,S=W),member(S=W,Pref),max(_,_=Where)).
% sort(Pref,Sorted),
% last(Sorted,_=Where).
update(S0,[A,B,C],S3) :-
update(S0,3,A,S1),
update(S1,2,B,S2),
update(S2,1,C,S3).
update(L,V,C,U) :-
append(X,[Y=C|Z],L),
P is Y+V,
append(X,[P=C|Z],U).
I have left commented the last two goals replaced by the single goal aggregate/3, so you can try to understand the syntax...

How to write a Prolog program

I don't know how to write a Prolog program for the following scenario.
1. If any two person having same hobby then they like each other.
2. Every gardener likes the Sun.
I did this but I don't know whether it is correct or not.
like(gardener,sun).
Please help me to solve it.
Prolog rules follow the "reversed-IF" template:
Head :- Goal1, ..., GoalN.
means (roughly), "Head holds if Goal1, ..., GoalN all hold".
Put the other way around it means, "if Goal1, ..., GoalN all hold, then Head also holds".
This fits exactly your first sentence, thus it can be encoded as a rule:
likes(A, B) :- % Head :-
hobby( A, HobbyA), % Goal1,
hobby( B, HobbyB), % Goal2,
same( HobbyA, HobbyB), % Goal3,
dif( A, B). % Goal4.
% different persons, not the same one
The second sentence too fits the same template:
likes(A, sun) :-
isA(A, gardner).
With the most natural encoding of isA( X, Y) as simply a unification X = Y, this becomes equivalent to the fact that you wrote. Facts are rules with no body.

Easy prolog queries

I am very new to prolog and although I’ve read some books I can definitely tell that my programming brain can’t think the Prolog way. The problem I would like to solve is pretty simple (I believe). I will describe it via an example.
Let’s say that I have a graph that contains 4 “types” of nodes and 3 edges that connect the nodes. The types can be A, B, C or D and as you can see from the image below (see Figure 1), A can be connected with B and C (A_To_B and A_To_C edges respectively), while C can be connected to D (C_To_D edge). There’s also an additional rule not shown on the picture: A can be connected to at most 1 C.
I would like to express these simple rules in Prolog to solve the problem shown in the second picture. There are 3 nodes which type is missing (labeled X?, Y? and Z?). By applying the above rules in my mind I can easily find that X? and Z? are of B type (as A can connect to no more than 1 Cs) and Y? is of type D as C can only connect to D.
Could please provide me any help on that? I am not writing just to pick the solution. I would like to learn Prolog as well so any suggestion on a book that explains Prolog to people who have never worked on such concepts before like me would be very welcome.
EDIT: Example that fails
I came up with the following two examples:
For example 1, the rules are
can_connect(a,b,_).
can_connect(a,c,1).
link(1,2).
type(1,a).
type(2,_).
The possible solutions returned are [b,c] which is correct as we request at most 1 link from A to C meaning that 0 links is also acceptable.
In example 2 the rules change to the following:
can_connect(a,b,_).
can_connect(a,c,**2**).
link(1,2).
link(1,3).
type(1,a).
type(2,_).
type(3,c).
Running the code here returns [c] which is wrong. b is also an acceptable solution as we require again at most 2 A to C links which means that having only 1 is OK.
I spent this weekend trying to figure out the solution. First of all, I believe that it works as intended in Example 1 simply because there's no link from A to C instantiated in the proposed solution (where checking if 2 can be b), so the can_connect(a,c,1) is not checked so the proposed solution is getting accepted. In Example 2, there's one A to C link already there so the can_connect(a,c,2) is checked and the solution where node 2 has type b is rejected as the rule checks if there are exactly 2 and not at most 2 links from A to C.
I find a solution which works at these scenarios but fails at some others. Here it is:
% value #3 is the lower bound and #4 is the upper bound.
can_connect(a,b,0,500).
% A C node can be connected by 0, 1 or 2 A nodes
can_connect(a,c,0,2).
can_connect(d,c,1,1).
can_connect(c,e,0,1).
%The same as previous solution
link(1,2).
link(1,3).
% No change here
type(1,a).
type(2,_).
type(3,c).
% No change here
node_type(N, NT) :-
type(N, NT),
nonvar(NT),
!. % assume a node has only one type
% No change here
node_type(N, NT) :-
assoc_types(Typed),
maplist(check_connections(Typed), Typed),
memberchk(N:NT, Typed).
% No change here
assoc_types(Typed) :-
findall(N, type(N, _), L),
maplist(typed, L, Typed).
% No change here
typed(N, N:T) :-
type(N, T),
member(T, [a,b,c]).
% Changes here
check_connections(Graph, N:NT) :-
forall(link(N, M), (
memberchk(M:MT, Graph),
can_connect(NT, MT, L, U),
findall(X, (link(N, X), memberchk(X:MT, Graph)), Ts),
mybetween(L, U, Ts),
forall(can_connect(NT, Y, LM, UM), (
findall(P, (link(N,P),memberchk(P:Y, Graph)), Ss),
length(Ss, SsSize ),
SsSize>=LM,
SsSize=<UM
))
)).
% It is used to find if the length of a list is between two limits.
mybetween(Lower, Upper, MyList) :-
length(MyList, MySize),
MySize=<Upper,
MySize>=Lower.
This solution fails in this example
In this example, X? must be always b, Y? must always be C and Z? must always be D. It finds X? and Y? correctly but not Z?. I believe after some debugging that this is due the fact that in the current implementation I only check the can_connect rules that are related with links that start from a node and not that end to a node. However, I am not sure at all about that.
Any help is appreciated.
the representation of the problem needs to disambiguate nodes names, so we can express the links appropriately
now we can write
can_connect(a,b,_).
can_connect(a,c,1).
can_connect(c,d,_).
link(1,2).
link(1,3).
link(1,4).
link(4,5).
link(4,6).
link(7,4).
link(7,8).
type(1,a).
type(2,b).
type(3,_).
type(4,c).
type(5,d).
type(6,_).
type(7,a).
type(8,_).
The underscore (anonymous variable) in Prolog plays a role similar to NULL in SQL, it can assume any value.
So, a first snippet
node_type(N, NT) :- type(N, NT), nonvar(NT), !. % assume a node has only one type
can be used to express what we know about the problem.
Facts can_connect/3 then can be read like
a can connect to any number of b
a can connect to just 1 c
etc
Where we don't know the node type, a complex rule is needed, that infers the type of source node from the type of target node, and accounts for the counting constraint, something like
node_type(N, NT) :-
link(M, N),
type(M, MT),
can_connect(MT, NT, C),
aggregate(count, Y^(link(M, Y), type(Y, NT)), C).
?- forall(between(1,8,N), (node_type(N,T),writeln(N:T))).
1:a
2:b
3:b
4:c
5:d
6:d
7:a
8:b
true.
edit if your Prolog doesn't have library(aggregate), from where aggregate/3 has been loaded, you can try
node_type(N, NT) :-
link(M, N),
type(M, MT),
can_connect(MT, NT, C),
findall(t, (link(M, Y), type(Y, NT)), Ts), length(Ts, C).
edit first of all, the updated graph, marked with types where known:
my previous code worked only under very restricted assumptions. Here is something more general, that checks the constraints over the full graph (as was suggested by #false comment), with a 'generate and test' approach.
node_type(N, NT) :-
assoc_types(Typed),
maplist(check_connections(Typed), Typed),
memberchk(N:NT, Typed).
assoc_types(Typed) :-
findall(N, type(N, _), L),
maplist(typed, L, Typed).
typed(N, N:T) :- type(N, T), member(T, [a,b,c,d]).
check_connections(Graph, N:NT) :-
forall(link(N, M), (
memberchk(M:MT, Graph),
can_connect(NT, MT, C),
aggregate(count, X^(link(N, X), memberchk(X:MT, Graph)), C)
)).
now ?- node_type(4,X). fails...

Route goes infinite loop prolog

Just begin for prolog and have a practice for route question
train(a,b).
train(b,a).
train(b,c).
train(c,b).
route(X,Y,[]) :-
train(X,Y)
; train(Y,X).
route(X,Y,[H|T]) :-
route(X,H,[]),
route(H,Y,T).
by doing this route/3 The first rule give two direct connected places an empty set states that there is a route. Second rule states the case where there are intermediate places to reach from one to another. but when I query this and I got a loop route.
Someone said to have a helper predicate visited_route/4 to keep track of the places already visited, but don't know how this way works. Hints or example would be help.
The problem with your current solution is that the Prolog solver generates infinite tracks like [a,b,a,b,a,b,a...] never reaching the end.
You may want to do, is to exclude cases, where X, Y, or H is a member of T (this may be the visited_route/4 predicate). This way, you won't ever pass the same node twice.
Edit
I've sat down and freshened my Prolog knowledge a little bit, creating such code, which seems to work:
train(a,b).
%train(b,a). Your predicate is symmetric, you don't need to specify both directions
train(b,c).
%train(c,b).
train(c,d).
train(c,e).
train(d,f).
train(e,f).
visited_route(X, Y, [], V) :-
( train(X,Y) ; train(Y,X) ),
not(member(Y, V)).
visited_route(X, Y, [H | T], V) :-
visited_route(X, H, [], [X | V]),
visited_route(H, Y, T, [X | V]).
route(X,Y,R) :-
visited_route(X, Y, R, []).
Visited route has an additional list containing all nodes visited on a way from X to Y (not counting Y). When solver finds a way leading from X to Y in first visited_route predicate, it then checks if the route doesn't go through already visited node, and discards the candidate if so.

Find All Relatives with Prolog

I'm having trouble wrapping my head around how I would return a list of everyone related to a certain person. So, if I say relatives(A,B), A would be a person and B is a list of all of the people related to that person. I can write any additional rules needed to assist in doing this. Here is what I have so far.
man(joe).
man(tim).
man(milan).
man(matt).
man(eugene).
woman(mary).
woman(emily).
woman(lily).
woman(rosie).
woman(chris).
parent(milan, mary).
parent(tim, milan).
parent(mary, lily).
parent(mary, joe).
parent(mary, matt).
parent(chris, rosie).
parent(eugene, mary).
parent(eugene, chris).
cousins(A, B) :- parent(C, A), parent(D, B), parent(E, C), parent(E, D), not(parent(C, B)), not(parent(D, A)), A \=B.
paternalgrandfather(A, C) :- man(A), man(B), parent(B, C), parent(A, B).
sibling(A, B) :- parent(C, A), parent(C, B), A \= B.
Can someone guide me as to how I would go about doing this? Thanks.
I think that you should concentrate on the 'true' relation, i.e. parent(Old,Jung), other predicates are irrelevant here. The obvious assumption it's that atoms occurring in parent/2 are identifiers (i.e. names are unique). From this picture seems that all persons here are relatives:
Then your problem should be equivalent to find all connected vertices in parent relation. You can implement a depth first visit, passing down the list of visited nodes to avoid loops (note that you need to go back to parents and down to children!), something like
relatives(Person, Relatives) :-
relatives([], Person, [Person|Relatives]).
relatives(Visited, Person, [Person|Relatives]) :-
findall(Relative, immediate(Person, Visited, R), Immediates),
... find relatives of immediates and append all in relatives.
immediate(Person, Visited, R) :-
(parent(Person, R) ; parent(R, Person)),
\+ member(R, Visited).
See if you can complete this snippet. Note the order of arguments in relatives/3 is choosen to easy maplist/3.
If you are willing to study more advanced code, SWI-Prolog library(ugraph) offers a reachable(+Vertex, +Graph, -Vertices) predicate that does it on a list based graph representation.
Here the SWI-Prolog snippet to get the image (a file to be feed to dot):
graph(Fact2) :-
format('digraph ~s {~n', [Fact2]),
forall(call(Fact2, From, To), format(' ~s -> ~s;~n', [From, To])),
format('}\n').
you can call in this way:
?- tell('/tmp/parent.gv'),graph(parent),told.
and then issue on command line dot -Tjpg /tmp/parent.gv | display
I think you should use builtin predicate findall/3 and maybe sort/2 to avoid duplicates
It would go along these lines:
relatives(Person, Relatives):-
findall(Relative, is_relative(Person, Relative), LRelatives),
sort(LRelatives, Relatives).
is_relative(Person, Relative):-
(cousins(Person, Relative) ; paternalgrandfather(Person, Relative) ; sibling(Person, Relative)).
You might want to add more clauses to is_relative to get more relationships.

Resources