Prolog Average Rules - prolog

The following set of Prolog rules work on an input such as average([3,4,5],A). Whereby A = 4.0.
However, if I try something like average([3,4,X],4). The following error is returned:
average([X|Xs],A) :- sum([X|Xs],S), length([X|Xs],L), {S/L=A}.
ERROR: is/2: Arguments are not sufficiently instantiated
How could I modify my code to allow average([3,4,X],4) to return the correct value for X?

The trivial solution with library(clpqr):
add(A, B, +(A,B)).
list_average([X|Xs], A) :-
length([X|Xs], Len),
foldl(add, Xs, X, Sum),
{Sum =:= A*Len}.
If for some reason you don't want to use the library, you can try the following code.
This will probably solve your problem, but I am not happy with this code. Certainly someone else knows better:
list_average(L, A) :-
( is_list(L)
-> length(L, Len),
term_variables(L-A, Vars),
solve(Vars, L, A, Len)
; instantiation_error(L)
).
solve([], L, A, Len) :-
sum_list(L, Sum),
A =:= Sum / Len. % Validate provided average
solve([X|Xs], L, A, Len) :-
partition(number, L, Nums, Vars),
length(Vars, T),
sum_list(Nums, Sum),
( var(A)
-> maplist(=(A), Vars), % all variables are as the average
A is Sum / (Len - T)
; maplist(=(X), Xs), % all free variables in list are same
X is (Len*A - Sum) / T
).
With this queries like this are possible:
?- list_average([2,3,4,5], A).
A = 3.5.
?- list_average([2,3,4,5], 3).
false.
?- list_average([2,X,4,5], 3).
X = 1.
?- list_average([2,X,4,Y], 3).
X = Y, Y = 3.
?- list_average([2,X,4,Y], A).
X = Y, Y = A, A = 3.
?- list_average([2,X,4,Y], 6).
X = Y, Y = 9.
It will automatically try to bind all free variables to a single free variable before solving numerically.

It's quite the same as Boris solution, but I use library lambda :
:- use_module(library(clpr)).
:- use_module(library(lambda)).
average(L, A) :-
length(L, Len),
foldl(\X^Y^Z^{Z = X+Y}, L, 0, TT),
{A * Len = TT}.
EDIT correction after false's remark.

Related

How to use an fd solver to determine which elements of a list can sum to a given number?

Given a list of possible summands I want to determine which, if any, can form a given sum. For example, with [1,2,3,4,5] I can make the sum of 9 with [4,5], [5,3,1], and [4,3,2].
I am using GNU Prolog and have something like the following which does not work
numbers([1,2,3,4,5]).
all_unique(_, []).
all_unique(L, [V|T]) :-
fd_exactly(1, L, V),
all_unique(L, T).
fd_sum([], Sum).
fd_sum([H|T], Sum):-
S = Sum + H,
fd_sum(T, S).
sum_clp(N, Summands):-
numbers(Numbers),
length(Numbers, F),
between(1, F, X),
length(S, X),
fd_domain(S, Numbers),
fd_domain(Y, [N]),
all_unique(S, Numbers),
fd_sum(S, Sum),
Sum #= Y,
fd_labeling(S).
I think the main problem is that I am not representing the constraint on the sum properly? Or maybe it is something else?
Just in case you're really interested in CLP(FD), here is your corrected program.
numbers([1,2,3,4,5]).
% note: use builtins where available, both for efficiency and correctness
%all_unique(_, []).
%all_unique(L, [V|T]) :-
% fd_exactly(1, L, V),
% all_unique(L, T).
fd_sum([], 0). % sum_fd_SO.pl:8: warning: singleton variables [Sum] for fd_sum/2
fd_sum([H|T], Sum):-
% note: use CLP(FD) operators and the correct operands
Sum #= S + H,
fd_sum(T, S).
sum_clp(N, S):- % sum_fd_SO.pl:13-23: warning: singleton variables [Summands] for sum_clp/2
numbers(Numbers),
length(Numbers, F),
between(1, F, X),
length(S, X),
fd_domain(S, Numbers),
%fd_domain(Y, [N]),
%all_unique(S, Numbers),
fd_all_different(S),
fd_sum(S, N),
%Sum #= Y,
fd_labeling(S).
test
?- sum_clp(3,L).
L = [3] ? ;
L = [1,2] ? ;
L = [2,1] ? ;
no
I think mixing the code for sublist into clp code is causing some confusion. GNU-Prolog has a sublist/2 predicate, you can use that.
You seem to be building the arithmetic expression with fd_sum but it is incorrectly implemented.
sum_exp([], 0).
sum_exp([X|Xs], X+Xse) :-
sum_exp(Xs, Xse).
sum_c(X, N, Xsub) :-
sublist(Xsub, X),
sum_exp(Xsub, Xe),
N #= Xe.
| ?- sum_exp([A, B, C, D], X).
X = A+(B+(C+(D+0)))
yes
| ?- sum_c([1, 2, 3, 4, 5], 9, X).
X = [4,5] ? ;
X = [2,3,4] ? ;
X = [1,3,5] ? ;
(1 ms) no
| ?- length(X, 4), sum_c(X, 4, [A, B]), member(A, [1, 2, 3]).
A = 1
B = 3
X = [_,_,1,3] ? ;
A = 2
B = 2
X = [_,_,2,2] ? ;
A = 3
B = 1
X = [_,_,3,1] ?
yes

Finding the max in a list - Prolog

I was just introduced to Prolog and am trying to write a predicate that finds the Max value of a list of integers. I need to write one that compares from the beginning and the other that compares from the end. So far, I have:
max2([],R).
max2([X|Xs], R):- X > R, max2(Xs, X).
max2([X|Xs], R):- X <= R, max2(Xs, R).
I realize that R hasn't been initiated yet, so it's unable to make the comparison. Do i need 3 arguments in order to complete this?
my_max([], R, R). %end
my_max([X|Xs], WK, R):- X > WK, my_max(Xs, X, R). %WK is Carry about
my_max([X|Xs], WK, R):- X =< WK, my_max(Xs, WK, R).
my_max([X|Xs], R):- my_max(Xs, X, R). %start
other way
%max of list
max_l([X],X) :- !, true.
%max_l([X],X). %unuse cut
%max_l([X],X):- false.
max_l([X|Xs], M):- max_l(Xs, M), M >= X.
max_l([X|Xs], X):- max_l(Xs, M), X > M.
Ignoring the homework constraints about starting from the beginning or the end, the proper way to implement a predicate that gets the numeric maximum is as follows:
list_max([P|T], O) :- list_max(T, P, O).
list_max([], P, P).
list_max([H|T], P, O) :-
( H > P
-> list_max(T, H, O)
; list_max(T, P, O)).
A very simple approach (which starts from the beginning) is the following:
maxlist([],0).
maxlist([Head|Tail],Max) :-
maxlist(Tail,TailMax),
Head > TailMax,
Max is Head.
maxlist([Head|Tail],Max) :-
maxlist(Tail,TailMax),
Head =< TailMax,
Max is TailMax.
As you said, you must have the variables instantiated if you want to evaluate an arithmetic expression. To solve this, first you have to make the recursive call, and then you compare.
Hope it helps!
As an alternative to BLUEPIXY' answer, SWI-Prolog has a builtin predicate, max_list/2, that does the search for you. You could also consider a slower method, IMO useful to gain familiarity with more builtins and nondeterminism (and then backtracking):
slow_max(L, Max) :-
select(Max, L, Rest), \+ (member(E, Rest), E > Max).
yields
2 ?- slow_max([1,2,3,4,5,6,10,7,8],X).
X = 10 ;
false.
3 ?- slow_max([1,2,10,3,4,5,6,10,7,8],X).
X = 10 ;
X = 10 ;
false.
edit
Note you don't strictly need three arguments, but just to have properly instantiated variables to carry out the comparison. Then you can 'reverse' the flow of values:
max2([R], R).
max2([X|Xs], R):- max2(Xs, T), (X > T -> R = X ; R = T).
again, this is slower than the three arguments loops, suggested in other answers, because it will defeat 'tail recursion optimization'. Also, it does just find one of the maxima:
2 ?- max2([1,2,3,10,5,10,6],X).
X = 10 ;
false.
Here's how to do it with lambda expressions and meta-predicate foldl/4, and, optionally, clpfd:
:- use_module([library(lambda),library(apply),library(clpfd)]).
numbers_max([Z|Zs],Max) :- foldl(\X^S^M^(M is max(X,S)),Zs,Z,Max).
fdvars_max( [Z|Zs],Max) :- foldl(\X^S^M^(M #= max(X,S)),Zs,Z,Max).
Let's run some queries!
?- numbers_max([1,4,2,3],M). % integers: all are distinct
M = 4. % succeeds deterministically
?- fdvars_max( [1,4,2,3],M).
M = 4. % succeeds deterministically
?- numbers_max([1,4,2,3,4],M). % integers: M occurs twice
M = 4. % succeeds deterministically
?- fdvars_max( [1,4,2,3,4],M).
M = 4. % succeeds deterministically
What if the list is empty?
?- numbers_max([],M).
false.
?- fdvars_max( [],M).
false.
At last, some queries showing differences between numbers_max/2 and fdvars_max/2:
?- numbers_max([1,2,3,10.0],M). % ints + float
M = 10.0.
?- fdvars_max( [1,2,3,10.0],M). % ints + float
ERROR: Domain error: `clpfd_expression' expected, found `10.0'
?- numbers_max([A,B,C],M). % more general use
ERROR: is/2: Arguments are not sufficiently instantiated
?- fdvars_max( [A,B,C],M).
M#>=_X, M#>=C, M#=max(C,_X), _X#>=A, _X#>=B, _X#=max(B,A). % residual goals
list_max([L|Ls], Max) :- foldl(num_num_max, Ls, L, Max).
num_num_max(X, Y, Max) :- Max is max(X, Y).
%Query will be
?-list_max([4,12,5,3,8,90,10,11],Max).
Max=90
Right now I was working with recursion in Prolog, so if it is useful for someone I will leave 'my two cents' solving it in the two ways that I have thought:
% Start
start :- max_trad([2, 4, 6, 0, 5], MaxNumber1),
max_tail([2, 4, 6, 0, 5], 0, MaxNumber2),
show_results(MaxNumber1, MaxNumber2).
% Traditional Recursion (Method 1)
max_trad([Head|Tail], Max) :- max_trad(Tail, Value), Head > Value, Max is Head.
max_trad([Head|Tail], Max) :- max_trad(Tail, Value), Head =< Value, Max is Value.
max_trad([], 0).
% Tail Recursion (Method 2)
max_tail([], PartialMax, PartialMax).
max_tail([Head|Tail], PartialMax, FinalMax) :- Head > PartialMax, max_tail(Tail, Head, FinalMax).
max_tail([_|Tail], PartialMax, FinalMax) :- max_tail(Tail, PartialMax, FinalMax).
% Show both of the results
show_results(MaxNumber1, MaxNumber2) :-
write("The max value (obtained with traditional recursion) is: "), writeln(MaxNumber1),
write("The max value (obtained with tail recursion) is: "), writeln(MaxNumber2).
The output of the above code is:
Both methods are similar, the difference is that in the second an auxiliary variable is used in the recursion to pass values forward, while in the first method, although we have one less variable, we are filling the Stack with instructions to be executed later, so if it were an exaggeratedly large list, the second method is appropriate.
maximum_no([],Max):-
write("Maximum No From the List is:: ",Max).
maximum_no([H|T],Max):-
H>Max,
N = H,
maximum_no(T,N).
maximum_no(L,Max):-
maximum_no(L,Max).
The maximum number in a list in Prolog ?
max([],A):-print(A),!.
max([Head | Tail] , A):-A =< Head ,A1 is Head , max(Tail,A1) ; max(Tail,A).
max(L,M):-
member(M,L),
findall(X,(member(X,L),X>M),NL),
length(NL,0).

Difference between X\=Y and dif(X,Y)

What is the difference between this:
X \= Y
and this piece of code:
dif(X, Y)
I thought that they should behave the same, but they do not. Here's the example:
n_puta(L, N, X) :- nputa(L, N, 0, X).
nputa([], N, C, _) :- N = C.
nputa([G|R], N, C, X) :- G = X, nputa(R, N, Y, X), C is Y - 1.
nputa([G|R], N, C, X) :- dif(G,X), nputa(R, N, C, X).
And here are some calls:
?- n_puta([a,a,b,b,b], 2, X).
X = a ;
false.
?- n_puta([a,a,b,a,b,b], 3, X).
X = a ;
X = b ;
false.
X should be the atom that occurs exactly N times in the list L. If I replace dif(G, X) with G \= X, I don't get the expected result. Can someone tell me what is the difference between these two operators? Can I use anything else except dif(G, X)?
This example works prefectly in SWI-Prolog, but doesn't work in Amzi! Prolog.
dif/2 and (\=)/2 are the same as long as their arguments are ground. But only dif/2 is a pure relation that works correctly also with variables and can be used in all directions. Your example clearly shows that you should use dif/2 in this case, because you use your predicate not only to test, but also to generate solutions. The most widely used Prolog systems all provide dif/2.

Getting the product of a list from left to right

How do you get the product of a list from left to right?
For example:
?- product([1,2,3,4], P).
P = [1, 2, 6, 24] .
I think one way is to overload the functor and use 3 arguments:
product([H|T], Lst) :- product(T, H, Lst).
I'm not sure where to go from here.
You can use library(lambda) found here : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
Quite unreadable :
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
product(L, R) :-
foldl(\X^Y^Z^(Y = []
-> Z = [X, [X]]
; Y = [M, Lst],
T #= X * M,
append(Lst, [T], Lst1),
Z = [T, Lst1]),
L, [], [_, R]).
Thanks to #Mike_Hartl for his advice, the code is much simple :
product([], []).
product([H | T], R) :-
scanl(\X^Y^Z^( Z #= X * Y), T, H, R).
seems like a list copy, just multiplying by last element handled. Let's start from 1 for the leftmost element:
product(L, P) :-
product(L, 1, P).
product([X|Xs], A, [Y|Ys]) :-
Y is X * A,
product(Xs, Y, Ys).
product([], _, []).
if we use library(clpfd):
:- [library(clpfd)].
product([X|Xs], A, [Y|Ys]) :-
Y #= X * A,
product(Xs, Y, Ys).
product([], _, []).
it works (only for integers) 'backward'
?- product(L, [1,2,6,24]).
L = [1, 2, 3, 4].
Probably very dirty solution (I am new to Prolog):
product([ListHead|ListTail], Answer) :-
product_acc(ListTail, [ListHead], Answer).
product_acc([ListHead|ListTail], [AccHead|AccTail], Answer) :-
Product is ListHead * AccHead,
append([Product, AccHead], AccTail, TempList),
product_acc(ListTail, TempList, Answer).
product_acc([], ReversedList, Answer) :-
reverse(ReversedList, Answer).
So basically at the beginning we call another predicate which has
extra "variable" Acc which is accumulator list.
So we take out head (first number) from original list and put it in
to Accumulator list.
Then we always take head (first number) from original list and
multiply it with head (first number) from accumulator list.
Then we have to append our new number which we got by multiplying
with the head from accumulator and later with the tail
Then we call same predicate again until original list becomes empty
and at the end obviously we need to reverse it.
And it seems to work
?- product([1,2,3,4], L).
L = [1, 2, 6, 24].
?- product([5], L).
L = [5].
?- product([5,4,3], L).
L = [5, 20, 60].
Sorry if my explanation is not very clear. Feel free to comment.

Prolog. How to check if two math expressions are the same

I'm writing a prolog program that will check if two math expressions are actually the same. For example, if my math expression goal is: (a + b) + c then any of the following expressions are considered the same:
(a+b)+c
a+(b+c)
(b+a)+c
(c+a)+b
a+(c+b)
c+(a+b)
and other combinations
Certainly, I don't expect to check the combination of possible answers because the expression can be more complex than that.
Currently, this is my approach:
For example, if I want to check if a + b *c is the same with another expression such as c*b+a, then I store both expression recursively as binary expressions, and I should create a rule such as ValueOf that will give me the "value" of the first expression and the second expression. Then I just check if the "value" of both expression are the same, then I can say that both expression are the same. Problem is, because the content of the expression is not number, but identifier, I cannot use the prolog "is" keyword to get the value.
Any suggestion?
many thanks
% represent a + b * c
binExprID(binEx1).
hasLeftArg(binEx1, a).
hasRightArg(binEx1, binEx2).
hasOperator(binEx1, +).
binExprID(binEx2).
hasLeftArg(binEx2, b).
hasRightArg(binEx2, c).
hasOperator(binEx2, *).
% represent c * b + a
binExprID(binEx3).
hasLeftArg(binEx3, c).
hasRightArg(binEx3, b).
hasOperator(binEx3, *).
binExprID(binEx4).
hasLeftArg(binEx4, binEx3).
hasRightArg(binEx4, a).
hasOperator(binEx4, +).
goal:- valueOf(binEx1, V),
valueOf(binEx4, V).
Math expressions can be very complex, I presume you are referring to arithmetic instead. The normal form (I hope my wording is appropriate) is 'sum of monomials'.
Anyway, it's not an easy task to solve generally, and there is an ambiguity in your request: 2 expressions can be syntactically different (i.e. their syntax tree differ) but still have the same value. Obviously this is due to operations that leave unchanged the value, like adding/subtracting 0.
From your description, I presume that you are interested in 'evaluated' identity. Then you could normalize both expressions, before comparing for equality.
To evaluate syntactical identity, I would remove all parenthesis, 'distributing' factors over addends. The expression become a list of multiplicative terms. Essentially, we get a list of list, that can be sorted without changing the 'value'.
After the expression has been flattened, all multiplicative constants must be accumulated.
a simplified example:
a+(b+c)*5 will be [[1,a],[b,5],[c,5]] while a+5*(c+b) will be [[1,a],[5,c],[5,b]]
edit after some improvement, here is a very essential normalization procedure:
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N).
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[1, N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(msort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
accum(T2, [Total|Symbols]) :-
include(number, T2, Numbers),
foldl(mul, Numbers, 1, Total),
exclude(number, T2, Symbols).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
Some test:
?- arith_equivalence(a+(b+c), (a+c)+b).
true .
?- arith_equivalence(a+b*c+0*77, c*b+a*1).
true .
?- arith_equivalence(a+a+a, a*3).
true .
I've used some SWI-Prolog builtin, like include/3, exclude/3, foldl/5, and msort/2 to avoid losing duplicates.
These are basic list manipulation builtins, easily implemented if your system doesn't have them.
edit
foldl/4 as defined in SWI-Prolog apply.pl:
:- meta_predicate
foldl(3, +, +, -).
foldl(Goal, List, V0, V) :-
foldl_(List, Goal, V0, V).
foldl_([], _, V, V).
foldl_([H|T], Goal, V0, V) :-
call(Goal, H, V0, V1),
foldl_(T, Goal, V1, V).
handling division
Division introduces some complexity, but this should be expected. After all, it introduces a full class of numbers: rationals.
Here are the modified predicates, but I think that the code will need much more debug. So I allegate also the 'unit test' of what this micro rewrite system can solve. Also note that I didn't introduce the negation by myself. I hope you can work out any required modification.
/* File: arith_equivalence.pl
Author: Carlo,,,
Created: Oct 3 2012
Purpose: answer to http://stackoverflow.com/q/12665359/874024
How to check if two math expressions are the same?
I warned that generalizing could be a though task :) See the edit.
*/
:- module(arith_equivalence,
[arith_equivalence/2,
normalize/2,
distribute/2,
sortex/2
]).
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N), !.
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X / Y, L) :-
normalize(X, Xn),
normalize(Y, Yn),
divide(Xn, Yn, L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(dsort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
dsort(L, S) :- is_list(L) -> msort(L, S) ; L = S.
divide([], _, []).
divide([N|Nr], D, [R|Rs]) :-
( N = [Nn|Ns],
D = [[Dn|Ds]]
-> Q is Nn/Dn, % denominator is monomial
remove_common(Ns, Ds, Ar, Br),
( Br = []
-> R = [Q|Ar]
; R = [Q|Ar]/[1|Br]
)
; R = [N/D] % no simplification available
),
divide(Nr, D, Rs).
remove_common(As, [], As, []) :- !.
remove_common([], Bs, [], Bs).
remove_common([A|As], Bs, Ar, Br) :-
select(A, Bs, Bt),
!, remove_common(As, Bt, Ar, Br).
remove_common([A|As], Bs, [A|Ar], Br) :-
remove_common(As, Bs, Ar, Br).
accum(T, [Total|Symbols]) :-
partition(number, T, Numbers, Symbols),
foldl(mul, Numbers, 1, Total), !.
accum(T, T).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
:- begin_tests(arith_equivalence).
test(1) :-
arith_equivalence(a+(b+c), (a+c)+b).
test(2) :-
arith_equivalence(a+b*c+0*77, c*b+a*1).
test(3) :-
arith_equivalence(a+a+a, a*3).
test(4) :-
arith_equivalence((1+1)/x, 2/x).
test(5) :-
arith_equivalence(1/x+1, (1+x)/x).
test(6) :-
arith_equivalence((x+a)/(x*x), 1/x + a/(x*x)).
:- end_tests(arith_equivalence).
running the unit test:
?- run_tests(arith_equivalence).
% PL-Unit: arith_equivalence ...... done
% All 6 tests passed
true.

Resources