Mapargs/3?

A lot of code doing term mapping is roughly constructed as follows:

  • Map a single term
  • If compound, map all arguments
  • else leave unchanged

Notably the 2nd step is rather boring: either use =../2 to create a list, map the list elements and create the result term or use functor/3 and arg/3.

I see two ways out

  • Add mapargs/3 to library(append) that will do the above loop (using compound_name_arity/3 and friends).
  • Adopt the ECLiPSe logical do loops. Well, it seems the version I have (adopted from the original publication) doesnā€™t allow for this. Not sure whether the current ECLiPSe version can deal with this.

These leaves some questions:

  • Is a mapargs/3 a good idea? If so, is this already known in some other system, possibly with a different name and/or on a different library (library(terms))?
  • Should we (eventually) go for the ECLiPSe logical loops or improve the mapping? One of the advantages of logical loops is that you do not need lambda expressions.
3 Likes

That would be a big win, because lambda expansion (at least with library(yall)) is slightly different for interpreted vs compile-time-expanded. Also, a number of programming languages have seen fit to add ā€œlist comprehensionsā€ even though they can be replaced by map, filter, etc. (similar to maplist/3, include/3) combined with lambda (Haskell and Python; and apparently Javascript is considering adding comprehensions). So, a more general mechanism, like ā€œlogical loopsā€ would be better than a specific solution of mapargs. (This doesnā€™t preclude having both - I suppose one might want to pass mapargs as a ā€œhigher orderā€ predicate in some situations.)

FWIW, although Iā€™ve sometimes done iteration over a compoundā€™s arguments, I usually avoid that by using a list instead of args ā€¦ writing foo(x,y,z) instead of foo([x,y,z]) doesnā€™t seem to be worth the slight saving in keystrokes ā€¦ although it is useful for implementing things similar to call/2.

PS: I think you meant library(apply) and not library(append).

1 Like

That is a bit too optimistic. Also the ECLiPSe logical loops have a notation that defines which variables
are shared with the environment. So, this is subject to the same issues (I fear) :frowning:

A possible fix for both is to drop the parameter specification and simply define all variables to share with the enclosing clause. This might cause some use cases with setof/3 (and bagof/3) to avoid the need for existential variable annotation to stop working though.

Hmm. I think it is also ugly, defies checking argument counts, uses a lot more memory and will often harm indexing :frowning: If that is the solution for avoiding a loop over arguments Iā€™d rather make that easier :slight_smile:

Sure. Thanks.

1 Like

I was thinking about terms, not predicates ā€¦ and I use lists where the number of items is variable, despite the storage overhead.

Anyway, for predicates, there are already two models: apply/2 and call/2.

But at least we wouldnā€™t have different behavior, depending on whether the do/2 is expanded at compile time or interpreted?

My package pac happened to include mapterm/3, functionality of which is similar to that of the proposed maparg/3. (pac/prolog/pac/pac-etc.pl ) My implementation is an application
of recursive closure of pac (mrec below). It was just an old day hobby work and nothing interesting for others, I believe, though I never saw codes for similiar job by others. I do not know ā€œlogical loopā€.

?- mapterm(=, f(a, b), Out).
 Out = f(a, b).
?- mapterm(pred([a,b]), f(a,a), R).
 R = f(b, b).
?- mapterm(mapterm(pred([a,b])), f(g(a,a), h(a,a)), R).
 R = f(g(b, b), h(b, b)).
?- mapterm(pred([A, [A,A]]), f(a,b), Out).
 Out = f([a, a], [b, b]).
?- F = pred([A, [A,A]]), mapterm(F, f(a,b), Out).
 F = update_link:'pac#16',
 Out = f([a, a], [b, b]).
etc(mapterm, [F|As], _, meta:G, P, P):- var(F), !,
	complete_args(mapterm, [F|As], G).
etc(mapterm, [F|As], M, G, P, Q):-
   	expand_arg(F, M, F0, P, P0),
	term_variables(F0, Vs),
	expand_core(
		mrec(Vs, [	_Entry	= pred(( [A, B]:-
										functor(A, Fa, Na),
										functor(B, Fa, Na),
										call(Mapterm, Na, A, B))),
					Mapterm = pred( ([0, _, _]:- !)
								&
							  ([I, A, B]:-
									arg(I, A, Ai),
									arg(I, B, Bi),
									call(F, Ai, Bi),
									J is I - 1,
									call(Mapterm, J, A, B)))
				  ]),
				M, G0, P0, Q),
	complete_args(G0, As, G).

[EDIT 2021/1/2]
There is a codes for ā€œmapargsā€ near the ā€œmaptermā€. I wrote it for editing a complicate and long source file ā€œexpand-exp.plā€ under the same directory of the expand-etc.pl. I donā€™t remember the exact purpose of my mapargs/3, but it was useful for me to edit many places in the source file, for which usually emacs commnad M-x query-replace and the like are used. Without the mapargs I could not finish the editing manually because of many human errors of mine. Anyway this experience may be irrelevant to your new mapargs/3; I think the experience was a homework on compile_aux_clause/1 and term_expansion/2, dcg_translate_rule/2, in the end.

Thanks. I was doubting between mapargs/3 and mapterm/3. This is at least a clear vote for the latter :slight_smile:

I havenā€™t looked at the details, but I fear the answer is disappointing. Both library(yall) and logical loops are terms that are translated using goal-expansion and have a notion to tell which variables must be shared with the environment. Both can also be called as a normal goal. In that case there is no way to see which parts of the goal are shared with the environment and thus the direct calling model is always sharing everything.

SWI-Prolog provides access to the term being expanded while doing goal expansion, so we can compute which variables of the expanded expression are shared. I think most other Prologā€™s do not allow for that and having a notation on what to share is thus the only option. Possibly we should do the following:

  • Compute the set of shared variables
  • Use this instead of the (possible) annotation for the translation. That ensures consistent results.
  • If there is an annotation, verify the variables are the same as the computed set and print a warning otherwise.

Would that make sense?

Lists are of course ok if the number of elements is not fixed. Wrapping the thing in a term for annotation/typing can be a good thing.

Call/N is ISO and I think should be considered a modern replacement for apply/2 as used in the past century :slight_smile:

show/1 defined in the module pac displays an expanded goal like this:

?- show( mapterm(pred([A, [A,A]]), f(a,b), Out) ).
pac:pac#4(f(a,b),_), where
pac:pac#5(0,_,_):-!
pac:pac#5(A,B,C):-pac:arg(A,B,D),pac:arg(A,C,E),user:pac#3(D,E),pac:(F is A-1),pac:pac#5(F,B,C)
pac:pac#4(A,B):-pac:functor(A,C,D),pac:functor(B,C,D),pac:pac#5(D,A,B)
Out = _.
 ?- listing('pac#3').
 :- dynamic'pac#3'/2.

 'pac#3'(A, [A, A]).

The name ''mapterm" is after the ā€œmaplistā€, but now your ā€œmapargsā€ sounds better.
My ā€˜mapargs/3ā€™ was initially aimed at more flexible mapterm with arbitrary flipping arguments, but I could not find the general form of such functionality.

Thanks for the URL. On reading the short note, my expand-etc.pl now looks like a crude form of an implementation of ā€œlogical loopā€, because it already includes my own version of maplist, foldl, foldr, sed, mapterm, fold_num, do, for, etc. Of course I know some of them are given in much smarter way in the SWI library. Fortunately, functionality and performance seem comparative. Also I already noticed that variety of ā€œlogical loopsā€ in the expand-etc.pl are uniformly covered with a small set of ā€œprimitivesā€ in the core of pac library of mine. However it seems a difficult task for me to lift the current expand-etc.pl upto such ā€œlogical loopā€ language, though I am interested if I could, and, I have a pressing ā€œmissionā€ to finish, which you might guess easily.

Interesting. Just added this as mapterm/3 to library(terms). I still do not know which name is better. You map the arguments, so mapargs, but it is an operation on a (compound) term, so mapterm. Note that we also have maplist/3 and not mapelements/3, which are after all the things being mapped. I almost believe this is a convincing argument for mapterm/3.

If the world was till an empty place we might have opted for map_term_arguments/3, but given maplist/3 I think that is a bad idea.

Any more insights?

Yes. Once I thought using variant checker like =@=/2 because my pac is based
on something like an algebra of combinators in my sense. It seemed interesting, but redundancy was out of my sight soon without investing further. Redundant ā€œlogical loopsā€ was enough for my private project. Anyway your comment is to the point. Thanks.

If you mean by mapterm recursive version of mapargs, as far as I remember such mapterm was not so difficult. In fact I wrote recursive version of mapterm first. Perhaps map_tree, map_path are there in expand-etc.pl for such purpose imaging tree automata like mapping. Not sure I will check later.

EDIT 2021/1/3

A simple version of recursive materm/3 for illustration by inserting three lines
into codes of non recursive mapterm. Behavior at leafs is much simplified for illustration.

% ?- mapterm_rec(=, f(a, b), Out).
%@ Out = f(a, b).
% ?- mapterm_rec(pred([a, b]), f(a, b), Out).
%@ Out = f(b, b).
% ?- mapterm_rec(pred([a, b]), f(g(a), h(a,b)), Out).
%@ Out = f(g(b), h(b, b)).

etc(mapterm_rec, [F|As], _, meta:G, P, P):- var(F), !,
	complete_args(mapterm_rec, [F|As], G).
etc(mapterm_rec, [F|As], M, G, P, Q):-
   	expand_arg(F, M, F0, P, P0),
	term_variables(F0, Vs),
	expand_core(
		mrec(Vs, [	Entry	= pred(( [A, B]:-
										functor(A, Fa, Na),
										functor(B, Fa, Na),
										call(Mapterm_rec, Na, A, B))),
					Mapterm_rec = pred( ([0, _, _]:- !)
								&
							  ([I, A, B]:-
									arg(I, A, Ai),
									arg(I, B, Bi),
									(	call(F, Ai, Bi)-> true
									;	atomic(Ai) -> Bi = Ai
									;	call(Entry, Ai, Bi)
									),
									J is I - 1,
									call(Mapterm_rec, J, A, B)))
				  ]),
				M, G0, P0, Q),
	complete_args(G0, As, G).

That is surely the case. In part this may not be so bad as people have different preferences. As I argued before and you seem to start appreciating, I think library(apply_macros) was a bad idea. Or, maybe more polite (I didnā€™t invent it, it came to SWI-Prolog via YAP), an intermediate solution. The final solution should be partial evaluation/inlining or (possibly) a faster alternative to call/N.

For the latter, consider.

 maplist(plus(3), [1,2,3], X).

This results in call(user:plus(3), I, O). This requires call/3 to find plus/1, add 2 to get at plus/3, lookup the functor, find the module user and the predicate user:plus/3. That means 3 hash lookups. Now we can create the environment frame and run it.

Alternatively, we already know by the meta-predicate declaration that plus(3) for meta argument 2 will call user:plus/3. So, instead of using the meta predicate declaration to turn plus(3) into user:plus(3), we could turn the plus functor into a blob that holds a pointer to the predicate user:plus/3. Now, if call/3 finds this blob it can immediately fill the argument vector and call. Most likely the performance difference compared to a normal call would be neglectable.

This would deal with library(apply), but probably not with yall and logical loops. Possibly a similar trick could be applied though.

I agree that partial evaluation is a key, about which I know only partially though.
BTW, the following term_expansion rule for maplist_rec/3, a recursive version of maplist/3,
displays this for maplist_rec(plus(1), [0,1,2], Out)):

% ?- show(maplist_rec(plus(1), [0,1,2], Out)).
%@ pac:pac#12([0,1,2],_), where
%@ pac:pac#12([],[]):-true
%@ pac:pac#12([A|B],[C|D]):-(pac:is_list(A)->pac:pac#12(A,C);pac:plus(1,A,C)),pac:pac#12(B,D)
%@ Out = _.

It seems that my pac library already does something like ā€œpartial evaluationā€ partially. Is it right ?
Here is a simple statistic for maplist_rec(plus(1), Ks, Out)), where Ks is a list of length 1000, and each element of Ks is a list of length 1000.

% ?- N = 1000, K=1000, numlist(1, N, Ns),  length(Ks, K),
%	maplist(=(Ns), Ks),
%	time(maplist_rec(plus(1), Ks, Out)).
%@ % 4,003,002 inferences, 0.136 CPU in 0.146 seconds (93% CPU, 29343004 Lips)
%@ N = K, K = 1000,
%@ Ns = [1, 2, 3, 4, 5, 6, 7, 8, 9|...],
%@ Ks = [[1, 2, 3, 4, 5, 6, 7, 8|...], [1, 2, 3, 4, 5, 6, 7|...], [1, 2, 3, 4, 5, 6|...], [1, 2, 3, 4, 5|...], [1, 2, 3, 4|...], [1, 2, 3|...], [1, 2|...], [1|...], [...|...]|...],
%@ Out = [[2, 3, 4, 5, 6, 7, 8, 9|...], [2, 3, 4, 5, 6, 7, 8|...], [2, 3, 4, 5, 6, 7|...], [2, 3, 4, 5, 6|...], [2, 3, 4, 5|...], [2, 3, 4|...], [2, 3|...], [2|...], [...|...]|...].
etc(maplist_rec, [F|As], _, meta:G, P, P):- var(F), !,
	complete_args(maplist_rec, [F|As], G).
etc(maplist_rec, [F|As], M, G, P, Q):-
   	expand_arg(F, M, F0, P, P0),
	term_variables(F0, Vs),
	expand_core(
		mrec(Vs, [	Main = pred(
						[[], []]
					&	([[X|Xs], [Y|Ys]]:-
							((	is_list(X)
							-> 	call(Main, X, Y)
							;	call(F0, X, Y)
							),
							call(Main, Xs, Ys)))
					)
				  ]),
				M, G0, P0, Q),
	complete_args(G0, As, G).

EDIT 2021/1/3

is_list/1 is  expensive !
% ?- N is 10^7, length(X, N), time(repeat(1000, is_list(X))).
%@ % 2,001 inferences, 25.174 CPU in 25.178 seconds (100% CPU, 79 Lips)
%@ N = 10000000,
%@ X = [_2438, _2444, _2450, _2456, _2462, _2468, _2474, _2480, _2486|...].

EDIT 2021/1/4
It seems that is_list/1 is not prepared as a fast type checker like integer/1 and atom/1. So it may not be good to use is_list/1 as follows, provided that X has chance to be bound to a long list or cyclic term.

f(X):- integer(X),!, ā€¦
f(X):- atom((X),!, ā€¦
f(X):- is_list(X), !, ā€¦
ā€¦

help(is_list) says:

is_list(+Term)
True if Term is bound to the empty list ([]) or a compound term with nameā€˜
[|]ā€™ and arity 2 and the second argument is a list. This predicate acts as
if defined by the definition below on acyclic terms. The implementation
safely fails if Term represents a cyclic list.

        is_list(X) :-
                var(X), !,
                fail.
        is_list([]).
        is_list([_|T]) :-
                is_list(T).

EDIT 2021/1/4
is_list(X) compared with (X=[_|_]; X =[]). So, I should not use is_list/1
for merely checking functor(X, '[|]', 2).

% ?- N is 10^7, length(X, N), time(repeat(1000, (X=[_|_]; X =[]))).
%@ % 1,000 inferences, 0.166 CPU in 0.359 seconds (46% CPU, 6014 Lips)
%@ N = 10000000,
%@ X = [_238, _2888, _2894, _2900, _2906, _2912, _2918, _2924, _2930|...] .

From what Iā€™ve read so far, it seems like the term name is not modified by this predicate.

Therefore, I like mapargs/3 more than mapterm/3.

I do like map_term_arguments/3 as well. The longer we do not break with old and outdated naming conventions the more difficult it will become to do so.

Dear Jan,

mapterm/3 seems to me inaccurate.

That is assuming I understand the nomenclature correctly.

A variable and a list are terms right ?

eg
?- copy_term( [1,2,3], X ).
X = [1, 2, 3].

Do you mean mapcompound/3 ?

stoics_lib has had maparg/3 for a long while now:
http://eu.swi-prolog.org/pack/file_details/stoics_lib/src/meta/maparg.pl
mapargs/3 is probably more accurate than the singular.

Also the library you placed the predicate in (terms) wouldnā€™t be
my choice. maparg/3 is in meta sub-dir in stoics-lib.

This is just my opinion as someone unlikely to use it.
Rather fond of my own library predicates :slight_smile:
So feel absolutely no worry about changing anything on my account.

I quite often thought that the distinction between lists and compounds is
quite arbitrary.

you could have

?- length( a(b,c), 2 ).

?- map( plus(1), [1,2,3], [3,4,5] ).

? map( plus(1), a(1,2,3), a(3,4,5) ).

I have seen from R, that madness lies at the end of the way of unchecked polymorphism.
I am not convinced, though, that it would be as severe a problem in this context and possibly in most of contexts for compounds vs lists.

Regards,

Nicos Angelopoulos

http://stoics.org.uk/~nicos

I posted at this thread mapterm_rec/3, a recursive version of ā€œmapterm/3ā€, which can be used to modify subterms including functor names. Also I commented to Jan that mapargs sounds better. However, Prolog list, as every one knows, is a special case of recursive binary term, and maplist is a special meta predicate on the list which works recursively on the special structure which is very similar to mapcar of LISP. Therefore, I prefers to mapargs, but also to reserve the name mapterm for recursive version like my mapterm_rec.

Iā€™m still not entirely convinced about the best name. I decided to rename back to mapargs/3 though. @nicos mapcompound/3 might be better. I feels like a little awkward name though.

I guess it is your R view that you consider compounds and lists similar. Normally I think they are not in the Prolog world. List are supposed to hold an unknown number of terms that play the same role in the computation. Compounds can be used as arrays (mostly in the few systems that have unbounded arity). Traditionally though, they are closer to what other languages call records or structures, except that they identify the components by position rather then by name. Well, every application domain comes with its own traditions.