Prolog. Fill out lists - prolog

I have to fill out a list of length n digits.
I know that n-1 is in the range from 1 to 9, and one digit can be in the range from 1 to 99.
I did it this way:
generate([First|Next],Czynniki):-
between(1,99,First),
generate2(Next).
generate2(Next):-
sublist([1,2,3,4,5,6,7,8,9],Next).
sublist([],[]).
sublist([H|T],[H|S]):-
sublist(T,S).
sublist([_|T],S):-
sublist(T,S).
Doing it this way I generate some of the same solutions.
Maybe you have some idea ​​how I can generate lists without repetition?
Edit
For the sake of clarity, I (#repeat) have added the following relevant comment by the OP:
At the entrance I have list of length N of undefined variables. And want fill out my list: N-1 numbers from the interval 1-9 and one number in the range 1-99.
Example: N=5, L=[56,2,3,4,8] ...

Use clpfd!
:- use_module(library(clpfd)).
Let's define digits10plusdigit100_n/2 like this:
digits10plusdigit100_n(Zs,N) :-
Zs = [CentDigit|DecDigits],
length(Zs,N),
CentDigit in 1..99,
DecDigits ins 1..9,
labeling([],Zs).
Sample queries:
?- digits10plusdigit100_n(Zs,1).
Zs = [1]
; Zs = [2]
; Zs = [3]
...
; Zs = [98]
; Zs = [99]
; false.
?- digits10plusdigit100_n(Zs,3).
Zs = [1,1,1]
; Zs = [1,1,2]
; Zs = [1,1,3]
...
; Zs = [1,2,1]
; Zs = [1,2,2]
...
; Zs = [1,9,8]
; Zs = [1,9,9]
; Zs = [2,1,1]
; Zs = [2,1,2]
...
; Zs = [2,1,3]
; Zs = [2,1,4]
...
; Zs = [98,9,9]
; Zs = [99,1,1]
; Zs = [99,1,2]
...
; Zs = [99,9,8]
; Zs = [99,9,9]
; false.

maybe change to between(10,99,X)
so reverse your predicates, generate numbers less then 10 and then generate last variable wich will be greater then 10

Isn't this just a variation of what #false very elegantly did in here ?
gen(Xs) :-
between(1, 9, L),
length(Xs, L),
maplist(between(1,99), Xs).
?- gen(Xs).
Xs = [1] ;
Xs = [2] ;
Xs = [3] ;
Xs = [4] ;
Xs = [5] ;
..
Xs = [99] ;
Xs = [1, 1] ;
Xs = [1, 2] ;
Xs = [1, 3] ;
Xs = [1, 4] ;
..
Xs = [1, 98] ;
Xs = [1, 99] ;
Xs = [2, 1] ;
Xs = [2, 2] ;
Xs = [2, 3] ;
Xs = [2, 4] ;
Xs = [2, 5] ;
Xs = [2, 6] ;

Related

Prolog program to create a list with first duplicate elements

I need to implement this function:
cod_first(X, L, Lrem, Lfront).
Lfront contains all the copies of X that are at the beginning of L, including X; Lrem is the list of the rest of the elements.
I've tried to implement it using append but I'm quite new in Prolog and I'm a bit lost.
The expected output for the program is something like this:
?- cod_first(1, [1, 1, 2, 3], Lrem, Lfront)
Lrem = [2, 3],
Lfront = [1, 1, 1];
false.
?- cod_first(1, [2, 3, 4], Lrem, Lfront)
Lrem = [2, 3, 4],
Lfront = [1];
false.
Update: I've found this function that packs the same elements into a list:
pack([], []).
pack([X], [[X]]).
pack([X, X| L], [[X| Xs]| R]) :-
pack([X| L], [Xs| R]).
pack([X, Y| L], [[X]| R]) :-
X \= Y,
pack([Y| L], R).
I think this function could be adaptable to the one I'm looking for, any help?
First let's check the code you found! I will test it by considering all lists, starting with the shortest one:
?- N=N, length(Xs,N), pack(Xs, Xss).
N = 0, Xs = [], Xss = []
; N = 1, Xs = [_A], Xss = [[_A]]
; N = 2, Xs = [_A,_A], Xss = [[_A,_A]]
; N = 3, Xs = [_A,_A,_A], Xss = [[_A,_A,_A]]
; N = 4, Xs = [_A,_A,_A,_A], Xss = [[_A,_A,_A,_A]]
; ... .
So, according to this query, your code only works for lists where all elements are the same. In fact, the goal X \= Y is responsible for this. Better express inequality with dif(X, Y). With this little change we get:
?- N=N, length(Xs,N), pack(Xs, Xss).
N = 0, Xs = [], Xss = []
; N = 1, Xs = [_A], Xss = [[_A]]
; N = 2, Xs = [_A,_A], Xss = [[_A,_A]]
; N = 2, Xs = [_A,_B], Xss = [[_A],[_B]], dif(_A,_B)
; N = 3, Xs = [_A,_A,_A], Xss = [[_A,_A,_A]]
; N = 3, Xs = [_A,_A,_B], Xss = [[_A,_A],[_B]], dif(_A,_B)
; N = 3, Xs = [_A,_B,_B], Xss = [[_A],[_B,_B]], dif(_A,_B)
; N = 3, Xs = [_A,_B,_C], Xss = [[_A],[_B],[_C]], dif(_A,_B), dif(_B,_C)
; N = 4, Xs = [_A,_A,_A,_A], Xss = [[_A,_A,_A,_A]]
; ... .
Now we get really all solutions. Let's consider the two answers for N = 2. The first says that for Xs's elements being all equal, Xss contains just one element. The second says that when Xs's elements are different, they show in separate elements of Xss. Note the dif(_A,_B) which ensures that only terms that are different are chosen.
However, you are only interested in a single such split:
cod_first(X, [], [], [X]).
cod_first(X, [X|Es], Lrem, [X|Xs]) :-
cod_first(X, Es, Lrem, Xs).
cod_first(X, [E|Es], [E|Es], [X]) :-
dif(X,E).
?- N=N, length(Xs, N), cod_first(X, Xs, Lrem, Lfront).
N = 0, Xs = [], Lrem = [], Lfront = [X]
; N = 1, Xs = [X], Lrem = [], Lfront = [X,X]
; N = 1, Xs = [_A], Lrem = [_A], Lfront = [X], dif(_A,X)
; N = 2, Xs = [X,X], Lrem = [], Lfront = [X,X,X]
; N = 2, Xs = [X,_A], Lrem = [_A], Lfront = [X,X], dif(_A,X)
; N = 2, Xs = [_A,_B], Lrem = [_A,_B], Lfront = [X], dif(_A,X)
; N = 3, Xs = [X,X,X], Lrem = [], Lfront = [X,X,X,X]
; N = 3, Xs = [X,X,_A], Lrem = [_A], Lfront = [X,X,X], dif(_A,X)
; N = 3, Xs = [X,_A,_B], Lrem = [_A,_B], Lfront = [X,X], dif(_A,X)
; N = 3, Xs = [_A,_B,_C], Lrem = [_A,_B,_C], Lfront = [X], dif(_A,X)
; N = 4, Xs = [X,X,X,X], Lrem = [], Lfront = [X,X,X,X,X]
; ... .
Here is another version which I prefer using library(reif) available
for
SICStus and
SWI.
cod_first2(X, Es, Lrem, [X|Xs]) :-
cod_first2i(Es, X, Xs, Lrem).
cod_first2i([], _, [], []).
cod_first2i([E|Es], X, Xs0, Ys) :-
if_( E = X
, ( Xs0 = [X|Xs], cod_first2i(Es, X, Xs, Ys) )
, ( Xs0 = [], Ys = [E|Es] )
).
This is much more efficient, but gives exactly the same answers.

Extra Outputs when using _

I have the following code:
pick_even([], []).
pick_even([_, H | T], [H | R]) :-
pick_even(T, R).
pick_even([_, H , _ | T], [H | R]) :-
pick_even(T, R).
When running the query, ?- pick_even(L,[4,7])., I want to receive the output:
L = [_7650, 4, _7662, 7] ;
L = [_7650, 4, _7662, 7, _7674] ;
Instead I am receiving some extra outputs that I do not want:
L = [_7650, 4, _7662, 7] ;
L = [_7650, 4, _7662, 7, _7674] ;
L = [_7650, 4, _7662, _7668, 7] ;
L = [_7650, 4, _7662, _7668, 7, _7680].
How can I eliminate these extra outputs without modifying the query?
I'm brand new to prolog, so I expect this to be a very easy syntax fix.
list_evens([], []).
list_evens([_|Es], Fs) :-
list_evens2(Es, Fs).
list_evens2([], []).
list_evens2([E|Es], [E|Fs]) :-
list_evens(Es, Fs).
That is, you forgot in particular the case of a one-element list.
And, for testing, the best way is to take the most general query:
?- list_even(Xs, Ys).
Xs = [], Ys = []
; Xs = [_A], Ys = []
; Xs = [_A,_B], Ys = [_B]
; Xs = [_A,_B,_C], Ys = [_B]
; Xs = [_A,_B,_C,_D], Ys = [_B,_D]
; Xs = [_A,_B,_C,_D,_E], Ys = [_B,_D]
; Xs = [_A,_B,_C,_D,_E,_F], Ys = [_B,_D,_F]
; ... .
In this manner you say:
Oh Prolog, why should I figure out what cases are of interest? Please do this for me!
And, diligently, Prolog will fill out the blanks. So you only need to ensure that all the answers you expect are here.

recursive Prolog predicate?

i am currently working on a project and i want to implement helper predicate in Prolog
break_down(N, L)
which works as follows
?- break_down(1,L).
L = [1] ;
false.
?- break_down(4,L).
L = [1, 1, 1, 1] ;
L = [1, 1, 2] ;
L = [1, 3] ;
L = [2, 2] ;
L = [4] ;
false.
and so on for any positive integer N .
i have tried and implemented a code which generates only the first result and i cannot get the rest of the results , and this is my code
break_down(1,[1]).
break_down(N,L):-
N>0,
N1 is N-1,
break_down(N1,L1),
append(L1,[1],L).
which generates only the first output result :
L = [1, 1, 1, 1] ;
any suggestion how to edit my code to get the rest ?
Here's a straight-forward recursive implementation using plain integer arithmetic and backtracking:
break_down(N,L) :-
break_ref_down(N,1,L). % reference item is initially 1
break_ref_down(0,_,[]).
break_ref_down(N,Z0,[Z|Zs]) :-
between(Z0,N,Z), % multiple choices
N0 is N-Z,
break_ref_down(N0,Z,Zs). % pass on current item as reference
Sample query:
?- break_down(8,Zs).
Zs = [1,1,1,1,1,1,1,1]
; Zs = [1,1,1,1,1,1,2]
; Zs = [1,1,1,1,1,3]
; Zs = [1,1,1,1,2,2]
; Zs = [1,1,1,1,4]
; Zs = [1,1,1,2,3]
; Zs = [1,1,1,5]
; Zs = [1,1,2,2,2]
; Zs = [1,1,2,4]
; Zs = [1,1,3,3]
; Zs = [1,1,6]
; Zs = [1,2,2,3]
; Zs = [1,2,5]
; Zs = [1,3,4]
; Zs = [1,7]
; Zs = [2,2,2,2]
; Zs = [2,2,4]
; Zs = [2,3,3]
; Zs = [2,6]
; Zs = [3,5]
; Zs = [4,4]
; Zs = [8]
; false.
Here's an implementation based on clpfd.
:- use_module(library(clpfd)).
As the predicate break_downFD/2 is non-recursive, the code is both readable and simple:
break_downFD(N,Zs) :-
length(Max,N), % multiple choices
append(_,Zs,Max),
Zs ins 1..N,
sum(Zs,#=,N),
chain(Zs,#=<), % enforce sequence is non-descending
labeling([],Zs). % multiple choices, possibly
Sample query using SWI-Prolog:
?- break_downFD(6,Zs).
Zs = [1,1,1,1,1,1]
; Zs = [1,1,1,1,2]
; Zs = [1,1,1,3]
; Zs = [1,1,2,2]
; Zs = [1,1,4]
; Zs = [1,2,3]
; Zs = [2,2,2]
; Zs = [1,5]
; Zs = [2,4]
; Zs = [3,3]
; Zs = [6]
; false.

Permuted combinations of the elements of a list - Prolog

How can I generate all the possible combinations of the elements of a list?
For example, given the list [1,2,3], I want to design a predicate with the form comb([1,2,3], L). which should return the following answer for L:
[1]
[2]
[3]
[1,2]
[2,1]
[1,3]
[3,1]
[2,3]
[3,2]
[1,2,3]
[1,3,2]
[2,1,3]
[2,3,1]
[3,1,2]
[3,2,1]
What you are asking for involves both combinations (selecting a subset) and permutations (rearranging the order) of a list.
Your example output implies that the empty list is not considered a valid solution, so we will exclude it in the implementation that follows. Reconsider if this was an oversight. Also this implementation produces the solutions in a different order than your example output.
comb(InList,Out) :-
splitSet(InList,_,SubList),
SubList = [_|_], /* disallow empty list */
permute(SubList,Out).
splitSet([ ],[ ],[ ]).
splitSet([H|T],[H|L],R) :-
splitSet(T,L,R).
splitSet([H|T],L,[H|R]) :-
splitSet(T,L,R).
permute([ ],[ ]) :- !.
permute(L,[X|R]) :-
omit(X,L,M),
permute(M,R).
omit(H,[H|T],T).
omit(X,[H|L],[H|R]) :-
omit(X,L,R).
Tested with Amzi! Prolog:
?- comb([1,2,3],L).
L = [3] ;
L = [2] ;
L = [2, 3] ;
L = [3, 2] ;
L = [1] ;
L = [1, 3] ;
L = [3, 1] ;
L = [1, 2] ;
L = [2, 1] ;
L = [1, 2, 3] ;
L = [1, 3, 2] ;
L = [2, 1, 3] ;
L = [2, 3, 1] ;
L = [3, 1, 2] ;
L = [3, 2, 1] ;
no
Stay pure by defining comb/2 based on same_length/2, prefix/2, foldl/4 and
select/3:
comb(As,Bs) :-
same_length(As,Full),
Bs = [_|_],
prefix(Bs,Full),
foldl(select,Bs,As,_).
Here's the sample query given by the OP:
?- comb([1,2,3],Xs).
Xs = [1]
; Xs = [2]
; Xs = [3]
; Xs = [1,2]
; Xs = [1,3]
; Xs = [2,1]
; Xs = [2,3]
; Xs = [3,1]
; Xs = [3,2]
; Xs = [1,2,3]
; Xs = [1,3,2]
; Xs = [2,1,3]
; Xs = [2,3,1]
; Xs = [3,1,2]
; Xs = [3,2,1]
; false.
Ok! But what if the list given as the first argument contains duplicates?
?- comb([1,1,2],Xs).
Xs = [1]
; Xs = [1] % (redundant)
; Xs = [2]
; Xs = [1,1]
; Xs = [1,2]
; Xs = [1,1] % (redundant)
; Xs = [1,2] % (redundant)
; Xs = [2,1]
; Xs = [2,1] % (redundant)
; Xs = [1,1,2]
; Xs = [1,2,1]
; Xs = [1,1,2] % (redundant)
; Xs = [1,2,1] % (redundant)
; Xs = [2,1,1]
; Xs = [2,1,1] % (redundant)
; false.
Not quite! Can we get rid of above redundant answers? Yes, simply use selectd/3!
comb(As,Bs) :-
same_length(As,Full),
Bs = [_|_],
prefix(Bs,Full),
foldl(selectd,Bs,As,_).
So let's re-run above query again with the improved implementation of comb/2!
?- comb([1,1,2],Xs).
Xs = [1]
; Xs = [2]
; Xs = [1,1]
; Xs = [1,2]
; Xs = [2,1]
; Xs = [1,1,2]
; Xs = [1,2,1]
; Xs = [2,1,1]
; false.
there is a predefined predicate called permutation ...
1 ?- permutation([1,2,3],L).
L = [1, 2, 3] ;
L = [2, 1, 3] ;
L = [2, 3, 1] ;
L = [1, 3, 2] ;
L = [3, 1, 2] ;
L = [3, 2, 1] .
2 ?- listing(permutation).
lists:permutation([], [], []).
lists:permutation([C|A], D, [_|B]) :-
permutation(A, E, B),
select(C, D, E).
lists:permutation(A, B) :-
permutation(A, B, B).
true.
hope this helps ..
Hint: This is easy to do if you have written a predicate inselt(X,Y,Z), which holds if any insertion of Y into X gives Z:
inselt([E|X], Y, [E|Z]) :- inselt(X,Y,Z).
inselt(X, Y, [Y|X]).
Then comb/3 can be coded recursively using inselt/3.

Compute a list of distinct odd numbers (if one exists), such that their sum is equal to a given number

:- use_module(library(clpfd)). % load constraint library
% [constraint] Compute a list of distinct odd numbers (if one exists), such that their sum is equal to a given number.
odd(Num) :- Num mod 2 #= 1.
sumOfList([],N,N) :- !.
sumOfList([H|T],Counter,N) :-
NewN #= H + Counter,
sumOfList(T,NewN,N).
buildOddList(N,InputList,L) :-
%return list when sum of list is N
V in 1..N,
odd(V),
append(InputList,[V],TempL),
sumOfList(TempL,0,N)->
L = TempL;
buildOddList(N,TempL,L).
computeOddList(N) :-
buildOddList(N,[],L),
label(L).
This is my code, I can't seem to get the right output, any code critics? :)
Here my take on this question, realized by a predicate nonNegInt_oddPosSummands/2 and an auxiliary predicate list_n_sum/3:
:- use_module(library(clpfd)).
list_n_sum([],_,0).
list_n_sum([Z|Zs],N,Sum) :-
Z #>= 1,
Z #=< N,
Z mod 2 #= 1,
Sum #= Z + Sum0,
Sum0 #>= 0,
list_n_sum(Zs,N,Sum0).
nonNegInt_oddPosSummands(N,List) :-
length(_,N),
list_n_sum(List,N,N),
chain(List,#<),
labeling([],List).
Now on to some queries!
First, "which lists can 19 be decomposed into?":
?- nonNegInt_oddPosSummands(19,Zs).
Zs = [19] ;
Zs = [1, 3, 15] ;
Zs = [1, 5, 13] ;
Zs = [1, 7, 11] ;
Zs = [3, 5, 11] ;
Zs = [3, 7, 9] ;
false.
Next, a more general query that does not terminate as the solution set is infinite. "Which positive integers N can be decomposed into Zs if Zs has a length of 2?"
?- Zs=[_,_], nonNegInt_oddPosSummands(N,Zs).
N = 4, Zs = [1,3] ;
N = 6, Zs = [1,5] ;
N = 8, Zs = [1,7] ;
N = 8, Zs = [3,5] ;
N = 10, Zs = [1,9] ...
Finally, the most general query. Like the one above it does not terminate, as the solution set is infinite. However, it fairly enumerates all decompositions and corresponding positive integers.
?- nonNegInt_oddPosSummands(N,Zs).
N = 0, Zs = [] ;
N = 1, Zs = [1] ;
N = 3, Zs = [3] ;
N = 4, Zs = [1,3] ;
N = 5, Zs = [5] ;
N = 6, Zs = [1,5] ;
N = 7, Zs = [7] ;
N = 8, Zs = [1,7] ;
N = 8, Zs = [3,5] ;
N = 9, Zs = [9] ;
N = 9, Zs = [1,3,5] ;
N = 10, Zs = [1,9] ...
Can suggest you this solution:
:- use_module(library(clpfd)).
all_odd([]) :-!.
all_odd([H | T]) :-
H mod 2 #= 1,
all_odd(T).
solve(N,L) :-
N2 is floor(sqrt(N)),
Len in 1..N2,
label([Len]),
length(L, Len),
L ins 1..N,
all_different(L),
all_odd(L),
sum(L,#=,N),
label(L),
% only show sorted sets
sort(L,L).
Example:
?- solve(17,L).
L = [17] ;
L = [1, 3, 13] ;
L = [1, 5, 11] ;
L = [1, 7, 9] ;
L = [3, 5, 9] ;
false.
I see others have posted complete solutions already. Still, your code can be made to wok with only two slight modifications:
computeOddList only tests whether such a list exists. To know which list matches the constraints, just return it. Thus:
computeOddList(N, L) :-
...
The list TempL may currently contain duplicates. Just place all_different(TempL) after append to fix that.
Now computeOddList will return at least one list of distinct odd numbers if it exists. Still, for e.g. computeOddList(17, L) it will not return all lists. I don't know clpFD myself, so other than suggesting you compare your code to Xonix' code I cannot really help you.
:- use_module(library(clpfd)). % load constraint library
% [constraint] Compute a list of distinct odd numbers (if one exists), such that their sum is equal to a given number.
odd(Num) :- Num mod 2 #= 1.
sumOfList([],N,N) :- !.
sumOfList([H|T],Counter,N) :-
NewN #= H + Counter,
sumOfList(T,NewN,N).
oddList([]) :- !.
oddList([H|T]) :-
odd(H),
oddList(T).
computeOddList(N,L) :-
(L = [];L=[_|_]),
length(L,V),
V in 1..N,
L ins 1..N,
all_different(L),
oddList(L),
sumOfList(L,0,N).
I managed to kinda solved it, however it doesn't end properly after it runs out of cases. Hmm.

Resources