どう書く？org ;コインを減らす払い方 を commonlispで その２

コインを減らす払い方。できたつもり。
ずいぶん書き直したなぁ。これであってんのかなぁ。
まぁいいか。

;;コインを減らす払い方 c
(defmacro make-coins(yen1 yen5 yen10 yen50 yen100 yen500)
  `'((1 ,yen1)
    (5 ,yen5)
    (10 ,yen10)
    (50 ,yen50)
    (100 ,yen100)
    (500 ,yen500)))

(defun copy-coins(coins)
  `((1 ,(get-count coins 0))
    (5 ,(get-count coins 1))
    (10 ,(get-count coins 2))
    (50 ,(get-count coins 3))
    (100 ,(get-count coins 4))
    (500 ,(get-count coins 5))))

(defmacro get-val (coins n)
  `(car (nth ,n ,coins)))

(defmacro get-count (coins n)
  `(cadr (nth ,n ,coins)))


(defun update-coins(coins n plus)
  (let ((c (copy-coins coins)))
    (setf (get-count c n) (+ (get-count c n) plus))
    c))

(defun setvalue-coins(coins n val)
  (let ((c (copy-coins coins)))
    (setf (get-count c n) val)
    c))

(defun sum(coins)
  (let ((result 0))
    (dolist (coin coins result)
      (setf result (+ result (* (car coin) (cadr coin)))))))

(defun sum2(coins n)
  (let ((result 0))
    (dotimes (var (1+ n) result)
      (setf result (+ result (* (get-val coins var) (get-count coins var)))))))

(defun convert-coins(kingaku)
  (let ((nokori kingaku))
    (reverse
     (mapcar #'(lambda (kin)
         (multiple-value-bind (su amari) (truncate nokori kin)
           (setf nokori (- nokori (* su kin)))
           (list kin su)))
         '(500 100 50 10 5 1)))))

(defun get-upkingaku(kingaku n)
  (let ((coins (convert-coins kingaku)))
    (dotimes (var (1+ n))
      (setf coins (setvalue-coins coins var 0)))
    (update-coins coins (1+ n) 1)))
    
(defun get-remainder(x y)
  (multiple-value-bind (a remainder)
      (truncate x y)
    remainder))

(defun subtract-coin(coins n count)
  (if (= n 0)
      (subtract-1yen coins count)
    (let ((result coins)
      (val (get-val coins n))
      (val-1 (get-val coins (1- n))))
      (dotimes (var count result)
    (let ((sum (sum2 result (1- n))))
      (if (< sum val)
          (setf result (update-coins result n -1))
        (setf result (subtract-coin result (1- n) (/ val val-1)))))))))

(defun subtract-1yen(coins count)
  (update-coins coins 0 (* -1 count)))

(defun get-payment(coins kingaku)
  (if (< (sum coins) kingaku)
      nil
    (progn
      (let ((c coins)
        (shiharai kingaku)
        (val-lst '(1 5 10 50 100 500 1000)))
    (dotimes (var 6 c)
      (let* ((remainder (get-remainder shiharai (nth (1+ var) val-lst)))
         (maisu (get-count c var)))
        (cond ((= remainder 0))
          ((< (* maisu (nth var val-lst)) remainder)
           (setf shiharai (sum (get-upkingaku shiharai var))))
          (t
           (progn
             (setf shiharai (- shiharai remainder))
             (setf c (subtract-coin c var (/ remainder (nth var val-lst)))))))))))))

(defun pay(coins kingaku)
  (if (< (sum coins) kingaku)
      nil
    (let ((payment (get-payment coins kingaku)))
      `((1 ,(- (get-count coins 0) (get-count payment 0)))
    (5 ,(- (get-count coins 1) (get-count payment 1)))
    (10 ,(- (get-count coins 2) (get-count payment 2)))
    (50 ,(- (get-count coins 3) (get-count payment 3)))
    (100 ,(- (get-count coins 4) (get-count payment 4)))
    (500 ,(- (get-count coins 5) (get-count payment 5)))))))