Programeer opdrachtenOpdracht : opdr1_dirk.txt

Terug naar de inzendingen
Opdracht 1, Dirk Gerrits
14 Jan 2005
 1 
*****candy-machine.lisp*****
  
 2;;;; Copyright (c) 2005, Dirk H.P. Gerrits 
 3;;;;
 4;;;; Permission is hereby granted, free of charge, to any person obtaining a
 5;;;; copy of this software and associated documentation files (the "Software"),
 6;;;; to deal in the Software without restriction, including without limitation
 7;;;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
 8;;;; and/or sell copies of the Software, and to permit persons to whom the
 9;;;; Software is furnished to do so, subject to the following conditions:
 10;;;;
 11;;;; The above copyright notice and this permission notice shall be included in
 12;;;; all copies or substantial portions of the Software.
 13;;;;
 14;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 15;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 16;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 17;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 18;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 19;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 20;;;; DEALINGS IN THE SOFTWARE.
 21;;;;
 22;;;; Summary
 23;;;;----------------------------------------------------------------------------
 24;;;; This is a simulation (written in Common Lisp) of a simple candy machine as
 25;;;; described in Pascal Schiks's programming assignment 1.
 26;;;;
 27;;;; Notes
 28;;;;----------------------------------------------------------------------------
 29;;;; * Due to other responsibilities I had little time to think and program on
 30;;;;   this assignment.  The result is an algorithm whose effectiveness has not
 31;;;;   been very well tested.
 32;;;;
 33;;;; * The documentation strings may at times seem excessive, but keep
 34;;;;   in mind that the documentation strings are available when the
 35;;;;   program is running, even if the source code isn't,
 36;;;;
 37;;;; * For those who don't read Common Lisp or recursive algorithms very well,
 38;;;;   here's a description of the (simplistic) algorithm used to give change:
 39;;;;   - All possible ways of dividing the amount of change into coins are
 40;;;;     computed with a recursive function.
 41;;;;   - Each way is given a score based on the number of coins
 42;;;;     involved (less is better), and the probability that there are
 43;;;;     enough coins in the machine to return change this way (more
 44;;;;     is better).
 45;;;;   - The way of making change with the best score is selected and those
 46;;;;     coins are returned from the machine.  Since the machine doesn't know
 47;;;;     whether a tube of coins is empty, it is possible that the machine tries
 48;;;;     (and fails) to return certain coins, so that the consumer only gets
 49;;;;     part of his change or none at all.  However, the scoring mechanism
 50;;;;     tries to postpone this as long as it can.
 51;;;;
 52;;;; Usage:
 53;;;;----------------------------------------------------------------------------
 54;;;; Just load this file into your favorite Comman Lisp implementation.  With
 55;;;; CLISP (http://clisp.cons.org/) this can be done from the command-line as
 56;;;; follows:
 57;;;;
 58;;;; $ clisp candy-machine.lisp
 59;;;;
 60;;;; When the file is loaded, you're presented with a menu to control
 61;;;; the simulation.  Menu choices are made by entering the
 62;;;; corresponding number with the keyboard and pressing ENTER.
 63;;;;
 64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 65
 66(defparameter *candy-prices*
 67  '(("rolletje drop" . 75)
 68    ("zakje katjesdrop" . 125)
 69    ("zakje engelse drop" . 150)
 70    ("rolletje pepermunt" . 75)
 71    ("reep chocolade" . 100))
 72  "Association list of names and prices (in eurocents) of candy.")
 73
 74(defparameter *candy-refill-amount* 10
 75  "Number of pieces of each kind of candy after a refill.")
 76
 77(defparameter *coin-values* '(5 10 20 50 100 200)
 78  "Values of the accepted coins (in eurocents).")
 79
 80(defparameter *coin-refill-amount* 15
 81  "Minimum number of coins of each kind after a refill.")
 82
 83;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 84
 85(defstruct (coin-tube (:conc-name nil)
 86                      (:constructor make-coin-tube (coin-value)))
 87  "A tube of coins inside a candy dispenser machine."
 88  (num-coins *coin-refill-amount*)
 89  (coin-value))
 90
 91(defun <5-coins? (coin-tube)
 92  "Return whether COIN-TUBE holds less than 5 coins."
 93  (< (num-coins coin-tube) 5))
 94
 95(defun >10-coins? (coin-tube)
 96  "Return whether COIN-TUBE holds more than 10 coins."
 97  (> (num-coins coin-tube) 10))
 98
 99;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100
 101(defstruct (candy-holder (:conc-name nil)
 102                         (:constructor make-candy-holder (candy)))
 103  "A holder for pieces of candy of one kind."
 104  (num-pieces *candy-refill-amount*)
 105  (candy))
 106
 107(defun piece-available? (candy-holder)
 108  "Return whether at least 1 piece of candy is available from CANDY-HOLDER."
 109  (>= (num-pieces candy-holder) 1))
 110
 111;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 112
 113(defstruct (candy-machine (:conc-name nil)
 114                          (:constructor make-candy-machine ()))
 115  "A candy dispenser machine accepting coins."
 116  (candy-holders (mapcar #'(lambda (candy+price)
 117                             (make-candy-holder (car candy+price)))
 118                         *candy-prices*))
 119  (coin-tubes (mapcar #'(lambda (coin-value)
 120                          (make-coin-tube coin-value))
 121                      *coin-values*))
 122  (inserted-money 0))
 123
 124(defun candy-holder (candy-machine candy)
 125  "Return the candy holder of CANDY-MACHINE holding a particular kind of CANDY."
 126  (find candy (candy-holders candy-machine) :key #'candy :test #'equal))
 127  
 128(defun coin-tube (candy-machine coin-value)
 129  "Return the coin tube of CANDY-MACHINE holding coins of COIN-VALUE."
 130  (find coin-value (coin-tubes candy-machine) :key #'coin-value))
 131
 132(defun refill-machine! (candy-machine)
 133  "Refill the CANDY-MACHINE with candy and coins as needed."
 134  (dolist (candy-holder (candy-holders candy-machine))
 135    (setf (num-pieces candy-holder)
 136          (max (num-pieces candy-holder) *candy-refill-amount*)))
 137  (dolist (coin-tube (coin-tubes candy-machine))
 138    (setf (num-coins coin-tube)
 139          (max (num-coins coin-tube) *coin-refill-amount*)))
 140  candy-machine)
 141
 142(defun insert-coin! (candy-machine coin-value)
 143  "Insert a COIN-VALUE eurocent coin into CANDY-MACHINE."
 144  (incf (num-coins (coin-tube candy-machine coin-value)))
 145  (incf (inserted-money candy-machine) coin-value))
 146
 147(defun return-coins! (candy-machine coin-value num-coins)
 148  "Try to return NUM-COINS COIN-VALUE eurocent coins as change from CANDY-MACHINE.
 149The function returns how many coins were actually returned.  Since the machine
 150itself doesn't know this, the inserted money might be decreased more than
 151the total value of the returned coins!)"
 152  (let ((coins-returned (min (num-coins (coin-tube candy-machine coin-value))
 153                             num-coins)))
 154    (decf (num-coins (coin-tube candy-machine coin-value)) coins-returned)
 155    (decf (inserted-money candy-machine) coin-value)
 156    coins-returned))
 157
 158(defun buy-candy! (candy-machine candy)
 159  "Buy 1 piece of CANDY from CANDY-MACHINE.  Return CANDY when successful, NIL otherwise."
 160  (let ((price (cdr (assoc candy *candy-prices* :test #'equalp))))
 161    (when (and (>= (inserted-money candy-machine) price)
 162               (piece-available? (candy-holder candy-machine candy)))
 163      (decf (inserted-money candy-machine) price)
 164      (decf (num-pieces (candy-holder candy-machine candy)))
 165      candy)))
 166
 167;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 168
 169(defun all-ways-of-making-change (amount)
 170  "Return all the ways that coins from *COIN-VALUES* sum to AMOUNT eurocents."
 171  (labels ((add-coins (coin-value num-coins change)
 172             (if (> num-coins 0)
 173                 (acons coin-value num-coins change)
 174                 change))
 175           (recurse (amount coin-values)
 176             (let ((coin-value (car coin-values)))             
 177               (cond ((= amount 0)
 178                      (list ()))
 179                     ((null coin-values)
 180                      '())
 181                     (t
 182                      (loop for num-coins from 0 upto (floor amount coin-value)
 183                            for total-value = (* num-coins coin-value)
 184                            nconc (mapcar #'(lambda (change)
 185                                              (add-coins coin-value num-coins
 186                                                         change))
 187                                          (recurse (- amount total-value)
 188                                                   (cdr coin-values)))))))))
 189    (recurse amount *coin-values*)))
 190
 191(defun best-way-of-making-change (amount candy-machine)
 192  "Return the 'best' way for CANDY-MACHINE to make change for AMOUNT eurocents."
 193  (let (best-change best-score)
 194    (loop for change in (all-ways-of-making-change amount)
 195          for score = (score change candy-machine)
 196          if (or (null best-score) (> score best-score))
 197          do (setq best-change change
 198                   best-score  score))
 199    best-change))
 200
 201(defun score (change candy-machine)
 202  "Return how well CHANGE scores according to CANDY-MACHINE's coin tubes.
 203\(Larger is better.)"
 204  (let ((success-probability
 205         (reduce #'* change :key
 206                 #'(lambda (coin-value+num-coins)
 207                     (let* ((coin-value (car coin-value+num-coins))
 208                            (num-coins (cdr coin-value+num-coins))
 209                            (coin-tube (coin-tube candy-machine coin-value)))
 210                       (enough-coins-probability num-coins
 211                                                 (coin-range coin-tube))))))
 212        (total-num-coins (reduce #'+ change :key #'cdr)))
 213    (- (* 10 success-probability)
 214       total-num-coins)))
 215
 216(defun coin-range (coin-tube)
 217  "Return the minimum and maximum number of coins in COIN-TUBE, based on its <5 and >10 sensors.
 218\(When the sensors indicate there are more than 10 coins, the maximum is taken to be 15,
 219  which might not be correct.)"
 220  (cond ((<5-coins? coin-tube) (cons 0 4))
 221        ((>10-coins? coin-tube) (cons 11 15))
 222        (t (cons 5 10))))
 223
 224(defun enough-coins-probability (num-coins coin-range)
 225  "Return the probability that a number in COIN-RANGE is at least NUM-COINS."
 226  (let* ((lower-bound (car coin-range))
 227         (upper-bound (cdr coin-range))
 228         (num-in-range (- upper-bound lower-bound -1))
 229         (num-above (max (- upper-bound num-coins -1) 0)))
 230    (min (/ num-above num-in-range) 1)))
 231
 232(defun return-change! (candy-machine)
 233  "Return inserted money as change from CANDY-MACHINE."
 234  (mapcar #'(lambda (coin-value+num-coins)
 235              (let ((coin-value (car coin-value+num-coins))
 236                    (num-coins (cdr coin-value+num-coins)))
 237                (cons coin-value
 238                      (return-coins! candy-machine
 239                                     coin-value
 240                                     num-coins))))
 241          (best-way-of-making-change (inserted-money candy-machine)
 242                                     candy-machine)))
 243
 244;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 245
 246(defstruct (menu-item (:constructor menu-item (choice-number text callback))
 247                      (:conc-name nil))
 248  choice-number text callback)
 249
 250(defun do-menu (header footer menu-items)
 251  "Allow the user to choose from MENU-ITEMS through a menu with a CAPTION."
 252  (flet ((choice->callback (choice)
 253           (let ((menu-item (find choice menu-items :key #'choice-number)))
 254             (and menu-item (callback menu-item))))
 255         (print-menu ()
 256           (when header
 257             (format t "~&=[ ~A ]~A~%" header
 258                     (let ((padding (max 0 (- 30 (length header)))))
 259                       (make-string padding :initial-element #\=))))
 260           (loop for menu-item in menu-items
 261                 do (format t "~&~A - ~A~%" (choice-number menu-item)
 262                            (text menu-item)))
 263           (when footer
 264             (format t "~&~A~%" footer))))
 265    (print-menu)
 266    (loop for choice = (progn (format t "~&> ")
 267                              (parse-integer (read-line) :junk-allowed t))
 268          for callback = (choice->callback choice)
 269          while (null callback)
 270          finally (funcall callback))))
 271
 272(defun do-main-menu (candy-machine)
 273  "Menu to control CANDY-MACHINE."
 274  (do-menu "Candy machine" nil
 275    (list (menu-item 1 "Insert money" #'(lambda ()
 276                                          (do-coin-menu candy-machine)
 277                                          (do-main-menu candy-machine)))
 278          (menu-item 2 "Select product" #'(lambda ()
 279                                            (do-candy-menu candy-machine)
 280                                            (do-main-menu candy-machine)))
 281          (menu-item 3 "Refill machine" #'(lambda ()
 282                                            (refill-machine! candy-machine)
 283                                            (do-main-menu candy-machine)))
 284          (menu-item 0 "Quit" #'(lambda () t)))))
 285
 286(defun do-candy-menu (candy-machine)
 287  "Menu to buy candy from CANDY-MACHINE." 
 288  (do-menu "Select product"
 289           (format nil "~%Inserted: EUR ~,2F" (/ (inserted-money candy-machine) 100))
 290    (append
 291     (loop for i upfrom 1
 292           for (candy . price) in *candy-prices*
 293           when (piece-available? (candy-holder candy-machine candy))
 294           collect (menu-item i (format nil "~@(~A~) - ~,2F" candy (/ price 100))
 295                              (let ((candy candy))
 296                                #'(lambda ()
 297                                    (let ((bought-candy
 298                                           (buy-candy! candy-machine candy)))
 299                                      (format t "~&~:[You have not inserted enough ~
 300                                                      money for a ~;Here's your ~]~
 301                                                 ~A~2%" bought-candy candy)
 302                                      (do-candy-menu candy-machine))))))
 303     (list (menu-item 0 "Return change and go back"
 304                      #'(lambda ()
 305                          (format t "~&Here's your change: ")
 306                          (print-change (return-change! candy-machine))
 307                          (format t "~2%")))))))
 308
 309(defun do-coin-menu (candy-machine)
 310  "Menu to insert coins into a CANDY-MACHINE."
 311  (do-menu "Insert money"
 312           (format nil "~%Inserted: EUR ~,2F" (/ (inserted-money candy-machine) 100))
 313    (append (loop for i upfrom 1
 314                  for coin-value in *coin-values*
 315                  collect (menu-item i (format nil "~,2F" (/ coin-value 100))
 316                                     (let ((coin-value coin-value))
 317                                       #'(lambda ()
 318                                           (insert-coin! candy-machine coin-value)
 319                                           (do-coin-menu candy-machine)))))
 320            (list (menu-item 0 "Go back" #'(lambda () t))))))
 321
 322(defun print-change (change &optional (stream *standard-output*))
 323  "Print a textual representation of CHANGE to STREAM."
 324  (let ((change (sort (copy-list change) #'> :key #'car)))
 325    (if (null change)
 326        (format stream "EUR 0.00")
 327        (loop for ((coin-value . num-coins) . more?) on change
 328              sum (* num-coins coin-value) into total-change
 329              do (format stream "~Ax~,2F~@?" num-coins (/ coin-value 100)
 330                         (if more? " + " " = EUR ~,2F") (/ total-change 100))))))
 331
 332;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333
 334(do-main-menu (make-candy-machine))
 
 
Mijn commentaar
 
 Erg interesant Dirk !
 Dat lisp ziet er inderdaad wel leuk uit.
 Net als mijn PERL versie is het een kort en efficient programma.
 Het lijkt erop dat je munt betaal algoritme erg op mijn oplossing lijkt
 met dat verschil dat je de functie zichzelf laat aanroepen (recursief zoals je al aangeeft).
 Vraag me af of dat op een embedded systeem niet tot geheugenproblemen lijdt.
 Wat lisp betreft, het lijkt me dat het vooral de syntax is die lisp zo geheimzinnig maakt.
 stel me zo voor dat c -> list zoiets is als basic -> c
 Erg leuk dat je mee hebt gedaan !