Form a single list from multiple answers in Prolog - prolog

I currently have this piece of code in Prolog
s1(Q,100) :- generate(Q).
generate([X,Y,S,P]) :-
nat(X, 49),
nat(Y, 98),
S is X+Y,
P is X*Y,
S =< 100,
X < Y.
nat(2,_).
nat(X,N) :-
N > 2,
M is N - 1,
nat(Y,M),
X is Y + 1.
It currently generates a list of quadruples, X, Y, S, P such that
1 < X < 49
1 < Y < 98
1 < X < Y
X + Y <= 100
P = X * Y
S = X + Y
This works and creates all possible solutions but with multiple answers (i.e, having to press ; every time to get the next result.)
How can a single list be formed of all these results, for instance,
[[2, 3, 5, 6], [2, 4, 6, 8], ...]
without using any built in predicates such as findall/3?

First, the upper interval bounds you gave for X and Y are both off by one:
1 < X < 49 does not match nat(X,49), 1 < X =< 49 does.
1 < Y < 98 does not match nat(Y,98), 1 < Y =< 98 does.
Let's get it started!
If you want to collect all solutions without using findall/3 (etc), one way is to calculate the Cartesian product (a.k.a. cross-product) of two lists Xs and Ys.
To get Xs and Ys, we can use the builtin predicate numlist/3:
?- numlist(2,49,Xs).
Xs = [2,3,4,/* consecutive integers from 5 to 47 omitted */,48,49].
?- numlist(2,98,Ys).
Ys = [2,3,4,/* consecutive integers from 5 to 96 omitted */,97,98].
To combine every X in Xs with every Y in Ys we use dcg xproduct//3.
For selecting which quadruples to collect, use the grammar rule x_y_maybe_quadruple//2:
x_y_maybe_quadruple(X,Y) -->
( { 1 < X, X < Y, X+Y =< 100 } % if all these conditions are met
-> { P is X * Y },
{ S is X + Y },
[[X,Y,S,P]] % then add single "quadruple"
; [] % else add nothing.
).
Let's put it all together!
?- numlist(2,49,Xs),
numlist(2,98,Ys),
phrase(xproduct(x_y_maybe_quadruple,Xs,Ys),Qss).
Qss = [[2,3,5,6],[2,4,6,8],
/* lots of other quadruples omitted */,
[48,51,99,2448],[48,52,100,2496]].
So... do we actually get all quadruples we would have gotten if we had used findall/3?
?- findall(Qs,generate(Qs),Qss1),
numlist(2,49,Xs),
numlist(2,98,Ys),
phrase(xproduct(x_y_maybe_quadruple,Xs,Ys),Qss2),
Qss1 = Qss2.
Qss1 = Qss2,
Qss2 = [[2, 3, 5, 6], [2, 4, 6, 8], [2|...], [...|...]|...],
Xs = [2, 3, 4, 5, 6, 7, 8, 9, 10|...],
Ys = [2, 3, 4, 5, 6, 7, 8, 9, 10|...].
It works! And not just that: we get exactly the same quadruples in the exact same order!

You need to add a solution to a list if it is not already in the list..if its in the list fail.
so
myfindall(List) :-
my_find(List,[]),
!.
my_find(List,Ac) :-
s1(Q,100),
my_set(Q,Ac,NewAc),
my_find(List,NewAc).
my_find(Ac,Ac).
my_set(X,[],[X]) :-
!.
my_set(H,[H|_],_) :-
!,
fail.
my_set(X,[H|T],L) :-
my_set(X,T,Rtn),
L = [H|Rtn].

Related

Turn List into number, increment the number, and then turn the number into a list

I have my head stuck in this exercise in prolog, I ve been trying to do it on my own but it just won't work. Example: ?-succesor([1,9,9],X) -> X = [2,0,0]. Had tried first to reverse the list and increment it with 1 and then do a if %10 = 0 the next element should be incremented too. Thing is that I m too used with programming syntax and I can't get my head wrapped around this.Any help would be appreciated.
I have done this so far, but the output is false.
%[1,9,9] -> 199 +1 -> 200;
numbers_atoms([],[]).
numbers_atoms([X|Y],[C|K]) :-
atom_number(C, X),
numbers_atoms(Y,K).
%([1,2,3],X)
digits_number(Digits, Number) :-
numbers_atoms(Digits, Atoms),
number_codes(Number, Atoms).
number_tolist( 0, [] ).
number_tolist(N,[A|As]) :-
N1 is floor(N/10),
A is N mod 10,
number_tolist(N1, As).
addOne([X],[Y]):-
digits_number(X,Y1), %[1,9,9] -> 199
Y1 is Y1+1, % 199 -> 200
number_tolist(Y1,[Y]), % 200 -> [2,0,0]
!.
You can solve this problem similarly to how you would solve it manually: traverse the list of digits until you reach the rightmost digit; increment that digit and compute the carry-on digit, which must be recursively propagated to the left. At the end, prepend the carry-on digit if it is equal to 1 (otherwise, ignore it).
% successor(+Input, -Output)
successor([X0|Xs], L) :-
successor(Xs, X0, C, Ys),
( C = 1 % carry-on
-> L = [C|Ys]
; L = Ys ).
% helper predicate
successor([], X, C, [Y]) :-
Z is X + 1,
Y is Z mod 10,
C is Z div 10. % carry-on
successor([X1|Xs], X0, C, [Y|Ys]) :-
successor(Xs, X1, C0, Ys),
Z is X0 + C0,
Y is Z mod 10,
C is Z div 10. % carry-on
Examples:
?- successor([1,9,9], A).
A = [2, 0, 0].
?- successor([2,7],A), successor(A,B), successor(B,C), successor(C,D).
A = [2, 8],
B = [2, 9],
C = [3, 0],
D = [3, 1].
?- successor([7,9,9,8], A), successor(A, B).
A = [7, 9, 9, 9],
B = [8, 0, 0, 0].
?- successor([9,9,9,9], A), successor(A, B).
A = [1, 0, 0, 0, 0],
B = [1, 0, 0, 0, 1].
Here's a version which doesn't use is and can work both ways:
successor(ListIn, ListOut) :-
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
ripple_inc([], [1]).
ripple_inc([0|T], [1|T]).
ripple_inc([1|T], [2|T]).
ripple_inc([2|T], [3|T]).
ripple_inc([3|T], [4|T]).
ripple_inc([4|T], [5|T]).
ripple_inc([5|T], [6|T]).
ripple_inc([6|T], [7|T]).
ripple_inc([7|T], [8|T]).
ripple_inc([8|T], [9|T]).
ripple_inc([9|T], [0|Tnext]) :-
ripple_inc(T, Tnext).
e.g.
?- successor([1,9,9], X).
X = [2, 0, 0]
?- successor([1,9,9], [2,0,0]).
true
?- successor(X, [2,0,0]).
X = [1, 9, 9]
although it's nicely deterministic when run 'forwards', it's annoying that if run 'backwards' it finds an answer, then leaves a choicepoint and then infinite loops if that choicepoint is retried. I think what causes that is starting from the higher number then reverse(ListIn, ListInRev) has nothing to work on and starts generating longer and longer lists both filled with empty variables and never ends.
I can constrain the input and output to be same_length/2 but I can't think of a way to constrain them to be the same length or ListOut is one item longer ([9,9,9] -> [1,0,0,0]).
This answer tries to improve the previous answer by #TessellatingHacker, like so:
successor(ListIn, ListOut) :-
no_longer_than(ListIn, ListOut), % weaker than same_length/2
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
The definition of no_longer_than/2 follows. Note the similarity to same_length/2:
no_longer_than([],_). % same_length([],[]).
no_longer_than([_|Xs],[_|Ys]) :- % same_length([_|Xs],[_|Ys]) :-
no_longer_than(Xs,Ys). % same_length(Xs,Ys).
The following sample queries still succeed deterministically, as they did before:
?- successor([1,9,9], X).
X = [2,0,0].
?- successor([1,9,9], [2,0,0]).
true.
The "run backwards" use of successor/2 now also terminates universally:
?- successor(X, [2,0,0]).
X = [1,9,9]
; false.

Comparing a list of integers with a number prolog

I have to define a predicate which takes as input a list of integers, and instantiates X with the elements of L smaller than 10, and Y with the elements of the list greater than or equal to 10.
This is the predicate: separate(L, X, Y)
Here are some examples of the output I'm looking for:
?− separate([2, 13, 4, 0, 55], X, Y).
X = [2, 4, 0]
Y = [13, 55]
?− separate([2, 3], X, Y).
X = [2, 3]
Y = [ ]
Quite simple. Here a solution without built-in predicates:
separate([],[],[]).
separate([H|T],LG,LL):-
( H > 10 ->
LG = [H|TG],
separate(T,TG,LL) ;
LL = [H|TL],
separate(T,LG,TL)
).
?- separate([2, 13, 4, 0, 55], X, Y).
X = [13, 55],
Y = [2, 4, 0]
?- separate([2, 3], X, Y).
X = [],
Y = [2, 3]
I would break it up into multiple clauses:
separate( [] , [] , [] ) .
separate( [X|Xs] , [X|Ys] , Zs ) :- X < 10, separate(Xs,Ys,Zs).
separate( [X|Xs] , Ys , [X|Zs] ) :- X >= 10, separate(Xs,Ys,Zs).
Easier to read. Better expresses intent, too, as well as not making assumptions about the content of the list — e.g., what happens with [1,12,3,x,9,28]?

Prolog write n as sum of consecutive numbers

I'm studying prolog and I want to determine all decomposition of n (n given, positive), as sum of consecutive natural numbers but I don't know how to approach this.
Any ideas ?
The key here is between/3, which relates numbers and ranges. Prolog is not going to conjure up numbers from thin air, you have to give it some clues. In this case, you can assume a range of numbers between 1 and the n which you are given:
decomp2(N, X, Y) :-
between(1, N, X),
between(1, N, Y),
N =:= X + Y.
This will give you the sum of two numbers that yields N:
?- decomp2(5, X, Y).
X = 1,
Y = 4 ;
X = 2,
Y = 3 ;
X = 3,
Y = 2 ;
X = 4,
Y = 1 ;
Once you can get two, you can get a longer list by tearing one value off with decomp2/2 and getting the rest through induction. You just need to come up with a base case, such as, the singleton list of N:
decomp(N, [N]).
decomp(N, [X|L]) :- decomp2(N, X, Y), decomp(Y, L).
Be warned that this is going to produce a lot of repetition!
?- decomp(5, L).
L = [5] ;
L = [1, 4] ;
L = [1, 1, 3] ;
L = [1, 1, 1, 2] ;
L = [1, 1, 1, 1, 1] ;
L = [1, 1, 2, 1] ;
L = [1, 2, 2] ;
L = [1, 2, 1, 1] ;
L = [1, 3, 1] ;
L = [2, 3] ;
L = [2, 1, 2] ;
L = [2, 1, 1, 1] ;
L = [2, 2, 1] ;
L = [3, 2] ;
L = [3, 1, 1] ;
L = [4, 1] ;
You could probably clamp down on the repetition by introducing an ordering requirement, such as that X be greater than Y.
I have reached the solution and it looks something like this:
Remark: in isConsecutive i get rid of the "solution" when the list is the number itself
% equal with the given parameter N.
% generatePair(N - integer, X - integer, Y - integer)
% generatePair(i,o,o)
% generatePair(N) = { (X,Y), X<Y && X+Y=N
generatePair(N, X, Y) :-
my_between(1, N, Y),
my_between(1, N, X),
X < Y,
N =:= X + Y.
% This predicate decomposes the given number N into a list of integers
% such that their sum is equal to N.
% decomposeNumber(N - integer, L - list)
% decomposeNumber(i,o)
% decomposeNumber(N) = { [X|L]
decomposeNumber(N, [N]).
decomposeNumber(N, [X|L]) :- generatePair(N, X, Y), decomposeNumber(Y, L).
% This predicate checks it the that elements in the given list have
% consecutive value.
% isConsecutive(L - list)
% isConsecutive(i)
% isConsecutive([l1,l2,..,ln]) = { true, L=[l1,l2] && l1+1=l2
% { isConsecutive(l2..ln), l1+1=l2 && n>2
% { false, otherwise
isConsecutive([X,Y]):-X+1=:=Y.
isConsecutive([H1,H2|T]):-H2=:=H1+1, isConsecutive([H2|T]).
nAsSumOfConsecutives(N,L):-decomposeNumber(N,X), isConsecutive(X), L=X.
main(N,L):-findall(R,nAsSumOfConsecutives(N,R),L).

Find all natural divisors of a number (with Prolog)

I want to create a predicate divisors(X,[Y]) which is true if
X>1 and Y is the list of all divisors of X starting with X and going down to 1.
What my code right now looks like:
divisors(1,[1]).
divisors(X,[Y,Z|Ys]) :-
X>0,
Y is X,
Y>Z,
divides(X,[Z|Ys]).
divides(X,[Y,Z|Ys]) :-
Y>Z,
0 is X mod Y,
divides(X,[Z|Ys]).
divides(X,[1]).
But there are several problems with it:
prolog returns an error if asked for the list (e.g. ?-divisors(10,X).)
?- divisors(X,[Y]). Where [Y] is an incomplete list of divisors is true...
Edit by Guy Coder
This answer is by the OP and was posted in a comment below.
Moving here so others can see it.
divisors(X,R) :-
X > 1,
divisors(X,1,[],R).
divisors(X,D,R,R):-
D>X.
divisors(N,D0,R0,R) :-
divisors_0(N,D0,R0,R1),
D is D0 + 1,
divisors(N,D,R1,R).
divisors_0(N,D,R0,[D|R0]) :-
divides(N,D).
divisors_0(N,D,R0,R0).
divides(N,D) :-
0 is N mod D.
Op also noted some errors in this version:
It doesn't terminate if I ask a wrong statement like (10,[1,2,3]).
It throws an error if I ask a statement like (X, [10,5,2,1]). (-> Arguments are not sufficiently initialized.)
While the answer by William is nice and probably faster here is answer closer to what you were writing.
divides(N,D) :-
0 is N mod D.
divisors_0(N,D,R0,[D|R0]) :-
divides(N,D).
divisors_0(N,D,R0,R0) :-
\+ divides(N,D).
divisors(_,0,R,R).
divisors(N,D0,R0,R) :-
divisors_0(N,D0,R0,R1),
D is D0 - 1,
divisors(N,D,R1,R).
divisors(X,R) :-
X > 1,
divisors(X,X,[],R), !.
Example:
?- between(1,15,N), divisors(N,Rs).
N = 2,
Rs = [1, 2] ;
N = 3,
Rs = [1, 3] ;
N = 4,
Rs = [1, 2, 4] ;
N = 5,
Rs = [1, 5] ;
N = 6,
Rs = [1, 2, 3, 6] ;
N = 7,
Rs = [1, 7] ;
N = 8,
Rs = [1, 2, 4, 8] ;
N = 9,
Rs = [1, 3, 9] ;
N = 10,
Rs = [1, 2, 5, 10] ;
N = 11,
Rs = [1, 11] ;
N = 12,
Rs = [1, 2, 3, 4, 6, 12] ;
N = 13,
Rs = [1, 13] ;
N = 14,
Rs = [1, 2, 7, 14] ;
N = 15,
Rs = [1, 3, 5, 15].
Edit
OP modified their code, see update in question and had some errors.
This version resolves those errors.
divisors(X,R) :-
(
var(X)
->
false
;
(
var(R)
->
X > 1,
divisors(X,1,[],R)
;
divisors_2(X,R), !
)
).
divisors_2(_,[]).
divisors_2(X,[H|T]) :-
divides(X,H),
divisors_2(X,T).
divisors(X,D,R,R):-
D>X.
divisors(N,D0,R0,R) :-
divisors_0(N,D0,R0,R1),
D is D0 + 1,
divisors(N,D,R1,R).
divisors_0(N,D,R0,[D|R0]) :-
divides(N,D).
divisors_0(_,_,R0,R0).
divides(N,D) :-
0 is N mod D.
The first error: It doesn't terminate if I ask a wrong statement like divisors(10,[1,2,3]).
is fixed by adding to divisors/2
(
var(R)
->
X > 1,
divisors(X,1,[],R)
;
divisors_2(X,R), !
)
and
divisors_2(_,[]).
divisors_2(X,[H|T]) :-
divides(X,H),
divisors_2(X,T).
which just processes the list of denominators instead of generating a list.
The second error: It throws an error if I ask a statement like divisors(X, [10,5,2,1]). (-> Arguments are not sufficiently initialized.)
is resolved by further adding to divisor/2
divisors(X,R) :-
(
var(X)
->
false
;
(
var(R)
->
X > 1,
divisors(X,1,[],R)
;
divisors_2(X,R), !
)
).
which checks if the first parameter X is a variable and if so just returns false. The other option would be to generate an infinite list of answers. While possible it wasn't requested.
In Prolog, it is quite common to use backtracking and propose multiple solutions to the same query. Instead of constructing a list of dividers, we thus can construct a predicate that unifies the second parameter with all divisors. For example:
divisor(N, D) :-
between(1, N, D),
0 is N mod D.
This then yields:
?- divisor(12, N).
N = 1 ;
N = 2 ;
N = 3 ;
N = 4 ;
N = 6 ;
N = 12.
The above algorithm is an O(n) algorithm: we scan for divisors linear with the value of the item for which we want to obtain the divisors. We can easily improve this to O(√n) by scanning up to √n, and each time yield both the divisor (of course in case it is a divisor), and the co-divisor, like:
emitco(D, _, D).
emitco(D, C, C) :-
dif(D, C).
divisor(N, R) :-
UB is floor(sqrt(N)),
between(1, UB, D),
0 is N mod D,
C is N / D,
emitco(D, C, R).
This still yield the correct answers, but the order is like a convergent alternating sequence:
?- divisor(12, N).
N = 1 ;
N = 12 ;
N = 2 ;
N = 6 ;
N = 3 ;
N = 4.
?- divisor(16, N).
N = 1 ;
N = 16 ;
N = 2 ;
N = 8 ;
N = 4 ;
false.
We can obtain a list of the divisors by using a findall/3 [swi-doc] or setof/3 [swi-doc]. The setof/3 will even sort the divisors, so we can implement divisors/2 in terms of divisor/2:
divisors(N, Ds) :-
setof(D, divisor(N, D), Ds).
For example:
?- divisors(2, N).
N = [1, 2].
?- divisors(3, N).
N = [1, 3].
?- divisors(5, N).
N = [1, 5].
?- divisors(12, N).
N = [1, 2, 3, 4, 6, 12].
?- divisors(15, N).
N = [1, 3, 5, 15].
We can use reverse/2 to reverse that result.

Prolog - merge digits to number

I want to merge list of digits to number.
[1,2,3] -> 123
My predicate:
merge([X], X).
merge([H|T], X) :-
merge(T, X1),
X is X1 + H * 10.
But now I get:
[1,2,3] -> 33
Another way to do it would be to multiply what you've handled so far by ten, but you need an accumulator value.
merge(Digits, Result) :- merge(Digits, 0, Result).
merge([X|Xs], Prefix, Result) :-
Prefix1 is Prefix * 10 + X,
merge(Xs, Prefix1, Result).
merge([], Result, Result).
The math is off. You're rule says you have to multiply H by 10. But really H needs to be multiplied by a power of 10 equivalent to its position in the list. That would be * 100 for the 1, and * 10 for the 2. What you get now is: 10*1 + 10*2 + 3 which is 33. The problem is that your recursive clause doesn't know what numeric "place" the digit is in.
If you structure the code differently, and use an accumulator, you can simplify the problem. Also, by using CLP(FD) and applying some constraints on the digits, you can have a more general solution.
:- use_module(library(clpfd)).
digits_number(Digits, X) :-
digits_number(Digits, 0, X).
digits_number([], S, S).
digits_number([D|Ds], S, X) :-
D in 0..9,
S1 #= S*10 + D,
digits_number(Ds, S1, X).
?- digits_number([1,2,3], X).
X = 123
?- digits_number(L, 123).
L = [1, 2, 3] ;
L = [0, 1, 2, 3] ;
L = [0, 0, 1, 2, 3] ;
L = [0, 0, 0, 1, 2, 3] ;
L = [0, 0, 0, 0, 1, 2, 3]
...
?-

Resources