-- $Id: heapsort.ghc,v 1.2 2001/05/08 02:46:59 doug Exp $
-- http://www.bagley.org/~doug/shootout/
-- from Julian Assange

module Main(main) where
import System(getArgs, exitWith, ExitCode(..))
import Numeric(showFFloat)

main = do
         arg <- getArgs
     case arg of
              [num] -> putStrLn (showFFloat (Just 10) answer "")
                   where
                     answer = last . heapsort .
                                      take (read num) . random $ 1.0
          _     -> exitWith (ExitFailure 1)

-- construct an infinite list of random numbers
random :: Double -> [Double]
random max = map norm . rand $ 42
           where norm x = (fromIntegral x) * (max / (fromIntegral im))
                 rand x = x' : (rand x')
                where x' = (x * ia + ic) `mod` im
             im     = 139968
                 ia     = 3877
                 ic     = 29573

-- fold up a list like a tree
treefold f z []      = z
treefold f z [x]     = x
treefold f z (a:b:l) = treefold f z (f a b : pairfold l)
                 where pairfold (x:y:rest) = f x y : pairfold rest
                   pairfold l          = l

-- heapfold using linked lists
data Heap a = Nil | Node a [Heap a]
heapsort :: Ord a => [a] -> [a]
heapsort = flatten_heap . merge_heaps . map heapify

    where heapify x   = Node x []

      merge_heaps :: Ord a => [Heap a] -> Heap a
          merge_heaps = treefold merge_heap Nil

          flatten_heap Nil            = []
          flatten_heap (Node x heaps) = x:flatten_heap (merge_heaps heaps)

          merge_heap Nil                     Nil = Nil
          merge_heap heap@(Node _ _)         Nil = heap
          merge_heap node_a@(Node a heaps_a) node_b@(Node b heaps_b)
                     | a < b     = Node a (node_b : heaps_a)
                     | otherwise = Node b (node_a : heaps_b)