chiark - git - mdw - profile/blob - dot/emacs-calc

   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"
  83                                    "<H:mmCSSpp >Www Mmm D, YYYY"
  84                                    "YYYY-MM-DD< hh:mm:ss>"
  85                                    "Www Mmm BD< hh:mm:ss> YYYY"
  86                                    "Www D Mmmm YYYY<, h:mm:ss>"
  87                                    "D.M.Y< h:mm:SS>"
  88                                    "M-D-Y< H:mm:SSpp>"
  89                                    "D-M-Y< h:mmCSS>"
  90                                    "j<, h:mm:SS>"
  91                                    "YYddd< hh:mm:ss>"))
  92 (setq calc-complex-format 'i)
  93 (setq calc-previous-modulo '(bigpos 296 967 294 4))
  94 (setq calc-angle-mode 'rad)
  95 ;;; End of mode settings
  96
  97 ;;; Custom units stored by Calc on Thu Mar 18 19:02:50 1999
  98 (setq math-additional-units
  99         '((EB "1024 * PB" "Exabyte")
 100           (PB "1024 * TB" "Petabyte")
 101           (TB "1024 * GB" "Terabyte")
 102           (gig "GB" "Gigabyte")
 103           (GB "1024 * MB" "Gigabyte")
 104           (meg "MB" "Megabyte")
 105           (MB "1024 * kB" "Megabyte")
 106           (KB "kB" "Kilobyte")
 107           (kB "1024 * byte" "Kilobyte")
 108           (Eb "1024 * Pb" "Exabit")
 109           (Pb "1024 * Tb" "Petabit")
 110           (Tb "1024 * Gb" "Teraabit")
 111           (Gb "1024 * Mb" "Gigabit")
 112           (Mb "1024 * kb" "Megabit")
 113           (Kb "kb" "Kilobit")
 114           (kb "1024 * bit" "Kilobit")
 115           (byte "octet" "Byte")
 116           (octet "8 * bit" "Octet")
 117           (bit nil "Bit")))
 118 ;;; End of custom units
 119
 120 ;;; Variable "var-AlgSimpRules" stored by Calc on Thu Jan  6 21:04:23 2000
 121 (setq var-AlgSimpRules
 122         '(vec (calcFunc-assign
 123                (+ (^ (calcFunc-sin (var x var-x)) 2)
 124                   (^ (calcFunc-cos (var x var-x)) 2))
 125                1)
 126               (calcFunc-assign
 127                (calcFunc-exp (var x var-x))
 128                (^ (var e var-e) (var x var-x)))))
 129
 130 ;;; Variable "var-DeMoivre" stored by Calc on Fri Mar 19 16:06:10 1999
 131 (setq var-DeMoivre
 132         '(vec (calcFunc-assign
 133                (^ (var e var-e) (var x var-x))
 134                (calcFunc-exp (var x var-x)))
 135               (calcFunc-assign
 136                (calcFunc-exp (* (var i var-i) (var t var-t)))
 137                (calcFunc-evalsimp (+ (calcFunc-cos (var t var-t))
 138                                      (* (var i var-i)
 139                                         (calcFunc-sin (var t var-t))))))))
 140
 141 ;;; Variable "var-TrigDefRules" stored by Calc on Tue Jan  4 13:47:34 2000
 142 (setq var-TrigDefRules
 143         '(vec (calcFunc-phase 1)
 144               (calcFunc-assign
 145                (calcFunc-sin (var t var-t))
 146                (/ (- (^ (var e var-e) (* (var i var-i) (var t var-t)))
 147                      (^ (var e var-e) (neg (* (var i var-i) (var t var-t)))))
 148                   (* 2 (var i var-i))))
 149               (calcFunc-assign
 150                (calcFunc-cos (var t var-t))
 151                (/ (+ (^ (var e var-e) (* (var i var-i) (var t var-t)))
 152                      (^ (var e var-e) (neg (* (var i var-i) (var t var-t)))))
 153                   2))
 154               (calcFunc-assign
 155                (calcFunc-arcsin (var x var-x))
 156                (* (neg (var i var-i))
 157                   (calcFunc-ln (- (* (var i var-i) (var x var-x))
 158                                   (calcFunc-sqrt (- 1
 159                                                     (^ (var x var-x) 2)))))))
 160               (calcFunc-assign
 161                (calcFunc-arccos (var x var-x))
 162                (* (neg (var i var-i))
 163                   (calcFunc-ln (- (var x var-x)
 164                                   (calcFunc-sqrt (- (^ (var x var-x) 2)
 165                                                     1))))))
 166               (calcFunc-assign
 167                (calcFunc-arctan (var x var-x))
 168                (* (frac -1 2)
 169                   (* (var i var-i)
 170                      (calcFunc-ln (/ (+ 1 (* (var i var-i)
 171                                              (var x var-x)))
 172                                      (- 1 (* (var i var-i)
 173                                              (var x var-x))))))))
 174               (calcFunc-assign
 175                (calcFunc-arctanh (var x var-x))
 176                (* (frac 1 2)
 177                   (calcFunc-ln (/ (+ 1 (var x var-x))
 178                                   (- 1 (var x var-x))))))
 179
 180               (calcFunc-phase 2)
 181               (calcFunc-assign
 182                (calcFunc-tan (var t var-t))
 183                (/ (calcFunc-sin (var t var-t))
 184                   (calcFunc-cos (var t var-t))))
 185               (calcFunc-assign
 186                (calcFunc-sinh (var t var-t))
 187                (* (neg (var i var-i))
 188                   (calcFunc-sin (* (var i var-i) (var t var-t)))))
 189               (calcFunc-assign
 190                (calcFunc-cosh (var t var-t))
 191                (calcFunc-cos (* (var i var-i) (var t var-t))))
 192               (calcFunc-assign
 193                (calcFunc-tanh (var t var-t))
 194                (/ (calcFunc-sinh (var t var-t))
 195                   (calcFunc-cosh (var t var-t))))
 196               (calcFunc-assign
 197                (calcFunc-arcsinh (var x var-x))
 198                (* (neg (var i var-i))
 199                   (calcFunc-arcsin (* (var i var-i) (var x var-x)))))
 200               (calcFunc-assign
 201                (calcFunc-arccosh (var x var-x))
 202                (* (neg (var i var-i)) (calcFunc-arccos (var x var-x))))))