My professor gave this as an example of Prolog. It is a program that solves the Tower of Hanoi puzzle, where you have to move a stack of disks to another peg by moving one disk after the other, without putting a bigger disk on top of a smaller disk.
Now, I don't like that program. I was told Prolog was meant for declarative programming. I don't want to program how to solve the problem, I want to write down using Prolog what the problem is. Then let Prolog solve it.
My effort so far can be found below. There are two types of lists I employ, a sequence of actions is represented like this: [[1,2],[3,1]]; this would be "move the top disk from peg 1 to peg 2, move the disk from peg 3 to peg 1". My second type of list is a state, for example, if there are three pegs [[1,2,3], [], []] would mean that there are three disks on the first peg. Smaller disks have smaller numbers, so the front of the inner list is the top of a stack.
% A sequence of actions (first argument) is a solution if it leads
% from the begin state (second argument) to the End state (third argument).
solution([], X, X).
solution([[FromIdx | ToIdx] | T], Begin, End) :-
moved(FromIdx, ToIdx, Begin, X),
solution(T, X, End).
% moved is true when Result is the resulting state after moving
% a disk from FromIdx to ToIdx starting at state Start
moved(FromIdx, ToIdx, Start, Result) :-
allowedMove(FromIdx, ToIdx, Start),
nth1(FromIdx, Start, [Disk|OtherDisks]),
nth1(ToIdx, Start, ToStack),
nth1(FromIdx, Result, OtherDisks),
nth1(ToIdx, Result, [Disk|ToStack]).
allowedMove(FromIdx, ToIdx, State) :-
number(FromIdx), number(ToIdx),
nth1(FromIdx, State, [FromDisk|_]),
nth1(ToIdx, State, [ToDisk|_]),
ToDisk > FromDisk.
allowedMove(_, ToIdx, State) :- nth1(ToIdx, State, []).
The above program seems to work, but it is too slow for everything reasonably complex. Asking it to solve the classic Tower of Hanoi problem, moving three disks from the first peg to the third and last, would go like this:
?- solution(Seq, [[1,2,3], [], []], [[], [], [1,2,3]]).
I would like to make some modifications to the program so that it works for this query. How would I go about doing that? When profiling I can see that nth1 uses a lot of time, should I get rid of it? Something that bothers me is that moved is completely deterministic and should only have one result. How can I speed up this bottleneck?
The Prolog solution to Hanoi one typically finds looks something like this. The solution writes the moves out to the screen as it encounters them and doesn't collect the moves in a list:
move_one(P1, P2) :-
format("Move disk from ~k to ~k", [P1, P2]), nl.
move(1, P1, P2, _) :-
move_one(P1, P2).
move(N, P1, P2, P3) :-
N > 1,
N1 is N - 1,
move(N1, P1, P3, P2),
move(1, P1, P2, P3),
move(N1, P3, P2, P1).
hanoi(N) :-
move(N, left, center, right).
This could be modified to collect the moves in a list instead by adding a list argument throughout and using append/3:
move(0, _, _, _, []).
move(N, P1, P2, P3, Moves) :-
N > 0,
N1 is N - 1,
move(N1, P1, P3, P2, M1),
append(M1, [P1-to-P2], M2),
move(N1, P3, P2, P1, M3),
append(M2, M3, Moves).
hanoi(N, Moves) :-
move(N, left, center, right, Moves).
We were able to make the base case simpler without the write. The append/3 does the job, but it's a bit clunky. Also, the is/2 in particular makes it non-relational.
By using a DCG and CLP(FD), the append/3 can be eliminated and it can be made more relational. Here's what I'd call an initial "naive" approach, and it is also more readable:
hanoi_dcg(N, Moves) :-
N in 0..1000,
phrase(move(N, left, center, right), Moves).
move(0, _, _, _) --> [].
move(N, P1, P2, P3) -->
{ N #> 0, N #= N1 + 1 },
move(N1, P1, P3, P2),
[P1-to-P2],
move(N1, P3, P2, P1).
This results in:
| ?- hanoi_dcg(3, Moves).
Moves = [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center] ? a
no
| ?- hanoi_dcg(N, [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center]).
N = 3 ? ;
(205 ms) no
| ?-
Although it's relational, it does have a couple of issues:
Useless choice points in "both directions"
Termination issues unless constrained with something like N in 0..1000
I sense there's a way around these two issues, but haven't worked that out yet. (I'm sure if some smarter Prologers than I, such as #mat, #false, or #repeat see this, they'll have a good answer right off.)
I looked at your solution and here is some thought I had about it:
When you move, what you're doing is take from one tower and put on another.
There is a SWI-Predicate that replaces an element in a list, select/4. But you also want to have the index where you replaced it. so lets rewrite it a little, and call it switch_nth1, because it doesn't have to do much with select anymore.
% switch_nth1(Element, FromList, Replacement, ToList, Index1)
switch_nth1(Elem, [Elem|L], Repl, [Repl|L], 1).
switch_nth1(Elem, [A|B], D, [A|E], M) :-
switch_nth1(Elem, B, D, E, N),
M is N+1.
Since we're operating on List of Lists, we'll need two switch_nth1 calls: one to replace the Tower we take from, and one to put it on the new tower.
A move predicate could look like this (sorry I changed the arguments a little). (It should be called allowed_move because it doesn't do moves that aren't allowed).
move((FromX - ToX), BeginState, NewState):-
% take a disk from one tower
switch_nth1([Disk| FromTowerRest], BeginState, FromTowerRest, DiskMissing, FromX),
% put the disk on another tower.
switch_nth1(ToTower, DiskMissing, [Disk|ToTower], NewState, ToX),
% there are two ways how the ToTower can look like:
(ToTower = []; % it's empty
ToTower = [DiskBelow | _], % it already has some elements on it.
DiskBelow > Disk).
If you plug that into your solution you sadly run into some termination issues, since noone said that a state that already has been reached shouldn't be a right step on the way. Thus, we need to keep track where we already were and disallow continuation when a known state is reached.
solution(A,B,C):-solution_(A,B,C,[B]).
solution_([], X, X,_).
solution_([Move | R], BeginState, EndState, KnownStates):-
move(Move, BeginState, IntermediateState),
\+ memberchk(IntermediateState, KnownStates), % don't go further, we've been here.
solution_(R, IntermediateState, EndState, [IntermediateState | KnownStates]).
That said, this solution still is very imperative – there should be nicer solutions out there, where you really take advantage of recursion.
By "declarative" I'll assume you mean something close to the old slogan of "in Prolog, to write down a question is to have the answer to it". Let Prolog discover the answer instead of me just coding in Prolog the answer that I had to find out on my own.
Simply defining a legal_move predicate, stating the initial and final condition and running a standard search of whatever variety, leads to extremely very inefficient solution that will backtrack a whole lot.
Making a computer derive the efficient solution here seems a very hard problem to me. For us humans though, with just a little bit of thinking the solution is obvious, cutting away all the redundancy too, making any comparisons and checking the legality of positions completely unnecessary -- the solution is efficient and every move is legal by construction.
If we can move N = M + K disks, we can move M of them just the same - the other two pegs are empty, and we pretend the lower K disks aren't there.
But having moved the M disks, we're faced with the remaining K. Wherever the M disks went, we can't move any of the K there, because by construction the K disks are all "larger" than any of the M ("larger" simply because they were beneath them initially on the source peg).
But the third peg is empty. It is easy to move one disk there. Wouldn't it be just peachy if K were equal 1? Having moved the remaining K = 1 disk to the empty target peg, we again can pretend it isn't there (because it's the "largest") and move the M disks on top of it.
The vital addition: since M disks are to be moved to target in the second phase, initially they are to be moved into the spare.
This all means that if we knew how to move M disks, we could easily move M + 1. Induction, recursion, DONE!
If you knew all this already, apologies for the load of verbiage. The code:
hanoi(Disks, Moves):-
phrase( hanoi(Disks, [source,target,spare]), Moves).
hanoi( Disks, [S,T,R]) -->
{ append( M, [One], Disks) },
hanoi( M, [S,R,T]),
[ moving( One, from(S), to(T)) ],
hanoi( M, [R,T,S]).
hanoi( [], _) --> [ ].
Testing:
4 ?- hanoi([1,2,3], _X), maplist( writeln, _X).
moving(1,from(source),to(target))
moving(2,from(source),to(spare))
moving(1,from(target),to(spare))
moving(3,from(source),to(target))
moving(1,from(spare),to(source))
moving(2,from(spare),to(target))
moving(1,from(source),to(target)) ;
false.
Related
I'm generating random coordinates and adding on my list, but first I need verify if that coordinate already exists. I'm trying to use member but when I was debugging I saw that isn't working:
My code is basically this:
% L is a list and Q is a count that define the number of coordinate
% X and Y are the coordinate members
% check if the coordniate already exists
% if exists, R is 0 and if not, R is 1
createCoordinates(L,Q) :-
random(1,10,X),
random(1,10,Y),
convertNumber(X,Z),
checkCoordinate([Z,Y],L,R),
(R is 0 -> print('member'), createCoordinates(L,Q); print('not member'),createCoordinates(L,Q-1).
checkCoordinate(C,L,R) :-
(member(C,L) -> R is 0; R is 1).
% transforms the number N in a letter L
convertNumber(N,L) :-
N is 1, L = 'A';
N is 2, L = 'B';
...
N is 10, L = 'J'.
%call createCoordinates
createCoordinates(L,20).
When I was debugging this was the output:
In this picture I'm in the firts interation and L is empty, so R should be 1 but always is 0, the coordinate always is part of the list.
I have the impression that the member clause is adding the coordinate at my list and does'nt make sense
First off, I would recommend breaking your problem down into smaller pieces. You should have a procedure for making a random coordinate:
random_coordinate([X,Y]) :-
random(1, 10, XN), convertNumber(XN, X),
random(1, 10, Y).
Second, your checkCoordinate/3 is converting Prolog's success/failure into an integer, which is just busy work for Prolog and not really improving life for you. memberchk/2 is completely sufficient to your task (member/2 would work too but is more powerful than necessary). The real problem here is not that member/2 didn't work, it's that you are trying to build up this list parameter on the way out, but you need it to exist on the way in to examine it.
We usually solve this kind of problem in Prolog by adding a third parameter and prepending values to the list on the way through. The base case then equates that list with the outbound list and we protect the whole thing with a lower-arity procedure. In other words, we do this:
random_coordinates(N, Coordinates) :- random_coordinates(N, [], Coordinates).
random_coordinates(0, Result, Result).
random_coordinates(N, CoordinatesSoFar, FinalResult) :- ...
Now that we have two things, memberchk/2 should work the way we need it to:
random_coordinates(N, CoordinatesSoFar, FinalResult) :-
N > 0, succ(N0, N), % count down, will need for recursive call
random_coordinate(Coord),
(memberchk(Coord, CoordinatesSoFar) ->
random_coordinates(N, CoordinatesSoFar, FinalResult)
;
random_coordinates(N0, [Coord|CoordinatesSoFar], FinalResult)
).
And this seems to do what we want:
?- random_coordinates(10, L), write(L), nl.
[[G,7],[G,3],[H,9],[H,8],[A,4],[G,1],[I,9],[H,6],[E,5],[G,8]]
?- random_coordinates(10, L), write(L), nl.
[[F,1],[I,8],[H,4],[I,1],[D,3],[I,6],[E,9],[D,1],[C,5],[F,8]]
Finally, I note you continue to use this syntax: N is 1, .... I caution you that this looks like an error to me because there is no distinction between this and N = 1, and your predicate could be stated somewhat tiresomely just with this:
convertNumber(1, 'A').
convertNumber(2, 'B').
...
My inclination would be to do it computationally with char_code/2 but this construction is actually probably better.
Another hint that you are doing something wrong is that the parameter L to createCoordinates/2 gets passed along in all cases and is not examined in any of them. In Prolog, we often have variables that appear to just be passed around meaninglessly, but they usually change positions or are used multiple times, as in random_coordinates(0, Result, Result); while nothing appears to be happening there, what's actually happening is plumbing: the built-up parameter becomes the result value. Nothing interesting is happening to the variable directly there, but it is being plumbed around. But nothing is happening at all to L in your code, except it is supposedly being checked for a new coordinate. But you're never actually appending anything to it, so there's no reason to expect that anything would wind up in L.
Edit Notice that #lambda.xy.x solves the problem in their answer by prepending the new coordinate in the head of the clause and examining the list only after the recursive call in the body, obviating the need for the second list parameter.
Edit 2 Also take a look at #lambda.xy.x's other solution as it has better time complexity as N approaches 100.
Since i had already written it, here is an alternative solution: The building block is gen_coord_notin/2 which guarantees a fresh solution C with regard to an exclusion list Excl.
gen_coord_notin(C, Excl) :-
random(1,10,X),
random(1,10,Y),
( memberchk(X-Y, Excl) ->
gen_coord_notin(C, Excl)
;
C = X-Y
).
The trick is that we only unify C with the new result, if it is fresh.
Then we only have to fold the generations into N iterations:
gen_coords([], 0).
gen_coords([X|Xs], N) :-
N > 0,
M is N - 1,
gen_coords(Xs, M),
gen_coord_notin(X, Xs).
Remark 1: since coordinates are always 2-tuples, a list representation invites unwanted errors (e.g. writing [X|Y] instead of [X,Y]). Traditionally, an infix operator like - is used to seperate tuples, but it's not any different than using coord(X,Y).
Remark 2: this predicate is inherently non-logical (i.e. calling gen_coords(X, 20) twice will result in different substitutions for X). You might use the meta-level predicates var/1, nonvar/1, ground/1, integer, etc. to guard against non-sensical calls like gen_coord(1-2, [1-1]).
Remark 3: it is also important that the conditional does not have multiple solutions (compare member(X,[A,B]) and memberchk(X,[A,B])). In general, this can be achieved by calling once/1 but there is a specialized predicate memberchk/2 which I used here.
I just realized that the performance of my other solutions is very bad for N close to 100. The reason is that with diminishing possible coordinates, the generate and test approach will take longer and longer. There's an alternative solution which generates all coordinates and picks N random ones:
all_pairs(Ls) :-
findall(X-Y, (between(1,10,X), between(1,10,Y)), Ls).
remove_index(X,[X|Xs],Xs,0).
remove_index(I,[X|Xs],[X|Rest],N) :-
N > 0,
M is N - 1,
remove_index(I,Xs,Rest,M).
n_from_pool(_Pool, [], 0).
n_from_pool(Pool, [C|Cs], N) :-
N > 0,
M is N - 1,
length(Pool, L),
random(0,L,R),
remove_index(C,Pool,NPool,R),
n_from_pool(NPool, Cs, M).
gen_coords2(Xs, N) :-
all_pairs(Pool),
n_from_pool(Pool, Xs, N).
Now the query
?- gen_coords2(Xs, 100).
Xs = [4-6, 5-6, 5-8, 9-6, 3-1, 1-3, 9-4, 6-1, ... - ...|...] ;
false.
succeeds as expected. The error message
?- gen_coords2(Xs, 101).
ERROR: random/1: Domain error: not_less_than_one' expected, found0'
when we try to generate more distinct elements than possible is not nice, but better than non-termination.
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]).
This is a question provoked by an already deleted answer to this question. The issue could be summarized as follows:
Is it possible to fold over a list, with the tail of the list generated while folding?
Here is what I mean. Say I want to calculate the factorial (this is a silly example but it is just for demonstration), and decide to do it like this:
fac_a(N, F) :-
must_be(nonneg, N),
( N =< 1
-> F = 1
; numlist(2, N, [H|T]),
foldl(multiplication, T, H, F)
).
multiplication(X, Y, Z) :-
Z is Y * X.
Here, I need to generate the list that I give to foldl. However, I could do the same in constant memory (without generating the list and without using foldl):
fac_b(N, F) :-
must_be(nonneg, N),
( N =< 1
-> F = 1
; fac_b_1(2, N, 2, F)
).
fac_b_1(X, N, Acc, F) :-
( X < N
-> succ(X, X1),
Acc1 is X1 * Acc,
fac_b_1(X1, N, Acc1, F)
; Acc = F
).
The point here is that unlike the solution that uses foldl, this uses constant memory: no need for generating a list with all values!
Calculating a factorial is not the best example, but it is easier to follow for the stupidity that comes next.
Let's say that I am really afraid of loops (and recursion), and insist on calculating the factorial using a fold. I still would need a list, though. So here is what I might try:
fac_c(N, F) :-
must_be(nonneg, N),
( N =< 1
-> F = 1
; foldl(fac_foldl(N), [2|Back], 2-Back, F-[])
).
fac_foldl(N, X, Acc-Back, F-Rest) :-
( X < N
-> succ(X, X1),
F is Acc * X1,
Back = [X1|Rest]
; Acc = F,
Back = []
).
To my surprise, this works as intended. I can "seed" the fold with an initial value at the head of a partial list, and keep on adding the next element as I consume the current head. The definition of fac_foldl/4 is almost identical to the definition of fac_b_1/4 above: the only difference is that the state is maintained differently. My assumption here is that this should use constant memory: is that assumption wrong?
I know this is silly, but it could however be useful for folding over a list that cannot be known when the fold starts. In the original question we had to find a connected region, given a list of x-y coordinates. It is not enough to fold over the list of x-y coordinates once (you can however do it in two passes; note that there is at least one better way to do it, referenced in the same Wikipedia article, but this also uses multiple passes; altogether, the multiple-pass algorithms assume constant-time access to neighboring pixels!).
My own solution to the original "regions" question looks something like this:
set_region_rest([A|As], Region, Rest) :-
sort([A|As], [B|Bs]),
open_set_closed_rest([B], Bs, Region0, Rest),
sort(Region0, Region).
open_set_closed_rest([], Rest, [], Rest).
open_set_closed_rest([X-Y|As], Set, [X-Y|Closed0], Rest) :-
X0 is X-1, X1 is X + 1,
Y0 is Y-1, Y1 is Y + 1,
ord_intersection([X0-Y,X-Y0,X-Y1,X1-Y], Set, New, Set0),
append(New, As, Open),
open_set_closed_rest(Open, Set0, Closed0, Rest).
Using the same "technique" as above, we can twist this into a fold:
set_region_rest_foldl([A|As], Region, Rest) :-
sort([A|As], [B|Bs]),
foldl(region_foldl, [B|Back],
closed_rest(Region0, Bs)-Back,
closed_rest([], Rest)-[]),
!,
sort(Region0, Region).
region_foldl(X-Y,
closed_rest([X-Y|Closed0], Set)-Back,
closed_rest(Closed0, Set0)-Back0) :-
X0 is X-1, X1 is X + 1,
Y0 is Y-1, Y1 is Y + 1,
ord_intersection([X0-Y,X-Y0,X-Y1,X1-Y], Set, New, Set0),
append(New, Back0, Back).
This also "works". The fold leaves behind a choice point, because I haven't articulated the end condition as in fac_foldl/4 above, so I need a cut right after it (ugly).
The Questions
Is there a clean way of closing the list and removing the cut? In the factorial example, we know when to stop because we have additional information; however, in the second example, how do we notice that the back of the list should be the empty list?
Is there a hidden problem I am missing?
This looks like its somehow similar to the Implicit State with DCGs, but I have to admit I never quite got how that works; are these connected?
You are touching on several extremely interesting aspects of Prolog, each well worth several separate questions on its own. I will provide a high-level answer to your actual questions, and hope that you post follow-up questions on the points that are most interesting to you.
First, I will trim down the fragment to its essence:
essence(N) :-
foldl(essence_(N), [2|Back], Back, _).
essence_(N, X0, Back, Rest) :-
( X0 #< N ->
X1 #= X0 + 1,
Back = [X1|Rest]
; Back = []
).
Note that this prevents the creation of extremely large integers, so that we can really study the memory behaviour of this pattern.
To your first question: Yes, this runs in O(1) space (assuming constant space for arising integers).
Why? Because although you continuously create lists in Back = [X1|Rest], these lists can all be readily garbage collected because you are not referencing them anywhere.
To test memory aspects of your program, consider for example the following query, and limit the global stack of your Prolog system so that you can quickly detect growing memory by running out of (global) stack:
?- length(_, E),
N #= 2^E,
portray_clause(N),
essence(N),
false.
This yields:
1.
2.
...
8388608.
16777216.
etc.
It would be completely different if you referenced the list somewhere. For example:
essence(N) :-
foldl(essence_(N), [2|Back], Back, _),
Back = [].
With this very small change, the above query yields:
?- length(_, E),
N #= 2^E,
portray_clause(N),
essence(N),
false.
1.
2.
...
1048576.
ERROR: Out of global stack
Thus, whether a term is referenced somewhere can significantly influence the memory requirements of your program. This sounds quite frightening, but really is hardly an issue in practice: You either need the term, in which case you need to represent it in memory anyway, or you don't need the term, in which case it is simply no longer referenced in your program and becomes amenable to garbage collection. In fact, the amazing thing is rather that GC works so well in Prolog also for quite complex programs that not much needs to be said about it in many situations.
On to your second question: Clearly, using (->)/2 is almost always highly problematic in that it limits you to a particular direction of use, destroying the generality we expect from logical relations.
There are several solutions for this. If your CLP(FD) system supports zcompare/3 or a similar feature, you can write essence_/3 as follows:
essence_(N, X0, Back, Rest) :-
zcompare(C, X0, N),
closing(C, X0, Back, Rest).
closing(<, X0, [X1|Rest], Rest) :- X1 #= X0 + 1.
closing(=, _, [], _).
Another very nice meta-predicate called if_/3 was recently introduced in Indexing dif/2 by Ulrich Neumerkel and Stefan Kral. I leave implementing this with if_/3 as a very worthwhile and instructive exercise. Discussing this is well worth its own question!
On to the third question: How do states with DCGs relate to this? DCG notation is definitely useful if you want to pass around a global state to several predicates, where only a few of them need to access or modify the state, and most of them simply pass the state through. This is completely analogous to monads in Haskell.
The "normal" Prolog solution would be to extend each predicate with 2 arguments to describe the relation between the state before the call of the predicate, and the state after it. DCG notation lets you avoid this hassle.
Importantly, using DCG notation, you can copy imperative algorithms almost verbatim to Prolog, without the hassle of introducing many auxiliary arguments, even if you need global states. As an example for this, consider a fragment of Tarjan's strongly connected components algorithm in imperative terms:
function strongconnect(v)
// Set the depth index for v to the smallest unused index
v.index := index
v.lowlink := index
index := index + 1
S.push(v)
This clearly makes use of a global stack and index, which ordinarily would become new arguments that you need to pass around in all your predicates. Not so with DCG notation! For the moment, assume that the global entities are simply easily accessible, and so you can code the whole fragment in Prolog as:
scc_(V) -->
vindex_is_index(V),
vlowlink_is_index(V),
index_plus_one,
s_push(V),
This is a very good candidate for its own question, so consider this a teaser.
At last, I have a general remark: In my view, we are only at the beginning of finding a series of very powerful and general meta-predicates, and the solution space is still largely unexplored. call/N, maplist/[3,4], foldl/4 and other meta-predicates are definitely a good start. if_/3 has the potential to combine good performance with the generality we expect from Prolog predicates.
If your Prolog implementation supports freeze/2 or similar predicate (e.g. Swi-Prolog), then you can use following approach:
fac_list(L, N, Max) :-
(N >= Max, L = [Max], !)
;
freeze(L, (
L = [N|Rest],
N2 is N + 1,
fac_list(Rest, N2, Max)
)).
multiplication(X, Y, Z) :-
Z is Y * X.
factorial(N, Factorial) :-
fac_list(L, 1, N),
foldl(multiplication, L, 1, Factorial).
Example above first defines a predicate (fac_list) which creates a "lazy" list of increasing integer values starting from N up to maximum value (Max), where next list element is generated only after previous one was "accessed" (more on that below). Then, factorial just folds multiplication over lazy list, resulting in constant memory usage.
The key to understanding how this example works is remembering that Prolog lists are, in fact, just terms of arity 2 with name '.' (actually, in Swi-Prolog 7 the name was changed, but this is not important for this discussion), where first element represents list item and the second element represents tail (or terminating element - empty list, []). For example. [1, 2, 3] can be represented as:
.(1, .(2, .(3, [])))
Then, freeze is defined as follows:
freeze(+Var, :Goal)
Delay the execution of Goal until Var is bound
This means if we call:
freeze(L, L=[1|Tail]), L = [A|Rest].
then following steps will happen:
freeze(L, L=[1|Tail]) is called
Prolog "remembers" that when L will be unified with "anything", it needs to call L=[1|Tail]
L = [A|Rest] is called
Prolog unifies L with .(A, Rest)
This unification triggers execution of L=[1|Tail]
This, obviously, unifies L, which at this point is bound to .(A, Rest), with .(1, Tail)
As a result, A gets unified with 1.
We can extend this example as follows:
freeze(L1, L1=[1|L2]),
freeze(L2, L2=[2|L3]),
freeze(L3, L3=[3]),
L1 = [A|R2], % L1=[1|L2] is called at this point
R2 = [B|R3], % L2=[2|L3] is called at this point
R3 = [C]. % L3=[3] is called at this point
This works exactly like the previous example, except that it gradually generates 3 elements, instead of 1.
As per Boris's request, the second example implemented using freeze. Honestly, I'm not quite sure whether this answers the question, as the code (and, IMO, the problem) is rather contrived, but here it is. At least I hope this will give other people the idea what freeze might be useful for. For simplicity, I am using 1D problem instead of 2D, but changing the code to use 2 coordinates should be rather trivial.
The general idea is to have (1) function that generates new Open/Closed/Rest/etc. state based on previous one, (2) "infinite" list generator which can be told to "stop" generating new elements from the "outside", and (3) fold_step function which folds over "infinite" list, generating new state on each list item and, if that state is considered to be the last one, tells generator to halt.
It is worth to note that list's elements are used for no other reason but to inform generator to stop. All calculation state is stored inside accumulator.
Boris, please clarify whether this gives a solution to your problem. More precisely, what kind of data you were trying to pass to fold step handler (Item, Accumulator, Next Accumulator)?
adjacent(X, Y) :-
succ(X, Y) ;
succ(Y, X).
state_seq(State, L) :-
(State == halt -> L = [], !)
;
freeze(L, (
L = [H|T],
freeze(H, state_seq(H, T))
)).
fold_step(Item, Acc, NewAcc) :-
next_state(Acc, NewAcc),
NewAcc = _:_:_:NewRest,
(var(NewRest) ->
Item = next ;
Item = halt
).
next_state(Open:Set:Region:_Rest, NewOpen:NewSet:NewRegion:NewRest) :-
Open = [],
NewOpen = Open,
NewSet = Set,
NewRegion = Region,
NewRest = Set.
next_state(Open:Set:Region:Rest, NewOpen:NewSet:NewRegion:NewRest) :-
Open = [H|T],
partition(adjacent(H), Set, Adjacent, NotAdjacent),
append(Adjacent, T, NewOpen),
NewSet = NotAdjacent,
NewRegion = [H|Region],
NewRest = Rest.
set_region_rest(Ns, Region, Rest) :-
Ns = [H|T],
state_seq(next, L),
foldl(fold_step, L, [H]:T:[]:_, _:_:Region:Rest).
One fine improvement to the code above would be making fold_step a higher order function, passing it next_state as the first argument.
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've looked through the similar questions but can't find anything that's relevant to my problem. I'm struggling to find an algorithm or set of 'loops' that will find a path from CityA to CityB, using a database of
distance(City1,City2,Distance)
facts. What I've managed to do so far is below, but it always backtracks at write(X), and then completes with the final iteration, which is what I want it to do but only to a certain extent.
For example, I don't want it to print out any city names that are dead ends, or to use the final iteration. I want it to basically make a path from CityA to CityB, writing the name of the cities it goes to on the path.
I hope somebody can help me!
all_possible_paths(CityA, CityB) :-
write(CityA),
nl,
loop_process(CityA, CityB).
loop_process(CityA, CityB) :-
CityA == CityB.
loop_process(CityA, CityB) :-
CityA \== CityB,
distance(CityA, X, _),
write(X),
nl,
loop_process(X, CityB).
I tried to demonstrate how you can achieve what you're working on so that you can understand better how it works. So since your OP wasn't very complete, I took some liberties ! Here are the facts I'm working with :
road(birmingham,bristol, 9).
road(london,birmingham, 3).
road(london,bristol, 6).
road(london,plymouth, 5).
road(plymouth,london, 5).
road(portsmouth,london, 4).
road(portsmouth,plymouth, 8).
Here is the predicate we will call to find our paths, get_road/4. It basically calls the working predicate, that has two accumulators (one for the points already visited and one for the distance we went through).
get_road(Start, End, Visited, Result) :-
get_road(Start, End, [Start], 0, Visited, Result).
Here is the working predicate,
get_road/6 : get_road(+Start, +End, +Waypoints, +DistanceAcc, -Visited, -TotalDistance) :
The first clause tells that if there is a road between our first point and our last point, we can end here.
get_road(Start, End, Waypoints, DistanceAcc, Visited, TotalDistance) :-
road(Start, End, Distance),
reverse([End|Waypoints], Visited),
TotalDistance is DistanceAcc + Distance.
The second clause tells that if there is a road between our first point and an intermediate point, we can take it and then solve get_road(intermediate, end).
get_road(Start, End, Waypoints, DistanceAcc, Visited, TotalDistance) :-
road(Start, Waypoint, Distance),
\+ member(Waypoint, Waypoints),
NewDistanceAcc is DistanceAcc + Distance,
get_road(Waypoint, End, [Waypoint|Waypoints], NewDistanceAcc, Visited, TotalDistance).
Usage is as follows :
?- get_road(portsmouth, plymouth, Visited, Distance).
And yields :
Visited = [portsmouth, plymouth],
Distance = 8 ;
Visited = [portsmouth, london, plymouth],
Distance = 9 ;
Visited = [portsmouth, plymouth, london, plymouth],
Distance = 18 ;
false.
I hope it will be helpful to you.
Please separate the pure part from the impure (I/O, like write/1, nl/0 but also (==)/2 and (\==)/2). As long as they are entirely interlaced with your pure code you cannot expect much.
Probably you want a relation between a starting point, an end point and a path in between.
Should that path be acyclic or do you permit cycles?
To ensure that an element X does not occur in a list Xs use the goal maplist(dif(X),Xs).
You do not need any further auxiliary predicates to make this a nice relation!
You should return a successful list as an Out variable in all_possible_paths. Then write out that list. Don't do both in the same procedure.