;;;
;;; Solves the coin change problem[0], taking into account a given finite limit
;;; of coins of each denomination, using a "dumb" greedy algorithm. This
;;; doesn't necessarily result in the minimum number of coins for non-canonical
;;; sets of denominations, but is in practice not far from it, and is simple to
;;; implement. Uses a couple of simple checks to fail early in certain
;;; scenarios, and a memoization table, from target to denomination to solution
;;; (this works because of the greedy nature). The recursive level will be at
;;; most the number of denominations.
;;;
;;; Mathematically speaking, given target T, denominations di, and counts ci,
;;; it computes the coefficients si of the following linear equation, such that
;;; 0 <= si <= ci:
;;;   T = (sum (* si di))
;;;
;;; This is NOT the solutions counting algorithm!
;;;
;;; [0]: https://en.wikipedia.org/wiki/Change-making_problem
;;;

(import
  (only (chicken base)
        alist-ref
        alist-update
        define-constant
        foldl
        gensym
        include
        receive
        sub1
        )
  (only (chicken sort) sort)
  (chicken type)
  )

(define-constant missing 'missing)
(define (missing? obj) (eq? obj missing))

; TODO: better performant impl
(define (alist-update-with key alist update #!optional (=? eq?))
  (let* ((value (alist-ref key alist =? missing))
         (value (if (missing? value) (update) (update value))))
    (alist-update key value alist =?)))

; Memoization table (solution may be #f):
; `((,target . ((,denomination . ,solution)
;               ...))
;   (,target . ((,denomination . ,solution)
;               ...))
;   ...)
(define (memo:get memo target denomination)
  (alist-ref denomination (alist-ref target memo = '()) = missing))

(define (memo:set memo target denomination solution)
  (values
    solution
    (alist-update-with target memo
                       (lambda (#!optional (denoms-alist '()))
                         (alist-update denomination solution denoms-alist =))
                       =)))

; `(,denom ,count . ,csum)
(define get-denom car)
(define get-count cadr)
(define get-csum cddr)

(define (max-denomination-multiplicity/unlimited denomination target)
  (inexact->exact (floor (/ target denomination))))
(define (max-denomination-multiplicity denomination count target)
  (min count (max-denomination-multiplicity/unlimited denomination target)))

; Sorts the input denominations list in ascending order, and includes a
; cumulative sum of the value at each "level".
;
;   (prepare-denominations '((3 . 3) (2 . 2) (5 . 5)))
;   => '((5 5 . 38)
;        (3 3 . 13)
;        (2 2 . 4))
(define (prepare-denominations denominations)
  (define (denom/count<? d/c1 d/c2) (< (get-denom d/c1) (get-denom d/c2)))
  (define (kons sum.denominations denomination)
    (let ((sum (car sum.denominations))
          (denominations (cdr sum.denominations))
          (denom (get-denom denomination))
          (count (cdr denomination)))
      (let ((sum (+ sum (* count denom))))
        (cons sum
              `((,denom ,count . ,sum) . ,denominations)))))
  (let* ((denominations (sort denominations denom/count<?))
         (sum.denominations (foldl kons '(0 . ()) denominations)))
    (cdr sum.denominations)))

; target :: Int
; denominations :: [(Denomination . Count)]
;
;   (coin-change 765 '((50 . 123) (10 . 456) (5 . 789)))
;   => (values ((50 . 15) (10 . 1) (5 . 1))
;              ((5 (5)) (15 (10) (5 . 1)) (765 (50) (10 . 1) (5 . 1))))
(: coin-change (integer (list-of (pair integer integer)) --> (or false (list-of (pair integer integer))) list))
(define (coin-change target denominations)
  ; Internal entry-point
  (define (coin-change* memo target denominations)
    (cond
      ((zero? target)
       (values '() memo))
      ; There is no solution if there are no more coins; or if the
      ; target is greater than the cumulative sum of the available
      ; coins.
      ((or (null? denominations)
           (> target (get-csum (car denominations))))
       (values #f memo))
      (else
        (let ((denomination (car denominations))
              (denominations (cdr denominations)))
          (let ((denom (get-denom denomination))
                (count (get-count denomination)))
            (let ((solution (memo:get memo target denom)))
              (if (missing? solution)
                  (receive (solution memo) (coin-change/multiplicity memo denom count denominations target
                                                                     (max-denomination-multiplicity denom count target))
                    (memo:set memo target denom solution))
                  (values solution memo))))))))

  ; Tests all multiplicities of a given denomination, from greatest to least
  (define (coin-change/multiplicity memo denom count denominations target nd)
    (if (negative? nd)
        (values #f memo) ; No solution found for all possible multiplicities of this denomination
        (receive (solution memo) (coin-change* memo (- target (* nd denom)) denominations)
          (if solution ; Return the first solution found with this multiplicity
              (values `((,denom . ,nd) . ,solution) memo)
              ; Try a lower multiplicity of this denomination
              (coin-change/multiplicity memo denom count denominations target (sub1 nd))))))

  (coin-change* '() target (prepare-denominations denominations)))

; target :: Int
; denominations :: [Denomination]
(: coin-change/unlimited (integer (list-of integer) --> (or false (list-of (pair integer integer))) list))
(define (coin-change/unlimited target denominations)
  (define (f denom)
    `(,denom . ,(max-denomination-multiplicity/unlimited denom target)))
  (coin-change target (map f denominations)))