{-- Calculation of Deforestation Rate for the PRODES project

    (c) Gilberto Camara (INPE) - March, 2004

	This program is free software; you can redistribute it 
    and/or modify it under the terms of the GNU General 
    Public License 2.1 as published by the Free Software Foundation
    (http://www.opensource.org/licenses/gpl-license.php)
--}

-- Auxiliary generic functions used in TerraHS

module TerraHS.Misc.GenericFunctions
{--
(	
	doall,
	mapWith2,
	mapWith3,
	fst3,
	snd3,
	thr3,
	find, 
	filter2,
	filter3,
	filter4,
	mkPairs,
	mkPairsFun,
	mkTuples,
	mkQuads,
	conv43,
	qsort,
	
	print_generic,
	appUnsafe,
	cartp, cartesian,
	
	toDouble, toInt
	
	
)--}
where

--import Maybe

import Foreign
import Foreign.C.String
import qualified System.IO.Unsafe (unsafePerformIO)

toDouble :: String -> Double
toDouble str = read str::Double

toInt :: String -> Int32
toInt str = read str::Int32

-- converte uma função IO binaria (não recomendado - solução não pura)
appUnsafe :: (a -> b -> IO c) -> a -> b -> c
appUnsafe f e1 e2 = System.IO.Unsafe.unsafePerformIO (f e1 e2)

cartp  ::  [a] -> [b] -> (a -> b -> Bool)->[(a,b)]
cartp xs ys p = [ (x,y) | x <- xs, y <- ys, (p x y) ]

cartesian ::[a] -> [b] -> (a -> b -> IO Bool ) -> IO [(a,b)]
cartesian [] ys p = return []
cartesian xs [] p = return []
cartesian (x:xs) ys p =  cartesian0 x ys p >>= \r1 ->  (cartesian xs ys p) >>= \r2 -> return (r1 ++ r2)


cartesian0 :: a -> [b] -> (a -> b -> IO Bool ) -> IO [(a,b)]
cartesian0 x [] p = return []
cartesian0 x (y:ys) p = do 
	pred <- p x y
	if pred then (cartesian0 x ys p) >>= \r1 -> return ( (x,y) : r1 ) else do (cartesian0 x ys p) >>= \r1 -> return ( r1 )

	
print_generic :: Show a => a -> IO()
print_generic g = (putStrLn (show (g)))

-- doall - performs a list of IO actions
doall :: [IO ()] -> IO ()
doall = foldr1 (>>)

-- mapWith2 - generic map with a function with 2 arguments
-- (the first argument is a constant and the second is a list)
mapWith2 :: (a -> b -> c ) -> a -> [b] -> [c]
mapWith2 f p1 xs = [ f p1 x | x <- xs ]

-- mapWith3 - generic map with a function with 3 arguments
-- (the first two arguments are constants and the third is a list)
mapWith3 :: (a -> b -> c -> d) -> a -> b -> [c] -> [d]
mapWith3 f p1 p2 xs = [ f p1 p2 x | x <- xs ]

-- fst3 - retrieve the first argument of a triple
fst3            :: (a,b,c) -> a
fst3 (x,_,_)    = x

-- snd3 - retrieves the second argument of a triple
snd3            :: (a,b,c) -> b
snd3 (_,y,_)    = y

-- trd3 - retrieves the thrid argument of a triple
thr3            :: (a,b,c) -> c
thr3 (_,_,z)    = z

{--
find :: (Eq a) => a -> [a] -> Maybe a
find _ [] = Nothing
find x (y:ys) 
	| (x == y) = Just y
	| otherwise = find x ys


filter2 :: (Eq a) => ([a],[a]) -> [(a, a)]
filter2 (xs,ys) = [ (x,fromJust (find x ys)) | x <- xs, (elem x ys)]

filter3 :: (Eq a) => ([a],[a],[a]) -> [(a, a, a)]
filter3 (xs,ys,zs) = [ (x,fromJust (find x ys), fromJust (find x zs)) | x <- xs, ((elem x ys) && (elem x zs))]

filter4 :: (Eq a) => ([a],[a],[a],[a]) -> [(a, a, a, a)]
filter4 (xs,ys,zs,ws) = [ (x,fromJust (find x ys), fromJust (find x zs), fromJust (find x ws)) | x <- xs, ((elem x ys) && (elem x zs) && (elem x ws))]
--}
-- Check 
mkPairs :: [a] -> [(a,a)]
mkPairs [] = []
mkPairs (x:[]) = []
mkPairs (x1:x2:[]) = [(x1,x2)]
mkPairs (x1:x2:xs) =  [(x1, x2)] ++ mkPairs xs

mkPairsFun :: (a->b) -> [a] -> [(b,b)]
mkPairsFun f [] = []
mkPairsFun f (x:[]) = []
mkPairsFun f (x1:x2:[]) =  [(f x1, f x2)]
mkPairsFun f (x1:x2:xs) =  [(f x1, f x2)] ++ mkPairsFun f xs

mkTuples :: [[a]] -> [([(a)], [(a)], [(a)])]
mkTuples [] = []
mkTuples (d1:[]) = [] 
mkTuples (d1:d2:[]) = [] 
mkTuples (d1:d2:d3:[]) = [(d1,d2,d3)]
mkTuples (d1:d2:d3:ds) = [(d1,d2,d3)] ++ mkTuples (d2:d3:ds)

mkQuads :: [[a]] -> [([(a)], [(a)], [(a)], [a])]
mkQuads [] = []
mkQuads (d1:[]) = [] 
mkQuads (d1:d2:[]) = [] 
mkQuads (d1:d2:d3:[]) = []
mkQuads (d1:d2:d3:d4:[]) = [(d1,d2,d3,d4)] 
mkQuads (d1:d2:d3:d4:ds) = [(d1,d2,d3,d4)] ++ mkQuads (d2:d3:d4:ds)

mk43 :: (a, a, a, a) -> (a,a,a)
mk43 = (\(x1,x2,x3,x4) -> (x1,x2,x3))

  
mk43a :: (a, a, a, a) -> (a,a,a)
mk43a = (\(x1,x2,x3,x4) -> (x2,x3,x4))


conv43 :: [[(a, a, a, a)]] -> [[(a,a,a)]]
conv43 [] = []
conv43 (q1:quads) = [(map (mk43) q1)] ++ [(map (mk43a) q1)] ++ conv43 quads

--qsort :: Ord a => [a] -> [a]
--qsort [] = []
--qsort (piv:rest) = qsort upper ++ [piv] ++ qsort lower
--	where
--	upper = [ x | x <- rest, x > piv]
--	lower = [ x | x <- rest, x <= piv]

qsort :: Ord a => [a] ->  [a]
qsort [] = []
qsort (piv:rest) = qsort upper ++ [piv] ++ qsort lower
	where
	upper = [ x | x <- rest, x < piv]
	lower = [ x | x <- rest, x >= piv]