How to generate a list with only two 1s and other 0s of the given length?

Question

I have to generate lists that consist of 2 '1's and other elements are '0's. I tried the following code but it does not work:

count([], _, 0).
count([X|T], X, Y) :- count(T, X, Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z).

two(X) :- count(X, 1, Counter), Counter =:= 2.

Querying length(Vs, 4), Vs ins 0..1, two(Vs). gives nothing.

How to generate such lists properly? I expect to get something like [1, 1, 0, 0], [1, 0, 1, 0] ... [0, 0, 1, 1].

Answer 1

twoones(Bs) :-
   Bs ins 0..1,
   sum(Bs, #=, 2).

| ?- length(Bs,4), twoones(Bs).
Bs = [_A,_B,_C,_D],
clpz:(_A+_B+_C+_D#=2),
clpz:(_A in 0..1),
clpz:(_B in 0..1),
clpz:(_C in 0..1),
clpz:(_D in 0..1) ? 
yes
| ?- length(Bs,4), twoones(Bs), labeling([], Bs).
Bs = [0,0,1,1] ? ;
Bs = [0,1,0,1] ? ;
Bs = [0,1,1,0] ? ...

Here, I am using library(clpz) which is the successor to library(clpfd). For simple examples as this, there is not much of a difference.

Answer 2

A grammar is quite a natural way of specifying a list pattern:

two --> [1], one ; [0], two.
one --> [1], zeros ; [0], one.
zeros --> [] ; [0], zeros.

Example call:

?- length(Xs, 3), phrase(two, Xs, []).
Xs = [1, 1, 0]
Yes (0.00s cpu, solution 1, maybe more)
Xs = [1, 0, 1]
Yes (0.00s cpu, solution 2, maybe more)
Xs = [0, 1, 1]
Yes (0.00s cpu, solution 3, maybe more)
No (0.00s cpu)

Answer 3

I think you are making it too complicated here. Instead of using clpfd here, you can just make a predicate that generates such lists.

We can first make a predicate that unifies with all lists that contain only 0s:

all0([]).
all0([0|T]) :-
    all0(T).

next we can make a predicate with1s(N, l) that will "inject" N ones in a list it generates:

with1s(0, L) :-
    all0(L).
with1s(N, [H|T]) :-
    N > 0,
    ((H=1, N1 is N-1);
     (H=0, N1 = N)),
    with1s(N1, T).

So for example for a list of three elements, we get:

?- L = [_,_,_], with1s(2, L).
L = [1, 1, 0] ;
L = [1, 0, 1] ;
L = [0, 1, 1] ;
false.

This of course does not work bidirectional, I leave it as an exercise to further improve the predicate.

Answer 4

These are excellent answers.

Here is another one. nth0 comes from library(lists).

• SWI Prolog nth0

• SICStus nth0

• The two 1 have been replaced by a and b for illustration purposes.

• findall(0, between(1, Zlen, _), Zlist) creates a list of 0 (Zlist) of length Zlen. See between.

gimme(List,Len) :- Len >= 2,                    
                   Zlen is Len-2,
                   findall(0, between(1, Zlen, _), Zlist),
                   between(0, Zlen, Pos1),                 % we will insert 'a' at Pos1
                   Pos1n is Pos1+1,
                   between(Pos1n,Len,Pos2),                % we will insert 'b' at Pos2, always after 'a'
                   nth0(Pos1, Tlist, a, Zlist),            % Zlist -morph-> Tlist
                   nth0(Pos2, List, b, Tlist).             % Tlist -morph-> List                

?- gimme(L,2).
L = [a, b] ;
false.

?- gimme(L,3).
L = [a, b, 0] ;
L = [a, 0, b] ;
L = [0, a, b] ;
false.

?- gimme(L,4).
L = [a, b, 0, 0] ;
L = [a, 0, b, 0] ;
L = [a, 0, 0, b] ;
L = [0, a, b, 0] ;
L = [0, a, 0, b] ;
L = [0, 0, a, b] ;
false.

?- gimme(L,5).
L = [a, b, 0, 0, 0] ;
L = [a, 0, b, 0, 0] ;
L = [a, 0, 0, b, 0] ;
L = [a, 0, 0, 0, b] ;
L = [0, a, b, 0, 0] ;
L = [0, a, 0, b, 0] ;
L = [0, a, 0, 0, b] ;
L = [0, 0, a, b, 0] ;
L = [0, 0, a, 0, b] ;
L = [0, 0, 0, a, b] ;

Answer 5

Another way to specify this pattern:

two_ones_n_zeros(N, L) :-
    length(Z, N),
    maplist(=(0), Z),
    nth1(I, L0, 1, Z),
    nth1(J, L, 1, L0),
    I < J.

Example:

?- two_ones_n_zeros(2, L).
L = [1, 1, 0, 0] ;
L = [1, 0, 1, 0] ;
L = [1, 0, 0, 1] ;
L = [0, 1, 1, 0] ;
L = [0, 1, 0, 1] ;
L = [0, 0, 1, 1] ;
false.

Comparison of the efficiency of the different approaches

two_ones_n_zeros_dcg(N, L) :-
    M is N + 2,
    length(L, M),
    phrase((zeros, [1], zeros, [1], zeros), L).

two --> [1], one ; [0], two.
one --> [1], zeros ; [0], one.
zeros --> [] ; [0], zeros.

:- use_module(library(clpfd)).

two_ones_n_zeros_clp(N, L) :-
    M is N + 2,
    length(L, M),
    twoones(L),
    labeling([], L).

twoones(Bs) :-
   Bs ins 0..1,
   sum(Bs, #=, 2).

comparison(N) :-
    write('\nLists: '),
    garbage_collect,
    time(forall(two_ones_n_zeros(N, _), true)),
    write('\nDCG: '),
    garbage_collect,
    time(forall(two_ones_n_zeros_dcg(N, _), true)),
    write('\nCLP: '),
    garbage_collect,
    time(forall(two_ones_n_zeros_clp(N, _), true)).

Empirical results, using swi-prolog (version 8.4.2):

?- two_ones_n_zeros(1, L1).
L1 = [1, 1, 0] ;
L1 = [1, 0, 1] ;
L1 = [0, 1, 1] ;
false.

?- two_ones_n_zeros_dcg(1, L1).
L1 = [1, 1, 0] ;
L1 = [1, 0, 1] ;
L1 = [0, 1, 1] ;
false.

?- two_ones_n_zeros_clp(1, L1).
L1 = [0, 1, 1] ;
L1 = [1, 0, 1] ;
L1 = [1, 1, 0].

?- comparison(400).

Lists: 
% 323,613 inferences, 0.031 CPU in 0.031 seconds (100% CPU, 10355616 Lips)

DCG: 
% 11,152,272 inferences, 0.391 CPU in 0.391 seconds (100% CPU, 28549816 Lips)

CLP: 
% 1,302,560,369 inferences, 94.063 CPU in 94.110 seconds (100% CPU, 13847818 Lips)
true.