-- (c) MP-I and CP (1998/99-2010/11)

-- NB: this is not a library, it is just a script of demos.
-- The useful material can be found in libraries BTree.hs and LTree.hs

import Data.List
import BTree
import LTree
import Exp
import System.Time
import System.Cmd

--- (a) BTree virtual data structure display ----------------------------------

--- Quicksort ------------------------------------------------------------------
qSort_vtree x = ((expShow "_.html") . cBTree2Exp .
                (fmap show) . (anaBTree qsep)) x
--- Towers of Hanoi ------------------------------------------------------------
hanoi_vtree =
	expShow "_.html" .
        cBTree2Exp .
        (fmap show) .
        (anaBTree strategy)

--- (b) LTree virtual data structure display -----------------------------------

--- Fibonacci ------------------------------------------------------------------
fib_vtree n = ((expShow "_.html") . cLTree2Exp .
              (fmap show) . (anaLTree fibd)) n
--- Mergesort ------------------------------------------------------------------
mSort_vtree [] = (expShow "_.html") (Var " ")
mSort_vtree l = ((expShow "_.html") . cLTree2Exp .
		(fmap show) . (anaLTree lsplit )) l
-- Double factorial ------------------------------------------------------------
dfac_vtree 0 = (expShow "_.html") (Var "1")
dfac_vtree n = ((expShow "_.html") . cLTree2Exp .
               (fmap show) . (anaLTree dfacd)) (1,n)

-- (c) Auxiliary functions -----------------------------------------------------
cLTree2Exp = cataLTree (either Var h)
	     where h(a,b) = Term "Fork" [a,b] 
--------------------------------------------------------------------------------
cBTree2Exp :: BTree a -> Exp [Char] a
cBTree2Exp = cataBTree (either (const (Var "nil")) h)
	     where h(a,(b,c)) = Term a [c,b] 

-- (d) A study of fibonacci ---------------------------------------------------

-- pointwise version of fib =  hyloLTree (either (const 1) add) fibd

fibpw 0 = 1
fibpw 1 = 1
fibpw(n+2) = fibpw(n+1) + fibpw n

-- liner version O(n) after mutual recursion law

fiblpw n = let (a,b) = aux n in b
         where aux 0 = (1,1)
               aux (n+1) = let (a,b) = aux n in (a+b,a) 

-- IO-monadic version o fibpw showing algorithm evolution

fibpwm 0 = return 1
fibpwm 1 = return 1
fibpwm(n+2) = do putStr("\nfib("++show(n+2)++") = ...\n");
		 a <- fibpwm(n+1) ;
                 b <- fibpwm n;
--               putStr("\nn+1="++show(n+1)++" n="++show n++" a+b="++show(a+b)++"\n");
                 return (a + b)

-- IO-monadic version o fibpw' showing algorithm evolution

fiblpwm n = do (a,b) <- auxm n ; putStr("\nresult="++(show b)++"\n")
         where auxm 0 = return (1,1)
               auxm (n+1) = do (a,b) <- auxm n ;
                               putStr("\nn+1="++show(n+1)++" (a+b,a)="++show(a+b,a)++"\n");
			       return (a+b,a) 

-- measuring time costs:

trun f a =
        do
	start <- getClockTime
	print(f a)
	end <- getClockTime
	print (diffClockTimes end start)

tanalysis f f' a =
        do start <- getClockTime
	   print(f a)
	   mid <- getClockTime
	   print(f' a)
	   end <- getClockTime
	   print (diffClockTimes mid start)
	   print (diffClockTimes end mid)
	   print $ div (tdPicosec(diffClockTimes mid start)) (tdPicosec(diffClockTimes end mid))

-- trun fib 19
-- trun fiblpw 19