I have a problem which is [1,2,3,0,4,5,6] and the goal is [4,5,6,0,1,2,3] and the Heuristic function
is to calculate misplaced for 4,5,6 tile in position of 1,2,3 tile so when I try to add the condition for head >3 it always false
getHeuristic([], 0, []):-!.
% here it is calculated as number of misplaced numbers for 4,5,6 only
% ( so if Head = Head and value greater than 3 its correct so
% don't count it)
getHeuristic([H|T1],V,[H|T2]):-!,
H>3,
getHeuristic(T1,V, T2).
getHeuristic([_|T1],H,[_|T2]):-
getHeuristic(T1,TH, T2),
H is TH + 1.
A heuristic is a quick way to estimate how close the current state is to the goal state (in the state space).
Let h*(S) be the cost of an optimal path from current state S to a goal state G. Then, a heuristic function h(S) is admissible if, and only, if:
0 ≤ h(S) ≤ h*(S), and
h(G) = 0.
In other words, an admissible heuristic function must be always optimistic!
For example, from the following current state, you need at least two "moves" to reach the goal state:
Current state = [6,4,5,0,1,2,3]
Swap 6 and 4 : [4,6,5,0,1,2,3]
Swap 5 and 6 : [4,5,6,0,1,2,3] = Goal state
Notice that, for example, a heuristic function that estimates the cost of an optimal path to reach the goal state [4,5,6,0,1,2,3] from the current state [5,4,6,0,1,2,3] as at least 2 is not admissible (since a unique move - swap 5 and 4 - is sufficient to correct both positions).
Thus, I think you can do something like this:
heuristic(State, Goal, Value) :-
heuristic(State, Goal, 0, Value).
heuristic([], [], A, A).
heuristic([X|Xs], [Y|Ys], A, V) :-
( X < Y
-> A1 is A + 1
; A1 is A ),
heuristic(Xs, Ys, A1, V).
Examples:
?- heuristic([1,2,3,0,4,5,6], [4,5,6,0,1,2,3], V).
V = 3.
?- heuristic([6,4,5,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 2.
?- heuristic([5,4,6,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 1.
?- heuristic([4,5,6,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 0.
Remark: The "moves" counted by the heuristic function do not necessarily correspond to the actual moves that cause transitions from states to their successors in the state space (i.e., they are relaxed moves).
If you want to compute a "distance" from the "current state" to the "target state" by counting the number of nonmatching positions:
% nmpcount(+CurrentState,+TargetState,?Count)
nmpcount(CurrentState,TargetState,Count) :-
nmpcount2(CurrentState,TargetState,0,Count).
% nmpcount2(+CurrentState,+TargetState,+CountSoFar,?CountFinal)
nmpcount2([],[],Count,Count).
nmpcount2([X|MoreCS],[X|MoreTS],CountIn,FinalCount) :-
nmpcount2(MoreCS,MoreTS,CountIn,FinalCount).
nmpcount2([X|MoreCS],[Y|MoreTS],CountIn,FinalCount) :-
dif(X,Y),
CountNext is CountIn+1,
nmpcount2(MoreCS,MoreTS,CountNext,FinalCount).
Related
I am trying to resolve the following problem:
Given k neurons n1,...,nk they are connected by a predicate arc given in input. The first h neurons are input ones and do not have any incoming arcs, they have a boolean value. Every arc (i,j) have a weight w(i,j) that have value [-2, ..., +2].
The output of node (that is not an input one) is obtained, as always, by the sum on all the incoming arcs of the arc weight times the output value of the neuron at the other end of the arc.
Determine the weights of the network that maximize the sum of the absolute values of the difference between the weitghts of nk-1 and nk on all the given configurations in input. Consider only acyclic graphs.
Prepare a battery of benchmark instances in the following way. For each k = 10, 15, 20, 25, 30 and h~k/3: generate randomly 20 different instances (arc). 100 instances in total
The part that says that the input nodes have boolean values means that for each configuration we have a different set of input nodes, for example with h = 2 we have:
n_config
h1
h2
1
0
0
2
0
1
3
1
0
4
1
1
This means that in the first configuration the input nodes are false (i.e. not considered), in the second only the first is true, etc...
I am at a point where I do not know where to go. I have found a solution that works well for k = 5 and h = 2 but the moment I try with k = 10 and h = 3 the grounding takes a lot. So I suspect I am doing something wrong with the sum, for calculate the weight of each output node.
Here the code I am working with:
#const n = 5. % nodes
#const h = 2. % input nodes h~k/3
#const n_config = 2**h.
node(1..n).
weight(-2;-1;0;1;2).
% arc predicate
arc(1,3). arc(2,3). arc(3,4;3,5).
% arcs for k = 10
% arc(1,4;1,5;1,8). arc(2,4;2,5;2,8;2,10). arc(3,4;3,5;3,7;3,9). arc(4,5). arc(5,8;5,10). arc(6,8;6,9;6,10). arc(7,9;7,10). arc(8,9;8,10).
% Configurations
config(1..2**h).
% differentiate between input and output nodes
node_out(X) :- node(X), X>h.
node_in(X) :- node(X), X<=h.
% The input node don't have any input edge
:- node_in(X), node(Y), arc(Y,X).
% Assign one weight to each arc using a choice rule
1 {weight_arc(X,Y,W) : weight(W)}1 :- arc(X, Y).
% input layer
{weight_node(C,X,1) : node_in(X)}:- config(C).
% output nodes
weight_node(C,X, 1) :- node_out(X), config(C).
%%% Now we eliminate all the configurations we do not want to also speed up the aggregate sum
% the number of 1 need to be the half af all number of 0s and 1s
:- #count{C,V:weight_node(C,X,V)}!=(2**h)/2, node_in(X).
% At least one config has all at 1 or 0
:- #count{C:weight_node(C,X,V), node_in(X)}!=(2**h)-1.
% First config always at 0
:- #count{C:weight_node(C,X,V), node_in(X), C=1} != 0.
% Last config always at 1
:- #count{X:weight_node(C,X,V), node_in(X), C=2**h} < h.
% The other are always different from 0 and 1
:- #count{X:weight_node(C,X,V), node_in(X)}=0, config(C), C!=1, C!=h**2.
% give an order to the succession of input nodes
:- T1=#count{X1:weight_node(C1,X1,V), node_in(X1)},
T2=#count{X2:weight_node(C2,X2,V), node_in(X2)},
config(C1), config(C2), C1<C2, T1=T2,
MaxC1 = #max{X1:weight_node(C1,X1,V), node_in(X1)},
MaxC2 = #max{X2:weight_node(C2,X2,V), node_in(X2)},
MaxC1>MaxC2.
:- T1=#count{X1:weight_node(C1,X1,V), node_in(X1)}, T2=#count{X2:weight_node(C2,X2,V), node_in(X2)}, config(C1), config(C2), C1<C2, T1>T2.
weight_nodexarc(C,X,Y,S*Wa) :- weight_node(C, X, S), weight_arc(X,Y,Wa), node_in(X).
weight_nodexarc(C,X,Y,S*Wa) :- out_weight_node(C, X, S), weight_arc(X,Y,Wa), node_out(X).
out_weight_node(C, Y, Wn) :- Wn=#sum{W,X: weight_nodexarc(C,X,Y,W)}, node_out(Y), config(C), C>1.
out_weight_node(C, Y, Wn) :- Wn=0, node_out(Y), config(C), C=1.
result_config(C,|R|) :- out_weight_node(C,n,O1), out_weight_node(C,n-1,O2), R=O1-O2, config(C),C>1.
% the first configuration is always at 0 because it doeas not have any input nodes
result_config(1,0).
% It has sense only of the first config is at 0
:- result_config(C,R), C!=1, R=0.
:- result_config(C1,R1), result_config(C2,R2), C1<C2, R1>R2.
%result(T) :- T = #sum{R,C:result_config(C,R), config(C)}.
#maximize {R,C:result_config(C,R)}.
So I am trying to solve this Booth arrangement problem given here. It is basically a sliding tile puzzle where one (booth)tile has to reach a target spot and in the end all other (booths)tiles should be in their original location. Each tile/booth has a dimension and following are the input fact and relation descriptions:
One fact of the form room(W,H), which specifies the width W and
height H of the room (3 ≤ W, H ≤ 20).
One fact booths(B), which
specifies the number of booths (1 ≤ B ≤ 20).
A relation that consists
of facts of the form dimension(B, W, H), which specifies the width W
and height H of booth B.
A relation consisting of facts of the form
position(B, W, H), specifying the initial position (W, H) of booth B.
One fact target(B, W, H), specifying the destination (W, H) of the
target booth B.
An additional fact horizon(H) gives an upper bound on
the number of moves to be performed.
The program is supposed to read input facts from a file but I am just trying to do the solving so I have just copy pasted one possible input for now, and I have written some basic clauses:
room(3, 3).
booths(3).
dimension(1, 2, 1).
dimension(2, 2, 1).
dimension(3, 1, 1).
position(1, 0, 1).
position(2, 1, 2).
position(3, 0, 0).
target(3, 0, 2).
horizon(10).
xlim(X) :- room(X,_).
ylim(X) :- room(_,X).
sum(X,Y,Z) :- Z is X+Y .
do(position(B,X,Y),movedown,position(B,X,Z)) :- Y > 0 , sum(Y,-1,Z) .
do(position(B,X,Y),moveup,position(B,X,Z)) :- ylim(L), Y < L , sum(Y,1,Z) .
do(position(B,X,Y),moveleft,position(B,Z,Y)) :- X > 0 , sum(X,-1,Z) .
do(position(B,X,Y),moveright,position(B,Z,Y)) :- xlim(L), X < L, sum(X,1,Z) .
noverlap(B1,B2) :-
position(B1,X1,Y1),
position(B2,X2,Y2),
ends(Xe1,Ye1,B1),
ends(Xe2,Ye2,B2),
( Xe1 < X2 ;
Xe2 < X1 ;
Ye1 < Y2 ;
Ye2 < Y1 ).
ends(Xe,Ye,B) :-
dimension(B,W,H),
position(B,X,Y),
Xe is X+W-1,
Ye is Y+H-1.
between(X,Y,Z) :-
X > Y ,
X < Z .
validMove(M,B) :- do(position(B,X,Y),M,position(B,Xn,Yn)) .
I am new to Prolog and I am stuck on how to go from here, I have the no_overlap rule so I can test if a move is valid or not but I am not sure how with the current clauses that I have. My current clauses for moves do/3 probably needs some modification. Any pointers?.
You need to express the task in terms of relations between states of the puzzle. Your current clauses determine the validity of a single move, and can also generate possible moves.
However, that is not sufficient: You need to express more than just a single move and its effect on a single tile. You need to encode, in some way, the state of the whole puzzle, and also encode how a single move changes the state of the whole task.
For a start, I recommend you think about a relation like:
world0_move_world(W0, M, W) :- ...
and express the relation between a given "world" W0, a possible move M, and the resulting world W. This relation should be so general as to generate, on backtracking, each move M that is possible in W0. Ideally, it should even work if W0 is a free variable, and for this you may find clpfd useful: Constraints allow you to express arithmetic relations in a much more general way than you are currently using.
Once you have such a relation, the whole task is to find a sequence Ms of moves such that any initial world W0 is transformed to a desired state W.
Assuming you have implemented world0_move_world/3 as a building block, you can easily lift this to lists of moves as follows (using dcg):
moves(W0) --> { desired_world(W0) }.
moves(W0) --> [M], { world0_move_world(W0, M, W) }, moves(W).
You can then use iterative deepening to find a shortest sequence of moves that solves the puzzle:
?- length(Ms, _), initial_world(W0), phrase(moves(W0), Ms).
I am trying to implement a depth first iterative deepening search of a state space graph.
I have a graph with three vertices and their are two activating edges and two inhibition edges. Each node has a binary value, collectively this is the state of the graph. The graph can transition to a new state by seeing if one of the nodes is above a threshold or below a threshold (calculated from summing all the incoming nodes). At most one node will change at each transition. As their are three nodes, their are three state transition edges leaving each state in the state transition graph.
I think my state_change/3 works correctly, for instance I can query:
?-g_s_s(0,1,1,Begin),node(Arc),state_change(g_s(Begin),Second,Arc).
And it gives me the three correct answers:
Begin = [node(v1, 0), node(v2, 1), node(v3, 1)],
Arc = v1,
Second = g_s([node(v1, 1), node(v2, 1), node(v3, 1)]) ;
Begin = [node(v1, 0), node(v2, 1), node(v3, 1)],
Arc = v2,
Second = g_s([node(v1, 0), node(v2, 0), node(v3, 1)]) ;
Begin = [node(v1, 0), node(v2, 1), node(v3, 1)],
Arc = v3,
Second = g_s([node(v1, 0), node(v2, 1), node(v3, 0)])
I am trying to use the predicate id_path given in Bratkos Prolog for A.I book, the solution to question 11.3 but I am having problems using/adapting it. I want to create a path from a start node to the other nodes, with out getting into loops- I don't want it to have repeat elements or to get stuck when a path does not exist. I want the path to say the starting state, then a succession of states you can visit from the start state. If there is a self loop I want this to be included once for every way of getting there. Ie I want to keep track of the way that I got to the state space and make this unique not just that the state space is unique in the path.
For instance from 011 I want all three paths of length one to be found with the arcs.
?-id_path(g_s([node(v1,0),node(v2,1),node(v3,1)],Last,[Temp],Path).
Path = [[node(v1,0),node(v2,1),node(v3,1)],to([node(v1,1),node(v2,1),node(v3,1)],v1)];
Path =[[node(v1,0),node(v2,1),node(v3,1)], to([node(v1,0),node(v2,0),node(v3,1)],v2)];
Path=[[node(v1,0),node(v2,1),node(v3,1)],to([node(v1,1),node(v2,1),node(v3,0)],v3)];
and then at the next level all the paths with three nodes, showing the two arcs it needs to get to the nodes, then at the next level all the paths with fours nodes showing the three arcs it needs etc
I have also put my code in SWISH if this is helpful? (Trying this for the first time?!)
http://pengines.swi-prolog.org/apps/swish/p/HxBzEwLb.pl#&togetherjs=xydMBkFjQR
a(v1,v3). %a activating edge
a(v3,v1).
i(v1,v2). %a inhibition edge
i(v2,v3).
nodes([v1,v2,v3]).
node(X):- nodes(List),member(X,List). %to retrieve a node in graph a) or an arc in graph b)
g_s_s(X,Y,Z,g_s([node(v1,X),node(v2,Y),node(v3,Z)])). %graph_state_simple - I use this to simply set a starting graph state.
sum_list([], 0).
sum_list([H|T], Sum) :-
sum_list(T, Rest),
Sum is H + Rest.
invert(1,0).
invert(0,1).
state_of_node(Node,g_s(List),State):-
member(node(Node,State),List).
%all activating nodes in a graph state for a node
all_a(Node,As,Ss,g_s(NodeList)):-
findall(A, a(A,Node),As),
findall(S,(member(M,As),member(node(M,S),NodeList)),Ss).
%all inhibiting nodes in a graph state for a node
all_i(Node,Is,Ss,g_s(NodeList)):-
findall(I, i(I,Node),Is),
findall(S,(member(M,Is),member(node(M,S),NodeList)),Ss).
%sum of activating nodes of a node in a state
sum_a(Node,g_s(NodeList),Sum):-
all_a(Node,_As,Ss,g_s(NodeList)),
sum_list(Ss,Sum).
%sum of inhibiting nodes of a node in a state
sum_i(Node,g_s(NodeList),Sum):-
all_i(Node,_Is,Ss,g_s(NodeList)),
sum_list(Ss,Sum).
above_threshold(Threshold,Node,g_s(NodeList),TrueFalse):-
sum_a(Node,g_s(NodeList),Sum_A),
sum_i(Node,g_s(NodeList),Sum_I),
TrueFalse = true,
Threshold < (Sum_A-Sum_I),
!.
above_threshold(Threshold,Node,g_s(NodeList),TrueFalse):-
sum_a(Node,g_s(NodeList),Sum_A),
sum_i(Node,g_s(NodeList),Sum_I),
TrueFalse = false,
Threshold >= (Sum_A-Sum_I).
%arc needs to be instantiated
state_change(g_s(State1),g_s(State1),Arc):-
above_threshold(0,Arc,g_s(State1),true),
state_of_node(Arc,g_s(State1),1).
state_change(g_s(State1),g_s(State2),Arc):-
above_threshold(0,Arc,g_s(State1),false),
state_of_node(Arc,g_s(State1),1),
my_map(State1,State2,Arc).
state_change(g_s(State1),g_s(State2),Arc):-
above_threshold(0,Arc,g_s(State1),true),
state_of_node(Arc,g_s(State1),0),
my_map(State1,State2,Arc).
state_change(g_s(State1),g_s(State1),Arc):-
above_threshold(0,Arc,g_s(State1),false),
state_of_node(Arc,g_s(State1),0).
%
my_map([],[],_).
my_map([X|T],[Y|L],Arc):-
X= node(Node,Value1),
Node =Arc,
invert(Value1,Value2),
Y = node(Node,Value2),
my_map(T,L,Arc).
my_map([X|T],[Y|L],Arc):-
X= node(Node,Value1),
Node \= Arc,
Y = node(Node,Value1),
my_map(T,L,Arc).
%this is the def in the book which I can not adapt.
path(Begin,Begin,[start(Begin)]).
path(First, Last,[First,Second|Rest]):-
state_change(First,Second,Arc),
path(Second,Last,[Second|Rest]).
%this is the def in the book which I can not adapt.
id_path(First,Last,Template,Path):-
Path = Template,
path(First,Last,Path)
; copy_term(Template,P),
path(First,_,P),
!,
id_path(First,Last,[_|Template],Path).
Since the state space is finite, there will be only finitely many minimal loops or terminal paths. The following options come to mind to represent minimal loops in a graph.
- Rational Terms: Some Prolog systems support rational terms, so a repeating path [0,1,2,2,2,...] can be represented as X = [0,1|Y], Y=[2|Y].
- Non-Rational Terms: You could of course represent a repeating path also as a pair. The previous example would then be ([0,1], [2]).
Detecting a loop pattern and find not only whether something is loop, but also the part that is looping, can be archived by the following code. The append predicate will do the search:
?- append(X, [2|Y], [0,1,2,3]).
X = [0, 1],
Y = [3]
So we know that when we have already found a path [0,1,2,3], and when we see a node 2, that we have found a loop, and we can expressed the found loop with an Omega word as follows [0,1] [2,3]ω. Here is a simple backtracking code:
path(P, P).
path((C,[]), P) :-
last(C, X), edge(X, Y),
extend(C, Y, A, B), path((A,B), P).
extend(C, Y, A, [Y|B]) :-
append(A, [Y|B], C), !.
extend(C, Y, A, []) :-
append(C, [Y], A).
Here is an example run:
?- path(([s(0,1,1)],[]), X).
X = ([s(0,1,1)],[]) ;
X = ([s(0,1,1),s(0,1,0)],[]) ;
X = ([s(0,1,1),s(0,1,0),s(0,0,0)],[]) ;
X = ([s(0,1,1),s(0,1,0)],[s(0,0,0)]) ;
X = ([s(0,1,1)],[s(0,1,0)]) ;
X = ([s(0,1,1),s(1,1,1)],[]) ;
...
I am working on solving the classic Missionaries(M) and Cannibals(C) problem, the start state is 3 M and 3 C on the left bank and the goal state is 3M, 3C on the right bank. I have complete the basic function in my program and I need to implemet the search-strategy such as BFS and DFS.
Basically my code is learn from the Internet. So far I can successfuly run the program with DFS method, but I try to run with BFS it always return false. This is my very first SWI-Prolog program, I can not find where is the problem of my code.
Here is part of my code, hope you can help me find the problem of it
solve2 :-
bfs([[[3,3,left]]],[0,0,right],[[3,3,left]],Solution),
printSolution(Solution).
bfs([[[A,B,C]]],[A,B,C],_,[]).
bfs([[[A,B,C]|Visisted]|RestPaths],[D,E,F],Visisted,Moves) :-
findall([[I,J,K],[A,B,C]|Visited]),
(
move([A,B,C],[I,J,K],Description),
safe([I,J,K]),
not(member([I,J,K],Visited)
),
NewPaths
),
append(RestPaths,NewPaths,CurrentPaths),
bfs(CurrentPaths,[D,E,F],[[I,J,K]|Visisted],MoreMoves),
Moves = [ [[A,B,C],[I,J,K],Description] | MoreMoves ].
move([A,B,left],[A1,B,right],'One missionary cross river') :-
A > 0, A1 is A - 1.
% Go this state if left M > 0. New left M is M-1
.
.
.
.
.
safe([A,B,_]) :-
(B =< A ; A = 0),
A1 is 3-A, B1 is 3-B,
(B1 =< A1; A1 =0).
I use findall to find all possible path before go to next level. Only the one pass the safe() will be consider as possible next state. The state will not use if it already exist. Since my program can run with DFS so I think there is nothing wrong with move() and safe() predicate. My BFS predicate is changing base on my DFS code, but its not work.
There is a very simple way to turn a depth-first search program into a breadth-first one, provided the depth-first search is directly mapped to Prolog's search. This technique is called iterative deepening.
Simply add an additional argument to ensure that the search will only go N steps deep.
So a dfs-version:
dfs(State) :-
final(State).
dfs(State1) :-
state_transition(State1, State2),
dfs(State2).
Is transformed into a bfs by adding an argument for the depth. E.g. by using successor-arithmetics:
bfs(State, _) :-
final(State).
bfs(State1, s(X)) :-
state_transition(State1, State2),
bfs(State2, X).
A goal bfs(State,s(s(s(0)))) will now find all derivations requiring 3 or less steps. You still can perform dfs! Simply use bfs(State,X).
To find all derivations use natural_number(X), bfs(State,X).
Often it is useful to use a list instead of the s(X)-number. This list might contain all intermediary states or the particular transitions performed.
You might hesitate to use this technique, because it seems to recompute a lot of intermediary states ("repeatedly expanded states"). After all, first it searches all paths with one step, then, at most two steps, then, at most three steps... However, if your problem is a search problem, the branching factor here hidden within state_transition/2 will mitigate that overhead. To see this, consider a branching factor of 2: We only will have an overhead of a factor of two! Often, there are easy ways to regain that factor of two: E.g., by speeding up state_transition/2 or final/1.
But the biggest advantage is that it does not consume a lot of space - in contrast to naive dfs.
The Logtalk distribution includes an example, "searching", which implements a framework for state space searching:
https://github.com/LogtalkDotOrg/logtalk3/tree/master/examples/searching
The "classical" problems are included (farmer, missionaries and cannibals, puzzle 8, bridge, water jugs, etc). Some of the search algorithms are adapted (with permission) from Ivan Bratko's book "Prolog programming for artificial intelligence". The example also includes a performance monitor that can give you some basic stats on the performance of a search method (e.g. branching factors and number of state transitions). The framework is easy to extend, both for new problems and new search methods.
If anyone still interested in this for a python solution please find the following.
For the simplification, count of Missionaries and Cannibals on left is only taken to the consideration.
This is the solution tree.
#M #missionaries in left
#C #cannibals in left
# B=1left
# B=0right
def is_valid(state):
if(state[0]>3 or state[1]>3 or state[2]>1 or state[0]<0 or state[1]<0 or state[2]<0 or (0<state[0]<state[1]) or (0<(3-state[0])<(3-state[1]))):
return False
else:
return True
def generate_next_states(M,C,B):
moves = [[1, 0, 1], [0, 1, 1], [2, 0, 1], [0, 2, 1], [1, 1, 1]]
valid_states = []
for each in moves:
if(B==1):next_state = [x1 - x2 for (x1, x2) in zip([M, C, B], each)]
else:next_state = [x1 + x2 for (x1, x2) in zip([M, C, B], each)]
if (is_valid(next_state)):
# print(next_state)
valid_states.append(next_state)
return valid_states
solutions = []
def find_sol(M,C,B,visited):
if([M,C,B]==[0,0,0]):#everyne crossed successfully
# print("Solution reached, steps: ",visited+[[0,0,0]])
solutions.append(visited+[[0,0,0]])
return True
elif([M,C,B] in visited):#prevent looping
return False
else:
visited.append([M,C,B])
if(B==1):#boat is in left
for each_s in generate_next_states(M,C,B):
find_sol(each_s[0],each_s[1],each_s[2],visited[:])
else:#boat in in right
for each_s in generate_next_states(M,C,B):
find_sol(each_s[0],each_s[1],each_s[2],visited[:])
find_sol(3,3,1,[])
solutions.sort()
for each_sol in solutions:
print(each_sol)
Please refer to this gist to see a possible solution, maybe helpful to your problem.
Gist: solve Missionaries and cannibals in Prolog
I've solved with depth-first and then with breadth-first, attempting to clearly separate the reusable part from the state search algorithm:
miss_cann_dfs :-
initial(I),
solve_dfs(I, [I], Path),
maplist(writeln, Path), nl.
solve_dfs(S, RPath, Path) :-
final(S),
reverse(RPath, Path).
solve_dfs(S, SoFar, Path) :-
move(S, T),
\+ memberchk(T, SoFar),
solve_dfs(T, [T|SoFar], Path).
miss_cann_bfs :-
initial(I),
solve_bfs([[I]], Path),
maplist(writeln, Path), nl.
solve_bfs(Paths, Path) :-
extend(Paths, Extended),
( member(RPath, Extended),
RPath = [H|_],
final(H),
reverse(RPath, Path)
; solve_bfs(Extended, Path)
).
extend(Paths, Extended) :-
findall([Q,H|R],
( member([H|R], Paths),
move(H, Q),
\+ member(Q, R)
), Extended),
Extended \= [].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% problem representation
% independent from search method
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
initial((3,3, >, 0,0)).
final((0,0, <, 3,3)).
% apply a *valid* move
move((M1i,C1i, Bi, M2i,C2i), (M1f,C1f, Bf, M2f,C2f)) :-
direction(Bi, F1, F2, Bf),
who_move(MM, CM),
M1f is M1i + MM * F1, M1f >= 0,
C1f is C1i + CM * F1, C1f >= 0,
( M1f >= C1f ; M1f == 0 ),
M2f is M2i + MM * F2, M2f >= 0,
C2f is C2i + CM * F2, C2f >= 0,
( M2f >= C2f ; M2f == 0 ).
direction(>, -1, +1, <).
direction(<, +1, -1, >).
% valid placements on boat
who_move(M, C) :-
M = 2, C = 0 ;
M = 1, C = 0 ;
M = 1, C = 1 ;
M = 0, C = 2 ;
M = 0, C = 1 .
I suggest you to structure your code in a similar way, with a predicate similar to extend/2, that make clear when to stop the search.
If your Prolog system has a forward chainer you can also solve
the problem by modelling it via forward chaining rules. Here
is an example how to solve a water jug problem in Jekejeke Minlog.
The state is represented by a predicate state/2.
You first give a rule that filters duplicates as follows. The
rule says that an incoming state/2 fact should be removed,
if it is already in the forward store:
% avoid duplicate state
unit &:- &- state(X,Y) && state(X,Y), !.
Then you give rules that state that search need not be continued
when a final state is reached. In the present example we check
that one of the vessels contains 1 liter of water:
% halt for final states
unit &:- state(_,1), !.
unit &:- state(1,_), !.
As a next step one models the state transitions as forward chaining
rules. This is straight forward. We model emptying, filling and pouring
of vessels:
% emptying a vessel
state(0,X) &:- state(_,X).
state(X,0) &:- state(X,_).
% filling a vessel
state(5,X) &:- state(_,X).
state(X,7) &:- state(X,_).
% pouring water from one vessel to the other vessel
state(Z,T) &:- state(X,Y), Z is min(5,X+Y), T is max(0,X+Y-5).
state(T,Z) &:- state(X,Y), Z is min(7,X+Y), T is max(0,X+Y-7).
We can now use the forward chaining engine to do the job for us. It
will not do iterative deeping and it will also not do breadth first.
It will just do unit resolution by a strategy that is greedy for the
given fact and the process only completes, since the state space
is finite. Here is the result:
?- post(state(0,0)), posted.
state(0, 0).
state(5, 0).
state(5, 7).
state(0, 7).
Etc..
The approach will tell you whether there is a solution, but not explain
the solution. One approach to make it explainable is to use a fact
state/4 instead of a fact state/2. The last two arguments are used for
a list of actions and for the length of the list.
The rule that avoids duplicates is then changed for a rule that picks
the smallest solution. It reads as follows:
% choose shorter path
unit &:- &- state(X,Y,_,N) && state(X,Y,_,M), M<N, !.
unit &:- state(X,Y,_,N) && &- state(X,Y,_,M), N<M.
We then get:
?- post(state(0,0,[],0)), posted.
state(0, 0, [], 0).
state(5, 0, [fl], 1).
state(5, 7, [fr,fl], 2).
state(0, 5, [plr,fl], 2).
Etc..
With a little helper predicate we can force an explanation of
the actions that lead to a path:
?- post(state(0,0,[],0)), state(1,7,L,_), explain(L).
0-0
fill left vessel
5-0
pour left vessel into right vessel
0-5
fill left vessel
5-5
pour left vessel into right vessel
3-7
empty right vessel
3-0
pour left vessel into right vessel
0-3
fill left vessel
5-3
pour left vessel into right vessel
1-7
Bye
Source Code: Water Jug State
http://www.xlog.ch/jekejeke/forward/jugs3.p
Source Code: Water Jug State and Path
http://www.xlog.ch/jekejeke/forward/jugs3path.p
I have a graph in Prolog represented by the edges & weights:
connected(a,b,2).
connected(b,e,1).
connected(b,l,5).
connected(b,g,2).
connected(c,s,2).
connected(d,a,2).
connected(d,k,4).
connected(d,l,7).
connected(e,m,2).
I need to write a predicate which takes a list of nodes & distance.
?- dist([a,b,e],X).
X=3
I've tried to write it, but it is very clumsy & doesn't give the intended result.
The basic idea I have is:
If it is a list of 2 elements then see if they are connected.
If more then 2 elements in the list: see if the 1st element & 2nd element are connected,
recursively see if the next elements are connected.
I have defined 2 auxiliary predicates for head & tail.
dist([A, B], X) :-
connected(A, B, X).
dist([A|B], Length) :-
connected(A, hd(B,H,N), X), % sees if A & next element in the list are connected
dist(tl(B,H,N), Length1), % recursive call with the list excluding element A
Length is X + Length1.
hd([H|T],H,Q).
tl([H|T],T,Q).
I am very new to Prolog land and I am still trying to comprehend the language semantics.
Please suggest an efficient way to go about this problem.
dist([_], 0). % path of length 0 has distance 0
dist([A, B | T], L) :-
connected(A, B, L1), % A and B are connected directly, the distance is L1
dist([B|T], L2), % the distance between B and the last element is L2
L is L1 + L2.