merge.lhs

I have two interviews coming up with the real-deal companies where 'real-deal' 
means that I'm fairly confident that I have to have my shit together to make 
an impression on them and thus get offered a job.  This is my boning-up 
scratchpad.

Note that this is a brain-dump and not a carefully edited how-to, tutorial, or
otherwise.

> module Merge where

> import System.Random (randomRIO)
> import qualified Data.Text as T
> import qualified Data.Text.IO as T
> import qualified Data.List as L
> import Data.Char (toUpper)
> import Text.Groom
> import GHC.Vacuum

First problem: Sorting a huge amount of data, in this case, single integers, 
in a confined space.

What I want is a large file of numbers
ex: "10293012459185912839182391829312"
I'm going to treat them as single digits


> gen_file :: IO [()]
> gen_file = do
>   mapM (\_ -> do
>            b <- ints
>            T.appendFile "nums.db" $ T.pack $ show b
>        ) range

> ints :: IO Int
> ints = randomRIO (1000,9999)

> range :: [Int]
> range = [1..100]

> msort :: (a -> a -> Bool) -> [a] -> [a]
> msort _ [] = []
> msort _ [a] = [a]
> msort fx a =
>   merge fx (msort fx a1) (msort fx a2)
>  where
>    (a1,a2) = xsplit a          
> xsplit :: [a] -> ([a],[a])
> xsplit [] = ([],[])
> xsplit [a] = ([a],[])
> xsplit (a:b:zs) = (a:xs,b:ys)
>  where
>    (xs,ys) = xsplit zs

> merge :: (a -> a -> Bool) -> [a] -> [a] -> [a]          
> merge _ a [] = a
> merge _ [] a = a
> merge fx (x:xs) (y:ys) =
>   case fx x y of
>     True -> x: merge fx xs (y:ys)
>     False -> y: merge fx (x:xs) ys

> lots :: IO [Int]
> lots = mapM (\_ -> rints) range

> rints :: IO Int
> rints = randomRIO (1000,9999)

> test_msort :: IO Int
> test_msort = fmap (length . msort (<=)) lots

------------

Backing up a bit, I know specifically that I'll be asked about binary search 
trees.

Let's take a non-infinite list of integers and make a tree out of them.

> data BTree a =          
>             End
>             | Node a (BTree a) (BTree a)
>  deriving (Show, Eq, Ord)

> newl :: a -> BTree a
> newl a = Node a End End



> insert :: Ord a => a -> BTree a -> BTree a
> insert a End = newl a
> insert a (Node v lf ri) | a <= v = Node v (insert a lf) ri
>                         | otherwise = Node v lf (insert a ri)


tree up 100 things

> tup :: (Ord a) => a -> [a] -> BTree a
> tup a ls = 
>   fst $ L.mapAccumL (\t y -> (insert y t,y)) (newl a) ls

> showt :: Show a => BTree a -> IO ()
> showt t = putStr (pic "" t)
>  where
>   pic ind End = ind ++ "."
>   pic ind (Node x tl tr) = pic ('\t':ind) tr ++ "\n" ++
>                            ind ++ show x ++ "\n" ++
>                            pic ('\t':ind) tl ++ "\n"

> walk :: (Ord a) => a -> (BTree a) -> [a]
> walk v End = [v]
> walk a (Node v r l) | a <= v = walk a r
>                     | otherwise = walk a l

> my_search :: (Ord a) => a -> BTree a -> Maybe a
> my_search _ End = Nothing
> my_search tos (Node val lef ri) | tos == val = Just val
>                                 | tos < val = my_search tos lef
>                                 | tos > val = my_search tos ri
> my_search _ _ = Nothing -- I hate compiler warnings.

> sortit :: BTree a -> [a]
> sortit End = []
> sortit (Node val lef ri) =
>   sortit lef ++ [val] ++ sortit ri

> blarg :: IO (BTree Int)
> blarg = fmap (tup 50) (mapM (\_ -> ints) range)

> sx :: Show a => BTree a -> String
> sx End = ""
> sx (Node a l r) =
>   show a ++ " => " ++ (sx l) ++ (sx r)

Ok, now let's try to do something useful with this.

> data Msg = Msg { from :: String
>                , to :: String
>                , when :: Int
>                , message :: String }
>  deriving (Show)

> instance Eq Msg where
>   (==) a b = (when a) == (when b)

> instance Ord Msg where
>  compare a b = (when a) `compare` (when b)

> rmsg :: IO Msg
> rmsg = do
>   f <- rs
>   t <- rs
>   w <- ri 1 9
>   m <- rs
>   return $ Msg f t w m
>  where
>   rs = do
>     s <- ri 1 20
>     mapM (\_ -> rc) [0..s]
>   ri :: Int -> Int -> IO Int
>   ri a b = randomRIO (a,b)
>   rc :: IO Char
>   rc = randomRIO ('a','z')

> string_tree :: IO (BTree Msg)
> string_tree = do
>   f <- rmsg
>   fmap (tup f) $ mapM (\_ -> rmsg) range

I hadn't explored binary search trees in depth until tonight.
I have concluded that they are awesome.


Hrm.. how about transformations on leafs?

So, find the correct leaf with a function (leaf -> leaf -> Ordering), then
modify it with another function (leaf -> leaf) on EQ

I could do this quite simply if I could override the Ord class for just this 
function.

 type FindT = (a -> Bool)
 type ModT = (a -> a)

 trans :: (Ord a) => FindT -> ModT -> BTree a -> BTree a
 trans _fx _mx End = End
 trans fx mx (Node val lef ri) =
   case fx val of  
      True -> (

Ok, screw that. Approach taken from 'sortit' above.

First a generalized application to the tree for all elements.
(heh, this is fun as hell)

> elemf :: (a -> a) -> BTree a -> BTree a
> elemf _ End = End
> elemf fx (Node val l r) =
>   Node (fx val) (elemf fx l) (elemf fx r)

A rudamentary transform.

> trans_e :: Msg -> Msg
> trans_e a = a { to = (map toUpper $ to a) }

And to test it

fmap (elemf trans_e) string_tree

I guess that's really all you need.

> trans_2 :: Msg -> Msg
> trans_2 a = filt (to a) a
>  where
>    filt :: String -> Msg -> Msg
>    filt [] b = b
>    filt (x:_) b =
>      case x == 'a' of
>        True -> b { to = (map toUpper $ to b) }
>        False -> b

Uppercase only the ones with a to line that start with 'a'!

Ok, now comes balancing them.

Or does insert keep them balanced?  Let's see.

> few :: IO (BTree Msg)
> few = do
>   f <- rmsg
>   fmap (tup f) $ mapM (\_ -> rmsg) rng
>  where
>    rng :: [Int]
>    rng = [1..8]

> make_doc :: IO ()
> make_doc = do
>   x <- few
>   T.writeFile "out.dot" $ T.pack $ show $ ppDot . nameGraph $ vacuum x

You can make an image of this graph with "dot out.dot -Tpng -o out.png"