import Shape
import Draw
import List (sortBy)
import QuickCheck -- just for testing

-- #1 


-- one of many possible ways to generate without regard for order

subStrings :: String -> [String]
subStrings [] = [""]
subStrings xss@(_:xs) = prefixes xss ++ subStrings xs
  where prefixes [x] = [[x]]
        prefixes (x:xs) = [x] : (map (x:) (prefixes xs))
  -- List.inits is almost right, but returns the empty list.
  -- Another way is:
  --    prefixes xs = map reverse (suffixes (reverse xs))
  --	suffixes [x] = [[x]]
  --    suffixes (x:xs) = (x:xs):(suffixes xs)

-- #1 EC

-- a simple brute-force approach: generate and then sort
subStrings1 :: String -> [String]
subStrings1 = (sortBy c) . subStrings
  where c s1 s2 = compare (length s2) (length s1)


-- another brute-force approach:
subStrings2 :: String -> [String]
subStrings2 s = concat [extractN n s | n <- reverse [1..length s]] ++ [""]
    where extractN n s | n > length s = []
		       | otherwise = take n s : (extractN n (tail s))


-- a trickier direct way
subStrings3 :: String -> [String]
subStrings3 s = f [s]
  where f ("":_) = [""]
        f ss@(s:_) = ss ++ f ((init s):(map tail ss))

-- #2

squareRoot :: Float -> Float
squareRoot x = limit (iterate next_a 1.0)
     where next_a a = (a + x/a) / 2
           limit (x1:x2:xs) | abs (x1 - x2) < epsilon = x2
                            | otherwise = limit (x2:xs)
	   epsilon = 1.0e-7


-- #3

data Tree a = Leaf a | Branch (Tree a) (Tree a)
  deriving Show

foldTree :: (a -> a -> a) -> (b -> a) -> Tree b -> a
foldTree bop lop (Leaf a) = lop a
foldTree bop lop (Branch l r) = bop (foldTree bop lop l) (foldTree bop lop r)

fringe :: Tree a -> [a]
fringe = foldTree (++) (:[])
 

treeSize :: Tree a -> Int
treeSize = foldTree (+) (const 1)

treeHeight :: Tree a -> Int
treeHeight = foldTree bop (const 0)
       where bop lval rval = 1 + max lval rval


-- a few others:

sumTree :: Tree Int -> Int
sumTree = foldTree (+) id

mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f = foldTree Branch (Leaf . f)

mirrorTree :: Tree a -> Tree a
mirrorTree = foldTree (flip Branch) Leaf

t1 :: Tree Int
t1 = Branch (Branch (Leaf 1) (Leaf 2)) (Branch (Branch (Leaf 3) (Leaf 4)) (Leaf 5))

-- #4 

data InternalTree a = ILeaf | IBranch a (InternalTree a) (InternalTree a)
  deriving Show

zipTWith :: (a -> b -> c) -> InternalTree a -> InternalTree b -> InternalTree c
zipTWith f (IBranch a al ar) (IBranch b bl br) = 
                 IBranch (f a b) (zipTWith f al bl) (zipTWith f ar br)
zipTWith f _ _ = ILeaf

zipT :: InternalTree a -> InternalTree b -> InternalTree (a,b)
zipT = zipTWith (,)


-- #5

data Expr = C Float | V String | Expr :+ Expr | Expr :- Expr |
	    Expr :* Expr | Expr :/ Expr | Let String Expr Expr
  deriving Show


evaluate :: Expr -> Float
evaluate = evaluate' [] 
  where evaluate' env (C x) = x
	evaluate' env (V s) = case lookup s env of
			        Just v -> v
                                Nothing -> error "undefined variable"
        evaluate' env (e1 :+ e2) = evaluate' env e1 + evaluate' env e2
        evaluate' env (e1 :- e2) = evaluate' env e1 - evaluate' env e2
        evaluate' env (e1 :* e2) = evaluate' env e1 * evaluate' env e2
        evaluate' env (e1 :/ e2) = evaluate' env e1 / evaluate' env e2
	evaluate' env (Let s e1 e2) = 
                    let v = evaluate' env e1 in evaluate' ((s,v):env) e2

-- #6

infixr 5 `Union`
infixr 6 `Intersect`

-- A Region is either:
data Region = Shape Shape		-- primitive shape
            | Translate Vector Region -- translated region
            | Scale     Vector Region -- scaled region
            | Complement Region	-- inverse of region
            | Region `Union` Region   -- union of regions
            | Region `Intersect` Region -- intersection of regions
	    | HalfPlane Coordinate Coordinate  -- half plane left of p1->p2
            | Empty                   -- empty region
     deriving Show

type Vector = (Float,Float)
type Coordinate = (Float,Float)

isLeftOf :: Coordinate -> Ray -> Bool
(px,py) `isLeftOf` ((ax,ay),(bx,by))
       = let (s,t) = (px-ax, py-ay)
             (u,v) = (px-bx, py-by)
         in  s*v >= t*u
type Ray = (Coordinate, Coordinate)

containsR :: Region -> Coordinate -> Bool
(Shape s) `containsR` p
   = s `containsS` p
(Translate (u,v) r) `containsR` (x,y)
   = let p = (x-u,y-v) in r `containsR` p
(Scale (u,v) r) `containsR` (x,y)
   = let p = (x/u,y/v) in r `containsR` p
(Complement r) `containsR` p 
   = not (r `containsR` p)
(r1 `Union` r2)     `containsR` p
   = r1 `containsR` p || r2 `containsR` p
(r1 `Intersect` r2) `containsR` p
   = r1 `containsR` p && r2 `containsR` p
(HalfPlane p1 p2) `containsR` p
   = p `isLeftOf` (p1,p2)
Empty `containsR` p 
   = False

containsS :: Shape -> Coordinate -> Bool
(Rectangle s1 s2) `containsS` (x,y)
   = let t1 = s1/2; t2 = s2/2
     in (-t1<=x) && (x<=t1) && (-t2<=y) && (y<=t2)
(Ellipse r1 r2) `containsS` (x,y)
   = (x/r1)^2 + (y/r2)^2 <= 1
(Polygon pts) `containsS` p
   = let leftOfList = map (isLeftOf p) 
                          (zip pts (tail pts ++ [head pts]))
     in and leftOfList
(RtTriangle s1 s2) `containsS` p
   = (Polygon [(0,0),(s1,0),(0,s2)]) `containsS` p

univ = Complement Empty

-- as usual, assume coordinates are given in counter-clockwise order.
polygon :: [Coordinate] -> Region
polygon pts = foldr Intersect univ (zipWith HalfPlane pts (tail pts ++ [head pts]))


-- for quickcheck
prop_poly pts c = containsR (Shape (Polygon pts)) c == containsR (polygon pts) c

-- #7

type Dict a b = a -> Maybe b
empty :: Dict a b
empty = f where f _ = Nothing
find :: Dict a b -> a -> Maybe b
find d a = d a
insert :: Eq a => Dict a b -> a -> b -> Dict a b
insert d a b = f 
    where f a' | a == a' = Just b
               | otherwise = d a'