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

[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.

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

I shall spend some time studying your other code shortly, but many thanks for spotting the mistake with the above code 

I think this should fix it:

Code: [Select]

(defun _coins ( n l )
  (cond
    ( (< n 0) 32767)
    ( (zerop n) 0)
    ( (null l) 32767)
    ( (min (_coins n (cdr l)) (1+ (_coins (- n (car l)) l))))
  )
)
The 32767 values should be infinity, but 32767 should suffice for these examples.

Code: [Select]

_$ (_coins 32 '(20 10 5 3))
5

[ElpanovEvgeniy]

New version - smaller code size, speed above...

Code: [Select]

(defun change_v2 (n l / i)
 (cond ((or (not l) (< n 0)) '(32767 nil))
       ((< n (car l)) (change_v2 n (cdr l)))
       ((zerop (rem n (car l))) (list (setq i (/ n (car l))) (cons (car l) i)))
       ((f2 (change_v2 n (cdr l)) (f1 (car l) (change_v2 (- n (car l)) l))))
 )
)
(defun f1 (a b)
 (cond ((= (caadr b) a) (cons (1+ (car b)) (cons (cons a (1+ (cdadr b))) (cddr b))))
       ((cons (1+ (car b)) (cons (cons a 1) (cdr b))))
 )
)
(defun f2 (a b) (if (< (car a) (car b)) a b))

[Lee Mac]

I shall have to take some time to study this one too!

At first glance I think this;

Code: [Select]

((< n (car l)) (ff n (cdr l)))

Should be;

Code: [Select]

((< n (car l)) (change_v2 n (cdr l)))

[ElpanovEvgeniy]

Yes it is!
My apologies, the code in the message corrected.
I wanted to make the code more readable - for yourself using the short name of the function ...

[ElpanovEvgeniy]

Next version - another optimization...

Code: [Select]

(defun change_v3 (n l / i)
 (cond ((or (not l) (< n 0)) '(32767 nil))
       ((< n (car l)) (change_v3 n (cdr l)))
       ((zerop (rem n (car l))) (list (setq i (/ n (car l))) (cons (car l) i)))
       ((f2 (change_v3 n (cdr l)) (change_v3 (- n (car l)) l) (car l)))
 )
)
(defun f2 (a b c)
 (if (< (car a) (1+ (car b)))
  a
  (cond ((= (caadr b) c) (cons (1+ (car b)) (cons (cons c (1+ (cdadr b))) (cddr b))))
        ((cons (1+ (car b)) (cons (cons c 1) (cdr b))))
  )
 )
)

[Lee Mac]

Having examined your first version, I'm impressed     It takes the same form as the function I posted to calculate the minimum number of coins, but also returning what those coins are along the way. I like how you have used the functionality of the "assoc++" function in your "f1" function, and use "f2" in place of the "min" call.

Now to look at the later versions....!

[ElpanovEvgeniy]

Next version - another optimization...

Code: [Select]

(defun change_v4 (n l / i)
 (cond ((or (not l) (< n 0)) '(32767 nil))
       ((< n (car l)) (change_v4 n (cdr l)))
       ((zerop (rem n (car l))) (list (setq i (/ n (car l))) (cons (car l) i)))
       ((f3 (change_v4 n (cdr l)) (change_v4 (- n (car l)) l) (car l)))
 )
)
(defun f3 (a b c)
 (cond ((< (car a) (1+ (car b))) a)
       ((= (caadr b) c) (cons (1+ (car b)) (cons (cons c (1+ (cdadr b))) (cddr b))))
       ((cons (1+ (car b)) (cons (cons c 1) (cdr b))))
 )
)

[Lee Mac]

Fantastic idea Evgeniy! 

[ElpanovEvgeniy]

Having examined your first version, I'm impressed     It takes the same form as the function I posted to calculate the minimum number of coins, but also returning what those coins are along the way. I like how you have used the functionality of the "assoc++" function in your "f1" function, and use "f2" in place of the "min" call.

Now to look at the later versions....!

Yes, I was inspired by the program that you wrote!

[ElpanovEvgeniy]

Fantastic idea Evgeniy! 

yes, but a recursive function is slow

Code: [Select]

(BenchMark '((_givechange 67 '(50 20 10 5 2 1)) (change_v4 67 '(50 20 10 5 2 1))))

Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):

    (_GIVECHANGE 67 (QUOTE (50 20 10 5 2...)......1840 / 7.05 <fastest>
    (CHANGE_V4 67 (QUOTE (50 20 10 5 2 1)))......12964 / 1 <slowest>                           

Code: [Select]

(BenchMark '((_givechange 98 '(50 49 20 10 1)) (change_v4 98 '(50 49 20 10 1))))

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

    (CHANGE_V4 98 (QUOTE (50 49 20 10 1)))........1966 / 9.39 <fastest>
    (_GIVECHANGE 98 (QUOTE (50 49 20 10 ...).....18455 / 1 <slowest>                           

Code: [Select]

(BenchMark '((_givechange 32 '(20 10 5 3)) (change_v4 32 '(20 10 5 3))))

Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

    (_GIVECHANGE 32 (QUOTE (20 10 5 3))).....1404 / 1.09 <fastest>
    (CHANGE_V4 32 (QUOTE (20 10 5 3))).......1529 / 1 <slowest>

Code: [Select]

(BenchMark '((_givechange 15 '(10 4 3 2)) (change_v4 15 '(10 4 3 2))))

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (_GIVECHANGE 15 (QUOTE (10 4 3 2))).....1435 / 1.07 <fastest>
    (CHANGE_V4 15 (QUOTE (10 4 3 2))).......1529 / 1 <slowest>

Code: [Select]

(BenchMark '((_givechange 15 '(100 99 98 97 96 95  10 4 3 2)) (change_v4 15 '(100 99 98 97 96 95 10 4 3 2))))

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (CHANGE_V4 15 (QUOTE (100 99 98 97 9...).....1591 / 1.23 <fastest>
    (_GIVECHANGE 15 (QUOTE (100 99 98 97...).....1950 / 1 <slowest>

[Lee Mac]

True, in most cases the recursive form is slower since it is repeating many calculations (somewhat analogous to a recursive fibonnacci number calculation), whereas the iterative version following the 'bottom-up' calculation is referring back to a list being constructed for each amount up to the desired amount, possible since this problem exhibits optimal substructure - i.e. The optimal coins to make an amount 'n' is an optimal coin 'c₀' + the optimal coins to make an amount 'n-c₀' ...

[irneb]

OK ... then what about this one:

Code: [Select]

(defun CalcChange (amount denom / lst item)
  (setq denom (vl-sort denom '>))
  (while denom
    (setq item (cons (car denom) 0)
          denom (cdr denom)
    )
    (while (> amount (car item))
      (setq item (cons (car item) (1+ (cdr item)))
            amount (- amount (car item))
      )
    )
    (if (> (cdr item) 0) (setq lst (cons item lst)))
  )
  (reverse lst)
)

[Lee Mac]

The Greedy Algorithm won't always yield the optimal result Irne 

[irneb]

OK! I see! ... Seems a bit difficult to get this as fast as possible, since you basically have to run the permutations to get the "optimal" amount of coins. You're correct, the recursive idea jumps out as the most obvious answer in a similar manner as per the fibonaci sequence (not to mention the even worse prime calculation)!

I'm now thinking could it be made faster by sorting the denominations in another manner, e.g. by increasing residual? I'll have to check.

[Lee Mac]

Another optimisation:

Code: [Select]

(defun _givechange ( n l / a b c d e f g h i )
    (if (setq i (assoc l *change*))
        (progn
            (setq a (cadr i) b (caddr i))
            (repeat (- (length b) n 1) (setq a (cdr a) b (cdr b)))
            (setq c (1- (length a)))
        )
        (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))
    )
    (if i
        (if (< (length (cadr i)) (length a))
            (setq *change* (subst (list l a b) i *change*))
        )
        (setq *change* (cons (list l a b) *change*))
    )
    (setq c 0)
    (while (< c n)
        (setq h (assoc++ (setq e (nth c b)) h) c (+ c e))
    )
    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)
    )
)

[David Bethel]

Maybe for us simple minded folks

Code: [Select]

(defun givechange (a dl / d q c)

(defun remove (expr lst);;;TonyT or VNesterowski
  (apply 'append (subst nil (list expr) (mapcar 'list lst))))

  (while (and (> a 0)
              (> (length dl) 0))
         (setq d (apply 'max dl)
               q (fix (/ a d))
               a (- a (* d q))
               dl (remove d dl))
          (if (> q 0)
              (setq c (cons (cons d q) c))))
  (reverse c))


[Lee Mac]

A simple approach David, but the greedy algorithm will have trouble with examples such as (givechange 40 '(25 20 10 5 1)) 

[ElpanovEvgeniy]

Another optimisation:

Code: [Select]

...

my answer:

Code: [Select]

(defun change_v5 (n l / i)
  (cond ((or (not l) (< n 0)) '(32767 nil))
        ((< n (car l)) (change_v5 n (cdr l)))
        ((zerop (rem n (car l))) (list (setq i (/ n (car l))) (cons (car l) i)))
        ((f1 (f2 n (cdr l)) (change_v5 (- n (car l)) l) (car l)))
  )
)
(defun f1 (a b c)
  (cond ((not a) (f3 n l))
        ((< (car a) (1+ (car b))) a)
        ((= (caadr b) c) (cons (1+ (car b)) (cons (cons c (1+ (cdadr b))) (cddr b))))
        ((cons (1+ (car b)) (cons (cons c 1) (cdr b))))
  )
)
(defun f2 (n l / i)
  (setq i 0
        l (mapcar '(lambda (a / b c)
                     (setq b n
                           n (rem n a)
                           c (/ b a)
                           i (+ i c)
                     )
                     (cons a c)
                   )
                  (vl-sort l '>)
          )
  )
  (if (= n 0)
    (cons i l)
  )
)
(defun f3 (n l / i)
  (cond ((or (not l) (< n 0)) '(32767 nil))
        ((< n (car l)) (change_v5 n (cdr l)))
        ((zerop (rem n (car l))) (list (setq i (/ n (car l))) (cons (car l) i)))
        ((f1 (f3 n (cdr l)) (change_v5 (- n (car l)) l) (car l)))
  )
)

[Lee Mac]

Give me a minute, I think my head just exploded 

[David Bethel]

A simple approach David, but the greedy algorithm will have trouble with examples such as (givechange 40 '(25 20 10 5 1)) 

We Yanks don't have a 20p.  Maybe the Founding Fathers were mathematicians as well and we didn't know it!  -David

[Lee Mac]

A simple approach David, but the greedy algorithm will have trouble with examples such as (givechange 40 '(25 20 10 5 1)) 

We Yanks don't have a 20p.  Maybe the Founding Fathers were mathematicians as well and we didn't know it!  -David

We Brits don't have 25p, I was just looking to the general case for an arbitrary set of denominations for which dynamic programming must be used   

Coincidentally, the greedy algorithm will produce the optimal result for the US currency system. 

[Jürg Menzi]

A little bit offtopic...

Hi Lee
Great solution, thanks!

Had this problem:
http://www.theswamp.org/index.php?topic=42146.0
So I used your solution a little bit modified:

Code - Auto/Visual Lisp: [Select]

1. ...
2.  (while (and (setq e (nth c b)) (< c n))
3.   (setq h (assoc++ e h) c (+ c e))
4.  )
5.  (cons (- n c) h)
6. )

The problem was, that my application requires the ability to get a remainder.

Thanks again and have a good day
Cheers

[Lee Mac]

Thank you Jürg! I'm pleased that my solution was useful in applications other than this challenge