Codelesson Clojure Assignment 6

assignment_6.clj

(ns codelesson.assignment-6
  (:require [clojure.string :as str])
  (:import [org.joda.time Years DateTime])
  (:import [java.text NumberFormat]))

;; utils

(defn account-logger [key ref old new]
;;  (println (str "ACCOUNTS " key "\n WAS:" old "\n NOW:" new "END"))
)

(def uniq-id (ref 0))

(defn new-uniq-id []
  (dosync (alter uniq-id inc)))

(defn years-since [date-time-1 date-time-2]
  (.getYears (Years/yearsBetween date-time-1 date-time-2)))

(defn format-money [f]
  {:pre [(number? f)]}
   (.format (NumberFormat/getCurrencyInstance) f))
  
;; account definitions
(defn create-account-type [interest-rate overdraft-rate maximum-overdraft]
  {:interest-rate interest-rate
   :overdraft-rate overdraft-rate
   :maximum-overdraft maximum-overdraft})

(def account-types (ref {}))

(defn reset-account-types []
  (dosync (ref-set account-types {})))

(defn save-new-account-type [id account-type]  
  (dosync (alter account-types assoc id account-type)))

(def accounts (ref {}))

(add-watch accounts "accounts" account-logger)

;; overdraft available
(def original-overdraft 100000)

(def overall-overdraft (ref original-overdraft))

;; bank-total
(def original-bank 1000000)

(def overall-bank (ref original-bank))

(defn reset-accounts []
  (dosync (ref-set accounts {})))

(defn create-account [account-type balance-dollars date-created]
  {:pre [(instance? DateTime date-created)]}
  {:account-type account-type
   :balance-dollars balance-dollars
   :date-created date-created
   :tx-count 0})

(defn save-new-account [id account]
  {:pre [(contains? @account-types (:account-type account))]}
  (dosync (alter accounts assoc id account)))

(defn lookup-account-type-field [account-id field]
  {:post (number? %)}
  "look up the corresponding field in this account's account type"
  ((@account-types ((@accounts account-id) :account-type)) field))

(defn inc-transaction-count [account-id]
  "create a new account record with increased tx count"
  {:pre [(contains? @accounts account-id)]}
  (assoc (@accounts account-id)
    :tx-count (inc ((@accounts account-id) :tx-count))))

(defn alter-account-amt [account-id fn amt]
  "create a new account record with fn (+/-) applied"
  {:pre [(fn? fn)
         (number? amt)
         (contains? @accounts account-id)]}

  (let [current-balance ((@accounts account-id) :balance-dollars)]
    (assoc (@accounts account-id)
      :balance-dollars (fn current-balance amt))))

;; must be called from within dosync
(defn save-account [account-id new-account]
  "replace account with new one"
  (alter accounts assoc account-id new-account))

(defn bonus-percentage [years rate balance]
  {:pre [(number? years) (number? rate) (number? balance)]}
  (cond
   (> 0 balance) 0.0
   (<= years 2) 0.0
   (and (> years 2) (< years 5)) (if (> 500 balance)
                                   (/ rate 32)
                                   (/ rate 24))
   (>= years 5) (if (> 500 balance)
                  (/ rate 16)
                  (/ rate 8))))

(defn apply-bonus [account-id]
  "Apply appropriate bonus every 10 txes, if account is not in overdraft"
  {:pre [(contains? @accounts account-id)] }
  (if (= 0
         (mod ((@accounts account-id) :tx-count) 10))    
    (let [age-in-years (years-since ((@accounts account-id) :date-created) (DateTime.))
          current-balance ((@accounts account-id) :balance-dollars)
          interest-rate (lookup-account-type-field account-id :interest-rate)
          bonus-percent (bonus-percentage age-in-years interest-rate current-balance)
          bonus (* bonus-percent current-balance)
          ]
      
      (if (> current-balance 0)
        (do
          (save-account account-id (alter-account-amt account-id + bonus))
          (alter overall-bank - bonus))))))


(defn apply-interest [account-id]
  "Apply appropriate interest every 25 txes, if account is not in overdraft"
  {:pre [(contains? @accounts account-id)] }
  (if (= 0
         (mod ((@accounts account-id) :tx-count) 25))    
    (let [interest-rate (lookup-account-type-field account-id :interest-rate)
          current-balance ((@accounts account-id) :balance-dollars)
          interest (* interest-rate current-balance)
          ]
      (if (> current-balance 0)
        (do
          (save-account account-id (alter-account-amt account-id + interest))
          (alter overall-bank - interest))))))

(defn validate-overdrafts []
    (= (format-money (- @overall-overdraft original-overdraft))
       (format-money (reduce + (filter neg? (map :balance-dollars (vals @accounts)))))))

(defn repay-overdrafts [account-id amt]
  {:pre [(contains? @accounts account-id) (number? amt)] }
  "repay the overdraft and return the remainder"
  (let [outstanding-overdraft (max 0 (- ((@accounts account-id) :balance-dollars)))
        to-repay (min amt outstanding-overdraft)
        left-to-transfer (- amt to-repay)
        ]
    (if (< 0 to-repay)    
        (alter overall-overdraft + to-repay)
        )
    left-to-transfer))

(defn take-from-overdraft [orig-balance new-balance]
  "if we're asking for a negative balance, take it from the overdraft acct"
  (if (< new-balance -1000)
    (throw (Exception. "Exceeded maximum overdraft"))
    )
  (if (> new-balance 0)
    0
    (let [start (min orig-balance 0)
          required (- start new-balance)]
      (if (> 0 (- @overall-overdraft required))
        (throw (Exception. "Bank declined overdraft")))
      (alter overall-overdraft - required)
        required)))

                                              
(defn withdraw [account-id amt]
  (let [initial-amt ((@accounts account-id) :balance-dollars)]    
    (save-account account-id (alter-account-amt account-id - amt))
    (save-account account-id (inc-transaction-count account-id))
    (apply-interest account-id)
    (apply-bonus account-id)
    (take-from-overdraft initial-amt ((@accounts account-id) :balance-dollars))
    ))


(defn deposit [account-id amt]
  ;;  (let [amt-to-apply (repay-overdrafts account-id amt)]
  (repay-overdrafts account-id amt)
  (save-account account-id (alter-account-amt account-id + amt))
  (save-account account-id (inc-transaction-count account-id))
  (apply-interest account-id)
  (apply-bonus account-id))

(defn apply-overdraft-penalty [account-id]
  ;; NOTE: You can apply a penalty on an overdrawn account, to
  ;; exceed the maximum overdrawn.
  (do
    (save-account account-id (alter-account-amt account-id - 10))
    (alter overall-overdraft - 10)
    (alter overall-bank + 10)
    ))

(defn transfer [from-account-id to-account-id amt]
  {:pre [(contains? @accounts from-account-id)
         (contains? @accounts to-account-id)]
   :post [(validate-overdrafts)]}
   
  (try
    (dosync
     (withdraw from-account-id amt)
     (deposit to-account-id amt)
     [(@accounts from-account-id) (@accounts to-account-id)]
     )
    (catch Exception e
      (println "TX Failed" (.getMessage e))
      ;; I interpret the "in this mode" to mean
      ;; "when the overdraft request cannot be completed"
      (dosync
       (apply-overdraft-penalty from-account-id)))))

;; initialize accounts

(save-new-account-type :chequing (create-account-type 0.02 0.10 1000))
(save-new-account-type :savings (create-account-type 0.04 0.075 1000))
(save-new-account-type :money-market (create-account-type 0.06 0.05 1000))


(defn max-day-of-month [year month]
  (.getMaximumValue (.dayOfMonth (DateTime. year month 1 12 0)))
  )

(defn random-account-type []
  (let [keys (keys @account-types)]        
    (nth keys (rand-int (count keys)))))


(defn random-date []
  "some random date since Jan 1, seven years ago"
  (def year-now (.get (.year (DateTime.))))
  (def month (+ 1 (rand-int 12)))
  (def year (- year-now (rand-int 7)))
  (def day (+ 1 (rand-int (max-day-of-month year month))))
  (def hour (rand-int 24))
  (def minute (rand-int 60))
  (DateTime. year month day hour minute)
 )

(defn random-account []
  (create-account (random-account-type) 500 (random-date)))

(defn random-accounts [n]
  (dotimes [x n]
    (save-new-account (new-uniq-id) (random-account))))


(defn select-random-amt []
  (+ 100 (* 10 (rand-int (/ (- 500 100) 10)))))

(defn select-random-account [accounts]
  (let [key-list (keys accounts)]        
    (nth key-list (rand-int (count key-list)))))

(defn exec-random-transaction []
  (let [from-account-id (select-random-account @accounts)
        to-account-id (select-random-account (dissoc @accounts from-account-id))]
    (transfer from-account-id to-account-id (select-random-amt))))

(defn random-transactions [n]
  (dotimes [x n]
    (exec-random-transaction)))


(defn format-acct [account-id]
  (str "acct #" account-id
       " balance: " (format-money ((@accounts account-id) :balance-dollars))
       " tx-count: " ((@accounts account-id)  :tx-count))
  )

(defn format-result [accounts overdraft bank]
  (let [key-list (keys accounts)]
    (str "Bank balance: " (format-money bank) "\n"
         "Overdraft balance: " (format-money overdraft) "\n"
         (str/join "\n" (map format-acct key-list)))))

(defn main[]
  (do
    (random-accounts 10)
    (random-transactions 100)
    (println (format-result @accounts @overall-overdraft @overall-bank))))

(defn check-result []
   ;; hardcoded values
   (let [orig-accts-total (* (+ 500) 10)
         final-accts-total (reduce + (map :balance-dollars (vals @accounts)))
         total-overdraft (reduce + (filter neg? (map :balance-dollars (vals @accounts))))]
        (println "overall balance delta" (format-money (- final-accts-total orig-accts-total)))
        (println "... should match bank balance delta" (format-money (- original-bank @overall-bank)))
        (println "overdraft delta" (format-money (- original-overdraft @overall-overdraft)))
        (println "... should match total overdraft" (format-money total-overdraft))))

=> (main)
TX Failed Exceeded maximum overdraft
TX Failed Exceeded maximum overdraft
TX Failed Exceeded maximum overdraft
Bank balance: $1,000,020.20
Overdraft balance: $98,570.00
acct #1 balance: $80.00 tx-count: 22
acct #2 balance: $1,548.70 tx-count: 11
acct #3 balance: ($850.00) tx-count: 23
acct #4 balance: $900.00 tx-count: 17
acct #5 balance: $1,101.10 tx-count: 17
acct #6 balance: ($110.00) tx-count: 23
acct #7 balance: ($470.00) tx-count: 18
acct #8 balance: $2,310.00 tx-count: 19
acct #9 balance: $260.00 tx-count: 23
acct #10 balance: $210.00 tx-count: 21
nil


=> (check-result)
overall balance delta ($20.20)
... should match bank balance delta ($20.20)
overdraft delta $1,430.00
... should match total overdraft ($1,430.00)
nil