Coin Problem.. Code

(* Coin Problem:

   A group of coin denominations is given.
   You are asked to represent a given sum with the least amount of coins.
   How do you do that? *)


(* open modules to make things shorter *)
open Printf;; open List;;



(* printf utilities *)

(* Print a coin count pair ie: "(3 of 7)" *)
let print_pair pair oc =
  output_char oc '(';
  output_string oc (string_of_int (snd pair));

  output_string oc " of ";
  output_string oc (string_of_int (fst pair));
  output_char oc ')' ;;


(* Print a path string ie: "(1 of 5),(3 of 2)" *)
let rec print_path path oc = match path with
    pair :: [] ->

      print_pair pair oc
  | pair :: tl ->
      print_pair pair oc;
      output_string oc ", ";

      print_path tl oc
  | [] -> () ;;

(* Print a path list (path strings separated by new lines *)
let print_paths paths oc =
  let rec pp paths oc =

  match paths with
    path :: [] ->
      print_path path oc
  | path :: tl ->

      print_path path oc;
      output_string oc ".\n";
      pp tl oc
  | [] -> () in output_char oc '\n'; pp paths oc ;;


(* Print a list... [1;2;3;4] *)
let rec print_list l oc =
  let rec pl l oc =
  match l with

    i :: [] ->
      output_string oc (string_of_int i);
      output_char oc ']'
  | i :: tl ->

      output_string oc (string_of_int i);
      output_char oc ';';
      pl tl oc
  | [] -> () in output_char oc '['; pl l oc ;;


(* Count how many coins are in a path *)
let path_coins path =
  let rec _c path c = match path with

    [] -> c
  | pair :: tl -> _c tl (c + (snd pair)) in _c path 0 ;;



(* Solve the coin problem.
   @parameter: coins List containing coin values
   @parameter: sum Integer of what we want to represent
   @return: A path of coin value pairs *)
let solve coins sum =
  (* Recursive helper matches 3 types
     @parameter: coins List containing coin values
     @parameter: remains Integer whats left to represent
     @parameter: current_path How many of what coins have been used in this path
     @parameter: best_path Best known path upto the current point in execution
     @returns: Best known path so far *)
  let rec gen_path coins remains current_path best_path =
      (* filter out coins that are too big *)
      let coin_opts = filter
        (fun coin -> remains  >=  coin) coins in


      (* partition posible coins between divisible and non divisible *)
      let coin_part  = partition
        (fun coin -> remains mod coin = 0) coin_opts in


      (* get the maximum coin value of each *)
      let div_max    = fold_left max 0 (fst coin_part) and
          ndv_max    = fold_left max 0 (snd coin_part) in


  match coin_part with
    (* no more coins to choose from, return best path known *)
    _ when (length coin_opts) = 0 -> best_path

    (* remaining sum is not only divisible by a coin amount,
       but also, that amount is the highest available *)

  | (divs, ndvs) when ndv_max < div_max || ndvs = [] ->

      let new_path = (div_max, remains / div_max) :: current_path in

        if (path_coins best_path) < (path_coins new_path) then
          best_path
        else
          new_path

    (* general case when we don't know which is a better choice,
       we end up simply adding a coin of each, individualy..
       @parameter: coin_optss List pf coin values we have yet to check
       @returns: Best known path so far *)

  | _ -> let rec do_coin_opts coin_opts = match coin_opts with

      (* we have already cycled through each coin,
         leave this inner loop *)
      [] -> best_path

      (* try adding one of coin and continue *)
    | coin :: tl ->

      (* keep list short; filter and fold quantities *)
      let cPath = filter
        (fun pair -> fst pair <> coin) current_path in

      let count = fold_left
        (fun c pair -> if (fst pair) = coin then (c+ (snd pair)) else c) 0 current_path in


      (* get what would have happened had we added another coin *)
      let path_a = do_coin_opts tl in

      (* finish building this path and compare it to our retrieved alternative *)
      gen_path coin_opts (remains - coin) ((coin,count+1)::cPath) path_a

    (* the general case is to go through each available coin *)

    in do_coin_opts coin_opts

  (* solve simply calls the gen_path function, with the appropriate parameters *)
  in gen_path coins sum [] [(0,sum)]
;;



(* Coin Problem Test Cases *)



let coins = [3;5;7;9];;
let sum = 4;;


(* run it *)
let path = solve coins sum;;

(* printf "test print_pair %t\n" (print_pair (4,5));; *)

printf "Problem.\nCoin Values = %t\nRequested Sum = %d\n\n" (print_list coins) sum;;


if fst (hd path) = 0 then printf "Solution:\nImposible to do" else

printf "Solution:\nCoins = %d.\nPath = %t\n" (path_coins path) (print_path path);;