Prolog call, apply, bagof, finall


call(Goal, Arg1, Arg2, ..., ArgN)

This calls the goal passed to it, using the given list of arguments. e.g. the following calls write on a:
call(write, a).

If the goal already includes arguments then the arguments listed in the call are appended.

Where this is useful is allowing us to pass goals as arguments to other goals, then run them using call. For example, suppose we wanted to implement foreach(Goal,List), which would apply the Goal to each element of List.

   foreach(_, []).
   foreach(Goal, [H|T]) :- call(Goal, H), foreach(Goal, T).
Similarly, we could write a version of a for loop, that let us specify the range of values and what should be done to them:
   forvalues(A, B, _) :- integer(A), integer(B), A > B.
   forvalues(A, B, Goal) :- integer(A), integer(B), call(Goal, A),
                            NewA is A+1, forvalues(NewA, B, Goal).


apply(Goal, [Arg1, Arg2, ..., ArgN])

Similar to call, but takes the arguments as a list.


term =.. List

This unifies the list with the prolog term, and allows conversion between the two.

For example, T =.. [ length, [], K ], T. unifies T with length([], K) and then calls it, allowing us to build terms as lists and then call them.

Conversely, length([], K) =.. L unifies L with the list [ length, [], K ] allowing us to extract parts of a term.

Two other functions, functor and arg also allow us to decompose terms: functor(Term,Functor,Arity) extracts the functor of a term (e.g. length) and its arity (the number of arguments the term takes), while arg(N,Term,Argument) extracts the Nth argument (1 refers to the first argument).


bagof

bagof is an interesting way to group combinations of possible solutions. For a query with multiple arguments, you specify which argument is to be grouped into lists, with one list formed for each combination of the other arguments.

For example, suppose bioparents(P1, P2, C) indicates that P1 and P2 are the biological parents of C, and we have the following facts:

bioparents(stanley, ruth, gladys).
bioparents(stanley, ruth, hazel).
bioparents(stanley, irene, ralph).
bioparents(leonard, ruth, herbert).
bioparents(lawrence, mildred, ernest).
bioparents(lawrence, mildred, larry).
If I want to know all the pairs of biological parents, and which children they had, I could use the following:
bagof(Child, bioparents(P1, P2, Child), Kids). This would give me output along the lines of
Child = _G111 P1 = stanley P2 = ruth Kids = [gladys, hazel]
Child = _G111 P1 = stanley P2 = irene Kids = [ralph]
Child = _G111 P1 = leonard P2 = ruth Kids = [herbert]
Child = _G111 P1 = lawrence P2 = mildred Kids = [ernest, larry]


findall

findall is another way of grouping elements that satisfy a query.

Suppose we have the following fact set:

parents(homer, marge, bart).
parents(homer, marge, maggie).
parents(homer, marge, lisa).
parents(ned, maude, rod).
parents(ned, maude, tod).
Then the query
findall(Child, parents(P1, P2, Child), AllKids).
produces AllKids, as the list of every child of any pair of parents, i.e.
AllKids = [ bart, maggie, lisa, rod, tod ].

Similarly the query
findall(Child, parents(homer, P2, Child), HomersKids)>
produces HomersKids = [ bart, maggie, lisa ]