Shape.hs

-- givens and exercises from Ch 2 of Haskell School of Expression
--
module Shape (Shape (Rectangle, Ellipse, RightTriangle, Polygon),
              Radius, Side, Vertex,
              square, circle, distBetween, area
             ) where
              

data Shape = Rectangle Side Side
           | Ellipse Radius Radius
           | RightTriangle Side Side
           | Polygon [Vertex]
  deriving Show

type Radius = Float
type Side   = Float
type Vertex = (Float, Float)

twopi = pi * 2

square s = Rectangle s s
circle r = Ellipse r r

-- 2.1

rectangle h w = Polygon [(0,0),(0,w),(h,w),(h,0)]
rightTriangle h w = Polygon [(0,0),(0,w),(h,0)]

-- 2.2

regularPolygon n s = Polygon (map make [1 .. n])
  where make i = (radius * cos angle i, radius * sin angle i)
        radius = s / (2 * sin size)
        angle i = fromIntegral (2 * i) * size
        size = pi / fromIntegral n


area (Rectangle s1 s2) = s1 * s2
area (RightTriangle s1 s2) = s1 * s2 / 2
area (Ellipse r1 r2) = pi * r1 * r2

area (Polygon (v1:vs)) = polyArea vs
  where polyArea :: [Vertex] -> Float
        polyArea (v2:v3:vs') = triArea v1 v2 v3
                             + polyArea (v3:vs')
        polyArea _ = 0
area (Polygon _)   = 0



-- HORRENDOUS! Somewhere along the line I broke this so badly it infini-loops now
-- I don't really even care about poor performing or whatever
-- The idea is that:
-- windowed 2 "abcd" -> ["ab","bc","cd","da"]
-- windowed 3 "abcd" -> ["abc","bcd","cda","dab"]
windowed :: Int -> [a] -> [[a]]
windowed _ [] = []
windowed n list = chunker n list
  where 
    chunk = take n list
    chunker n stuff =
      let start = take n stuff
          l = length start
      in 
        if l < n then
          start : take (n-l) chunk : (chunker n (drop 1 stuff))
        else
          start : (chunker n (drop 1 stuff))


-- Exercise 2.4 - determine convexity of a shape

convex :: Shape -> Bool
convex (Polygon vs) = allSame
  where allSame = all (> 0.0) products || all (< 0.0) products
        -- TODO: I have no idea how to 'wrap' the list of vertexes and 
        -- partition them in threes so I can then simply map cross over that list
        v1:v2:v3:vs' = vs
        products = [ cross v1 v2 v3 ] --map cross vs???

        cross :: Vertex -> Vertex -> Vertex -> Float
        cross (x1,y1) (x2,y2) (x3,y3) = 
          (x2 - x1) * (y3 - y2) -
          (y2 - y1) * (x3 - x2)

convex _ = False


triArea v1 v2 v3 =
  let a = distBetween v1 v2
      b = distBetween v2 v3
      c = distBetween v3 v1
      s = 0.5 * (a + b + c)
  in sqrt (s * (s - a) * (s - b) * (s - c))

distBetween (x1,y1) (x2,y2) =
  sqrt ((x1-x2)^2 + (y1-y2)^2)


-- Exercise 2.5 - compute area with quadrants in the plane
-- compute areas, positive if the x increases, negative if it decreases

-- Note: probably wrong if the poly isn't all in the positive quadrant of the plane?

quadArea (Polygon list) =
  sum areas
  where 
        points = list ++ [head list]
        -- TODO: Again, I don't know how to generate the areas from the points, I need to
        -- turn points into a sliding window
        areas = [4.0, 2.0, -1.0]
        trapArea (x1,y1) (x2,y2) = 
          let h = x2 - x1 
          in 0.5 * h * (y1 + y2)