• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10.1/emacs-93/emacs/lisp/calc/

Lines Matching +defs:math +defs:transpose

88 	 (if (and (math-objvecp (car items))
89 (math-objvecp (nth 1 items))
90 (math-objvecp (nth 2 items)))
91 (if (and (math-num-integerp (car items))
92 (math-num-integerp (nth 1 items)))
93 (if (math-realp (nth 2 items))
97 (math-normalize (list '+
106 (if (math-realp (car items))
110 (if (math-objvecp (car items))
115 (while (and p (math-objvecp (car p)))
116 (or (math-integerp (car p))
121 (list 'date (math-dt-to-date items)))))
141 (if (and (math-realp (car items)) (math-realp (nth 1 items)))
143 (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
145 (math-normalize (list '+ (car items)
148 (if (and (math-realp (car items)) (math-anglep (nth 1 items)))
150 (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
152 (math-normalize (list '* (car items)
153 (if (math-anglep (nth 1 items))
157 (math-to-radians-2
161 (math-quarter-circle
166 (if (or (math-scalarp x) (not (math-objvecp x)))
167 (if (or (math-anglep sigma) (not (math-objvecp sigma)))
168 (math-make-sdev x sigma)
174 (if (and (math-anglep a) (math-anglep m))
175 (if (math-posp m)
176 (math-make-mod a m)
178 (if (and (math-objectp a) (math-objectp m))
184 (if (and (or (math-anglep lo) (eq (car lo) 'date)
185 (not (math-objvecp lo)))
186 (or (math-anglep hi) (eq (car hi) 'date)
187 (not (math-objvecp hi))))
188 (math-make-intv (+ mode 9) lo hi)
191 (if (math-zerop (nth 1 items))
193 (if (and (math-integerp (car items)) (math-integerp (nth 1 items)))
194 (math-normalize (cons 'frac items))
195 (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
199 (if (and (math-realp (car items)) (math-integerp (nth 1 items)))
200 (calcFunc-scf (math-float (car items)) (nth 1 items))
201 (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
203 (math-normalize
237 (math-objvecp item))
276 (math-date-to-dt (math-floor (nth 1 item)))
280 (append (math-date-to-dt (nth 1 item))
281 (and (not (math-integerp (nth 1 item)))
298 (cdr (math-complex item))
305 (cdr (math-polar item))
327 (list (nth 1 item) (math-normalize (nth 2 item)))
463 (defun calc-transpose (arg)
468 (defun calc-conj-transpose (arg)
583 (or (math-vectorp m)
584 (math-reject-arg m 'vectorp))
585 (cons 'vec (math-mat-dimens m)))
589 (defun math-map-vec (f a)
590 (if (math-vectorp a)
594 (defun math-dimension-error ()
606 (math-make-vec-dimen obj dims))
608 (defun math-make-vec-dimen (obj dims)
612 (not (math-numberp obj)))
615 (math-make-vec-dimen obj (cdr dims)))))
617 (math-reject-arg (car dims) 'fixnatnump))
665 (defun math-map-vec-2 (f a b)
666 (if (math-vectorp a)
667 (if (math-vectorp b)
671 (math-dimension-error))
673 (if a (math-dimension-error))
679 (if (math-vectorp b)
689 (defun math-reduce-vec (f a)
690 (if (math-vectorp a)
700 (defun math-reduce-cols (f a)
701 (if (math-matrixp a)
702 (cons 'vec (math-reduce-cols-col-step f (cdr a) 1 (length (nth 1 a))))
705 (defun math-reduce-cols-col-step (f a col cols)
707 (cons (math-reduce-cols-row-step f (nth col (car a)) col (cdr a))
708 (math-reduce-cols-col-step f a (1+ col) cols))))
710 (defun math-reduce-cols-row-step (f tot col a)
712 (math-reduce-cols-row-step f
720 (defun math-dot-product (a b)
722 (let ((accum (math-mul (car a) (car b))))
724 (setq accum (math-add accum (math-mul (car a) (car b)))))
731 (if (math-vectorp v)
733 (if (math-objectp v)
740 (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
741 (if (and (eq (car-safe n) 'intv) (math-constp n))
743 (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
744 (math-add (nth 3 n) (if (memq (nth 1 n) '(1 3)) 1 0)))
745 (or (and (integerp (setq n (math-check-integer n)))
747 (math-reject-arg n 'fixposintp))
749 (math-reject-arg mat 'vectorp))
751 (math-reject-arg n "*Index out of range")))))
756 (if (math-num-integerp n)
762 (defun math-mat-col (mat n)
768 (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
769 (if (and (eq (car-safe n) 'intv) (math-constp n))
770 (if (math-matrixp mat)
771 (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
773 (or (and (integerp (setq n (math-check-integer n)))
775 (math-reject-arg n 'fixposintp))
777 (math-reject-arg mat 'vectorp))
778 (or (if (math-matrixp mat)
780 (math-mat-col mat n))
782 (math-reject-arg n "*Index out of range")))))
785 (defun math-mat-less-row (mat n)
789 (math-mat-less-row (cdr mat) (1- n)))))
792 (and (integerp (setq n (math-check-integer n)))
795 (math-mat-less-row mat n)))
798 (defun math-mat-less-col (mat n)
799 (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
803 (and (integerp (setq n (math-check-integer n)))
805 (if (math-matrixp mat)
807 (math-mat-less-col mat n))
808 (math-mat-less-row mat n))))
811 (if (math-square-matrixp mat)
812 (cons 'vec (math-get-diag-step (cdr mat) 1))
816 (defun math-get-diag-step (row n)
819 (math-get-diag-step (cdr row) (1+ n)))))
821 (defun math-transpose (mat) ; [Public]
825 (setq m (cons (math-mat-col mat col) m)))
829 (if (math-vectorp mat)
830 (if (math-matrixp mat)
831 (math-transpose mat)
832 (math-col-matrix mat))
833 (if (math-numberp mat)
835 (math-reject-arg mat 'matrixp))))
841 (or (Math-vectorp els) (math-reject-arg els 'vectorp))
844 (or (integerp mode) (math-reject-arg mode 'fixnump)))
848 (math-reject-arg els "*Wrong number of elements"))
849 (error (math-reject-arg els (nth 1 err)))))
852 (or (integerp mode) (math-reject-arg mode 'fixnump))
855 (error (math-reject-arg thing (nth 1 err)))))
862 (setq cols (math-check-fixnum cols t))
863 (if (math-vectorp vec)
864 (let* ((flat (math-flatten-vector vec))
878 (defun math-flatten-vector (vec) ; [L V]
879 (if (math-vectorp vec)
880 (apply 'append (mapcar 'math-flatten-vector (cdr vec)))
884 (math-normalize (list '| a b)))
887 (math-normalize (list '| b a)))
890 (if (and (math-vectorp v1) (math-vectorp v2))
899 (defun math-copy-matrix (m)
900 (if (math-vectorp (nth 1 m))
907 (setq n (math-check-fixnum n)))
908 (if (math-vectorp a)
911 (if (math-matrixp a)
915 (cons 'vec (math-diag-step (cdr a) 0 (1- (length a))))))
917 (cons 'vec (math-diag-step (make-list n a) 0 n))
922 (if (math-vectorp a)
923 (math-reject-arg a 'numberp)
929 (defun math-mimic-ident (a m)
930 (if (math-square-matrixp m)
932 (if (math-vectorp m)
933 (if (math-zerop a)
935 (if (math-vectorp x)
936 (math-mimic-ident a x)
939 (math-dimension-error))
942 (defun math-diag-step (a n m)
948 (math-diag-step (cdr a) (1+ n) m))
953 (if (math-messy-integerp n)
954 (math-float (calcFunc-index (math-trunc n) start incr))
956 (setq n (math-check-fixnum n)))
963 start (math-add start (or incr 1))))
966 start (math-mul start (or incr 2)))))
980 (setq start (if start (math-check-fixnum start t) 1))
981 (if (< start 1) (math-reject-arg start 'posp))
991 (setq start (math-check-fixnum start t)
992 end (math-check-fixnum (or end 0) t))
993 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
1010 (setq start (math-check-fixnum start t)
1011 end (math-check-fixnum (or end 0) t))
1012 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
1028 (if (math-vectorp vec)
1030 (math-reject-arg vec 'vectorp)))
1034 (if (math-numberp mask)
1035 (if (math-zerop mask)
1038 (or (math-vectorp mask) (math-reject-arg mask 'vectorp))
1039 (or (math-constp mask) (math-reject-arg mask 'constp))
1040 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
1041 (or (= (length mask) (length vec)) (math-dimension-error))
1044 (or (math-zerop (car mask))
1050 (or (math-vectorp mask) (math-reject-arg mask 'vectorp))
1051 (or (math-constp mask) (math-reject-arg mask 'constp))
1052 (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
1054 (fvec (and filler (math-vectorp filler))))
1056 (if (math-zerop (car mask))
1069 (math-constp a))
1070 (if (math-matrixp a)
1071 (math-reduce-vec 'math-max (math-map-vec 'calcFunc-cnorm a))
1072 (math-reduce-vec 'math-max (math-map-vec 'math-abs a)))
1078 (math-constp a))
1079 (if (math-matrixp a)
1080 (math-reduce-vec 'math-max
1081 (math-reduce-cols 'math-add-abs a))
1082 (math-reduce-vec 'math-add-abs a))
1086 (defun math-add-abs (a b)
1087 (math-add (math-abs a) (math-abs b)))
1092 (if (math-vectorp vec)
1093 (cons 'vec (sort (copy-sequence (cdr vec)) 'math-beforep))
1094 (math-reject-arg vec 'vectorp)))
1097 (if (math-vectorp vec)
1098 (cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep)))
1099 (math-reject-arg vec 'vectorp)))
1101 ;; The variable math-grade-vec is local to calcFunc-grade and
1102 ;; calcFunc-rgrade, but is used by math-grade-beforep, which is called
1104 (defvar math-grade-vec)
1106 (defun calcFunc-grade (math-grade-vec)
1107 (if (math-vectorp math-grade-vec)
1108 (let* ((len (1- (length math-grade-vec))))
1109 (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))
1110 (math-reject-arg math-grade-vec 'vectorp)))
1112 (defun calcFunc-rgrade (math-grade-vec)
1113 (if (math-vectorp math-grade-vec)
1114 (let* ((len (1- (length math-grade-vec))))
1116 'math-grade-beforep))))
1117 (math-reject-arg math-grade-vec 'vectorp)))
1119 (defun math-grade-beforep (i j)
1120 (math-beforep (nth i math-grade-vec) (nth j math-grade-vec)))
1127 (math-reject-arg vec 'vectorp))
1130 (math-dimension-error)))
1132 (math-reject-arg n 'fixnatnump))
1141 (setq bin (math-floor bin)))
1144 (aset res bin (math-add (aref res bin)
1154 (or (math-vectorp a) (math-reject-arg a 'vectorp)))
1157 (or (math-vectorp b) (math-reject-arg b 'vectorp))
1162 (if (and (math-simple-set a) (math-simple-set b))
1168 (if (math-beforep (car a) (car b))
1179 (if (and (math-simple-set a) (math-simple-set b))
1185 (while (and b (math-beforep (car b) (car a)))
1196 (if (and (math-simple-set a) (math-simple-set b))
1204 (math-beforep (car a) (car b))))
1218 (setq a (math-prepare-set a))
1238 (math-clean-set (nreverse vec))))
1241 (setq a (math-prepare-set a))
1244 (math-make-intv (+ (logand (nth 1 (nth 1 a)) 2)
1251 (setq a (math-prepare-set a))
1258 (not (math-infinitep a))
1260 (math-num-integerp a)
1261 (setq a (math-add a 1)))
1262 (setq a (math-ceiling a))
1264 (not (math-infinitep b))
1266 (math-num-integerp b)
1267 (setq b (math-sub b 1)))
1268 (setq b (math-floor b))
1269 (if (and prev (Math-equal (math-sub a 1) (nth 3 prev)))
1274 (math-clean-set vec always-vec)))
1278 (or (math-constp a) (math-reject-arg a "*Set must be finite"))
1282 (setq count (math-add count (math-sub (nth 3 (car a))
1284 (setq count (math-add count 1)))
1289 (or (math-constp a) (math-reject-arg a "*Set must be finite"))
1294 (setcdr p (nconc (cdr (calcFunc-index (math-add
1295 (math-sub (nth 3 (nth 1 p))
1306 (math-negp (if (eq (car-safe (nth 1 a)) 'intv)
1309 (math-reject-arg (nth 1 a) 'posp))
1314 (setq accum (math-sub accum
1315 (math-power-of-2 (nth 2 (car a)))))
1316 (setq accum (math-add accum
1317 (math-sub
1318 (math-power-of-2 (1+ (nth 3 (car a))))
1319 (math-power-of-2 (nth 2 (car a)))))))
1320 (setq accum (math-add accum (math-power-of-2 (car a))))))
1324 (or (math-num-integerp a) (math-reject-arg a 'integerp))
1325 (if w (setq a (math-clip a w)))
1326 (if (math-messy-integerp a) (setq a (math-trunc a)))
1328 (neg (math-negp a))
1329 (aa (if neg (math-sub -1 a) a))
1333 (math-format-bignum-binary (cdr aa))
1334 (math-format-binary aa))))
1352 (math-clean-set (nreverse vec))))
1355 (if (math-simple-set a)
1358 (or (math-vectorp a) (math-reject-arg a 'vectorp))
1359 (setq a (sort (copy-sequence (cdr a)) 'math-beforep))
1366 (math-clean-set (math-prepare-set a))))
1368 (defun math-prepare-set (a)
1371 (or (math-vectorp a) (math-reject-arg a 'vectorp))
1372 (setq a (cons 'vec (sort (copy-sequence (cdr a)) 'math-beforep))))
1378 (if (math-intv-constp (nth 1 p))
1383 (math-reject-arg (nth 1 p) 'constp))
1388 (math-reject-arg (nth 1 p) 'realp))
1395 (if (or (memq (setq res (math-compare (nth 3 (nth 1 p))
1402 (setq res (math-compare (nth 3 (nth 1 p)) (nth 3 (nth 2 p))))
1423 (defun math-clean-set (a &optional always-vec)
1436 (defun math-simple-set (a)
1455 (math-sub (math-mul (nth 2 a) (nth 3 b))
1456 (math-mul (nth 3 a) (nth 2 b)))
1457 (math-sub (math-mul (nth 3 a) (nth 1 b))
1458 (math-mul (nth 1 a) (nth 3 b)))
1459 (math-sub (math-mul (nth 1 a) (nth 2 b))
1460 (math-mul (nth 2 a) (nth 1 b))))
1461 (math-reject-arg b "*Three-vector expected"))
1462 (math-reject-arg a "*Three-vector expected")))
1466 ;; The variable math-rb-close is local to math-read-brackets, but
1467 ;; is used by math-read-vector, which is called (directly and
1468 ;; indirectly) by math-read-brackets.
1469 (defvar math-rb-close)
1471 ;; The next few variables are local to math-read-exprs in calc-aent.el
1472 ;; and math-read-expr in calc-ext.el, but are set in functions they call.
1473 (defvar math-exp-pos)
1474 (defvar math-exp-str)
1475 (defvar math-exp-old-pos)
1476 (defvar math-exp-token)
1477 (defvar math-exp-keep-spaces)
1478 (defvar math-expr-data)
1480 (defun math-read-brackets (space-sep math-rb-close)
1481 (and space-sep (setq space-sep (not (math-check-for-commas))))
1482 (math-read-token)
1483 (while (eq math-exp-token 'space)
1484 (math-read-token))
1485 (if (or (equal math-expr-data math-rb-close)
1486 (eq math-exp-token 'end))
1488 (math-read-token)
1490 (let ((save-exp-pos math-exp-pos)
1491 (save-exp-old-pos math-exp-old-pos)
1492 (save-exp-token math-exp-token)
1493 (save-exp-data math-expr-data)
1494 (vals (let ((math-exp-keep-spaces space-sep))
1495 (if (or (equal math-expr-data "\\dots")
1496 (equal math-expr-data "\\ldots"))
1498 (catch 'syntax (math-read-vector))))))
1501 (let ((error-exp-pos math-exp-pos)
1502 (error-exp-old-pos math-exp-old-pos)
1504 (setq math-exp-pos save-exp-pos
1505 math-exp-old-pos save-exp-old-pos
1506 math-exp-token save-exp-token
1507 math-expr-data save-exp-data)
1508 (let ((math-exp-keep-spaces nil))
1509 (setq vals2 (catch 'syntax (math-read-vector))))
1511 (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";")))
1512 (equal math-expr-data math-rb-close)
1513 (eq math-exp-token 'end)))
1516 (setq math-exp-pos error-exp-pos
1517 math-exp-old-pos error-exp-old-pos)
1520 (if (or (equal math-expr-data "\\dots")
1521 (equal math-expr-data "\\ldots"))
1523 (math-read-token)
1526 (let ((exp2 (if (or (equal math-expr-data math-rb-close)
1527 (equal math-expr-data ")")
1528 (eq math-exp-token 'end))
1530 (math-read-expr-level 0))))
1533 (if (equal math-expr-data ")") 2 3)
1536 (if (not (or (equal math-expr-data math-rb-close)
1537 (equal math-expr-data ")")
1538 (eq math-exp-token 'end)))
1540 (if (equal math-expr-data ";")
1541 (let ((math-exp-keep-spaces space-sep))
1542 (setq vals (cons 'vec (math-read-matrix (list vals))))))
1543 (if (not (or (equal math-expr-data math-rb-close)
1544 (eq math-exp-token 'end)))
1546 (or (eq math-exp-token 'end)
1547 (math-read-token))
1550 (defun math-check-for-commas (&optional balancing)
1552 (pos (1- math-exp-pos)))
1556 math-exp-str (1+ pos)))
1557 (or (/= (aref math-exp-str pos) ?,) (> count 0) balancing))
1558 (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<))
1560 ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>))
1564 (and pos (= (aref math-exp-str pos) ?,)))))
1566 (defun math-read-vector ()
1567 (let* ((val (list (math-read-expr-level 0)))
1570 (while (eq math-exp-token 'space)
1571 (math-read-token))
1572 (and (not (eq math-exp-token 'end))
1573 (not (equal math-expr-data ";"))
1574 (not (equal math-expr-data math-rb-close))
1575 (not (equal math-expr-data "\\dots"))
1576 (not (equal math-expr-data "\\ldots"))))
1577 (if (equal math-expr-data ",")
1578 (math-read-token))
1579 (while (eq math-exp-token 'space)
1580 (math-read-token))
1581 (let ((rest (list (math-read-expr-level 0))))
1586 (defun math-read-matrix (mat)
1587 (while (equal math-expr-data ";")
1588 (math-read-token)
1589 (while (eq math-exp-token 'space)
1590 (math-read-token))
1591 (setq mat (nconc mat (list (math-read-vector)))))