Function: math-symb-map

math-symb-map is a byte-compiled function defined in calc-map.el.gz.

Signature

(math-symb-map F MODE ARGS)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-map.el.gz
;;; Map a function over a vector symbolically. [Public]
(defun math-symb-map (f mode args)
  (let* ((func (math-var-to-calcFunc f))
	 (nargs (length args))
	 (ptrs (vconcat args))
	 (vflags (make-vector nargs nil))
	 (heads '(vec))
	 (head nil)
	 (vec nil)
	 (i -1)
	 (math-working-step 0)
	 (math-working-step-2 nil)
	 len obj expr) ;; cols
    (if (eq mode 'eqn)
	(setq mode 'elems
	      heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt
				  calcFunc-leq calcFunc-geq))
      (while (and (< (setq i (1+ i)) nargs)
		  (not (math-matrixp (aref ptrs i)))))
      (if (< i nargs)
	  (if (eq mode 'elems)
	      (setq func (list 'lambda '(&rest x)
			       (list 'math-symb-map
				     (list 'quote f) '(quote elems) 'x))
		    mode 'rows)
	    (if (eq mode 'cols)
		(while (< i nargs)
		  (if (math-matrixp (aref ptrs i))
		      (aset ptrs i (math-transpose (aref ptrs i))))
		  (setq i (1+ i)))))
	(setq mode 'elems))
      (setq i -1))
    (while (< (setq i (1+ i)) nargs)
      (setq obj (aref ptrs i))
      (if (and (memq (car-safe obj) heads)
	       (or (eq mode 'elems)
		   (math-matrixp obj)))
	  (progn
	    (aset vflags i t)
	    (if head
		(if (cdr heads)
		    (setq head (nth
				(aref (aref [ [0 1 2 3 4 5]
					      [1 1 2 3 2 3]
					      [2 2 2 1 2 1]
					      [3 3 1 3 1 3]
					      [4 2 2 1 4 1]
					      [5 3 1 3 1 5] ]
					    (- 6 (length (memq head heads))))
				      (- 6 (length (memq (car obj) heads))))
				heads)))
	      (setq head (car obj)))
	    (if len
		(or (= (length obj) len)
		    (math-dimension-error))
	      (setq len (length obj))))))
    (or len
	(if (= nargs 1)
	    (math-reject-arg (aref ptrs 0) 'vectorp)
	  (math-reject-arg nil "At least one argument must be a vector")))
    (setq math-working-step-2 (1- len))
    (while (> (setq len (1- len)) 0)
      (setq expr nil
	    i -1)
      (while (< (setq i (1+ i)) nargs)
	(if (aref vflags i)
	    (progn
	      (aset ptrs i (cdr (aref ptrs i)))
	      (setq expr (nconc expr (list (car (aref ptrs i))))))
	  (setq expr (nconc expr (list (aref ptrs i))))))
      (setq math-working-step (1+ math-working-step)
	    vec (cons (math-normalize (math-build-call func expr)) vec)))
    (setq vec (cons head (nreverse vec)))
    (if (and (eq mode 'cols) (math-matrixp vec))
	(math-transpose vec)
      vec)))