;;; -*- Mode:LISP; Readtable:CL; Base:10 -*-
;;; There are often several ways to write a simple function in LISP. No,
;;; I don't mean the right and wrong ways -- I mean, the "normal" way
;;; the function might be written in a procedural language, versus the
;;; "LISP" ways, which just sometimes, might be "better" if more
;;; legible, or more easily modified, etc.
;;; Here's a standard implementation of the COINS algorithm. Given an
;;; input coin value, what combination of coins -- quarters, dimes,
;;; nickels, and pennies -- yields the desired value with the minimum
;;; number of coins? [Ref.: HARDCOPY magazine, 4/87, p. 136]
;;; The procedural algorithm is very short; it's a brute force method
;;; that isn't hard to follow.
(defun coins-proc()
(let((amount (floor (prompt-and-read :number "Enter amount: "))))
(format t "~& Quarters: ~d" (quotient amount 25))
(setq amount (mod amount 25))
(format t "~& Dimes: ~d" (quotient amount 10))
(setq amount (mod amount 10))
(format t "~& Nickels: ~d" (quotient amount 5))
(setq amount (mod amount 5))
(format t "~& Pennies: ~d" amount)))
;;; But notice that accumulating the results, e.g. to return the results
;;; to a calling program, is messier to add in.
(defun coins-proc2()
(let((amount (floor (prompt-and-read :number "Enter amount: ")))
(vals))
(format t "~& Quarters: ~d" (quotient amount 25))
(push (cons 25 (quotient amount 25)) vals)
(setq amount (mod amount 25))
(format t "~& Dimes: ~d" (quotient amount 10))
(push (cons 10 (quotient amount 25)) vals)
(setq amount (mod amount 10))
(format t "~& Nickels: ~d" (quotient amount 5))
(push (cons 5 (quotient amount 25)) vals)
(setq amount (mod amount 5))
(format t "~& Pennies: ~d" amount)
(push (cons 1 (quotient amount 25)) vals)
))
;;; Here's a lispified version that does a few nice things:
;;; 1. you can pass in the amount, so it does type error checking;
;;; 2. uses an accumulator driver (see below), so the
;;; algorithm is more centralized;
;;; 3. nicer output format;
;;; 3. returns the accumulated results.
(defun coins-lisp(&optional amount)
(declare(values got-list left-over))
(if (null amount)
(setq amount (prompt-and-read :number "How many cents? ")))
;;check it's positive
(etypecase amount ((integer 0 *)))
;;accumulate and print
(let*((got-amounts (accum amount))
(got-list (car got-amounts))
(left-over (cadr got-amounts))
(coin-list '((25 quarter "~p")
(10 dime "~p")
(5 nickel "~p")
(1 penn "~@p"))))
(format t "~%Need:~%")
(dolist (amts got-list)
(let((coin (first amts))
(num (rest amts)))
(when (and (numberp num)
(plusp num))
(let*((coin-stuff(rest(assoc coin coin-list)))
(coin-name (string-downcase (first coin-stuff)))
(coin-fmt (second coin-stuff)))
(format t "~& ~d ~1(~a~@?~)"
num coin-name coin-fmt num)))))
(unless (zerop left-over)
(format t "~% ...is ~d cents short."))
(format t "~%")
(values got-list left-over)))
(defun accum(amount)
(accum2
(accum2
(accum2
(accum2 (list nil ;accumulator
amount)
25) ;quarters
10) ;dimes
5) ;nickels
1) ;pennies
)
(defun accum2 (got-amount increment)
;;accumulator function
(let((got (first got-amount))
(amount (second got-amount)))
(if (and (numberp amount)
(> amount 0))
(multiple-value-bind (used left)
(floor amount increment)
(if (> used 0)
(list
;;GOT
(append got
(ncons (cons increment used)))
;;AMOUNT
left)
got-amount))
got-amount)))