Here's the Picat model with the models in Update 4 and Update 5 and Update 6: http://hakank.org/picat/generating_numbers.pi
Update 6: This is probably the constraint model I would have written if not gotten astray from the beginning with wrong assumptions about the problem... It's a more direct approach (from a constraint programmer's perspective) and don't use permutations/1 etc.
It is slightly slower than Update 5 (3.7s using the sat solver vs 3.3s for the Update 4 model). The cp solver is, however, much slower on this model.
In the Picat program cited above it's model go3/0. (The fastest model is go/0.)
The approach:
- create an 20 x 5 matrix with domain 1..5.
- for each row ensure that it's distinct numbers
- and in the loop ensure that there are no common triplets
The model:
go3 ?=>
nolog,
N = 5,
M = 20,
X = new_array(M,N),
X :: 1..N,
% symmetry breaking
X[1,1] #= 1,X[1,2] #= 2,X[1,3] #= 3,X[1,4] #= 4,X[1,5] #= 5,
foreach(I in 1..M)
all_distinct([X[I,K] : K in 1..N]),
foreach(J in 1..I-1)
foreach(A in 0..2)
foreach(B in 0..2)
sum([X[I,K+A] #= X[J,K+B] : K in 1..3]) #< 3
end
end
end
end,
solve($[ff,split],X),
foreach(P in X)
println(P.to_list)
end,
println(numbers=[[I.to_string : I in T].join('').to_int : T in X]),
nl.
go3 => true.
First solution (3.7s with sat):
[12345,35421,23154,25314,43512,32415,32541,12453,21534,14523,
34251,14235,54312,45132,51432,52134,53214,34125,41352,15243]
Update 5 Here's a much faster approach: About 3.3s to find the first solutions, compared to 1min25s for the approach in Update 4.
The approach here is:
- Preprocessing step: From the 120 permutations (
Ps), build a 120 x 120 matrix A of 0/1 where A[P1,P2] = 1 means that Ps[P1] and Ps[P2] are compatible, i.e. that they have no common triplet
- The model: Create a 0/1 list
X of length 120, where X[I] = 1 means that the permutations Ps[I] should be in the sequence (or rather "set" since the order of the permutations don't make a difference).
- In the foreach loop,
X[I]*X[J] #= 1 #=> A[I,J] is a "strange" way of saying that both X[I] and X[J] should be in the sequence if A[I,J] #= 1.
The cp solver takes about 3.3s to find the first length 20 solution. The sat solver is slower for this model: 4.8s (so it's still much faster than the Update 4 version).
Here the complete model:
go ?=>
N = 5,
Ps = permutations(1..N),
PsLen = Ps.len,
% Compatibility matrix:
% A[P1,P2] = 1 if they don't have any common triple
A = new_array(PsLen,PsLen),
bind_vars(A,0),
foreach(P1 in 1..PsLen)
A[P1,P1] := 1,
foreach(P2 in 1..PsLen, P1 < P2)
if check_perms(Ps[P1],Ps[P2]) then
A[P1,P2] := 1,
A[P2,P1] := 1
end
end
end,
M = 20, % length 20 sequence
println(m=M),
% List of 0/1:
% 1 means that it should be in the sequence
X = new_list(PsLen),
X :: 0..1,
sum(X) #= M, % We want M 1s
X[1] #= 1, % symmetry breaking
foreach(I in 1..PsLen)
foreach(J in 1..I-1)
X[I]*X[J] #= 1 #=> A[I,J]
end
end,
solve($[degree,updown],X),
println(x=X),
Perms = [Ps[I] : I in 1..PsLen, X[I]==1],
foreach(P in Perms)
println(P)
end,
println(numbers=[[I.to_string : I in T].join('').to_int : T in Perms]),
% println("Checking:"),
% foreach(I in 1..Perms.len, J in 1..I-1)
% if not check_perms(Perms[I],Perms[J]) then
% println("ERROR!"=Perms[I]=Perms[J])
% end
% end,
nl,
% fail,
nl.
go4 => true.
% list version
check2(Forbidden,Tri) =>
foreach(PP in Tri)
not membchk(PP,Forbidden)
end.
check_perms(Perm1,Perm2) =>
tri(Perm1,Tri1),
tri(Perm2,Tri2),
foreach(PP in Tri2)
not membchk(PP,Tri1)
end,
foreach(PP in Tri1)
not membchk(PP,Tri2)
end.
tri(P,Tri) :- Tri=[P[K..K+2] : K in 1..3].
Here's the first solution:
x = [1,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1]
[1,2,3,4,5]
[3,2,4,1,5]
[3,4,2,5,1]
[2,1,4,3,5]
[4,3,1,2,5]
[4,1,3,5,2]
[2,4,5,1,3]
[4,2,1,5,3]
[4,5,2,3,1]
[1,4,5,3,2]
[2,3,5,4,1]
[1,3,2,5,4]
[3,5,1,2,4]
[3,1,5,4,2]
[2,5,3,1,4]
[5,2,1,3,4]
[5,3,4,1,2]
[1,5,2,4,3]
[5,1,4,2,3]
[5,4,3,2,1]
numbers = [12345,32415,34251,21435,43125,41352,24513,42153,45231,14532,23541,13254,35124,31542,25314,52134,53412,15243,51423,54321]
CPU time 3.325 seconds. Backtracks: 233455
Update 4 As mentioned in the comments, here's a constraint model which find an sequence of length 20.
A seq of 20 is optimal with the following reasoning: There are 60 possible triplets in the collection of the 120 permutations of 1..5. Each number consists of 3 unique triplets each. Thus, there can not be more than 60 / 3 = 20 numbers in such a sequence.
Here's a 20 number sequence:
[12345,32451,43125,15423,23541,41532,52134,
24135,14352,31524,54321,25314,42513,51243,
34215,53412,45231,35142,21453,13254]
This model using the sat solver takes about 1min25 to first this sequence. It's a little more elaborated than the "simple" use of list handling in the previous versions which use backtracking, and that was the problem in these approaches to get a sequence of maximum length.
Some comments:
matrix_element/4 is used to connect the triplets in the Y matrix and the numbers in Z.- the triplets are represented as a number 123..543 (in
Z) and thus we can make sure that they are distinct.
- as usual Picat's
cp module is faster on simpler instances (e.g. lengths up to 16), but for larger instances (>16) then sat tends to be much better.
The model:
import sat, util.
go3 ?=>
nolog,
N = 5,
Ps = permutations(1..N),
PLen = Ps.len,
% Find the triplets
TripletsMap = new_map(),
foreach(P in Ps)
tri(P,Tri),
foreach(T in Tri) TripletsMap.put(T,1) end
end,
% Convert to numbers (123..543)
Triplets = [T[1]*100+T[2]*10+T[3] : T in keys(TripletsMap)].sort,
% length of sequence
member(M,20..20),
println(m=M),
% Indices of the selected permutation
X = new_list(M),
X :: 1..PLen,
% The triplets
Z = new_list(M*3),
Z :: Triplets,
% Y contains the "shortcuts" to the permutations
Y = new_array(M,5),
Y :: 1..N,
all_distinct(X),
all_distinct(Z),
X[1] #= 1, % symmetry breaking
% Fill Y
foreach(I in 1..M)
element(I,X,II),
foreach(K in 1..5)
matrix_element(Ps,II,K,Y[I,K])
end
end,
% Convert triplet list in Y <-> triplet number in Z
C = 1,
foreach(I in 1..M)
foreach(J in 1..3)
to_num([Y[I,J+K] : K in 0..2],10,Z[C]),
C := C+1
end
end,
Vars = Z ++ X ++ Y.vars,
solve($[constr,updown,split],Vars) % split (SAT)
PsX = [Ps[I] : I in X],
println(numbers=[[I.to_string : I in Ps[T]].join('').to_int : T in X]),
nl.
go3 => true.
tri(P,Tri) :- Tri=[P[K..K+2] : K in 1..3].
% converts a number Num to/from a list of integer
% List given a base Base
to_num(List, Base, Num) =>
Len = length(List),
Num #= sum([List[I]*Base**(Len-I) : I in 1..Len]).
And I still think that there is some algorithmic approach which solves this problem in notime...
Update3 Sigh, the program in Update2 was still wrong since it only picked numbers that were later in the permutation list. This third version use permutation(1..5,Next) so all numbers has a change to be picked.
go2 ?=>
Ps = permutations(1..5),
Forbidden = [],
gen(Ps,Forbidden,L),
println([[I.to_string : I in C].join('').to_int : C in L]),
println(len=L.len),
nl,
fail,
nl.
go2 => true.
%
% Create triplets (Tri) from the permutation P
%
tri(P,Tri) :- Tri=[P[K..K+2] : K in 1..3].
% list version
check2(Forbidden,Tri) =>
foreach(PP in Tri)
not membchk(PP,Forbidden)
end.
% list version
add_forbidden_triplets2(Forbidden,Triplets) = F =>
foreach(T in Triplets)
Forbidden := Forbidden ++ [T]
end,
F = Forbidden.
gen([],_Forbidden,[]).
gen(Ps,Forbidden,[Next|L]) :-
permutation(1..5,Next),
not membchk(Next,L),
tri(Next,Tri),
check2(Forbidden,Tri),
% Forbidden := add_forbidden_triplets2(Forbidden,Tri),
Forbidden2 = add_forbidden_triplets2(Forbidden,Tri), % better
Ps2 = [PP : PP in Ps, PP != Next],
gen(Ps2,Forbidden2,L).
gen(_Ps,Forbidden,[]) :-
not (permutation(1..5,Next),
tri(Next,Tri),
check2(Forbidden,Tri)).
The first solution is of length 16:
[12345,12435,12534,13245,13425,13524,14235,14325,
14523,21543,24153,25413,35421,43152,45312,53214]
The next solution (via backtracking) is - however - of length 15:
[12345,12435,12534,13245,13425,13524,14235,14325,
14523,21543,24153,25413,35421,43152,45321]
So I'm - still - not sure if 16 is the maximum length.
Update2: The version in Update was not completely correct (in fact it was dead wrong), since I forgot to add the triplet to Forbidden in the loop (add_forbidden_triplets(Forbidden, Triplets). The program is updated below.
The first solution with 12345 are start number is:
[12345,23145,13245,13425,34125,12435,24135,14235,
14325,43152,42153,45213,45312,53214]
len = 14
And now it's getting interesting since the length of the other sequences (with different start numbers) are around 12..17 numbers. And that's contra intuitive since these things should be symmetric, shouldn't it?
Update: Since I first missed one important constraint in the instructions, here's an adjusted program based on the first approach. It yield a sequence of length 107. The basic - and quite simple - change is that the forbidden triplets are now saved in the hash table Forbidden. The sequence is finished when there's not any available number (when Found is false).
go ?=>
N = 5,
Ps = permutations(1..N),
select(P,Ps,Ps2),
L = [P],
tri(P,Triplets),
Forbidden = new_map(), % keep forbidden triplets in a hash table
add_forbidden_triplets(Forbidden, Triplets), % added in **Update2**
Found = true,
while(Found == true)
if select(NextP,Ps2,Ps3), tri(NextP,PTri), check(Forbidden,PTri) then
L := L ++ [NextP],
add_forbidden_triplets(Forbidden, PTri),
P := NextP,
Ps2 := Ps3
else
Found := false
end
end,
println([[I.to_string : I in C].join('').to_int : C in L]),
println(len=L.len),
nl,
% fail, % generate a new solution
nl.
go => true.
%
% Create triplets (Tri) from the permutation P
%
tri(P,Tri) :- Tri=[P[K..K+2] : K in 1..3].
%
% Check if Tri contain some forbidden triplet
%
check(Forbidden,Tri) =>
foreach(PP in Tri)
not Forbidden.has_key(PP)
end.
%
% Add triplets to Forbidden map
%
add_forbidden_triplets(Forbidden,Triplets) =>
foreach(T in Triplets)
Forbidden.put(T,1)
end.
Here's the first solution:
[12345,23145,13245,31245,32145,32415,32451,13425,
1425,34125,34215,34251,31452,34152,12435,21435,
24135,24315,24351,14235,42135,42315,42351,14325,
41325,43125,43215,43251,14352,41352,43152,43512,
43521,12453,21453,24153,24513,24531,14253,41253,
42153,42513,42531,14523,41523,45213,45231,14532,
41532,45132,45312,45321,21354,23154,23514,23541,
13254,31254,32154,32514,32541,13524,31524,35124,
35214,35241,13542,31542,35142,35412,35421,12534,
21534,25134,25314,25341,52134,52314,15324,51324,
53124,53214,53241,15342,51342,53142,53412,53421,
12543,21543,25143,25413,25431,15243,51243,52143,
52413,52431,15423,51423,54213,54231,15432,51432,
54132,54312,54321]
len = 107
Here's my original answer:
Your program generates 106+1 numbers (using initial number to just 12345), not all 120 that my programs below generates. Perhaps I have missed some requirement in the problem? By the way, you don't need solve/1 in your program since there aren't any constraints.
Below are two of my approaches: both generate a sequence of length 120, i.e. all numbers can be "chained". Both use permutations/1 (from util module) to first generate all the 120 permutations (5!=120) and the select non-deterministically some of the permutations that are left (using select/3). The checking of the allowed successor is done using tri/2 to generate all triplets and check/2 to check that there no common triplets.
Since I found out early that all number can be used (unless I've missed something), the control when the program is done is when there are no permutations available. This is probably a shortcoming of my approach.
import util.
% Using foreach loop
go ?=>
N = 5,
Ps = permutations(1..N),
select(P,Ps,Ps2), % pick the first number (i.e. 12345)
L := [P],
while(Ps2 != [])
tri(P,Forbidden),
select(NextP,Ps2,Ps3),
tri(NextP,PTri),
check(Forbidden,PTri),
L := L ++ [NextP],
P := NextP,
Ps2 := Ps3
end,
println([[I.to_string : I in C].join('').to_int : C in L]), % convert to number
nl.
go => true.
% Using genx/2 ("Prolog style")
go3 ?=>
Ps = permutations(1..5),
PLen = Ps.len,
println(plen=PLen),
genx(Ps,L),
println(len=L.len),
nl.
go3 => true.
% Create triplets (Tri) from the permutation P
tri(P,Tri) :- Tri=[P[K..K+2] : K in 1..3].
% Check if Tri contain some forbidden triplet
check(Forbidden,Tri) =>
foreach(PP in Tri)
not membchk(PP,Forbidden)
end.
% This is the same principal logic as used in go/0
% but in "Prolog style"
genx([],[]).
genx([P],[P]).
genx([P|Ps],[P|L]) :-
tri(P,Forbidden),
select(Next,Ps,Ps2), % pick a new available number
tri(Next,Tri),
check(Forbidden,Tri),
genx([Next|Ps2],L).
Here's the output of go/0 (converted to numbers):
[12345,23145,21345,23415,13245,23451,31245,32145,32415,
13425,32451,31425,34125,34215,13452,34251,31452,34152,
34512,12435,34521,21435,24135,24315,14235,24351,41235,
42135,42315,14325,42351,41325,43125,43215,14352,43251,
41352,43152,43512,12453,43521,21453,24153,24513,14253,
24531,41253,42153,42513,14523,42531,41523,45123,45213,
14532,45231,41532,45132,45312,12354,45321,21354,23154,
23514,13254,23541,31254,32154,32514,13524,32541,31524,
35124,35214,13542,35241,31542,35142,35412,12534,35421,
21534,25134,25314,15234,25341,51234,52134,52314,15324,
52341,51324,53124,53214,15342,53241,51342,53142,53412,
12543,53421,21543,25143,25413,15243,25431,51243,52143,
52413,15423,52431,51423,54123,54213,15432,54231,51432,
54312,54132,54321]
