David Tran’s blog

{-
    Program : Prime.hs
    Author  : David Tran
    Date    : 2010-07-17

    Below references show many ways to construct prime numbers:
    * http://www.haskell.org/haskellwiki/Prime_numbers
    * Melissa E. O’Neill, The Genuine Sieve of Eratosthenes
      http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
      http://lambda-the-ultimate.org/node/3127

    The classic one-liner is very elegant:
    primes = sieve [2..] where sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p > 0]
    However, it may be also the slowest…

    The reason that I wrote my own version is because, after read yen3’s blog
    (Chinese) http://yen3rc.blogspot.com/2010/03/haskell-practice-prime-2.html
    I like to try the idea of list 6n+1 and 6n+5.

-}

module Prime (isPrime, primes) where

primes :: [Integer]
primes = 2:3:5: filter isPrime' ns
  where ns = foldr (\n acc -> 6*n+1 : 6*n+5 : acc) [] [1..]
--      ns = concat $ zipWith (\x y -> [x,y]) [7, 13..] [11, 17..]

isPrime' :: Integer -> Bool
isPrime' n = check primes
  where check (p:ps) | p < n'    = if (n `mod` p == 0) then False else check ps
                     | otherwise = True
        n' = truncate (sqrt $ fromIntegral n) + 1

isPrime :: Integer -> Bool
isPrime n | n < 2     = False
          | otherwise = isPrime' n

{-
isPrime :: Integer -> Bool
isPrime n = n `elem` takeWhile (<=n) primes
-}

{-
 
  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

My power set solution is defined.
I just found there is challenge question about get the power set in “order” without using sort.
For example:

subsets [] = [[]]
subsets [1,2,3] = [[],[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]

My solution for this challenge is simply reuse my combination function.

combination :: [a] -> Int -> [[a]]
combination _   0    = [[]]
combination []  _    = []
combination (x:xs) n = map (x:) (combination xs (n-1)) ++ combination xs n

subset :: [a] -> [[a]]
subset xs = concat [combination xs k | k <- [0..n]] where n = length xs

-- http://www.haskell.org/haskellwiki/Pointfree

-- point free for n parameters

f1 :: (Num a, Ord a) => a -> a -> a
f1 a b = 1 + max a b

f2 :: (Num a, Ord a) => a -> a -> a
-- f2 a b = (((1+).).max) a b
f2 = ((1+).).max

g1 :: (Num b) => (a -> b -> b) -> b -> [a] -> b
g1 x y z = 1 + foldr x y z

g2 :: (Num b) => (a -> b -> b) -> b -> [a] -> b
-- g2 x y z = ((((1+).).).foldr) x y z
g2 = (((1+).).).foldr

Finished:
Yet Another Haskell Tutorial
Haskell for C Programmers

Start reading:
Haskell Wikibook

To find the combination of (n,r), we can use this formula:
C(n,r) = C(n-1,r-1) + C(n-1,r)

This means, combination of (n,r) equals to combine of
take the first ( C(n-1,r-1) ) and without take the first ( C(n-1,r) ).

For example, for C(2,1), it can be:
C(2,1)
= add#1 in C(1,0) + C(1,1)
= add#1 in C(1,0) + add#2 in C(0,0) + C(0,1)
where
add#1 = add first element of list ( C(2,1) )
add#2 = add first element of list ( C(1,1) )

So, the base case could define as:
C(_,0) = [[]]
C(0,_) = []

Here is the Haskell definition for combination:

combination :: [a] -> Int -> [[a]]
combination _   0    = [[]]
combination []  _    = []
combination (x:xs) n = map (x:) (combination xs (n-1)) ++ combination xs n

The power set of S is the set of all subsets of S.
There will be total 2ⁿ sets where n is the number element of S.
For example, the set S={a,b,c}, we could use all 3 bits value to find the power set.

By using this hint (the color red represents power set of {b,c}), the power set function can be defined as:

powerset :: [a] -> [[a]]
powerset []     = [[]]
powerset (x:xs) = powerset xs ++ map (x:) (powerset xs)
-- powerset (x:xs) = powerset xs ++ [x:xs' | xs' <- powerset xs]

Compute permutation using list comprehension and recursion can be like:

permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [x:ps | x <- xs, ps <- permutations (delete x xs)]

There are many other variants, like:

permutations xs = [x:ps | x <- xs, ps <- permutations (xs\\[x])] 

and also on here and LicensedPreludeExts

permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [y:zs | (y,ys) <- selections xs, zs <- permutations ys ]

selections :: [a] -> [(a,[a])]
selections [] = []
selections (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- selections xs]

even faster version:

permutations :: [a] -> [[a]]
permutations []     = [[]]
permutations (x:xs) = [zs | ys <- permutations xs, zs <- everywhere x ys]

everywhere :: a -> [a] -> [[a]]
everywhere x []     = [[x]]
everywhere x (y:ys) = (x:y:ys) : [y:zs | zs <- everywhere x ys]

and so on.

Sometime the list to permute may contain repeat elements (likes two quizzes below), one way to get the unique permutations is like:

result = nub (permutations list_has_repeat_elements)

This is sometime really inefficient, especially there are many repeats elements like in Chess960 quiz; simply modify the permutations definition can improve a lot in this case:

permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ x:ps | x <- nub xs, ps <- permutations (delete x xs) ]

Now, I can apply this permutations to quick solve below two quizzes.

(1) Check960 (see detail information on: Ruby Quiz #106 Chess960 or wikipedia)

module Main where
import Data.List

pieces = "RNBKQBNR"

permutations [] = [[]]
permutations xs = [x:ps | x <- nub xs, ps <- permutations (delete x xs)]

restriction position =
  r1 < k && k < r2 &&
  sum (elemIndices 'B' position) `mod` 2 /= 0
  where
    r1:r2:_  = elemIndices 'R' position
    Just k   = elemIndex   'K' position

result = filter restriction (permutation pieces)

main = do
--  print result
    print (length result)

(2) Quiz: give you 1,2,2,3,4,5 six digits(attention: two 2s), print out all of different possible numbers by using the digits under two conditions: 3 and 5 can’t be consecutive, 4 can’t be at the thousand position. This is really similar to the Check960 quiz.

module Main where
import Data.List

permutations [] = [[]]
permutations xs = [x:ps | x <- nub xs, ps <- permutations (delete x xs)]

digits = [1,2,2,3,4,5]

check xs =            -- precondition: xs is one of "digits"’s permutations  
  xs !! 2 /= 4  &&    -- 4 can’t be at the thousand position
  abs (p3 - p5) /= 1  -- 3 and 5 can’t be consecutive
  where
    Just p3 = elemIndex 3 xs
    Just p5 = elemIndex 5 xs

result = filter check (permutations digits)

main = do
--  print result
    print (length result)

I have more fun with Haskell than Ruby.