[bpt/emacs.git] / lisp / calc / calc-fin.el

;;; calc-fin.el --- financial functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.

;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.

(require 'calc-ext)
(require 'calc-macs)

;;; Financial functions.

(defun calc-fin-pv ()
  (interactive)
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3)))
     (if (calc-is-inverse)
	 (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3)))
       (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3)))))))

(defun calc-fin-npv (arg)
  (interactive "p")
  (calc-slow-wrapper
   (if (calc-is-inverse)
       (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg))
     (calc-vector-op "npv" 'calcFunc-npv (1+ arg)))))

(defun calc-fin-fv ()
  (interactive)
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
     (if (calc-is-inverse)
	 (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3)))
       (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3)))))))

(defun calc-fin-pmt ()
  (interactive)
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
     (if (calc-is-inverse)
	 (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3)))
       (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3)))))))

(defun calc-fin-nper ()
  (interactive)
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3)))
     (if (calc-is-inverse)
	 (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb
					   (calc-top-list-n 3)))
       (calc-enter-result 3 "nper" (cons 'calcFunc-nper
					 (calc-top-list-n 3)))))))

(defun calc-fin-rate ()
  (interactive)
  (calc-slow-wrapper
   (calc-pop-push-record 3
			 (if (calc-is-hyperbolic) "ratl"
			   (if (calc-is-inverse) "ratb" "rate"))
			 (calc-to-percentage
			  (calc-normalize
			   (cons (if (calc-is-hyperbolic) 'calcFunc-ratel
				   (if (calc-is-hyperbolic) 'calcFunc-rateb
				     'calcFunc-rate))
				 (calc-top-list-n 3)))))))

(defun calc-fin-irr (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-inverse)
       (calc-vector-op "irrb" 'calcFunc-irrb arg)
     (calc-vector-op "irr" 'calcFunc-irr arg))))

(defun calc-fin-sln ()
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3)))))

(defun calc-fin-syd ()
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4)))))

(defun calc-fin-ddb ()
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4)))))


(defun calc-to-percentage (x)
  (cond ((Math-objectp x)
	 (setq x (math-mul x 100))
	 (if (Math-num-integerp x)
	     (setq x (math-trunc x)))
	 (list 'calcFunc-percent x))
	((Math-vectorp x)
	 (cons 'vec (mapcar 'calc-to-percentage (cdr x))))
	(t x)))

(defun calc-convert-percent ()
  (interactive)
  (calc-slow-wrapper
   (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1)))))

(defun calc-percent-change ()
  (interactive)
  (calc-slow-wrapper
   (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2)))))
     (calc-pop-push-record 2 "%ch" (calc-to-percentage res)))))


;;; Financial functions.

(defun calcFunc-pv (rate num amount &optional lump)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let ((p (math-pow (math-add 1 rate) num)))
      (math-add (math-mul amount
			  (math-div (math-sub 1 (math-div 1 p))
				    rate))
		(math-div (or lump 0) p)))))
(put 'calcFunc-pv 'math-expandable t)

(defun calcFunc-pvl (rate num amount)
  (calcFunc-pv rate num 0 amount))
(put 'calcFunc-pvl 'math-expandable t)

(defun calcFunc-pvb (rate num amount &optional lump)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let* ((p (math-pow (math-add 1 rate) num)))
      (math-add (math-mul amount
			  (math-div (math-mul (math-sub 1 (math-div 1 p))
					      (math-add 1 rate))
				    rate))
		(math-div (or lump 0) p)))))
(put 'calcFunc-pvb 'math-expandable t)

(defun calcFunc-npv (rate &rest flows)
  (math-check-financial rate 1)
  (math-with-extra-prec 2
    (let* ((flat (math-flatten-many-vecs flows))
	   (pp (math-add 1 rate))
	   (p pp)
	   (accum 0))
      (while (setq flat (cdr flat))
	(setq accum (math-add accum (math-div (car flat) p))
	      p (math-mul p pp)))
      accum)))
(put 'calcFunc-npv 'math-expandable t)

(defun calcFunc-npvb (rate &rest flows)
  (math-check-financial rate 1)
  (math-with-extra-prec 2
    (let* ((flat (math-flatten-many-vecs flows))
	   (pp (math-add 1 rate))
	   (p 1)
	   (accum 0))
      (while (setq flat (cdr flat))
	(setq accum (math-add accum (math-div (car flat) p))
	      p (math-mul p pp)))
      accum)))
(put 'calcFunc-npvb 'math-expandable t)

(defun calcFunc-fv (rate num amount &optional initial)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let ((p (math-pow (math-add 1 rate) num)))
      (math-add (math-mul amount
			  (math-div (math-sub p 1)
				    rate))
		(math-mul (or initial 0) p)))))
(put 'calcFunc-fv 'math-expandable t)

(defun calcFunc-fvl (rate num amount)
  (calcFunc-fv rate num 0 amount))
(put 'calcFunc-fvl 'math-expandable t)

(defun calcFunc-fvb (rate num amount &optional initial)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let ((p (math-pow (math-add 1 rate) num)))
      (math-add (math-mul amount
			  (math-div (math-mul (math-sub p 1)
					      (math-add 1 rate))
				    rate))
		(math-mul (or initial 0) p)))))
(put 'calcFunc-fvb 'math-expandable t)

(defun calcFunc-pmt (rate num amount &optional lump)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let ((p (math-pow (math-add 1 rate) num)))
      (math-div (math-mul (math-sub amount
				    (math-div (or lump 0) p))
			  rate)
		(math-sub 1 (math-div 1 p))))))
(put 'calcFunc-pmt 'math-expandable t)

(defun calcFunc-pmtb (rate num amount &optional lump)
  (math-check-financial rate num)
  (math-with-extra-prec 2
    (let ((p (math-pow (math-add 1 rate) num)))
      (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate)
		(math-mul (math-sub 1 (math-div 1 p))
			  (math-add 1 rate))))))
(put 'calcFunc-pmtb 'math-expandable t)

(defun calcFunc-nper (rate pmt amount &optional lump)
  (math-compute-nper rate pmt amount lump nil))
(put 'calcFunc-nper 'math-expandable t)

(defun calcFunc-nperb (rate pmt amount &optional lump)
  (math-compute-nper rate pmt amount lump 'b))
(put 'calcFunc-nperb 'math-expandable t)

(defun calcFunc-nperl (rate pmt amount)
  (math-compute-nper rate pmt amount nil 'l))
(put 'calcFunc-nperl 'math-expandable t)

(defun math-compute-nper (rate pmt amount lump bflag)
  (and lump (math-zerop lump)
       (setq lump nil))
  (and lump (math-zerop pmt)
       (setq amount lump
	     lump nil
	     bflag 'l))
  (or (math-objectp rate) (and math-expand-formulas (null lump))
      (math-reject-arg rate 'numberp))
  (and (math-zerop rate)
       (math-reject-arg rate 'nonzerop))
  (or (math-objectp pmt) (and math-expand-formulas (null lump))
      (math-reject-arg pmt 'numberp))
  (or (math-objectp amount) (and math-expand-formulas (null lump))
      (math-reject-arg amount 'numberp))
  (if lump
      (progn
	(or (math-objectp lump)
	    (math-reject-arg lump 'numberp))
	(let ((root (math-find-root (list 'calcFunc-eq
					  (list (if bflag
						    'calcFunc-pvb
						  'calcFunc-pv)
						rate
						'(var DUMMY var-DUMMY)
						pmt
						lump)
					  amount)
				    '(var DUMMY var-DUMMY)
				    '(intv 3 0 100)
				    t)))
	  (if (math-vectorp root)
	      (nth 1 root)
	    root)))
    (math-with-extra-prec 2
      (let ((temp (if (eq bflag 'l)
		      (math-div amount pmt)
		    (math-sub 1 (math-div (math-mul amount rate)
					  (if bflag
					      (math-mul pmt (math-add 1 rate))
					    pmt))))))
	(if (or (math-posp temp) math-expand-formulas)
	    (math-neg (calcFunc-log temp (math-add 1 rate)))
	  (math-reject-arg pmt "*Payment too small to cover interest rate"))))))

(defun calcFunc-rate (num pmt amount &optional lump)
  (math-compute-rate num pmt amount lump 'calcFunc-pv))

(defun calcFunc-rateb (num pmt amount &optional lump)
  (math-compute-rate num pmt amount lump 'calcFunc-pvb))

(defun math-compute-rate (num pmt amount lump func)
  (or (math-objectp num)
      (math-reject-arg num 'numberp))
  (or (math-objectp pmt)
      (math-reject-arg pmt 'numberp))
  (or (math-objectp amount)
      (math-reject-arg amount 'numberp))
  (or (null lump)
      (math-objectp lump)
      (math-reject-arg lump 'numberp))
  (let ((root (math-find-root (list 'calcFunc-eq
				    (list func
					  '(var DUMMY var-DUMMY)
					  num
					  pmt
					  (or lump 0))
				    amount)
			      '(var DUMMY var-DUMMY)
			      '(intv 3 (float 1 -4) 1)
			      t)))
    (if (math-vectorp root)
	(nth 1 root)
      root)))

(defun calcFunc-ratel (num pmt amount)
  (or (math-objectp num) math-expand-formulas
      (math-reject-arg num 'numberp))
  (or (math-objectp pmt) math-expand-formulas
      (math-reject-arg pmt 'numberp))
  (or (math-objectp amount) math-expand-formulas
      (math-reject-arg amount 'numberp))
  (math-with-extra-prec 2
    (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1)))

(defun calcFunc-irr (&rest vecs)
  (math-compute-irr vecs 'calcFunc-npv))

(defun calcFunc-irrb (&rest vecs)
  (math-compute-irr vecs 'calcFunc-npvb))

(defun math-compute-irr (vecs func)
  (let* ((flat (math-flatten-many-vecs vecs))
	 (root (math-find-root (list func
				     '(var DUMMY var-DUMMY)
				     flat)
			       '(var DUMMY var-DUMMY)
			       '(intv 3 (float 1 -4) 1)
			       t)))
    (if (math-vectorp root)
	(nth 1 root)
      root)))

(defun math-check-financial (rate num)
  (or (math-objectp rate) math-expand-formulas
      (math-reject-arg rate 'numberp))
  (and (math-zerop rate)
       (math-reject-arg rate 'nonzerop))
  (or (math-objectp num) math-expand-formulas
      (math-reject-arg num 'numberp)))


(defun calcFunc-sln (cost salvage life &optional period)
  (or (math-realp cost) math-expand-formulas
      (math-reject-arg cost 'realp))
  (or (math-realp salvage) math-expand-formulas
      (math-reject-arg salvage 'realp))
  (or (math-realp life) math-expand-formulas
      (math-reject-arg life 'realp))
  (if (math-zerop life) (math-reject-arg life 'nonzerop))
  (if (and period
	   (if (math-num-integerp period)
	       (or (Math-lessp life period) (not (math-posp period)))
	     (math-reject-arg period 'integerp)))
      0
    (math-div (math-sub cost salvage) life)))
(put 'calcFunc-sln 'math-expandable t)

(defun calcFunc-syd (cost salvage life period)
  (or (math-realp cost) math-expand-formulas
      (math-reject-arg cost 'realp))
  (or (math-realp salvage) math-expand-formulas
      (math-reject-arg salvage 'realp))
  (or (math-realp life) math-expand-formulas
      (math-reject-arg life 'realp))
  (if (math-zerop life) (math-reject-arg life 'nonzerop))
  (or (math-realp period) math-expand-formulas
      (math-reject-arg period 'realp))
  (if (or (Math-lessp life period) (not (math-posp period)))
      0
    (math-div (math-mul (math-sub cost salvage)
			(math-add (math-sub life period) 1))
	      (math-div (math-mul life (math-add life 1)) 2))))
(put 'calcFunc-syd 'math-expandable t)

(defun calcFunc-ddb (cost salvage life period)
  (if (math-messy-integerp period) (setq period (math-trunc period)))
  (or (integerp period) (math-reject-arg period 'fixnump))
  (or (math-realp cost) (math-reject-arg cost 'realp))
  (or (math-realp salvage) (math-reject-arg salvage 'realp))
  (or (math-realp life) (math-reject-arg life 'realp))
  (if (math-zerop life) (math-reject-arg life 'nonzerop))
  (if (or (Math-lessp life period) (<= period 0))
      0
    (let ((book cost)
	  (res 0))
      (while (>= (setq period (1- period)) 0)
	(setq res (math-div (math-mul book 2) life)
	      book (math-sub book res))
	(if (Math-lessp book salvage)
	    (setq res (math-add res (math-sub book salvage))
		  book salvage)))
      res)))

(provide 'calc-fin)

;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b
;;; calc-fin.el ends here
Commit	Line	Data
3132f345 CW	1	;;; calc-fin.el --- financial functions for Calc
3132f345 CW	2
58ba2f8f	3	;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
49f70d46	4	;; 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
3132f345 CW	5
3132f345 CW	6	;; Author: David Gillespie <daveg@synaptics.com>
e8fff8ed	7	;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
136211a9 EZ	8
	9	;; This file is part of GNU Emacs.
	10
662c9c64	11	;; GNU Emacs is free software: you can redistribute it and/or modify
7c671b23	12	;; it under the terms of the GNU General Public License as published by
662c9c64 GM	13	;; the Free Software Foundation, either version 3 of the License, or
662c9c64 GM	14	;; (at your option) any later version.
7c671b23	15
136211a9	16	;; GNU Emacs is distributed in the hope that it will be useful,
7c671b23 GM	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
662c9c64	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
136211a9	23
3132f345	24	;;; Commentary:
136211a9	25
3132f345	26	;;; Code:
136211a9 EZ	27
136211a9 EZ	28	;; This file is autoloaded from calc-ext.el.
136211a9	29
7bd61134	30	(require 'calc-ext)
136211a9 EZ	31	(require 'calc-macs)
136211a9 EZ	32
136211a9 EZ	33	;;; Financial functions.
	34
	35	(defun calc-fin-pv ()
	36	(interactive)
	37	(calc-slow-wrapper
	38	(if (calc-is-hyperbolic)
	39	(calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3)))
	40	(if (calc-is-inverse)
	41	(calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3)))
bf77c646	42	(calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3)))))))
136211a9 EZ	43
	44	(defun calc-fin-npv (arg)
	45	(interactive "p")
	46	(calc-slow-wrapper
	47	(if (calc-is-inverse)
	48	(calc-vector-op "npvb" 'calcFunc-npvb (1+ arg))
bf77c646	49	(calc-vector-op "npv" 'calcFunc-npv (1+ arg)))))
136211a9 EZ	50
	51	(defun calc-fin-fv ()
	52	(interactive)
	53	(calc-slow-wrapper
	54	(if (calc-is-hyperbolic)
	55	(calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
	56	(if (calc-is-inverse)
	57	(calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3)))
bf77c646	58	(calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3)))))))
136211a9 EZ	59
	60	(defun calc-fin-pmt ()
	61	(interactive)
	62	(calc-slow-wrapper
	63	(if (calc-is-hyperbolic)
	64	(calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
	65	(if (calc-is-inverse)
	66	(calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3)))
bf77c646	67	(calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3)))))))
136211a9 EZ	68
	69	(defun calc-fin-nper ()
	70	(interactive)
	71	(calc-slow-wrapper
	72	(if (calc-is-hyperbolic)
	73	(calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3)))
	74	(if (calc-is-inverse)
	75	(calc-enter-result 3 "nprb" (cons 'calcFunc-nperb
	76	(calc-top-list-n 3)))
	77	(calc-enter-result 3 "nper" (cons 'calcFunc-nper
bf77c646	78	(calc-top-list-n 3)))))))
136211a9 EZ	79
	80	(defun calc-fin-rate ()
	81	(interactive)
	82	(calc-slow-wrapper
	83	(calc-pop-push-record 3
	84	(if (calc-is-hyperbolic) "ratl"
	85	(if (calc-is-inverse) "ratb" "rate"))
	86	(calc-to-percentage
	87	(calc-normalize
	88	(cons (if (calc-is-hyperbolic) 'calcFunc-ratel
	89	(if (calc-is-hyperbolic) 'calcFunc-rateb
	90	'calcFunc-rate))
bf77c646	91	(calc-top-list-n 3)))))))
136211a9 EZ	92
	93	(defun calc-fin-irr (arg)
	94	(interactive "P")
	95	(calc-slow-wrapper
	96	(if (calc-is-inverse)
	97	(calc-vector-op "irrb" 'calcFunc-irrb arg)
bf77c646	98	(calc-vector-op "irr" 'calcFunc-irr arg))))
136211a9 EZ	99
	100	(defun calc-fin-sln ()
	101	(interactive)
	102	(calc-slow-wrapper
bf77c646	103	(calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3)))))
136211a9 EZ	104
	105	(defun calc-fin-syd ()
	106	(interactive)
	107	(calc-slow-wrapper
bf77c646	108	(calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4)))))
136211a9 EZ	109
	110	(defun calc-fin-ddb ()
	111	(interactive)
	112	(calc-slow-wrapper
bf77c646	113	(calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4)))))
136211a9 EZ	114
	115
	116	(defun calc-to-percentage (x)
	117	(cond ((Math-objectp x)
	118	(setq x (math-mul x 100))
	119	(if (Math-num-integerp x)
	120	(setq x (math-trunc x)))
	121	(list 'calcFunc-percent x))
	122	((Math-vectorp x)
	123	(cons 'vec (mapcar 'calc-to-percentage (cdr x))))
bf77c646	124	(t x)))
136211a9 EZ	125
	126	(defun calc-convert-percent ()
	127	(interactive)
	128	(calc-slow-wrapper
bf77c646	129	(calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1)))))
136211a9 EZ	130
	131	(defun calc-percent-change ()
	132	(interactive)
	133	(calc-slow-wrapper
	134	(let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2)))))
bf77c646	135	(calc-pop-push-record 2 "%ch" (calc-to-percentage res)))))
136211a9 EZ	136
	137
	138	;;; Financial functions.
	139
	140	(defun calcFunc-pv (rate num amount &optional lump)
	141	(math-check-financial rate num)
	142	(math-with-extra-prec 2
	143	(let ((p (math-pow (math-add 1 rate) num)))
	144	(math-add (math-mul amount
	145	(math-div (math-sub 1 (math-div 1 p))
	146	rate))
bf77c646	147	(math-div (or lump 0) p)))))
136211a9 EZ	148	(put 'calcFunc-pv 'math-expandable t)
	149
	150	(defun calcFunc-pvl (rate num amount)
bf77c646	151	(calcFunc-pv rate num 0 amount))
136211a9 EZ	152	(put 'calcFunc-pvl 'math-expandable t)
	153
	154	(defun calcFunc-pvb (rate num amount &optional lump)
	155	(math-check-financial rate num)
	156	(math-with-extra-prec 2
	157	(let* ((p (math-pow (math-add 1 rate) num)))
	158	(math-add (math-mul amount
	159	(math-div (math-mul (math-sub 1 (math-div 1 p))
	160	(math-add 1 rate))
	161	rate))
bf77c646	162	(math-div (or lump 0) p)))))
136211a9 EZ	163	(put 'calcFunc-pvb 'math-expandable t)
	164
	165	(defun calcFunc-npv (rate &rest flows)
	166	(math-check-financial rate 1)
	167	(math-with-extra-prec 2
	168	(let* ((flat (math-flatten-many-vecs flows))
	169	(pp (math-add 1 rate))
	170	(p pp)
	171	(accum 0))
	172	(while (setq flat (cdr flat))
	173	(setq accum (math-add accum (math-div (car flat) p))
	174	p (math-mul p pp)))
bf77c646	175	accum)))
136211a9 EZ	176	(put 'calcFunc-npv 'math-expandable t)
	177
	178	(defun calcFunc-npvb (rate &rest flows)
	179	(math-check-financial rate 1)
	180	(math-with-extra-prec 2
	181	(let* ((flat (math-flatten-many-vecs flows))
	182	(pp (math-add 1 rate))
	183	(p 1)
	184	(accum 0))
	185	(while (setq flat (cdr flat))
	186	(setq accum (math-add accum (math-div (car flat) p))
	187	p (math-mul p pp)))
bf77c646	188	accum)))
136211a9 EZ	189	(put 'calcFunc-npvb 'math-expandable t)
	190
	191	(defun calcFunc-fv (rate num amount &optional initial)
	192	(math-check-financial rate num)
	193	(math-with-extra-prec 2
	194	(let ((p (math-pow (math-add 1 rate) num)))
	195	(math-add (math-mul amount
	196	(math-div (math-sub p 1)
	197	rate))
bf77c646	198	(math-mul (or initial 0) p)))))
136211a9 EZ	199	(put 'calcFunc-fv 'math-expandable t)
	200
	201	(defun calcFunc-fvl (rate num amount)
bf77c646	202	(calcFunc-fv rate num 0 amount))
136211a9 EZ	203	(put 'calcFunc-fvl 'math-expandable t)
	204
	205	(defun calcFunc-fvb (rate num amount &optional initial)
	206	(math-check-financial rate num)
	207	(math-with-extra-prec 2
	208	(let ((p (math-pow (math-add 1 rate) num)))
	209	(math-add (math-mul amount
	210	(math-div (math-mul (math-sub p 1)
	211	(math-add 1 rate))
	212	rate))
bf77c646	213	(math-mul (or initial 0) p)))))
136211a9 EZ	214	(put 'calcFunc-fvb 'math-expandable t)
	215
	216	(defun calcFunc-pmt (rate num amount &optional lump)
	217	(math-check-financial rate num)
	218	(math-with-extra-prec 2
	219	(let ((p (math-pow (math-add 1 rate) num)))
	220	(math-div (math-mul (math-sub amount
	221	(math-div (or lump 0) p))
	222	rate)
bf77c646	223	(math-sub 1 (math-div 1 p))))))
136211a9 EZ	224	(put 'calcFunc-pmt 'math-expandable t)
	225
	226	(defun calcFunc-pmtb (rate num amount &optional lump)
	227	(math-check-financial rate num)
	228	(math-with-extra-prec 2
	229	(let ((p (math-pow (math-add 1 rate) num)))
	230	(math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate)
	231	(math-mul (math-sub 1 (math-div 1 p))
bf77c646	232	(math-add 1 rate))))))
136211a9 EZ	233	(put 'calcFunc-pmtb 'math-expandable t)
	234
	235	(defun calcFunc-nper (rate pmt amount &optional lump)
bf77c646	236	(math-compute-nper rate pmt amount lump nil))
136211a9 EZ	237	(put 'calcFunc-nper 'math-expandable t)
	238
	239	(defun calcFunc-nperb (rate pmt amount &optional lump)
bf77c646	240	(math-compute-nper rate pmt amount lump 'b))
136211a9 EZ	241	(put 'calcFunc-nperb 'math-expandable t)
	242
	243	(defun calcFunc-nperl (rate pmt amount)
bf77c646	244	(math-compute-nper rate pmt amount nil 'l))
136211a9 EZ	245	(put 'calcFunc-nperl 'math-expandable t)
	246
	247	(defun math-compute-nper (rate pmt amount lump bflag)
	248	(and lump (math-zerop lump)
	249	(setq lump nil))
	250	(and lump (math-zerop pmt)
	251	(setq amount lump
	252	lump nil
	253	bflag 'l))
	254	(or (math-objectp rate) (and math-expand-formulas (null lump))
	255	(math-reject-arg rate 'numberp))
	256	(and (math-zerop rate)
	257	(math-reject-arg rate 'nonzerop))
	258	(or (math-objectp pmt) (and math-expand-formulas (null lump))
	259	(math-reject-arg pmt 'numberp))
	260	(or (math-objectp amount) (and math-expand-formulas (null lump))
	261	(math-reject-arg amount 'numberp))
	262	(if lump
	263	(progn
	264	(or (math-objectp lump)
	265	(math-reject-arg lump 'numberp))
	266	(let ((root (math-find-root (list 'calcFunc-eq
	267	(list (if bflag
	268	'calcFunc-pvb
	269	'calcFunc-pv)
	270	rate
	271	'(var DUMMY var-DUMMY)
	272	pmt
	273	lump)
	274	amount)
	275	'(var DUMMY var-DUMMY)
	276	'(intv 3 0 100)
	277	t)))
	278	(if (math-vectorp root)
	279	(nth 1 root)
	280	root)))
	281	(math-with-extra-prec 2
	282	(let ((temp (if (eq bflag 'l)
	283	(math-div amount pmt)
	284	(math-sub 1 (math-div (math-mul amount rate)
	285	(if bflag
	286	(math-mul pmt (math-add 1 rate))
	287	pmt))))))
	288	(if (or (math-posp temp) math-expand-formulas)
	289	(math-neg (calcFunc-log temp (math-add 1 rate)))
bf77c646	290	(math-reject-arg pmt "*Payment too small to cover interest rate"))))))
136211a9 EZ	291
136211a9 EZ	292	(defun calcFunc-rate (num pmt amount &optional lump)
bf77c646	293	(math-compute-rate num pmt amount lump 'calcFunc-pv))
136211a9 EZ	294
136211a9 EZ	295	(defun calcFunc-rateb (num pmt amount &optional lump)
bf77c646	296	(math-compute-rate num pmt amount lump 'calcFunc-pvb))
136211a9 EZ	297
	298	(defun math-compute-rate (num pmt amount lump func)
	299	(or (math-objectp num)
	300	(math-reject-arg num 'numberp))
	301	(or (math-objectp pmt)
	302	(math-reject-arg pmt 'numberp))
	303	(or (math-objectp amount)
	304	(math-reject-arg amount 'numberp))
	305	(or (null lump)
	306	(math-objectp lump)
	307	(math-reject-arg lump 'numberp))
	308	(let ((root (math-find-root (list 'calcFunc-eq
	309	(list func
	310	'(var DUMMY var-DUMMY)
	311	num
	312	pmt
	313	(or lump 0))
	314	amount)
	315	'(var DUMMY var-DUMMY)
	316	'(intv 3 (float 1 -4) 1)
	317	t)))
	318	(if (math-vectorp root)
	319	(nth 1 root)
bf77c646	320	root)))
136211a9 EZ	321
	322	(defun calcFunc-ratel (num pmt amount)
	323	(or (math-objectp num) math-expand-formulas
	324	(math-reject-arg num 'numberp))
	325	(or (math-objectp pmt) math-expand-formulas
	326	(math-reject-arg pmt 'numberp))
	327	(or (math-objectp amount) math-expand-formulas
	328	(math-reject-arg amount 'numberp))
	329	(math-with-extra-prec 2
bf77c646	330	(math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1)))
136211a9 EZ	331
136211a9 EZ	332	(defun calcFunc-irr (&rest vecs)
bf77c646	333	(math-compute-irr vecs 'calcFunc-npv))
136211a9 EZ	334
136211a9 EZ	335	(defun calcFunc-irrb (&rest vecs)
bf77c646	336	(math-compute-irr vecs 'calcFunc-npvb))
136211a9 EZ	337
	338	(defun math-compute-irr (vecs func)
	339	(let* ((flat (math-flatten-many-vecs vecs))
	340	(root (math-find-root (list func
	341	'(var DUMMY var-DUMMY)
	342	flat)
	343	'(var DUMMY var-DUMMY)
	344	'(intv 3 (float 1 -4) 1)
	345	t)))
	346	(if (math-vectorp root)
	347	(nth 1 root)
bf77c646	348	root)))
136211a9 EZ	349
	350	(defun math-check-financial (rate num)
	351	(or (math-objectp rate) math-expand-formulas
	352	(math-reject-arg rate 'numberp))
	353	(and (math-zerop rate)
	354	(math-reject-arg rate 'nonzerop))
	355	(or (math-objectp num) math-expand-formulas
bf77c646	356	(math-reject-arg num 'numberp)))
136211a9 EZ	357
	358
	359	(defun calcFunc-sln (cost salvage life &optional period)
	360	(or (math-realp cost) math-expand-formulas
	361	(math-reject-arg cost 'realp))
	362	(or (math-realp salvage) math-expand-formulas
	363	(math-reject-arg salvage 'realp))
	364	(or (math-realp life) math-expand-formulas
	365	(math-reject-arg life 'realp))
	366	(if (math-zerop life) (math-reject-arg life 'nonzerop))
	367	(if (and period
	368	(if (math-num-integerp period)
	369	(or (Math-lessp life period) (not (math-posp period)))
	370	(math-reject-arg period 'integerp)))
	371	0
bf77c646	372	(math-div (math-sub cost salvage) life)))
136211a9 EZ	373	(put 'calcFunc-sln 'math-expandable t)
	374
	375	(defun calcFunc-syd (cost salvage life period)
	376	(or (math-realp cost) math-expand-formulas
	377	(math-reject-arg cost 'realp))
	378	(or (math-realp salvage) math-expand-formulas
	379	(math-reject-arg salvage 'realp))
	380	(or (math-realp life) math-expand-formulas
	381	(math-reject-arg life 'realp))
	382	(if (math-zerop life) (math-reject-arg life 'nonzerop))
	383	(or (math-realp period) math-expand-formulas
	384	(math-reject-arg period 'realp))
	385	(if (or (Math-lessp life period) (not (math-posp period)))
	386	0
	387	(math-div (math-mul (math-sub cost salvage)
	388	(math-add (math-sub life period) 1))
bf77c646	389	(math-div (math-mul life (math-add life 1)) 2))))
136211a9 EZ	390	(put 'calcFunc-syd 'math-expandable t)
	391
	392	(defun calcFunc-ddb (cost salvage life period)
	393	(if (math-messy-integerp period) (setq period (math-trunc period)))
	394	(or (integerp period) (math-reject-arg period 'fixnump))
	395	(or (math-realp cost) (math-reject-arg cost 'realp))
	396	(or (math-realp salvage) (math-reject-arg salvage 'realp))
	397	(or (math-realp life) (math-reject-arg life 'realp))
	398	(if (math-zerop life) (math-reject-arg life 'nonzerop))
	399	(if (or (Math-lessp life period) (<= period 0))
	400	0
	401	(let ((book cost)
	402	(res 0))
	403	(while (>= (setq period (1- period)) 0)
	404	(setq res (math-div (math-mul book 2) life)
	405	book (math-sub book res))
	406	(if (Math-lessp book salvage)
	407	(setq res (math-add res (math-sub book salvage))
	408	book salvage)))
bf77c646	409	res)))
136211a9	410
7bd61134 JB	411	(provide 'calc-fin)
7bd61134 JB	412
cbee283d	413	;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b
bf77c646	414	;;; calc-fin.el ends here