From c596d6868d82aa82a199bdee3503c6b959f65b87 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Wed, 8 Mar 2017 11:14:44 -0500 Subject: [PATCH] Refactor some lisp code and tests --- fitnesse/FitNesseRoot/RecentChanges.wiki | 1 + .../TranscendentalLisp/FinanceUnitTests.wiki | 14 +++ ...ctionUnitTests.wiki => LangUnitTests.wiki} | 0 lisp/finance/interest-compounder-test.lisp | 22 ++++- lisp/finance/interest-compounder.lisp | 93 ++++++++++--------- lisp/lang/dlambda.lisp | 2 + lisp/object/multiple-methods.lisp | 2 + lisp/object/static.lisp | 2 + lisp/unit/unit-test.lisp | 9 +- 9 files changed, 97 insertions(+), 48 deletions(-) create mode 100644 fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki rename fitnesse/FitNesseRoot/TranscendentalLisp/{ExternalFunctionUnitTests.wiki => LangUnitTests.wiki} (100%) diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index 2e1d183..8447b41 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/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| diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki new file mode 100644 index 0000000..cac682f --- /dev/null +++ b/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$/ | diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/ExternalFunctionUnitTests.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki similarity index 100% rename from fitnesse/FitNesseRoot/TranscendentalLisp/ExternalFunctionUnitTests.wiki rename to fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki diff --git a/lisp/finance/interest-compounder-test.lisp b/lisp/finance/interest-compounder-test.lisp index 4cb61c0..122bdeb 100644 --- a/lisp/finance/interest-compounder-test.lisp +++ b/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)))))) diff --git a/lisp/finance/interest-compounder.lisp b/lisp/finance/interest-compounder.lisp index d279085..65a601e 100644 --- a/lisp/finance/interest-compounder.lisp +++ b/lisp/finance/interest-compounder.lisp @@ -1,49 +1,58 @@ (load "../lang/dlambda.lisp") -(defun interest-compounder (initial-principal initial-interest-rate) - (let ((private) (public) - (principal initial-principal) - (interest-rate initial-interest-rate) - (years-passed 0)) +(let ((static)) - (setq private - (eval - (dlambda + (setq static + (eval + (dlambda - (:add-years (years) - (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)))))) - (: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) + (years-passed 0)) - (:compound-interest (years) - (if (> years 0) + (setq private + (eval + (dlambda + + (:add-years (years) + (if (> years 0) + (setq years-passed (+ years-passed years)))) + + (:compound-interest (years) + (if (> years 0) + (begin + (setq principal + (+ principal + (call static :percent-of-number principal interest-rate))) + (call private :compound-interest (- years 1)))))))) + + (setq public + (eval + (dlambda + + (:get-years-passed () + years-passed) + + (:get-principal () + principal) + + (:get-interest-rate () + interest-rate) + + (:set-interest-rate (new-interest-rate) + (setq interest-rate new-interest-rate)) + + (:make-contribution (contribution) + (setq principal (+ principal contribution))) + + (:move-forward-years (years) (begin - (setq principal - (+ principal - (call private :percent-of-number principal interest-rate))) - (call private :compound-interest (- years 1)))))))) - - (setq public - (eval - (dlambda - - (:get-years-passed () - years-passed) - - (:get-principal () - principal) - - (:get-interest-rate () - interest-rate) - - (:set-interest-rate (new-interest-rate) - (setq interest-rate new-interest-rate)) - - (: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))))))))) diff --git a/lisp/lang/dlambda.lisp b/lisp/lang/dlambda.lisp index ce293cc..ab8f792 100644 --- a/lisp/lang/dlambda.lisp +++ b/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) diff --git a/lisp/object/multiple-methods.lisp b/lisp/object/multiple-methods.lisp index 23d2aa6..dfd7950 100644 --- a/lisp/object/multiple-methods.lisp +++ b/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) diff --git a/lisp/object/static.lisp b/lisp/object/static.lisp index 831f0cb..414cb87 100644 --- a/lisp/object/static.lisp +++ b/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 diff --git a/lisp/unit/unit-test.lisp b/lisp/unit/unit-test.lisp index ef55170..ae09b09 100644 --- a/lisp/unit/unit-test.lisp +++ b/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) - - (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)))