I want to make a program which should give out all possible routes between two stations. The problem I have is that it doesn't give me all routes. My code so far is:
connection(s1,s2).
connection(s2,s3).
connection(s3,s4).
connection(s4,s5).
connection(s5,s1).
connection(s1,s4).
connection(s2,s5).
direction1(X,Y) :- connection(X,Y).
direction2(X,Y) :- connection(Y,X).
route1(X,Y,R):- route1(X,Y,[X],R).
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].
route2(X,Y,R):- route2(X,Y,[X],R).
route2(X,Y,_,[X,Y]) :- direction2(X,Y).
route2(X, Y, Visited, Route) :- direction2(X, Z), Z \= Y, \+ member(Z, Visited), route2(Z, Y, [Z|Visited], Route2), Route = [X|Route2].
route(X,Y,R) :- route1(X,Y,R); route2(X,Y,R).
For example when I ask for "?- route(s1,s4,R)" it only gives me R = [s1, s4], R = [s1, s2, s3, s4] and R = [s1, s5, s4].
But there are also the routes (s1,s2,s5,s4) and (s1,s5,s2,s3,s4) and I don't know why I don't get them. How to fix this?
Thanks in advance!
Is enough
direction(X,Y) :- connection(X,Y).
direction(X,Y) :- connection(Y,X).
route(X,Y,R) :-
route(X,Y,[X],R).
route(X,Y,_,[X,Y]) :-
direction(X,Y).
route(X, Y, Visited, [X | Hr]) :-
direction(X, Z),
Z \= Y,
\+ member(Z, Visited),
route(Z, Y, [Z | Visited], Hr).
I mean: use only one direction/2 instead the duplication of direction1/2 and direction2/2. The use of the Visited list permit you to avoid the potential loop.
So you can unify route1/3 and route2/3 in a single route/3.
Your code fail finding [s1, s2, s5, s4] because from s1 to s5 you need direction1/2 (so route1/3 and route1/4) but from s5 to s4 you need direction2/2 (but route1/4 doesn't call direction2/2).
In similar way your code fail finding [s1, s5, s2, s3, s4] because you need direction2/2 (so route2/3 and route2/4) from s1 to s2 but you need direction1/2 from s2 to s4.
Related
I'm trying to rule to check if someone likes a friend other than the one stated in the argument. So for example,
likes(Alice,Bob).
likes(Bob,Alice).
likes(Alice,Jeff).
likes(Jeff,Alice).
I'm trying to create a rule friends(X,Y) that if both of them like each other, we look for another pair that either X or Y is linked to. Any help?
The first solution returns the first person found that one of the two people likes, in case these 2 people like each other.
likes(alice,bob).
likes(bob,alice).
likes(alice,jeff).
likes(jeff,alice).
friends_aux(X, Y, Z) :- likes(Y, Z), Z \= X.
friends_aux(X, Y, Z) :- likes(X, Z), Z \= Y.
friends(X, Y, Z) :- likes(X, Y), likes(Y, X), friends_aux(X, Y, Z), !.
And the second solution returns true if any of the two people have any other couple.
friends2_aux(X, Y) :- likes(Y, Z), Z \= X.
friends2_aux(X, Y) :- likes(X, Z), Z \= Y.
friends2(X, Y) :- likes(X, Y), likes(Y, X), friends2_aux(X, Y), !.
I attached an image of the results.
Results
Hopefully this is what you wanted.
So I have this undirected graph to traverse, and I should find all the verticies those are connected to a given vertex.
edge(a, b).
edge(b, c).
edge(c, d).
edge(d, e).
edge(e, f).
edge(f, d).
edge(d, g).
edge(g, f).
edge(g, h).
edge(h, i).
edge(i, j).
edge(j, d).
edge(d, k).
edge(l, m).
edge(m, n).
undirectedEdge(X, Y) :- edge(X, Y).
undirectedEdge(X, Y) :- edge(Y, X).
connected(X, Y) :- undirectedEdge(X, Y).
connected(X, Y) :- connected(X, Z), connected(Z, Y), X \= Y.
And once I type connected(a, X). it goes into an infinite loop.
I understand why I have it, but I have no idea how to avoid it, maybe I can find some help here?
Using closure0/3 and setof/3 we get:
connected(A,B) :-
setof(t, closure0(undirectedEdge, A, B), _).
And once I type connected(a, X). it goes into an infinite loop.
The reason this happens is because it is checking a path of the form a → b → a → b → a → b → …. So it keeps "hopping" between two nodes.
You can maintain a list of nodes that the algorithm already visisted, to prevent that like:
connected(X, Y) :-
connected(X, Y, [X]).
connected(X, X, _).
connected(X, Z, L) :-
undirectedEdge(X, Y),
\+ member(Y, L),
connected(Y, Z, [Y|L]).
You can make use of the distinct/1 predicate [swi-doc] to generate distinct answers:
?- distinct(connected(a, X)).
X = a ;
X = b ;
X = c ;
X = d ;
X = e ;
X = f ;
X = g ;
X = h ;
X = i ;
X = j ;
X = k ;
false.
I need some very basic help on how to approach this problem. I have a one room planner that, given a start state and end state, it solves this using recursion. However, I want to solve this for two states (aka rooms). I decided that setting flags would be my best bet since each state of the rooms is either in room1 or room2. However I do not know how to implement this. Any can push me in the right direction?
Just to clarify, the new states would be (ontable(X), room1) instead of ontable(X)
:- module( planner,
[
plan/4,change_state/3,conditions_met/2,member_state/2,
move/3,go/2,test/0,test2/0
]).
:- [utils].
plan(State, Goal, _, Moves) :- equal_set(State, Goal),
write('moves are'), nl,
reverse_print_stack(Moves).
plan(State, Goal, Been_list, Moves) :-
move(Name, Preconditions, Actions),
conditions_met(Preconditions, State),
change_state(State, Actions, Child_state),
not(member_state(Child_state, Been_list)),
stack(Child_state, Been_list, New_been_list),
stack(Name, Moves, New_moves),
plan(Child_state, Goal, New_been_list, New_moves),!.
change_state(S, [], S).
change_state(S, [add(P)|T], S_new) :- change_state(S, T, S2),
add_to_set(P, S2, S_new), !.
change_state(S, [del(P)|T], S_new) :- change_state(S, T, S2),
remove_from_set(P, S2, S_new), !.
conditions_met(P, S) :- subset(P, S).
member_state(S, [H|_]) :- equal_set(S, H).
member_state(S, [_|T]) :- member_state(S, T).
/* move types */
move(pickup(X), [handempty, clear(X), on(X, Y)],
[del(handempty), del(clear(X)), del(on(X, Y)),
add(clear(Y)), add(holding(X))]).
move(pickup(X), [handempty, clear(X), ontable(X)],
[del(handempty), del(clear(X)), del(ontable(X)),
add(holding(X))]).
move(putdown(X), [holding(X)],
[del(holding(X)), add(ontable(X)), add(clear(X)),
add(handempty)]).
move(stack(X, Y), [holding(X), clear(Y)],
[del(holding(X)), del(clear(Y)), add(handempty), add(on(X, Y)),
add(clear(X))]).
move(goroom1, [handempty], []).
move(goroom1, [holding(X)], []).
move(goroom2, [handempty], []).
move(goroom2, [holding(X)], []).
/* run commands */
go(S, G) :- plan(S, G, [S], []).
test :- go([handempty, ontable(b), ontable(c), on(a, b), clear(c), clear(a)],
[handempty, ontable(c), on(a,b), on(b, c), clear(a)]).
test2 :- go([handempty, ontable(b), ontable(c), on(a, b), clear(c), clear(a)],
[handempty, ontable(a), ontable(b), on(c, b), clear(a), clear(c)]).
So I solved it by using flags basically. So for each move predicate I basically add a room1 and room2 flag. If they are true then it does the action. So for example ontable(X) in room1 then del ontable and add holding(X) in room1. I also add two predicates to move between rooms. The biggest hurdle was moving from procedural logic to state logic. So if handempty is in room1 then it can only move to room2! #CapelliC thank you for the advice
What I want to do is to delete part of a list specified in another list i.e. e.g.
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3,3,2].
I first defined the following. No problem there.
deleteOne(X, [X|Z], Z).
deleteOne(X, [V|Z], [V|Y]) :-
X \== V,
deleteOne(X,Z,Y).
Then, the following does not work as expected.
deleteSome([], [], _).
deleteSome([X|Xs], Y, Zs) :-
deleteSome(Xs, Y, [X|Zs]).
deleteSome([X|Xs], Y, Zs) :-
member(X,Y),
deleteOne(X,Y,Y),
deleteSome(Xs, Y, Zs).
I would use the powerful select/3 builtin
deleteSome(L, D, R) :-
select(E, L, L1),
select(E, D, D1),
!, deleteSome(L1, D1, R).
deleteSome(L, _, L).
test:
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3, 3, 2].
I must admit, I don't understand your deleteSome code at all. Here's what I'd do (no Prolog here, so might contain errors):
deleteSome(X, [], X).
deleteSome(X, [Y|Ys], Z) :-
deleteOne(Y, X, T),
deleteSome(T, Ys, Z).
I.e. If there's nothing to delete, no change. Otherwise, the result is when we delete the first of the to-deletes, and then delete the rest of them.
There is some confusion in that it seems your deleteOne has (Original, ToDelete, Result) parameters, but deleteSome has (ToDelete, Original, Result). For consistency, I'd rather rewrite it so the signatures are compatible:
deleteSome([], Y, Y).
deleteSome([X|Xs], Y, Z) :-
deleteOne(X, Y, T),
deleteSome(Xs, T, Z).
I'm continuing some researches in lattices and semilattices and suddenly having this question.
Basically, we have a RelationList of [a,b] pairs, which means that (a,b) is an edge. Now we should know, is a graph formed by this RelationList 1-connectivity or not.
By the way, we have an ordered graph, so order of (a,b) is important.
clear_link(X, Y, RelationList) :-
(member([X,Y], RelationList)
;
member([Y,X], RelationList)),
X =\= Y.
linked(X, Y, RelationList) :-
clear_link(X, Y, RelationList),
!.
linked(X, Y, RelationList) :-
clear_link(X, Z, RelationList),
linked(Z, Y, RelationList).
simple_connect(RelationList, E) :-
forall((member(X, E),
member(Y, E), X < Y),
linked(X, Y, RelationList)).
But, for 6-element graph I have stackoverflow.
?- simple_connect([[2,1],[2,3],[4,3],[4,5],[6,5]],[1,2,3,4,5,6]).
ERROR: Out of local stack
Am I defining it wrong?
I've correct some. Now it's fine
clear_link(X, Y, RelationList) :-
member([X,Y], RelationList),
X =\= Y.
linked(X, Y, RelationList) :-
clear_link(X, Y, RelationList),
!.
linked(X, Y, RelationList) :-
clear_link(X, Z, RelationList),
linked(Z, Y, RelationList),
!.
simple_connect(RelationList, E) :-
forall((member(X, E),
member(Y, E), X < Y),
linked(X, Y, RelationList)).
connective_graph(RelationList, E) :-
findall(Relation, (
member(X, RelationList),
sort(X, Relation)
),SortRelationList),
simple_connect(SortRelationList, E).
And
?- connective_graph([[2,1],[2,3],[4,3],[4,5],[6,5]],[1,2,3,4,5,6]).
true.
?- connective_graph([[2,1],[4,3],[4,5],[6,5]],[1,2,3,4,5,6]).
false.
Right answer (copy to post)
connected(X, Y, RelationList) :-
(member([X,Y], RelationList);
member([Y,X], RelationList)).
path(X, Y, RelationList, Path) :-
travel(X, Y, RelationList, [X], ReversePath),
reverse(ReversePath, Path),!.
travel(X, Y, RelationList, Point, [Y | Point]) :-
connected(X, Y, RelationList).
travel(X, Y, RelationList, Visited, Path) :-
connected(X, Z, RelationList),
Z =\= Y,
\+member(Z, Visited),
travel(Z, Y, RelationList, [Z|Visited], Path).
connective_graph(RelationList, E) :-
forall((member(X, E),
member(Y, E),
X < Y)
,path(X,Y,RelationList,_)).