I have come across the following puzzle and couldn't formulate a solution in Picat:
You will generate 5-digit numbers, where each digit is in
1..5and different from the others, with the constraint that any three adjacent digits used in one number can’t be used in another number. How many different numbers can be obtained according to this rule?
For example, if we generated the number 12345, the other numbers CANNOT contain 123, 345, or 456, so all numbers of the following form are banned from the chain:
123AB, A123B, AB123,
234AB, A234B, AB234,
345AB, A345B, AB345,
I got really confused on how to store these "forbidden" sublists and how to check each number against them as I build the list of numbers.
My attempt:
I think I managed to generate the valid "candidate" for a given chain state, but I can't figure out how to generate the chain like this.
import cp.
import util.
valid(Ls, Cd) ?=>
% verify that the head of the chain is correct?
% so the chain consists of permutations of 12345
foreach (L in Ls)
len(L) = 5,
permutation(L, [1,2,3,4,5])
end,
% generate the candidate
Cd = new_list(5),
permutation(Cd, [1,2,3,4,5]),
% check the candidate against the head of the chain
foreach (L in Ls)
not sublist([L[1],L[2],L[3]], Cd),
not sublist([L[2],L[3],L[4]], Cd),
not sublist([L[3],L[4],L[5]], Cd)
end,
solve(Ls),
printf("Cd: %w\n", Cd),
fail,
nl.
% so that 3 element sublists of 12345 are 123,234 and 345.
sublist(X, S) =>
append(_, T , S),
append(X, _ , T),
X.len #>= 0.
% seems to work, the candidates don't have the banned triplets as sublists.
% so in this case the banned triplets would be
% 123,234,345,543,432,321
go => valid([[1,2,3,4,5], [5,4,3,2,1]], _).
main => go.
Comment: It is indeed very interesting that the situation is not symmetric. If we analyze the state:
[12345,12435,12534,13245,13425,13524,14235,
14325,14523,21543,24153,25413,35421,43152]
we see that the three candidates which are valid/can be appended to this chain are:
Cd1: [5,3,2,1,4]
Cd2: [4,5,3,1,2]
Cd3: [4,5,3,2,1]
Obviously, if we choose Cd3, since it contains both 453 and 532 it disallows us from choosing any candidate after it, so the chain ends at N=15.
If we choose Cd1, it excludes Cd3 but still keeps Cd2, so the chain goes on to N=16.
Similarly if we choose Cd2, it excludes Cd3 but still keeps Cd1, so again N=16 is possible.
So it seems that in general some candidates contain(and therefore exclude) others, and the length of the chain depends on whether we choose these candidates or not.
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:
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:
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 tripletX 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).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.Z) and thus we can make sure that they are distinct.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]