dot/emacs-calc: Write `var-IntegNumerRules' as longhand sexp.

[profile] / dot / emacs-calc

;;; -*-emacs-lisp-*-

;;; --- Homebrew functions ---

(autoload 'calc-tabular-command "calc-alg-2")

(defun calc-path-length (&optional var low high)
  "Computes the path length of a parametric function.

The stack should contain a vector containing the (rectangular only, I'm
afraid) components of a vector-valued function.  The independent variable is
prompted for.  If the Hyp flag is set, limits for the parameter are requested
and a definite path length is computed; otherwise an indefinite result is
computed.

The path length of a function `r(t)' between limits `a' and `b' is computed
as
	 b
	/
	| |r(t)| dt
	/
	 a

If, as is likely, the result is unintegrable, a numeric result can be
obtained using `z n' (`calc-integrate-numerically')."
  (interactive "sPath length variable: ")
  (if (calc-is-hyperbolic)
      (calc-tabular-command 'calcFunc-path-length "Path length" "path"
			    nil var low high)
    (calc-slow-wrapper
     (if (or (equal var "") (equal var "$"))
	 (calc-enter-result 2 "path" (list 'calcFunc-path-length
					   (calc-top-n 2)
					   (calc-top-n
					    1)))
       (let ((var (math-read-expr var)))
	 (if (eq (car-safe var) 'error)
	     (error "Bad format in expression: %s"
		    (nth 1 var)))
	 (calc-enter-result 1 "path" (list
				      'calcFunc-path-length
				      (calc-top-n 1)
				      var)))))))

(defun calcFunc-path-length (f x &optional a b)
  (let ((d (math-simplify (list 'calcFunc-deriv f x))))
    (append (list 'calcFunc-integ
		  (list 'calcFunc-sqrt (list '* d d))
		  x)
	    (and a b (list a b)))))
(put 'calc-define 'calc-path-length
     '(progn (define-key calc-mode-map "zp" 'calc-path-length)))

(defvar var-IntegNumerRules
  '(vec (calcFunc-condition
	 (calcFunc-condition
	  (calcFunc-assign
	   (calcFunc-integ (var f var-f) (var x var-x)
			   (var a var-a) (var b var-b))
	   (calcFunc-ninteg (var f var-f) (var x var-x)
			    (var a var-a) (var b var-b)))
	  (calcFunc-constant (var a var-a)))
	 (calcFunc-constant (var b var-b)))))

(defun calc-integrate-numerically ()
  "Computes an approximate result for a symbolic definite integral with
constant bounds."
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 1 "intn"
		      (math-rewrite (calc-top-n 1) var-IntegNumerRules 5))))
(put 'calc-define 'calc-integrate-numerically
     '(progn (define-key calc-mode-map "zn" 'calc-integrate-numerically)))


;;; Mode settings stored by Calc on Mon Mar 15 16:25:50 2004
(setq calc-group-char " ")
(setq calc-frac-format '("/" nil))
(setq calc-date-format '(Www " " D " " Mmmm " " YYYY (", " h ":" mm ":" ss)))
(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>"))
(setq calc-complex-format 'i)
(setq calc-previous-modulo '(bigpos 296 967 294 4))
(setq calc-angle-mode 'rad)
;;; End of mode settings

;;; Custom units stored by Calc on Thu Mar 18 19:02:50 1999
(setq math-additional-units '(
  (EB "1024 * PB" "Exabyte")
  (PB "1024 * TB" "Petabyte")
  (TB "1024 * GB" "Terabyte")
  (gig "GB" "Gigabyte")
  (GB "1024 * MB" "Gigabyte")
  (meg "MB" "Megabyte")
  (MB "1024 * kB" "Megabyte")
  (KB "kB" "Kilobyte")
  (kB "1024 * byte" "Kilobyte")
  (Eb "1024 * Pb" "Exabit")
  (Pb "1024 * Tb" "Petabit")
  (Tb "1024 * Gb" "Teraabit")
  (Gb "1024 * Mb" "Gigabit")
  (Mb "1024 * kb" "Megabit")
  (Kb "kb" "Kilobit")
  (kb "1024 * bit" "Kilobit")
  (byte "octet" "Byte")
  (octet "8 * bit" "Octet")
  (bit nil "Bit")))
;;; End of custom units

;;; Variable "var-AlgSimpRules" stored by Calc on Thu Jan  6 21:04:23 2000
(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)))))

;;; Variable "var-DeMoivre" stored by Calc on Fri Mar 19 16:06:10 1999
(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))))))))

;;; Variable "var-TrigDefRules" stored by Calc on Tue Jan  4 13:47:34 2000
(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))))))