SWI-Prolog CLPFD - prolog

I'm new to prolog for constraint programming. I have an issue with CLPFD not reducing a domain as I expect it to. This is probably really simple.
[A,B] ins 1..5,A*B#=5.
I expect it to reduce the domain of A and B to
1\/5
But it just gives
A in 1..5,
A*B#=5,
B in 1..5.
Any suggestions would be appreciated.

While this answer is tailored to clpfd as implemented in swi-prolog, the idea/method is portable.
:- use_module(library(clpfd)).
Here's how we can reduce domain sizes before starting full enumeration:
shave_zs(Zs) :-
maplist(flag_zs_shave_z(F,Zs), Zs),
once((var(F) ; ground(Zs) ; shave_zs(Zs))).
flag_zs_shave_z(Flag, Zs, Z) :-
( fd_size(Z, sup)
-> true % never shave the infinite
; fd_dom(Z, Z_dom),
phrase(dom_integers_(Z_dom), Z_vals),
maplist(flag_zs_z_val(Flag,Zs,Z), Z_vals)
).
flag_zs_z_val(Flag, Zs, Z, Z_val) :-
( \+ call_with_inference_limit((Z #= Z_val,labeling([],Zs)), 1000, _)
-> Z #\= Z_val,
Flag = true
; true
).
We use grammar dom_integers_//1, as defined on the SWI-Prolog clpfd manual page:
dom_integers_(I) --> { integer(I) }, [I].
dom_integers_(L..U) --> { numlist(L, U, Is) }, Is.
dom_integers_(D1\/D2) --> dom_integers_(D1), dom_integers_(D2).
Sample queries:
?- [A,B] ins 1..5, A*B #= 5, (Shaved = false ; Shaved = true, shave_zs([A,B])).
Shaved = false, A*B #= 5, A in 1..5, B in 1..5 ;
Shaved = true, A*B #= 5, A in 1\/5, B in 1\/5.
?- [A,B] ins 1..10, A*B #= 10, (Shaved = false ; Shaved = true, shave_zs([A,B])).
Shaved = false, A*B #= 10, A in 1..10 , B in 1..10 ;
Shaved = true, A*B #= 10, A in 1..2\/5\/10, B in 1..2\/5\/10.

You are right that 1\/5 would be optimal pruning in this case.
However, for efficiency reasons, CLP(FD) systems typically maintain only so-called bounds consistency for arithmetic constraints, and in general do not remove interior elements from domains even when some of them cannot participate in solutions.
Bounds consistency, in the finite case, means that there are solutions where the variable assumes the lower and upper boundary of the domain. In this case, there are solutions for A=1 and A=5.
Notice that these are the only solutions in this concrete case, but in general, there are also solutions with interior points in analogous larger instances, for example:
?- [A,B] ins 1..10, A*B#=10, label([A,B]).
A = 1,
B = 10 ;
A = 2,
B = 5 ;
A = 5,
B = 2 ;
A = 10,
B = 1.
The good news though is that the number of such solutions only grows logarithmically in the size of the domain:
?- length(_, Exp), N #= 2^Exp, [A,B] ins 1..N,A*B#=N,
findall(., label([A,B]), Ls), length(Ls, L),
writeln(Exp-L), false.
0-1
1-2
2-3
3-4
4-5
5-6
6-7
7-8
etc.
This is in contrast to other cases, like X mod 2 #= 0, where the number of solutions grows linearly in the size of the domain of X (and thus exponentially in the length of its decimal representation), and it is thus not feasible to explicitly prune the domain.
Thus, as a feasible workaround, you can use label/1 to obtain concrete solutions, and then use in/2 constraints to restrict the operands to their concretely admissible domains:
:- use_module(library(clpfd)).
stricter_domains(Vs) :-
findall(Vs, label(Vs), Sols0),
transpose(Sols0, Sols),
maplist(list_to_domain, Sols, Ds),
maplist(in, Vs, Ds).
list_to_domain([L|Ls], Dom) :- foldl(dom_disj, Ls, L, Dom).
dom_disj(D0, I, D0\/I).
Your example:
?- [A,B] ins 1..5, A*B#=5, stricter_domains([A,B]).
A in 1\/5,
A*B#=5,
B in 1\/5.

Related

How to check how many elements you've already consumed in Prolog DCGs

Say I have these DCGs:
zorbs([H|T]) --> zorb(H), zorbs(T).
zorbs([]) --> [].
zorb(a) --> [1,2].
zorb(b) --> [3].
zorb(c) --> [6,1,2,2].
I can do this:
?- phrase(zorbs(X), [1,2,3,6,1,2,2]).
X = [a, b, c] .
I can also "reverse" this by doing:
phrase(zorbs([a,b,c]), X).
X = [1, 2, 3, 6, 1, 2, 2].
Now, what I want to do is find a list of numbers with length less than 4 (for example) which these elements "parse" into, returning the rest.
So, for example, given [a,b,c], which would normally relate to [1, 2, 3, 6, 1, 2, 2], I want it to relate to [1, 2, 3] (which has length less than 4) and also give the remainder that couldn't be "reversed," so [c]. I don't really know where to start, as it seems there's no way to reason about the number of elements you've already consumed in a DCG.
Here's a sort-of solution:
X in 0..4,
indomain(X),
Q = [_|_],
prefix(Q, [a,b,c]),
length(A, X),
phrase(zorbs(Q), A).
but I think this is very inefficient, because I think it basically iterates up from nothing, and I want to find the solution with the biggest Q.
There is no direct way how to do this in this case. So your approach is essentially what can be done. That is, you are enumerating all possible solutions and (what you have not shown) selecting them accordingly.
Questions about the biggest and the like include some quantification that you cannot express directly in first order logic.
However, sometimes you can use a couple of tricks.
Sometimes, a partial list like [a,b,c|_] may be helpful.
?- Xs = [_,_,_,_|_], phrase(zorbs(Xs),[1,2,3,6,1,2,2]).
false.
So here we have proven that there is no list of length 4 or longer that corresponds to that sequence. That is, we have proven this for infinitely many lists!
And sometimes, using phrase/3 in place of phrase/2 may help. Say, you have a number sequence that doesn't parse, and you want to know how far it can parse:
?- Ys0 = [1,2,3,6,1,2,7], phrase(zorbs(Xs),Ys0,Ys).
Ys0 = [1,2,3,6,1,2,7], Xs = [], Ys = [1,2,3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "a", Ys = [3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "ab", Ys = [6,1,2,7]
; false.
(This is with the two DCG-rules exchanged)
Can use:
% Like "between", but counts down instead of up
count_down(High, Low, N) :-
integer(High),
integer(Low),
count_down_(High, Low, N).
count_down_(H, L, N) :-
compare(C, H, L),
count_down_comp_(C, H, L, N).
count_down_comp_('=', _H, L, N) :-
% All equal, final
N = L.
% Accept H as the counting-down value
count_down_comp_('>', H, _L, H).
count_down_comp_('>', H, L, N) :-
H0 is H - 1,
% Decrement H towards L, and loop
count_down_(H0, L, N).
... and then start with:
count_down(4, 1, Len), length(Lst, Len), phrase...
Another method is to use freeze to limit a list's length, element-by-element:
max_len_freeze(Lst, MaxLen) :-
compare(C, MaxLen, 0),
max_len_freeze_comp_(C, Lst, MaxLen).
max_len_freeze_comp_('=', [], 0).
max_len_freeze_comp_('>', [_|Lst], MaxLen) :-
succ(MaxLen0, MaxLen),
!,
freeze(Lst, max_len_freeze(Lst, MaxLen0)).
max_len_freeze_comp_('>', [], _).
... and then start with:
max_len_freeze(Lst, 4), phrase...
This will work to find the longest list (maximum length 4) first, since your DCG is greedy (i.e. matching [H|T] before []).

Residual constraints with reification in clpfd

I defined reified variants of the
clpfd constraints (#<)/2, (#=<)/2, (#>=)/2 and (#>)/2:
:- use_module(library(clpfd)).
ltA(X,Y,Truth) :- X #< Y #<==> B, bool01_truth(B,Truth).
ltB(X,Y, true) :- X #< Y.
ltB(X,Y,false) :- X #>= Y.
lteA(X,Y,Truth) :- X #=< Y #<==> B, bool01_truth(B,Truth).
lteB(X,Y, true) :- X #=< Y.
lteB(X,Y,false) :- X #> Y.
gteA(X,Y,Truth) :- X #>= Y #<==> B, bool01_truth(B,Truth).
gteB(X,Y, true) :- X #>= Y.
gteB(X,Y,false) :- X #< Y.
gtA(X,Y,Truth) :- X #> Y #<==> B, bool01_truth(B,Truth).
gtB(X,Y, true) :- X #> Y.
gtB(X,Y,false) :- X #=< Y.
Of course, ltA/3 and ltB/3 are logically equivalent, as are
lteA/3 and lteB/3, gteA/3 and gteB/3, and gtA/3 and gtB/3.
The answers I get using these predicates, however, differ regarding size and readability. I ran the following queries with SWI-Prolog 7.1.37:
Good news, first!
?- lteA(X,Y,Truth).
Truth = false, Y#=<X+ -1 ;
Truth = true, Y#>=X.
?- lteB(X,Y,Truth).
Truth = true, Y#>=X ;
Truth = false, Y#=<X+ -1.
?- gteA(X,Y,Truth).
Truth = false, X#=<Y+ -1 ;
Truth = true, X#>=Y.
?- gteB(X,Y,Truth).
Truth = true, X#>=Y ;
Truth = false, X#=<Y+ -1.
Ok! But what about the other two?
?- ltA(X,Y,Truth).
Truth = false, X+1#=_G968, Y#=<_G968+ -1 ;
Truth = true, X+1#=_G912, Y#>=_G912.
?- ltB(X,Y,Truth).
Truth = true, X#=<Y+ -1 ;
Truth = false, X#>=Y.
?- gtA(X,Y,Truth).
Truth = false, X#=<_G1301+ -1, Y+1#=_G1301 ;
Truth = true, X#>=_G1243, Y+1#=_G1243.
?- gtB(X,Y,Truth).
Truth = true, Y#=<X+ -1 ;
Truth = false, Y#>=X.
Not quite!
How do I get compact answers with ltA/3 and gtA/3---just like with lteA/3 and gteA/3?
It runs counter the basic idea of CLP(FD) to have compact
answers. Since CLP(FD) usually doesn't do gauss elimination and
similar things. Its not like a Computer Algebra System (CAS).
In CLP(FD), you basically model your problem by entering
inequations, and the system is allowed to do nothing with this
inequations as long as you don't call labeling.
Some CLP(FD) realizations already check consistency to some
degree when entering inequations and/or already do simplifications
and propagations. But this isnt mandatory.
In your example you have E #= X where E is an expression and
X is a variable. There is no guarantee that occurences
of X are replaced by E when entering a model.
Usually this is not done in CLP(FD), since it would blow
up the entered model. You can directly test that this
is not simplified:
Welcome to SWI-Prolog (Multi-threaded, 64 bits, Version 7.3.4)
Copyright (c) 1990-2015 University of Amsterdam, VU Amsterdam
?- use_module(library(clpfd)).
true.
?- A#=X+1, Y#=<A+ -1.
Y#=<A+ -1,
X+1#=A.
The same also happens in Jekejeke Prolog. The CLP(FD) of
Jekejeke Prolog is open source here. Refification itself
is planned but not yet implemented:
Jekejeke Prolog, Runtime Library 1.0.7
(c) 1985-2015, XLOG Technologies GmbH, Switzerland
?- use_module(library(finite/clpfd)).
% 11 consults and 0 unloads in 513 ms.
Yes
?- A#=X+1, Y#=<A+ -1.
A #= 1+X,
-1+A #>= Y
Typicall an equation E #= X only leads to substitutions when
E is also a variable or constant. This might explain why your
examples look different from case to case.
Here you see SWI-Prolog simplifying A #= X. I just modified
the above example slightly so that E is a variable:
?- A#=X, Y#=<A+ -1.
A = X,
Y#=<X+ -1.
And here you see Jekejeke Prolog doing it (Todo bug fix: I
guess I need to reorder the rules a little bit, so that it
gives A = X and not X = A as here):
?- A#=X, Y#=<A+ -1.
X = A,
-1+A #>= Y
The case of E #= X where E is a constant and where this
value is propagated is called forward checking. This is the
minimum requirement a CLP(FD) must be able to do, otherwise
labeling would not work.
But already the case of E #= X where E is a variable a
propagation isn't mandatory. But the testing above shows
that many CLP(FD) do it. Propagating variables leads to
union find algorithms and the like.
Bye

Use reified constraints to make 3 numbers consecutive

Here's an outline of my SWI-Prolog program:
:- use_module(library(clpfd)).
consec1(L) :-
L=[L1,L2,L3,L4,L5,L6,L7,L8,L9],
L ins 1..9,
...,
abs(L5-L4)#=1,
all_different(L),
labeling([],L)
abs(L5-L4)#=1 makes L5 and L4 next to each other. If I wanted to make three numbers next to each other e.g. L3, L4 and L5, how could I use reified constraints to do this?
E.g. L3=4,L5=5,L4=6 or L4=7,L5=8,L3=9
This implements consecutive in the sense you gave in the comments. For a list of N values, we need space enough to make all the values fit in between, and all values need to be different.
consecutive([]). % debatable case
consecutive(Xs) :-
Xs = [_|_],
length(Xs, N),
all_different(Xs),
max_of(Max, Xs),
min_of(Min, Xs),
Max-Min #= N-1.
max_of(Max, [Max]).
max_of(Max0, [E|Es]) :-
Max0 #= max(E,Max1),
max_of(Max1, Es).
min_of(Min, [Min]).
min_of(Min0, [E|Es]) :-
Min0 #= min(E, Min1),
min_of(Min1, Es).
TL;DR: too long for a comment: play-time with specialized sicstus-prolog clpfd constraints
This answer follows up this previous answer; recent versions of SICStus Prolog offer specialized clpfd constraints maximum/2 and minimum/2 as alternatives to min_of/2 and max_of/2.
Using the following code for benchmarking1,2 ...
:- use_module(library(clpfd)).
:- use_module(library(between)).
bench_(How, N, Ub) :-
\+ \+ ( length(Xs, N),
domain(Xs, 1, Ub),
all_different(Xs),
Max-Min #= N-1,
( How = 0
; How = min_of , max_of( Max, Xs), min_of( Min, Xs)
; How = minimum, maximum(Max, Xs), minimum(Min, Xs)
),
labeling([enum], Xs) ).
... we run the following tests:
To estimate worst-case overhead of min/max constraint:
?- member(How, [0,v1,v2]), call_time(bench_(How,10,10), T_ms).
How = 0 , T_ms = 5910
; How = v1, T_ms = 19560
; How = v2, T_ms = 7190.
To measure the runtime costs of propagating min/max constraints in more typical cases:
?- between(6, 8, N), NN #= N+N, call_time(bench_(v1,N,NN),T_ms).
N = 6, NN = 12, T_ms = 50
; N = 7, NN = 14, T_ms = 300
; N = 8, NN = 16, T_ms = 2790.
?- between(6, 8, N), NN #= N+N, call_time(bench_(v2,N,NN),T_ms).
N = 6, NN = 12, T_ms = 20
; N = 7, NN = 14, T_ms = 100
; N = 8, NN = 16, T_ms = 830.
In both "use cases", the specialized constraints give impressive speedup.
Footnote 1: Using SICStus Prolog version 4.3.2 (64-bit).
Footnote 2: Answer sequences were post-processed to improve appearance.

Most general higher-order constraint describing a sequence of integers ordered with respect to a relation

In CLP(FD), we frequently need to state: "This is a list of integers and finite domain variables in (sometimes: strictly) ascending/descending order."
Is there any CLP(FD) system that provides a general (parametrisable) built-in constraint for this task?
SWI-Prolog provides a constraint called chain/2, which is similar to what I am looking for. However, the name is slightly too specific to encompass all relations that the constraint can describe (example: #< is not a partial order but admissible in chain/2, leading to the sequence — taken as a set of integers — no longer counting as a chain as defined in mathematical order-theory). Hence, the name does not fully describe what the constraint actually implements.
Please give the most general definition with respect to the usual binary CLP(FD) constraints — or a suitable subset that contains at least #<, #>, #=< and #>= — including the proper name according to the algebraic structure the constraint defines. The condition imposed is that the constraint describe an actual mathematical structure that has a proper name in the literature.
As a start, consider with SICStus Prolog or SWI:
:- use_module(library(clpfd)).
connex(Relation_2, List) :-
connex_relation(Relation_2),
connex_(List, Relation_2).
connex_relation(#=).
connex_relation(#<).
connex_relation(#=<).
connex_relation(#>).
connex_relation(#>=).
connex_([], _).
connex_([L|Ls], Relation_2) :-
foldl(adjacent(Relation_2), Ls, L, _).
adjacent(Relation_2, X, Prev, X) :- call(Relation_2, Prev, X).
Sample cases:
?- connex(#<, [A,B,C]).
A#=<B+-1,
B#=<C+-1.
?- connex(#=, [A,B,C]).
A = B, B = C,
C in inf..sup.
?- maplist(connex(#<), [[A,B],[C,D]]).
A#=<B+-1,
C#=<D+-1.
Notice that it would even be admissible to allow #\=, because the relation would still describe a connex as known in mathematical order-theory. Hence, the code above is not most general with respect to the usual binary CLP(FD) constraints.
Hoogle was not very useful, but Hayoo is!
foldcmpl
so this is a special form of fold for a list, but it does not apply length list times but one time less.
isSortedBy
is not entirely general in its name, but in its signature. Maybe insisting on the most general name is not that helpful. Otherwise we just have entities all over?
The definition reads:
The isSortedBy function returns True iff the predicate returns true for all adjacent pairs of elements in the list.
Maybe: all_adjacent_pairs(R_2, Xs). which sounds a bit after having a looping construct that has adjacent_pair as some modifier.
This is inspired by a toolbox of functional higher-order idioms I once implemented. Back then I found the corner cases agonizing, I still do today:) Also, finding good names is always an issue...
Consider meta-predicate mapadj/4:
mapadj(Relation_4,As,Bs,Cs) :-
list_list_list_mapadj(As,Bs,Cs,Relation_4).
list_list_list_mapadj([],[],[],_).
list_list_list_mapadj([A|As],Bs,Cs,Relation_4) :-
list_prev_list_list_mapadj(As,A,Bs,Cs,Relation_4).
list_prev_list_list_mapadj([],_,[],[],_).
list_prev_list_list_mapadj([A1|As],A0,[B|Bs],[C|Cs],Relation_4) :-
call(Relation_4,A0,A1,B,C),
list_prev_list_list_mapadj(As,A1,Bs,Cs,Relation_4).
Sample uses:
z_z_sum_product(X,Y,Sum,Product) :-
Sum #= X + Y,
Product #= X * Y.
:- mapadj(z_z_sum_product,[], [], []).
:- mapadj(z_z_sum_product,[1], [], []).
:- mapadj(z_z_sum_product,[1,2], [3], [2]).
:- mapadj(z_z_sum_product,[1,2,3], [3,5], [2,6]).
:- mapadj(z_z_sum_product,[1,2,3,4],[3,5,7],[2,6,12]).
I'm aware of the rift in the corner cases As = []and As = [_], still I feel this is as close to "for all adjacent list items" as it gets.
Also, all of this can easily be extended:
down to mapadj/2 (akin to chain/2, except for the type-check with singleton lists)
sideways, with an additional state argument, to foldadjl/n, scanadjl/n
Regarding names: IMO the l / r suffix is required with fold / scan, but not with map.
Edit 2015-04-26
Here comes the before-mentioned foldadjl/4:
foldadjl(Relation_4,Xs) -->
list_foldadjl(Xs,Relation_4).
list_foldadjl([],_) -->
[].
list_foldadjl([X|Xs],Relation_4) -->
list_prev_foldadjl(Xs,X,Relation_4).
list_prev_foldadjl([],_,_) -->
[].
list_prev_foldadjl([X1|Xs],X0,Relation_4) -->
call(Relation_4,X0,X1),
list_prev_foldadjl(Xs,X1,Relation_4).
Edit 2015-04-27
Here comes meta-predicate splitlistIfAdj/3, based on
if_/3 which was proposed in a previous answer
on reification.
split_if_adj(P_3,As,Bss) :- splitlistIfAdj(P_3,As,Bss).
splitlistIfAdj(P_3,As,Bss) :-
list_split_(As,Bss,P_3).
list_split_([],[],_).
list_split_([X0|Xs], [Cs|Bss],P_3) :-
list_prev_split_(Xs,X0,Cs,Bss, P_3).
list_prev_split_([], X, [X],[],_).
list_prev_split_([X1|Xs],X0,[X0|Cs],Bss,P_3) :-
if_(call(P_3,X0,X1),
(Cs = [], Bss = [Cs0|Bss0]),
(Cs = Cs0, Bss = Bss0)),
list_prev_split_(Xs,X1,Cs0,Bss0,P_3).
To show it in use let's define dif/3 exactly the same way as (=)/3 but with flipped truth-value:
dif(X, Y, R) :- X == Y, !, R = false.
dif(X, Y, R) :- ?=(X, Y), !, R = true. % syntactically different
dif(X, Y, R) :- X \= Y, !, R = true. % semantically different
dif(X, Y, R) :- R == false, !, X = Y.
dif(X, X, false).
dif(X, Y, true) :-
dif(X, Y).
Now we use them in tandem:
?- splitlistIfAdj(dif,[1,2,2,3,3,3,4,4,4,4],Pss).
Pss = [[1],[2,2],[3,3,3],[4,4,4,4]]. % succeeds deterministically
What if we generalize some list items? Do we get multiple answers with the right pending goals?
First, a small example:
?- splitlistIfAdj(dif,[1,X,2],Pss).
X = 1, Pss = [[1,1],[2]] ;
X = 2, Pss = [[1],[2,2]] ;
dif(X,1),dif(X,2), Pss = [[1],[X],[2]].
A somewhat bigger example involving the two variables X and Y.
?- splitlistIfAdj(dif,[1,2,2,X,3,3,Y,4,4,4],Pss).
X = 2, Y = 3, Pss = [[1],[2,2,2],[3,3,3],[4,4,4]] ;
X = 2, Y = 4, Pss = [[1],[2,2,2],[3,3],[4,4,4,4]] ;
X = 2, dif(Y,3),dif(Y,4), Pss = [[1],[2,2,2],[3,3],[Y],[4,4,4]] ;
X = Y, Y = 3, Pss = [[1],[2,2],[3,3,3,3],[4,4,4]] ;
X = 3, Y = 4, Pss = [[1],[2,2],[3,3,3],[4,4,4,4]] ;
X = 3, dif(Y,3),dif(Y,4), Pss = [[1],[2,2],[3,3,3],[Y],[4,4,4]] ;
dif(X,2),dif(X,3), Y = 3, Pss = [[1],[2,2],[X],[3,3,3],[4,4,4]] ;
dif(X,2),dif(X,3), Y = 4, Pss = [[1],[2,2],[X],[3,3],[4,4,4,4]] ;
dif(X,2),dif(X,3), dif(Y,3),dif(Y,4), Pss = [[1],[2,2],[X],[3,3],[Y],[4,4,4]].
Edit 2015-05-05
Here's tpartition/4:
tpartition(P_2,List,Ts,Fs) :- tpartition_ts_fs_(List,Ts,Fs,P_2).
tpartition_ts_fs_([],[],[],_).
tpartition_ts_fs_([X|Xs0],Ts,Fs,P_2) :-
if_(call(P_2,X), (Ts = [X|Ts0], Fs = Fs0),
(Ts = Ts0, Fs = [X|Fs0])),
tpartition_ts_fs_(Xs0,Ts0,Fs0,P_2).
Sample use:
?- tpartition(=(0), [1,2,3,4,0,1,2,3,0,0,1], Ts, Fs).
Ts = [0, 0, 0],
Fs = [1, 2, 3, 4, 1, 2, 3, 1].
Edit 2015-05-15
On and on, ... here's splitlistIf/3:
split_if(P_2,As,Bss) :- splitlistIf(P_2,As,Bss).
splitlistIf(P_2,As,Bss) :-
list_pred_split(As,P_2,Bss).
list_pred_split([],_,[]).
list_pred_split([X|Xs],P_2,Bss) :-
if_(call(P_2,X), list_pred_split(Xs,P_2,Bss),
(Bss = [[X|Ys]|Bss0], list_pred_open_split(Xs,P_2,Ys,Bss0))).
list_pred_open_split([],_,[],[]).
list_pred_open_split([X|Xs],P_2,Ys,Bss) :-
if_(call(P_2,X), (Ys = [], list_pred_split(Xs,P_2,Bss)),
(Ys = [X|Ys0], list_pred_open_split(Xs,P_2,Ys0,Bss))).
Let's use it:
?- splitlistIf(=(x),[x,1,2,x,1,2,3,x,1,4,x,x,x,x,1,x,2,x,x,1],Xs).
Xs = [[1, 2], [1, 2, 3], [1, 4], [1], [2], [1]].
Quite in the same vein as mapadj/4 presented in an earlier answer... maybe the name is better.
forallAdj(P_2,Xs) :-
list_forallAdj(Xs,P_2).
list_forallAdj([],_).
list_forallAdj([X|Xs],P_2) :-
list_forallAdj_prev(Xs,P_2,X).
list_forallAdj_prev([],_,_).
list_forallAdj_prev([X1|Xs],P_2,X0) :-
call(P_2,X0,X1),
list_forallAdj_prev(Xs,P_2,X1).
Sample use:
:- use_module(library(clpfd)).
:- use_module(library(lambda)).
?- Ls = [0,_,_,_,_,_], forallAdj(\X0^X1^(X0 + 1 #= X1), Ls).
Ls = [0, 1, 2, 3, 4, 5].
Where could that take us?
forallAdj => existAdj
maybe variants with index (forallAdjI, existAdjI) like in Collections.List Module (F#)
findfirstAdj/pickfirstAdj also like F# find/pick

Solution to Smullyan's numerical machines

Here I propose to find a solution to Smullyan's numerical machines as defined here.
Problem statement
They're machines that take a list of digits as input, and transform it to another list of digits following some rules based on the pattern of the input.
Here are the rules of the machine given in the link above, expressed a bit more formally.
Let say M is the machine, and M(X) is the transformation of X.
We define a few rules like this:
M(2X) = X
M(3X) = M(X)2M(X)
M(4X) = reverse(M(X)) // reverse the order of the list.
M(5X) = M(X)M(X)
And anything that does not match any rule is rejected.
Here are a few examples:
M(245) = 45
M(3245) = M(245)2M(245) = 45245
M(43245) = reverse(M(3245)) = reverse(45245) = 54254
M(543245) = M(43245)M(43245) = 5425454254
And the questions are, find X such that:
M(X) = 2
M(X) = X
M(X) = X2X
M(X) = reverse(X)
M(X) = reverse(X2X)reverse(X2X)
Here is a second example a bit more complex with the exhaustive search (especially if I want the first 10 or 100 solutions).
M(1X2) = X
M(3X) = M(X)M(X)
M(4X) = reverse(M(X))
M(5X) = truncate(M(X)) // remove the first element of the list truncate(1234) = 234. Only valid if M(X) has at least 2 elements.
M(6X) = 1M(X)
M(7X) = 2M(X)
Questions:
M(X) = XX
M(X) = X
M(X) = reverse(X)
(Non-)Solutions
Writing a solver in Prolog is pretty straightforward. Except that it's just exhaustive exploration (a.k.a brute force) and may take some time for some set of rules.
I tried but couldn't express this problem in terms of logic constraints with CLP(FD), so I tried CHR (Constraint Handling Rules) to express this in terms of constraints on lists (especially append constraints), but no matter how I express it, it always boils down to an exhaustive search.
Question
Any idea what approach I could take to resolve any problem of this kind in a reasonable amount of time?
Ideally I would like to be able to generate all the solutions shorter than some bound.
Let's look at your "a bit more complex" problem. Exhaustive search works excellently!
Here is a comparison with Серге́й's solution which can be improved significantly by factoring the common goals:
m([1|A], X) :-
A = [_|_],
append(X, [2], A).
m([E | X], Z) :-
m(X, Y),
( E = 3,
append(Y, Y, Z)
; E = 4,
reverse(Y, Z)
; E = 5,
Y = [_ | Z]
; E = 6,
Z = [1 | Y]
; E = 7,
Z = [2 | Y]
).
For query time(findall(_, (question3(X), write(X), nl), _)). I get with B 8.1, SICStus 4.3b8:
Серге́й B tabled 104.542s
Серге́й B 678.394s
false B 16.013s
false B tabled 53.007s
Серге́й SICStus 439.210s
false SICStus 7.990s
Серге́й SWI 1383.678s, 5,363,110,835 inferences
false SWI 44.743s, 185,136,302 inferences
The additional questions are not that difficult to answer. Only SICStus with above m/2 and
call_nth/2:
| ?- time(call_nth( (
length(Xs0,N),append(Xs0,Xs0,Ys),m(Xs0,Ys),
writeq(Ys),nl ), 10)).
[4,3,7,4,3,1,4,3,7,4,3,1,2,4,3,7,4,3,1,4,3,7,4,3,1,2]
[3,4,7,4,3,1,3,4,7,4,3,1,2,3,4,7,4,3,1,3,4,7,4,3,1,2]
[4,3,7,3,4,1,4,3,7,3,4,1,2,4,3,7,3,4,1,4,3,7,3,4,1,2]
[3,4,7,3,4,1,3,4,7,3,4,1,2,3,4,7,3,4,1,3,4,7,3,4,1,2]
[3,5,4,5,3,1,2,2,1,3,5,4,5,3,1,2,3,5,4,5,3,1,2,2,1,3,5,4,5,3,1,2]
[3,5,5,3,4,1,2,1,4,3,5,5,3,4,1,2,3,5,5,3,4,1,2,1,4,3,5,5,3,4,1,2]
[5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2]
[4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2]
[5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2]
[3,5,4,7,4,3,1,_2735,3,5,4,7,4,3,1,2,3,5,4,7,4,3,1,_2735,3,5,4,7,4,3,1,2]
196660ms
| ?- time(call_nth( (
length(Xs0,N),m(Xs0,Xs0),
writeq(Xs0),nl ), 10)).
[4,7,4,3,1,4,7,4,3,1,2]
[4,7,3,4,1,4,7,3,4,1,2]
[5,4,7,4,3,1,_2371,5,4,7,4,3,1,2]
[4,7,4,5,3,1,_2371,4,7,4,5,3,1,2]
[5,4,7,3,4,1,_2371,5,4,7,3,4,1,2]
[3,5,4,7,4,1,2,3,5,4,7,4,1,2]
[4,3,7,4,5,1,2,4,3,7,4,5,1,2]
[3,4,7,4,5,1,2,3,4,7,4,5,1,2]
[4,7,5,3,6,4,1,4,7,5,3,6,4,2]
[5,4,7,4,3,6,1,5,4,7,4,3,6,2]
6550ms
| ?- time(call_nth( (
length(Xs0,N),reverse(Xs0,Ys),m(Xs0,Ys),
writeq(Ys),nl ), 10)).
[2,1,3,4,7,1,3,4,7]
[2,1,4,3,7,1,4,3,7]
[2,1,3,5,4,7,_2633,1,3,5,4,7]
[2,1,5,4,7,3,2,1,5,4,7,3]
[2,4,6,3,5,7,1,4,6,3,5,7]
[2,6,3,5,4,7,1,6,3,5,4,7]
[2,_2633,1,5,3,4,7,_2633,1,5,3,4,7]
[2,_2633,1,5,4,3,7,_2633,1,5,4,3,7]
[2,1,3,4,4,4,7,1,3,4,4,4,7]
[2,1,3,4,5,6,7,1,3,4,5,6,7]
1500ms
Here is another improvement to #Celelibi's improved version (cele_n). Roughly, it gets a factor of two by constraining the length of the first argument, and another factor of two by pretesting the two versions.
cele_n SICStus 2.630s
cele_n SWI 12.258s 39,546,768 inferences
cele_2 SICStus 0.490s
cele_2 SWI 2.665s 9,074,970 inferences
appendh([], [], Xs, Xs).
appendh([_, _ | Ws], [X | Xs], Ys, [X | Zs]) :-
appendh(Ws, Xs, Ys, Zs).
m([H|A], X) :-
A = [_|_], % New
m(H, X, A).
m(1, X, A) :-
append(X, [2], A).
m(3, X, A) :-
appendh(X, B, B, X),
m(A, B).
m(4, X, A) :-
reverse(X, B),
m(A, B).
m(5, X, A) :-
X = [_| _],
m(A, [_|X]).
m(H1, [H2 | B], A) :-
\+ \+ ( H2 = 1 ; H2 = 2 ), % New
m(A, B),
( H1 = 6, H2 = 1
; H1 = 7, H2 = 2
).
answer3(X) :-
between(1, 13, N),
length(X, N),
reverse(X, A),
m(X, A).
run :-
time(findall(X, (answer3(X), write(X), nl), _)).
I propose here another solution which is basically exhaustive exploration. Given the questions, if the length of the first argument of m/2 is known, the length of the second is known as well. If the length of the second argument is always known, this can be used to cut down the search earlier by propagating some constraints down to the recursive calls. However, this is not compatible with the optimization proposed by false.
appendh([], [], Xs, Xs).
appendh([_, _ | Ws], [X | Xs], Ys, [X | Zs]) :-
appendh(Ws, Xs, Ys, Zs).
m([1 | A], X) :-
append(X, [2], A).
m([3 | A], X) :-
appendh(X, B, B, X),
m(A, B).
m([4 | A], X) :-
reverse(X, B),
m(A, B).
m([5 | A], X) :-
B = [_, _ | _],
B = [_ | X],
m(A, B).
m([H1 | A], [H2 | B]) :-
m(A, B),
( H1 = 6, H2 = 1
; H1 = 7, H2 = 2
).
answer3(X) :-
between(1, 13, N),
length(X, N),
reverse(X, A),
m(X, A).
Here is the time taken respectively by: this code, this code when swapping recursive calls with the constraints of each case (similar to solution of Sergey Dymchenko), and the solution of false which factor the recursive calls. The test is run on SWI and search for all the solution whose length is less or equal to 13.
% 36,380,535 inferences, 12.281 CPU in 12.315 seconds (100% CPU, 2962336 Lips)
% 2,359,464,826 inferences, 984.253 CPU in 991.474 seconds (99% CPU, 2397214 Lips)
% 155,403,076 inferences, 47.799 CPU in 48.231 seconds (99% CPU, 3251186 Lips)
All measures are performed with the call:
?- time(findall(X, (answer3(X), writeln(X)), _)).
(I assume that this is about a list of digits, as you suggest. Contrary to the link you gave, which talks about numbers. There might be differences with leading zeros. I did not take the time to think that through)
First of all, Prolog is an excellent language to search brute force. For, even in that case, Prolog is able to mitigate combinatorial explosion. Thanks to the logic variable.
Your problem statements are essentially existential statements: Does there exist an X such that such and such is true. That's where Prolog is best at. The point is the way how you are asking the question. Instead of asking with concrete values like [1] and so on, simply ask for:
?- length(Xs, N), m(Xs,Xs).
Xs = [3,2,3], N = 3
; ... .
And similarly for the other queries. Note that there is no need to settle for concrete values! This makes the search certainly more expensive!
?- length(Xs, N), maplist(between(0,9),Xs), m(Xs,Xs).
Xs = [3,2,3], N = 3
; ... .
In this manner it is quite efficiently possible to find concrete solutions, should they exist. Alas, we cannot decide that a solution does not exist.
Just to illustrate the point, here is the answer for the "most complex" puzzle:
?- length(Xs0,N),
append(Xs0,[2|Xs0],Xs1),reverse(Xs1,Xs2),append(Xs2,Xs2,Xs3), m(Xs0,Xs3).
Xs0 = [4, 5, 3, 3, 2, 4, 5, 3, 3], N = 9, ...
; ... .
It comes up in no time. However, the query:
?- length(Xs0,N), maplist(between(0,9),Xs0),
append(Xs0,[2|Xs0],Xs1),reverse(Xs1,Xs2),append(Xs2,Xs2,Xs3), m(Xs0,Xs3).
is still running!
The m/2 I used:
m([2|Xs], Xs).
m([3|Xs0], Xs) :-
m(Xs0,Xs1),
append(Xs1,[2|Xs1], Xs).
m([4|Xs0], Xs) :-
m(Xs0, Xs1),
reverse(Xs1,Xs).
m([5|Xs0],Xs) :-
m(Xs0,Xs1),
append(Xs1,Xs1,Xs).
The reason why this is more effective is simply that a naive enumeration of all n digits has 10n different candidates, whereas Prolog will only search for 3n given by the 3 recursive rules.
Here is yet another optimization: All 3 rules have the very same recursive goal. So why do this thrice, when once is more than enough:
m([2|Xs], Xs).
m([X|Xs0], Xs) :-
m(Xs0,Xs1),
( X = 3,
append(Xs1,[2|Xs1], Xs)
; X = 4,
reverse(Xs1,Xs)
; X = 5,
append(Xs1,Xs1,Xs)
).
For the last query, this reduces from 410,014 inferences, 0.094s CPU down to 57,611 inferences, 0.015s CPU.
Edit: In a further optimization the two append/3 goals can be merged:
m([2|Xs], Xs).
m([X|Xs0], Xs) :-
m(Xs0,Xs1),
( X = 4,
reverse(Xs1,Xs)
; append(Xs1, Xs2, Xs),
( X = 3, Xs2 = [2|Xs1]
; X = 5, Xs2 = Xs1
)
).
... which further reduces execution to 39,096 inferences and runtime by 1ms.
What else can be done? The length is bounded by the length of the "input". If n is the length of the input, then 2(n-1)-1 is the longest output. Is this helping somehow? Probably not.
Tabling (memoization) can help with harder variants of the problem.
Here is my implementation for the third question of second example in B-Prolog (returns all solutions of length 13 or less):
:- table m/2.
m(A, X) :-
append([1 | X], [2], A).
m([3 | X], Z) :-
m(X, Y),
append(Y, Y, Z).
m([4 | X], Z) :-
m(X, Y),
reverse(Y, Z).
m([5 | X], Z) :-
m(X, Y),
Y = [_ | Z].
m([6 | X], Z) :-
m(X, Y),
Z = [1 | Y].
m([7 | X], Z) :-
m(X, Y),
Z = [2 | Y].
question3(X) :-
between(1, 13, N),
length(X, N),
reverse(X, Z), m(X, Z).
Run:
B-Prolog Version 8.1, All rights reserved, (C) Afany Software 1994-2014.
| ?- cl(smullyan2).
cl(smullyan2).
Compiling::smullyan2.pl
compiled in 2 milliseconds
loading...
yes
| ?- time(findall(_, (question3(X), writeln(X)), _)).
time(findall(_, (question3(X), writeln(X)), _)).
[7,3,4,1,7,3,4,1,2]
[7,4,3,1,7,4,3,1,2]
[3,7,4,5,1,2,3,7,4,5,1,2]
[7,4,5,3,1,_678,7,4,5,3,1,2]
[7,4,5,3,6,1,7,4,5,3,6,2]
[7,5,3,6,4,1,7,5,3,6,4,2]
[4,4,7,3,4,1,4,4,7,3,4,1,2]
[4,4,7,4,3,1,4,4,7,4,3,1,2]
[5,6,7,3,4,1,5,6,7,3,4,1,2]
[5,6,7,4,3,1,5,6,7,4,3,1,2]
[5,7,7,3,4,1,5,7,7,3,4,1,2]
[5,7,7,4,3,1,5,7,7,4,3,1,2]
[7,3,4,4,4,1,7,3,4,4,4,1,2]
[7,3,4,5,1,_698,7,3,4,5,1,_698,2]
[7,3,4,5,6,1,7,3,4,5,6,1,2]
[7,3,4,5,7,1,7,3,4,5,7,1,2]
[7,3,5,6,4,1,7,3,5,6,4,1,2]
[7,3,5,7,4,1,7,3,5,7,4,1,2]
[7,3,6,5,4,1,7,3,6,5,4,1,2]
[7,4,3,4,4,1,7,4,3,4,4,1,2]
[7,4,3,5,1,_698,7,4,3,5,1,_698,2]
[7,4,3,5,6,1,7,4,3,5,6,1,2]
[7,4,3,5,7,1,7,4,3,5,7,1,2]
[7,4,4,3,4,1,7,4,4,3,4,1,2]
[7,4,4,4,3,1,7,4,4,4,3,1,2]
[7,4,5,6,3,1,7,4,5,6,3,1,2]
[7,4,5,7,3,1,7,4,5,7,3,1,2]
[7,5,6,3,4,1,7,5,6,3,4,1,2]
[7,5,6,4,3,1,7,5,6,4,3,1,2]
[7,5,7,3,4,1,7,5,7,3,4,1,2]
[7,5,7,4,3,1,7,5,7,4,3,1,2]
[7,6,5,3,4,1,7,6,5,3,4,1,2]
[7,6,5,4,3,1,7,6,5,4,3,1,2]
CPU time 25.392 seconds.
yes
So it's less than a minute for this particular problem.
I don't think constraint programming will be of any help with this type of problem, especially with "find 20 first solutions" variant.
Update: running times of the same program on my computer on different systems:
B-Prolog 8.1 with tabling: 26 sec
B-Prolog 8.1 without tabling: 128 sec
ECLiPSe 6.1 #187: 122 sec
SWI-Prolog 6.2.6: 330 sec

Resources