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
  52 (defvar var-IntegNumerRules 'calc-IntegNumerRules)
  53 (defun calc-IntegNumerRules ()
  54   (math-read-plain-expr "[
  55 integ(f, x, a, b) := ninteg(f, x, a, b) :: constant(a) :: constant(b)
  56 ]"))
  57
  58 (defun calc-integrate-numerically ()
  59   "Computes an approximate result for a symbolic definite integral with
  60 constant bounds."
  61   (interactive)
  62   (calc-slow-wrapper
  63    (calc-enter-result 1 "intn"
  64                       (math-rewrite (calc-top-n 1) var-IntegNumerRules 5))))
  65
  66 ;;; Mode settings stored by Calc on Mon Mar 15 16:25:50 2004
  67 (setq calc-group-char " ")
  68 (setq calc-frac-format '("/" nil))
  69 (setq calc-date-format '(Www " " D " " Mmmm " " YYYY (", " h ":" mm ":" ss)))
  70 (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>"))
  71 (setq calc-complex-format 'i)
  72 (setq calc-previous-modulo '(bigpos 296 967 294 4))
  73 (setq calc-angle-mode 'rad)
  74 ;;; End of mode settings
  75
  76 ;;; Variable "var-AlgSimpRules" stored by Calc on Thu Jan  6 21:04:23 2000
  77 (setq var-AlgSimpRules '(vec (calcFunc-assign (+ (^ (calcFunc-sin (var x var-x)) 2) (^ (calcFunc-cos (var x var-x)) 2)) 1) (calcFunc-assign (calcFunc-exp (var x var-x)) (^ (var e var-e) (var x var-x)))))
  78
  79 ;;; Custom units stored by Calc on Thu Mar 18 19:02:50 1999
  80 (setq math-additional-units '(
  81   (TB "1024 * GB" "Terabyte")
  82   (gig "GB" "Gigabyte")
  83   (GB "1024 * MB" "Gigabyte")
  84   (meg "MB" "Megabyte")
  85   (MB "1024 * kB" "Megabyte")
  86   (KB "kB" "Kilobyte")
  87   (kB "1024 * byte" "Kilobyte")
  88   (Tb "1024 * Gb" "Teraabit")
  89   (Gb "1024 * Mb" "Gigabit")
  90   (Mb "1024 * kb" "Megabit")
  91   (Kb "kb" "Kilobit")
  92   (kb "1024 * bit" "Kilobit")
  93   (byte "octet" "Byte")
  94   (octet "8 * bit" "Octet")
  95   (bit nil "Bit")
  96 ))
  97 ;;; End of custom units
  98
  99 ;;; Variable "var-DeMoivre" stored by Calc on Fri Mar 19 16:06:10 1999
 100 (setq var-DeMoivre '(vec (calcFunc-assign (^ (var e var-e) (var x var-x)) (calcFunc-exp (var x var-x))) (calcFunc-assign (calcFunc-exp (* (var i var-i) (var t var-t))) (calcFunc-evalsimp (+ (calcFunc-cos (var t var-t)) (* (var i var-i) (calcFunc-sin (var t var-t))))))))
 101
 102 ;;; Variable "var-TrigDefRules" stored by Calc on Tue Jan  4 13:47:34 2000
 103 (setq var-TrigDefRules '(vec (calcFunc-phase 1) (calcFunc-assign (calcFunc-sin (var t var-t)) (/ (- (^ (var e var-e) (* (var i var-i) (var t var-t))) (^ (var e var-e) (neg (* (var i var-i) (var t var-t))))) (* 2 (var i var-i)))) (calcFunc-assign (calcFunc-cos (var t var-t)) (/ (+ (^ (var e var-e) (* (var i var-i) (var t var-t))) (^ (var e var-e) (neg (* (var i var-i) (var t var-t))))) 2)) (calcFunc-assign (calcFunc-arcsin (var x var-x)) (* (neg (var i var-i)) (calcFunc-ln (- (* (var i var-i) (var x var-x)) (calcFunc-sqrt (- 1 (^ (var x var-x) 2))))))) (calcFunc-assign (calcFunc-arccos (var x var-x)) (* (neg (var i var-i)) (calcFunc-ln (- (var x var-x) (calcFunc-sqrt (- (^ (var x var-x) 2) 1)))))) (calcFunc-assign (calcFunc-arctan (var x var-x)) (* (frac -1 2) (* (var i var-i) (calcFunc-ln (/ (+ 1 (* (var i var-i) (var x var-x))) (- 1 (* (var i var-i) (var x var-x)))))))) (calcFunc-assign (calcFunc-arctanh (var x var-x)) (* (frac 1 2) (calcFunc-ln (/ (+ 1 (var x var-x)) (- 1 (var x var-x)))))) (calcFunc-phase 2) (calcFunc-assign (calcFunc-tan (var t var-t)) (/ (calcFunc-sin (var t var-t)) (calcFunc-cos (var t var-t)))) (calcFunc-assign (calcFunc-sinh (var t var-t)) (* (neg (var i var-i)) (calcFunc-sin (* (var i var-i) (var t var-t))))) (calcFunc-assign (calcFunc-cosh (var t var-t)) (calcFunc-cos (* (var i var-i) (var t var-t)))) (calcFunc-assign (calcFunc-tanh (var t var-t)) (/ (calcFunc-sinh (var t var-t)) (calcFunc-cosh (var t var-t)))) (calcFunc-assign (calcFunc-arcsinh (var x var-x)) (* (neg (var i var-i)) (calcFunc-arcsin (* (var i var-i) (var x var-x))))) (calcFunc-assign (calcFunc-arccosh (var x var-x)) (* (neg (var i var-i)) (calcFunc-arccos (var x var-x))))))
 104
 105 ;;; Definition stored by Calc on Tue Jan  4 22:44:33 2000
 106 (put 'calc-define 'calc-integrate-numerically '(progn
 107  (define-key calc-mode-map "zn" 'calc-integrate-numerically)
 108 ))
 109
 110 ;;; Definition stored by Calc on Tue Jan  4 22:44:37 2000
 111 (put 'calc-define 'calc-path-length '(progn
 112  (define-key calc-mode-map "zp" 'calc-path-length)
 113 ))