Refactor some lisp code and tests

fitnesse/FitNesseRoot/RecentChanges.wiki

@@ -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|

fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki

@@ -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$/ |

lisp/finance/interest-compounder-test.lisp

@@ -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))))))

lisp/finance/interest-compounder.lisp

@@ -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)))))))))

lisp/lang/dlambda.lisp

@@ -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)

lisp/object/multiple-methods.lisp

@@ -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)

lisp/object/static.lisp

@@ -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

lisp/unit/unit-test.lisp

@@ -1,10 +1,9 @@
 (defun run-unit-test (unit-test)
   (if (call unit-test)
-    (progn
+    (begin
       (print (cons t unit-test))
       t)
-
+    (begin
-    (progn
       (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)))