-- <PRE>
import Shape

len :: [a] -> Int
len [] = 0
len (x:xs) = 1 + len xs

tag1 x = (1,x)

-- Parameterized datatypes

data Option a = NONE | SOME a

pos :: Eq a => a -> [a] -> Option Int
pos a l =
  let find a [] n = NONE
      find a (x:xs) n =
          if a==x
             then SOME n
             else find a xs (n+1)
  in find a l 0

-- multiple parameterized datatypes

data Pair a b  = Pair (a,b)
data Pair2 a b  = Pair2 a b


-- Recursive datatypes

data Mylist a = Nil
              | Cons  (a,Mylist a)

-- Recursive datatypes with multiple parameters

data Twolist a b = Twonil
                 | Acons  (a,Twolist a b)
                 | Bcons  (b,Twolist a b)

append2 Twonil ys = ys
append2 (Acons(a,xs)) ys =  Acons(a,append2 xs ys)
append2 (Bcons(b,xs)) ys = Bcons(b,append2 xs ys)

rev2 Twonil = Twonil
rev2 (Acons(a,t)) = append2 (rev2 t) (Acons(a,Twonil))
rev2 (Bcons(b,t)) = append2 (rev2 t) (Bcons(b,Twonil))

-- Recursive datatypes with no parameters

data Nat = Zero | Succ  Nat
  deriving Show

toNat 0 = Zero
toNat n = Succ(toNat (n-1))

-- Functions with functions as parameters

mymap f [] = []
mymap f (x:xs) = (f x):(mymap f xs)

myfoldr op e [] = e
myfoldr op e (x:xs) =
      op x (myfoldr op e xs)

-- Polymorphism from functions as arguments

applyTwice f x = f(f x)

z f x y = (f x, f y)

concat1 :: [[a]] -> [a]
concat1 = foldr (++) []

concat2 :: [[a]] -> [a]
concat2 = foldl (++) []

-----------------------------------------------------------
-- Perimiters of Shapes
-----------------------------------------------------------

perimeter :: Shape -> Float
perimeter (Rectangle  s1 s2) = 2*(s1+s2)
perimeter (RtTriangle s1 s2) = s1 + s2 + sqrt(s1^2+s2^2)
perimeter (Polygon pts)      = foldl (+) 0 (sides pts)
perimeter (Ellipse r1 r2)
   | r1 > r2   = ellipsePerim r1 r2
   | otherwise = ellipsePerim r2 r1
   where ellipsePerim r1 r2
           = let e = sqrt (r1^2 - r2^2) / r1
                 s = scanl aux (0.25*e^2)
                             (map intToFloat [2..])
                 aux s i = nextEl e s i
                 test x = x > epsilon
                 sSum = foldl (+) 0 (takeWhile test s)
             in 2*r1*pi*(1 - sSum)



sides        :: [Vertex] -> [Side]
sides  []     = []
sides (p:pts) = aux (p:pts)
  where aux (p1:p2:pts) =  (distBetween p1 p2) : (aux (p2:pts))
        aux (pn:[])     = distBetween pn p  : []

sides2    :: [Vertex] -> [Side]
sides2 pts = zipWith distBetween pts
                (tail pts ++ [head pts])

nextEl:: Float -> Float -> Float -> Float
nextEl e s i =  s*(2*i-1)*(2*i-3)*(e^2) / (4*i^2)

epsilon :: Float
epsilon = 0.00001



intToFloat   :: Int -> Float
intToFloat  n = fromInteger (toInteger n)

-- </PRE>