3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: David Gillespie <daveg@synaptics.com> |
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
;; Maintainers: D. Goel <deego@gnufans.org> |
;; Maintainer: Jay Belanger <belanger@truman.edu> |
|
;; Colin Walters <walters@debian.org> |
|
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
801 |
(cons f args)))))) |
(cons f args)))))) |
802 |
|
|
803 |
;;; Do substitutions in parallel to avoid crosstalk. |
;;; Do substitutions in parallel to avoid crosstalk. |
804 |
|
|
805 |
|
;; The variables math-ms-temp and math-ms-args are local to |
806 |
|
;; math-multi-subst, but are used by math-multi-subst-rec, which |
807 |
|
;; is called by math-multi-subst. |
808 |
|
(defvar math-ms-temp) |
809 |
|
(defvar math-ms-args) |
810 |
|
|
811 |
(defun math-multi-subst (expr olds news) |
(defun math-multi-subst (expr olds news) |
812 |
(let ((args nil) |
(let ((math-ms-args nil) |
813 |
temp) |
math-ms-temp) |
814 |
(while (and olds news) |
(while (and olds news) |
815 |
(setq args (cons (cons (car olds) (car news)) args) |
(setq math-ms-args (cons (cons (car olds) (car news)) math-ms-args) |
816 |
olds (cdr olds) |
olds (cdr olds) |
817 |
news (cdr news))) |
news (cdr news))) |
818 |
(math-multi-subst-rec expr))) |
(math-multi-subst-rec expr))) |
819 |
|
|
820 |
(defun math-multi-subst-rec (expr) |
(defun math-multi-subst-rec (expr) |
821 |
(cond ((setq temp (assoc expr args)) (cdr temp)) |
(cond ((setq math-ms-temp (assoc expr math-ms-args)) |
822 |
|
(cdr math-ms-temp)) |
823 |
((Math-primp expr) expr) |
((Math-primp expr) expr) |
824 |
((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2)) |
((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2)) |
825 |
(let ((new (list (car expr))) |
(let ((new (list (car expr))) |
826 |
(args args)) |
(math-ms-args math-ms-args)) |
827 |
(while (cdr (setq expr (cdr expr))) |
(while (cdr (setq expr (cdr expr))) |
828 |
(setq new (cons (car expr) new)) |
(setq new (cons (car expr) new)) |
829 |
(if (assoc (car expr) args) |
(if (assoc (car expr) math-ms-args) |
830 |
(setq args (cons (cons (car expr) (car expr)) args)))) |
(setq math-ms-args (cons (cons (car expr) (car expr)) |
831 |
|
math-ms-args)))) |
832 |
(nreverse (cons (math-multi-subst-rec (car expr)) new)))) |
(nreverse (cons (math-multi-subst-rec (car expr)) new)))) |
833 |
(t |
(t |
834 |
(cons (car expr) |
(cons (car expr) |
1041 |
(calcFunc-mod . math-mod) |
(calcFunc-mod . math-mod) |
1042 |
(calcFunc-vconcat . |
(calcFunc-vconcat . |
1043 |
math-concat) ))) |
math-concat) ))) |
1044 |
lfunc))) |
func))) |
1045 |
(while (cdr vec) |
(while (cdr vec) |
1046 |
(setq expr (funcall lfunc expr (nth 1 vec)) |
(setq expr (funcall lfunc expr (nth 1 vec)) |
1047 |
vec (cdr vec))))) |
vec (cdr vec))))) |
1230 |
(math-normalize (cons 'vec (nreverse mat))))) |
(math-normalize (cons 'vec (nreverse mat))))) |
1231 |
|
|
1232 |
|
|
1233 |
(defun calcFunc-inner (mul-func add-func a b) |
;; The variables math-inner-mul-func and math-inner-add-func are |
1234 |
|
;; local to calcFunc-inner, but are used by math-inner-mats, |
1235 |
|
;; which is called by math-inner-mats. |
1236 |
|
(defvar math-inner-mul-func) |
1237 |
|
(defvar math-inner-add-func) |
1238 |
|
|
1239 |
|
(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b) |
1240 |
(or (math-vectorp a) (math-reject-arg a 'vectorp)) |
(or (math-vectorp a) (math-reject-arg a 'vectorp)) |
1241 |
(or (math-vectorp b) (math-reject-arg b 'vectorp)) |
(or (math-vectorp b) (math-reject-arg b 'vectorp)) |
1242 |
(if (math-matrixp a) |
(if (math-matrixp a) |
1254 |
(math-dimension-error)))) |
(math-dimension-error)))) |
1255 |
(if (math-matrixp b) |
(if (math-matrixp b) |
1256 |
(nth 1 (math-inner-mats (list 'vec a) b)) |
(nth 1 (math-inner-mats (list 'vec a) b)) |
1257 |
(calcFunc-reduce add-func (calcFunc-map mul-func a b))))) |
(calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))) |
1258 |
|
|
1259 |
(defun math-inner-mats (a b) |
(defun math-inner-mats (a b) |
1260 |
(let ((mat nil) |
(let ((mat nil) |
1264 |
(setq col cols |
(setq col cols |
1265 |
row nil) |
row nil) |
1266 |
(while (> (setq col (1- col)) 0) |
(while (> (setq col (1- col)) 0) |
1267 |
(setq row (cons (calcFunc-reduce add-func |
(setq row (cons (calcFunc-reduce math-inner-add-func |
1268 |
(calcFunc-map mul-func |
(calcFunc-map math-inner-mul-func |
1269 |
(car a) |
(car a) |
1270 |
(math-mat-col b col))) |
(math-mat-col b col))) |
1271 |
row))) |
row))) |