source: trunk/source/contrib/krueger/InterfaceProjects/Loan Calc/loan-calc.lisp @ 13390

Last change on this file since 13390 was 13390, checked in by plkrueger, 11 years ago

New contrib from Paul Krueger

File size: 19.5 KB
Line 
1;;; loan-calc.lisp
2
3#|
4The MIT license.
5
6Copyright (c) 2010 Paul L. Krueger
7
8Permission is hereby granted, free of charge, to any person obtaining a copy of this software
9and associated documentation files (the "Software"), to deal in the Software without restriction,
10including without limitation the rights to use, copy, modify, merge, publish, distribute,
11sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
12furnished to do so, subject to the following conditions:
13
14The above copyright notice and this permission notice shall be included in all copies or substantial
15portions of the Software.
16
17THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
18LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
20WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
23|#
24
25;;; Sample lisp/Cocoa interface that uses a NIB file defined with interface builder;
26;;; A definition is provided for the "SpeechController" class that was specified to interface builder
27;;; as the class of the NIB file owner.
28;;; We manually create an instance of SpeechController and specify it as the owner for the NIB file.
29
30(require :NIB)
31(require :date)
32(require :decimal)
33
34(defpackage :loan-calc
35  (:nicknames :lnc)
36  (:use :iu :ccl :common-lisp)
37  (:export test-loan))
38
39(in-package :lnc)
40
41;; The loan-controller class
42
43(defclass loan-controller (ns:ns-window-controller)
44  ((loan :foreign-type :id :accessor loan)
45   (loan-text :foreign-type :id :accessor loan-text)
46   (int-text :foreign-type :id :accessor int-text)
47   (dur-text :foreign-type :id :accessor dur-text)
48   (pay-text :foreign-type :id :accessor pay-text)
49   (int-slider :foreign-type :id :accessor int-slider)
50   (dur-slider :foreign-type :id :accessor dur-slider)
51   (pay-slider :foreign-type :id :accessor pay-slider))
52  (:metaclass ns:+ns-object))
53
54(objc:defmethod (#/initWithLoan: :id)
55                ((self loan-controller) (ln :id))
56  (setf (loan self) ln)
57  (let* ((nib-name (ccl::%make-nsstring 
58                    (namestring (truename "ip:Loan Calc;loan.nib"))))
59         (init-self (#/initWithWindowNibPath:owner: self nib-name self)))
60    init-self))
61
62;; Action methods that are called when controls do something
63
64(objc:defmethod (#/buttonPushed: :void) 
65                ((self loan-controller) (button-matrix :id))
66  (with-slots (loan loan-text int-text dur-text pay-text int-slider 
67                    dur-slider pay-slider) self
68    (let ((cm (#/selectedRow button-matrix)))
69      (unless (eql cm (compute-mode loan))
70        (case (compute-mode loan)
71          (0 (#/setEnabled: loan-text #$YES))
72          (1 (#/setEnabled: int-text #$YES)
73             (#/setEnabled: int-slider #$YES))
74          (2 (#/setEnabled: dur-text #$YES)
75             (#/setEnabled: dur-slider #$YES))
76          (3 (#/setEnabled: pay-text #$YES)
77             (#/setEnabled: pay-slider #$YES)))
78        (setf (compute-mode loan) cm)
79        (case cm
80          (0 (#/setEnabled: loan-text #$NO))
81          (1 (#/setEnabled: int-text #$NO)
82             (#/setEnabled: int-slider #$NO))
83          (2 (#/setEnabled: dur-text #$NO)
84             (#/setEnabled: dur-slider #$NO))
85          (3 (#/setEnabled: pay-text #$NO)
86             (#/setEnabled: pay-slider #$NO)))
87        (compute-new-loan-values loan)))))
88
89(objc:defmethod (#/awakeFromNib :void) 
90                ((self loan-controller))
91  (#/setEnabled: (loan-text self) #$NO)
92  ;; set the sliders to update continuously so that the text boxes reflect the current value
93  ;; Note that we can set this in IB for text boxes, but not, apparently, for sliders
94  (#/setContinuous: (int-slider self) #$YES)
95  (#/setContinuous: (dur-slider self) #$YES)
96  (#/setContinuous: (pay-slider self) #$YES))
97
98(objc:defmethod (#/windowWillClose: :void) 
99                ((self loan-controller) (notif :id))
100  (declare (ignore notif))
101  (when (loan self)
102    ;; Tell the loan that the window is closing
103    ;; It will #/autorelease this window-controller)
104    (window-closed (loan self))))
105
106
107;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
108;;;; Everything below is related to the loan data model
109
110(defconstant $max-interest-rate$ .5)
111
112;; Some loan utility functions
113
114;; all equations are derived from a basic loan equation for an N month loan:
115;; LoanPrinciple = MonthlyPayment * ( (1 / (1 + MonthlyInterest)) +
116;;                                    (1 / (1 + MonthlyInterest)^2) + ... +
117;;                                    (1 / (1 + MonthlyInterest)^N) )
118;; which can be manipulated to derive:
119;; MonthlyPayment = LoanPrinciple * (MonthlyInterest + (MonthlyInterest / ((1 + MonthlyInterest)^LoanDuration - 1)))
120
121(defun pay-to-loan-ratio (mo-int loan-dur)
122  ;; Just computes the MonthlyPayment/Loan ratio from the basic loan equation given above
123  (if (zerop mo-int) 0 
124    (+ mo-int (/ mo-int (1- (expt (1+ mo-int) loan-dur))))))
125
126;; The loan class
127
128(defclass loan (ns:ns-object)
129  ((loan-amount :accessor loan-amount :initform 0)
130   (interest-rate :accessor interest-rate :initform 0)
131   (loan-duration :accessor loan-duration :initform 0)
132   (monthly-payment :accessor monthly-payment :initform 0)
133   (origination-date :accessor origination-date :initform (now))
134   (first-payment :accessor first-payment :initform (next-month (now)))
135   (pay-schedule :accessor pay-schedule :initform nil)
136   (window-controller :accessor window-controller :initform nil)
137   (compute-mode :accessor compute-mode :initform 0)
138   (max-dur :foreign-type #>BOOL :accessor max-dur)
139   (min-dur :foreign-type #>BOOL :accessor min-dur)
140   (min-pay :foreign-type #>BOOL :accessor min-pay))
141  (:metaclass ns:+ns-object))
142
143
144;; Normal lisp methods for our class
145
146(defmethod initialize-instance :after ((self loan) 
147                                       &key &allow-other-keys)
148  (setf (window-controller self)
149        (make-instance (find-class 'loan-controller)
150          :with-loan self))
151  (#/showWindow: (window-controller self) self))
152
153(defmethod window-closed ((self loan))
154  ;; called by the window-controller to tell us that the window closed
155  (when (window-controller self)
156    (#/autorelease (window-controller self))
157    (setf (window-controller self) nil)))
158
159(defmethod close-loan ((self loan))
160  ;; just tell the window to close
161  (when (window-controller self)
162    (let ((win (#/window (window-controller self))))
163      ;; for reasons mysterious to me, calling #/window seems to
164      ;; also #/retain the window, so we'll #/release it
165      (#/release win)
166      (#/performClose: win self))))
167
168(defmethod set-pay-schedule ((self loan))
169  ;; create a detailed payment schedule for the loan using daily compounding of interest
170  ;; Payments are on the same date of each month, but the number of days between payments
171  ;; varies because the number of days in each month varies.
172  ;; We compute accurate interest compounded daily for the actual number of days.
173  (let ((monthly-interest (/ (interest-rate self) 12))
174        (payment (monthly-payment self))
175        (sched nil)
176        (display-min-pay-banner nil))
177    (prog1
178        (do* ((begin (loan-amount self) end)
179              (begin-date (first-payment self) end-date)
180              (end-date (next-month begin-date) (next-month begin-date))
181              (int (round (* begin monthly-interest))
182                   (round (* begin monthly-interest)))
183              (end (- (+ begin int) payment) (- (+ begin int) payment)))
184             ((not (plusp end)) 
185              (progn
186                (push (list (short-date-string begin-date) 
187                            (/ begin 100)
188                            (/ int 100)
189                            (/ payment 100)
190                            (short-date-string end-date) 
191                            (/ end 100)
192                            int) 
193                      sched)
194                (setf (pay-schedule self) (nreverse sched))))
195          (when (>= end begin)
196            ;; oops, with this combination of values the loan will never
197            ;; be paid off, so let's set a minimum payment required
198            ;; Display a field that tells user the minimum payment was reached
199            (setf display-min-pay-banner t)
200            (#/willChangeValueForKey: self #@"monthlyPayment")
201            (setf (monthly-payment self) (1+ int))
202            (#/didChangeValueForKey: self #@"monthlyPayment")
203            ;; now patch up our loop variables and keep going
204            (setf payment (monthly-payment self))
205            (setf end (1- begin)))
206          ;; put the last payment into the list
207          (push (list (short-date-string begin-date) 
208                      (/ begin 100)
209                      (/ int 100)
210                      (/ payment 100)
211                      (short-date-string end-date) 
212                      (/ end 100)
213                      int)
214                sched))
215      (#/willChangeValueForKey: self #@"totInterest")
216      ;; we'll make the total interest field call our accessor
217      ;; to generate a new amount
218      (#/didChangeValueForKey: self #@"totInterest")
219      (if display-min-pay-banner
220        (progn
221          ;; Set a condition that says the minimum payment was reached
222          (setf display-min-pay-banner t)
223          (#/willChangeValueForKey: self #@"minPay")
224          (setf (min-pay self) #$YES)
225          (#/didChangeValueForKey: self #@"minPay"))
226        (progn
227          ;; otherwise reset that condition
228          (#/willChangeValueForKey: self #@"minPay")
229          (setf (min-pay self) #$NO)
230          (#/didChangeValueForKey: self #@"minPay")))
231      ;; If we happen to be computing the interest rate, then
232      ;; the combination of loan-amount and monthly payment will
233      ;; determine a maximum interest rate. This, in turn,
234      ;; determines a maximum loan duration. If the duration was set
235      ;; longer than this by the user, we will reset the
236      ;; lone duration value to the maximum needed.
237      ;; If, on the other hand, the monthly payment is set so low that
238      ;; the interest rate approaches 0, then we may have to adjust the
239      ;; loan duration up to the minimum needed to pay the loan.
240      ;; Let's start by resetting our two "duration" conditions and then we'll
241      ;; set them if conditions dictate.
242      ;; Reset a condition that indicates the max duration was reached
243      (#/willChangeValueForKey: self #@"maxDur")
244      (setf (max-dur self) #$NO)
245      (#/didChangeValueForKey: self #@"maxDur")
246      ;; Reset a condition that indicates the min duration was reached
247      (#/willChangeValueForKey: self #@"minDur")
248      (setf (min-dur self) #$NO)
249      (#/didChangeValueForKey: self #@"minDur"))
250      (let ((duration-diff (- (loan-duration self) (list-length (pay-schedule self)))))
251        (unless (or (eql (compute-mode self) 2) (zerop duration-diff))
252          ;; i.e. we're not calling this function just to determine the loan duration
253          ;; and we have to adjust the loan duration
254          (if (plusp duration-diff)
255            (progn
256              ;; change the loan-duration value to what it must be
257              (#/willChangeValueForKey: self #@"loanDuration")
258              (setf (loan-duration self) (list-length (pay-schedule self)))
259              (#/didChangeValueForKey: self #@"loanDuration")
260              (when (> duration-diff 2)
261                ;; If we're one-off just fix it and don't post a message
262                ;; This can occur almost anytime because of numerical issues
263                ;; Display a field that tells user the max duration was reached
264                (#/willChangeValueForKey: self #@"maxDur")
265                (setf (max-dur self) #$YES)
266                (#/didChangeValueForKey: self #@"maxDur")))
267            (progn
268              ;; change the oan-duration value to what it must be
269              (#/willChangeValueForKey: self #@"loanDuration")
270              (setf (loan-duration self) (list-length (pay-schedule self)))
271              (#/didChangeValueForKey: self #@"loanDuration")
272              (when (< duration-diff -2)
273                ;; If we're one-off just fix it and don't post a message
274                ;; This can occur almost anytime because of numerical issues
275                ;; Display a field that tells user the min duration was reached
276                (#/willChangeValueForKey: self #@"minDur")
277                (setf (min-dur self) #$YES)
278                (#/didChangeValueForKey: self #@"minDur"))))))))
279
280(defmethod print-pay-schedule ((self loan) &optional (strm t))
281  (format strm 
282          "~:{~%On ~a balance = $~$ + interest of $~$ - payment of $~$ = ~a balance of $~$~}"
283          (pay-schedule self)))
284
285(defmethod compute-int-rate ((self loan))
286  ;; Find a monthly interest rate that makes the rest of the values work.
287  ;; There isn't an algebraic solution for the interest rate, so let's search for it.
288  ;; Find a suitable search range and do a binary search for it. Even for large interest
289  ;; rates the number of search iterations should be minimal.
290
291  (with-slots (loan-amount monthly-payment loan-duration interest-rate) self
292 
293    ;; First we'll check to see whether the monthly payment is great than the loan amount.
294    ;; If so we'll set the interest rate directly so that the loan is paid off in one month.
295    ;; This avoids some ugly arithmetic overflow things that can happen when interest rates
296    ;; go off the charts
297    (let ((max-monthly-rate (/ $max-interest-rate$ 12)))
298      (if (>= monthly-payment loan-amount)
299        (min max-monthly-rate (1- (/ monthly-payment loan-amount)))
300        (let ((imin (max 0 (min max-monthly-rate
301                                (/ (- (* monthly-payment loan-duration) loan-amount) 
302                                   (* loan-duration loan-amount)))))
303              ;; imin is basically a rate that would result in the first month's interest as
304              ;; the average interest paid for all months. Since we know it must be greater
305              ;; than this, we have a guaranteed lower bound. But we cap it at our allowed
306              ;; monthly maximum interest.
307              (imax (min max-monthly-rate 
308                         (- (/ monthly-payment loan-amount) .000008333)))
309              ;; imax is a rate that would result in the first month's interest being
310              ;; minimally smaller than the payment. Since we must pay off in a finite
311              ;; duration, this is a guaranteed maximum. We cap it the allowed maximum
312              ;; monthly rate.
313              (target-p-l-ratio (/ monthly-payment loan-amount)))
314          (unless (>= imax imin)
315            (error "Max int = ~8,4f, Min int = ~8,4f" imax imin))
316          (do* ((i (/ (+ imin imax) 2) 
317                   (/ (+ imin imax) 2))
318                (p-l-ratio (pay-to-loan-ratio i loan-duration) 
319                           (pay-to-loan-ratio i loan-duration)))
320               ((<= (- imax imin) .000001) imax)
321            (if (>= target-p-l-ratio p-l-ratio)
322              (setf imin i)
323              (setf imax i))))))))
324
325(defmethod compute-new-loan-values ((self loan))
326  ;; For the sake of expediency we assume monthly componding
327  ;; The basic equation governing these computations is
328  (with-slots (compute-mode interest-rate loan-duration monthly-payment 
329                            loan-amount pay-schedule) self
330    (case compute-mode
331      (0
332       ;; compute the loan amount
333       (unless (or (zerop interest-rate)
334                   (zerop loan-duration)
335                   (zerop monthly-payment))
336         (#/willChangeValueForKey: self #@"loanAmt")
337         (setf loan-amount 
338               (round (/ monthly-payment 
339                         (pay-to-loan-ratio (/ interest-rate 12)
340                                            loan-duration))))
341         (set-pay-schedule self)
342         (#/didChangeValueForKey: self #@"loanAmt")))
343      (1
344       ;; compute the interest rate
345       (unless (or (zerop loan-amount)
346                   (zerop loan-duration)
347                   (zerop monthly-payment))
348         (#/willChangeValueForKey: self #@"interestRate")
349         (setf interest-rate 
350               (* 12 (/ (floor (* 1000000 (compute-int-rate self)))
351                        1000000)))
352         (set-pay-schedule self)
353         (#/didChangeValueForKey: self #@"interestRate")))
354      (2
355       ;; compute the loan duration
356       (unless (or (zerop interest-rate)
357                   (zerop loan-amount)
358                   (zerop monthly-payment))
359         (#/willChangeValueForKey: self #@"loanDuration")
360         (set-pay-schedule self)
361         (setf loan-duration
362               (list-length pay-schedule))
363         (#/didChangeValueForKey: self #@"loanDuration")))
364      (3
365       ;; compute the monthly payment
366       (unless (or (zerop interest-rate)
367                   (zerop loan-amount)
368                   (zerop loan-duration))
369         (#/willChangeValueForKey: self #@"monthlyPayment")
370         (setf monthly-payment
371               (round (* loan-amount 
372                         (pay-to-loan-ratio (/ interest-rate 12) 
373                                            loan-duration))))
374         (set-pay-schedule self)
375         (#/didChangeValueForKey: self #@"monthlyPayment"))))))
376
377;; Accessor functions used by display objects to retrieve and set values as dictated
378;; by the bindings we set up in IB
379
380(objc:defmethod (#/loanAmt :id)
381                ((self loan))
382  (lisp-to-ns-decimal (loan-amount self)))
383
384(objc:defmethod (#/interestRate :id)
385                ((self loan))
386  (#/numberWithFloat: ns:ns-number (float (interest-rate self))))
387
388(objc:defmethod (#/loanDuration :id)
389                ((self loan))
390  (#/numberWithInt: ns:ns-number (loan-duration self)))
391
392(objc:defmethod (#/monthlyPayment :id)
393                ((self loan))
394  (lisp-to-ns-decimal (monthly-payment self)))
395
396(objc:defmethod (#/originationDate :id)
397                ((self loan))
398  (lisp-to-ns-date (origination-date self)))
399
400(objc:defmethod (#/firstPayment :id)
401                ((self loan))
402  (lisp-to-ns-date (first-payment self)))
403
404(objc:defmethod (#/totInterest :id)
405                ((self loan))
406  (lisp-to-ns-decimal (reduce #'+ (pay-schedule self) 
407                              :key #'seventh 
408                              :initial-value 0)))
409
410(objc:defmethod (#/setLoanAmt: :void)
411                ((self loan) (amt :id))
412  (setf (loan-amount self) (lisp-from-ns-decimal amt))
413  (compute-new-loan-values self))
414
415(objc:defmethod (#/setInterestRate: :void)
416                ((self loan) (rate :id))
417  (setf (interest-rate self) (#/floatValue rate))
418  (compute-new-loan-values self))
419
420(objc:defmethod (#/setLoanDuration: :void)
421                ((self loan) (dur :id))
422  (setf (loan-duration self) (#/longValue dur))
423  (compute-new-loan-values self))
424
425(objc:defmethod (#/setMonthlyPayment: :void)
426                ((self loan) (pay :id))
427  (setf (monthly-payment self) (lisp-from-ns-decimal pay))
428  (compute-new-loan-values self))
429
430(objc:defmethod (#/setOriginationDate: :void)
431                ((self loan) (dt :id))
432  (let ((new-dt (ns-to-lisp-date dt)))
433    (setf (origination-date self) new-dt)
434    (#/willChangeValueForKey: self #@"firstPayment")
435    (setf (first-payment self) (next-month new-dt))
436    (#/didChangeValueForKey: self #@"firstPayment"))
437  (compute-new-loan-values self))
438
439(objc:defmethod (#/setFirstPayment: :void) 
440                ((self loan) (pay :id))
441  (let ((new-pay (ns-to-lisp-date pay)))
442    (setf (first-payment self) new-pay))
443  (compute-new-loan-values self))
444
445
446
447;; test by
448(defun test-loan ()
449  ;; up to caller to #/release the returned loan instance
450  ;; but only after window is closed or crash will occur
451  (make-instance 'loan))
452
453(provide :loan-calc)
Note: See TracBrowser for help on using the repository browser.