Refactor some lisp code and tests
This commit is contained in:
parent
87eb0204f5
commit
c596d6868d
|
@ -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|
|
||||
|
|
|
@ -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$/ |
|
|
@ -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))))))
|
||||
|
|
|
@ -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)))))))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
Loading…
Reference in New Issue