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" "<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))))))