1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
module Shape
( Shape
, area
, square
, circle
, polygon
)
where
data Shape = Rectangle Side Side
| Ellipse Radius Radius
| RtTriangle Side Side
| Polygon [Vertex]
deriving Show
type Radius = Float
type Side = Float
type Vertex = (Float, Float)
polygon :: [Vertex] -> Shape
polygon vs = Polygon vs
area :: Shape -> Float
area (Rectangle s1 s2 ) = s1 * s2
area (RtTriangle s1 s2 ) = s1 * s2 / 2
area (Ellipse r1 r2 ) = pi * r1 * r2
area (Polygon vs)
| length vs <= 2 = 0
| otherwise = polyArea (vs ++ [head vs])
where polyArea :: [Vertex] -> Float
polyArea (v1: v2: vs') = trapezoidArea v1 v2 + polyArea (v2:vs')
polyArea _ = 0
trapezoidArea :: Vertex -> Vertex -> Float
trapezoidArea v1 v2 =
let h = fst v2 - fst v1
aplusb = snd v2 + snd v1
in (aplusb / 2) * h
triArea :: Vertex -> Vertex -> Vertex -> Float
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 :: Vertex -> Vertex -> Float
distBetween (x1, y1) (x2, y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
circle :: Radius -> Shape
circle r = Ellipse r r
convex :: Shape -> Bool
convex (Rectangle a b ) = True
convex (RtTriangle a b ) = True
convex (Ellipse r1 r2) = True
convex (Polygon [_, _, _]) = True
convex (Polygon (vfirst : vsecond : vthird : vs)) = False
crossProduct :: Vertex -> Vertex -> Vertex -> Float
crossProduct (x1, y1) (x2, y2) (x3, y3) = (x2 - x1) * (y3 - y2) - (y2 - y1) * (x3 - x2)
square :: Side -> Shape
square s = Rectangle s s
rectangle :: Side -> Side -> Shape
rectangle s1 s2 = Polygon [(x, y), (-x, y), (-x, -y), (x, -y)]
where
x = s1 / 2
y = s2 / 2
regularPolygon :: Int -> Side -> Shape
regularPolygon n s =
let
angleinc = (pi * 2) / fromIntegral n
radius = (s * sin ((pi - angleinc) / 2)) / sin angleinc
regularVerts 0 _ = []
regularVerts n angle =
(radius * cos angle, radius * sin angle) : regularVerts
(n - 1)
(angle + angleinc)
in
Polygon (regularVerts n 0)
rtTriangle :: Side -> Side -> Shape
rtTriangle s1 s2 = Polygon [(0, 0), (s1, 0), (0, s2)]
|
