| 1 | ;;; -*-emacs-lisp-*- |
| 2 | |
| 3 | ;;; --- Homebrew functions --- |
| 4 | |
| 5 | (autoload 'calc-tabular-command "calc-alg-2") |
| 6 | |
| 7 | (defun calc-path-length (&optional var low high) |
| 8 | "Computes the path length of a parametric function. |
| 9 | |
| 10 | The stack should contain a vector containing the (rectangular only, I'm |
| 11 | afraid) components of a vector-valued function. The independent variable is |
| 12 | prompted for. If the Hyp flag is set, limits for the parameter are requested |
| 13 | and a definite path length is computed; otherwise an indefinite result is |
| 14 | computed. |
| 15 | |
| 16 | The path length of a function `r(t)' between limits `a' and `b' is computed |
| 17 | as |
| 18 | b |
| 19 | / |
| 20 | | |r(t)| dt |
| 21 | / |
| 22 | a |
| 23 | |
| 24 | If, as is likely, the result is unintegrable, a numeric result can be |
| 25 | obtained using `z n' (`calc-integrate-numerically')." |
| 26 | (interactive "sPath length variable: ") |
| 27 | (if (calc-is-hyperbolic) |
| 28 | (calc-tabular-command 'calcFunc-path-length "Path length" "path" |
| 29 | nil var low high) |
| 30 | (calc-slow-wrapper |
| 31 | (if (or (equal var "") (equal var "$")) |
| 32 | (calc-enter-result 2 "path" (list 'calcFunc-path-length |
| 33 | (calc-top-n 2) |
| 34 | (calc-top-n |
| 35 | 1))) |
| 36 | (let ((var (math-read-expr var))) |
| 37 | (if (eq (car-safe var) 'error) |
| 38 | (error "Bad format in expression: %s" |
| 39 | (nth 1 var))) |
| 40 | (calc-enter-result 1 "path" (list |
| 41 | 'calcFunc-path-length |
| 42 | (calc-top-n 1) |
| 43 | var))))))) |
| 44 | |
| 45 | (defun calcFunc-path-length (f x &optional a b) |
| 46 | (let ((d (math-simplify (list 'calcFunc-deriv f x)))) |
| 47 | (append (list 'calcFunc-integ |
| 48 | (list 'calcFunc-sqrt (list '* d d)) |
| 49 | x) |
| 50 | (and a b (list a b))))) |
| 51 | (put 'calc-define 'calc-path-length |
| 52 | '(progn (define-key calc-mode-map "zp" 'calc-path-length))) |
| 53 | |
| 54 | (defvar var-IntegNumerRules |
| 55 | '(vec (calcFunc-condition |
| 56 | (calcFunc-condition |
| 57 | (calcFunc-assign |
| 58 | (calcFunc-integ (var f var-f) (var x var-x) |
| 59 | (var a var-a) (var b var-b)) |
| 60 | (calcFunc-ninteg (var f var-f) (var x var-x) |
| 61 | (var a var-a) (var b var-b))) |
| 62 | (calcFunc-constant (var a var-a))) |
| 63 | (calcFunc-constant (var b var-b))))) |
| 64 | |
| 65 | (defun calc-integrate-numerically () |
| 66 | "Computes an approximate result for a symbolic definite integral with |
| 67 | constant bounds." |
| 68 | (interactive) |
| 69 | (calc-slow-wrapper |
| 70 | (calc-enter-result 1 "intn" |
| 71 | (math-rewrite (calc-top-n 1) var-IntegNumerRules 5)))) |
| 72 | (put 'calc-define 'calc-integrate-numerically |
| 73 | '(progn (define-key calc-mode-map "zn" 'calc-integrate-numerically))) |
| 74 | |
| 75 | (setq calc-highlight-selections-with-faces t |
| 76 | calc-show-selections nil) |
| 77 | |
| 78 | ;;; Mode settings stored by Calc on Mon Mar 15 16:25:50 2004 |
| 79 | (setq calc-group-char " ") |
| 80 | (setq calc-frac-format '("/" nil)) |
| 81 | (setq calc-date-format '(Www " " D " " Mmmm " " YYYY (", " h ":" mm ":" ss))) |
| 82 | (setq calc-standard-date-formats '("N" "<H:mmCSSpp >Www Mmm D, YYYY" "YYYY-MM-DD< hh:mm:ss>" "Www Mmm BD< hh:mm:ss> YYYY" "Www D Mmmm YYYY<, h:mm:ss>" "D.M.Y< h:mm:SS>" "M-D-Y< H:mm:SSpp>" "D-M-Y< h:mmCSS>" "j<, h:mm:SS>" "YYddd< hh:mm:ss>")) |
| 83 | (setq calc-complex-format 'i) |
| 84 | (setq calc-previous-modulo '(bigpos 296 967 294 4)) |
| 85 | (setq calc-angle-mode 'rad) |
| 86 | ;;; End of mode settings |
| 87 | |
| 88 | ;;; Custom units stored by Calc on Thu Mar 18 19:02:50 1999 |
| 89 | (setq math-additional-units '( |
| 90 | (EB "1024 * PB" "Exabyte") |
| 91 | (PB "1024 * TB" "Petabyte") |
| 92 | (TB "1024 * GB" "Terabyte") |
| 93 | (gig "GB" "Gigabyte") |
| 94 | (GB "1024 * MB" "Gigabyte") |
| 95 | (meg "MB" "Megabyte") |
| 96 | (MB "1024 * kB" "Megabyte") |
| 97 | (KB "kB" "Kilobyte") |
| 98 | (kB "1024 * byte" "Kilobyte") |
| 99 | (Eb "1024 * Pb" "Exabit") |
| 100 | (Pb "1024 * Tb" "Petabit") |
| 101 | (Tb "1024 * Gb" "Teraabit") |
| 102 | (Gb "1024 * Mb" "Gigabit") |
| 103 | (Mb "1024 * kb" "Megabit") |
| 104 | (Kb "kb" "Kilobit") |
| 105 | (kb "1024 * bit" "Kilobit") |
| 106 | (byte "octet" "Byte") |
| 107 | (octet "8 * bit" "Octet") |
| 108 | (bit nil "Bit"))) |
| 109 | ;;; End of custom units |
| 110 | |
| 111 | ;;; Variable "var-AlgSimpRules" stored by Calc on Thu Jan 6 21:04:23 2000 |
| 112 | (setq var-AlgSimpRules |
| 113 | '(vec (calcFunc-assign |
| 114 | (+ (^ (calcFunc-sin (var x var-x)) 2) |
| 115 | (^ (calcFunc-cos (var x var-x)) 2)) |
| 116 | 1) |
| 117 | (calcFunc-assign |
| 118 | (calcFunc-exp (var x var-x)) |
| 119 | (^ (var e var-e) (var x var-x))))) |
| 120 | |
| 121 | ;;; Variable "var-DeMoivre" stored by Calc on Fri Mar 19 16:06:10 1999 |
| 122 | (setq var-DeMoivre |
| 123 | '(vec (calcFunc-assign |
| 124 | (^ (var e var-e) (var x var-x)) |
| 125 | (calcFunc-exp (var x var-x))) |
| 126 | (calcFunc-assign |
| 127 | (calcFunc-exp (* (var i var-i) (var t var-t))) |
| 128 | (calcFunc-evalsimp (+ (calcFunc-cos (var t var-t)) |
| 129 | (* (var i var-i) |
| 130 | (calcFunc-sin (var t var-t)))))))) |
| 131 | |
| 132 | ;;; Variable "var-TrigDefRules" stored by Calc on Tue Jan 4 13:47:34 2000 |
| 133 | (setq var-TrigDefRules |
| 134 | '(vec (calcFunc-phase 1) |
| 135 | (calcFunc-assign |
| 136 | (calcFunc-sin (var t var-t)) |
| 137 | (/ (- (^ (var e var-e) (* (var i var-i) (var t var-t))) |
| 138 | (^ (var e var-e) (neg (* (var i var-i) (var t var-t))))) |
| 139 | (* 2 (var i var-i)))) |
| 140 | (calcFunc-assign |
| 141 | (calcFunc-cos (var t var-t)) |
| 142 | (/ (+ (^ (var e var-e) (* (var i var-i) (var t var-t))) |
| 143 | (^ (var e var-e) (neg (* (var i var-i) (var t var-t))))) |
| 144 | 2)) |
| 145 | (calcFunc-assign |
| 146 | (calcFunc-arcsin (var x var-x)) |
| 147 | (* (neg (var i var-i)) |
| 148 | (calcFunc-ln (- (* (var i var-i) (var x var-x)) |
| 149 | (calcFunc-sqrt (- 1 |
| 150 | (^ (var x var-x) 2))))))) |
| 151 | (calcFunc-assign |
| 152 | (calcFunc-arccos (var x var-x)) |
| 153 | (* (neg (var i var-i)) |
| 154 | (calcFunc-ln (- (var x var-x) |
| 155 | (calcFunc-sqrt (- (^ (var x var-x) 2) |
| 156 | 1)))))) |
| 157 | (calcFunc-assign |
| 158 | (calcFunc-arctan (var x var-x)) |
| 159 | (* (frac -1 2) |
| 160 | (* (var i var-i) |
| 161 | (calcFunc-ln (/ (+ 1 (* (var i var-i) |
| 162 | (var x var-x))) |
| 163 | (- 1 (* (var i var-i) |
| 164 | (var x var-x)))))))) |
| 165 | (calcFunc-assign |
| 166 | (calcFunc-arctanh (var x var-x)) |
| 167 | (* (frac 1 2) |
| 168 | (calcFunc-ln (/ (+ 1 (var x var-x)) |
| 169 | (- 1 (var x var-x)))))) |
| 170 | |
| 171 | (calcFunc-phase 2) |
| 172 | (calcFunc-assign |
| 173 | (calcFunc-tan (var t var-t)) |
| 174 | (/ (calcFunc-sin (var t var-t)) |
| 175 | (calcFunc-cos (var t var-t)))) |
| 176 | (calcFunc-assign |
| 177 | (calcFunc-sinh (var t var-t)) |
| 178 | (* (neg (var i var-i)) |
| 179 | (calcFunc-sin (* (var i var-i) (var t var-t))))) |
| 180 | (calcFunc-assign |
| 181 | (calcFunc-cosh (var t var-t)) |
| 182 | (calcFunc-cos (* (var i var-i) (var t var-t)))) |
| 183 | (calcFunc-assign |
| 184 | (calcFunc-tanh (var t var-t)) |
| 185 | (/ (calcFunc-sinh (var t var-t)) |
| 186 | (calcFunc-cosh (var t var-t)))) |
| 187 | (calcFunc-assign |
| 188 | (calcFunc-arcsinh (var x var-x)) |
| 189 | (* (neg (var i var-i)) |
| 190 | (calcFunc-arcsin (* (var i var-i) (var x var-x))))) |
| 191 | (calcFunc-assign |
| 192 | (calcFunc-arccosh (var x var-x)) |
| 193 | (* (neg (var i var-i)) (calcFunc-arccos (var x var-x)))))) |