Topic: -={ Challenge }=- Give Change

[Lee Mac]

For me, of all the threads in the forum, the 'Challenge' threads are my favourite since they usually produce very interesting and imaginative code. However, I haven't seen or participated in such a thread in quite a while, so thought it was time to post one.

With a plethora of past challenges, it becomes difficult to find a topic that hasn't already been explored. This time, I pose a challenge with a possible practical application: a function to calculate the amount of each denomination of some arbitrary currency for a given amount.

Example: In the UK, for amounts less than £1, we have 50p, 20p, 10p, 5p, 2p, and 1p denominations.

So, given an amount of 67p = 50p + 10p + 5p + 2p

So, the challenge would be to write a function requiring two parameters: a numerical amount for which to calculate the change, and a list of denominations.

The function would then return a list of dotted pairs, giving the minimum number of 'coins' to make up the amount, e.g.:

Code: [Select]

_$ (_givechange 67 '(50 20 10 5 2 1))

==> ((50 . 1) (10 . 1) (5 . 1) (2 . 1))

The list of denominations could of course be arbitrary to suit any currency (as long as the list contained a unit element).

I hope others enjoy participating in the challenge as much as I have.

Enjoy!

Lee

[VovKa]

and while Evgeniy is sleeping...

Code: [Select]

(defun test (n lst / a)
    (if lst
        (if (zerop (/ n (car lst)))
            (test n (cdr lst))
            (cons (cons (car lst) (/ n (car lst)))
                  (test (rem n (car lst)) (cdr lst))
            )
        )
    )
)
(test 67 (vl-sort '(50 20 10 5 2 1) '>))ok, it's rather straightforward, will give wrong result for (test 98 (vl-sort '(50 49 20 10 1) '>)), and so on and so forth

[gile]

my 2 cents (even Vovka was faster...)

Code: [Select]

(defun givechange (amount coins / n)
  (cond
    ((or (null coins) (<= amount 0)) nil)
    ((zerop (setq n (/ amount (car coins)))) (givechange amount (cdr coins)))
    (T
     (cons (cons (car coins) n) (givechange (rem amount (car coins)) (cdr coins)))
    )
  )
)

[Lee Mac]

Very nice guys! Mine is very similar, but a little more verbose:

Code: [Select]

(defun _givechange ( amount denominations / itm num )
    (if (and denominations (< 0 amount))
        (progn
            (setq itm (apply 'max denominations)
                  num (fix (/ amount itm))
            )
            (if (< 0 num)
                (cons (cons itm num) (_givechange (rem amount itm) (vl-remove itm denominations)))
                (_givechange amount (vl-remove itm denominations))
            )
        )
    )
)

[VovKa]

who's gonna beat
this
(_givechange 98 '(50 49 20 10 1)) -> ((49 . 2))
or this
(_givechange 32 '(20 10 5 3)) -> ((20 . 1) (3 . 4))
?  :pissed:

[Lee Mac]

Maybe:

Code: [Select]

(defun _givechange ( amount denominations / itm num )
    (if (and denominations (< 0 amount))
        (cond
            (   (setq itm (vl-some '(lambda ( x ) (if (zerop (rem amount x)) x)) (vl-remove 1 denominations)))
                (list (cons itm (/ amount itm)))
            )
            (   (< 0 (setq num (fix (/ amount (setq itm (apply 'max denominations))))))
                (cons (cons itm num) (_givechange (rem amount itm) (vl-remove itm denominations)))
            )
            (   (_givechange amount (vl-remove itm denominations)))
        )
    )
)
Slow though

[VovKa]

(_givechange 15 '(10 4 3 2))  :pissed:

[Lee Mac]

A faster (iterative) version of the above:

Code: [Select]

(defun _givechange ( n l / d n r x )
    (setq l (vl-sort l '>))
    (while (and l (< 0 n))
        (if (/= 1 (setq x (vl-some (function (lambda ( d ) (if (zerop (rem n d)) d))) l)))
            (setq r (cons (cons x (/ n x)) r) l nil)
            (if (< 0 (setq d (fix (/ n (setq x (car l))))))
                (setq r (cons (cons x d) r) n (rem n x))
            )
        )
        (setq l (cdr l))
    )
    (reverse r)
)
But still not correct such examples as:

Code: [Select]

(_givechange 50 '(20 10 5 2 1))
More thinking (+ coffee) required.

[Lee Mac]

After some studying...

The following code uses a 'bottom-up' approach, using the algorithm described here and here, modified to make it iterative instead of recursive.

The initial maximum should be infinity, but I've chosen 32767 for practical purposes.

Code: [Select]

(defun _givechange ( n l / _assoc++ a b c d e f g h )

    (defun _assoc++ ( a b / c )
        (if (setq c (assoc a b))
            (subst (cons a (1+ (cdr c))) c b)
            (cons  (cons a 1) b)
        )
    )
 
    (setq a '(0) b '(0) c 0)
    (while (<= (setq c (1+ c)) n) (setq d 32767)
        (foreach e l
            (if (and (<= e c) (< (setq f (1+ (nth (1- e) a))) d))
                (setq d f g e)
            )
        )
        (setq a (cons d a) b (cons g b))
    )
    (setq c 0)
    (while (< c n)
        (setq h (_assoc++ (setq e (nth c b)) h) c (+ c e))
    )
    (reverse h)
)

Code: [Select]

_$ (_givechange 67 '(50 20 10 5 2 1))
((50 . 1) (10 . 1) (5 . 1) (2 . 1))
_$ (_givechange 98 '(50 49 20 10 1))
((49 . 2))
_$ (_givechange 32 '(20 10 5 3))
((20 . 1) (3 . 4))
_$ (_givechange 15 '(10 4 3 2))
((10 . 1) (3 . 1) (2 . 1))
Since its now 2:30am here, time for bed me thinks 

[ElpanovEvgeniy]

and while Evgeniy is sleeping...
...

Using a simple path (greedy algorithm).

Code: [Select]

(defun test (n l)
  (mapcar '(lambda (a / b)
             (setq b n
                   n (rem n a)
             )
             (cons a (/ b a))
           )
          (vl-sort l '>)
  )
)

[VovKa]

Since its now 2:30am here, time for bed me thinks 

evening is not the best time for challenging

[Lee Mac]

Using a simple path (greedy algorithm).

Very succinct Evgeniy 

Although the greedy algorithm does not always yield optimal results 

[Lee Mac]

On a related theme, the following function will return the minimum number of coins required to make an amount (but not the values of the coins used):

Code: [Select]

(defun _coins ( n l )
  (cond
    ( (< n 0) 32767)
    ( (zerop n) 0)
    ( (null l) n)
    ( (min (_coins n (cdr l)) (1+ (_coins (- n (car l)) l))))
  )
)
By its recursive nature it is extremely inefficient, since many calculations are performed repeatedly (much like a recursive Fibonnacci number generator). It is far better to use a list to store the minimum number of coins for lower amounts, then compound this list iteratively.

[ElpanovEvgeniy]

Using a simple path (greedy algorithm).

Very succinct Evgeniy 

Although the greedy algorithm does not always yield optimal results 

recursive metod:

Code: [Select]

(defun change (n l)
 (cond ((< n (car l)) (change n (cdr l)))
       ((<= n 0) nil)
       ((null l) (list (cons n 32767)))
       ((= 0 (rem n (car l))) (list (cons (car l) (/ n (car l)))))
       ((f2 (change n (cdr l)) (f1 (car l) (change (- n (car l)) l))))
 )
)
(defun f1 (a b)
 (cond ((= (caar b) a) (cons (cons a (1+ (cdar b))) (cdr b)))
       ((cons (cons a 1) b))
 )
)
(defun f2 (a b)
 (if (and a b)
  (if (< 0 (apply (function +) (mapcar (function cdr) a)) (apply (function +) (mapcar (function cdr) b)))
   a
   b
  )
  (if a a b)
 )
)test:

Code: [Select]

_$ (change 67 '(50 20 10 5 2 1))
((50 . 1) (10 . 1) (5 . 1) (2 . 1))
_$ (change 98 '(50 49 20 10 1))
((49 . 2))
_$ (change 32 '(20 10 5 3))
((20 . 1) (3 . 4))
_$ (change 15 '(10 4 3 2))
((10 . 1) (3 . 1) (2 . 1))

[ElpanovEvgeniy]

On a related theme, the following function will return the minimum number of coins required to make an amount (but not the values of the coins used):

Code: [Select]

(defun _coins ( n l )
  (cond
    ( (< n 0) 32767)
    ( (zerop n) 0)
    ( (null l) n)
    ( (min (_coins n (cdr l)) (1+ (_coins (- n (car l)) l))))
  )
)
By its recursive nature it is extremely inefficient, since many calculations are performed repeatedly (much like a recursive Fibonnacci number generator). It is far better to use a list to store the minimum number of coins for lower amounts, then compound this list iteratively.

test:

Code: [Select]

(_givechange 32 '(20 10 5 3)) ;>> ((20 . 1) (3 . 4))
(change 32 '(20 10 5 3))      ;>> ((20 . 1) (3 . 4))
but
(_coins 32 '(20 10 5 3))      ;>> 4