The distance between a long sequence and a short sequence, is the minimum distance between the short sequence and any subsequence of the long sequence that is the same length as the short sequence.
The distance I am using is I think the Manhattan distance. (But this should be unimportant as I would like to be able to change distance functions).
This first version shows a naive implementation without early abandon. I generate all subsequence of the same length, map these to find the distance between them and the short sequence and then use aggregate/3 to find the min.
abs(X,Y,Z):-
Z is abs(X-Y).
seq_seq_absdis(Seq1,Seq2,Dis):-
same_length(Seq1,Seq2),
maplist(abs,Seq1,Seq2,Dislist),
sumlist(Dislist,Dis).
seq_subseq(List1,List2):-
append(List2,_,List1),
dif(List2,[]).
seq_subseq([_|T],Subseq):-
seq_subseq(T,Subseq).
smallseq_largeseq_dis(Sseq,Lseq,Dis):-
findall(Subseq, (same_length(Subseq,Sseq),seq_subseq(Lseq,Subseq)),Subseqs),
maplist(seq_seq_absdis(Sseq),Subseqs,Distances),
aggregate(min(D),member(D,Distances),Dis).
Example query:
?-smallseq_largeseq_dis([1,2,4],[1,2,3,1,2,5],Dis).
Dis = 1
This next version should be more efficient, as it will abandon calculating the distance between a subsequence of the long sequence and the short sequence once the distance is over the minimum already found.
ea_smallseq_largeseq_dis(Sseq,Lseq,Subseq,Dis):-
retractall(best(_,_)),
assert(best(initial,10000)),
findall(Subseq-Dis, ea_smallseq_largeseq_dis_h(Sseq,Lseq,10000,Subseq,Dis),Pairs),
append(_,[Subseq-Dis|[]],Pairs).
ea_smallseq_largeseq_dis_h(Sseq,Lseq,BestSofar1,Subseq,Dis):-
same_length(Sseq,Subseq),
seq_subseq(Lseq,Subseq),
best(_,BestSofar2),
( ( BestSofar2 < BestSofar1) ->
accumulate_dis(Sseq,Subseq,BestSofar2,Dis),
retractall(best(_,_)),
assert(best(Subseq,Dis))
;(
accumulate_dis(Sseq,Subseq,BestSofar1,Dis),
retractall(best(_,_)),
assert(best(Subseq,Dis))
)
).
accumulate_dis(Seq1,Seq2,Best,Dis):-
accumulate_dis(Seq1,Seq2,Best,Dis,0).
accumulate_dis([],[],_Best,Dis,Dis).
accumulate_dis(Seq1,Seq2,Best,Dis,Ac):-
Seq1=[H1|T1],
Seq2=[H2|T2],
abs(H1,H2,Dis1),
Ac1 is Dis1 + Ac,
Ac1 <Best,
accumulate_dis(T1,T2,Best,Dis,Ac1).
Query:
?-ea_smallseq_largeseq_dis([1,2,3],[1,2,4,5,6,7,8,1,2,3],Subseq,Dis).
Dis = 0,
Subseq = [1, 2, 3]
But in this I have used assert and retract so I want to have a version which does the same algorithm but with out these. I think I should be able to do this with a dcg with semicontext notation but find it hard to grasp... how do I keep track of the subsequences I am generating by backtracking and at the same time the 'state' of the minimum distance found so far?
The problem I have..
seq_subseq/2 is generating the sub-sequences by back tracking.
The first subseq tested needs to be set to the min distance.
I then want to loop, so back track to generate another sequence. But to back track I have to fail. But then I cant bring back the min distance so far to check on the next sequence.
If I don't want to use backtracking, I think I need to define a state transition predicate for generating the sub-sequences in order.
At the moment
? seq_subseq([1,2,3,4],X).
X = [1]
X = [1, 2]
X = [1, 2, 3]
X = [1, 2, 3, 4]
X = [2]
X = [2, 3]
X = [2, 3, 4]
X = [3]
X = [3, 4]
X = [4]
So I think I need to define a relation:
subseq0_seq_subseq1(Subseq0,Seq,Subseq1)
That would work like:
?-subseq0_seq_subseq1([1,2,3,4],[1,2,3,4],Subseq1).
Subseq1 = [2].
and
?-subseq0_seq_subseq1([1,2,3],[1,2,3,4],Subseq1).
Subseq1 = [1,2,3,4].
But I need to do this in an efficient way.
Update- Thanks to the answer from Mat I now have this, which is a great improvement I think. Can anyone see any further improvements to this? I have a double nested -> structure and a ! in the accumulate_dis/4 definition both of which seem ugly. I have also made it return the sub-sequence of the long-sequence which is the shortest distance away from the short sequence.
It needs to work with non integers so clpfd is not appropriate I think.
abs(X,Y,Z):-
Z is abs(X-Y).
list_subseq_min(Ls, Subs, Min,BestSeq1) :-
prefix_dist(Ls, Subs, 1000, Front, D0),
BestSeq0=Front,
min_sublist(Ls, Subs,BestSeq0,BestSeq1, D0, Min).
prefix_dist(Ls, Ps, Best,Front,D) :-
same_length(Front, Ps),
append(Front, _, Ls),
accumulate_dis(Front, Ps, Best, D).
min_sublist(Ls0, Subs, BestSeq0,BestSeq2, D0, D) :-
( prefix_dist(Ls0, Subs, D0, Front,D1) ->
min_list([D0,D1],D2),
Ls0 = [_|Ls],
( D0 < D1 ->
BestSeq1 =BestSeq0
;
BestSeq1 =Front
),
min_sublist(Ls, Subs, BestSeq1,BestSeq2, D2, D)
; D = D0,BestSeq0 =BestSeq2
).
accumulate_dis(Seq1,Seq2,Best,Dis):-
accumulate_dis(Seq1,Seq2,Best,Dis,0),!.
accumulate_dis([],[],_Best,Dis,Dis).
accumulate_dis(Seq1,Seq2,Best,Dis,Ac):-
Seq1=[H1|T1],
Seq2=[H2|T2],
abs(H1,H2,Dis1),
Ac1 is Dis1 + Ac,
Ac1 <Best,
accumulate_dis(T1,T2,Best,Dis,Ac1).
accumulate_dis(Seq1,Seq2,Best,Dis):-Dis is Best+1.
query:
?- list_subseq_min([2.1,3.4,4,1.1,2,4,10,12,15],[1,2,3],D,B).
D = 1.1,
B = [1.1, 2, 4].
One important note: You should have clearified that you are talking about the Manhatten distance between lists. This was only clear from your code, whereas your wording can easily lead readers to assume you are talking about the edit distance.
Here is a solution that simply walks the list, keeps track of the minimum, and eventually yields the found minimum.
list_subseq_min(Ls, Subs, Min) :-
prefix_dist(Ls, Subs, D0),
min_sublist(Ls, Subs, D0, Min).
absdiff(X, Y, Z):- Z #= abs(X-Y).
lists_dist(Ls1, Ls2, D) :-
maplist(absdiff, Ls1, Ls2, Ds),
sum(Ds, #=, D).
prefix_dist(Ls, Ps, D) :-
same_length(Front, Ps),
append(Front, _, Ls),
lists_dist(Front, Ps, D).
min_sublist(Ls0, Subs, D0, D) :-
( prefix_dist(Ls0, Subs, D1) ->
D2 #= min(D0,D1),
Ls0 = [_|Ls],
min_sublist(Ls, Subs, D2, D)
; D #= D0
).
Example query and its result:
?- list_subseq_min([1,2,3,1,2,5], [1,2,4], D).
D = 1.
It's quite straight-forward, and since the bookkeeping is limited to only one predicate, using semicontext notations does not really pay off. It is especially useful to use semicontext notation—and DCGs in general—when what is being described spans different rules and communication between them would otherwise be harder.
The running time is in O(N×M).
And now the point, which I leave as an exercise: Modify this solution to prune earlier, if the previously found minimum is already exceeded. Do so in a pure way, or at least as pure as possible: assertz/1 and friends are definitely out of the question, since they prevent your testing these predicates in isolation. Pass around arguments and build the distance more incrementally! This may help you to improve the average running time, though of course not the worst case complexity.
It is for this passing around states between different clauses that semicontext notation may become useful at last.
EDIT: Very well, you have implemented a solution that does the pruning. I will now also show mine. I will reuse the auxiliary predicates absdiff/3 and lists_dist/3 from above, and the following additional auxiliary predicate:
same_length_prefix(Ls, Ps, Front) :-
same_length(Front, Ps),
append(Front, _, Ls).
list_subseq_min/3 is now slightly different:
list_subseq_min(Ls, Subs, Min) :-
same_length_prefix(Ls, Subs, Front),
lists_dist(Front, Subs, D0),
phrase(min_sublist(Ls, Subs), [D0-Front], [Min-_]).
And now the point: min_sublist//2 is a DCG nonterminal that concisely describes the main idea of the algorithm:
min_sublist(Ls0, Subs) -->
( front(Ls0, Subs) ->
{ Ls0 = [_|Ls] },
min_sublist(Ls, Subs)
; []
).
From this description, it is very clear that we are considering the list element by element. It uses fewer (explicit) arguments than previously. The additional two arguments are implicitly passed around as a pair D-Front, which keeps track of the best distance and subsequence found so far. Note how DCG notation exposes the core of the computation, and hides what is not relevant at this place.
The rest is quite self-explanatory, and is analogous to the pruning you have implemented. I highlight the single use of semicontext notation in this program, which lets us express any change of the optimal sequence found so far.
front(Ls, Subs), [D-Front] -->
[Current],
{ same_length_prefix(Ls, Subs, Front1),
capped_dist(Front1, Subs, Current, 0-Front1, D-Front) }.
capped_dist([], [], _, DF, DF).
capped_dist([L|Ls], [P|Ps], Current, D1-Front1, DF) :-
absdiff(L, P, D2),
D3 #= D1 + D2,
Current = D0-_,
( D3 #> D0 -> DF = Current
; capped_dist(Ls, Ps, Current, D3-Front1, DF)
).
I can't bring myself to accept the nastiness and primitiveness of contemporary floating-point numbers, so I have retained the integer arithmetic and simply multiply all numbers you show so that they become integers:
?- list_subseq_min([21,34,40,11,20,40,100,120,150], [10,20,30], D).
D = 11.
I leave extending this so that it also shows the found subsequence as an easy exercise.
One important note: The capping only affects the calculation of the distance; note in particular that the running time is Θ(N×M) due to the way same_length_prefix/3 is used in front//2! I leave improving this as a slightly harder exercise.
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.
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.
The term fib(N,F) is true when F is the Nth Fibonacci number.
The following Prolog code is generally working for me:
:-use_module(library(clpfd)).
fib(0,0).
fib(1,1).
fib(N,F) :-
N #> 1,
N #=< F + 1,
F #>= N - 1,
F #> 0,
N1 #= N - 1,
N2 #= N - 2,
F1 #=< F,
F2 #=< F,
F #= F1 + F2,
fib(N1,F1),
fib(N2,F2).
When executing this query (in SICStus Prolog), the first (and correct) match is found for N (rather instantly):
| ?- fib(X,377).
X = 14 ?
When proceeding (by entering ";") to see if there are any further matches (which is impossible by definition), it takes an enormous amount of time (compared to the first match) just to always reply with no:
| ?- fib(X,377).
X = 14 ? ;
no
Being rather new to Prolog, I tried to use the Cut-Operator (!) in various ways, but I cannot find a way to prevent the search after the first match. Is it even possible given the above rules? If yes, please let me know how :)
There are two parts to get what you want.
The first is to use
call_semidet/1
which ensures that there is exactly one answer. See links for an
implementation for SICStus, too. In the unlikely event of having more
than one answer, call_semidet/1 produces a safe error. Note that
once/1 and !/0 alone simply cut away whatever there has been.
However, you will not be very happy with call_semidet/1 alone. It
essentially executes a goal twice. Once to see if there is no more
than one answer, and only then again to obtain the first answer. So
you will get your answer much later.
The other part is to speed up your definition such that above will not
be too disturbing to you. The solution suggested by CapelliC changes
the algorithm altogether which is specific to your concrete function
but does not extend to any other function. But it also describes a
different relation.
Essentially, you found the quintessential parts already, you only need
to assemble them a bit differently to make them work. But, let's start
with the basics.
CLPFD as CLP(Z)
What you are doing here is still not that common to many Prolog
programmers. You use finite domain constraints for general integer
arithmetics. That is, you are using CLPFD as a pure substitute to the
moded expression evaluation found in (is)/2, (>)/2 and the
like. So you want to extend the finite domain paradigm which assumes
that we express everything within finite given intervals. In fact, it
would be more appropriate to call this extension CLP(Z).
This extension does not work in every Prolog offering finite
domains. In fact, there is only SICStus, SWI and YAP that correctly
handle the case of infinite intervals. Other systems might fail or
succeed when they rather should succeed or fail - mostly when integers
are getting too large.
Understanding non-termination
The first issue is to understand the actual reason why your original
program did not terminate. To this end, I will use a failure
slice. That
is, I add false goals into your program. The point being: if the
resulting program does not terminate then also the original program
does not terminate. So the minimal failure slice of your (presumed)
original program is:
fiborig(0,0) :- false.
fiborig(1,1) :- false.
fiborig(N,F) :-
N #> 1,
N1 #= N-1,
N2 #= N-2,
F #= F1+F2,
fiborig(N1,F1), false,
fiborig(N2,F2).
There are two sources for non-termination here: One is that for a given
F there are infinitely many values for F1 and F2. That can be
easily handled by observing that F1 #> 0, F2 #>= 0.
The other is more related to Prolog's execution mechanism. To
illustrate it, I will add F2 #= 0. Again, because the resulting
program does not terminate, also the original program will loop.
fiborig(0,0) :- false.
fiborig(1,1) :- false.
fiborig(N,F) :-
N #> 1,
N1 #= N-1,
N2 #= N-2,
F #= F1+F2,
F1 #> 0,
F2 #>= 0,
F2 #= 0,
fiborig(N1,F1), false,
fiborig(N2,F2).
So the actual problem is that the goal that might have 0 as result
is executed too late. Simply exchange the two recursive goals. And add
the redundant constraint F2 #=< F1 for efficiency.
fibmin(0,0).
fibmin(1,1).
fibmin(N,F) :-
N #> 1,
N1 #= N-1,
N2 #= N-2,
F1 #> 0,
F2 #>= 0,
F1 #>= F2,
F #= F1+F2,
fibmin(N2,F2),
fibmin(N1,F1).
On my lame laptop I got the following runtimes for fib(N, 377):
SICStus SWI
answer/total
fiborig: 0.090s/27.220s 1.332s/1071.380s
fibmin: 0.080s/ 0.110s 1.201s/ 1.506s
Take the sum of both to get the runtime for call_semidet/1.
Note that SWI's implementation is written in Prolog only, whereas
SICStus is partly in C, partly in Prolog. So when porting SWI's (actually #mat's) clpfd to
SICStus, it might be comparable in speed.
There are still many things to optimize. Think of indexing, and the
handling of the "counters", N, N1, N2.
Also your original program can be improved quite a bit. For example,
you are unnecessarily posting the constraint F #>= N-1 three times!
If you are only interested in the first solution or know that there is at most one solution, you can use once/1 to commit to that solution:
?- once(fib(X, 377)).
+1 for using CLP(FD) as a declarative alternative to lower-level arithmetic. Your version can be used in all directions, whereas a version based on primitive integer arithmetic cannot.
I played a bit with another definition, I wrote in standard arithmetic and translated to CLP(FD) on purpose for this question.
My plain Prolog definition was
fibo(1, 1,0).
fibo(2, 2,1).
fibo(N, F,A) :- N > 2, M is N -1, fibo(M, A,B), F is A+B.
Once translated, since it take too long in reverse mode (or doesn't terminate, don't know),
I tried to add more constraints (and moving them around) to see where a 'backward' computation terminates:
fibo(1, 1,0).
fibo(2, 2,1).
fibo(N, F,A) :-
N #> 2,
M #= N -1,
M #>= 0, % added
A #>= 0, % added
B #< A, % added - this is key
F #= A+B,
fibo(M, A,B). % moved - this is key
After adding B #< A and moving the recursion at last call, now it works.
?- time(fibo(U,377,Y)).
% 77,005 inferences, 0.032 CPU in 0.033 seconds (99% CPU, 2371149 Lips)
U = 13,
Y = 233 ;
% 37,389 inferences, 0.023 CPU in 0.023 seconds (100% CPU, 1651757 Lips)
false.
edit To account for 0 based sequences, add a fact
fibo(0,0,_).
Maybe this explain the role of the last argument: it's an accumulator.
I have the following task:
Write a method that will add two polynoms. I.e 0+2*x^3 and 0+1*x^3+2*x^4 will give 0+3*x^3+2*x^4.
I also wrote the following code:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
(
B1=B2,
B3 = B2,
A3 is A1+A2,
add_poly(P1,P2,P3)
;
B1<B2,
B3=B1,
A3=A1,
add_poly(P1,+A2*x^B2+P2,P3)
;
B1>B2,
B3=B2,
A3=A2,
add_poly(+A1*x^B1+P1,P2,P3)
).
add_poly(X+P1,Y+P2,Z+P3):-
Z is X+Y,
add_poly(P1,P2,P3).
My problem is that I don't know how to stop. I would like to stop when one the arguments is null and than to append the second argument to the third one. But how can I check that they are null?
Thanks.
Several remarks:
Try to avoid disjunctions (;)/2 in the beginning. They need special indentation to be readable. And they make reading a single rule more complex — think of all the extra (=)/2 goals you have to write and keep track of.
Then, I am not sure what you can assume about your polynomials. Can you assume they are written in canonical form?
And for your program: Consider the head of your first rule:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
I will generalize away some of the arguments:
add_poly(+A1*x^B1+P1,_,_):-
and some of the subterms:
add_poly(+_+_,_,_):-
This corresponds to:
add_poly(+(+(_),_),_,_) :-
Not sure you like this.
So this rule applies only to terms starting with a prefix + followed by an infix +. At least your sample data did not contain a prefix +.
Also, please remark that the +-operator is left associative. That means that 1+2+3+4 associates to the left:
?- write_canonical(1+2+3+4).
+(+(+(1,2),3),4)
So if you have a term 0+3*x^3+2*x^4 the first thing you "see" is _+2*x^4. The terms on the left are nested deeper.
For your actual question (how to stop) - you will have to test explicitly that the leftmost subterm is an integer, use integer/1 - or maybe a term (*)/2 (that depends on your assumptions).
I assume that polynomials you are speaking of are in 1 variable and with integer exponents.
Here a procedure working on normal polynomial form: a polynomial can be represented as a list (a sum) of factors, where the (integer) exponent is implicitly represented by the position.
:- [library(clpfd)].
add_poly(P1, P2, Sum) :-
normalize(P1, N1),
normalize(P2, N2),
append(N1, N2, Nt),
aggregate_all(max(L), (member(M, Nt), length(M, L)), LMax),
maplist(rpad(LMax), Nt, Nn),
clpfd:transpose(Nn, Tn),
maplist(sumlist, Tn, NSum),
denormalize(NSum, Sum).
rpad(LMax, List, ListN) :-
length(List, L),
D is LMax - L,
zeros(D, Z),
append(List, Z, ListN).
% the hardest part is of course normalization: here a draft
normalize(Ts + T, [N|Ns]) :-
normalize_fact(T, N),
normalize(Ts, Ns).
normalize(T, [N]) :-
normalize_fact(T, N).
% build a list with 0s left before position E
normalize_fact(T, Normal) :-
fact_exp(T, F, E),
zeros(E, Zeros),
nth0(E, Normal, F, Zeros).
zeros(E, Zeros) :-
length(Zeros, E),
maplist(copy_term(0), Zeros).
fact_exp(F * x ^ E, F, E).
fact_exp(x ^ E, 1, E).
fact_exp(F * x, F, 1).
fact_exp(F, F, 0).
% TBD...
denormalize(NSum, NSum).
test:
?- add_poly(0+2*x^3, 0+1*x^3+2*x^4, P).
P = [0, 0, 0, 3, 2]
the answer is still in normal form, denormalize/2 should be written...
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