v15i034: Patch for GNU Emacs Calc, version 1.04 -> 1.05, part 07/20

David Gillespie daveg at csvax.cs.caltech.edu
Mon Oct 15 11:16:44 AEST 1990


Posting-number: Volume 15, Issue 34
Submitted-by: daveg at csvax.cs.caltech.edu (David Gillespie)
Archive-name: calc-1.05/part07

#!/bin/sh
# this is part 7 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc.patch continued
#
CurArch=7
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> calc.patch
X+ which correspond to zeros in mask are deleted.  The length of the
X+ result vector is the number of nonzero elements of the mask."
X+   (interactive "P")
X+   (calc-wrapper
X+    (calc-binary-op "vmsk" 'calcFunc-vmask arg))
X+ )
X+ 
X+ (defun calc-expand-vector (arg)
X+   "Expand a vector according to a mask vector.
X+ Vector is in top of stack, mask is in second-to-top.
X+ The result is a vector of the same length as mask.  Each nonzero element
X+ of mask is replaced by the next element of vec.  If vec has more elements
X+ than mask has nonzero elements, some are omitted.  If vec has fewer
X+ elements, the last few nonzero elements of mask are left the same.
X+ With Hyperbolic flag, top-of-stack is a filler element which is used
X+ instead of zero for zero mask elements; vector and mask are in stack
X+ levels two and three."
X+   (interactive "P")
X+   (calc-wrapper
X+    (if (calc-is-hyperbolic)
X+        (calc-enter-result 3 "vexp" (cons 'calcFunc-vexp (calc-top-list-n 3)))
X+      (calc-binary-op "vexp" 'calcFunc-vexp arg)))
X+ )
X+ 
X  (defun calc-sort ()
X    "Sort the matrix at top of stack into increasing order.
X! With Inverse flag, sort into decreasing order.
X! With Hyperbolic flag, return a permutation vector which would sort the input."
X    (interactive)
X    (calc-slow-wrapper
X     (if (calc-is-inverse)
X***************
X*** 4292,4297 ****
X--- 7907,7922 ----
X       (calc-enter-result 1 "sort" (list 'calcFunc-sort (calc-top-n 1)))))
X  )
X  
X+ (defun calc-grade ()
X+   "Grade the matrix at top of stack into increasing order.
X+ This produces a permutation vector which would sort the input."
X+   (interactive)
X+   (calc-slow-wrapper
X+    (if (calc-is-inverse)
X+        (calc-enter-result 1 "rgrd" (list 'calcFunc-rgrade (calc-top-n 1)))
X+      (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1)))))
X+ )
X+ 
X  (defun calc-histogram (n)
X    "Compile a histogram of a vector of integers in the range [0..N).
X  N is the numeric prefix argument.
X***************
X*** 4375,4410 ****
X     (calc-unary-op "cnrm" 'calcFunc-cnorm arg))
X  )
X  
X! (defun calc-mrow (n)
X    "Replace matrix at top of stack with its Nth row.
X  Numeric prefix N must be between 1 and the height of the matrix.
X  If top of stack is a non-matrix vector, extract its Nth element.
X  If N is negative, remove the Nth row (or element)."
X!   (interactive "NRow number: ")
X    (calc-wrapper
X!    (setq n (prefix-numeric-value n))
X!    (if (= n 0)
X!        (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
X!      (if (< n 0)
X! 	 (calc-enter-result 1 "rrow" (list 'calcFunc-mrrow
X! 					   (calc-top-n 1) (- n)))
X!        (calc-enter-result 1 "mrow" (list 'calcFunc-mrow (calc-top-n 1) n)))))
X  )
X  
X! (defun calc-mcol (n)
X    "Replace matrix at top of stack with its Nth column.
X  Numeric prefix N must be between 1 and the width of the matrix.
X  If top of stack is a non-matrix vector, extract its Nth element.
X  If N is negative, remove the Nth column (or element)."
X!   (interactive "NColumn number: ")
X    (calc-wrapper
X!    (setq n (prefix-numeric-value n))
X!    (if (= n 0)
X!        (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
X!      (if (< n 0)
X! 	 (calc-enter-result 1 "rcol" (list 'calcFunc-mrcol
X! 					   (calc-top-n 1) (- n)))
X!        (calc-enter-result 1 "mcol" (list 'calcFunc-mcol (calc-top-n 1) n)))))
X  )
X  
X  ;;;; [calc-map.el]
X--- 8000,8041 ----
X     (calc-unary-op "cnrm" 'calcFunc-cnorm arg))
X  )
X  
X! (defun calc-mrow (n &optional nn)
X    "Replace matrix at top of stack with its Nth row.
X  Numeric prefix N must be between 1 and the height of the matrix.
X  If top of stack is a non-matrix vector, extract its Nth element.
X  If N is negative, remove the Nth row (or element)."
X!   (interactive "NRow number: \nP")
X    (calc-wrapper
X!    (if (consp nn)
X!        (calc-enter-result 2 "mrow" (cons 'calcFunc-mrow (calc-top-list-n 2)))
X!      (setq n (prefix-numeric-value n))
X!      (if (= n 0)
X! 	 (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
X!        (if (< n 0)
X! 	   (calc-enter-result 1 "rrow" (list 'calcFunc-mrrow
X! 					     (calc-top-n 1) (- n)))
X! 	 (calc-enter-result 1 "mrow" (list 'calcFunc-mrow
X! 					   (calc-top-n 1) n))))))
X  )
X  
X! (defun calc-mcol (n &optional nn)
X    "Replace matrix at top of stack with its Nth column.
X  Numeric prefix N must be between 1 and the width of the matrix.
X  If top of stack is a non-matrix vector, extract its Nth element.
X  If N is negative, remove the Nth column (or element)."
X!   (interactive "NColumn number: \nP")
X    (calc-wrapper
X!    (if (consp nn)
X!        (calc-enter-result 2 "mcol" (cons 'calcFunc-mcol (calc-top-list-n 2)))
X!      (setq n (prefix-numeric-value n))
X!      (if (= n 0)
X! 	 (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
X!        (if (< n 0)
X! 	   (calc-enter-result 1 "rcol" (list 'calcFunc-mrcol
X! 					     (calc-top-n 1) (- n)))
X! 	 (calc-enter-result 1 "mcol" (list 'calcFunc-mcol
X! 					   (calc-top-n 1) n))))))
X  )
X  
X  ;;;; [calc-map.el]
X***************
X*** 4414,4420 ****
X  For example, applying f to [1, 2, 3] produces f(1, 2, 3)."
X    (interactive)
X    (calc-wrapper
X!    (let* ((calc-dollar-values (mapcar 'car-safe
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X  	  (oper (or oper (calc-get-operator "Apply"
X--- 8045,8052 ----
X  For example, applying f to [1, 2, 3] produces f(1, 2, 3)."
X    (interactive)
X    (calc-wrapper
X!    (let* ((sel-mode nil)
X! 	  (calc-dollar-values (mapcar 'calc-get-stack-element
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X  	  (oper (or oper (calc-get-operator "Apply"
X***************
X*** 4433,4452 ****
X  
X  (defun calc-reduce (&optional oper)
X    "Apply a binary operator across all elements of a vector.
X! For example, applying + computes the sum of vector elements."
X    (interactive)
X    (calc-wrapper
X!    (let* ((calc-dollar-values (mapcar 'car-safe
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X! 	  (oper (or oper (calc-get-operator "Reduce" 2))))
X       (message "Working...")
X       (calc-set-command-flag 'clear-message)
X       (calc-enter-result (1+ calc-dollar-used)
X! 			(concat (substring "red" 0 (- 4 (length (nth 2 oper))))
X  				(nth 2 oper))
X! 			(list (intern (concat "calcFunc-reduce"
X! 					      (or calc-mapping-dir "")))
X  			      (math-calcFunc-to-var (nth 1 oper))
X  			      (calc-top-n (1+ calc-dollar-used))))))
X  )
X--- 8065,8091 ----
X  
X  (defun calc-reduce (&optional oper)
X    "Apply a binary operator across all elements of a vector.
X! For example, applying + computes the sum of vector elements.
X! With Hyperbolic flag, accumulate intermediate results into a vector."
X    (interactive)
X    (calc-wrapper
X!    (let* ((sel-mode nil)
X! 	  (accum (calc-is-hyperbolic))
X! 	  (calc-dollar-values (mapcar 'calc-get-stack-element
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X! 	  (oper (or oper (calc-get-operator (if accum "Accumulate" "Reduce")
X! 					    2))))
X       (message "Working...")
X       (calc-set-command-flag 'clear-message)
X       (calc-enter-result (1+ calc-dollar-used)
X! 			(concat (substring (if accum "acc" "red")
X! 					   0 (- 4 (length (nth 2 oper))))
X  				(nth 2 oper))
X! 			(list (if accum
X! 				  'calcFunc-accum
X! 				(intern (concat "calcFunc-reduce"
X! 						(or calc-mapping-dir ""))))
X  			      (math-calcFunc-to-var (nth 1 oper))
X  			      (calc-top-n (1+ calc-dollar-used))))))
X  )
X***************
X*** 4456,4462 ****
X  For example, applying * computes a vector of products."
X    (interactive)
X    (calc-wrapper
X!    (let* ((calc-dollar-values (mapcar 'car-safe
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X  	  (oper (or oper (calc-get-operator "Map")))
X--- 8095,8102 ----
X  For example, applying * computes a vector of products."
X    (interactive)
X    (calc-wrapper
X!    (let* ((sel-mode nil)
X! 	  (calc-dollar-values (mapcar 'calc-get-stack-element
X  				      (nthcdr calc-stack-top calc-stack)))
X  	  (calc-dollar-used 0)
X  	  (oper (or oper (calc-get-operator "Map")))
X***************
X*** 4477,4493 ****
X  				     (1+ calc-dollar-used)))))))
X  )
X  
X  ;;; Return a list of the form (nargs func name)
X  (defun calc-get-operator (msg &optional nargs)
X    (let ((inv nil) (hyp nil) (prefix nil)
X  	done key oper (which 0)
X  	(msgs '( "(Press ? for help)"
X! 		 "+, -, *, /, ^, %, \\, :, !, |, Neg"
X  		 "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt"
X  		 "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB"
X! 		 "Binary + And, Or, Xor, Diff; Not, Clip"
X  		 "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction"
X! 		 "Kombinatorics + Dfact, Lcm, Gcd, Binomial, Perms; Random"
X  		 "Matrix-dir + Elements, Rows, Cols, Across, Down"
X  		 "X or Z = any function by name; ' = alg entry; $ = stack")))
X      (while (not done)
X--- 8117,8181 ----
X  				     (1+ calc-dollar-used)))))))
X  )
X  
X+ (defun calc-outer-product (&optional oper)
X+   "Compute the generalized outer product of two vectors.
X+ For example, using * produces a multiplication table."
X+   (interactive)
X+   (calc-wrapper
X+    (let* ((sel-mode nil)
X+ 	  (calc-dollar-values (mapcar 'calc-get-stack-element
X+ 				      (nthcdr calc-stack-top calc-stack)))
X+ 	  (calc-dollar-used 0)
X+ 	  (oper (or oper (calc-get-operator "Outer" 2))))
X+      (message "Working...")
X+      (calc-set-command-flag 'clear-message)
X+      (calc-enter-result (+ 2 calc-dollar-used)
X+ 			(concat (substring "out" 0 (- 4 (length (nth 2 oper))))
X+ 				(nth 2 oper))
X+ 			(cons 'calcFunc-outer
X+ 			      (cons (math-calcFunc-to-var (nth 1 oper))
X+ 				    (calc-top-list-n
X+ 				     2 (1+ calc-dollar-used)))))))
X+ )
X+ 
X+ (defun calc-inner-product (&optional mul-oper add-oper)
X+   "Compute the generalized inner product of two vectors or matrices.
X+ You specify the multiplicative and additive operators or functions to use.
X+ For example, using * and + respectively does a matrix multiplication."
X+   (interactive)
X+   (calc-wrapper
X+    (let* ((sel-mode nil)
X+ 	  (calc-dollar-values (mapcar 'calc-get-stack-element
X+ 				      (nthcdr calc-stack-top calc-stack)))
X+ 	  (calc-dollar-used 0)
X+ 	  (mul-oper (or mul-oper (calc-get-operator "Inner (Mult)" 2)))
X+ 	  (add-oper (or add-oper (calc-get-operator "Inner (Add)" 2))))
X+      (message "Working...")
X+      (calc-set-command-flag 'clear-message)
X+      (calc-enter-result (+ 2 calc-dollar-used)
X+ 			(concat "in"
X+ 				(substring (nth 2 mul-oper) 0 1)
X+ 				(substring (nth 2 add-oper) 0 1))
X+ 			(nconc (list 'calcFunc-inner
X+ 				     (math-calcFunc-to-var (nth 1 mul-oper))
X+ 				     (math-calcFunc-to-var (nth 1 add-oper)))
X+ 			       (calc-top-list-n 2 (1+ calc-dollar-used))))))
X+ )
X+ 
X  ;;; Return a list of the form (nargs func name)
X  (defun calc-get-operator (msg &optional nargs)
X    (let ((inv nil) (hyp nil) (prefix nil)
X  	done key oper (which 0)
X  	(msgs '( "(Press ? for help)"
X! 		 "+, -, *, /, ^, %, \\, :, &, !, |, Neg"
X  		 "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt"
X  		 "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB"
X! 		 "Algebra + Simp, Esimp, Deriv, Integ, !, =, etc."
X! 		 "Binary + And, Or, Xor, Diff; l/r/t/L/R shifts; Not, Clip"
X  		 "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction"
X! 		 "Functions + Re, Im; Hypot; Mant, Expon, Scale; etc."
X! 		 "Kombinatorics + Dfact, Lcm, Gcd, Choose; Random; etc."
X! 		 "Vectors + Length, Row, Col, Diag, Mask, etc."
X  		 "Matrix-dir + Elements, Rows, Cols, Across, Down"
X  		 "X or Z = any function by name; ' = alg entry; $ = stack")))
X      (while (not done)
X***************
X*** 4506,4522 ****
X  	     (keyboard-quit))
X  	    ((= key ??)
X  	     (setq which (% (1+ which) (length msgs))))
X! 	    ((= key ?I)
X! 	     (setq inv (not inv)
X! 		   prefix nil))
X! 	    ((= key ?H)
X! 	     (setq hyp (not hyp)
X! 		   prefix nil))
X  	    ((eq key prefix)
X  	     (setq prefix nil))
X! 	    ((and (memq key '(?b ?c ?k ?m)) (null prefix))
X! 	     (setq inv nil hyp nil
X! 		   prefix key))
X  	    ((eq prefix ?m)
X  	     (setq prefix nil)
X  	     (if (eq key ?e)
X--- 8194,8207 ----
X  	     (keyboard-quit))
X  	    ((= key ??)
X  	     (setq which (% (1+ which) (length msgs))))
X! 	    ((and (= key ?I) (null prefix))
X! 	     (setq inv (not inv)))
X! 	    ((and (= key ?H) (null prefix))
X! 	     (setq hyp (not hyp)))
X  	    ((eq key prefix)
X  	     (setq prefix nil))
X! 	    ((and (memq key '(?a ?b ?c ?f ?k ?m ?v ?V)) (null prefix))
X! 	     (setq prefix (downcase key)))
X  	    ((eq prefix ?m)
X  	     (setq prefix nil)
X  	     (if (eq key ?e)
X***************
X*** 4562,4576 ****
X  					   arglist)
X  					  expr))
X  		       done t))))
X! 	    ((setq oper (assq key (cond ((eq prefix ?b) calc-b-oper-keys)
X! 					((eq prefix ?c) calc-c-oper-keys)
X! 					((eq prefix ?k) calc-k-oper-keys)
X! 					(inv (if hyp
X! 						 calc-inv-hyp-oper-keys
X! 					       calc-inv-oper-keys))
X! 					(t (if hyp
X! 					       calc-hyp-oper-keys
X! 					     calc-oper-keys)))))
X  	     (if (eq (nth 1 oper) 'user)
X  		 (let ((func (intern
X  			      (completing-read "Function name: "
X--- 8247,8260 ----
X  					   arglist)
X  					  expr))
X  		       done t))))
X! 	    ((setq oper (assq key (nth (if inv (if hyp 3 1) (if hyp 2 0))
X! 				       (cond ((eq prefix ?a) calc-a-oper-keys)
X! 					     ((eq prefix ?b) calc-b-oper-keys)
X! 					     ((eq prefix ?c) calc-c-oper-keys)
X! 					     ((eq prefix ?f) calc-f-oper-keys)
X! 					     ((eq prefix ?k) calc-k-oper-keys)
X! 					     ((eq prefix ?v) calc-v-oper-keys)
X! 					     (t calc-oper-keys)))))
X  	     (if (eq (nth 1 oper) 'user)
X  		 (let ((func (intern
X  			      (completing-read "Function name: "
X***************
X*** 4612,4703 ****
X  	 (error "Must be a %d-argument operator" nargs))
X      (append (cdr oper)
X  	    (list
X! 	     (concat (if prefix (char-to-string prefix) "")
X! 		     (if inv "I" "") (if hyp "H" "")
X! 		     (char-to-string key)))))
X! )
X! 
X! (defconst calc-oper-keys '( ( ?+ 2 calcFunc-add )
X! 			    ( ?- 2 calcFunc-sub )
X! 			    ( ?* 2 calcFunc-mul )
X! 			    ( ?/ 2 calcFunc-div )
X! 			    ( ?^ 2 calcFunc-pow )
X! 			    ( ?| 2 calcFunc-vconcat )
X! 			    ( ?% 2 calcFunc-mod )
X! 			    ( ?\\ 2 calcFunc-idiv )
X! 			    ( ?: 2 calcFunc-fdiv )
X! 			    ( ?! 1 calcFunc-fact )
X! 			    ( ?n 1 calcFunc-neg )
X! 			    ( ?x user )
X! 			    ( ?z user )
X! 			    ( ?A 1 calcFunc-abs )
X! 			    ( ?J 1 calcFunc-conj )
X! 			    ( ?G 1 calcFunc-arg )
X! 			    ( ?Q 1 calcFunc-sqrt )
X! 			    ( ?N 2 calcFunc-min )
X! 			    ( ?X 2 calcFunc-max )
X! 			    ( ?F 1 calcFunc-floor )
X! 			    ( ?R 1 calcFunc-round )
X! 			    ( ?S 1 calcFunc-sin )
X! 			    ( ?C 1 calcFunc-cos )
X! 			    ( ?T 1 calcFunc-tan )
X! 			    ( ?L 1 calcFunc-ln )
X! 			    ( ?E 1 calcFunc-exp )
X! 			    ( ?B 2 calcFunc-log )
X! ))
X! (defconst calc-b-oper-keys '( ( ?a 2 calcFunc-and )
X! 			      ( ?o 2 calcFunc-or )
X! 			      ( ?x 2 calcFunc-xor )
X! 			      ( ?d 2 calcFunc-diff )
X! 			      ( ?n 1 calcFunc-not )
X! 			      ( ?c 1 calcFunc-clip )
X! 			      ( ?l 2 calcFunc-lsh )
X! 			      ( ?r 2 calcFunc-rsh )
X! 			      ( ?L 2 calcFunc-ash )
X! 			      ( ?R 2 calcFunc-rash )
X! 			      ( ?t 2 calcFunc-rot )
X! ))
X! (defconst calc-c-oper-keys '( ( ?d 1 calcFunc-deg )
X! 			      ( ?r 1 calcFunc-rad )
X! 			      ( ?h 1 calcFunc-hms )
X! 			      ( ?f 1 calcFunc-float )
X! 			      ( ?F 1 calcFunc-frac )
X! ))
X! (defconst calc-k-oper-keys '( ( ?g 2 calcFunc-gcd )
X! 			      ( ?l 2 calcFunc-lcm )
X! 			      ( ?b 2 calcFunc-choose )
X! 			      ( ?d 1 calcFunc-dfact )
X! 			      ( ?m 1 calcFunc-moebius )
X! 			      ( ?p 2 calcFunc-perm )
X! 			      ( ?r 1 calcFunc-random )
X! 			      ( ?t 1 calcFunc-totient )
X! ))
X! (defconst calc-inv-oper-keys '( ( ?F 1 calcFunc-ceil )
X! 				( ?R 1 calcFunc-trunc )
X! 				( ?Q 1 calcFunc-sqr )
X! 				( ?S 1 calcFunc-arcsin )
X! 				( ?C 1 calcFunc-arccos )
X! 				( ?T 1 calcFunc-arctan )
X! 				( ?L 1 calcFunc-exp )
X! 				( ?E 1 calcFunc-ln )
X! ))
X! (defconst calc-hyp-oper-keys '( ( ?F 1 calcFunc-ffloor )
X! 				( ?R 1 calcFunc-fround )
X! 				( ?S 1 calcFunc-sinh )
X! 				( ?C 1 calcFunc-cosh )
X! 				( ?T 1 calcFunc-tanh )
X! 				( ?L 1 calcFunc-log10 )
X! 				( ?E 1 calcFunc-exp10 )
X! ))
X! (defconst calc-inv-hyp-oper-keys '( ( ?F 1 calcFunc-fceil )
X! 				    ( ?R 1 calcFunc-ftrunc )
X! 				    ( ?S 1 calcFunc-arcsinh )
X! 				    ( ?C 1 calcFunc-arccosh )
X! 				    ( ?T 1 calcFunc-arctanh )
X! 				    ( ?L 1 calcFunc-exp10 )
X! 				    ( ?E 1 calcFunc-log10 )
X! ))
X! 
X  
X  
X  
X--- 8296,8488 ----
X  	 (error "Must be a %d-argument operator" nargs))
X      (append (cdr oper)
X  	    (list
X! 	     (let ((name (concat (if inv "I" "") (if hyp "H" "")
X! 				 (if prefix (char-to-string prefix) "")
X! 				 (char-to-string key))))
X! 	       (if (> (length name) 3)
X! 		   (substring name 0 3)
X! 		 name)))))
X! )
X! 
X! (defconst calc-oper-keys '( ( ( ?+ 2 calcFunc-add )
X! 			      ( ?- 2 calcFunc-sub )
X! 			      ( ?* 2 calcFunc-mul )
X! 			      ( ?/ 2 calcFunc-div )
X! 			      ( ?^ 2 calcFunc-pow )
X! 			      ( ?| 2 calcFunc-vconcat )
X! 			      ( ?% 2 calcFunc-mod )
X! 			      ( ?\\ 2 calcFunc-idiv )
X! 			      ( ?: 2 calcFunc-fdiv )
X! 			      ( ?! 1 calcFunc-fact )
X! 			      ( ?& 1 calcFunc-inv )
X! 			      ( ?n 1 calcFunc-neg )
X! 			      ( ?x user )
X! 			      ( ?z user )
X! 			      ( ?A 1 calcFunc-abs )
X! 			      ( ?J 1 calcFunc-conj )
X! 			      ( ?G 1 calcFunc-arg )
X! 			      ( ?Q 1 calcFunc-sqrt )
X! 			      ( ?N 2 calcFunc-min )
X! 			      ( ?X 2 calcFunc-max )
X! 			      ( ?F 1 calcFunc-floor )
X! 			      ( ?R 1 calcFunc-round )
X! 			      ( ?S 1 calcFunc-sin )
X! 			      ( ?C 1 calcFunc-cos )
X! 			      ( ?T 1 calcFunc-tan )
X! 			      ( ?L 1 calcFunc-ln )
X! 			      ( ?E 1 calcFunc-exp )
X! 			      ( ?B 2 calcFunc-log ) )
X! 			    ( ( ?F 1 calcFunc-ceil )     ; inverse
X! 			      ( ?R 1 calcFunc-trunc )
X! 			      ( ?Q 1 calcFunc-sqr )
X! 			      ( ?S 1 calcFunc-arcsin )
X! 			      ( ?C 1 calcFunc-arccos )
X! 			      ( ?T 1 calcFunc-arctan )
X! 			      ( ?L 1 calcFunc-exp )
X! 			      ( ?E 1 calcFunc-ln )
X! 			      ( ?B 2 calcFunc-alog )
X! 			      ( ?^ 2 calcFunc-nroot ) )
X! 			    ( ( ?F 1 calcFunc-ffloor )   ; hyperbolic
X! 			      ( ?R 1 calcFunc-fround )
X! 			      ( ?S 1 calcFunc-sinh )
X! 			      ( ?C 1 calcFunc-cosh )
X! 			      ( ?T 1 calcFunc-tanh )
X! 			      ( ?L 1 calcFunc-log10 )
X! 			      ( ?E 1 calcFunc-exp10 ) )
X! 			    ( ( ?F 1 calcFunc-fceil )    ; inverse-hyperbolic
X! 			      ( ?R 1 calcFunc-ftrunc )
X! 			      ( ?S 1 calcFunc-arcsinh )
X! 			      ( ?C 1 calcFunc-arccosh )
X! 			      ( ?T 1 calcFunc-arctanh )
X! 			      ( ?L 1 calcFunc-exp10 )
X! 			      ( ?E 1 calcFunc-log10 ) )
X! ))
X! (defconst calc-a-oper-keys '( ( ( ?s 1 calcFunc-simplify )
X! 				( ?e 1 calcFunc-esimplify )
X! 				( ?d 2 calcFunc-deriv )
X! 				( ?i 2 calcFunc-integ )
X! 				( ?S 2 calcFunc-solve )
X! 				( ?= 2 calcFunc-eq )
X! 				( ?\# 2 calcFunc-neq )
X! 				( ?< 2 calcFunc-lt )
X! 				( ?> 2 calcFunc-gt )
X! 				( ?\[ 2 calcFunc-leq )
X! 				( ?\] 2 calcFunc-geq )
X! 				( ?{ 2 calcFunc-in )
X! 				( ?! 1 calcFunc-lnot )
X! 				( ?& 2 calcFunc-land )
X! 				( ?\| 2 calcFunc-lor )
X! 				( ?: 3 calcFunc-if ) )
X! 			      ( ( ?S 2 calcFunc-finv ) )
X! 			      ( ( ?S 2 calcFunc-fsolve ) )
X! 			      ( ( ?S 2 calcFunc-ffinv ) )
X! ))
X! (defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and )
X! 				( ?o 2 calcFunc-or )
X! 				( ?x 2 calcFunc-xor )
X! 				( ?d 2 calcFunc-diff )
X! 				( ?n 1 calcFunc-not )
X! 				( ?c 1 calcFunc-clip )
X! 				( ?l 2 calcFunc-lsh )
X! 				( ?r 2 calcFunc-rsh )
X! 				( ?L 2 calcFunc-ash )
X! 				( ?R 2 calcFunc-rash )
X! 				( ?t 2 calcFunc-rot ) )
X! ))
X! (defconst calc-c-oper-keys '( ( ( ?d 1 calcFunc-deg )
X! 				( ?r 1 calcFunc-rad )
X! 				( ?h 1 calcFunc-hms )
X! 				( ?f 1 calcFunc-float )
X! 				( ?F 1 calcFunc-frac ) )
X! ))
X! (defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta )
X! 				( ?e 1 calcFunc-erf )
X! 				( ?g 1 calcFunc-gamma )
X! 				( ?h 2 calcFunc-hypot )
X! 				( ?i 1 calcFunc-im )
X! 				( ?j 2 calcFunc-besJ )
X! 				( ?n 2 calcFunc-min )
X! 				( ?r 1 calcFunc-re )
X! 				( ?s 1 calcFunc-sign )
X! 				( ?x 2 calcFunc-max )
X! 				( ?y 2 calcFunc-besY )
X! 				( ?A 1 calcFunc-abssqr )
X! 				( ?B 3 calcFunc-betaI )
X! 				( ?E 1 calcFunc-expm1 )
X! 				( ?G 2 calcFunc-gammaP )
X! 				( ?I 2 calcFunc-ilog )
X! 				( ?L 1 calcFunc-lnp1 )
X! 				( ?M 1 calcFunc-mant )
X! 				( ?Q 1 calcFunc-isqrt )
X! 				( ?S 1 calcFunc-scf )
X! 				( ?T 2 calcFunc-arctan2 )
X! 				( ?X 1 calcFunc-xpon )
X! 				( ?\[ 2 calcFunc-decr )
X! 				( ?\] 2 calcFunc-incr ) )
X! 			      ( ( ?e 1 calcFunc-erfc )
X! 				( ?E 1 calcFunc-lnp1 )
X! 				( ?G 2 calcFunc-gammaQ )
X! 				( ?L 1 calcFunc-expm1 ) )
X! 			      ( ( ?B 3 calcFunc-betaB )
X! 				( ?G 2 calcFunc-gammag) )
X! 			      ( ( ?G 2 calcFunc-gammaG ) )
X! ))
X! (defconst calc-k-oper-keys '( ( ( ?b 1 calcFunc-bern )
X! 				( ?c 2 calcFunc-choose )
X! 				( ?d 1 calcFunc-dfact )
X! 				( ?e 1 calcFunc-euler )
X! 				( ?f 1 calcFunc-prfac )
X! 				( ?g 2 calcFunc-gcd )
X! 				( ?h 2 calcFunc-shuffle )
X! 				( ?l 2 calcFunc-lcm )
X! 				( ?m 1 calcFunc-moebius )
X! 				( ?n 1 calcFunc-nextprime )
X! 				( ?r 1 calcFunc-random )
X! 				( ?s 2 calcFunc-stir1 )
X! 				( ?t 1 calcFunc-totient )
X! 				( ?B 3 calcFunc-utpb )
X! 				( ?C 2 calcFunc-utpc )
X! 				( ?F 3 calcFunc-utpf )
X! 				( ?N 3 calcFunc-utpn )
X! 				( ?P 2 calcFunc-utpp )
X! 				( ?T 2 calcFunc-utpt ) )
X! 			      ( ( ?n 1 calcFunc-prevprime )
X! 				( ?B 3 calcFunc-ltpb )
X! 				( ?C 2 calcFunc-ltpc )
X! 				( ?F 3 calcFunc-ltpf )
X! 				( ?N 3 calcFunc-ltpn )
X! 				( ?P 2 calcFunc-ltpp )
X! 				( ?T 2 calcFunc-ltpt ) )
X! 			      ( ( ?b 2 calcFunc-bern )
X! 				( ?c 2 calcFunc-perm )
X! 				( ?e 2 calcFunc-euler )
X! 				( ?s 2 calcFunc-stir2 ) )
X! ))
X! (defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange )
X! 				( ?b 2 calcFunc-cvec )
X! 				( ?c 2 calcFunc-mcol )
X! 				( ?d 2 calcFunc-diag )
X! 				( ?e 2 calcFunc-vexp )
X! 				( ?f 2 calcFunc-find )
X! 				( ?l 1 calcFunc-vlen )
X! 				( ?m 2 calcFunc-vmask )
X! 				( ?n 1 calcFunc-rnorm )
X! 				( ?r 2 calcFunc-mrow )
X! 				( ?s 3 calcFunc-subvec )
X! 				( ?t 1 calcFunc-trn )
X! 				( ?x 1 calcFunc-index )
X! 				( ?D 1 calcFunc-det )
X! 				( ?C 1 calcFunc-cross )
X! 				( ?G 1 calcFunc-grade )
X! 				( ?H 2 calcFunc-histogram )
X! 				( ?N 1 calcFunc-cnorm )
X! 				( ?S 1 calcFunc-sort )
X! 				( ?T 1 calcFunc-tr ) )
X! 			      ( ( ?G 1 calcFunc-rgrade )
X! 				( ?S 1 calcFunc-rsort ) )
X! 			      ( ( ?e 3 calcFunc-vexp )
X! 				( ?H 3 calcFunc-histogram ) )
X! ))
X  
X  
X  
X***************
X*** 4918,4923 ****
X--- 8703,8709 ----
X  			 "Leave it symbolic for non-constant arguments? ")))
X       (if cmd
X  	 (progn
X+ 	   (calc-need-macros)
X  	   (fset cmd
X  		 (list 'lambda
X  		       '()
X***************
X*** 4959,4965 ****
X    (if (consp form)
X        (if (eq (car form) 'var)
X  	  (if (or (memq (nth 1 form) arglist)
X! 		  (boundp (nth 2 form)))
X  	      ()
X  	    (setq arglist (cons (nth 1 form) arglist)))
X  	(calc-default-formula-arglist-step (cdr form))))
X--- 8745,8751 ----
X    (if (consp form)
X        (if (eq (car form) 'var)
X  	  (if (or (memq (nth 1 form) arglist)
X! 		  (calc-var-value (nth 2 form)))
X  	      ()
X  	    (setq arglist (cons (nth 1 form) arglist)))
X  	(calc-default-formula-arglist-step (cdr form))))
X***************
X*** 5030,5036 ****
X  			'(arg)
X  			'(interactive "P")
X  			(list 'calc-execute-kbd-macro
X! 			      last-kbd-macro
X  			      'arg))))
X        (let* ((kmap (calc-user-key-map))
X  	     (old (assq key kmap)))
X--- 8816,8823 ----
X  			'(arg)
X  			'(interactive "P")
X  			(list 'calc-execute-kbd-macro
X! 			      (vector (key-description last-kbd-macro)
X! 				      last-kbd-macro)
X  			      'arg))))
X        (let* ((kmap (calc-user-key-map))
X  	     (old (assq key kmap)))
X***************
X*** 5075,5095 ****
X  				  (lambda (cmd)
X  				    (if (stringp (symbol-function cmd))
X  					(symbol-function cmd)
X! 				      (nth 1 (nth 3 (symbol-function cmd))))))
X  				 (function
X  				  (lambda (new cmd)
X  				    (if (stringp (symbol-function cmd))
X  					(fset cmd new)
X! 				      (setcar (cdr (nth 3 (symbol-function
X! 							   cmd)))
X! 					      new))))))
X! 	     (calc-wrapper
X! 	      (calc-edit-mode (list 'calc-finish-macro-edit
X! 				    (list 'quote def)))
X! 	      (insert (if (stringp cmd)
X! 			  cmd
X! 			(nth 1 (nth 3 cmd)))))
X! 	     (calc-show-edit-buffer)))
X  	  (t (let* ((func (calc-stack-command-p cmd))
X  		    (defn (and func
X  			       (symbolp func)
X--- 8862,8919 ----
X  				  (lambda (cmd)
X  				    (if (stringp (symbol-function cmd))
X  					(symbol-function cmd)
X! 				      (let ((mac (nth 1 (nth 3 (symbol-function
X! 								cmd)))))
X! 					(if (vectorp mac)
X! 					    (aref mac 1)
X! 					  mac)))))
X  				 (function
X  				  (lambda (new cmd)
X  				    (if (stringp (symbol-function cmd))
X  					(fset cmd new)
X! 				      (let ((mac (cdr (nth 3 (symbol-function
X! 							      cmd)))))
X! 					(if (vectorp (car mac))
X! 					    (progn
X! 					      (aset (car mac) 0
X! 						    (key-description new))
X! 					      (aset (car mac) 1 new))
X! 					  (setcar mac new))))))))
X! 	     (let ((keys (progn (and (fboundp 'edit-kbd-macro)
X! 				     (edit-kbd-macro nil))
X! 				(fboundp 'MacEdit-parse-keys))))
X! 	       (calc-wrapper
X! 		(calc-edit-mode (list 'calc-finish-macro-edit
X! 				      (list 'quote def)
X! 				      keys)
X! 				t)
X! 		(if keys
X! 		    (let (top
X! 			  (fill-column 70)
X! 			  (fill-prefix nil))
X! 		      (insert "Notations: RET, SPC, TAB, DEL, LFD, NUL"
X! 			      ", C-xxx, M-xxx.\n\n")
X! 		      (setq top (point))
X! 		      (insert (if (stringp cmd)
X! 				  (key-description cmd)
X! 				(if (vectorp (nth 1 (nth 3 cmd)))
X! 				    (aref (nth 1 (nth 3 cmd)) 0)
X! 				  (key-description (nth 1 (nth 3 cmd)))))
X! 			      "\n")
X! 		      (if (>= (prog2 (forward-char -1)
X! 				     (current-column)
X! 				     (forward-char 1))
X! 			      (screen-width))
X! 			  (fill-region top (point))))
X! 		  (insert "Press C-q to quote control characters like RET"
X! 			  " and TAB.\n"
X! 			  (if (stringp cmd)
X! 			      cmd
X! 			    (if (vectorp (nth 1 (nth 3 cmd)))
X! 				(aref (nth 1 (nth 3 cmd)) 1)
X! 			      (nth 1 (nth 3 cmd)))))))
X! 	       (calc-show-edit-buffer)
X! 	       (forward-line (if keys 2 1)))))
X  	  (t (let* ((func (calc-stack-command-p cmd))
X  		    (defn (and func
X  			       (symbolp func)
X***************
X*** 5099,5115 ****
X  		     (calc-wrapper
X  		      (calc-edit-mode (list 'calc-finish-formula-edit
X  					    (list 'quote func)))
X! 		      (insert (math-format-flat-expr defn 0) "\n"))
X  		     (calc-show-edit-buffer))
X  		 (error "That command's definition cannot be edited"))))))
X  )
X  
X! (defun calc-finish-macro-edit (def)
X!   (let ((str (buffer-substring (point) (point-max))))
X      (if (symbolp (cdr def))
X  	(if (stringp (symbol-function (cdr def)))
X  	    (fset (cdr def) str)
X! 	  (setcar (cdr (nth 3 (symbol-function (cdr def)))) str))
X        (setcdr def str)))
X  )
X  
X--- 8923,8949 ----
X  		     (calc-wrapper
X  		      (calc-edit-mode (list 'calc-finish-formula-edit
X  					    (list 'quote func)))
X! 		      (insert (math-format-nice-expr defn (screen-width))
X! 			      "\n"))
X  		     (calc-show-edit-buffer))
X  		 (error "That command's definition cannot be edited"))))))
X  )
X  
X! (defun calc-finish-macro-edit (def keys)
X!   (forward-line 1)
X!   (if (and keys (looking-at "\n")) (forward-line 1))
X!   (let* ((true-str (buffer-substring (point) (point-max)))
X! 	 (str true-str))
X!     (if keys (setq str (MacEdit-parse-keys str)))
X      (if (symbolp (cdr def))
X  	(if (stringp (symbol-function (cdr def)))
X  	    (fset (cdr def) str)
X! 	  (let ((mac (cdr (nth 3 (symbol-function (cdr def))))))
X! 	    (if (vectorp (car mac))
X! 		(progn
X! 		  (aset (car mac) 0 (if keys true-str (key-description str)))
X! 		  (aset (car mac) 1 str))
X! 	      (setcar mac str))))
X        (setcdr def str)))
X  )
X  
X***************
X*** 5191,5197 ****
X  	  (insert "\"\n"))))
X  )
X  (put 'calc-algebraic-entry 'MacEdit-print 'calc-macro-edit-algebraic)
X- (put 'calc-dollar-sign 'MacEdit-print 'calc-macro-edit-algebraic)
X  
X  (defun calc-macro-edit-variable ()
X    (let ((str "") ch)
X--- 9025,9030 ----
X***************
X*** 5285,5300 ****
X       (let* ((cmd (cdr def))
X  	    (fcmd (and cmd (symbolp cmd) (symbol-function cmd)))
X  	    (pt (point))
X! 	    (fill-column 70))
X         (if (and fcmd
X  		(eq (car-safe fcmd) 'lambda)
X  		(get cmd 'calc-user-defn))
X  	   (progn
X! 	     (insert (prin1-to-string
X! 		      (cons 'defun (cons cmd (cdr fcmd))))
X  		     "\n")
X! 	     (fill-region pt (point))
X! 	     (indent-rigidly pt (point) 3)
X  	     (delete-region pt (1+ pt))
X  	     (let* ((func (calc-stack-command-p cmd))
X  		    (ffunc (and func (symbolp func) (symbol-function func)))
X--- 9118,9143 ----
X       (let* ((cmd (cdr def))
X  	    (fcmd (and cmd (symbolp cmd) (symbol-function cmd)))
X  	    (pt (point))
X! 	    (fill-column 70)
X! 	    (fill-prefix nil)
X! 	    str q-ok)
X         (if (and fcmd
X  		(eq (car-safe fcmd) 'lambda)
X  		(get cmd 'calc-user-defn))
X  	   (progn
X! 	     (and (eq (car-safe (nth 3 fcmd)) 'calc-execute-kbd-macro)
X! 		  (vectorp (nth 1 (nth 3 fcmd)))
X! 		  (progn (and (fboundp 'edit-kbd-macro)
X! 			      (edit-kbd-macro nil))
X! 			 (fboundp 'MacEdit-parse-keys))
X! 		  (setq q-ok t)
X! 		  (aset (nth 1 (nth 3 fcmd)) 1 nil))
X! 	     (insert (setq str (prin1-to-string
X! 				(cons 'defun (cons cmd (cdr fcmd)))))
X  		     "\n")
X! 	     (or (and (string-match "\"" str) (not q-ok))
X! 		 (progn (fill-region pt (point))
X! 			(indent-rigidly pt (point) 3)))
X  	     (delete-region pt (1+ pt))
X  	     (let* ((func (calc-stack-command-p cmd))
X  		    (ffunc (and func (symbolp func) (symbol-function func)))
X***************
X*** 5303,5313 ****
X  		    (eq (car-safe ffunc) 'lambda)
X  		    (get func 'calc-user-defn)
X  		    (progn
X! 		      (insert (prin1-to-string
X! 			       (cons 'defun (cons func (cdr ffunc))))
X  			      "\n")
X! 		      (fill-region pt (point))
X! 		      (indent-rigidly pt (point) 3)
X  		      (delete-region pt (1+ pt))))))
X  	 (and (stringp fcmd)
X  	      (insert "  (fset '" (prin1-to-string cmd)
X--- 9146,9158 ----
X  		    (eq (car-safe ffunc) 'lambda)
X  		    (get func 'calc-user-defn)
X  		    (progn
X! 		      (insert (setq str (prin1-to-string
X! 					 (cons 'defun (cons func
X! 							    (cdr ffunc)))))
X  			      "\n")
X! 		      (or (and (string-match "\"" str) (not q-ok))
X! 			  (progn (fill-region pt (point))
X! 				 (indent-rigidly pt (point) 3)))
X  		      (delete-region pt (1+ pt))))))
X  	 (and (stringp fcmd)
X  	      (insert "  (fset '" (prin1-to-string cmd)
X***************
X*** 5356,5363 ****
X  	 (mapatoms (function
X  		    (lambda (x)
X  		      (and (string-match "\\`var-" (symbol-name x))
X! 			   (boundp x)
X! 			   (symbol-value x)
X  			   (not (eq (car-safe (symbol-value x))
X  				    'special-const))
X  			   (calc-insert-permanent-variable x)))))
X--- 9201,9207 ----
X  	 (mapatoms (function
X  		    (lambda (x)
X  		      (and (string-match "\\`var-" (symbol-name x))
X! 			   (calc-var-value x)
X  			   (not (eq (car-safe (symbol-value x))
X  				    'special-const))
X  			   (calc-insert-permanent-variable x)))))
X***************
X*** 5388,5394 ****
X  	    (symbol-name var)
X  	    " ')\n")
X      (backward-char 2))
X!   (insert (prin1-to-string (symbol-value var)))
X    (forward-line 1)
X  )
X  
X--- 9232,9238 ----
X  	    (symbol-name var)
X  	    " ')\n")
X      (backward-char 2))
X!   (insert (prin1-to-string (calc-var-value var)))
X    (forward-line 1)
X  )
X  
X***************
X*** 5401,5408 ****
X      (mapatoms (function
X  	       (lambda (x)
X  		 (and (string-match "\\`var-" (symbol-name x))
X! 		      (boundp x)
X! 		      (symbol-value x)
X  		      (not (eq (car-safe (symbol-value x)) 'special-const))
X  		      (insert "(setq "
X  			      (symbol-name x)
X--- 9245,9251 ----
X      (mapatoms (function
X  	       (lambda (x)
X  		 (and (string-match "\\`var-" (symbol-name x))
X! 		      (calc-var-value x)
X  		      (not (eq (car-safe (symbol-value x)) 'special-const))
X  		      (insert "(setq "
X  			      (symbol-name x)
X***************
X*** 5426,5431 ****
X--- 9269,9279 ----
X  )
X  
X  (defun calc-execute-kbd-macro (mac arg)
X+   (if (vectorp mac)
X+       (setq mac (or (aref mac 1)
X+ 		    (aset mac 1 (progn (and (fboundp 'edit-kbd-macro)
X+ 					    (edit-kbd-macro nil))
X+ 				       (MacEdit-parse-keys (aref mac 0)))))))
X    (if (< (prefix-numeric-value arg) 0)
X        (execute-kbd-macro mac (- (prefix-numeric-value arg)))
X      (if calc-executing-macro
X***************
X*** 5458,5467 ****
X  		   (delete-region (point) (point-max))
X  		   (while new-stack
X  		     (calc-record-undo (list 'push 1))
X! 		     (let ((fmt (math-format-stack-value
X! 				 (car (car new-stack)))))
X! 		       (setcar (cdr (car new-stack)) (calc-count-lines fmt))
X! 		       (insert fmt "\n"))
X  		     (setq new-stack (cdr new-stack)))
X  		   (calc-renumber-stack))
X  	       (while new-stack
X--- 9306,9312 ----
X  		   (delete-region (point) (point-max))
X  		   (while new-stack
X  		     (calc-record-undo (list 'push 1))
X! 		     (insert (math-format-stack-value (car new-stack)) "\n")
X  		     (setq new-stack (cdr new-stack)))
X  		   (calc-renumber-stack))
X  	       (while new-stack
X***************
X*** 5471,5476 ****
X--- 9316,9337 ----
X  	     (calc-record-undo (list 'set 'saved-stack-top 0))))))))
X  )
X  
X+ (defun calc-push-list-in-macro (vals m sels)
X+   (let ((entry (list (car vals) 1 (car sels)))
X+ 	(mm (+ (or m 1) calc-stack-top)))
X+     (if (> mm 1)
X+ 	(setcdr (nthcdr (- mm 2) calc-stack)
X+ 		(cons entry (nthcdr (1- mm) calc-stack)))
X+       (setq calc-stack (cons entry calc-stack))))
X+ )
X+ 
X+ (defun calc-pop-stack-in-macro (n mm)
X+   (if (> mm 1)
X+       (setcdr (nthcdr (- mm 2) calc-stack)
X+ 	      (nthcdr (+ n mm -1) calc-stack))
X+     (setq calc-stack (nthcdr n calc-stack)))
X+ )
X+ 
X  
X  (defun calc-kbd-if ()
X    "An \"if\" statement in a Calc keyboard macro.
X***************
X*** 5678,5684 ****
X  )
X  
X  (defun calc-kbd-break ()
X!   "Break out of a keyboard macro, or out of a Z< Z> or Z{ Z} loop in a macro.
X  Usage:  cond  Z/    breaks only if cond is true.  Use \"1 Z/\" to break always."
X    (interactive)
X    (calc-wrapper
X--- 9539,9545 ----
X  )
X  
X  (defun calc-kbd-break ()
X!   "Break out of a keyboard macro, or out of a Z< Z>, Z{ Z}, or Z( Z) loop.
X  Usage:  cond  Z/    breaks only if cond is true.  Use \"1 Z/\" to break always."
X    (interactive)
X    (calc-wrapper
X***************
X*** 5714,5719 ****
X--- 9575,9581 ----
X  	  (calc-simplify-mode calc-simplify-mode)
X  	  (calc-mapping-dir calc-mapping-dir)
X  	  (calc-algebraic-mode calc-algebraic-mode)
X+ 	  (calc-incomplete-algebraic-mode calc-incomplete-algebraic-mode)
X  	  (calc-symbolic-mode calc-symbolic-mode)
X  	  (calc-prefer-frac calc-prefer-frac)
X  	  (calc-complex-mode calc-complex-mode)
X***************
X*** 5849,5854 ****
X--- 9711,9725 ----
X  (math-defcache math-pi-over-180 nil
X    (math-div-float (math-pi) '(float 18 1)))
X  
X+ (math-defcache math-sqrt-pi nil
X+   (math-sqrt-float (math-pi)))
X+ 
X+ (math-defcache math-sqrt-2 nil
X+   (math-sqrt-float '(float 2 0)))
X+ 
X+ (math-defcache math-sqrt-two-pi nil
X+   (math-sqrt-float (math-two-pi)))
X+ 
X  (math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21)
X    (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1))))
X  
X***************
X*** 5885,5890 ****
X--- 9756,9822 ----
X      (/= (% a 2) 0))
X  )
X  
X+ ;;; True if A is a small or big integer.  [P x] [Public]
X+ (defun math-integerp (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg)))
X+ )
X+ 
X+ ;;; True if A is (numerically) a non-negative integer.  [P N] [Public]
X+ (defun math-natnump (a)
X+   (or (natnump a)
X+       (eq (car-safe a) 'bigpos))
X+ )
X+ 
X+ ;;; True if A is a rational (or integer).  [P x] [Public]
X+ (defun math-ratp (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac)))
X+ )
X+ 
X+ ;;; True if A is a real (or rational).  [P x] [Public]
X+ (defun math-realp (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float)))
X+ )
X+ 
X+ ;;; True if A is a real or HMS form.  [P x] [Public]
X+ (defun math-anglep (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float hms)))
X+ )
X+ 
X+ ;;; True if A is a number of any kind.  [P x] [Public]
X+ (defun math-numberp (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float cplx polar)))
X+ )
X+ 
X+ ;;; True if A is a complex number or angle.  [P x] [Public]
X+ (defun math-scalarp (a)
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms)))
X+ )
X+ 
X+ ;;; True if A is a vector.  [P x] [Public]
X+ (defun math-vectorp (a)
X+   (eq (car-safe a) 'vec)
X+ )
X+ 
X+ ;;; True if A is any vector or scalar data object.  [P x]
X+ (defun math-objvecp (a)    ;  [Public]
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float cplx polar
X+ 				  hms sdev intv mod vec incomplete)))
X+ )
X+ 
X+ ;;; True if A is numerically (but not literally) an integer.  [P x] [Public]
X+ (defun math-messy-integerp (a)
X+   (cond
X+    ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
X+    ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a))))
X+ )
X+ 
X  ;;; True if A is numerically an integer.  [P x] [Public]
X  (defun math-num-integerp (a)
X    (or (Math-integerp a)
X***************
X*** 5959,5964 ****
X--- 9891,9908 ----
X  	 (= (car dims) (nth 1 dims))))
X  )
X  
X+ ;;; True if A is any scalar data object.  [P x]
X+ (defun math-objectp (a)    ;  [Public]
X+   (or (integerp a)
X+       (memq (car-safe a) '(bigpos bigneg frac float cplx
X+ 				  polar hms sdev intv mod)))
X+ )
X+ (defmacro Math-objectp (a)    ;  [Public]
X+   (` (or (not (consp (, a)))
X+ 	 (memq (car (, a))
X+ 	       '(bigpos bigneg frac float cplx polar hms sdev intv mod))))
X+ )
X+ 
X  ;;; True if A is any real scalar data object.  [P x]
X  (defun math-real-objectp (a)    ;  [Public]
X    (or (integerp a)
X***************
X*** 5965,5981 ****
X        (memq (car-safe a) '(bigpos bigneg frac float hms sdev intv mod)))
X  )
X  
X! ;;; True if A is an object not composed of sub-formulas .  [P x] [Public]
X! (defun math-primp (a)
X!   (or (integerp a)
X!       (memq (car-safe a) '(bigpos bigneg frac float cplx polar
X! 				  hms mod var)))
X! )
X! (defmacro Math-primp (a)
X!   (` (or (not (consp (, a)))
X! 	 (memq (car (, a)) '(bigpos bigneg frac float cplx polar
X! 				    hms mod var))))
X! )
X  
X  ;;; True if A is a constant or vector of constants.  [P x] [Public]
X  (defun math-constp (a)
X--- 9909,9915 ----
X        (memq (car-safe a) '(bigpos bigneg frac float hms sdev intv mod)))
X  )
X  
X! ;;; Math-primp moved up so calc-select stuff can use it.
X  
X  ;;; True if A is a constant or vector of constants.  [P x] [Public]
X  (defun math-constp (a)
X***************
X*** 6058,6063 ****
X--- 9992,10072 ----
X  )
X  
X  
X+ (defun math-normalize-fancy (a)
X+   (cond ((eq (car a) 'frac)
X+ 	 (math-make-frac (math-normalize (nth 1 a))
X+ 			 (math-normalize (nth 2 a))))
X+ 	((eq (car a) 'cplx)
X+ 	 (let ((real (math-normalize (nth 1 a)))
X+ 	       (imag (math-normalize (nth 2 a))))
X+ 	   (if (math-zerop imag) real (list 'cplx real imag))))
X+ 	((eq (car a) 'polar)
X+ 	 (math-normalize-polar a))
X+ 	((eq (car a) 'hms)
X+ 	 (math-normalize-hms a))
X+ 	((eq (car a) 'mod)
X+ 	 (math-normalize-mod a))
X+ 	((eq (car a) 'sdev)
X+ 	 (let ((x (math-normalize (nth 1 a)))
X+ 	       (s (math-normalize (nth 2 a))))
X+ 	   (if (or (and (Math-objectp x) (not (Math-anglep x)))
X+ 		   (and (Math-objectp s) (not (Math-anglep s))))
X+ 	       (list 'calcFunc-sdev x s)
X+ 	     (math-make-sdev x s))))
X+ 	((eq (car a) 'intv)
X+ 	 (let ((mask (math-normalize (nth 1 a)))
X+ 	       (lo (math-normalize (nth 2 a)))
X+ 	       (hi (math-normalize (nth 3 a))))
X+ 	   (if (or (and (Math-objectp lo) (not (Math-anglep lo)))
X+ 		   (and (Math-objectp hi) (not (Math-anglep hi))))
X+ 	       (list 'calcFunc-intv mask lo hi)
X+ 	     (math-make-intv mask lo hi))))
X+ 	((eq (car a) 'vec)
X+ 	 (cons 'vec (mapcar 'math-normalize (cdr a))))
X+ 	((eq (car a) 'quote)
X+ 	 (math-normalize (nth 1 a)))
X+ 	((eq (car a) 'special-const)
X+ 	 (calc-with-default-simplification
X+ 	  (math-normalize (nth 1 a))))
X+ 	((eq (car a) 'var)
X+ 	 (cons 'var (cdr a)))   ; need to re-cons for selection routines
X+ 	((eq (car a) 'calcFunc-if)
X+ 	 (math-normalize-logical-op a))
X+ 	((memq (car a) '(calcFunc-lambda calcFunc-quote))
X+ 	 (let ((calc-simplify-mode 'none))
X+ 	   (cons (car a) (mapcar 'math-normalize (cdr a)))))
X+ 	((or (integerp (car a)) (consp (car a)))
X+ 	 (if (null (cdr a))
X+ 	     (math-normalize (car a))
X+ 	   (error "Can't use multi-valued function in an expression"))))
X+ )
X+ 
X+ (defun math-normalize-nonstandard (a)
X+   (and (symbolp (car a))
X+        (or (eq calc-simplify-mode 'none)
X+ 	   (and (eq calc-simplify-mode 'num)
X+ 		(let ((aptr args))
X+ 		  (while (and aptr (or (math-scalarp (car aptr))
X+ 				       (eq (car-safe (car aptr))
X+ 					   'mod)))
X+ 		    (setq aptr (cdr aptr)))
X+ 		  aptr)))
X+        (cons (car a) args))
X+ )
X+ 
X+ 
X+ ;;; Normalize a bignum digit list by trimming high-end zeros.  [L l]
X+ (defun math-norm-bignum (a)
X+   (let ((digs a) (last nil))
X+     (while digs
X+       (or (eq (car digs) 0) (setq last digs))
X+       (setq digs (cdr digs)))
X+     (and last
X+ 	 (progn
X+ 	   (setcdr last nil)
X+ 	   a)))
X+ )
X+ 
X  (defun math-bignum-test (a)   ; [B N; B s; b b]
X    (if (consp a)
X        a
X***************
X*** 6105,6111 ****
X  	 (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
X  	((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
X  	 (if (math-lessp-float a b) -1 1))
X! 	((and (Math-anglep a) (Math-anglep b))
X  	 (math-sign (math-add a (math-neg b))))
X  	((eq (car-safe a) 'var)
X  	 2)
X--- 10114,10123 ----
X  	 (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
X  	((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
X  	 (if (math-lessp-float a b) -1 1))
X! 	((and (or (Math-anglep a)
X! 		  (and (eq (car a) 'cplx) (eq (nth 2 a) 0)))
X! 	      (or (Math-anglep b)
X! 		  (and (eq (car b) 'cplx) (eq (nth 2 b) 0))))
X  	 (math-sign (math-add a (math-neg b))))
X  	((eq (car-safe a) 'var)
X  	 2)
X***************
X*** 6146,6157 ****
X    (let ((ediff (- (nth 2 a) (nth 2 b))))
X      (if (>= ediff 0)
X  	(if (>= ediff (+ calc-internal-prec calc-internal-prec))
X! 	    (Math-integer-negp (nth 1 a))
X  	  (Math-lessp (math-scale-int (nth 1 a) ediff)
X  		      (nth 1 b)))
X        (if (>= (setq ediff (- ediff))
X  	      (+ calc-internal-prec calc-internal-prec))
X! 	  (Math-integer-posp (nth 1 b))
X  	(Math-lessp (nth 1 a)
X  		    (math-scale-int (nth 1 b) ediff)))))
X  )
X--- 10158,10173 ----
X    (let ((ediff (- (nth 2 a) (nth 2 b))))
X      (if (>= ediff 0)
X  	(if (>= ediff (+ calc-internal-prec calc-internal-prec))
X! 	    (if (eq (nth 1 a) 0)
X! 		(Math-integer-posp (nth 1 b))
X! 	      (Math-integer-negp (nth 1 a)))
X  	  (Math-lessp (math-scale-int (nth 1 a) ediff)
X  		      (nth 1 b)))
X        (if (>= (setq ediff (- ediff))
X  	      (+ calc-internal-prec calc-internal-prec))
X! 	  (if (eq (nth 1 b) 0)
X! 	      (Math-integer-negp (nth 1 a))
X! 	    (Math-integer-posp (nth 1 b)))
X  	(Math-lessp (nth 1 a)
X  		    (math-scale-int (nth 1 b) ediff)))))
X  )
X***************
X*** 6199,6207 ****
X  ;;; Convert a function name into a like-looking variable name formula.
X  (defun math-calcFunc-to-var (f)
X    (if (symbolp f)
X!       (let ((base (if (string-match "\\`calcFunc-\\(.+\\)\\'" (symbol-name f))
X! 		      (math-match-substring (symbol-name f) 1)
X! 		    (symbol-name f))))
X  	(list 'var
X  	      (intern base)
X  	      (intern (concat "var-" base))))
X--- 10215,10233 ----
X  ;;; Convert a function name into a like-looking variable name formula.
X  (defun math-calcFunc-to-var (f)
X    (if (symbolp f)
X!       (let* ((func (or (cdr (assq f '( ( + . calcFunc-add )
X! 				       ( - . calcFunc-sub )
X! 				       ( * . calcFunc-mul )
X! 				       ( / . calcFunc-div )
X! 				       ( ^ . calcFunc-pow )
X! 				       ( % . calcFunc-mod )
X! 				       ( neg . calcFunc-neg )
X! 				       ( | . calcFunc-vconcat ) )))
X! 		       f))
X! 	     (base (if (string-match "\\`calcFunc-\\(.+\\)\\'"
X! 				     (symbol-name func))
X! 		       (math-match-substring (symbol-name func) 1)
X! 		     (symbol-name func))))
X  	(list 'var
X  	      (intern base)
X  	      (intern (concat "var-" base))))
X***************
X*** 6221,6227 ****
X  		    argvals (cdr argvals)))
X  	    res)
X  	(cons 'calcFunc-call (cons (math-calcFunc-to-var f) args)))
X!     (cons f args))
X  )
X  
X  (defun calcFunc-call (f &rest args)
X--- 10247,10265 ----
X  		    argvals (cdr argvals)))
X  	    res)
X  	(cons 'calcFunc-call (cons (math-calcFunc-to-var f) args)))
X!     (if (and (eq f 'calcFunc-neg)
X! 	     (= (length args) 1))
X! 	(list 'neg (car args))
X!       (let ((func (assq f '( ( calcFunc-add . + )
X! 			     ( calcFunc-sub . - )
X! 			     ( calcFunc-mul . * )
X! 			     ( calcFunc-div . / )
X! 			     ( calcFunc-pow . ^ )
X! 			     ( calcFunc-mod . % )
X! 			     ( calcFunc-vconcat . | ) ))))
X! 	(if (and func (= (length args) 2))
X! 	    (cons (cdr func) args)
X! 	  (cons f args)))))
X  )
X  
X  (defun calcFunc-call (f &rest args)
X***************
X*** 6239,6244 ****
X--- 10277,10341 ----
X  
X  
X  
X+ ;;;; [calc-frac.el]
X+ 
X+ ;;;; Fractions.
X+ 
X+ ;;; Build a normalized fraction.  [R I I]
X+ ;;; (This could probably be implemented more efficiently than using
X+ ;;;  the plain gcd algorithm.)
X+ (defun math-make-frac (num den)
X+   (if (Math-integer-negp den)
X+       (setq num (math-neg num)
X+ 	    den (math-neg den)))
X+   (let ((gcd (math-gcd num den)))
X+     (if (eq gcd 1)
X+ 	(if (eq den 1)
X+ 	    num
X+ 	  (list 'frac num den))
X+       (if (equal gcd den)
X+ 	  (math-quotient num gcd)
X+ 	(list 'frac (math-quotient num gcd) (math-quotient den gcd)))))
X+ )
X+ 
X+ (defun calc-add-fractions (a b)
X+   (if (eq (car-safe a) 'frac)
X+       (if (eq (car-safe b) 'frac)
X+ 	  (math-make-frac (math-add (math-mul (nth 1 a) (nth 2 b))
X+ 				    (math-mul (nth 2 a) (nth 1 b)))
X+ 			  (math-mul (nth 2 a) (nth 2 b)))
X+ 	(math-make-frac (math-add (nth 1 a)
X+ 				  (math-mul (nth 2 a) b))
X+ 			(nth 2 a)))
X+     (math-make-frac (math-add (math-mul a (nth 2 b))
X+ 			      (nth 1 b))
X+ 		    (nth 2 b)))
X+ )
X+ 
X+ (defun calc-mul-fractions (a b)
X+   (if (eq (car-safe a) 'frac)
X+       (if (eq (car-safe b) 'frac)
X+ 	  (math-make-frac (math-mul (nth 1 a) (nth 1 b))
X+ 			  (math-mul (nth 2 a) (nth 2 b)))
X+ 	(math-make-frac (math-mul (nth 1 a) b)
X+ 			(nth 2 a)))
X+     (math-make-frac (math-mul a (nth 1 b))
X+ 		    (nth 2 b)))
X+ )
X+ 
X+ (defun calc-div-fractions (a b)
X+   (if (eq (car-safe a) 'frac)
X+       (if (eq (car-safe b) 'frac)
X+ 	  (math-make-frac (math-mul (nth 1 a) (nth 2 b))
X+ 			  (math-mul (nth 2 a) (nth 1 b)))
X+ 	(math-make-frac (nth 1 a)
X+ 			(math-mul (nth 2 a) b)))
X+     (math-make-frac (math-mul a (nth 2 b))
X+ 		    (nth 1 b)))
X+ )
X+ 
X+ 
X+ 
X  ;;;; [calc-vec.el]
X  
X  ;;;; Vectors.
X***************
X*** 6293,6298 ****
X--- 10390,10421 ----
X      obj)
X  )
X  
X+ (defun math-vector-head (vec)
X+   (if (and (Math-vectorp vec)
X+ 	   (cdr (cdr vec)))
X+       (nth 1 vec)
X+     (math-record-why 'vectorp vec)
X+     (list 'calcFunc-head vec))
X+ )
X+ (fset 'calcFunc-head (symbol-function 'math-vector-head))
X+ 
X+ (defun math-vector-tail (vec)
X+   (if (and (Math-vectorp vec)
X+ 	   (cdr (cdr vec)))
X+       (cdr (cdr vec))
X+     (math-record-why 'vectorp vec)
X+     (list 'calcFunc-tail vec))
X+ )
X+ (fset 'calcFunc-tail (symbol-function 'math-vector-tail))
X+ 
X+ (defun math-cons-vec (head tail)
X+   (if (Math-vectorp tail)
X+       (cons 'vec (cons head (cdr tail)))
X+     (math-record-why 'vectorp tail)
X+     (list 'calcFunc-cons head tail))
X+ )
X+ (fset 'calcFunc-cons (symbol-function 'math-cons-vec))
X+ 
X  
X  ;;;; [calc-mat.el]
X  
X***************
X*** 6400,6421 ****
X  	 (vec nil)
X  	 (i -1)
X  	 len cols obj expr)
X!     (if (eq mode 'rows)
X! 	()
X!       (while (and (< (setq i (1+ i)) nargs)
X! 		  (not (math-matrixp (aref ptrs i)))))
X!       (if (< i nargs)
X! 	  (if (eq mode 'elems)
X! 	      (setq func (list 'lambda '(&rest x)
X! 			       (list 'math-symb-map
X! 				     (list 'quote f) '(quote elems) 'x))
X! 		    mode 'rows)
X! 	    (while (< i nargs)
X! 	      (if (math-matrixp (aref ptrs i))
X! 		  (aset ptrs i (math-transpose (aref ptrs i))))
X! 	      (setq i (1+ i))))
X! 	(setq mode 'elems))
X!       (setq i -1))
X      (while (< (setq i (1+ i)) nargs)
X        (setq obj (aref ptrs i))
X        (if (and (eq (car-safe obj) 'vec)
X--- 10523,10543 ----
X  	 (vec nil)
X  	 (i -1)
X  	 len cols obj expr)
X!     (while (and (< (setq i (1+ i)) nargs)
X! 		(not (math-matrixp (aref ptrs i)))))
X!     (if (< i nargs)
X! 	(if (eq mode 'elems)
X! 	    (setq func (list 'lambda '(&rest x)
X! 			     (list 'math-symb-map
X! 				   (list 'quote f) '(quote elems) 'x))
X! 		  mode 'rows)
X! 	  (if (eq mode 'cols)
X! 	      (while (< i nargs)
X! 		(if (math-matrixp (aref ptrs i))
X! 		    (aset ptrs i (math-transpose (aref ptrs i))))
X! 		(setq i (1+ i)))))
X!       (setq mode 'elems))
X!     (setq i -1)
X      (while (< (setq i (1+ i)) nargs)
X        (setq obj (aref ptrs i))
X        (if (and (eq (car-safe obj) 'vec)
X***************
X*** 6566,6571 ****
X--- 10688,10764 ----
X      (calcFunc-reducer func vec))
X  )
X  
X+ (defun calcFunc-accum (func vec)
X+   (setq func (math-var-to-calcFunc func))
X+   (or (math-vectorp vec)
X+       (math-reject-arg vec 'vectorp))
X+   (let* ((expr (car (setq vec (cdr vec))))
X+ 	 (res (list 'vec expr)))
X+     (or expr
X+ 	(math-reject-arg vec "Vector is empty"))
X+     (while (setq vec (cdr vec))
X+       (setq expr (math-build-call func (list expr (car vec)))
X+ 	    res (nconc res (list expr))))
X+     (math-normalize res))
X+ )
X+ 
X+ 
X+ (defun calcFunc-outer (func a b)
X+   (or (math-vectorp a) (math-reject-arg a 'vectorp))
X+   (or (math-vectorp b) (math-reject-arg b 'vectorp))
X+   (setq func (math-var-to-calcFunc func))
X+   (let ((mat nil))
X+     (while (setq a (cdr a))
X+       (setq mat (cons (cons 'vec
X+ 			    (mapcar (function (lambda (x)
X+ 						(math-build-call func
X+ 								 (list (car a)
X+ 								       x))))
X+ 				    (cdr b)))
X+ 		      mat)))
X+     (math-normalize (cons 'vec (nreverse mat))))
X+ )
X+ 
X+ 
X+ (defun calcFunc-inner (mul-func add-func a b)
X+   (or (math-vectorp a) (math-reject-arg a 'vectorp))
X+   (or (math-vectorp b) (math-reject-arg b 'vectorp))
X+   (if (math-matrixp a)
X+       (if (math-matrixp b)
X+ 	  (cons 'vec (math-inner-mats (cdr a) (mapcar 'cdr (cdr b))))
X+ 	(math-mat-col
X+ 	 (cons 'vec
X+ 	       (if (= (length (nth 1 a)) 2)
X+ 		   (math-inner-mats (cdr a)
X+ 				  (mapcar 'cdr (cdr (math-row-matrix b))))
X+ 		 (math-inner-mats (cdr a)
X+ 				  (mapcar 'cdr (cdr (math-col-matrix b))))))
X+ 	 1))
X+     (if (math-matrixp b)
X+ 	(cons 'vec (math-inner-mat-row a (mapcar 'cdr (cdr b))))
X+       (car (math-inner-mat-row a
X+ 			     (mapcar 'cdr (cdr (math-col-matrix b)))))))
X+ )
X+ 
X+ (defun math-inner-mats (a b)
X+   (and a
X+        (cons (cons 'vec (math-inner-mat-row (car a) b))
X+ 	     (math-inner-mats (cdr a) b)))
X+ )
X+ 
X+ (defun math-inner-mat-row (a b)    ; uses "mul-func", "add-func"
X+   (if (math-no-empty-rows b)
X+       (cons
X+        (calcFunc-reduce add-func
X+ 			(calcFunc-map mul-func
X+ 				      a
X+ 				      (cons 'vec (mapcar 'car b))))
X+        (math-inner-mat-row a (mapcar 'cdr b)))
X+     (if (math-list-all-nil b)
X+ 	nil
X+       (math-dimension-error)))
X+ )
X+ 
X  
X  ;;;; [calc-mat.el]
X  
X***************
X*** 6618,6627 ****
X  )
X  
X  (defun calcFunc-mrow (mat n)   ; [Public]
X!   (and (integerp (setq n (math-check-integer n)))
X!        (> n 0)
X!        (math-vectorp mat)
X!        (nth n mat))
X  )
X  
X  ;;; Get the Nth column of a matrix.
X--- 10811,10826 ----
X  )
X  
X  (defun calcFunc-mrow (mat n)   ; [Public]
X!   (if (Math-vectorp n)
X!       (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
X!     (if (eq (car-safe n) 'intv)
X! 	(math-subvector mat
X! 			(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
X! 			(math-add (nth 3 n) (if (memq (nth 1 n) '(1 3)) 1 0)))
X!       (and (integerp (setq n (math-check-integer n)))
X! 	   (> n 0)
X! 	   (Math-vectorp mat)
X! 	   (nth n mat))))
X  )
X  
X  ;;; Get the Nth column of a matrix.
X***************
X*** 6630,6642 ****
X  )
X  
X  (defun calcFunc-mcol (mat n)   ; [Public]
X!   (and (integerp (setq n (math-check-integer n)))
X!        (> n 0)
X!        (math-vectorp mat)
X!        (if (math-matrixp mat)
X! 	   (and (< n (length (nth 1 mat)))
X! 		(math-mat-col mat n))
X! 	 (nth n mat)))
X  )
X  
X  ;;; Remove the Nth row from a matrix.
X--- 10829,10847 ----
X  )
X  
X  (defun calcFunc-mcol (mat n)   ; [Public]
X!   (if (Math-vectorp n)
X!       (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n)
X!     (if (eq (car-safe n) 'intv)
X! 	(if (math-matrixp mat)
X! 	    (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
X! 	  (calcFunc-mrow mat n))
X!       (and (integerp (setq n (math-check-integer n)))
X! 	   (> n 0)
X! 	   (Math-vectorp mat)
X! 	   (if (math-matrixp mat)
X! 	       (and (< n (length (nth 1 mat)))
X! 		    (math-mat-col mat n))
X! 	     (nth n mat)))))
X  )
X  
X  ;;; Remove the Nth row from a matrix.
X***************
X*** 6767,6784 ****
X  )
X  
X  ;;; Create a vector of consecutive integers. [Public]
X! (defun math-vec-index (n)
X!   (and (not (integerp n))
X!        (setq n (math-check-fixnum n)))
X!   (or (natnump n) (math-reject-arg n 'natnump))
X!   (let ((vec nil))
X!     (while (> n 0)
X!       (setq vec (cons n vec)
X! 	    n (1- n)))
X!     (cons 'vec vec))
X  )
X  (fset 'calcFunc-index (symbol-function 'math-vec-index))
X  
X  
X  ;;; Compute the row and column norms of a vector or matrix.  [Public]
X  (defun math-rnorm (a)
X--- 10972,11081 ----
X  )
X  
X  ;;; Create a vector of consecutive integers. [Public]
X! (defun math-vec-index (n &optional start incr)
X!   (if (math-messy-integerp n)
X!       (math-float (math-vec-index (math-trunc n)))
X!     (and (not (integerp n))
X! 	 (setq n (math-check-fixnum n)))
X!     (let ((vec nil))
X!       (if start
X! 	  (progn
X! 	    (if (>= n 0)
X! 		(while (>= (setq n (1- n)) 0)
X! 		  (setq vec (cons start vec)
X! 			start (math-add start (or incr 1))))
SHAR_EOF
echo "End of part 7, continue with part 8"
echo "8" > s2_seq_.tmp
exit 0



More information about the Comp.sources.misc mailing list