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 'calc-IntegNumerRules)
  55 (defun calc-IntegNumerRules ()
  56   (math-read-plain-expr "[
  57 integ(f, x, a, b) := ninteg(f, x, a, b) :: constant(a) :: constant(b)
  58 ]"))
  59
  60 (defun calc-integrate-numerically ()
  61   "Computes an approximate result for a symbolic definite integral with
  62 constant bounds."
  63   (interactive)
  64   (calc-slow-wrapper
  65    (calc-enter-result 1 "intn"
  66                       (math-rewrite (calc-top-n 1) var-IntegNumerRules 5))))
  67 (put 'calc-define 'calc-integrate-numerically
  68      '(progn (define-key calc-mode-map "zn" 'calc-integrate-numerically)))
  69
  70
  71 ;;; Mode settings stored by Calc on Mon Mar 15 16:25:50 2004
  72 (setq calc-group-char " ")
  73 (setq calc-frac-format '("/" nil))
  74 (setq calc-date-format '(Www " " D " " Mmmm " " YYYY (", " h ":" mm ":" ss)))
  75 (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>"))
  76 (setq calc-complex-format 'i)
  77 (setq calc-previous-modulo '(bigpos 296 967 294 4))
  78 (setq calc-angle-mode 'rad)
  79 ;;; End of mode settings
  80
  81 ;;; Custom units stored by Calc on Thu Mar 18 19:02:50 1999
  82 (setq math-additional-units '(
  83   (EB "1024 * PB" "Exabyte")
  84   (PB "1024 * TB" "Petabyte")
  85   (TB "1024 * GB" "Terabyte")
  86   (gig "GB" "Gigabyte")
  87   (GB "1024 * MB" "Gigabyte")
  88   (meg "MB" "Megabyte")
  89   (MB "1024 * kB" "Megabyte")
  90   (KB "kB" "Kilobyte")
  91   (kB "1024 * byte" "Kilobyte")
  92   (Eb "1024 * Pb" "Exabit")
  93   (Pb "1024 * Tb" "Petabit")
  94   (Tb "1024 * Gb" "Teraabit")
  95   (Gb "1024 * Mb" "Gigabit")
  96   (Mb "1024 * kb" "Megabit")
  97   (Kb "kb" "Kilobit")
  98   (kb "1024 * bit" "Kilobit")
  99   (byte "octet" "Byte")
 100   (octet "8 * bit" "Octet")
 101   (bit nil "Bit")))
 102 ;;; End of custom units
 103
 104 ;;; Variable "var-AlgSimpRules" stored by Calc on Thu Jan  6 21:04:23 2000
 105 (setq var-AlgSimpRules
 106         '(vec (calcFunc-assign
 107                (+ (^ (calcFunc-sin (var x var-x)) 2)
 108                   (^ (calcFunc-cos (var x var-x)) 2))
 109                1)
 110               (calcFunc-assign
 111                (calcFunc-exp (var x var-x))
 112                (^ (var e var-e) (var x var-x)))))
 113
 114 ;;; Variable "var-DeMoivre" stored by Calc on Fri Mar 19 16:06:10 1999
 115 (setq var-DeMoivre
 116         '(vec (calcFunc-assign
 117                (^ (var e var-e) (var x var-x))
 118                (calcFunc-exp (var x var-x)))
 119               (calcFunc-assign
 120                (calcFunc-exp (* (var i var-i) (var t var-t)))
 121                (calcFunc-evalsimp (+ (calcFunc-cos (var t var-t))
 122                                      (* (var i var-i)
 123                                         (calcFunc-sin (var t var-t))))))))
 124
 125 ;;; Variable "var-TrigDefRules" stored by Calc on Tue Jan  4 13:47:34 2000
 126 (setq var-TrigDefRules
 127         '(vec (calcFunc-phase 1)
 128               (calcFunc-assign
 129                (calcFunc-sin (var t var-t))
 130                (/ (- (^ (var e var-e) (* (var i var-i) (var t var-t)))
 131                      (^ (var e var-e) (neg (* (var i var-i) (var t var-t)))))
 132                   (* 2 (var i var-i))))
 133               (calcFunc-assign
 134                (calcFunc-cos (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))
 138               (calcFunc-assign
 139                (calcFunc-arcsin (var x var-x))
 140                (* (neg (var i var-i))
 141                   (calcFunc-ln (- (* (var i var-i) (var x var-x))
 142                                   (calcFunc-sqrt (- 1
 143                                                     (^ (var x var-x) 2)))))))
 144               (calcFunc-assign
 145                (calcFunc-arccos (var x var-x))
 146                (* (neg (var i var-i))
 147                   (calcFunc-ln (- (var x var-x)
 148                                   (calcFunc-sqrt (- (^ (var x var-x) 2)
 149                                                     1))))))
 150               (calcFunc-assign
 151                (calcFunc-arctan (var x var-x))
 152                (* (frac -1 2)
 153                   (* (var i var-i)
 154                      (calcFunc-ln (/ (+ 1 (* (var i var-i)
 155                                              (var x var-x)))
 156                                      (- 1 (* (var i var-i)
 157                                              (var x var-x))))))))
 158               (calcFunc-assign
 159                (calcFunc-arctanh (var x var-x))
 160                (* (frac 1 2)
 161                   (calcFunc-ln (/ (+ 1 (var x var-x))
 162                                   (- 1 (var x var-x))))))
 163
 164               (calcFunc-phase 2)
 165               (calcFunc-assign
 166                (calcFunc-tan (var t var-t))
 167                (/ (calcFunc-sin (var t var-t))
 168                   (calcFunc-cos (var t var-t))))
 169               (calcFunc-assign
 170                (calcFunc-sinh (var t var-t))
 171                (* (neg (var i var-i))
 172                   (calcFunc-sin (* (var i var-i) (var t var-t)))))
 173               (calcFunc-assign
 174                (calcFunc-cosh (var t var-t))
 175                (calcFunc-cos (* (var i var-i) (var t var-t))))
 176               (calcFunc-assign
 177                (calcFunc-tanh (var t var-t))
 178                (/ (calcFunc-sinh (var t var-t))
 179                   (calcFunc-cosh (var t var-t))))
 180               (calcFunc-assign
 181                (calcFunc-arcsinh (var x var-x))
 182                (* (neg (var i var-i))
 183                   (calcFunc-arcsin (* (var i var-i) (var x var-x)))))
 184               (calcFunc-assign
 185                (calcFunc-arccosh (var x var-x))
 186                (* (neg (var i var-i)) (calcFunc-arccos (var x var-x))))))