Lines Matching +defs:math +defs:sqr +defs:float
36 (defvar math-scalar-functions '(calcFunc-det
42 (defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag
49 (defvar math-scalar-if-args-functions '(+ - * / neg))
51 (defvar math-real-functions '(calcFunc-arg
60 (defvar math-positive-functions '())
62 (defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm
65 (defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs
73 (defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos
83 (defvar math-integer-functions '(calcFunc-idiv
87 (defvar math-num-integer-functions '())
89 (defvar math-rounding-functions '(calcFunc-floor
94 (defvar math-float-rounding-functions '(calcFunc-ffloor
99 (defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs
170 (defun calc-scale-float (arg)
196 (defun math-abs-approx (a)
198 (math-neg a))
202 (math-add (math-abs (nth 1 a)) (math-abs (nth 2 a))))
206 (math-abs-approx (nth 1 a)))
208 (math-max (math-abs (nth 2 a)) (math-abs (nth 3 a))))
212 (math-reduce-vec 'math-add-abs-approx a))
217 (defun math-add-abs-approx (a b)
218 (math-add (math-abs-approx a) (math-abs-approx b)))
223 (defvar math-decls-cache-tag nil)
224 (defvar math-decls-cache nil)
225 (defvar math-decls-all nil)
233 (defvar math-super-types
238 (float real number)
247 (defun math-setup-declarations ()
248 (or (eq math-decls-cache-tag (calc-var-value 'var-Decls))
251 (setq math-decls-cache-tag p
252 math-decls-cache nil)
266 math-super-types)))
281 range (math-prepare-set (cons 'vec vec))))
288 (setq math-decls-cache
293 math-decls-cache)))))
295 (setq math-decls-all (assq 'var-All math-decls-cache)))))
297 (defun math-known-scalarp (a &optional assume-scalar)
298 (math-setup-declarations)
302 (not (math-check-known-matrixp a))
303 (math-check-known-scalarp a)))
305 (defun math-known-matrixp (a)
307 (not (math-known-scalarp a t))))
309 (defun math-known-square-matrixp (a)
310 (and (math-known-matrixp a)
311 (math-check-known-square-matrixp a)))
314 (defun math-check-known-scalarp (a)
316 ((memq (car a) math-scalar-functions)
318 ((memq (car a) math-real-scalar-functions)
320 ((memq (car a) math-scalar-if-args-functions)
322 (math-check-known-scalarp (car a))))
325 (math-check-known-scalarp (nth 1 a)))
326 ((math-const-var a) t)
329 (or (assq (nth 2 a) math-decls-cache)
330 math-decls-all)
331 (assq (car a) math-decls-cache)))
340 (math-check-known-scalarp val))
345 (defun math-check-known-matrixp (a)
347 ((memq (car a) math-nonscalar-functions)
349 ((memq (car a) math-scalar-if-args-functions)
351 (not (math-check-known-matrixp (car a)))))
354 (math-check-known-matrixp (nth 1 a)))
355 ((math-const-var a) nil)
358 (or (assq (nth 2 a) math-decls-cache)
359 math-decls-all)
360 (assq (car a) math-decls-cache)))
369 (math-check-known-matrixp val))
374 (defun math-check-known-square-matrixp (a)
375 (cond ((math-square-matrixp a)
378 (math-check-known-square-matrixp (nth 1 a)))
384 (math-check-known-square-matrixp (nth 1 a))
385 (math-check-known-square-matrixp (nth 2 a))))
388 (or (assq (nth 2 a) math-decls-cache)
389 math-decls-all)
390 (assq (car a) math-decls-cache)))
398 (math-check-known-square-matrixp val))
410 (defun math-known-realp (a)
411 (< (math-possible-signs a) 8))
414 (defun math-known-posp (a)
415 (eq (math-possible-signs a) 4))
418 (defun math-known-negp (a)
419 (eq (math-possible-signs a) 1))
422 (defun math-known-nonnegp (a)
423 (memq (math-possible-signs a) '(2 4 6)))
426 (defun math-known-nonposp (a)
427 (memq (math-possible-signs a) '(1 2 3)))
430 (defun math-known-nonzerop (a)
431 (memq (math-possible-signs a) '(1 4 5 8 9 12 13)))
434 (defun math-guess-if-neg (a)
435 (let ((sgn (math-possible-signs a)))
440 (math-looks-negp a)))))
448 (defun math-possible-signs (a &optional origin)
450 (if origin (setq a (math-sub a origin)))
456 ((math-known-posp (nth 2 a)) 4)
457 ((math-known-negp (nth 3 a)) 1)
462 (if (math-known-realp (nth 1 a)) 7 15))
467 (math-neg-signs
468 (math-possible-signs (nth 2 a)
470 (math-add origin (nth 1 a))
472 (math-possible-signs (nth 2 a)
474 (math-sub origin (nth 1 a))
475 (math-neg (nth 1 a))))))
479 (math-neg (nth 2 a)))))
480 (math-possible-signs (nth 1 a)
482 (math-add origin org)
485 (let ((s1 (math-possible-signs (nth 1 a) origin))
486 (s2 (math-possible-signs (nth 2 a))))
487 (if (eq (car a) '-) (setq s2 (math-neg-signs s2)))
499 (math-neg-signs (math-possible-signs
501 (and origin (math-neg origin)))))
509 (math-possible-signs 0 origin)
510 (math-possible-signs (nth 2 a)
511 (math-div (or origin 0)
513 (math-neg-signs
514 (math-possible-signs (nth 2 a)
515 (math-div (nth 1 a)
517 (if (Math-negp (nth 1 a)) (math-neg-signs s) s)))
519 (let ((s (math-possible-signs (nth 1 a)
521 (math-mul (or origin 0) (nth 2 a))
522 (math-div (or origin 0) (nth 2 a))))))
523 (if (Math-negp (nth 2 a)) (math-neg-signs s) s)))
527 (setq signs (logior signs (math-possible-signs
533 (let ((s1 (math-possible-signs (nth 1 a)))
534 (s2 (math-possible-signs (nth 2 a))))
542 (math-neg-signs s2) 0))))))
544 (let ((s1 (math-possible-signs (nth 1 a)))
545 (s2 (math-possible-signs (nth 2 a))))
552 (if (math-evenp (nth 2 a))
558 (let ((s2 (math-possible-signs (nth 2 a))))
566 (let ((s1 (math-possible-signs (nth 1 a))))
571 (let ((s1 (math-possible-signs (nth 1 a))))
574 (if (or (not origin) (math-negp origin))
576 (setq origin (math-sub (or origin 0) 1))
583 (math-known-posp (nth 2 a))))
584 (if (math-known-nonnegp (nth 1 a))
585 (math-possible-signs (nth 1 a) 1)
588 (let ((s1 (math-possible-signs (nth 1 a))))
590 ((memq (car a) math-nonnegative-functions) 6)
591 ((memq (car a) math-positive-functions) 4)
592 ((memq (car a) math-real-functions) 7)
593 ((memq (car a) math-real-scalar-functions) 7)
594 ((and (memq (car a) math-real-if-arg-functions)
596 (if (math-known-realp (nth 1 a)) 7 15)))))
604 ((math-const-var a)
607 (math-possible-signs (math-pi) origin)
611 (math-possible-signs (math-e) origin)
618 (math-setup-declarations)
620 (or (assq (nth 2 a) math-decls-cache)
621 math-decls-all)
622 (assq (car a) math-decls-cache))))
628 (math-possible-signs (nth 2 decl) origin)
633 (defun math-neg-signs (s1)
635 (+ 8 (math-neg-signs (- s1 8)))
642 (defun math-known-integerp (a)
643 (eq (math-possible-types a) 1))
645 (defun math-known-num-integerp (a)
646 (<= (math-possible-types a t) 3))
648 (defun math-known-imagp (a)
649 (= (math-possible-types a) 16))
654 ;;; 2 may be integer-valued float.
656 ;;; 8 may be non-integer-valued float.
660 (defun math-possible-types (a &optional num)
665 ((eq (car a) 'float) (if num 12 8))
668 (math-possible-types (nth 2 a))
671 (if (math-known-realp (nth 1 a)) 15 63))
673 (if (math-zerop (nth 1 a)) 16 32))
675 (if (or (Math-equal (nth 2 a) (math-quarter-circle nil))
677 (math-neg (math-quarter-circle nil))))
681 (let* ((t1 (math-possible-types (nth 1 a) num))
682 (t2 (math-possible-types (nth 2 a) num))
699 (let* ((t1 (math-possible-types (nth 1 a) num))
700 (t2 (math-possible-types (nth 2 a) num))
731 (math-possible-types (nth 1 a)))
733 (let* ((t1 (math-possible-types (nth 1 a) num))
734 (t2 (math-possible-types (nth 2 a) num))
736 (if (and (<= t2 3) (math-known-nonnegp (nth 2 a)) (< t1 16))
746 (if (and (math-known-nonnegp (nth 1 a))
747 (math-known-posp (nth 2 a)))
751 (let ((t1 (math-possible-signs (nth 1 a))))
759 (setq types (logior types (math-possible-types (car a) t))))
761 ((or (memq (car a) math-integer-functions)
762 (and (memq (car a) math-rounding-functions)
763 (math-known-nonnegp (or (nth 2 a) 0))))
765 ((or (memq (car a) math-num-integer-functions)
766 (and (memq (car a) math-float-rounding-functions)
767 (math-known-nonnegp (or (nth 2 a) 0))))
771 ((and (eq (car a) 'calcFunc-float) (= (length a) 2))
772 (let ((t1 (math-possible-types (nth 1 a))))
778 (let ((t1 (math-possible-types (nth 1 a))))
782 ((math-const-var a)
788 (math-setup-declarations)
790 (or (assq (nth 2 a) math-decls-cache)
791 math-decls-all)
792 (assq (car a) math-decls-cache))))
801 ((memq 'float (nth 1 decl))
804 (math-possible-types (nth 2 decl)))
809 (defun math-known-evenp (a)
811 (math-evenp a))
814 (math-evenp (math-trunc a))))
816 (if (math-known-evenp (nth 1 a))
817 (math-known-num-integerp (nth 2 a))
818 (if (math-known-num-integerp (nth 1 a))
819 (math-known-evenp (nth 2 a)))))
821 (or (and (math-known-evenp (nth 1 a))
822 (math-known-evenp (nth 2 a)))
823 (and (math-known-oddp (nth 1 a))
824 (math-known-oddp (nth 2 a)))))
826 (math-known-evenp (nth 1 a)))))
828 (defun math-known-oddp (a)
830 (math-oddp a))
833 (math-oddp (math-trunc a))))
835 (or (and (math-known-evenp (nth 1 a))
836 (math-known-oddp (nth 2 a)))
837 (and (math-known-oddp (nth 1 a))
838 (math-known-evenp (nth 2 a)))))
840 (math-known-oddp (nth 1 a)))))
844 (let ((types (math-possible-types expr)))
847 (math-reject-arg expr 'realp 'quiet)))))
850 (let ((types (math-possible-types expr)))
853 (math-reject-arg expr "Expected an imaginary number")))))
856 (let ((signs (math-possible-signs expr)))
859 (math-reject-arg expr 'posp 'quiet)))))
862 (let ((signs (math-possible-signs expr)))
865 (math-reject-arg expr 'negp 'quiet)))))
868 (let ((signs (math-possible-signs expr)))
871 (math-reject-arg expr 'posp 'quiet)))))
874 (let ((signs (math-possible-signs expr)))
877 (math-reject-arg expr 'nonzerop 'quiet)))))
880 (let ((types (math-possible-types expr)))
883 (math-reject-arg expr 'integerp 'quiet)))))
886 (let ((types (math-possible-types expr t)))
889 (math-reject-arg expr 'integerp 'quiet)))))
898 (if (math-known-evenp expr)
900 (if (or (math-known-oddp expr)
901 (= (logand (math-possible-types expr) 3) 0))
903 (math-reject-arg expr "Can't tell if expression is odd or even"))))
906 (if (math-known-oddp expr)
908 (if (or (math-known-evenp expr)
909 (= (logand (math-possible-types expr) 3) 0))
911 (math-reject-arg expr "Can't tell if expression is odd or even"))))
914 (let ((types (math-possible-types expr)))
917 (math-reject-arg expr "Rational number expected")))))
920 (math-setup-declarations)
927 (setq range (nth 2 (or (assq (nth 2 expr) math-decls-cache)
928 math-decls-all)))
929 (setq range (nth 2 (assq (car-safe expr) math-decls-cache))))
931 (math-clean-set (copy-sequence range))
932 (setq range (math-possible-signs expr))
943 (math-reject-arg expr 'realp 'quiet)))))))
946 (if (math-known-scalarp a) 1
947 (if (math-known-matrixp a) 0
948 (math-reject-arg a 'objectp 'quiet))))
954 (math-normalize (list 'neg a)))
956 (defun math-neg-fancy (a)
960 (if (math-posp (nth 2 a))
961 (math-sub (nth 2 a) (math-half-circle nil))
962 (math-add (nth 2 a) (math-half-circle nil)))))
964 (if (math-zerop (nth 1 a))
966 (list 'mod (math-sub (nth 2 a) (nth 1 a)) (nth 2 a))))
968 (list 'sdev (math-neg (nth 1 a)) (nth 2 a)))
970 (math-make-intv (aref [0 2 1 3] (nth 1 a))
971 (math-neg (nth 3 a))
972 (math-neg (nth 2 a))))
973 ((and math-simplify-only
974 (not (equal a math-simplify-only)))
977 (math-sub (math-neg (nth 1 a)) (nth 2 a)))
979 (math-sub (nth 2 a) (nth 1 a)))
981 (math-okay-neg (nth 1 a)))
982 (list (car a) (math-neg (nth 1 a)) (nth 2 a)))
984 (math-okay-neg (nth 2 a)))
985 (list (car a) (nth 1 a) (math-neg (nth 2 a))))
987 (or (math-objectp (nth 1 a))
989 (math-objectp (nth 1 (nth 1 a))))))
990 (list (car a) (math-neg (nth 1 a)) (nth 2 a)))
992 (or (math-objectp (nth 2 a))
994 (math-objectp (nth 1 (nth 2 a))))))
995 (list (car a) (nth 1 a) (math-neg (nth 2 a))))
1002 (defun math-okay-neg (a)
1003 (or (math-looks-negp a)
1006 (defun math-neg-float (a)
1007 (list 'float (Math-integer-neg (nth 1 a)) (nth 2 a)))
1015 (math-normalize a))
1023 (math-normalize a))
1026 (defun math-add-objects-fancy (a b)
1028 (let ((aa (math-complex a))
1029 (bb (math-complex b)))
1030 (math-normalize
1032 (math-add (nth 1 aa) (nth 1 bb))
1033 (math-add (nth 2 aa) (nth 2 bb)))))
1034 (if (math-want-polar a b)
1035 (math-polar res)
1038 (math-map-vec-2 'math-add a b))
1041 (math-make-sdev (math-add (nth 1 a) (nth 1 b))
1042 (math-hypot (nth 2 a) (nth 2 b)))
1045 (math-make-sdev (math-add (nth 1 a) b) (nth 2 a)))))
1049 (math-make-sdev (math-add a (nth 1 b)) (nth 2 b)))
1052 (math-make-intv (logior (logand (nth 1 a) (nth 1 b))
1063 (math-add (nth 2 a) (nth 2 b))
1064 (math-add (nth 3 a) (nth 3 b)))
1068 (math-make-intv (nth 1 a)
1069 (math-add (nth 2 a) b)
1070 (math-add (nth 3 a) b)))))
1075 (math-make-intv (nth 1 b)
1076 (math-add a (nth 2 b))
1077 (math-add a (nth 3 b))))
1080 (math-add (nth 1 a) (nth 1 b)))
1082 (let ((parts (math-date-parts (nth 1 a))))
1084 (math-add (car parts) ; this minimizes roundoff
1085 (math-div (math-add
1086 (math-add (nth 1 parts)
1088 (math-add
1089 (math-mul (nth 1 b) 3600)
1090 (math-add (math-mul (nth 2 b) 60)
1094 (list 'date (math-add (nth 1 a) b)))
1097 (math-add-objects-fancy b a))
1101 (math-make-mod (math-add (nth 1 a) (nth 1 b)) (nth 2 a)))
1104 (math-make-mod (math-add (nth 1 a) b) (nth 2 a)))
1107 (math-make-mod (math-add a (nth 1 b)) (nth 2 b)))
1110 (or (eq (car-safe a) 'hms) (setq a (math-to-hms a)))
1111 (or (eq (car-safe b) 'hms) (setq b (math-to-hms b)))
1112 (math-normalize
1113 (if (math-negp a)
1114 (math-neg (math-add (math-neg a) (math-neg b)))
1115 (if (math-negp b)
1116 (let* ((s (math-add (nth 3 a) (nth 3 b)))
1117 (m (math-add (nth 2 a) (nth 2 b)))
1118 (h (math-add (nth 1 a) (nth 1 b))))
1119 (if (math-negp s)
1120 (setq s (math-add s 60)
1121 m (math-add m -1)))
1122 (if (math-negp m)
1123 (setq m (math-add m 60)
1124 h (math-add h -1)))
1125 (if (math-negp h)
1126 (math-add b a)
1128 (let* ((s (math-add (nth 3 a) (nth 3 b)))
1129 (m (math-add (nth 2 a) (nth 2 b)))
1130 (h (math-add (nth 1 a) (nth 1 b))))
1134 (defun math-add-symb-fancy (a b)
1135 (or (and math-simplify-only
1136 (not (equal a math-simplify-only))
1139 (math-add (math-add a (nth 1 b))
1142 (math-sub (math-add a (nth 1 b))
1146 (math-sub (math-sub a (nth 1 (nth 1 b)))
1148 (and (or (and (Math-vectorp a) (math-known-scalarp b))
1149 (and (Math-vectorp b) (math-known-scalarp a)))
1150 (math-map-vec-2 'math-add a b))
1151 (let ((inf (math-infinitep a)))
1154 (let ((inf2 (math-infinitep b)))
1159 (let ((dir (math-infinite-dir a inf))
1160 (dir2 (math-infinite-dir b inf2)))
1176 ((math-infinitep b)
1178 (math-add b a)
1181 (let ((temp (math-combine-sum (nth 2 a) b nil nil t)))
1183 (math-add (nth 1 a) temp))))
1185 (let ((temp (math-combine-sum (nth 2 a) b t nil t)))
1187 (math-add (nth 1 a) temp))))
1191 (math-combine-sum a b nil nil nil))))
1193 (list '- a (math-neg b)))
1195 (list '- b (math-neg a)))
1200 (list 'calcFunc-idn (math-add (nth 1 a) (nth 1 b))))
1201 (and (math-square-matrixp b)
1202 (math-add (math-mimic-ident (nth 1 a) b) b))
1203 (and (math-known-scalarp b)
1204 (math-add (nth 1 a) b))))
1207 (or (and (math-square-matrixp a)
1208 (math-add a (math-mimic-ident (nth 1 b) a)))
1209 (and (math-known-scalarp a)
1210 (math-add a (nth 1 b)))))
1219 (math-normalize a))
1222 (defun math-mul-objects-fancy (a b)
1224 (math-normalize
1225 (if (math-want-polar a b)
1226 (let ((a (math-polar a))
1227 (b (math-polar b)))
1229 (math-mul (nth 1 a) (nth 1 b))
1230 (math-fix-circular (math-add (nth 2 a) (nth 2 b)))))
1231 (setq a (math-complex a)
1232 b (math-complex b))
1234 (math-sub (math-mul (nth 1 a) (nth 1 b))
1235 (math-mul (nth 2 a) (nth 2 b)))
1236 (math-add (math-mul (nth 1 a) (nth 2 b))
1237 (math-mul (nth 2 a) (nth 1 b)))))))
1240 (if (math-matrixp a)
1241 (if (math-matrixp b)
1243 (math-mul-mats a b)
1244 (math-dimension-error))
1247 (math-mul-mats a (list 'vec b))
1248 (math-dimension-error))
1250 (math-mul-mat-vec a b)
1251 (math-dimension-error))))
1252 (if (math-matrixp b)
1254 (nth 1 (math-mul-mats (list 'vec a) b))
1255 (math-dimension-error))
1257 (math-dot-product a b)
1258 (math-dimension-error))))
1259 (math-map-vec-2 'math-mul a b)))
1261 (math-map-vec-2 'math-mul a b))
1264 (math-make-sdev (math-mul (nth 1 a) (nth 1 b))
1265 (math-hypot (math-mul (nth 2 a) (nth 1 b))
1266 (math-mul (nth 2 b) (nth 1 a))))
1269 (math-make-sdev (math-mul (nth 1 a) b)
1270 (math-mul (nth 2 a) b)))))
1274 (math-make-sdev (math-mul a (nth 1 b)) (math-mul a (nth 2 b))))
1277 (math-neg (math-mul a (math-neg b)))
1278 (math-make-intv (nth 1 a)
1279 (math-mul (nth 2 a) b)
1280 (math-mul (nth 3 a) b))))
1282 (math-mul b a))
1283 ((and (eq (car-safe a) 'intv) (math-intv-constp a)
1284 (eq (car-safe b) 'intv) (math-intv-constp b))
1285 (let ((lo (math-mul a (nth 2 b)))
1286 (hi (math-mul a (nth 3 b))))
1291 (math-combine-intervals
1293 (math-infinitep (nth 2 lo)))
1296 (math-infinitep (nth 3 lo)))
1299 (math-infinitep (nth 2 hi)))
1302 (math-infinitep (nth 3 hi)))
1307 (math-make-mod (math-mul (nth 1 a) (nth 1 b)) (nth 2 a)))
1310 (math-make-mod (math-mul (nth 1 a) b) (nth 2 a)))
1313 (math-make-mod (math-mul a (nth 1 b)) (nth 2 b)))
1315 (math-with-extra-prec 2
1316 (math-to-hms (math-mul (math-from-hms a 'deg) b) 'deg)))
1318 (math-mul b a))
1322 (defun math-mul-float (a b) ; [F F F]
1323 (math-make-float (math-mul (nth 1 a) (nth 1 b))
1326 (defun math-sqr-float (a) ; [F F]
1327 (math-make-float (math-mul (nth 1 a) (nth 1 a))
1330 (defun math-intv-constp (a &optional finite)
1340 (defun math-mul-zero (a b)
1341 (if (math-known-matrixp b)
1342 (if (math-vectorp b)
1343 (math-map-vec-2 'math-mul a b)
1344 (math-mimic-ident 0 b))
1345 (if (math-infinitep b)
1357 (if (or (math-posp a)
1358 (and (math-zerop a)
1363 (if (math-negp a)
1364 (math-neg (list 'intv 3 (or aa 0) (or bb 0)))
1366 (if (or (math-floatp a) (math-floatp b)) '(float 0 0) 0))))))
1369 (defun math-mul-symb-fancy (a b)
1370 (or (and math-simplify-only
1371 (not (equal a math-simplify-only))
1376 (math-neg b))
1377 (and (or (and (Math-vectorp a) (math-known-scalarp b))
1378 (and (Math-vectorp b) (math-known-scalarp a)))
1379 (math-map-vec-2 'math-mul a b))
1381 (math-mul b a))
1383 (math-neg (math-mul (nth 1 a) b)))
1385 (math-neg (math-mul a (nth 1 b))))
1387 (math-mul (nth 1 a)
1388 (math-mul (nth 2 a) b)))
1392 (math-known-scalarp b t)
1393 (math-div b (math-normalize
1394 (list '^ (nth 1 a) (math-neg (nth 2 a))))))
1398 (not (math-known-matrixp (nth 1 b)))
1399 (math-div a (math-normalize
1400 (list '^ (nth 1 b) (math-neg (nth 2 b))))))
1402 (or (math-known-scalarp a t) (math-known-scalarp b t))
1403 (let ((temp (math-combine-prod (nth 2 a) b t nil t)))
1405 (math-mul (nth 1 a) temp)
1406 (math-div (math-mul (nth 1 a) b) (nth 2 a)))))
1408 (math-div (math-mul a (nth 1 b)) (nth 2 b)))
1413 (math-add (math-mul a (nth 1 b))
1414 (math-mul a (nth 2 b))))
1419 (math-sub (math-mul a (nth 1 b))
1420 (math-mul a (nth 2 b))))
1424 (math-mul (nth 1 b) (math-mul a (nth 2 b))))
1429 (list 'calcFunc-idn (math-mul (nth 1 a) (nth 1 b))))
1430 (and (math-known-scalarp b)
1431 (list 'calcFunc-idn (math-mul (nth 1 a) b)))
1432 (and (math-known-matrixp b)
1433 (math-mul (nth 1 a) b))))
1436 (or (and (math-known-scalarp a)
1437 (list 'calcFunc-idn (math-mul a (nth 1 b))))
1438 (and (math-known-matrixp a)
1439 (math-mul a (nth 1 b)))))
1440 (and (math-identity-matrix-p a t)
1443 (list 'calcFunc-idn (math-mul
1447 (and (math-known-scalarp b)
1448 (list 'calcFunc-idn (math-mul
1451 (and (math-known-matrixp b)
1452 (math-mul (nth 1 (nth 1 a)) b))))
1453 (and (math-identity-matrix-p b t)
1456 (list 'calcFunc-idn (math-mul (nth 1 a)
1459 (and (math-known-scalarp a)
1460 (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b)))
1462 (and (math-known-matrixp a)
1463 (math-mul a (nth 1 (nth 1 b))))))
1464 (and (math-looks-negp b)
1465 (math-mul (math-neg a) (math-neg b)))
1467 (math-looks-negp a)
1468 (math-mul (math-neg a) (math-neg b)))
1471 (let ((temp (math-combine-prod a (nth 1 b) nil nil t)))
1473 (math-mul temp (nth 2 b)))))
1475 (math-combine-prod a b nil nil nil)))
1485 (let ((s1 (math-possible-signs a)))
1491 (math-neg b))
1494 ((and (eq (car a) 'intv) (math-intv-constp a))
1497 (math-zerop (nth 1 a)))
1502 (math-mul b a))
1510 (math-normalize a))
1512 (defun math-div-objects-fancy (a b)
1514 (math-normalize
1515 (cond ((math-want-polar a b)
1516 (let ((a (math-polar a))
1517 (b (math-polar b)))
1519 (math-div (nth 1 a) (nth 1 b))
1520 (math-fix-circular (math-sub (nth 2 a)
1523 (setq a (math-complex a))
1524 (list 'cplx (math-div (nth 1 a) b)
1525 (math-div (nth 2 a) b)))
1527 (setq a (math-complex a)
1528 b (math-complex b))
1529 (math-div
1531 (math-add (math-mul (nth 1 a) (nth 1 b))
1532 (math-mul (nth 2 a) (nth 2 b)))
1533 (math-sub (math-mul (nth 2 a) (nth 1 b))
1534 (math-mul (nth 1 a) (nth 2 b))))
1535 (math-add (math-sqr (nth 1 b))
1536 (math-sqr (nth 2 b))))))))
1537 ((math-matrixp b)
1538 (if (math-square-matrixp b)
1541 (if (math-matrixp a)
1543 (math-lud-solve (math-matrix-lud b) a b)
1545 (math-transpose
1546 (math-lud-solve (math-matrix-lud
1547 (math-transpose b))
1548 (math-transpose a) b))
1549 (math-dimension-error)))
1551 (math-mat-col (math-lud-solve (math-matrix-lud b)
1552 (math-col-matrix a) b)
1554 (math-dimension-error)))
1557 (math-mul a (calcFunc-inv b)))))
1558 (math-reject-arg b 'square-matrixp)))
1560 (math-map-vec-2 'math-div a b))
1563 (let ((x (math-div (nth 1 a) (nth 1 b))))
1564 (math-make-sdev x
1565 (math-div (math-hypot (nth 2 a)
1566 (math-mul (nth 2 b) x))
1570 (math-make-sdev (math-div (nth 1 a) b) (math-div (nth 2 a) b))
1571 (math-reject-arg 'realp b))))
1575 (let ((x (math-div a (nth 1 b))))
1576 (math-make-sdev x
1577 (math-div (math-mul (nth 2 b) x) (nth 1 b)))))
1580 (math-neg (math-div a (math-neg b)))
1581 (math-make-intv (nth 1 a)
1582 (math-div (nth 2 a) b)
1583 (math-div (nth 3 a) b))))
1589 (math-neg (math-div (math-neg a) b))
1591 (math-make-intv (aref [0 2 1 3] (nth 1 b))
1592 (math-div a (nth 3 b))
1593 (math-div a (nth 2 b)))))
1597 (math-neg (math-div a (math-neg b)))
1600 (math-reject-arg b "*Division by zero")))))
1601 ((and (eq (car-safe a) 'intv) (math-intv-constp a)
1602 (eq (car-safe b) 'intv) (math-intv-constp b))
1607 (lo (math-div a (nth 2 b)))
1608 (hi (math-div a (nth 3 b))))
1615 (math-combine-intervals
1617 (and (math-infinitep (nth 2 lo))
1618 (not (math-zerop (nth 2 b)))))
1621 (and (math-infinitep (nth 3 lo))
1622 (not (math-zerop (nth 2 b)))))
1625 (and (math-infinitep (nth 2 hi))
1626 (not (math-zerop (nth 3 b)))))
1629 (and (math-infinitep (nth 3 hi))
1630 (not (math-zerop (nth 3 b)))))
1635 (math-neg (math-div a (math-neg b)))
1638 (math-reject-arg b "*Division by zero")))))
1642 (math-make-mod (math-div-mod (nth 1 a) (nth 1 b) (nth 2 a))
1646 (math-make-mod (math-div-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
1649 (math-make-mod (math-div-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
1652 (math-with-extra-prec 1
1653 (math-div (math-from-hms a 'deg)
1654 (math-from-hms b 'deg)))
1655 (math-with-extra-prec 2
1656 (math-to-hms (math-div (math-from-hms a 'deg) b) 'deg))))
1659 (defun math-div-by-zero (a b)
1660 (if (math-infinitep a)
1667 (if (math-zerop a)
1670 (math-mul a '(var inf var-inf))
1672 (math-mul a '(neg (var inf var-inf)))
1676 (math-reject-arg a "*Division by zero"))))
1678 (defun math-div-zero (a b)
1679 (if (math-known-matrixp b)
1680 (if (math-vectorp b)
1681 (math-map-vec-2 'math-div a b)
1682 (math-mimic-ident 0 b))
1685 (if (and (eq (car-safe b) 'intv) (math-intv-constp b)
1686 (not (math-posp b)) (not (math-negp b)))
1689 (if (and (math-zerop (nth 2 b))
1692 (if (and (math-zerop (nth 3 b))
1695 (math-reject-arg b "*Division by zero"))
1698 ;; For math-div-symb-fancy
1699 (defvar math-trig-inverses
1713 (defvar math-div-trig)
1714 (defvar math-div-non-trig)
1716 (defun math-div-new-trig (tr)
1717 (if math-div-trig
1718 (setq math-div-trig
1719 (list '* tr math-div-trig))
1720 (setq math-div-trig tr)))
1722 (defun math-div-new-non-trig (ntr)
1723 (if math-div-non-trig
1724 (setq math-div-non-trig
1725 (list '* ntr math-div-non-trig))
1726 (setq math-div-non-trig ntr)))
1728 (defun math-div-isolate-trig (expr)
1731 (math-div-isolate-trig-term (nth 1 expr))
1732 (math-div-isolate-trig (nth 2 expr)))
1733 (math-div-isolate-trig-term expr)))
1735 (defun math-div-isolate-trig-term (term)
1736 (let ((fn (assoc (car-safe term) math-trig-inverses)))
1738 (math-div-new-trig
1740 (math-div-new-non-trig term))))
1742 (defun math-div-symb-fancy (a b)
1743 (or (and (math-known-matrixp b)
1744 (math-mul a (math-pow b -1)))
1745 (and math-simplify-only
1746 (not (equal a math-simplify-only))
1749 (and (Math-equal-int b -1) (math-neg a))
1750 (and (Math-vectorp a) (math-known-scalarp b)
1751 (math-map-vec-2 'math-div a b))
1754 (math-mul a (math-normalize
1755 (list '^ (nth 1 b) (math-neg (nth 2 b))))))
1757 (math-neg (math-div (nth 1 a) b)))
1759 (math-neg (math-div a (nth 1 b))))
1761 (math-div (nth 1 a) (math-mul (nth 2 a) b)))
1763 (or (math-known-scalarp (nth 1 b) t)
1764 (math-known-scalarp (nth 2 b) t))
1765 (math-div (math-mul a (nth 2 b)) (nth 1 b)))
1767 (math-mul (math-make-frac (nth 2 b) (nth 1 b)) a))
1772 (math-add (math-div (nth 1 a) b)
1773 (math-div (nth 2 a) b)))
1778 (math-sub (math-div (nth 1 a) b)
1779 (math-div (nth 2 a) b)))
1781 (math-looks-negp a))
1782 (math-looks-negp b)
1783 (math-div (math-neg a) (math-neg b)))
1785 (math-looks-negp a)
1786 (math-div (math-neg a) (math-neg b)))
1791 (list 'calcFunc-idn (math-div (nth 1 a) (nth 1 b))))
1792 (and (math-known-scalarp b)
1793 (list 'calcFunc-idn (math-div (nth 1 a) b)))
1794 (and (math-known-matrixp b)
1795 (math-div (nth 1 a) b))))
1798 (or (and (math-known-scalarp a)
1799 (list 'calcFunc-idn (math-div a (nth 1 b))))
1800 (and (math-known-matrixp a)
1801 (math-div a (nth 1 b)))))
1802 (and math-simplifying
1803 (let ((math-div-trig nil)
1804 (math-div-non-trig nil))
1805 (math-div-isolate-trig b)
1806 (if math-div-trig
1807 (if math-div-non-trig
1808 (math-div (math-mul a math-div-trig) math-div-non-trig)
1809 (math-mul a math-div-trig))
1812 (or (math-known-matrixp a) (math-known-matrixp b)))
1813 (math-combine-prod a b nil t nil)
1816 (let ((c (math-combine-prod (nth 1 a) (nth 1 b) nil t t)))
1818 (math-div (math-mul c (nth 2 a)) (nth 2 b))))
1819 (let ((c (math-combine-prod (nth 1 a) b nil t t)))
1821 (math-mul c (nth 2 a)))))
1823 (let ((c (math-combine-prod a (nth 1 b) nil t t)))
1825 (math-div c (nth 2 b))))
1826 (math-combine-prod a b nil t nil))))
1827 (and (math-infinitep a)
1828 (if (math-infinitep b)
1834 (if (or (math-posp b)
1836 (math-zerop (nth 2 b))))
1838 (not (math-intv-constp b t)))
1841 (if (or (math-negp b)
1843 (math-zerop (nth 3 b))))
1845 (not (math-intv-constp b t)))
1847 (math-neg a))
1849 (math-negp (nth 2 b)) (math-posp (nth 3 b)))
1852 (and (math-infinitep b)
1856 (math-mul-zero b a))))
1861 (if (math-known-scalarp a)
1862 (math-div b a)
1863 (math-mul (math-pow a -1) b)))
1866 (math-normalize (list '% a b)))
1868 (defun math-mod-fancy (a b)
1870 (if (or (math-posp a) (math-zerop a))
1872 (if (math-negp a)
1875 (if (math-negp (nth 2 a))
1879 ((and (eq (car-safe a) 'mod) (Math-realp b) (math-posp b))
1880 (math-make-mod (nth 1 a) b))
1881 ((and (eq (car-safe a) 'intv) (math-intv-constp a t) (math-posp b))
1882 (math-mod-intv a b))
1891 (math-normalize (list '^ a b)))
1893 (defun math-pow-of-zero (a b)
1895 (if (math-floatp b) (setq a (math-float a)))
1904 (math-reject-arg (list '^ a b) "*Indeterminate form")))
1906 ((math-known-posp b)
1908 ;; 0^negative is undefined (let math-div handle it)
1909 ((math-known-negp b)
1910 (math-div 1 a))
1912 ((math-infinitep b)
1917 (math-negp (nth 2 b))
1918 (math-posp (nth 3 b)))
1924 (defun math-pow-zero (a b)
1926 (math-make-mod 1 (nth 2 a))
1927 (if (math-known-matrixp a)
1928 (math-mimic-ident 1 a)
1929 (if (math-infinitep a)
1931 (if (and (eq (car a) 'intv) (math-intv-constp a)
1932 (or (and (not (math-posp a)) (not (math-negp a)))
1933 (not (math-intv-constp a t))))
1935 (if (or (math-floatp a) (math-floatp b))
1936 '(float 1 0) 1))))))
1938 (defun math-pow-fancy (a b)
1940 (or (if (memq (math-quarter-integer b) '(1 2 3))
1941 (let ((sqrt (math-sqrt (if (math-floatp b)
1942 (math-float a) a))))
1944 (math-pow sqrt (math-mul 2 b))))
1948 (let ((root (math-nth-root a (nth 2 b))))
1949 (and root (math-ipow root (nth 1 b))))))
1950 (and (or (eq a 10) (equal a '(float 1 1)))
1951 (math-num-integerp b)
1952 (calcFunc-scf '(float 1 0) b))
1955 (math-with-extra-prec 2
1956 (math-exp-raw
1957 (math-float (math-mul b (math-ln-raw (math-float a))))))))
1961 (cond ((and math-simplify-only
1962 (not (equal a math-simplify-only)))
1967 (math-known-matrixp (nth 1 a))
1968 (math-known-matrixp (nth 2 a)))
1972 (and (not (math-known-scalarp (nth 1 a)))
1973 (not (math-known-scalarp (nth 2 a)))))))
1975 (math-known-square-matrixp (nth 1 a))
1976 (math-known-square-matrixp (nth 2 a)))
1977 (math-mul (math-pow-fancy (nth 2 a) -1)
1978 (math-pow-fancy (nth 1 a) -1))
1981 (or (math-known-num-integerp b)
1982 (math-known-nonnegp (nth 1 a))
1983 (math-known-nonnegp (nth 2 a))))
1984 (math-mul (math-pow (nth 1 a) b)
1985 (math-pow (nth 2 a) b)))
1987 (or (math-known-num-integerp b)
1988 (math-known-nonnegp (nth 2 a))))
1989 (math-div (math-pow (nth 1 a) b)
1990 (math-pow (nth 2 a) b)))
1992 (math-known-nonnegp (nth 1 a))
1993 (not (math-equal-int (nth 1 a) 1)))
1994 (math-mul (math-pow (nth 1 a) b)
1995 (math-pow (math-div 1 (nth 2 a)) b)))
1997 (or (math-known-num-integerp b)
1998 (math-known-nonnegp (nth 1 a))))
1999 (math-pow (nth 1 a) (math-mul (nth 2 a) b)))
2001 (or (math-known-num-integerp b)
2002 (math-known-nonnegp (nth 1 a))))
2003 (math-pow (nth 1 a) (math-div b 2)))
2005 (math-known-evenp (nth 2 a))
2006 (memq (math-quarter-integer b) '(1 2 3))
2007 (math-known-realp (nth 1 a)))
2008 (math-abs (math-pow (nth 1 a) (math-mul (nth 2 a) b))))
2009 ((and (math-looks-negp a)
2010 (math-known-integerp b)
2011 (setq temp (or (and (math-known-evenp b)
2012 (math-pow (math-neg a) b))
2013 (and (math-known-oddp b)
2014 (math-neg (math-pow (math-neg a)
2018 (math-known-realp (nth 1 a))
2019 (math-known-evenp b))
2020 (math-pow (nth 1 a) b))
2021 ((math-infinitep a)
2025 (math-mul (math-pow -1 b) (math-pow (nth 1 a) b)))
2026 ((math-posp b)
2028 ((math-negp b)
2029 (if (math-floatp b) '(float 0 0) 0))
2031 (math-intv-constp b))
2035 ((math-infinitep b)
2037 (cond ((math-negp b)
2038 (math-pow (math-div 1 a) (math-neg b)))
2039 ((not (math-posp b))
2041 ((math-equal-int (setq scale (calcFunc-abssqr a)) 1)
2044 (if (math-floatp a) '(float 0 0) 0))
2050 (math-intv-constp a))
2052 (if (math-equal-int (nth 3 a) 1)
2060 (math-known-num-integerp b))
2061 (list 'calcFunc-idn (math-pow (nth 1 a) b)))
2067 (if (and (math-constp a) (math-constp b))
2068 (math-with-extra-prec 2
2069 (let* ((ln (math-ln-raw (math-float (nth 1 a))))
2070 (pow (math-exp-raw
2071 (math-float (math-mul (nth 1 b) ln)))))
2072 (math-make-sdev
2074 (math-mul
2076 (math-hypot (math-mul (nth 2 a)
2077 (math-div (nth 1 b) (nth 1 a)))
2078 (math-mul (nth 2 b) ln))))))
2079 (let ((pow (math-pow (nth 1 a) (nth 1 b))))
2080 (math-make-sdev
2082 (math-mul pow
2083 (math-hypot (math-mul (nth 2 a)
2084 (math-div (nth 1 b) (nth 1 a)))
2085 (math-mul (nth 2 b) (calcFunc-ln
2088 (if (math-constp a)
2089 (math-with-extra-prec 2
2090 (let ((pow (math-pow (nth 1 a) (math-sub b 1))))
2091 (math-make-sdev (math-mul pow (nth 1 a))
2092 (math-mul pow (math-mul (nth 2 a) b)))))
2093 (math-make-sdev (math-pow (nth 1 a) b)
2094 (math-mul (math-pow (nth 1 a) (math-add b -1))
2095 (math-mul (nth 2 a) b)))))
2097 (math-with-extra-prec 2
2098 (let* ((ln (math-ln-raw (math-float a)))
2099 (pow (calcFunc-exp (math-mul (nth 1 b) ln))))
2100 (math-make-sdev pow (math-mul pow (math-mul (nth 2 b) ln))))))
2101 ((and (eq (car-safe a) 'intv) (math-intv-constp a)
2105 (and (math-zerop (nth 2 a))
2109 (and (math-zerop (nth 3 a))
2112 (if (math-evenp b)
2113 (setq a (math-abs a)))
2114 (let ((calc-infinite-mode (if (math-zerop (nth 3 a)) -1 1)))
2115 (math-sort-intv (nth 1 a)
2116 (math-pow (nth 2 a) b)
2117 (math-pow (nth 3 a) b))))
2118 ((and (eq (car-safe b) 'intv) (math-intv-constp b)
2120 (math-sort-intv (nth 1 b)
2121 (math-pow a (nth 2 b))
2122 (math-pow a (nth 3 b))))
2123 ((and (eq (car-safe a) 'intv) (math-intv-constp a)
2124 (eq (car-safe b) 'intv) (math-intv-constp b)
2129 (let ((lo (math-pow a (nth 2 b)))
2130 (hi (math-pow a (nth 3 b))))
2135 (math-combine-intervals
2137 (math-infinitep (nth 2 lo)))
2140 (math-infinitep (nth 3 lo)))
2143 (math-infinitep (nth 2 hi)))
2146 (math-infinitep (nth 3 hi)))
2150 (math-make-mod (math-pow-mod (nth 1 a) (nth 1 b) (nth 2 a))
2153 (math-make-mod (math-pow-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
2155 (math-make-mod (math-pow-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
2157 (math-reject-arg a 'numberp))
2159 (math-reject-arg b 'numberp))))
2161 (defun math-quarter-integer (x)
2164 (if (math-negp x)
2166 (setq x (math-quarter-integer (math-neg x)))
2175 (if (eq (car x) 'float)
2190 (defun math-pow-mod (a b m) ; [R R R R]
2193 (math-div-mod 1 (math-pow-mod a (Math-integer-neg b) m) m)
2196 (math-pow-mod-step a b m)))
2197 (math-mod (math-pow a b) m)))
2199 (defun math-pow-mod-step (a n m) ; [I I I I]
2200 (math-working "pow" a)
2205 (let ((rest (math-pow-mod-step
2206 (math-imod (math-mul a a) m)
2207 (math-div2 n)
2209 (if (math-evenp n)
2211 (math-mod (math-mul a rest) m)))))))
2212 (math-working "pow" val)
2217 (defun math-min (a b)
2225 (if (= (setq res (math-compare (nth 2 b) lo)) -1)
2229 (if (= (setq res (math-compare (nth 3 b) hi)) -1)
2233 (math-make-intv (+ (if lom 2 0) (if him 1 0)) lo hi))
2234 (math-min a (list 'intv 3 b b)))
2236 (math-min (list 'intv 3 a a) b)
2237 (let ((res (math-compare a b)))
2248 (and (eq (car a) 'intv) (math-intv-constp a))
2249 (math-infinitep a)))
2250 (math-reject-arg a 'anglep))
2251 (math-min-list a b)))
2253 (defun math-min-list (a b)
2256 (and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
2257 (math-infinitep (car b)))
2258 (math-min-list (math-min a (car b)) (cdr b))
2259 (math-reject-arg (car b) 'anglep))
2263 (defun math-max (a b)
2266 (math-neg (math-min (math-neg a) (math-neg b)))
2267 (let ((res (math-compare a b)))
2278 (and (eq (car a) 'intv) (math-intv-constp a))
2279 (math-infinitep a)))
2280 (math-reject-arg a 'anglep))
2281 (math-max-list a b)))
2283 (defun math-max-list (a b)
2286 (and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
2287 (math-infinitep (car b)))
2288 (math-max-list (math-max a (car b)) (cdr b))
2289 (math-reject-arg (car b) 'anglep))
2294 (defun math-abs (a)
2296 (math-neg a))
2300 (math-hypot (nth 1 a) (nth 2 a)))
2305 (math-sqrt (calcFunc-abssqr a))
2307 (math-hypot (nth 1 a) (nth 2 a))
2309 (math-abs (nth 1 a))
2312 (list 'sdev (math-abs (nth 1 a)) (nth 2 a)))
2313 ((and (eq (car a) 'intv) (math-intv-constp a))
2316 (let* ((nlo (math-neg (nth 2 a)))
2317 (res (math-compare nlo (nth 3 a))))
2319 (math-make-intv (if (memq (nth 1 a) '(0 1)) 2 3) 0 nlo))
2321 (math-make-intv (if (eq (nth 1 a) 0) 2 3) 0 nlo))
2323 (math-make-intv (if (memq (nth 1 a) '(0 2)) 2 3)
2325 ((math-looks-negp a)
2326 (list 'calcFunc-abs (math-neg a)))
2327 ((let ((signs (math-possible-signs a)))
2329 (and (memq signs '(1 3)) (math-neg a)))))
2330 ((let ((inf (math-infinitep a)))
2338 (defalias 'calcFunc-abs 'math-abs)
2340 (defun math-float-fancy (a)
2342 (cons (car a) (cons (nth 1 a) (mapcar 'math-float (nthcdr 2 a)))))
2344 (math-numberp (nth 1 a)))
2345 (list (car a) (math-float (nth 1 a))
2346 (list 'calcFunc-float (nth 2 a))))
2349 (math-numberp (nth 1 (nth 1 a))))
2350 (list '* (math-float (nth 1 (nth 1 a)))
2351 (list 'calcFunc-float (list '/ (nth 2 (nth 1 a)) (nth 2 a)))))
2352 ((math-infinitep a) a)
2353 ((eq (car a) 'calcFunc-float) a)
2361 (t (math-reject-arg a 'objectp))))
2363 (defalias 'calcFunc-float 'math-float)
2365 ;; The variable math-trunc-prec is local to math-trunc in calc-misc.el,
2366 ;; but used by math-trunc-fancy which is called by math-trunc.
2367 (defvar math-trunc-prec)
2369 (defun math-trunc-fancy (a)
2370 (cond ((eq (car a) 'frac) (math-quotient (nth 1 a) (nth 2 a)))
2371 ((eq (car a) 'cplx) (math-trunc (nth 1 a)))
2372 ((eq (car a) 'polar) (math-trunc (math-complex a)))
2374 ((eq (car a) 'date) (list 'date (math-trunc (nth 1 a))))
2376 (if (math-messy-integerp (nth 2 a))
2377 (math-trunc (math-make-mod (nth 1 a) (math-trunc (nth 2 a))))
2378 (math-make-mod (math-trunc (nth 1 a)) (nth 2 a))))
2380 (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
2389 (math-add (math-trunc (nth 2 a)) 1)
2390 (math-trunc (nth 2 a)))
2394 (math-add (math-trunc (nth 3 a)) -1)
2395 (math-trunc (nth 3 a)))))
2396 ((math-provably-integerp a) a)
2398 (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a))
2399 ((math-infinitep a)
2400 (if (or (math-posp a) (math-negp a))
2403 ((math-to-integer a))
2404 (t (math-reject-arg a 'numberp))))
2406 (defun math-trunc-special (a prec)
2408 (setq prec (math-trunc prec)))
2410 (math-reject-arg prec 'fixnump))
2412 (math-provably-integerp a))
2414 (calcFunc-scf (math-trunc (let ((calc-prefer-frac t))
2418 (defun math-to-integer (a)
2433 (math-float (math-trunc a prec))))
2435 ;; The variable math-floor-prec is local to math-floor in calc-misc.el,
2436 ;; but used by math-floor-fancy which is called by math-floor.
2437 (defvar math-floor-prec)
2439 (defun math-floor-fancy (a)
2440 (cond ((math-provably-integerp a) a)
2442 (if (or (math-posp a)
2443 (and (math-zerop (nth 2 a))
2444 (math-zerop (nth 3 a))))
2445 (math-trunc a)
2446 (math-add (math-trunc a) -1)))
2447 ((eq (car a) 'date) (list 'date (math-floor (nth 1 a))))
2449 (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
2455 (math-floor (nth 2 a))
2458 (math-add (math-floor (nth 3 a)) -1)
2459 (math-floor (nth 3 a)))))
2461 (math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a))
2462 ((math-infinitep a)
2463 (if (or (math-posp a) (math-negp a))
2466 ((math-to-integer a))
2467 (t (math-reject-arg a 'anglep))))
2469 (defun math-floor-special (a prec)
2471 (setq prec (math-trunc prec)))
2473 (math-reject-arg prec 'fixnump))
2475 (math-provably-integerp a))
2477 (calcFunc-scf (math-floor (let ((calc-prefer-frac t))
2486 (math-float (math-floor a prec))))
2489 (defun math-ceiling (a &optional prec) ; [Public]
2492 (setq prec (math-trunc prec)))
2494 (math-reject-arg prec 'fixnump))
2496 (math-provably-integerp a))
2498 (calcFunc-scf (math-ceiling (let ((calc-prefer-frac t))
2502 ((Math-messy-integerp a) (math-trunc a))
2505 (math-add (math-trunc a) 1)
2506 (math-trunc a)))
2507 ((math-provably-integerp a) a)
2509 (if (or (math-negp a)
2510 (and (math-zerop (nth 2 a))
2511 (math-zerop (nth 3 a))))
2512 (math-trunc a)
2513 (math-add (math-trunc a) 1)))
2514 ((eq (car a) 'date) (list 'date (math-ceiling (nth 1 a))))
2516 (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
2524 (math-add (math-floor (nth 2 a)) 1)
2525 (math-ceiling (nth 2 a)))
2526 (math-ceiling (nth 3 a))))
2528 (math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
2529 ((math-infinitep a)
2530 (if (or (math-posp a) (math-negp a))
2533 ((math-to-integer a))
2534 (t (math-reject-arg a 'anglep))))
2536 (defalias 'calcFunc-ceil 'math-ceiling)
2543 (math-float (math-ceiling a prec))))
2545 (defvar math-rounding-mode nil)
2548 (defun math-round (a &optional prec)
2551 (setq prec (math-trunc prec)))
2553 (math-reject-arg prec 'fixnump))
2555 (math-provably-integerp a))
2557 (calcFunc-scf (math-round (let ((calc-prefer-frac t))
2562 (math-trunc a)
2563 (if (and (Math-negp a) (not (eq math-rounding-mode 'up)))
2564 (math-neg (math-round (math-neg a)))
2566 (math-add a (if (Math-ratp a)
2568 '(float 5 -1)))))
2569 (if (and (Math-num-integerp a) (eq math-rounding-mode 'even))
2571 (setq a (math-floor a))
2572 (or (math-evenp a)
2573 (setq a (math-sub a 1)))
2575 (math-floor a)))))
2576 ((math-provably-integerp a) a)
2577 ((eq (car a) 'date) (list 'date (math-round (nth 1 a))))
2579 (math-floor (math-add a '(frac 1 2))))
2581 (math-map-vec (function (lambda (x) (math-round x prec))) a))
2582 ((math-infinitep a)
2583 (if (or (math-posp a) (math-negp a))
2586 ((math-to-integer a))
2587 (t (math-reject-arg a 'anglep))))
2589 (defalias 'calcFunc-round 'math-round)
2592 (let ((math-rounding-mode 'even))
2593 (math-round a prec)))
2596 (let ((math-rounding-mode 'up))
2597 (math-round a prec)))
2604 (math-float (math-round a prec))))
2607 (let ((math-rounding-mode 'even))
2611 (let ((math-rounding-mode 'up))
2620 (list 'float (nth 1 x) (- 1 (math-numdigs (nth 1 x)))))
2629 (math-normalize (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
2639 (math-scale-int x n)
2640 (math-div x (math-scale-int 1 (- n)))))
2643 (math-make-frac (math-scale-int (nth 1 x) n) (nth 2 x))
2644 (math-make-frac (nth 1 x) (math-scale-int (nth 2 x) (- n)))))
2645 ((eq (car x) 'float)
2646 (math-make-float (nth 1 x) (+ (nth 2 x) n)))
2648 (math-normalize
2653 (math-normalize
2658 (math-normalize
2664 (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
2665 ((math-infinitep x)
2670 (if (math-messy-integerp n)
2672 (calcFunc-scf x (math-trunc n))
2673 (math-overflow n))
2674 (if (math-integerp n)
2675 (math-overflow n)
2683 (math-reject-arg step 'integerp))
2685 (math-add x step))
2686 ((eq (car x) 'float)
2687 (if (and (math-zerop x)
2688 (eq (car-safe relative-to) 'float))
2689 (math-mul step
2691 (math-add-float x (math-make-float
2694 (- (math-numdigs (nth 1 x))
2698 (math-add x step)
2699 (math-add x (list 'hms 0 0 step))))
2701 (math-reject-arg x 'realp))))
2704 (calcFunc-incr x (math-neg (or step 1)) relative-to))
2707 (if (math-objectp x)
2709 (math-div x 100))
2713 (if (and (math-objectp x) (math-objectp y))
2714 (math-div (math-sub y x) x)
2720 (math-mul a a))
2722 (math-add (math-sqr (nth 1 a))
2723 (math-sqr (nth 2 a))))
2725 (math-sqr (nth 1 a)))
2726 ((and (memq (car a) '(sdev intv)) (math-constp a))
2727 (math-sqr (math-abs a)))
2729 (math-reduce-vec 'math-add (math-map-vec 'calcFunc-abssqr a)))
2730 ((math-known-realp a)
2731 (math-pow a 2))
2732 ((let ((inf (math-infinitep a)))
2734 (math-mul (calcFunc-abssqr (math-infinite-dir a inf)) inf))))
2738 (defsubst math-sqr (a)
2739 (math-mul a a))
2745 (math-quotient a b))
2749 (math-floor (math-div a b)))
2750 (math-reject-arg b 'realp)))
2754 (math-floor (math-div a b)))
2755 (math-reject-arg b 'hmsp)))
2758 (math-floor (math-div a b)))
2759 ((or (math-infinitep a)
2760 (math-infinitep b))
2761 (math-div a b))
2762 (t (math-reject-arg a 'anglep))))
2766 (defun math-combine-sum (a b nega negb scalar-okay)
2768 (math-add-or-sub a b nega negb)
2779 (math-div 1 (nth 2 a)))
2793 (math-div 1 (nth 2 b)))
2798 (and (if math-simplifying
2802 (if nega (setq amult (math-neg amult)))
2803 (if negb (setq bmult (math-neg bmult)))
2804 (setq amult (math-add amult bmult))
2805 (math-mul amult a))))))
2807 (defun math-add-or-sub (a b aneg bneg)
2808 (if aneg (setq a (math-neg a)))
2809 (if bneg (setq b (math-neg b)))
2811 (math-normalize (list '+ a b))
2812 (math-add a b)))
2814 (defvar math-combine-prod-e '(var e var-e))
2818 ;; math-unit-prefixes is defined in calc-units.el,
2820 (defvar math-unit-prefixes)
2822 (defun math-combine-prod (a b inva invb scalar-okay)
2828 (setq a (math-mul-or-div a b inva invb))
2833 (math-looks-negp (nth 2 a)))
2834 (math-mul (math-pow (nth 1 a) (math-neg (nth 2 a))) b))
2837 (math-looks-negp (nth 2 b)))
2838 (math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b)))))
2839 ((and math-simplifying
2840 (math-combine-prod-trig a b)))
2844 (or math-simplifying
2852 (or math-simplifying
2855 a math-combine-prod-e))))
2858 (setq a (math-div 1 a) apow (math-neg apow)))
2861 (or math-simplifying
2869 (or math-simplifying
2872 b math-combine-prod-e))))
2875 (setq b (math-div 1 b) bpow (math-neg bpow)))
2876 (if inva (setq apow (math-neg apow)))
2877 (if invb (setq bpow (math-neg bpow)))
2878 (or (and (if math-simplifying
2879 (math-commutative-equal a b)
2881 (let ((sumpow (math-add apow bpow)))
2887 (and (math-looks-negp sumpow)
2889 (setq a (math-div 1 a)
2890 sumpow (math-neg sumpow)))
2894 (math-div 1 (list 'calcFunc-sqrt a)))
2895 ((and (eq a math-combine-prod-e)
2900 (math-pow a sumpow)
2902 (and math-simplifying-units
2903 math-combining-units
2904 (let* ((ua (math-check-unit-name a))
2907 (eq ua (setq ub (math-check-unit-name b)))
2913 math-unit-prefixes)))
2918 math-unit-prefixes))))
2924 (math-mul (math-pow (math-div ua ub) apow)
2925 (math-pow b (math-add apow bpow)))))))
2929 (list 'calcFunc-sqrt (math-mul a b)))
2931 (math-div 1 (list 'calcFunc-sqrt (math-mul a b))))
2933 (setq a (math-mul a b))
2935 (math-pow a apow)
2938 (defun math-combine-prod-trig (a b)
2942 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2946 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2950 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2954 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2958 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2962 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2966 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2970 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2974 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2978 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2982 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2986 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2990 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2994 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2998 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
3002 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
3006 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
3010 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
3015 (defun math-mul-or-div (a b ainv binv)
3017 (math-normalize
3020 (list '/ (math-div 1 a) b)
3027 (math-div (math-div 1 a) b)
3028 (math-div b a))
3030 (math-div a b)
3031 (math-mul a b)))))
3033 ;; The variable math-com-bterms is local to math-commutative-equal,
3034 ;; but is used by math-commutative collect, which is called by
3035 ;; math-commutative-equal.
3036 (defvar math-com-bterms)
3038 (defun math-commutative-equal (a b)
3041 (let ((math-com-bterms nil) aterms p)
3042 (math-commutative-collect b nil)
3043 (setq aterms math-com-bterms math-com-bterms nil)
3044 (math-commutative-collect a nil)
3045 (and (= (length aterms) (length math-com-bterms))
3049 (setq p math-com-bterms)
3054 (setq math-com-bterms (delq (car p) math-com-bterms)
3059 (defun math-commutative-collect (b neg)
3062 (math-commutative-collect (nth 1 b) neg)
3063 (math-commutative-collect (nth 2 b) neg))
3066 (math-commutative-collect (nth 1 b) neg)
3067 (math-commutative-collect (nth 2 b) (not neg)))
3068 (setq math-com-bterms (cons (if neg (math-neg b) b) math-com-bterms)))))