Prolog simple generator - prolog

I'm trying to learn myself Prolog and need a little help.
Could someone solve and explain this problem:
Define a p(A, M/N, K/L), which generates all possible rational fractions M/N and K/L, where:
N>M>0, K>L>0, (M/N)*(K/L) = 2 and (M+K)<A

Your description is not that clear to me, I am rather guessing which values should be known and which are asked. So I will rather use library(clpfd) where I do not have to make such considerations myself.
N>M>0, K>L>0, (M/N)*(K/L) = 2 and (M+K)<A
p(A, M/N, K/L) :-
N #> M, M #> 0,
K #> L, L #> 0,
M+K #< A,
(M/N) * (K/L) #= 2.
?- 3/2 #= F.
F = 1.
?- (3/2)*2 #= F.
F = 2.
Oh, clpfd is on the integers so fractions are truncated. I need some algebra first, multiplying both sides with (N*L) (they are both not 0...):
p(A, M/N, K/L) :-
N #> M, M #> 0,
K #> L, L #> 0,
M+K #< A,
M*K #= 2*N*L.
?- p(A, M/N, K/L).
A in 4..sup, M+K+ -1*A#=< -1, M in 1..sup,
M#=<N+ -1, M*K#=_A, N in 2..sup, 2*N#=_B,
_B in 4..sup, _B*L#=_A, L in 1..sup, L#=<K+ -1,
K in 2..sup, _A in 4..sup.
So Prolog says: Yes! That is true provided all this very fine print is true. The first line is the most interesting A in 4..sup which means that there is no upper bound for A. To get concrete solutions, A must be known:
?- A #= 10, p(A, M/N, K/L).
A = 10, M in 1..7, M+K#=_A, M#=<N+ -1,
M*K#=_B, K in 2..8, L#=<K+ -1, L in 1..7,
_C*L#=_B, _C in 4..56, 2*N#=_C, N in 2..28,
_B in 4..56, _A in 3..9.
Not enough! But now K, L, M, N have all finite domains, so we can enumerate them using labeling([], [K,L,M,N]).
?- A = 10, p(A,M/N,K/L),labeling([],[M,N,K,L]).
A = 10, M = L, L = 1, N = 2, K = 4
; A = 10, M = 1, N = L, L = 2, K = 8
; A = 10, M = L, L = 1, N = 3, K = 6
; ... .

Related

PROLOG : Given a number X, find all multiples of 4 less or equal than X

I have the following program:
list4(N, L) :-
list4(0, N, L).
list4(N, N, [N]).
list4(N0, N, [N0| List]) :-
N0 < N,
N1 is N0+1,
list4(N1, N, List).
When i change the line N1 is N0+1 to N1 is 4*N0 i get stack limit exceeded error.
My expected result is
list4(10,L).
L = [4,8]
Two problems with the 4*N0 version:
In list4/2 you initialize list4/3 with N0=0, which, multiplied with anything, always stays 0. That causes the infinite recursion. As you want multiples of four, you can just keep increasing N0 by one in each step and multiply it by 4 before putting it into the list.
The anchor relies on your count variable arriving at N exactly, but N0 * 4 overshoots. The first rule of list4/3 has to cover the rest of the cases with N0*4 > N as well. To also include the upper limit in the result, we can make the anchor stop at values larger than the limit and handle the upper bound itself in the second rule.
Expressed in code:
list4(N, L) :-
list4(1, N, L).
list4(N0, N, []) :- N4Times is N0*4,N4Times > N.
list4(N0, N, [N4Times| List]) :-
N4Times is N0*4,
N4Times =< N,
N1 is N0 + 1,
list4(N1, N, List).
Results in:
?- list4(10,L).
L = [4, 8] ;
false.
?- list4(8,L).
L = [4, 8] ;
false.
You can initialize the accumulator with 0 and increment it by 4 at each step.
% list4(+Upperbound, -MultiplesOfFour)
list4(U, M) :-
list4(0, U, M).
list4(A, U, L) :-
M is A+4,
( M =< U
-> L = [M|Ms],
list4(M, U, Ms)
; L = [] ).
Examples:
?- list4(10, L).
L = [4, 8].
?- list4(8, L).
L = [4, 8].
?- list4(20, L).
L = [4, 8, 12, 16, 20].
?- list4(30, L).
L = [4, 8, 12, 16, 20, 24, 28].
?- list4(3, L).
L = [].

Goldbach’s Conjecture in prolog

Goldbach’s Conjecture : Every positive even number greater than 2 is the sum of two prime numbers. Eg 28 (5,23 and 11,17)
I want Prolog code to print below (all combinations) :
?- goldbach(28, L).
Output :
L = [5,23];
L = [11, 17];
I have a code which prints single combination[5,23], but not the next [11,17].
is_prime(2).
is_prime(3).
is_prime(P) :- integer(P), P > 3, P mod 2 =\= 0, \+ has_factor(P,3).
has_factor(N,L) :- N mod L =:= 0.
has_factor(N,L) :- L * L < N, L2 is L + 2, has_factor(N,L2).
goldbach(4,[2,2]) :- !.
goldbach(N,L) :- N mod 2 =:= 0, N > 4, goldbach(N,L,3).
goldbach(N,[P,Q],P) :- Q is N - P, is_prime(Q), !.
goldbach(N,L,P) :- P < N, next_prime(P,P1), goldbach(N,L,P1).
next_prime(P,P1) :- P1 is P + 2, is_prime(P1), !.
next_prime(P,P1) :- P2 is P + 2, next_prime(P2,P1).
Drop the cuts (and add a condition to avoid duplicate answers).
goldbach(4,[2,2]).
goldbach(N,L) :-
N mod 2 =:= 0,
N > 4,
goldbach(N,L,3).
goldbach(N,[P,Q],P) :-
Q is N - P,
is_prime(Q), P < Q.
goldbach(N,L,P) :-
P < N,
next_prime(P,P1),
goldbach(N,L,P1).

Prolog - Multiples of a Number Below an Upper Limit

I am currently making a program in Prolog that will calculate all of the multiples (including itself) of a number, that do not exceed the value of another number. I was testing with the query below:
?- multiples(4,12,R,0)
This query would list all multiples of 4 that are less than or equal to 12 eg. 4, 8, 12. The R would return the result and 0 is where I was intending to implement a counter that would count up for each multiplication eg. 4*1,4*2,4*3. I am stuck and I am not sure if it would be a better design to simply add the multiples and check if it is below the upper bound or if it can be done with a counter or accumulator.
multiples(N,U,R,Ctr) :-
N =< U,
R is Ctr * N,
R =< U,
increment(Ctr,Ctr2),
multiples(N,U,R,Ctr2).
increment(Num, Num1) :-
Num1 is Num+1.
I believe my program is failing at the recursive step of calling multiples from within itself. I know that recursion needs a base case to allow it to exit, but I am completely stuck here and would appreciate some direction.
The problem with you approach is that there is no basecase: indeed your algorithm will always produce false. It will unify R with N, then do the recursion and that recursion will try to unify R with 2*N which will fail.
Well an idea could be to use an accumulator to which you add the delta each time. Something like:
multiples(N,U,R) :-
multiples(N,N,U,R).
multiples(_,C,U,C) :-
C =< U.
multiples(N,C,U,R) :-
C =< U,
C1 is C+N,
multiples(N,C1,U,R).
So here we call multiples(3,12,R). and it will result in:
?- multiples(4,12,R).
R = 4 ;
R = 8 ;
R = 12 ;
false.
CLP(FD) is very helpful here:
:- use_module(library(clpfd)).
multiple(Multiplicand, Max, Multiple) :-
MaxMultiplier #= Max // Multiplicand,
label([MaxMultiplier]),
Multiplier in 1 .. MaxMultiplier,
Multiple #= Multiplier * Multiplicand,
label([Multiple]).
?- multiple(4, 12, M).
M = 4 ;
M = 8 ;
M = 12.
?-
With CLP(FD) in this case, you can also query with the first argument as a variable:
|?- multiple(N, 12, 8).
N = 8 ;
N = 4 ;
N = 2 ;
N = 1.
Or both the multiplier and result:
?- multiple(N, 4, M).
N = M, M = 3 ;
N = M, M = 4 ;
N = M, M = 2 ;
N = 2,
M = 4 ;
N = M, M = 1 ;
N = 1,
M = 2 ;
N = 1,
M = 3 ;
N = 1,
M = 4.
?-
If you want to collect them in a list, you can use findall/3:
?- findall(Multiple, multiple(4, 12, Multiple), Multiples).
Multiples = [4, 8, 12].
?-

Prolog Break Money into Smaller Amounts

I have this predicate which returns true if S is equal to some equation say K + 2N + 3L = S. The money we have are 1, 5, and 10 respectively for K, N, L.
I don't want to use :- use_module(library(clpfd)), I want to solve this without it.
My intuition was to break this into subproblems like write a function breakMoney1(S,K) :- K is S. and create more helpers with one more parameter added however I am struggling with the problem of getting uninstantiated variables, when I compare.
breakMoney(S,K,N,L) :-
This is easier than you think, probably. A very naive solution following #Will Ness' suggestion would be:
break(Sum, K, N, L) :- integer(Sum), Sum >= 0,
% upper bounds for K, N, and L
K_Max is Sum div 1,
N_Max is Sum div 5,
L_Max is Sum div 10,
% enumerate possible values for K, N, and L
between(0, L_Max, L),
between(0, N_Max, N),
between(0, K_Max, K),
Sum =:= K + 5*N + 10*L.
This will "magically" turn into a clp(fd) solution with very little effort: for example, replace between with X in 0..Max, and the =:= with #=. Although, it should be enough to simply say that X #>= 0 for each of the denominations. It is a good exercise to see how much of the constraints you can remove and still get an answer:
break(Sum, K, N, L) :-
K #>= 0, N #>= 0, L #>= 0,
Sum #= K + 5*N + 10*L.
Depending on how you instantiate the arguments, you might immediately get a unique answer, or you might need to use label/1:
?- break(100, P, 8, 5).
P = 10.
?- break(10, K, N, L).
K in 0..10,
-1*K+ -5*N+ -10*L#= -10,
N in 0..2,
L in 0..1.
?- break(10, K, N, L), label([K, N, L]).
K = N, N = 0,
L = 1 ;
K = L, L = 0,
N = 2 ;
K = 5,
N = 1,
L = 0 ;
K = 10,
N = L, L = 0.
But as #lurker has pointed out, there is very little reason not to use constraint programming for this problem. Unless, of course, you have a very clever algorithm for solving this particular problem and you know for a fact that it will outsmart the generic clp(fd) solution. Even then, it might be possible to achieve the same effect by using the options to labelling/2.

reversible "binary to number" predicate

What is the best way to convert binary bits (it might be a list of 0/1, for example) into numbers in a reversible way. I've written a native predicate in swi, but is there better solution ?
Best regards
Use CLP(FD) constraints, for example:
:- use_module(library(clpfd)).
binary_number(Bs0, N) :-
reverse(Bs0, Bs),
foldl(binary_number_, Bs, 0-0, _-N).
binary_number_(B, I0-N0, I-N) :-
B in 0..1,
N #= N0 + B*2^I0,
I #= I0 + 1.
Example queries:
?- binary_number([1,0,1], N).
N = 5.
?- binary_number(Bs, 5).
Bs = [1, 0, 1] .
?- binary_number(Bs, N).
Bs = [],
N = 0 ;
Bs = [N],
N in 0..1 ;
etc.
Here is the solution I was thinking of, or rather what I hoped exists.
:- use_module(library(clpfd)).
binary_number(Bs, N) :-
binary_number_min(Bs, 0,N, N).
binary_number_min([], N,N, _M).
binary_number_min([B|Bs], N0,N, M) :-
B in 0..1,
N1 #= B+2*N0,
M #>= N1,
binary_number_min(Bs, N1,N, M).
This solution also terminates for queries like:
?- Bs = [1|_], N #=< 5, binary_number(Bs, N).
The solution
This answer seeks to provide a predicate binary_number/2 that presents both logical-purity and the best termination properties. I've used when/2 in order to stop queries like canonical_binary_number(B, 10) from going into infinite looping after finding the first (unique) solution. There is a trade-off, of course, the program has redundant goals now.
canonical_binary_number([0], 0).
canonical_binary_number([1], 1).
canonical_binary_number([1|Bits], Number):-
when(ground(Number),
(Number > 1,
Pow is floor(log(Number) / log(2)),
Number1 is Number - 2 ^ Pow,
( Number1 > 1
-> Pow1 is floor(log(Number1) / log(2)) + 1
; Pow1 = 1
))),
length(Bits, Pow),
between(1, Pow, Pow1),
length(Bits1, Pow1),
append(Zeros, Bits1, Bits),
maplist(=(0), Zeros),
canonical_binary_number(Bits1, Number1),
Number is Number1 + 2 ^ Pow.
binary_number(Bits, Number):-
canonical_binary_number(Bits, Number).
binary_number([0|Bits], Number):-
binary_number(Bits, Number).
Purity and termination
I claim that this predicate presents logical-purity from construction. I hope I got it right from these answers: one, two and three.
Any goal with proper arguments terminates. If arguments need to be checked, the simplest way to achieve this is using the built-in length/2:
binary_number(Bits, Number):-
length(_, Number),
canonical_binary_number(Bits, Number).
?- binary_number(Bits, 2+3).
ERROR: length/2: Type error: `integer' expected, found `2+3'
Exception: (6) binary_number(_G1642009, 2+3) ? abort
% Execution Aborted
?- binary_number(Bits, -1).
ERROR: length/2: Domain error: `not_less_than_zero' expected, found `-1'
Exception: (6) binary_number(_G1642996, -1) ? creep
Example queries
?- binary_number([1,0,1|Tail], N).
Tail = [],
N = 5 ;
Tail = [0],
N = 10 ;
Tail = [1],
N = 11 ;
Tail = [0, 0],
N = 20 .
?- binary_number(Bits, 20).
Bits = [1, 0, 1, 0, 0] ;
Bits = [0, 1, 0, 1, 0, 0] ;
Bits = [0, 0, 1, 0, 1, 0, 0] ;
Bits = [0, 0, 0, 1, 0, 1, 0, 0] ;
Bits = [0, 0, 0, 0, 1, 0, 1, 0, 0] .
?- binary_number(Bits, N).
Bits = [0],
N = 0 ;
Bits = [1],
N = 1 ;
Bits = [1, 0],
N = 2 ;
Bits = [1, 1],
N = 3 ;
Bits = [1, 0, 0],
N = 4 ;
Bits = [1, 0, 1],
N = 5 .
playing with bits...
binary_number(Bs, N) :-
var(N) -> foldl(shift, Bs, 0, N) ; bitgen(N, Rs), reverse(Rs, Bs).
shift(B, C, R) :-
R is (C << 1) + B.
bitgen(N, [B|Bs]) :-
B is N /\ 1 , ( N > 1 -> M is N >> 1, bitgen(M, Bs) ; Bs = [] ).

Resources