Am Donnerstag, den 26.11.2009, 00:34 +0100 schrieb Dieter Kaiser:
I have done some further work on a function which does the mapping over
bags. The following code allows the mapping for functions with an
arbitrary number of arguments:
(defun distribute-over (expr)
(cond ((= 1 (length (cdr expr)))
;; Distribute over for a function with one argument.
(cond ((and (not (atom (cadr expr)))
(not (atom (caadr expr)))
(member (caaadr expr) (get (caar expr)
'distributes_over))
(or $listarith (not (eq (caaadr expr) 'mlist))))
(simplify (cons (caadr expr)
(mapcar #'(lambda (u) (simplify (list (car expr)
u)))
(cdadr expr)))))
(t nil)))
(t
;; A function with more than one argument.
(do ((args (cdr expr) (cdr args))
(new-expr nil)
(first-args nil))
((null args) nil)
(when (and (not (atom (car args)))
(member (caar (car args))
(get (caar expr) 'distributes_over)))
;; Map the function over the arguments and simplify again.
(return
(simplify
(cons (ncons (caar (car args)))
(mapcar #'(lambda (u)
(simplify
(append
(append
(cons (ncons (caar expr))
(reverse first-args))
(ncons u))
(rest args))))
(cdr (car args)))))))
(setq first-args (cons (car args) first-args))))))
The function is called from the simplifier:
((and (get (caar x) 'distributes_over)
(distribute-over x)))
With the following code we set the properties:
(dolist (x '(%sin
%cos
%tan
%expintegral_e
%gamma_incomplete_generalized))
(setf (get x 'distributes_over) '(mlist $matrix mequal)))
Examples for the mapping:
A function with one argument which maps over a list:
(%i1) sin([1,2,3]);
(%o1) [sin(1),sin(2),sin(3)]
A function with two arguments. First we map over the first argument,
than over the second and at last over both arguments:
(%i2) expintegral_e([1,2,3],x);
(%o2) [expintegral_e(1,x),expintegral_e(2,x),expintegral_e(3,x)]
(%i3) expintegral_e(1,[x,y,z]);
(%o3) [expintegral_e(1,x),expintegral_e(1,y),expintegral_e(1,z)]
(%i4) expintegral_e([1,2,3],[x,y,z]);
(%o4) [[expintegral_e(1,x),expintegral_e(1,y),expintegral_e(1,z)],
[expintegral_e(2,x),expintegral_e(2,y),expintegral_e(2,z)],
[expintegral_e(3,x),expintegral_e(3,y),expintegral_e(3,z)]]
The Regularized Incomplete Gamma function has three arguments. We
combine the mapping over lists, matrices, and equations:
(%i6) gamma_incomplete_generalized([1,2,3],matrix([a,b],[c,d]),x=y);
(%o6) [matrix([gamma_incomplete_generalized(1,a,x)
= gamma_incomplete_generalized(1,a,y),
gamma_incomplete_generalized(1,b,x)
= gamma_incomplete_generalized(1,b,y)],
[gamma_incomplete_generalized(1,c,x)
= gamma_incomplete_generalized(1,c,y),
gamma_incomplete_generalized(1,d,x)
= gamma_incomplete_generalized(1,d,y)]),
matrix([gamma_incomplete_generalized(2,a,x)
= gamma_incomplete_generalized(2,a,y),
gamma_incomplete_generalized(2,b,x)
= gamma_incomplete_generalized(2,b,y)],
[gamma_incomplete_generalized(2,c,x)
= gamma_incomplete_generalized(2,c,y),
gamma_incomplete_generalized(2,d,x)
= gamma_incomplete_generalized(2,d,y)]),
matrix([gamma_incomplete_generalized(3,a,x)
= gamma_incomplete_generalized(3,a,y),
gamma_incomplete_generalized(3,b,x)
= gamma_incomplete_generalized(3,b,y)],
[gamma_incomplete_generalized(3,c,x)
= gamma_incomplete_generalized(3,c,y),
gamma_incomplete_generalized(3,d,x)
= gamma_incomplete_generalized(3,d,y)])]
With this extension we would have a general mapping functionality over
arbitrary operators and for functions with an arbitrary number of
arguments.
Dieter Kaiser