"Generating Numbers" Puzzle - list

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..5 and 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:
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]

Related

Finding a pattern in a list, prolog

I´m trying to build a predicate pattern(List,Pattern) that takes a List formed only by a repeated pattern and the output has to be that pattern.
Some examples of the List:
List1=[a,b,a,b]
List2=[1,2,3,1,2,3]
List3=[a,a,a,a,a,a,a,a]
As you can see, in each case either the list and the pattern can have different lenghts.
And the output in each case would be:
Pattern1=[a,b]
Pattern2=[1,2,3]
Pattern3=[a]
The only way I can think about a solution is taking the first element of the List (for example, in List2 would be "1") and going through List2 until I find again a "1" and then put in Pattern everything before the second 1 ("123"), but I don´t think it is the best solution. Does anybody know an easier way to solve it? Maybe with Append/3 or Member/2? Thank you!
You are looking for the shortest sequence Q ("pattern") such that list L is n > 0 concatenations of Q (whereby if n = 1 iff Q = L), then
If you have a verifying predicate which verifies that L is indeed a concatenation of a (non necessarily) shortest Q:
multiple_concatenations(X,X). % L = 1 * Q
multiple_concatenations(Q,L) :- % L = N * Q (for some N >= 1, Q <> []) if
concatenation(Q,Rest,L), % L = Q + Rest and
multiple_concatenations(Q,Rest). % Rest = M * Q (for some M)
Where concatenation/3 is just the sanely named append/3 from Prolog:
concatenation(List1,List2,List12) :-
append(List1,List2,List12).
... then you can try to find a shortest Q by just generating longer and longer potential _Q_s (of length going from 1 to length(L)) and break off at the first Q which passes multiple_concatenations(Q,L,N):
shortest_q(Q,L) :-
length(L,Length), % The length of L
must_be(positive_integer,Length), % Enforce length(L) > 0; throws if not
length(Q,N), % Generate a longer and longer
% "list template" Q (i.e. a list with only
% uninstantiated variables) on backtracking,
% with N = 0,1,2,3,...
N>0, % Don't want an empty template though
(concatenation(Q,_,L) % Q's uninstantiated members are
% now instantiated; if this fails,
->
(multiple_concatenations(Q,L), % Check whether Q is acceptable
!) % If yes, cut (i.e. break off at first answer)
;
fail). % If concatenation(Q,_,L) fails, fail the
% predicate: we have
% gone too far (Q is longer than L)
Add a few plunit test cases, which are doubleplus important in the "what am I computing right now?" Prolog wonderland:
:- begin_tests(mq).
test(1) :-
shortest_q(Q,[a,b,a,b]),
assertion(Q == [a,b]).
test(2) :-
shortest_q(Q,[1,2,3,1,2,3]),
assertion(Q == [1,2,3]).
test(3) :-
shortest_q(Q,[a,a,a,a,a,a,a,a]),
assertion(Q == [a]).
test(4) :-
shortest_q(Q,[a,b,c,d,e,f,g]),
assertion(Q == [a,b,c,d,e,f,g]).
:- end_tests(mq).
And so:
?- run_tests.
% PL-Unit: mq .... done
% All 4 tests passed
true.
Note however that "verification mode" accepts a sequence longer than the minimum:
?- shortest_q([1,2,3],[1,2,3,1,2,3]).
true.
?- shortest_q([1,2,3,1,2,3],[1,2,3,1,2,3]).
true.
A simple solution using only append/3 is:
% pattern(+List, -Pattern)
pattern([], _). % Any pattern repeated 0 times gives []
pattern(L, [P|Ps]) :- % [P|Ps] guarantees a non-empty pattern
append([P|Ps], R, L), % Gets a prefix of L as a possible pattern
pattern(R, [P|Ps]), % Checks whether prefix is indeed a pattern
!. % stops when the shortest pattern is found
Examples:
?- pattern([a,b,a,b], P).
P = [a, b].
?- pattern([1,2,3,1,2,3], P).
P = [1, 2, 3].
?- pattern([a,a,a,a,a,a,a], P).
P = [a].

Prolog: is there any way to generate the following items from a list?

I want to develop a predicate in prolog called next, which given a list returns another list with the N elements following the last value of the list where N is the size of the main list. For example: next([1,2,3,4], R).
will return R = [5,6,7,8]. or: next([11,12,13], R). It will return R = [14,15,16].
The problem I have is that if I iterate over the main list until I am left with its last element and start adding the next one to it to the result list, I don't know how many times I should iterate since I don't know what the length of the main list was.This is why my algorithm goes into a loop.
next([], []).
next([X], [X1|Res]) :- X1 is X + 1, next3([X1],Res),!.
next([H|T], [X]) :- next3(T, X).
How about this.
Here we use Constraint Logic Programming to constraint the elements of the result list to be increasing-monotonically-by-1 but just set them to actual values (in one instruction) once we know the last element of the input list.
We also use an open list (a list with an unbound fin) instead of append/3 to grow the output list at its end efficiently. This idiom called "using a difference list".
Finally we add test cases.
:- use_module(library(clpfd)).
% ---
% Called by the customer
% ---
nextor([],[]) :- !. % Empty input list means no work to do!
nextor([X|Xs],Out) :- % The input list contains at least 1 element
assertion(integer(X)), % This is for stating what we assume
OpenList = [K|Fin], % We will create a list of fresh variables; in order
% _to append easily, the list is kept "open", i.e. its tail end
% _is not [] as in a proper list but an unbound variable
% _(namely, Fin). The first element is as yet undefined,
% it is the fresh variable K.
assertion(\+is_list(OpenList)), % Not a list at present time.
nextor_w(X,Xs,[K|Fin],LastFin,LastX), % Processing the list with the first element X already
% _separated out (for assertions). To grow the OpenList at
% _its end, we just need Fin (we don't care about that list's
% Tip when we grow it at the end). Finally, to communicate
% the last Fin set up in the depth of the recursion to this
% call place, use LastFin. The last X found will be in LastX.
LastFin=[], % The open list is close (made proper list) by setting its
% _final Fin to [].
assertion(is_list(OpenList)), % Yes, it is a list now!
K #= LastX+1, % Now that LastX is known, we know K too.
% _The constraint propagates down the list, fixing the still
% unbound variables in OpenList (which is now a closed list).
Out = OpenList. % Unify for result.
% ---
% Does the recursion down the input list
% ---
nextor_w(Xp,[],[_|Fin],Fin,Xp) :- !. % At the end of recursion, communicate the "last X" and the
% and the "latest Fin" back to the caller.
nextor_w(Xp,[X|Xs],[K|Fin],FinOut,XpOut) :-
assertion(Xp+1 =:= X), % The input list is assumed to increase monotonously.
Kn #= K+1, % Next K is constrained to be previous K + 1,
Fin = [Kn|NewFin], % The Fin of the open list is set to a new list cell, with a new Fin
nextor_w(X,Xs,[Kn|NewFin],FinOut,XpOut).
% ---
% Testing
% ---
:- begin_tests(nextor).
test("empty list" ,true(R == [])) :-
nextor([],R).
test("1-elem list",true(R == [2])) :-
nextor([1],R).
test("2-elem list",true(R == [3,4])) :-
nextor([1,2],R).
test("3-elem list",true(R == [4,5,6])) :-
nextor([1,2,3],R).
:- end_tests(nextor).
And so:
?- run_tests.
% PL-Unit: nextor .... done
% All 4 tests passed
true.
How about doing:
next(In,Out) :-
length(In,N),
maplist(plus(N),In,Out).
Uses length/2 and maplist/3. This works for the examples in your question - next([1,2,3,4],R). and next([11,12,13],R). - but only because the lists contain consecutive numbers. next([23,2,18],R). will unify R with [26,5,21].
Or:
next(In,Out) :-
length(In,N),
last(In,LastValue),
MinValue is LastValue+1,
MaxValue is LastValue+N,
numlist(MinValue,MaxValue,Out).
Uses last/2 and numlist/3. With this approach next([23,2,18],R). will unify R with [19,20,21].
This works fine for me:
next(Xs,Ys) :-
next(Xs,[_],Ys).
next([_],[],[]).
next([X],[_|Q],[X1|R]) :-
X1 is X + 1,
next([X1],Q,R).
next([_|T],Q,R) :-
next(T,[_|Q],R).
As it runs down the list it is building up a second list. When it finds the end of the first list it then runs down the second list building the output.
I got this kind of output:
?- next([1,2,3,7,8],W).
W = [9, 10, 11, 12, 13] .

Smallest sub-list that contains all numbers

I am trying to write a program in sml that takes in the length of a list, the max number that will appear on the list and the list of course. It then calculates the length of the smallest "sub-list" that contains all numbers.
I have tried to use the sliding window approach , with two indexes , front and tail. The front scans first and when it finds a number it writes into a map how many times it has already seen this number. If the program finds all numbers then it calls the tail. The tail scans the list and if it finds that a number has been seen more times than 1 it takes it off.
The code I have tried so far is the following:
structure Key=
struct
type ord_key=int
val compare=Int.compare
end
fun min x y = if x>y then y else x;
structure mymap = BinaryMapFn ( Key );
fun smallest_sub(n,t,listall,map)=
let
val k=0
val front=0
val tail=0
val minimum= n;
val list1=listall;
val list2=listall;
fun increase(list1,front,k,ourmap)=
let
val number= hd list1
val elem=mymap.find(ourmap,number)
val per=getOpt(elem,0)+1
fun decrease(list2,tail,k,ourmap,minimum)=
let
val number=hd list2
val elem=mymap.find(ourmap,number)
val per=getOpt(elem,0)-1
val per1=getOpt(elem,0)
in
if k>t then
if (per1=1) then decrease(tl list2,tail+1,k-1,mymap.insert(ourmap,number,per),min minimum (front-tail))
else decrease(tl list2,tail+1,k,mymap.insert(ourmap,number,per),min minimum (front-tail))
else increase (list1, front,k,ourmap)
end
in
if t>k then
if (elem<>NONE) then increase (tl list1,front+1,k,mymap.insert(ourmap,number,per))
else increase(tl list1,front+1,k+1,mymap.insert(ourmap,number,per))
else (if (n>front) then decrease(list2,tail,k,ourmap,minimum) else minimum)
end
in
increase(list1,front,k,map)
end
fun solve (n,t,acc)= smallest_sub(n,t,acc,mymap.empty)
But when I call it with this smallest_sub(10,3,[1,3,1,3,1,3,3,2,2,1]); it does not work. What have I done wrong??
Example: if input is 1,3,1,3,1,3,3,2,2,1 the program should recognize that the parto of the list that contains all numbers and is the smallest is 1,3,3,2 and 3,2,2,1 so the output should be 4
This problem of "smallest sub-list that contains all values" seems to recur in
new questions without a successful answer. This is because it's not a minimal,
complete, and verifiable example.
Because you use a "sliding window" approach, indexing the front and the back
of your input, a list taking O(n) time to index elements is not ideal. You
really do want to use arrays here. If your input function must have a list, you
can convert it to an array for the purpose of the algorithm.
I'd like to perform a cleanup of the code before answering, because running
your current code by hand is a bit hard because it's so condensed. Here's an
example of how you could abstract out the book-keeping of whether a given
sub-list contains at least one copy of each element in the original list:
Edit: I changed the code below after originally posting it.
structure CountMap = struct
structure IntMap = BinaryMapFn(struct
type ord_key = int
val compare = Int.compare
end)
fun count (m, x) =
Option.getOpt (IntMap.find (m, x), 0)
fun increment (m, x) =
IntMap.insert (m, x, count (m, x) + 1)
fun decrement (m, x) =
let val c' = count (m, x)
in if c' <= 1
then NONE
else SOME (IntMap.insert (m, x, c' - 1))
end
fun flip f (x, y) = f (y, x)
val fromList = List.foldl (flip increment) IntMap.empty
end
That is, a CountMap is an int IntMap.map where the Int represents the
fixed key type of the map, being int, and the int parameter in front of it
represents the value type of the map, being a count of how many times this
value occurred.
When building the initialCountMap below, you use CountMap.increment, and
when you use the "sliding window" approach, you use CountMap.decrement to
produce a new countMap that you can test on recursively.
If you decrement the occurrence below 1, you're looking at a sub-list that
doesn't contain every element at least once; we rule out any solution by
letting CountMap.decrement return NONE.
With all of this machinery abstracted out, the algorithm itself becomes much
easier to express. First, I'd like to convert the list to an array so that
indexing becomes O(1), because we'll be doing a lot of indexing.
fun smallest_sublist_length [] = 0
| smallest_sublist_length (xs : int list) =
let val arr = Array.fromList xs
val initialCountMap = CountMap.fromList xs
fun go countMap i j =
let val xi = Array.sub (arr, i)
val xj = Array.sub (arr, j)
val decrementLeft = CountMap.decrement (countMap, xi)
val decrementRight = CountMap.decrement (countMap, xj)
in
case (decrementLeft, decrementRight) of
(SOME leftCountMap, SOME rightCountMap) =>
Int.min (
go leftCountMap (i+1) j,
go rightCountMap i (j-1)
)
| (SOME leftCountMap, NONE) => go leftCountMap (i+1) j
| (NONE, SOME rightCountMap) => go rightCountMap i (j-1)
| (NONE, NONE) => j - i + 1
end
in
go initialCountMap 0 (Array.length arr - 1)
end
This appears to work, but...
Doing Int.min (go left..., go right...) incurs a cost of O(n^2) stack
memory (in the case where you cannot rule out either being optimal). This is a
good use-case for dynamic programming because your recursive sub-problems have a
common sub-structure, i.e.
go initialCountMap 0 10
|- go leftCountMap 1 10
| |- ...
| `- go rightCountMap 1 9 <-.
`- go rightCountMap 0 9 | possibly same sub-problem!
|- go leftCountMap 1 9 <-'
`- ...
So maybe there's a way to store the recursive sub-problem in a memory array and not
perform a recursive lookup if you know the result to this sub-problem. How to
do memoization in SML is a good question in and of itself. How to do purely
functional memoization in a non-lazy language is an even better one.
Another optimization you could make is that if you ever find a sub-list the
size of the number of unique elements, you need to look no further. This number
is incidentally the number of elements in initialCountMap, and IntMap
probably has a function for finding it.

Find powers of 2 in a list Prolog

I'm trying to create a list in Prolog (SWI Prolog) and check which numbers are powers of 2 and second find how many times a specific number is in the list (in this example I'm trying to find how many times the number 3 is in the list).
For a example, if you ask
?- check([0,2,3,-5,-2,1,8,7,4], MULT2, THREE).
you should see
MULT2=[2,8,4]
THREE=1
My first try to find a solution is to search the list with head and doing head mod 2 = 0 to find all numbers which are powers of 2, but something went wrong and I only get "false" as an answer.
Here's how you can find the "powers of two" in logically-pure way!
Using sicstus-prolog 4.3.5, library(reif) and library(clpz):
:- use_module([library(reif), library(clpz)]).
power_of_two_t(I, T) :-
L #= min(I,1),
M #= I /\ (I-1),
call((L = 1, M = 0), T). % using (=)/3 and (',')/3 of library(reif)
Sample query1 using meta-predicate tfilter/3 in combination with power_of_two_t/2:
?- tfilter(power_of_two_t, [0,2,3,-5,-2,1,8,7,4], Ps).
Ps = [2,1,8,4]. % succeeds deterministically
Here's a more general query suggested by a comment:
?- tfilter(power_of_two_t, [X], Ps).
Ps = [X], 0#=X/\_A, _A+1#=X, X in 1..sup, _A in 0..sup
; Ps = [], dif(_A,0), _A#=X/\_B, _B+1#=X, X in 1..sup, _B in 0..sup
; Ps = [], dif(_A,1), _A#=min(X,1), _B#=X/\_C, _C+1#=X, X#>=_A, _A in inf..1.
Footnote 1: The answer sequences shown above were brushed up to indicate the determinism of calls.
Footnote 2: To reproduce the results use call_det/2 which is defined like this:
call_det(G_0, Det) :-
call_cleanup(G_0, Flag = set),
( nonvar(Flag)
-> Det = true
; Det = false
).
It's a strange thing to have two such a different tasks to do in one predicate. You should probably have two separate predicates, one for counting number of powers of 2 and one to count 3s. Then you can combine them in one predicate like:
check(Nums, MULT2, THREE) :-
count2powers(Nums, MULT2),
count3s(Nums, THREE).
After that you can decompose further and have a separate predicate to check if a number is a power of 2:
is2power(1).
is2power(N) :-
N > 0,
N2 is N // 2,
N2 * 2 =:= N,
is2power(N2).
This is basic software engineering and this way you can build your program step by step and you will be able to ask more concrete and meaningful questions than just "The whole program returns false."

Create a sublist from a list given an index and a number of elements. Prolog

I am trying to solve a simple prolog question but I am not able to solve it. From a list a need to create a sublist given the index I and then from I the next elements given as N. If the index is greater than the list lenght I will get the sublist empty. If N (number of elements) is greater than the rest of elements in the list I will get all the elements from I until the end.
Here, I got one part of the assignment, I can get from the index I, the next elements N. Now I ask about the other parts in the assignment:
1) When I (index) is longer than the list length, I have to get an empty list in the sublist.
?- sublist([a,b,c,d],5,2,L)
L=[]
2) When N (Next elements) is greater than the number of elements we have rest, I need to get all the elements from that position till the end.
?- sublist([a,b,c,d],4,4,L)
L=[d]
The code I already have is the next one, this one is working:
sublist([X|_],1,1,[X]).
sublist([],_,_,[]).% I use this one for the case bases
sublist([X|Xs],1,K,[X|Ys]):-
K>1,
K1 is K-1,
sublist(Xs,1,K1,Ys).
sublist([_|Xs],I,K,Ys):-
I > 1,
I1 is I-1,
sublist(Xs,I1,K,Ys).
sublist([X|_], 1, 1, [X]).
This is a good clause. It says that a sublist of length 1 starting at 1 taken from the list [X|_] is [X].
sublist([X|Xs], 1, K, [X|Ys]) :-
K > 1,
K1 is K - 1,
sublist(Xs, 1, K1, Ys).
This is also a good clause. It says that the sublist of length K starting at 1 taken from [X|Xs] starts with X and has a tail Ys which is the sublist of length K-1 from the tail of the first list (Xs) starting at 1.
sublist([_|Xs], I, K, Ys) :-
I > 1,
I1 is I - 1,
K1 is K - 1,
sublist(Xs, I1, K1, Ys).
This clause has an issue. If you have a list [_|Xs] and want to take a sublist of length K start at I (for I greater than 1), you take the sublist of length K-1 from its tail starting at position I-1. The question is: why would the sublist now need to be length K-1? The purpose of this clause should be to reduce the problem to the case where you're dealing with a starting index of 1, then let the second clause take care of the rest.
Then in your definition of the desired behavior, you have: If N (number of elements) is greater than the rest of elements in the list I will get all the elements from I until the end. This notion currently isn't in any of the clauses. The base case is currently your first clause which specifically requires a length of 1 to produce a list of length 1. You need another base case clause that handles the case where the first list goes empty but K might still be any value:
sublist([], ?, _, ?).
Just fill in the ? with something logical. :)
just to show how nondeterministic builtins like nth1/3 can help...
sublist(List, From, Count, SubList) :-
findall(E, (nth1(I, List, E), I >= From, I < From + Count), SubList).
edit a note to say that this 'one liner' is actually a lot less efficient than a crafted sublist/4.
Indeed,
2 ?- N=1000000,length(L,N),time(sublist(L,N,1,V)).
% 3,000,014 inferences, 2.129 CPU in 2.134 seconds (100% CPU, 1409024 Lips)
N = 1000000,
L = [_G28, _G31, _G34, _G37, _G40, _G43, _G46, _G49, _G52|...],
V = [_G3000104].
3 ?- N=1000000,length(L,N),time(sublist(L,1,1,V)).
% 4,000,012 inferences, 2.549 CPU in 2.553 seconds (100% CPU, 1569076 Lips)
N = 1000000,
L = [_G28, _G31, _G34, _G37, _G40, _G43, _G46, _G49, _G52|...],
V = [_G3000104].
I'm going to see if some kind of cut inside findall' predicate could solve this problem, but it's unlikely. This one is better:
sublist(List, From, Count, SubList) :-
To is From + Count - 1,
findall(E, (between(From, To, I), nth1(I, List, E)), SubList).
18 ?- N=1000000,length(L,N),time(sublist(L,3,3,V)).
% 28 inferences, 0.000 CPU in 0.000 seconds (93% CPU, 201437 Lips)
N = 1000000,
L = [_G682, _G685, _G688, _G691, _G694, _G697, _G700, _G703, _G706|...],
V = [_G3000762, _G3000759, _G3000756].
Here's one solution (though it's probably not what your professor wants):
sublist( Xs , Offset , Count , Ys ) :- %
length(Prefix,Offset ) , % construct a list of variables of length 'offset'
length(Ys,Count) , % construct a list of variables of length 'count'
append(Prefix,Suffix,Xs) , % strip the first first 'offset' items from the source list ,
append(Ys,_,Suffix) % extract the first 'count' items from what's left.
. % easy!
That's one approach, letting Prolog's built-ins do the work for you.
Here's another approach that doesn't use any built-ins. This one uses one helper predicate that simply splits a list into a prefix of the specified length, and a suffix, consisting of whatever is left over.
sublist( Xs , Offset , Count , Ys ) :-
split(Xs,Offset,_,X1) , % extract the first 'offset' items from the lsit and toss them
split(X1,Count,Ys,_) % extract the first 'count' items from the remainder to get the result.
.
split( [] , 0 , [] , [] ) . % splitting a zero-length prefix from an empty list yields a zero-length prefix and a zero length suffix.
split( [X|Xs] , 0 , [] , [X|Xs] ) . % splitting a zero-length prefix from a non-empty list yields a zero-length prefix and the non-empty list.
split( [X|Xs] , N , [X|Ps] , Qs ) :- % Otherwise...
N > 0 , % - if the count is positive
N1 is N-1 , % - we decrement count
split( Xs , N1 , Ps , Qs ) % - and recurse down, prepending the head of the source list to the prefix
. % Easy!