Re: Размен 1 доллара
От: Pirsig  
Дата: 18.09.08 14:28
Оценка:
Вроде бы итеративный, т.е. рекурсия хвостовая. Без продолжений. Состояние процесса в каждый момент описывается одинаковым числом переменных. Другое дело, что эти переменные списки, а один из списков, к тому же растет (но не сильно).

Код объемный, но по сравнению с рекурсивным вариантов жутко быстрый — 50 000 разменивает за 14 сек.
Написан на Common Lisp.

(defun cc-5 (amount coins)
  (labels ((make-tagged-amount (kinds amount)
         (cons kinds amount))
       
       (get-kinds (tagged-amount)
         (car tagged-amount))
       
       (get-amount (tagged-amount)
         (cdr tagged-amount))

       (merge-tagged-amount-lists (a b result)
         (if (and a b)
         (let ((amount-a (get-amount (car a)))
               (amount-b (get-amount (car b))))
           (cond ((< amount-a amount-b) (merge-tagged-amount-lists (cdr a) b (cons (car a) result)))
             ((> amount-a amount-b) (merge-tagged-amount-lists a (cdr b) (cons (car b) result)))
             ((= amount-a amount-b)
              (merge-tagged-amount-lists (cdr a)
                             (cdr b)
                             (cons (make-tagged-amount (+ (get-kinds (car a))
                                          (get-kinds (car b)))
                                           amount-a)
                               result)))))
         (if (or a b)
             (append (nreverse result) (or a b))
             (nreverse result))))
         
       (get-tagged-amount-list (kinds amount coin result)
         (cond ((> amount 0) (get-tagged-amount-list kinds
                             (- amount coin)
                             coin
                             (cons (make-tagged-amount kinds amount)
                                   result)))
           ((= amount 0) (cons (make-tagged-amount kinds amount)
                       result))
           (t result)))

       (sum (tagged-amount-list coin cur-sum result)        
         (if tagged-amount-list
         (let ((tagged-amount (car tagged-amount-list)))
           (cond ((= (get-amount tagged-amount) cur-sum) (sum tagged-amount-list
                                      coin
                                      (+ cur-sum coin)
                                      (+ result (get-kinds tagged-amount))))
             ((< (get-amount tagged-amount) cur-sum) (sum (cdr tagged-amount-list)
                                      coin
                                      cur-sum
                                      result))
             ((> (get-amount tagged-amount) cur-sum) (sum tagged-amount-list
                                      coin
                                      (+ cur-sum coin)
                                      result))))
         result))
            
       (process-coin (tagged-amount-list coins)
         (if (cdr coins)
         (process-coin (reduce #'(lambda (a b)
                       (merge-tagged-amount-lists a
                                      (get-tagged-amount-list (get-kinds b)
                                                  (get-amount b)
                                                  (car coins)
                                                  nil)
                                      nil))
                       (cdr tagged-amount-list)
                       :initial-value (get-tagged-amount-list (get-kinds (car tagged-amount-list))
                                          (get-amount (car tagged-amount-list))
                                          (car coins)
                                          nil))
                   (cdr coins))
         (sum tagged-amount-list (car coins) 0 0))))
    (if coins
    (process-coin (list (make-tagged-amount 1 amount)) coins)
    0)))

;; CL-USER> (time (cc-5 50000 '(50 25 10 5 1)))
;; Evaluation took:
;;   14.433 seconds of real time
;;   14.068879 seconds of user run time
;;   0.396025 seconds of system run time
;;   [Run times include 2.192 seconds GC run time.]
;;   0 calls to %EVAL
;;   0 page faults and
;;   2,790,509,272 bytes consed.
;; 4182519842501



В SICP на момент, в который была дана эта задача, списки еще рассматривались.
Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.