(require (quote calc-ext)) (defun calc-Need-calc-poly nil (byte-code "" [nil] 1)) (defun calcFunc-pcont (expr &optional var) (byte-code ":? @>x:/@>?,@=)8=,!2=9ʂu:J@=J8YS!u:?]@>du \"m ?tʂuk@=8 \"8 \"\"k@=8 \"8 \"\"k@=8:8@=8Y8 \"8\"k@>8 \"k : \"  GS 8 ! !  !  *)k@>b8 \" =+ʂ^8 \" !K@=G!K!X \"!] \"))k jkʇ" [expr var t p lead cont c2 (bigpos bigneg frac float cplx polar hms date mod var) (bigpos bigneg) float 1 0 math-zerop 2 math-trunc (bigpos bigneg frac float cplx polar hms date sdev intv mod) equal * math-mul calcFunc-pcont / math-div ^ bigpos math-pow (neg polar) math-is-polynomial math-poly-gcd-list math-guess-if-neg math-neg (+ - cplx sdev) math-negp - math-posp math-poly-gcd] 26)) (defun calcFunc-pprim (expr &optional var) (byte-code " \"\"   #)" [cont expr var calcFunc-pcont math-equal-int 1 math-poly-div-exact] 6)) (defun math-div-poly-const (expr c) (byte-code "!>@8 \"8 \"E \"" [expr c t car-safe (+ -) math-div-poly-const 1 2 math-div] 7)) (defun calcFunc-pdeg (expr &optional var) (byte-code ":\"@>?@=8=!%=,ǂA > \";\"A!" [expr var (bigpos bigneg) float 1 0 math-zerop (neg (var inf var-inf)) math-polynomial-p math-reject-arg "Expected a polynomial" math-poly-degree] 5)) (defun math-poly-degree (expr) (byte-code ":? @>!=łƂ@=,8!@=A8!8!\\@=V8!8!Z@=b8!r8!8\"@>8!8!]Ň" [expr t (bigpos bigneg frac float cplx polar hms date mod var) car-safe var 1 0 neg math-poly-degree * 2 / ^ natnump (+ -)] 14)) (defun calcFunc-plead (expr var) (byte-code "!=8 \"8 \"\"!=28 \"8 \"\"!=?8!P8 \"8\":?Z@>l \"hȂi \" A~ GS 8)" [expr var t p car-safe * math-mul calcFunc-plead 1 2 / math-div ^ math-natnump math-pow (bigpos bigneg frac float cplx polar hms date mod var) equal math-is-polynomial] 16)) (setq math-poly-modulus 1) (defun calcFunc-pgcd (pn pd) (byte-code "! \" ! \" \" \"*" [pn pd calc-prefer-frac t math-poly-modulus math-any-floats math-reject-arg "Coefficients must be rational" math-poly-gcd] 8)) (defun calcFunc-pdiv (pn pd &optional base) (byte-code " \" # A @+" [calc-prefer-frac t math-poly-modulus pn pd res base calc-poly-div-remainder math-poly-div] 5)) (defun calcFunc-prem (pn pd &optional base) (byte-code " \" #A*" [calc-prefer-frac t math-poly-modulus pn pd base math-poly-div] 5)) (defun calcFunc-pdivrem (pn pd &optional base) (byte-code " \" # @ AE+" [calc-prefer-frac t math-poly-modulus pn pd res base math-poly-div vec] 5)) (defun calcFunc-pdivide (pn pd &optional base) (byte-code " \" # @ A \"\"+" [calc-prefer-frac t math-poly-modulus pn pd res base math-poly-div math-add math-div] 7)) (defun math-mul-thru (lhs rhs) (byte-code "!>@8 \"8 \"E8 !>4 @ 8\" 8\"E8 \"" [lhs rhs car-safe (+ -) math-mul-thru 1 2 (+ -) math-mul] 11)) (defun math-div-thru (num den) (byte-code "!>@8 \"8 \"E \"" [num den car-safe (+ -) math-div-thru 1 2 math-div] 7)) (defun math-sort-terms (expr) (byte-code "!>!\"!" [expr car-safe (+ -) math-list-to-sum sort math-sum-to-list (lambda (a b) (byte-code "@ @\"" [a b math-beforep] 3))] 6)) (defun math-list-to-sum (lst) (byte-code "A@AA!@@E,@A)@@!,@@" [lst - + math-list-to-sum math-neg] 4)) (defun math-sum-to-list (tree &optional neg) (byte-code "!=8 \"8 \"\"7!=38 \"8 ?\"\"7 BC" [tree neg t car-safe + nconc math-sum-to-list 1 2 -] 11)) (defun math-poly-modulus (expr &optional expr2) (byte-code "! !Ç" [expr expr2 math-poly-modulus-rec 1] 3)) (defun math-poly-modulus-rec (expr) (byte-code "!=8:8@=8Y)8E>!>>8!>8!" [expr car-safe mod 2 bigpos 0 1 (+ - * /) math-poly-modulus-rec] 6)) (defun math-poly-div (u v &optional math-poly-div-base) (byte-code " \" ! !\"" [math-poly-div-base u v math-do-poly-div calcFunc-expand] 6)) (setq math-poly-div-base nil) (defun math-poly-div-exact (u v &optional base) (byte-code " #A=@ E\")" [res u v base math-poly-div 0 math-reject-arg vec "Argument is not a polynomial"] 5)) (defun math-do-poly-div (u v) (byte-code "! ! \"BB !R =+M!>I8 \"8 \"@=$M \"B \"Ua B!j !x \"!B \"  ? $?B $\"  @ \" A \"B," [u v nil math-poly-modulus t base math-poly-div-base vp up res math-constp math-div 0 1 car-safe (+ -) math-add-or-sub math-poly-div-exact 2 - math-compare math-atomic-factorp math-simplify math-is-polynomial gen math-poly-div-coefs math-build-polynomial-expr] 23)) (defun math-poly-div-rec (u v) (byte-code "!  \" !B =?!>;8 \"8 \"@=$? \" \"UO !X !d \"! o \" \" ? $? \"$\"  @\" A\" \"\"," [u v nil math-poly-modulus math-poly-div-base t base vp up res math-constp math-div 1 car-safe (+ -) math-add-or-sub math-poly-div-rec 2 - math-compare 0 math-atomic-factorp math-simplify math-is-polynomial gen math-poly-div-coefs math-add math-build-polynomial-expr] 26)) (defun math-poly-div-coefs (u v) (byte-code "? \" GGW B A !! @! @\"  B!?K BAAn@@\"\"\"L A+) @: @@>? @@= @8= @! @= A \"!B+ @@\"CB" [v nil u q urev vrev qk up vp t math-reject-arg "Division by zero" reverse math-poly-div-rec math-simplify math-zerop setcar math-sub math-mul-thru (bigpos bigneg) float 1 0 nreverse mapcar] 15)) (defun math-poly-pseudo-div (u v) (byte-code "? GGW AA !!   AAR @ @\" @@\"\"\"0 A )w s @ @\"\" A]) @: @@>? @@= @8= @! @= Ax \"!+" [v nil u urev vrev up vp t reverse setcar math-sub math-mul-thru (bigpos bigneg) float 1 0 math-zerop nreverse mapcar math-simplify] 13)) (defun math-poly-gcd (u v) (byte-code " \"U !H:5@>?2@=/8=2!8=? E !\" ! :p @>?m @=j 8=m !s =z !\" \"  $ $\" \"!!!!\")" [u v t base nil math-compare 0 math-constp (bigpos bigneg) float 1 math-zerop calcFunc-gcd calcFunc-pcont (bigpos bigneg) math-poly-gcd-base math-simplify calcFunc-expand math-build-polynomial-expr math-poly-gcd-coefs math-is-polynomial gen] 21)) (defun math-poly-div-list (lst a) (byte-code "= = \" \"" [a lst 1 -1 math-mul-list mapcar (lambda (x) (byte-code " \"" [x a math-poly-div-exact] 3))] 4)) (defun math-mul-list (lst a) (byte-code "= \"= \"\"=?\" \"" [a lst 1 -1 mapcar math-neg 0 (lambda (x) (byte-code " \"" [x a math-mul] 3))] 4)) (defun math-poly-gcd-list (lst) (byte-code "> >!B@A =?5@=1 @\"?! )" [lst gcd 1 -1 math-poly-gcd-frac-list 0 math-poly-gcd] 5)) (defun math-poly-gcd-frac-list (lst) (byte-code " @!=?AF@8A=@!=9 @8\" E)GƇ" [lst denom car-safe frac 2 calcFunc-lcm 1] 7)) (defun math-poly-gcd-coefs (u v) (byte-code " ! !\"  | | @:J @@>?G @@=C @8=G @!N @=| @:x @@>?u @@=q @8=u @!| @= A A T= \" \" G GZW  [ \"A   \"\"\" GS 8X \" Z\"\" \" S\"\"C! !\"\" GS 8!4 \" SYG B5 ." [d u v g h z hh r delta ghd math-poly-gcd math-poly-gcd-list 1 0 nil (bigpos bigneg) float math-zerop (bigpos bigneg) math-poly-div-list math-poly-pseudo-div math-mul math-pow math-poly-div-exact math-mul-list math-guess-if-neg -1] 25)) (defun math-atomic-factorp (expr) (byte-code "!=8!8!5!>$5!>48!5‡" [expr nil t car-safe * math-atomic-factorp 1 2 (+ - /) (^ neg)] 8)) (defun math-poly-div-base (a b) (byte-code " ! !Ǎ*" [a-base b-base a b nil math-total-polynomial-base return (byte-code "*@@ \" @8 8Y @@\")A" [a-base maybe b-base assoc 1 throw return] 5)] 4)) (defun math-poly-gcd-base (a b) (byte-code " ! !Ǎ*" [a-base b-base a b nil math-total-polynomial-base return (byte-code " G@8 @8V-@@ \"&@@\"*AC @@\"? @@\"C A" [a-base b-base 1 assoc throw return] 7)] 4)) (defun math-sort-poly-base-list (lst) (byte-code "\"" [lst sort (lambda (a b) (byte-code "8 8V8 8U@ @\"" [a b 1 math-beforep] 3))] 3)) (defun math-total-polynomial-base (expr) (byte-code " \"!)" [mpb-total-base nil expr math-polynomial-base math-polynomial-p1 math-sort-poly-base-list] 3)) (defun math-polynomial-p1 (subexpr) (byte-code " \"0@>0@=8!0 \" / D B*Ň" [subexpr mpb-total-base math-poly-base-variable exponent mpb-top-expr nil assoc (+ - * / neg) ^ natnump 2 math-polynomial-p] 5)) (defun calcFunc-factors (expr &optional var) (byte-code " ‚  !ˍ\"!!29ED!)+" [math-factored-vars var t nil math-to-list calc-prefer-frac expr res math-polynomial-base math-factor-finish factor (byte-code "!" [var math-factor-expr-try] 2) math-simplify math-vectorp vec 1] 8)) (defun calcFunc-factor (expr &optional var) (byte-code " ʍ)!!!+" [math-factored-vars nil math-to-list calc-prefer-frac t var expr math-simplify math-factor-finish factor (byte-code "!" [var math-factor-expr-try] 2) math-factor-expr] 4)) (defun math-factor-finish (x) (byte-code ":? @>(@= 8!(@A\"B" [x (bigpos bigneg frac float cplx polar hms date mod var) calcFunc-Fac-Prot math-factor-finish 1 mapcar] 5)) (defun math-factor-protect (x) (byte-code "!>D" [x car-safe (+ -) calcFunc-Fac-Prot] 3)) (defun math-factor-expr (expr) (byte-code "= D !> ! \"& @ A\"BD !>C̍ > !? *D " [math-factored-vars t expr calc-tweak-eqn-table y car-safe (* / ^ neg) assq mapcar math-factor-expr (+ -) factor (byte-code "!" [expr math-factor-expr-part] 2)] 7)) (defun math-factor-expr-part (x) (byte-code "!>A@!E:?$@>?E \"?E \"VEC BE!" [x math-factored-vars expr car-safe (+ - * / ^ neg) math-factor-expr-part (bigpos bigneg frac float cplx polar hms date sdev intv mod vec) assoc math-factor-contains 1 math-factor-expr-try] 6)) (defun math-factor-expr-try (x) (byte-code "!=0ʍˍ  , \"8 *8#\"*R $! AQ !Q\"+" [expr res1 res2 p x math-poly-modulus res car-safe * factor (byte-code "8 !)" [expr x 1 math-factor-expr-try] 2) (byte-code "8 !)" [expr x 2 math-factor-expr-try] 2) throw math-accum-factors 1 2 math-is-polynomial 30 gen nil math-factor-poly-coefs] 9)) (defun math-accum-factors (fac pow facs) (byte-code " !* A% @8 @8\" # !=7 8!F 8\" 8 =Q !i =a͂g ED  A{ @8\"?Јl @AA @8\\\" A 88:? 88@> 8 E AABBB E ABB) \" \"" [math-to-list fac facs pow found math-vectorp math-accum-factors 1 * 2 car-safe ^ natnump (vec) vec equal nil setcar (bigpos bigneg frac) math-mul math-pow] 14)) (defun math-factor-poly-coefs (p &optional square-free) (byte-code " A? @܂ @:: @@>?7 @@=3 @8=7 @!> @= r @:n @@>?k @@=g @8=k @!r @= T AC A \" @!! !#) ? ! GS 8!ꂼ\"=? \"\"# AA? @!!! 8!!!\"\" ;@:?@@>;@@=;@8:?&@8@>;@8:?;@8@>HA) BE\"!=GU8!8  A  @#}* \") =M = !\"\" #)@@ GS 8!88t@@@AAA\"B\"C \"\"\" \"\"\"\")cA!B\" \"\"\")#A*D8\" \"\"#- \"J !@ GS 8!ꂮD\"E \"@E \"@FGH!$!!? \"BE\"@E \"@G\"T#=@\" #SA \" #. !\"G GU@AI 8\"@ Bc !C 8\"J́K\"*" [t1 t2 p z square-free x pp res facs vec math-poly-modulus t calc-symbolic-mode nil roots csign expr unfac scale coef0 coef1 den cabs t1s uu v w temp 0 (bigpos bigneg) float 1 math-zerop (bigpos bigneg) math-factor-poly-coefs math-sort-terms math-factor-expr math-accum-factors math-factor-protect math-mul math-poly-gcd-list math-guess-if-neg -1 math-poly-div-list cont math-add (bigpos bigneg frac) mod (bigpos bigneg) 2 (bigpos bigneg) math-rewrite calcFunc-thecoefs (var FactorRules var-FactorRules) car-safe calcFunc-thefactors 3 math-vectorp math-build-polynomial-expr equal math-poly-gcd-coefs math-poly-deriv-coefs (1) math-poly-all-roots math-negp math-lcm-denoms math-div math-pow math-mul-list math-poly-div-coefs math-poly-zerop math-poly-simplify math-poly-mix nthcdr math-reject-arg "*Modulo factorization not yet implemented"] 77)) (defun math-poly-deriv-coefs (p) (byte-code " A @\" BT !*" [n dp nil p 1 math-mul nreverse] 4)) (defun math-factor-contains (x a) (byte-code " \" ĂN!>/A) @ \"\\ )N!=<8!M8 \"8\"NLJ" [x a sum equal 1 car-safe (+ - * / neg) 0 math-factor-contains ^ natnump 2 *] 10)) (defun calcFunc-nrat (expr) (byte-code "! !!! \"&@A\"B! @!!! A!!! \"=w \"\" A=v A=v@ @* \"!-" [expr calc-tweak-eqn-table calc-prefer-frac t res num den g num2 den2 math-any-floats calcFunc-pfrac math-vectorp assq car-safe mapcar calcFunc-nrat math-to-ratpoly math-simplify math-sort-terms calcFunc-expand math-poly-gcd 1 math-poly-div 0 math-div] 20)) (defun math-to-ratpoly (expr) (byte-code " !@!A!B)" [res expr math-to-ratpoly-rec math-simplify] 5)) (defun math-to-ratpoly-rec (expr) (byte-code ":? @>B@>8!8! A A\"<@ @ @E AB A=T@ @ A\" @E AB A=l@ @ @ A\"E AB A A\" =? A \" =? @ A\" \" A= A=@ @ @ @\"E @ A\"B@ @ A\" @ A\"E A A\"B*)*@=8!8! @ A\" A @\"\" = @ @\" A A\"B @ @\" \" A A\" \"B+@=8!8! A== A=H @ @B @ @\" A A\"\" =m @ A\" A @\"B @ A\" \" A @\" \"B)*@=8!8!8V @8\" A8\"B A8[\" @8[\"B)@=8! @! AB)B" [expr r1 r2 g d1 d2 t (bigpos bigneg frac float cplx polar hms date mod var) 1 (+ -) math-to-ratpoly-rec 2 equal math-mul math-poly-gcd math-poly-div 0 * math-poly-div-exact / ^ integerp math-pow neg math-neg] 46)) (defun math-ratpoly-p (expr &optional var) (byte-code " \" ǂ:?@>ɂ@>B8 \" >8 \"> ]*@=h8 \" d8 \"d \\*@=x8 \"@=8 \" 8 \" Z*@=8!8 \" 8\") ?ǂ \"Ăɇ" [expr var p1 p2 nil t equal 1 (bigpos bigneg frac float cplx polar hms date mod var) 0 (+ -) math-ratpoly-p 2 * neg / ^ integerp math-poly-depends] 14)) (defun calcFunc-apart (expr &optional var) (byte-code ":? @>@=)8 \"8 \"\"@=A8 \"8 \"\" \"?P\"! @ A \"@A x!  \"  # \"\"." [expr var t calc-prefer-frac rat num den qr q r (bigpos bigneg frac float cplx polar hms date mod var) + math-add calcFunc-apart 1 2 - math-sub math-ratpoly-p math-reject-arg "Expected a rational function" math-to-ratpoly math-poly-div math-polynomial-base math-expr-contains math-partial-fractions math-div] 18)) (defun math-padded-polynomial (expr var deg) (byte-code " # GZ\"\")" [p expr var deg math-is-polynomial append make-list 0] 6)) (defun math-partial-fractions (r den var) (byte-code " \" \" S\"  GU,88=?w A @8 @8 \"    V ׉ V $B A S  \"\"\"  SU @8 \" B_A =@8@8\"\" \" * @8 @8 Z\"\"\" S O-0 #BA\"B!\"!w!q@BA @h! \" @\"\"Ɖ A6!*." [fden den var tdeg fp dlist nil eqns lz tz calc-matrix-mode rpt deg dnum dvar deg2 fpp mult r res num calcFunc-factors math-polynomial-p 0 make-list scalar 2 1 append (vec) (1) math-add math-mul math-pow math-div vec math-padded-polynomial math-transpose mapcar (lambda (x) (byte-code " #B" [x var tdeg vec math-padded-polynomial] 5)) math-vectorp nreverse math-build-polynomial-expr math-normalize] 29)) (defun math-expand-term (expr) (byte-code "!=8!>2888E888E8@=$!=A8!>d888E888E8@=$!=s8!>888E888E8@=$!=8!>8!8V V W88$888SEE8W88[EE" [expr nil mmt-many t car-safe * 1 (+ -) math-add-or-sub 2 - (+ -) / (+ -) ^ (+ -) integerp 0 500000 -500000 math-expand-power] 19)) (defun calcFunc-expand (expr &optional many) (byte-code " #!" [expr many math-normalize math-map-tree math-expand-term] 5)) (defun math-expand-power (x n &optional var else-nil) (byte-code "! !> !>8 @=) 8!, 8 B 8 B { m@ \"b@ \"@ BAF z \" B) GUX\" 8E @ZEEEET*U     @EE   A  @ @EEE A +U      @EE   A  @E @EEE @ @EEEE   A  @ @ @EEEEr? A (,* ? E" [n x terms nil cterms var p i accum p1 p2 p3 else-nil natnump car-safe (+ -) (+ -) - math-neg 2 1 math-expr-contains delq apply calcFunc-add 0 + * calcFunc-choose ^ 3 6] 20)) (defun calcFunc-expandpow (x n) (byte-code " \"!" [x n math-normalize math-expand-power] 4))