David Tran’s blog

{-

    Program : make_change.hs
    Author  : David Tran
    Date    : 2008-10-25

    On the SOE exercise 5.9 (http://davidtran.doublegifts.com/blog/?p=37)
    I said that I will find a solution for it. Here it is.
    The make change question could be considered as partitions of integers
    problem. (http://davidtran.doublegifts.com/blog/?p=152)
    The amount money is the interger to be partition.
    The coins are the generating functions; only select functions matchs coins' value.

    Examples:
    makeChange 99 [5, 1]         ==> [19,4]
    makeChange 18 [10, 9, 3, 1]  ==> [0,2,0,0]

-}
import Data.List
import Data.Maybe

type Constant = (Int, Int)       -- "Constant" at "Position"
type Coefficient = [ Constant ]  -- "Sum" of Constant
type Exponent = Int
type Term = (Coefficient, Exponent)
type Polynomial = [ Term ]       -- "Sum" of Term

term :: Int -> Int -> Polynomial
term max n = ([],0) : [ ([(n,i)], n * i) | i <- [1.. max `div` n ] ]

mult :: Int -> Polynomial -> Polynomial -> Polynomial
mult max p1 p2 = [ (c1++c2, e1+e2) | (c1,e1) <- p1, (c2,e2) <- p2, e1+e2 <= max ]

makeChange :: Int -> [Int] -> [Int]
makeChange n cs = to_solution $ min_change $ only_coeff $ filter_terms $ generate_terms 
  where
  generate_terms = foldr1 (mult n) (map (term n) cs)
  filter_terms   = filter (\(c, e) -> e == n)
  only_coeff     = map (\(c, e) -> c)
  min_change     = minimumBy (\x y -> compare (countCoin x) (countCoin y))
  countCoin      = foldr (\(c,t) sum -> sum + t) 0
  to_solution xs = map (\c -> fromMaybe 0 (lookup c xs)) cs
  

{-
 
  Program ...... : partition.hs (Partitions of Integers)
                   Partitions of Integers using generating function
  Author ....... : David Tran
  Date ......... : 2008-10-25
  References ... : http://en.wikipedia.org/wiki/Partition_%28number_theory%29
                   http://chowkafat.net/Enumeration15.html 

  ========================================================================
  
  Here shows example for n == 3
  * To simply the calculation, the coefficient of term x^0 is always ([],0)
  * most time we are interested only on term "n" (limited constant). 
    So any term > n is no need to calculate;
    that's the "max" for; so we will not have an infinity of terms Polynomial.

  term 3 1 = [ ([],0), ([(1,1)],1), ([(1,2)],2), ([(1,3)], 3) ]
           = ( 1 x^0 + (N1 x)^1 + (N1 x)^2 + (N1 x)^3 )
  term 3 2 = [ ([],0), ([(2,1)],2) ]
           = ( 1 x^0 + (N2 x)^1 )
  term 3 3 = [ ([],0), ([(3,1)],3) ]
           = ( 1 x^0 + (N3 x)^1 )

  multiple the 3 terms = (term 3 1) * (term 3 2) * (term 3 3)
  mult 3 (term 3 3) $ mult 3 (term 3 1) (term 3 2)
  = [ ([],0), ([(2,1)],2), ([(1,1)],1), ([(1,1),(2,1)],3),
      ([(1,2)],2), ([(1,3)],3), ([(3,1)],3) ]

  ([(1,1),1) is for term x^1 => (1,1)           => 1 = 1
  for term x^2, we got [(2,1)] and [(1,2)]      => 2 = 2 = 1+1
  for term x^3, [(1,1),(2,1)], [(1,3)], [(3,1)] => 3 = 1 + 2
                                                     = 1 + 1 + 1
                                                     = 3
  
  ========================================================================

  Example Usage:

  *Main> partition 5
  [[(5,1)],[(2,1),(3,1)],[(1,1),(4,1)],[(1,1),(2,2)],[(1,2),(3,1)],[(1,3),(2,1)],[(1,5)]]

  *Main> pp_partition 5
  5=5
  5=2+3
  5=1+4
  5=1+2+2
  5=1+1+3
  5=1+1+1+2
  5=1+1+1+1+1

  *Main> countPartition 5
  7

-}

type Constant = (Int, Int)       -- "Constant" at "Position"
type Coefficient = [ Constant ]  -- "Sum" of Constant
type Exponent = Int
type Term = (Coefficient, Exponent)
type Polynomial = [ Term ]       -- "Sum" of Term

term :: Int -> Int -> Polynomial
term max n = ([],0) : [ ([(n,i)], n * i) | i <- [1.. max `div` n ] ]

mult :: Int -> Polynomial -> Polynomial -> Polynomial
mult max p1 p2 = [ (c1++c2, e1+e2) | (c1,e1) <- p1, (c2,e2) <- p2, e1+e2 <= max ]

partition :: Int -> [ Coefficient ]
partition n = only_coeff $ filter_terms $ generate_terms
  where generate_terms = foldr1 (mult n) (map (term n) [1..n])
        filter_terms   = filter (\(c, e) -> e == n)
        only_coeff     = map (\(c, e) -> c)

countPartition :: Int -> Int
countPartition = length . partition

pp_partition :: Int -> IO()   -- pretty print partition
pp_partition n = sequence_ $ map showSum (partition n)
  where showSum s = do putStr $ (show n) ++ "=" ++ sumList (strList s) ++ "\n"
        strList = foldl (\acc (n,i) -> acc ++ replicate i (show n)) []
        sumList = foldl1 (\x y -> x ++ "+" ++ y)
        

{-

Author ................. : David Tran
Date ................... : 2009-11-13
Breadth-first search ... : http://en.wikipedia.org/wiki/Breadth-first_search
Depth-first search ..... : http://en.wikipedia.org/wiki/Depth-first_search

Beath-first Algorithm (informal)
1. Enqueue the root node.
2. Dequeue a node and enqueue the direct child nodes.
3. If the queue is empty, every node has been examined. Done.
4. Repeat from Step 2.

Using a stack (put direct child nodes on the front instead of the back)
instead of a queue whould turn this algorithm into a depth-first search.

This program shows the similarity of breath-first and depth-first.
The "travel" function combines both into one!

-}

module Main where

-- http://www.haskell.org/haskellwiki/Algebraic_data_type
-- Rose Tree
data Tree a = Node a [Tree a]

df :: Tree a -> [a]
df (Node n st) = n : concat (map df st)
-- df (Node n st) = n : concat [df t | t <- st]

depthFirst :: Tree a -> [a]
depthFirst t = depthFirst' [t]
  where
  depthFirst' []                       = []
  depthFirst' ((Node n subTrees) : ts) = n : depthFirst' (subTrees ++ ts)

breadthFirst :: Tree a -> [a]
breadthFirst t = breadthFirst' [t]
  where
  breadthFirst' []                       = []
  breadthFirst' ((Node n subTrees) : ts) = n : breadthFirst' (ts ++ subTrees)

travel :: Tree a -> Bool -> [a]
travel t depthFirst = travel' [t]
  where 
  travel' [] = []
  travel' ((Node n st) : ts) = n : travel' nexts
    where nexts = if depthFirst then st ++ ts else ts ++ st

tree :: Tree Int
tree =   -- http://en.wikipedia.org/wiki/File:Depth-first-tree.svg
  Node 1 [
    Node 2 [
      Node 3 [
        Node 4 [], 
        Node 5 []
      ],
      Node 6 []
    ],
    Node 7 [],
    Node 8 [
      Node 9 [
        Node 10 [],
        Node 11 []
      ],
      Node 12 []
    ]
  ]

main :: IO ()
main = do 
       putStrLn $ show $ df tree
       putStrLn $ show $ depthFirst tree
       putStrLn $ show $ breadthFirst tree
       putStrLn $ show $ travel tree True
       putStrLn $ show $ travel tree False