[Maxima-commits] CVS: maxima/share/contrib opsubst.lisp,1.2,1.3

[Barton W. <wil...@us...>]

Update of /cvsroot/maxima/maxima/share/contrib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32706/share/contrib

Modified Files:
	opsubst.lisp 
Log Message:
(1) Appended user-level functions  opsubstif, gatherargs, and gatherops.

(2) Added comment on why opsubst locally sets inflag to true.

(3) Fixed some noun / verb problems.

(4) Added GPL.

Index: opsubst.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/share/contrib/opsubst.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- opsubst.lisp	23 Feb 2006 02:50:42 -0000	1.2
+++ opsubst.lisp	6 May 2006 09:37:47 -0000	1.3
@@ -1,4 +1,13 @@
 #|
+  Copyright 2006 by Barton Willis
+
+  This is free software; you can redistribute it and/or
+  modify it under the terms of the GNU General Public License,
+  http://www.gnu.org/copyleft/gpl.html.
+
+ This software has NO WARRANTY, not even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
 Usage: The function 'opsubst' is similar to the function 'subst', except that
 'opsubst' only makes substitutions for the operators in an expression. Specifically,
 
@@ -23,10 +32,10 @@
 (%i6) opsubst([f=g,g=h],f(x));
 (%o6) h(x)
 
-To determine the operator, 'opsubst' sets 'inflag' to true. This means 
-'opsubst' substitutes for the internal, not the displayed, operator
-in the expression. Internally, Maxima does not use the unary negation,
-division, or the subtraction operators; thus:
+To determine the operator, 'opsubst' sets 'inflag' to true. This means
+'opsubst' substitutes for the internal, not the displayed, operator.
+Since Maxima does not internally use the unary negation or division
+operators, substituting for these operators will not work; examples:
 
 (%i1) opsubst("+","-",a-b);
 (%o1) a-b
@@ -40,14 +49,39 @@
 (%i4) opsubst("[","*", -a*b);
 (%o4) [-1,a,b]
 
+If opsubst did not locally set 'inflag' to true, we'd have:
 
-When either operator isn't a Maxima symbol, generally some other function
-will signal an error:
+(%i1) opsubst("[","*", -a*b), listarith : true;
+(%o1) [-a,-b]
+(%i2) opsubst("[","*", -a*b), listarith : false;
+(%o2) -[a,b]
+
+So opsubst("*","[", opsubst("[","*", -a*b)) # -a*b. There is
+nothing wrong with this; however, With 'inflag' set to true, 
+we have (regardless of the value of listarith)
+
+(%i1) opsubst("[","*", -a*b);
+(%o1) [-1,a,b]
+(%i2) opsubst("*","[",%);
+(%o2) -a*b
+
+To me, it seems that it is better to substitute for the internal
+rather than the displayed operator. But do not be mislead by this
+example, the equation
+ 
+   opsubst(f,g,opsubst(g,f,e)) = e
+
+is not an identity.
+
+When either the first or second arguments of 'opsubst' are not Maxima
+symbols, generally some other function will signal an error; for
+example
 
 (%i5) opsubst(a+b,f, f(x));
 Improper name or value in functional position:b+a
 
-However, subscripted operators are allowed:
+However, the first two arguments to 'opsubst' can be 
+subscripted:
 
 (%i6) opsubst(g[5],f, f(x));
 (%o6) g[5](x)
@@ -68,6 +102,52 @@
 (defun op-subst (f g e)
   (let (($inflag t))
     (if ($mapatom e) e
-      (mapply1 (if (like g ($op e)) f ($op e))
+      (mapply1 (if (like ($verbify g) ($verbify ($op e))) f ($op e))
 	       (mapcar #'(lambda (s) (op-subst f g s)) (margs ($args e))) nil))))
 
+;; If prd(e) evaluates to true, do the substitution opsubst(id, e). The
+;; first argument should be an equation of the form symbol = symbol or lambda form.
+
+(defun $opsubstif (id prd e)
+  (if (op-equalp id 'mequal) (op-subst-if ($rhs id) ($lhs id) prd e)))
+  
+(defun op-subst-if (fn fo prd e)
+  (let (($inflag t) ($prederror nil) (q))
+    (cond (($mapatom e) e)
+	  (t
+	   (mapply1 (if (and (like ($verbify fo) ($verbify ($op e)))
+			     (eq t (mevalp (mfuncall '$apply prd ($args e))))) fn ($op e))
+		    (mapcar #'(lambda (s) (op-subst-if fn fo prd s)) (margs ($args e))) nil)))))
+	  	   	  
+;; Return a list of all the arguments to the operator 'op.' Each argument is
+;; a list (what 'args' would return).  Examples:
+
+;; (%i1) gatherargs(f(x) + f(y),'f);
+;; (%o1) [[x],[y]]
+
+;; In the expression 42 + f(f(x)), both x and f(x) are arguments to f; thus
+
+;; (%i2) gatherargs(42 + f(f(x)),'f);
+;; (%o2) [[f(x)],[x]]
+
+;; (%i3) gatherargs(f^2 + %pi,'f);
+;; (%o3) []
+
+	   
+(defun $gatherargs (e op)
+  `((mlist) ,@(gatherargs e ($verbify op))))
+
+(defun gatherargs (e op)
+  (if ($mapatom e) nil
+    (append (if (op-equalp e op) `(((mlist) ,@(margs e))))
+	    (mapcan #'(lambda (s) (gatherargs s op)) (margs e)))))
+	 	  
+(defun $gatherops (e)
+  ($setify `((mlist) ,@(gatherops e))))
+
+(defun gatherops (e)
+  (if ($mapatom e) nil (cons ($op e) (mapcan #'gatherops (margs e)))))
+
+
+
+  
\ No newline at end of file