File r38/packages/alg/maxmin.red artifact b60030f92d part of check-in 09c3848028

module maxmin;  % Support for generalized MAX and MIN.

% Author: F.J. Wright, QMW, London (fjw@maths.qmw.ac.uk) 7/7/90.

% Provide support for the MAX and MIN functions to allow:-
%     any number domain;
%     any symbolic arguments remain so;
%     nested algebraic-level lists of arguments;
% and to discard redundant nested max and min.
% The Lisp functions max and min are not affected.

% Revision : W. Neun, ZIB Berlin, 25/6/94 
%  added handling of  max(n,n+1,n-1) => n+1

put('max, 'simpfn, 'simpmax);

symbolic procedure simpmax u;
   S_simpmaxmin('max, function evalgreaterp, u, nil);

put('min, 'simpfn, 'simpmin);

symbolic procedure simpmin u;
   S_simpmaxmin('min, function evallessp, u, nil);

flag('(max min),'listargp);

symbolic smacro procedure difflist(u,v);
 for each uu in u collect reval list('difference,uu ,v);


symbolic procedure S_simpmaxmin(maxmin, relation, u,rec);
   begin scalar arglist, arglistp, mval, x;
      if null u then return nil ./ 1;   % 0 returned for empty args.
      arglistp := arglist := list nil;  % Dummy car with cdr to rplacd.
      for each val in flattenmaxmin(maxmin, revlis u) do
	 if atom denr(x := simp!* val)
	    and (atom numr x or car numr x memq '(!:rd!: !:rn!:))
	 % extremize numerical args:
	   then (if null mval or apply2(relation,val, mval)
		   then mval := val)
	 else
	 % successively append symbolic args efficiently:
	    << rplacd(arglistp, list val); arglistp := cdr arglistp >>;
      arglist := cdr arglist;  % Discard dummy car
      % Put any numerical extreme value at head of arg list:
      if mval then arglist := mval . arglist;
      % If more than one arg then keep as a max or min:
      if cdr arglist and rec then
		return !*kk2f(maxmin . !*trim arglist) ./ 1; 
      if cdr arglist then
	if length cdr arglist >= 1 and
	   not eqcar(prepsq(mval :=S_simpmaxmin(maxmin,relation,
			difflist(arglist,car arglist),T)),maxmin)
           then return addsq(mval,simp!* car arglist)
           else return !*kk2f(maxmin . !*trim arglist) ./ 1;
      % Otherwise just return the single (extreme) value:
      return simp car arglist
   end;  % simpmaxmin

symbolic procedure !*trim u;
   % Trim repeated elements from u.
   if null u then nil
    else if car u member cdr u then !*trim cdr u
    else car u . !*trim cdr u;

symbolic procedure flattenmaxmin(maxmin, u);
   % Flatten algebraic-mode lists and already recursively simplified
   % calls of max/min as appropriate.
   for each el in u join
      if atom el then list el
      else if car el eq 'list then flattenmaxmin(maxmin, cdr el)
      else if car el eq maxmin then cdr el
      else if car el='MAT then for each r in cdr el join r
      else list el;

endmodule;

end;