Topic: -={ Challenge }=- Give Change

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