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