Whenever I hear Backtracking in the context of Perl, I think Regular Expressions. So, if you can express the problem as a string, and a matching solution as a regular expression, Perl can solve the problem:

use strict;

my $change = 16;
my @coins = reverse sort qw(2 5);

my $q='1'x$change;

my $solution = join'',map{qr(((?:.{$_})+))} @coins;

$q = ~/^()$solution$/
  or die "Error in regex construction";
{
  # This should maybe be done via @-, but I'm lazy:
  no strict;
  print(length(${$_})/$_, '*', $_) for (1..4)
};
[download]

The key to using Perl effectively is to use its strengths rather than its weaknesses.

Update: Roy Johnson pointed out that I erroneously changed names between testing out and posting - $sol was left over in one place.

Hmmm, a few fixes so you can have 0 counts for some of the coins.

use strict;

my $change = 16;
my @coins = sort { $b <=> $a } qw(2 5);

my $q='1'x$change;

my $solution = join "", map { qr[((?:.{$_})*)] } @coins;

$q =~ /^$solution$/
  or die "Error in regex construction";
{
  # This should maybe be done via @-, but I'm lazy:
  no strict;
  print(length(${$_})/$coins[$_-1], '*', $coins[$_-1]) for (1..@coins)
+;
};
__END__
[download]

After reading the link you provided, I figured out that the problem is somewhat different: it's supposed to yield only one result. I offer a solution that parallels the ML one in another post in this thread.

What is at issue is that the obvious "greedy" algorithm for making change that proceeds by doling out as many coins as possible in decreasing order of value does not always work. Given only a 5 cent and a 2 cent coin, we cannot make 16 cents in change by first taking three 5's and then proceeding to dole out 2's. In fact we must use two 5's and three 2's to make 16 cents. Here's a method that works for any set of coins:

exception Change

fun change _ 0 = nil
  | change nil _ = raise Change
  | change (coin::coins) amt =
    if coin > amt then
       change coins amt
    else
       (coin :: change (coin::coins) (amt-coin))
       handle Change => change coins amt
[download]

The idea is to proceed greedily, but if we get "stuck", we undo the most recent greedy decision and proceed again from there. Simulate evaluation of the example of change [5,2] 16 to see how the code works.

use strict;
use warnings;

my $amount = 16;
my $coinset = [5,2];

{
  my $Exception = 0;

  sub change {
    my ($cset, $amt) = @_;
    if ($amt == 0)    { return [] }
    if (@$cset == 0)  { $Exception = 1; return [] }
    my $coin = shift @$cset;
    if ($coin > $amt) {
      print "$coin > $amt\n";
      return [change($cset, $amt)];
    }
    else {
      print "Checking $amt - $coin\n";
      my $rval = [$coin, @{change( [$coin, @$cset], $amt - $coin )}];
      if ($Exception) {
        print "Exception forces backing up to $amt\n";
        $Exception = 0;
        $rval = [@{change($cset, $amt)}];
      }
      return $rval;
    }
  }
}

use Data::Dumper;
print Dumper(change($coinset, $amount)), "\n";
[download]

I don't like global vars (even in disguise). So thats my take on yours.

#!/usr/bin/perl
use strict;
use warnings;

my $amount = 16;
my $coinset = [5,2];


sub change {
    my ($cset, $amt) = @_;
    if ($amt == 0)    { return [] }
    if (@$cset == 0)  { return "" }
    my $coin = shift @$cset;
    if ($coin > $amt) {
      print "$coin > $amt\n";
      $coin=change($cset, $amt);
      return$coin if!ref$coin;
      return[$coin];
    }
    else {
      print "Checking $amt - $coin\n";
      my $rval =change( [$coin, @$cset], $amt - $coin );
      return[$coin, @{$rval}]if ref $rval;
      print "Exception forces backing up to $amt\n";
      return [@{change($cset, $amt)}];
    }
}
use Data::Dumper;
print Dumper(change($coinset, $amount)), "\n";
[download]

It's not a global, it's a static. What's not to like about it?

---

Caution: Contents may have been coded under pressure.

    change _      0  = [[]]
    change []     _  = fail "can't make change"
    change (c:cs) n
       | c > n       = change cs n
       | otherwise   = map (c:) (change (c:cs) (n-c)) ++ change cs n
[download]

    > change [5,2] 16
    [[5,5,2,2,2],[2,2,2,2,2,2,2,2]]
[download]

    quickchange cs n = listToMaybe (change cs n)

    > quickchange [5,2] 16
    Just [5,5,2,2,2]

    > quickchange [7] 16
    Nothing
[download]

    > :m +Data.Ratio
    > quickchange [1%2, 1%3] (10%6)
    Just [1%2, 1%2, 1%3, 1%3]
[download]

Cheers,
Tom

This solution acts pretty much the same way humans act: It starts with the big number (the quarters), and once it determines that adding another quarter will put it past the target value, it moves on to the next smaller denomination and tries it. ...at least that's how I do it. ;)

use strict;
use warnings;

my $a_coins = [ 25, 25, 25, 10, 10, 10 , 5, 1, 1, 1, 1 ];
my $wanted = 72;
my @needed = @{ make_change( $a_coins, $wanted ) };
print "@needed = $wanted\n";

sub make_change {
    my( $a_coins, $dest ) = @_;
    my @coins = sort { $b <=> $a } @{ $a_coins };
    my @need;
    my $tally = 0;
    while ( @coins ) {
        my $current = shift @coins;
        next if $tally + $current > $dest;
        $tally += $current;
        push @need, $current;
        return \@need if $tally == $dest;
    }
    shift ( @{$a_coins} );
    @need = @{ make_change( $a_coins, $dest ) };
    my $check=0;
    foreach ( @need ) {
        $check += $_;
    }
    if( $check == $dest ) {
        return \@need;
    } else {
        die "Can't make change.\n";
    }
}
[download]

Updated: I've updated make_change() to use recursion to support cases such as @coins = ( 25, 10, 10, 10 ) and $wanted = 30. Now, if it is found that 25+10 exceeds 30 (which it does), 25 is discarded from the change queue, and the sub is re-run without the quarter getting in the way.

Interestingly, that only gives you the smallest number of coins for certain combinations of denominations. For instance, consider making change in a system that didn't have nickles. That is, $a_coins = [(25) x 4, (10) x 10, (1) x 10]; $wanted = 30;). Your solution would grab a quarter, and then be stuck with 5 pennies, for a total of 6 coins, where a smarter solution might give three dimes. But for coins in the US system, the greedy algorithm works.

There is a very interesting article on this subject here: http://www.sciencenews.org/articles/20030510/mathtrek.asp.

The article makes a few interesting points. One is that the US coin system would become more efficient (in number of coins needed to provide transaction change) if an 18 cent piece were introduced to replace the dime. Keep the dime, and introduce a 32 cent coin for even greater transaction efficiency. ...though this is going to be harder for your high-school student clerks to add in their heads.

It also mentions that the "greedy algorithm" (starting from the largest denomination and working downward) provides the most efficient (in number of coins used) solution for US coin denominations, but isn't guaranteed to do so given the denominations of other countries.




Dave

Says Eimi Metamorphoumai:

Interestingly, that only gives you the smallest number of coins for certain combinations of denominations.

I looked into this in some detail a while back also. As you point out, the greedy change algorithm for the US (1, 5, 10, 25) system always delivers the minimum possible number of coins for any amount, but this is a property of the particular denominations used. Clearly, a system with coins of size 1, 10, and 11 does not have this property, since the greedy algorithm gives change for 20 cents by starting with an 11-cent coin, and then delivers nine pennies.

When I realized this I started to look around to see if there were any widely-used coinage systems that did not have the greedy property. I was pleased to discover one: the pre-decimalization currency of the United Kingdom included the following coins:

    half-crown  =  30 pence
    florin      =  24 pence
    shilling    =  12 pence
    sixpence    =   6 pence

When changing four shillings = 48 pence, the greedy algorithm delivers a half-crown, a shilling, and a sixpence, but the optimal solution delivers two florins.

--
Mark Dominus
Perl Paraphernalia

ML has a TCL look to it,

Actually, TCL has a LISP look to it (this was explicitly mentioned in the orginal paper on TCL (external link)). Though it's far too limited to provide a lot of the cool-factor that LISP provides.

ML comes out of Functional Programming, just like LISP, so it's not that surprising that it looks a little like TCL to some people. But the similarties are only on the surface.

fun intf base next 0 = base
  | intf base next n = next (n, (intf base next (n-1)));
val iota = intf [0] (op ::);

local
      val append = foldl (op @) []
      fun repeat x = intf [] (fn (_,ls) => x::ls)
      fun rep2each x n ls = map (fn e => (repeat x n) @ e) ls
in
  fun change nil 0 = [[]]
    | change nil _ = []
    | change (c::cs) x =
         append (map (fn n => rep2each c n (change cs (x - n*c)))
                     (iota (x div c)))
end;
[download]

  datatype 'a option = Solution of 'a | Nothing;
[download]

  fun sflat ls = foldr (fn (Solution x, _) => Solution x
                         | (Nothing,v) => v) 
                       Nothing ls;
  fun smap _ Nothing = Nothing | smap f (Solution x) = Solution (f x)
[download]

local
  fun repeat x = intf [] (fn (_,ls) => x::ls)
in
  fun change1 nil 0 = Solution []
    | change1 nil _ = Nothing
    | change1 (c::cs) x =
         sflat (map (fn n => smap (fn x => (repeat c n) @ x) (change1 
+cs (x - n*c)))
                     (iota (x div c)))
end;
[download]

If all you want is to count the solutions, it's simpler, because you can get rid of all of ML's clumsy value construction syntax:

local val addup = foldr (fn (a,b) => a+b) 0
in
  fun countchange nil 0 = 1
    | countchange nil _ = 0
    | countchange (c::cs) x =
         addup (map (fn n => countchange cs (x - n*c))
                    (iota (x div c)))
end;
[download]

ML has a TCL look to it...