#lang racket

;;; stamps.rkt
;;;   Samuel A. Rebelsky
;;;   rebelsky@grinnell.edu
;;;
;;; A quick and dirty implementation of the "minimum stamps" problem.  
;;;
;;;  Copyright (c) 2015 Samuel A. Rebelsky.  All rights reserved.
;;;
;;;  stamps.rkt is free software: you can redistribute it and/or modify
;;;  it under the terms of the GNU General Public License as published by
;;;  the Free Software Foundation, either version 3 of the License, or
;;;  (at your option) any later version.
;;;
;;;  stamps.rkt is distributed in the hope that it will be useful,
;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;  GNU General Public License for more details.
;;;
;;;  You should have received a copy of the GNU General Public License
;;;  along with stamps.rkt.  If not, see <http://www.gnu.org/licenses/>.

; +-------+---------------------------------------------------------
; | Notes |
; +-------+

; The primary procedure is `(minimum-stamps value stamps)`, where
; `value` is a positive integer and `stamps` is a vector of 
; positive integers.

; The global variable VERBOSE is used to indicate whether we explain
; what we are doing.

; +---------+-------------------------------------------------------
; | Globals |
; +---------+

;;; Identifier:
;;;   VERBOSE
;;; Type:
;;;   Boolean
;;; Meaning:
;;;   Should we be verbose in describing how the algorithm works?

(define VERBOSE true)

; +---------+-------------------------------------------------------
; | Helpers |
; +---------+

;;; Procedure:
;;;   log
;;; Parameters:
;;;   value_1, a Scheme value
;;;   ...
;;;   value_n, a Scheme value
;;; Purpose:
;;;   Print the values.
;;; Produces:
;;;   [Nothing; called for the side effect]
(define log
  (lambda values
    (when VERBOSE
      (for-each (lambda (x) (display x) (display " ")) values)
      (newline))))

; +-------------------+---------------------------------------------
; | Primary Procedure |
; +-------------------+

;;; Procedure:
;;;   minimum-stamps
;;; Parameters:
;;;   value, an integer
;;;   stamps, a nonempty list of positive integers
;;; Purpose:
;;;   Find the smallest set of stamps that achieve value
;;; Produces:
;;;   set-of-stamps, a list of stamp values
;;; Process:
;;;   Uses the traditional dynamic programming approach.  Each entry
;;;   in the table will be a pair whose car is the size of the set and
;;;   whose cdr is the list of stamp values.
(define minimum-stamps
  (lambda (value stamps)
    (let ([table (make-vector (+ value 1) #f)])
      (vector-set! table 0 (cons 0 null))
      (let loop ([pos 1])
        (when (<= pos value)
          (log)
          (log "Finding the optimal value for" pos)
          (let kernel ([guess #f]
                       [lst stamps])
            (cond
              [(null? lst)
               (log "The optimal value for" pos "is" guess)
               (vector-set! table pos guess)
               (loop (+ pos 1))]
              [else
               (let* ([val (car lst)]
                      [remainder (- pos val)])
                 (log "Trying a stamp with value" val 
                      " giving us a remainder of" remainder)
                 (cond
                   [(negative? remainder)
                    (log "  Negative remainder.  Not a useful value.")
                    (kernel guess (cdr lst))]
                   [(not (vector-ref table remainder))
                    (log "  There is no way to make" remainder)
                    (kernel guess (cdr lst))]
                   [else
                    (let ([alternate (vector-ref table remainder)])
                      (log "  Best option for" remainder "is" (cdr alternate) 
                           "which is" (car alternate) "stamps")
                      (cond
                        [(or (not guess) (< (car alternate) (car guess)))
                         (let ([newguess (cons (+ 1 (car alternate))
                                               (cons val (cdr alternate)))])
                           (log "  Updating best guess to" (cdr newguess)
                                "which is" (car newguess) "stamps")
                           (kernel newguess (cdr lst)))]
                        [else
                         (log "  Retaining prior guess")
                         (kernel guess (cdr lst))]))]))]))))
        (let ([answer (vector-ref table value)])
           (if answer
               (cdr answer)
               (error "It is not possible to make a value of" value))))))