(require (quote calc-ext)) (defun calc-Need-calc-vec nil (byte-code "" [nil] 1)) (defun calc-display-strings (n) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "$ł!" [n t message calc-change-mode calc-display-strings "Displaying vectors of integers as quoted strings." "Displaying vectors of integers normally."] 6))] 2)) (defun calc-pack (n) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " ł   !! :! @=& A. A; !8 ;! ! \" # \"#-" [nn n mode num items 1 2 prefix-numeric-value calc-top-n vec integerp error "Packing mode must be an integer or vector of integers" calc-pack-size calc-top-list calc-enter-result + -1 "pack" calc-pack-items] 13))] 2)) (defun calc-pack-size (mode) (byte-code ":8&@!! @!\"A U3!4 )KYBK\"AK͇" [mode size t 1 integerp error "Vector of integers expected" * calc-pack-size 0 "Zero dimensions not allowed" assq ((-3 . 3) (-13 . 1) (-14 . 3) (-15 . 6)) 2] 8)) (defun calc-pack-items (mode items) (byte-code ":\\ATA! G VH S \" A Z\"A\" B@ !\"-Y@ \"Yh BU @! 8! 8! @! 8! 8! B!!= @E @ 8EE 8EE!U @! B @!= @ @!! B>I @!4@!)!A@ BE !D) @!=Y 8!= @  != 8  !=     GS   GS\"!SY  A @   A @ D\" B  !B.U% @! 8! B\" @! 8!! @ 8EE!U @!7 8!@ B @!L 8!R! @ 8!h 8E}@A 8!ށB!EEDE!CU @ 8 D ! !?!!?E \"F!G!*HU( @ 8!! I!J\"K!$!!!LE*M>~ @ 8!M@=M!?d!d@=d!?wNO\\#z!*P=Q 8!R! @! 8!S B! @! 8!!T BU> @! 8!VW @! 8\" @! 8!!VX @D 8E!Y\"" [mode size len items new nil p row calc-angle-mode x vx y vy z n sigma a m lo hi t calc-pack-size 0 nthcdr setcdr calc-pack-items nreverse vec -3 math-objvecp 1 2 math-num-integerp math-realp hms error "Seconds must be real" "Hours and minutes must be integers" math-normalize + rad * (hms 1 0 0) (hms 0 1 0) (hms 0 0 1) -13 date car-safe "Date value must be real" calcFunc-date (-14 -15) math-integerp "Components must be integers" math-dt-to-date /= "Vectors must be the same length" -1 cplx math-objectp "Components must be real" (cplx 0 1) -2 math-anglep polar calcFunc-exp math-to-radians-2 math-quarter-circle -4 math-scalarp math-make-sdev "Error component must be real" "Mean component must be real or complex" -5 math-posp math-make-mod "Modulus must be positive" calcFunc-makemod (-6 -7 -8 -9) math-make-intv 9 -10 math-zerop "Denominator must not be zero" frac calcFunc-fdiv (-11 -12) calcFunc-scf math-float calcFunc-float "Invalid packing mode: %d"] 88)) (defun calc-unpack (mode) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " ! \"#)" [calc-unpack-with-type t mode calc-pop-push-record-list 1 "unpk" calc-unpack-item prefix-numeric-value calc-top] 8))] 2)) (defun calc-unpack-type (item) (byte-code "!=GS+!=8Z+!\"A+!" [item t car-safe vec intv 1 9 assq ((cplx . -1) (polar . -2) (hms . -3) (sdev . -4) (mod . -5) (frac . -10) (float . -11) (date . -13)) error "Argument must be a composite object"] 6)) (defun calc-unpack-item (mode item) (byte-code "?2 !>? ! !=! @=- AA/ AV CV @! B @\" A @! Up! @\"\"] SF A !BC= @ BD \" ,= \"BD)U != A!U != A!U  != 8!!!UK !=E 8! 8!?AE\"H! !=   A @\"  @ B  8 B \\ !B !BD+U != A != !A :? @> D!U !> :? @> !A!U != A  DU' !=! A$!>A !=; AA> DUm !=T Aj :?^ @>g Dj!U != 8 8!D!@U !=A !B !D!ЁC\"" [mode item dims nil type new row calc-unpack-with-type t x y res car-safe (frac float cplx polar vec hms date sdev mod intv) math-objvecp var error "Argument must be a composite object or function call" intv 0 calc-unpack-type calc-unpack-item "Inconsistent types or dimensions in vector elements" append vec nreverse pair -3 hms "Argument must be an HMS form" -13 date "Argument must be a date form" -14 math-date-to-dt math-floor 1 -15 math-integerp -1 cplx polar math-complex (bigpos bigneg frac float) "Argument must be a complex number" -2 (cplx polar) (bigpos bigneg frac float) math-polar -4 sdev -5 mod "Argument must be a modulo form" (-6 -7 -8 -9) -10 frac (bigpos bigneg) "Argument must be a rational number" -11 float math-normalize 2 "Expected a floating-point number" -12 calcFunc-mant calcFunc-xpon "Invalid unpacking mode: %d"] 53)) (setq calc-unpack-with-type nil) (defun calc-diag (n) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "!!E!D#" [n calc-enter-result 1 "diag" calcFunc-diag calc-top-n prefix-numeric-value] 8))] 2)) (defun calc-ident (n) (interactive "NDimension of identity matrix = ") (byte-code "!" [nil calc-do (lambda nil (byte-code "= Ă!E#" [n calc-enter-result 0 "idn" (calcFunc-idn 1) calcFunc-idn 1 prefix-numeric-value] 7))] 2)) (defun calc-index (n &optional stack) (interactive "NSize of vector = P") (byte-code "!" [nil calc-do (lambda nil (byte-code ":!B# !D#" [stack n calc-enter-result 3 "indx" calcFunc-index calc-top-list-n 0 prefix-numeric-value] 8))] 2)) (defun calc-build-vector (n) (interactive "NSize of vector = ") (byte-code "!" [nil calc-do (lambda nil (byte-code "!!E#" [n calc-enter-result 1 "bldv" calcFunc-cvec calc-top-n prefix-numeric-value] 8))] 2)) (defun calc-cons (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " ##" [arg calc-is-hyperbolic calc-binary-op "rcns" calcFunc-rcons "cons" calcFunc-cons] 6))] 2)) (defun calc-head (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "  ##, '#,#" [arg calc-is-inverse calc-is-hyperbolic calc-unary-op "rtai" calcFunc-rtail "tail" calcFunc-tail "rhed" calcFunc-rhead "head" calcFunc-head] 10))] 2)) (defun calc-tail (arg) (interactive "P") (byte-code " !" [arg nil calc-invert-func calc-head] 3)) (defun calc-vlength (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " ##" [arg calc-is-hyperbolic calc-unary-op "dims" calcFunc-mdims "len" calcFunc-vlen] 6))] 2)) (defun calc-arrange-vector (n) (interactive "NNumber of columns = ") (byte-code "!" [nil calc-do (lambda nil (byte-code "!!E#" [n calc-enter-result 1 "arng" calcFunc-arrange calc-top-n prefix-numeric-value] 8))] 2)) (defun calc-vector-find (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "!B  !C\"#)" [func arg calcFunc-find calc-top-list-n 2 calc-enter-result "find" append prefix-numeric-value] 8))] 2)) (defun calc-subvector nil (interactive) (byte-code "!" [nil calc-do (lambda nil (byte-code " !B#!B#" [calc-is-inverse calc-enter-result 3 "rsvc" calcFunc-rsubvec calc-top-list-n "svec" calcFunc-subvec] 9))] 2)) (defun calc-reverse-vector (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "rev" calcFunc-rev] 4))] 2)) (defun calc-mask-vector (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-binary-op "vmsk" calcFunc-vmask] 4))] 2)) (defun calc-expand-vector (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " !B##" [arg calc-is-hyperbolic calc-enter-result 3 "vexp" calcFunc-vexp calc-top-list-n calc-binary-op] 7))] 2)) (defun calc-sort nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code " !D#!D#" [calc-is-inverse calc-enter-result 1 "rsrt" calcFunc-rsort calc-top-n "sort" calcFunc-sort] 9)) 8379] 3)) (defun calc-grade nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code " !D#!D#" [calc-is-inverse calc-enter-result 1 "rgrd" calcFunc-rgrade calc-top-n "grad" calcFunc-grade] 9)) 8609] 3)) (defun calc-histogram (n) (interactive "NNumber of bins: ") (byte-code "\"" [nil calc-do (lambda nil (byte-code "!! !F#\"! !E#" [calc-hyperbolic-flag n calc-enter-result 2 "hist" calcFunc-histogram calc-top-n 1 prefix-numeric-value] 12)) 8842] 3)) (defun calc-transpose (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "trn" calcFunc-trn] 4))] 2)) (defun calc-conj-transpose (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "ctrn" calcFunc-ctrn] 4))] 2)) (defun calc-cross (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-binary-op "cros" calcFunc-cross] 4))] 2)) (defun calc-remove-duplicates (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "rdup" calcFunc-rdup] 4))] 2)) (defun calc-set-union (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "%" [arg calc-binary-op "unio" calcFunc-vunion (vec) calcFunc-rdup] 6))] 2)) (defun calc-set-intersect (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "%" [arg calc-binary-op "intr" calcFunc-vint (vec) calcFunc-rdup] 6))] 2)) (defun calc-set-difference (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "%" [arg calc-binary-op "diff" calcFunc-vdiff (vec) calcFunc-rdup] 6))] 2)) (defun calc-set-xor (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "%" [arg calc-binary-op "xor" calcFunc-vxor (vec) calcFunc-rdup] 6))] 2)) (defun calc-set-complement (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "cmpl" calcFunc-vcompl] 4))] 2)) (defun calc-set-floor (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "vflr" calcFunc-vfloor] 4))] 2)) (defun calc-set-enumerate (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "enum" calcFunc-venum] 4))] 2)) (defun calc-set-span (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "span" calcFunc-vspan] 4))] 2)) (defun calc-set-cardinality (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "card" calcFunc-vcard] 4))] 2)) (defun calc-unpack-bits (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code " ##" [arg calc-is-inverse calc-unary-op "bpck" calcFunc-vpack "bupk" calcFunc-vunpack] 6))] 2)) (defun calc-pack-bits (arg) (interactive "P") (byte-code " !" [arg nil calc-invert-func calc-unpack-bits] 3)) (defun calc-rnorm (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "rnrm" calcFunc-rnorm] 4))] 2)) (defun calc-cnorm (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "#" [arg calc-unary-op "cnrm" calcFunc-cnorm] 4))] 2)) (defun calc-mrow (n &optional nn) (interactive "NRow number: P") (byte-code "!" [nil calc-do (lambda nil (byte-code ":!B#G ! U)!D#G W=! [E#G! E#" [nn n calc-enter-result 2 "mrow" calcFunc-mrow calc-top-list-n prefix-numeric-value 0 1 "getd" calcFunc-getdiag calc-top-n "rrow" calcFunc-mrrow] 14))] 2)) (defun calc-mcol (n &optional nn) (interactive "NColumn number: P") (byte-code "!" [nil calc-do (lambda nil (byte-code ":!B#G ! U)!D#G W=! [E#G! E#" [nn n calc-enter-result 2 "mcol" calcFunc-mcol calc-top-list-n prefix-numeric-value 0 1 "getd" calcFunc-getdiag calc-top-n "rcol" calcFunc-mrcol] 14))] 2)) (defun calcFunc-mdims (m) (byte-code "! \"!B" [m math-vectorp math-reject-arg vectorp vec math-mat-dimens] 5)) (defun math-map-vec (f a) (byte-code "! A\"B \"" [a f math-vectorp vec mapcar funcall] 5)) (defun math-dimension-error nil (byte-code "!\"" [nil calc-record-why "*Dimension error" signal wrong-type-argument] 4)) (defun calcFunc-vec (&rest objs) (byte-code "B" [objs vec] 2)) (defun calcFunc-cvec (obj &rest dims) (byte-code " \"" [obj dims math-make-vec-dimen] 3)) (defun math-make-vec-dimen (obj dims) (byte-code "9@!1A !?'@ A\"\"!B.@ \"B6@\": " [dims obj natnump math-numberp vec copy-sequence make-list math-make-vec-dimen math-reject-arg fixnatnump] 9)) (defun calcFunc-head (vec) (byte-code ": @=A8\"D" [vec 1 calc-record-why vectorp calcFunc-head] 3)) (defun calcFunc-tail (vec) (byte-code ": @=AAAB!\"D" [vec calc-record-why vectorp calcFunc-tail] 3)) (defun calcFunc-cons (head tail) (byte-code ": @= ABB\" E" [tail head vec calc-record-why vectorp calcFunc-cons] 4)) (defun calcFunc-rhead (vec) (byte-code ": @=A%!GZ\"\")-\"D" [vec nil copy-sequence setcdr nthcdr 2 calc-record-why vectorp calcFunc-rhead] 6)) (defun calcFunc-rtail (vec) (byte-code ": @=AGS8!\"D" [vec calc-record-why vectorp calcFunc-rtail] 3)) (defun calcFunc-rcons (head tail) (byte-code ": @= C\"\" E" [head tail vec append calc-record-why vectorp calcFunc-rcons] 5)) (defun math-map-vec-2 (f a b) (byte-code "!` !?A. A @ @# B5 !B)]AV @ # BA !B) ! A}  @# Bh !B)  #" [a b v nil f math-vectorp math-dimension-error funcall vec nreverse] 15)) (defun math-reduce-vec (f a) (byte-code "!.A*A@A$ @# )+ł/" [a accum f math-vectorp funcall 0] 6)) (defun math-reduce-cols (f a) (byte-code "! A8G$B" [a f math-matrixp vec math-reduce-cols-col-step 1] 8)) (defun math-reduce-cols-col-step (f a col cols) (byte-code " W  @8 A$ T $B" [col cols f a math-reduce-cols-row-step math-reduce-cols-col-step] 7)) (defun math-reduce-cols-row-step (f tot col a) (byte-code " @8# A$ " [a f tot col math-reduce-cols-row-step funcall] 7)) (defun math-dot-product (a b) (byte-code "A A0@ @\"A A* @ @\"\" )1Ň" [a b accum math-mul math-add 0] 7)) (defun calcFunc-vlen (v) (byte-code "! GS!ÂD" [v math-vectorp math-objectp 0 calcFunc-vlen] 4)) (defun calcFunc-mrow (mat n) (byte-code ": @=\"{!=!K 88>3͂4\"88>E˂F\"#{!!XV_\" :i @=p \" 8{\"" [n mat vec math-map-vec (lambda (x) (byte-code " \"" [mat x calcFunc-mrow] 3)) car-safe intv math-constp calcFunc-subvec math-add 2 1 (2 3) 0 3 (1 3) integerp math-check-integer math-reject-arg fixposintp vectorp "*Index out of range"] 13)) (defun calcFunc-subscr (mat n &optional m) (byte-code " \"  ! \" \" " [mat n m calcFunc-mrow math-num-integerp calcFunc-mcol] 6)) (defun math-mat-col (mat n) (byte-code "A\"B" [mat vec mapcar (lambda (x) (byte-code " \"" [x n elt] 3))] 4)) (defun calcFunc-mcol (mat n) (byte-code ": @=\"!}!= !7 !0 \"4 \"}!!DVK\" :U @=\\ \" !s 8GWp \"v 8}\"" [n mat vec calcFunc-trn math-map-vec (lambda (x) (byte-code " \"" [mat x calcFunc-mcol] 3)) car-safe intv math-constp math-matrixp (lambda (x) (byte-code " \"" [x n calcFunc-mrow] 3)) calcFunc-mrow integerp math-check-integer 0 math-reject-arg fixposintp vectorp 1 math-mat-col "*Index out of range"] 16)) (defun math-mat-less-row (mat n) (byte-code "X A @ AS\"B" [n mat 0 math-mat-less-row] 4)) (defun calcFunc-mrrow (mat n) (byte-code "!!V GW \"" [n mat integerp math-check-integer 0 math-mat-less-row] 5)) (defun math-mat-less-col (mat n) (byte-code "A\"B" [mat vec mapcar (lambda (x) (byte-code " \"" [x n math-mat-less-row] 3))] 4)) (defun calcFunc-mrcol (mat n) (byte-code "!!*V* !& 8GW# \"* \"" [n mat integerp math-check-integer 0 math-matrixp 1 math-mat-less-col math-mat-less-row] 7)) (defun calcFunc-getdiag (mat) (byte-code "!A\"B\"D" [mat math-square-matrixp vec math-get-diag-step 1 calc-record-why square-matrixp calcFunc-getdiag] 5)) (defun math-get-diag-step (row n) (byte-code " @8A T\"B" [row n math-get-diag-step] 4)) (defun math-transpose (mat) (byte-code " 8G SV \"BB*" [m nil col mat 1 0 math-mat-col vec] 4)) (defun calcFunc-trn (mat) (byte-code "!!!!&!\"&\"" [mat math-vectorp math-matrixp math-transpose math-col-matrix math-numberp math-reject-arg matrixp] 8)) (defun calcFunc-ctrn (mat) (byte-code "!!" [mat calcFunc-conj calcFunc-trn] 3)) (defun calcFunc-pack (mode els) (byte-code ": @=\" : @= A) A3 !3 \"ɏ" [els mode vec math-reject-arg vectorp integerp fixnump err (byte-code "! GSU A\" \"" [mode els calc-pack-size calc-pack-items math-reject-arg "*Wrong number of elements"] 5) ((error (byte-code " 8\"" [els err math-reject-arg 1] 4)))] 6)) (defun calcFunc-unpack (mode thing) (byte-code "! \"Ə" [mode integerp math-reject-arg fixnump err (byte-code " \"B" [mode thing vec calc-unpack-item] 4) ((error (byte-code " 8\"" [thing err math-reject-arg 1] 4)))] 5)) (defun calcFunc-unpackt (mode thing) (byte-code " \")" [calc-unpack-with-type mode thing pair calcFunc-unpack] 3)) (defun calcFunc-arrange (vec cols) (byte-code "\" !Z !CX# \"Y GYI \"S \"\" BC\" # W BC\" +" [cols t vec flat mat next nil math-check-fixnum math-vectorp math-flatten-vector 0 nconc nthcdr setcdr] 12)) (defun math-flatten-vector (vec) (byte-code "!A\"\"C" [vec math-vectorp apply append mapcar math-flatten-vector] 6)) (defun calcFunc-vconcat (a b) (byte-code " E!" [a b math-normalize |] 4)) (defun calcFunc-vconcatrev (a b) (byte-code " E!" [b a math-normalize |] 4)) (defun calcFunc-append (v1 v2) (byte-code "! ! A\" E" [v1 v2 math-vectorp append calcFunc-append] 6)) (defun calcFunc-appendrev (v1 v2) (byte-code " \"" [v2 v1 calcFunc-append] 3)) (defun math-copy-matrix (m) (byte-code "8!A\"B!" [m math-vectorp 1 vec mapcar copy-sequence] 5)) (defun calcFunc-diag (a &optional n) (byte-code "!?! !Y! GT\"+ EV !L> \"GT\"H EI V A GS#Bmj \"#Bm D" [n a integerp math-check-fixnum math-vectorp /= calcFunc-diag math-matrixp elt 1 vec math-diag-step 0 make-list] 14)) (defun calcFunc-idn (a &optional n) (byte-code " ! \" \"( !% \"( D" [n a calc-matrix-mode math-vectorp math-reject-arg numberp calcFunc-diag integerp calcFunc-idn] 7)) (defun math-mimic-ident (a m) (byte-code "! GS\"-!* !%A\"B' - !" [m a math-square-matrixp calcFunc-idn math-vectorp math-zerop vec mapcar (lambda (x) (byte-code "! \" " [x a math-vectorp math-mimic-ident] 4)) math-dimension-error] 8)) (defun math-diag-step (a n m) (byte-code " W#\" @ ZS\"B\"B AT #B$Ç" [n m a nil vec nconc make-list 0 math-diag-step] 8)) (defun calcFunc-index (n &optional start incr) (byte-code "!! #!!?! mYISYF B ?\"+dTXd B ]\"I !YV BSs Y B S) B)" [n start incr vec nil i math-messy-integerp math-float calcFunc-index math-trunc integerp math-check-fixnum 0 math-add 1 math-mul 2 nreverse -1] 12)) (defun calcFunc-find (vec x &optional start) (byte-code " \" ƉW\" \" / @\"U?= T A# F G)" [start t vec n x math-check-fixnum 1 math-reject-arg posp nthcdr math-compare 0] 7)) (defun calcFunc-subvec (vec start &optional end) (byte-code "\" \" ! \" GSX, # X: # VD XK΂n \" Xj # !\" \") B)" [start t end vec len chop nil math-check-fixnum 0 math-vectorp math-reject-arg vectorp + 1 (vec) nthcdr - copy-sequence setcdr] 13)) (defun calcFunc-rsubvec (vec start &optional end) (byte-code "\" \" ! \" GSX, # X: # VD XK f \"S !\"\" \"*)" [start t end vec len tail chop nil math-check-fixnum 0 math-vectorp math-reject-arg vectorp + 1 nthcdr copy-sequence setcdr append] 13)) (defun calcFunc-rev (vec) (byte-code "!A!B\"" [vec math-vectorp reverse math-reject-arg vectorp] 5)) (defun calcFunc-vmask (mask vec) (byte-code "!!Ƃ d!\"!)\" !4 \"G GU? A A]@!Y @ BB !B)" [mask vec new nil math-numberp math-zerop (vec) math-vectorp math-reject-arg vectorp math-constp constp math-dimension-error nreverse] 13)) (defun calcFunc-vexp (mask vec &optional filler) (byte-code "! \"!\" ! \" ) !Ad@!R E A@F K@ B` A @\\@ B+ !B*" [mask vec new nil fvec filler math-vectorp math-reject-arg vectorp math-constp constp math-zerop nreverse] 11)) (defun calcFunc-rnorm (a) (byte-code ": @=!,!\"\"\")\"\"4\"D" [a vec math-constp math-matrixp math-reduce-vec math-max math-map-vec calcFunc-cnorm math-abs calc-record-why vectorp calcFunc-rnorm] 9)) (defun calcFunc-cnorm (a) (byte-code ": @=!)!\"\"\"&\"1\"D" [a vec math-constp math-matrixp math-reduce-vec math-max math-reduce-cols math-add-abs calc-record-why vectorp calcFunc-cnorm] 8)) (defun math-add-abs (a b) (byte-code "! !\"" [a b math-add math-abs] 5)) (defun calcFunc-sort (vec) (byte-code "!A!\"B\"" [vec math-vectorp sort copy-sequence math-beforep math-reject-arg vectorp] 6)) (defun calcFunc-rsort (vec) (byte-code "!A!\"!B\"" [vec math-vectorp nreverse sort copy-sequence math-beforep math-reject-arg vectorp] 7)) (defun calcFunc-grade (grade-vec) (byte-code "!GS !A\"B)\"" [grade-vec len math-vectorp vec sort calcFunc-index math-grade-beforep math-reject-arg vectorp] 6)) (defun calcFunc-rgrade (grade-vec) (byte-code "!GS !A\"!B)\"" [grade-vec len math-vectorp vec nreverse sort calcFunc-index math-grade-beforep math-reject-arg vectorp] 7)) (defun math-grade-beforep (i j) (byte-code " 8 8\"" [i grade-vec j math-beforep] 4)) (defun calcFunc-histogram (vec wts &optional n) (byte-code " ɉ : @= \" :$ @=1 G GU1 !<\"\" :K @=  A @!o!!W  H A@ \"IT \"B-" [n wts vec res vp wvec wp bin nil 1 math-reject-arg vectorp math-dimension-error natnump fixnatnump make-vector 0 math-floor math-add append] 15)) (defun calcFunc-vunion (a b) (byte-code ":? @>D!\" :?* @>4 CC !> \" A \"!" [a b (bigpos bigneg frac float cplx polar hms date sdev intv mod) vec math-vectorp math-reject-arg vectorp (bigpos bigneg frac float cplx polar hms date sdev intv mod) calcFunc-rdup append] 8)) (defun calcFunc-vint (a b) (byte-code "! !Z!A !AC\" R@ @\"5AN@ @\"UI@ BA A !)d! !\"!" [a b vec math-simple-set calcFunc-rdup math-beforep math-compare 0 nreverse calcFunc-vcompl calcFunc-vunion] 13)) (defun calcFunc-vdiff (a b) (byte-code "! !e!A !AC] + @@\"6 A! C@ @\"UPA AY@ BA !)m! \"!" [a b vec math-simple-set calcFunc-rdup math-beforep math-compare 0 nreverse calcFunc-vcompl calcFunc-vunion] 12)) (defun calcFunc-vxor (a b) (byte-code "! !p!A !AC\" h4 ?4@ @\"C@ BAdO@ @\"UYA_ @ B A !)! ! \"! \"!\"*" [a b vec ca cb math-simple-set calcFunc-rdup math-beforep math-compare 0 nreverse calcFunc-vcompl calcFunc-vunion] 17)) (defun calcFunc-vcompl (a) (byte-code "!CA\\@8\"$@8>B @8>6ɂ7\\ @8F B@8@8>UƂV͉ \"g Uu \\ F B !!+" [a vec prev closed math-prepare-set (neg (var inf var-inf)) 2 equal (neg (var inf var-inf)) 1 (2 3) intv (0 1) 0 3 (0 2) (var inf var-inf) (var inf var-inf) math-clean-set nreverse] 8)) (defun calcFunc-vspan (a) (byte-code "!A.GS888\" 8\"\\88 8#)/ȇ" [a last math-prepare-set math-make-intv logand 1 2 3 (intv 2 0 0)] 8)) (defun calcFunc-vfloor (a &optional always-vec) (byte-code "!C A @8 @8 @8>P!?P\"P!P\"!>| !?|\"| !| \" ! \" 8\"U \" \" \"U F B ! \"-" [a vec p prev nil b mask always-vec math-prepare-set 1 2 3 (0 1) math-infinitep logior math-num-integerp math-add math-ceiling (0 2) math-sub math-floor math-compare 0 setcar nthcdr -1 intv nreverse math-clean-set] 21)) (defun calcFunc-vcard (a) (byte-code "\"!\"A>@!=3 @8@8\"\" \" )" [a t count calcFunc-vfloor math-constp math-reject-arg "*Set must be finite" 0 car-safe intv math-add math-sub 3 2 1] 11)) (defun calcFunc-venum (a) (byte-code "\"!\" AQ A 8!=I 88 88\"\" 88\"A AA\"\" *" [a t p next calcFunc-vfloor math-constp math-reject-arg "*Set must be finite" nil car-safe 1 intv setcdr nconc calcFunc-index math-add math-sub 3 2] 15)) (defun calcFunc-vpack (a) (byte-code "\"A#8!=88\"8!,8\"A{@!=n@8\"W @8!\"k @8T!@8!\"\"w @!\"/ )" [a t accum calcFunc-vfloor math-negp car-safe 1 intv 2 math-reject-arg posp 0 equal 3 (var inf var-inf) math-sub math-power-of-2 math-add] 17)) (defun calcFunc-vunpack (a &optional w) (byte-code "! \"  \"!!!! 3\"4 =?ׂN :K A!N ! WڂX bۂc GC S   Y  H= S    Y  H= S   SU # # #F B u F B  !!. " [a w calc-number-radix neg aa str zero one len vec pos pos2 math-num-integerp math-reject-arg integerp math-clip math-messy-integerp math-trunc 2 math-negp math-sub -1 0 "" math-format-bignum-binary math-format-binary 49 48 nil - 1 intv 3 (var inf var-inf) math-clean-set nreverse] 19)) (defun calcFunc-rdup (a) (byte-code "!Z:?@>D!#\"A!\" AR @ 8\"UJ AA\"N A0)B_!!" [a p math-simple-set (bigpos bigneg frac float cplx polar hms date sdev intv mod) vec math-vectorp math-reject-arg vectorp sort copy-sequence math-beforep math-compare 1 0 setcdr math-clean-set math-prepare-set] 10)) (defun math-prepare-set (a) (byte-code ":? @>D+!\"A!\"B A 8!={ 8!r 88>_ 88 88\"Uk AA\"o Ax 8\" 8:? 8@> 8@= 8\" 8\" 8\" A 8 8F\" A0 AA 88 88\"> = 88> 88> A| 88 88\" 88 88 88\"U5 886\"\" >I 88J >X 88Y\"\"\\ 88 =p 88u 88F AAAB\"*" [a p res (bigpos bigneg frac float cplx polar hms date sdev intv mod) vec math-vectorp math-reject-arg vectorp sort copy-sequence math-beforep nil car-safe 1 intv math-intv-constp (0 1 2) math-compare 2 3 0 setcdr constp (bigpos bigneg frac float hms) date equal (var inf var-inf) (neg (var inf var-inf)) realp setcar (-1 2) (0 2) (0 1) logand logior (1 0 2) (-1 0 2)] 29)) (defun math-clean-set (a &optional always-vec) (byte-code " A68!=!8888\"U-A88\"A AA?J 8!=J ?S 8T *" [p a res always-vec nil car-safe 1 intv math-compare 2 3 0 setcar] 8)) (defun math-simple-set (a) (byte-code ":? @>!=?;:@=;A0@!=?8ň\"?" [a (bigpos bigneg frac float cplx polar hms date sdev intv mod) car-safe intv vec nil] 4)) (defun calcFunc-cross (a b) (byte-code "!= GU` != GUY8 8\"8 8\"\"8 8\"8 8\"\"8 8\"8 8\"\"F] \"d\"" [a b car-safe vec 4 math-sub math-mul 2 3 1 math-reject-arg "*Three-vector expected"] 18)) (defun math-read-brackets (space-sep close) (byte-code " ? = \"$ =. ւm   \"A \"HقKۍ)   ;     ܍);? \" \" =    \"+ \" \" \"8  GV AB 8 \" \" =! \" F ) \"- \"- =?5\"` \"M  C!B ) \"X =?`\" =i  -" [space-sep exp-token exp-data close save-exp-pos exp-pos save-exp-old-pos exp-old-pos save-exp-token save-exp-data vals exp-keep-spaces error-exp-pos error-exp-old-pos vals2 nil exp2 math-check-for-commas math-read-token space equal end (vec) "\\dots" "\\ldots" (vec (neg (var inf var-inf))) syntax (byte-code " " [math-read-vector] 2) (byte-code " " [math-read-vector] 2) assoc (("\\ldots") ("\\dots") (";")) throw 2 calcFunc-mul 1 ")" (var inf var-inf) math-read-expr-level 0 intv 3 "Expected `]'" ";" vec math-read-matrix] 27)) (defun math-check-for-commas (&optional balancing) (byte-code " SY. ǂ T#. H\".V. P H>@TL H>LS Y b b HU*" [count pos exp-pos balancing exp-str 0 string-match "[],[{}()<>]" "[],[{}()]" /= 44 (91 123 40 60) (93 125 41 62)] 5)) (defun math-read-vector nil (byte-code "!C =  =?8 \"?8 \"?8 \"?8 \"?d \"D =Q E!C \" )B*" [val last exp-token exp-data close rest math-read-expr-level 0 space math-read-token end equal ";" "\\dots" "\\ldots" "," setcdr vec] 14)) (defun math-read-matrix (mat) (byte-code "\"# = C\" " [exp-data exp-token mat equal ";" math-read-token space nconc math-read-vector] 8))