Refactor some lisp code and tests

This commit is contained in:
Mike Cifelli 2017-03-08 11:14:44 -05:00
parent 87eb0204f5
commit c596d6868d
9 changed files with 97 additions and 48 deletions

View File

@ -1,3 +1,4 @@
|TranscendentalLisp.FinanceUnitTests||11:03:11 Wed, Mar 08, 2017|
|TranscendentalLisp.LexicalClosures||16:39:59 Tue, Mar 07, 2017|
|FrontPage||10:19:45 Tue, Mar 07, 2017|
|TranscendentalLisp||10:14:02 Tue, Mar 07, 2017|

View File

@ -0,0 +1,14 @@
---
Test
---
Unit tests for the interest-compounder class.
| script | lisp interpreter fixture |
| clear functions and symbols |
| check | evaluate file | lisp/finance/interest-compounder-test.lisp | =~/T$/ |
Unit tests for the compound-interest function.
| script | lisp interpreter fixture |
| clear functions and symbols |
| check | evaluate file | lisp/finance/compound-interest-test.lisp | =~/T$/ |

View File

@ -100,4 +100,24 @@
(setq compounder (interest-compounder 100000 5))
(call compounder :move-forward-years 27)
(call compounder :move-forward-years 0)
(assert= 27 (call compounder :get-years-passed))))))
(assert= 27 (call compounder :get-years-passed)))
(defun make-contribution ()
(setq compounder (interest-compounder 100000 5))
(call compounder :make-contribution 2000)
(assert= 102000 (call compounder :get-principal)))
(defun make-several-contributions ()
(setq compounder (interest-compounder 100000 5))
(call compounder :make-contribution 2000)
(call compounder :make-contribution 2000)
(call compounder :make-contribution 1000)
(assert= 105000 (call compounder :get-principal)))
(defun make-several-contributions-and-earn-interest ()
(setq compounder (interest-compounder 100000 5))
(call compounder :make-contribution 2000)
(call compounder :move-forward-years 2)
(call compounder :make-contribution 2000)
(call compounder :move-forward-years 2)
(assert= 126187 (call compounder :get-principal))))))

View File

@ -1,6 +1,17 @@
(load "../lang/dlambda.lisp")
(defun interest-compounder (initial-principal initial-interest-rate)
(let ((static))
(setq static
(eval
(dlambda
(:percent-of-number (n percentage)
(if (> percentage 0)
(/ (+ (* n percentage) 50) 100)
(/ (- (* n percentage) 50) 100))))))
(defun interest-compounder (initial-principal initial-interest-rate)
(let ((private) (public)
(principal initial-principal)
(interest-rate initial-interest-rate)
@ -14,17 +25,12 @@
(if (> years 0)
(setq years-passed (+ years-passed years))))
(:percent-of-number (n percentage)
(if (> percentage 0)
(/ (+ (* n percentage) 50) 100)
(/ (- (* n percentage) 50) 100)))
(:compound-interest (years)
(if (> years 0)
(begin
(setq principal
(+ principal
(call private :percent-of-number principal interest-rate)))
(call static :percent-of-number principal interest-rate)))
(call private :compound-interest (- years 1))))))))
(setq public
@ -43,7 +49,10 @@
(:set-interest-rate (new-interest-rate)
(setq interest-rate new-interest-rate))
(:make-contribution (contribution)
(setq principal (+ principal contribution)))
(:move-forward-years (years)
(begin
(call private :add-years years)
(call private :compound-interest years))))))))
(call private :compound-interest years)
(call private :add-years years)))))))))

View File

@ -1,5 +1,7 @@
(load "functions.lisp")
;; A special function based on the dlambda macro presented in "Let Over Lambda" by Doug Hoyte.
(let
((add-method-clause
(lambda (method)

View File

@ -1,3 +1,5 @@
;; This is based on an example presented in "Let Over Lambda" by Doug Hoyte.
(defun counter-class ()
(let ((counter 0))
(lambda (msg)

View File

@ -1,3 +1,5 @@
;; This is based on an example presented in "Let Over Lambda" by Doug Hoyte.
(let ((direction 'up))
(defun toggle-counter-direction ()
(setq direction

View File

@ -1,10 +1,9 @@
(defun run-unit-test (unit-test)
(if (call unit-test)
(progn
(begin
(print (cons t unit-test))
t)
(progn
(begin
(print (cons 'f unit-test))
nil)))
@ -15,12 +14,12 @@
(run-test-suite (cdr test-suite)))))
(defun unit (test-suite)
(eval (cons 'and (run-test-suite test-suite))))
(apply 'and (run-test-suite test-suite)))
(defun assert (comparison expected actual)
(if (call comparison expected actual)
t
(progn
(begin
(print (list expected 'is 'not comparison actual))
nil)))