Prolog breadth-first search (BFS) - prolog

I am new in Prolog and I need a little help. There is this problem:
The input is a given certain state space, which is edge-labeled tree.
Write a program in Prolog that implements a search by BFS method and
finds its way to the destination node (g) of the state space with a
minimum price.
E.g. : Edge-labeled tree --> (a, g, [a-b/1, a-c/3, b-d/4, b-e/7, c-f/6, c-g/9])
e.g. tree
Thx for help, need it.
EDIT:
This is what i done, but its only for NOT edge-labeled tree. I dont know how add edge-labeled.
oh(a,*).
oh(c,a).
oh(b,a).
oh(d,b).
oh(b,e).
oh(c,f).
oh(c,g).
oh(f,h).
bFS(Start, Finish, Path) :-
assertz(gen(Start, *)),
retract(gen(From, To)),
assertz(exp(From, To)),
oh(From, New),
not(gen(New, _)),
not(exp(New, _)),
assertz(gen(New, From)), New = Finish, find(From, [Finish], Path).
find(*, Path, Path).
find(Add, List, Path) :-
oh(Pridavany, Previous),
find(Previous,[Add|List],Path).
%find(b,[e],Path).

These are some good tips on Prolog search.
Try reading these before you see the answer.
The Breadth First Algorithm has been posted on cs.unm.edu and works fine with SWI Prolog.
state_record(State, Parent, [State, Parent]).
go(Start, Goal) :-
empty_queue(Empty_open),
state_record(Start, nil, State),
add_to_queue(State, Empty_open, Open),
empty_set(Closed),
path(Open, Closed, Goal).
path(Open,_,_) :- empty_queue(Open),
write('graph searched, no solution found').
path(Open, Closed, Goal) :-
remove_from_queue(Next_record, Open, _),
state_record(State, _, Next_record),
State = Goal,
write('Solution path is: '), nl,
printsolution(Next_record, Closed).
path(Open, Closed, Goal) :-
remove_from_queue(Next_record, Open, Rest_of_open),
(bagof(Child, moves(Next_record, Open, Closed, Child), Children);Children = []),
add_list_to_queue(Children, Rest_of_open, New_open),
add_to_set(Next_record, Closed, New_closed),
path(New_open, New_closed, Goal),!.
moves(State_record, Open, Closed, Child_record) :-
state_record(State, _, State_record),
mov(State, Next),
% not (unsafe(Next)),
state_record(Next, _, Test),
not(member_queue(Test, Open)),
not(member_set(Test, Closed)),
state_record(Next, State, Child_record).
printsolution(State_record, _):-
state_record(State,nil, State_record),
write(State), nl.
printsolution(State_record, Closed) :-
state_record(State, Parent, State_record),
state_record(Parent, _, Parent_record),
member(Parent_record, Closed),
printsolution(Parent_record, Closed),
write(State), nl.
add_list_to_queue([], Queue, Queue).
add_list_to_queue([H|T], Queue, New_queue) :-
add_to_queue(H, Queue, Temp_queue),
add_list_to_queue(T, Temp_queue, New_queue).
The code is free to use, for education purposes.
We offer them for use, free of charge, for educational purposes only.
We cannot know for sure what you want to achieve, but this is the algorithm.

Related

Prolog Domino Solution

I need an algorithm that given a set of domino pieces, returns every possible end to the game.
I have already found this one, Prolog domino game, but it only adds pieces to the beggining of the set, so it doesn't give you every possible solution.
I replaced this [5-4, 4-3, 3-2, 2-1], with this [[5,4], [4,3], [3,2], [2,1]], and tried adding this line domino_order(In, X, [Out|[X,Y]]) :- select(Piece, In, Remaining), swap_or_not(Piece, [X,Y]), domino_order(Remaining, Y, Out)., but it doesn't work.
writing down the detailed logic would lead to somewhat complex code.
I suggest instead to have a quick check for validity, and let Prolog work out the insertion points.
domino :-
Spare = [4-7,3-4], Curr = [1-2,2-3],
domino_row_add_spare(Curr, Spare, R),
writeln(R).
domino_row_add_spare(C, [], C).
domino_row_add_spare(C, Sps, U) :-
append(L, R, C),
select(X-Y, Sps, Rest),
(append(L, [X-Y|R], C1) ; append(L, [Y-X|R], C1)),
valid(C1),
domino_row_add_spare(C1, Rest, U).
valid([_]).
valid([_-X,X-Y|R]) :- valid([X-Y|R]).

Cycle route program in 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.

Performance issues on prolog

I'm currently implementing an prolog program to calculate the shortest path between two points.
The framework exists already in a Java project. As a requirement the path must be implemented in prolog.
Therefore I use gnu.prolog (http://www.gnu.org/software/gnuprologjava/)
Out of java I call searchPath(1,5,Path) which will return Path=[5,4,3,2,1]
Here is my prolog code:
:- dynamic(path/3).
findPath( [Goal | Rest], Goal, Temp, Temp, [Goal | Rest]).
findPath( [A | Rest], Goal, Cost, Temp, Path) :-
path(A,B,C),
\+member(B, [A | Rest]),
NewCosts is (Temp + C),
findPath([B, A | Rest], Goal, Cost, NewCosts, Path).
searchPath(Start,Goal,Path_to_goal) :-
findPath([Start], Goal, Cost1, 0, Path),
findPath([Start], Goal, Cost2, 0, Path2),
Cost1=<Cost2,
Path_to_goal = Path.
I have two issues with that:
The searchPath method should return the shortest path. However it
does NOT. This results in the fact that my ghost "decides" to switch
direction at some point resulting in the ghost jittering from left
to right.
My prolog code takes up to 6 seconds to return a result. I
don't have to tell you that this is far too much time. However sometimes prolog only needs 19ms. I wasn't able to figure out on which circumstances this depends on. For example a path list containing 99 elements takes 19ms to calculate but the 6 seconds were spent on a list containing only 38 elements.
Can you suggest any improvements?
Thanks for your help in advance!
You could use Dijkstra' algorithm. I implemented it answering to this question. My code uses attributed variables, I think should work in GnuProlog (I'll test now). Anyway, there you'll find the link to a working pure Prolog implementation.
edit well, I think you could correct your code, because there is a problem:
Path2 in searchPath/3 it's a singleton: then you clearly are going to always end with the first Path, and because the second findPath/3 will find always (if database doesn't change) the very same Cost and Path as the first, Cost1=<Cost2, will be always true. You could try if
searchPath(Start,Goal,Path_to_goal) :-
findall(Cost-Path, findPath([Start], Goal, Cost, 0, Path), Paths),
sort(Paths, [_-Path_to_goal|_]).
is sufficiently fast for your assignment. Otherwise you'll need to implement an incremental search, not easy to do because Prolog 'returns' alternatives paths on backtracking, then forcing to use some kind of side effect to select the minimum value.
more edit findall/3 will result in code too much slow. I've coded something more efficient using non backtrackable assignment (I used SWI-Prolog nb_setarg/3, you should use setarg/3 in GProlog).
findPath(_Limit, [Goal | Rest], Goal, Temp, Temp, [Goal | Rest]) :- !.
findPath(Limit, [A | Rest], Goal, Cost, Temp, Path) :-
path(A,B,C),
\+member(B, Rest),
NewCosts is (Temp + C),
NewCosts < Limit,
findPath(Limit, [B, A | Rest], Goal, Cost, NewCosts, Path).
% ?- searchPath(aberdeen, glasgow, Path, Length).
%
searchPath(Start, Goal, Path_to_goal, L) :-
S = path_len([], 1000000),
repeat,
arg(2, S, Limit),
( findPath(Limit, [Start], Goal, Cost, 0, Path)
-> ( Cost < Limit
-> nb_setarg(1, S, Path),
nb_setarg(2, S, Cost),
fail
)
; true
),
arg(1, S, Rev),
reverse(Rev, Path_to_goal),
arg(2, S, L).

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.

Formulation in Prolog

I currently have the following problem, that I want to solve with Prolog. It's an easy example, that would be easy to solve in Java/C/whatever. My problem is that I believe to be too tied to Java's thinking to actually formulate the problem in a way that makes useof Prolog's logic power.
The problem is..
I have a set of 6 arrows, either pointing left or right. Let's assume that they are in the following starting configuration:
->
<-
->
<-
->
<-
Now, I can switch two arrows as long as they are next to each other. My goal is to discover which sequence of actions will make the initial configuration of arrows turn into
<-
<-
<-
->
->
->
My initial attempt at formulating the problem is..
right(arrow_a).
left(arrow_b).
right(arrow_c).
left(arrow_d).
right(arrow_e).
left(arrow_f).
atPosition(1, arrow_a).
atPosition(2, arrow_b).
atPosition(3, arrow_c).
atPosition(4, arrow_d).
atPosition(5, arrow_e).
atPosition(6, arrow_f).
This will tell Prolog what the initial configuration of the arrows are. But now how do I insert aditional logic in it? How to implement, for example, switchArrows(Index) ? Is it even correct stating the initial conditions like this, in Prolog? Won't it interfere later when I try to set, for example, that arrow_a is at position 6, atPosition(6, arrow_a) ?
Your problem can be formulated as a sequence of transitions between configurations. First think about how you want to represent a single configuration. You could use a list to do this, for example [->,<-,->,<-,->,<-] to represent the initial configuration. A single move could be described with a relation step/2 that is used as step(State0, State) and describes the relation between two configurations that are "reachable" from each other by flipping two adjacent arrows. It will in general be nondeterministic. Your main predicate then describes a sequence of state transitions that lead to the desired target state from an initial state. Since you want to describe a list (of configurations), DCGs are a good fit:
solution(State0, Target) -->
( { State0 == Target } -> []
; { step(State0, State1) },
[State1],
solution(State1, Target)
).
And then use iterative deepening to find a solution if one exists, as in:
?- length(Solution, _), phrase(solution([->,<-,->,<-,->,<-], [<-,<-,<-,->,->,->]), Solution).
The nice thing is that Prolog automatically backtracks once all sequences of a given length have been tried and the target state could not yet be reached. You only have to implement step/2 now and are done.
Since a complete solution is posted already, here is mine:
solution(State0, Target) -->
( { State0 == Target } -> []
; { step(State0, State1) },
[State1],
solution(State1, Target)
).
flip(->, <-).
flip(<-, ->).
step([], []).
step([A|Rest0], [A|Rest]) :- step(Rest0, Rest).
step([A0,A1|Rest], [B0,B1|Rest]) :- flip(A0, B0), flip(A1, B1).
Example query:
?- length(Solution, _), phrase(solution([->,<-,->,<-,->,<-], [<-,<-,<-,->,->,->]), Solution).
Solution = [[->, <-, ->, <-, <-, ->],
[->, <-, ->, ->, ->, ->],
[->, ->, <-, ->, ->, ->],
[<-, <-, <-, ->, ->, ->]].
Since iterative deepening is used, we know that no shorter solution (less than 4 steps) is possible.
I also have a general comment on what you said:
It's an easy example, that would be
easy to solve in Java/C/whatever. My
problem is that I believe to be too
tied to Java's thinking to actually
formulate the problem in a way that
makes useof Prolog's logic power.
Personally, I think this example is already much more than could be expected from a beginning, say, Java programmer. Please try to solve this problem in Java/C/whatever and see how far you get. In my experience, when students say they are "too tied to Java's thinking" etc., they cannot solve the problem in Java either. Prolog is different, but not that different that, if you had a clear idea of how to solve it in Java, could not translate it quite directly to Prolog. My solution uses the built-in search mechanism of Prolog, but you do not have to: You could implement the search yourself just as you would in Java.
Here is my solution:
solution(Begin, End, PrevSteps, [Step | Steps]) :-
Step = step(Begin, State1),
Step,
forall(member(step(S, _), PrevSteps),
State1 \= S
), % prevent loops
( State1 == End
-> Steps = []
; solution(State1, End, [Step | PrevSteps], Steps)
).
rev(->,<-).
rev(<-,->).
step([X,Y|T], [XX,YY|T]) :- rev(X,XX), rev(Y, YY).
step([A,X,Y|T], [A,XX,YY|T]) :- rev(X,XX), rev(Y, YY).
step([A,B,X,Y|T], [A,B,XX,YY|T]) :- rev(X,XX), rev(Y, YY).
step([A,B,C,X,Y|T], [A,B,C,XX,YY|T]) :- rev(X,XX), rev(Y, YY).
step([A,B,C,D,X,Y], [A,B,C,D,XX,YY]) :- rev(X,XX), rev(Y, YY).
run :-
solution([->,<-,->,<-,->,<-], [<-,<-,<-,->,->,->],[],Steps),
!,
forall(member(Step,Steps),writeln(Step)).
It finds only first solution of all possible, though I suppose the solution found is not optimal, but rather first working one.
Managed to transform mat's code to mercury:
:- module arrows.
:- interface.
:- import_module io.
:- pred main(io, io).
:- mode main(di, uo) is cc_multi.
:- implementation.
:- import_module list, io, int.
:- type arrow ---> (->); (<-).
:- mode solution(in, in, in, in, out, in) is cc_nondet.
solution(State0, Target, MaxDepth, CurrentDepth) -->
{CurrentDepth =< MaxDepth},
( { State0 = Target } -> []
; { step(State0, State1) },
[State1],
solution(State1, Target, MaxDepth, CurrentDepth + 1)
).
flip(->, <-).
flip(<-, ->).
step([], []).
step([A|Rest0], [A|Rest]) :- step(Rest0, Rest).
step([A0,A1|Rest], [B0,B1|Rest]) :- flip(A0, B0), flip(A1, B1).
main -->
(({
member(N, 1..10),
solution([->,<-,->,<-,->,<-], [<-,<-,<-,->,->,->], N, 0, Solution, [])
})
-> print(Solution)
; print("No solutions")
).
Compiling with
mmc --infer-all arrows.m
to infer signatures & determinism

Resources