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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
| import Data.List
import Data.Array
import Data.Maybe
import Data.Function
import Text.Printf
import qualified Data.ByteString.Char8 as BS
data Point a = P a a deriving ( Show , Ord , Eq )
data Vector a = V a a deriving ( Show , Ord , Eq )
data Turn = S | L | R deriving ( Show , Eq , Ord , Enum )
compPoint :: ( Num a , Ord a ) => Point a -> Point a -> Ordering
compPoint ( P x1 y1 ) ( P x2 y2 )
| compare x1 x2 == EQ = compare y1 y2
| otherwise = compare x1 x2
findMinx :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ]
findMinx xs = sortBy ( \x y -> compPoint x y ) xs
compAngle ::(Num a , Ord a ) => Point a -> Point a -> Point a -> Ordering
compAngle ( P x1 y1 ) ( P x2 y2 ) ( P x0 y0 ) = compare ( ( y1 y0 ) * ( x2 x0 ) ) ( ( y2 y0) * ( x1 x0 ) )
sortByangle :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ]
sortByangle (z:xs) = z : sortBy ( \x y -> compAngle x y z ) xs
findTurn :: ( Num a , Ord a , Eq a ) => Point a -> Point a -> Point a -> Turn
findTurn ( P x0 y0 ) ( P x1 y1 ) ( P x2 y2 )
| ( y1 y0 ) * ( x2 x0 ) < ( y2 y0 ) * ( x1 x0 ) = L
| ( y1 y0 ) * ( x2 x0 ) == ( y2 y0 ) * ( x1 x0 ) = S
| otherwise = R
findHull :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ] -> [ Point a ]
findHull [x] ( z : ys ) = findHull [ z , x ] ys
findHull xs [] = xs
findHull ( y : x : xs ) ( z : ys )
| findTurn x y z == R = findHull ( x : xs ) ( z:ys )
| findTurn x y z == S = findHull ( x : xs ) ( z:ys )
| otherwise = findHull ( z : y : x : xs ) ys
convexHull ::( Num a , Ord a ) => [ Point a ] -> [ Point a ]
convexHull xs = reverse . findHull [ y , x ] $ ys where
( x : y : ys ) = sortByangle . findMinx $ xs
angVectors :: ( Num a , Ord a , Floating a ) => Vector a -> Vector a -> a
angVectors ( V ax ay ) ( V bx by ) = theta where
dot = ax * bx + ay * by
a = sqrt $ ax ^ 2 + ay ^ 2
b = sqrt $ bx ^ 2 + by ^ 2
theta = acos $ dot / a / b
rotVector :: ( Num a , Ord a , Floating a ) => Vector a -> a -> Vector a
rotVector ( V x y ) t = V ( x * cos t y * sin t ) ( x * sin t + y * cos t )
distVec :: ( Num a , Ord a , Floating a ) => Vector a -> Vector a -> a
distVec ( V x1 y1 ) ( V x2 y2 ) = sqrt $ ( x1 x2 ) ^ 2 + ( y1 y2 ) ^ 2
rotCal :: ( Num a , Ord a , Floating a ) => Array Int ( Point a ) -> a -> [ Int ] -> [ Vector a ] -> a -> Int -> a
rotCal arr ang [ pa , pb , qa , qb] [ cpa , cpb , cqa , cqb ] area n
| 2 * ang > pi = area
| otherwise = rotCal arr ang' [ pa' , pb' , qa' , qb' ] [ cpa' , cpb' , cqa' , cqb' ] area' n where
P x1 y1 = arr ! pa
P x2 y2 = arr ! ( mod ( pa + 1 ) n )
P x3 y3 = arr ! pb
P x4 y4 = arr ! ( mod ( pb + 1 ) n )
P x5 y5 = arr ! qa
P x6 y6 = arr ! ( mod ( qa + 1 ) n )
P x7 y7 = arr ! qb
P x8 y8 = arr ! ( mod ( qb + 1 ) n )
t1 = angVectors cpa ( V ( x2 x1 ) ( y2 y1 ) )
t2 = angVectors cpb ( V ( x4 x3 ) ( y4 y3 ) )
t3 = angVectors cqa ( V ( x6 x5 ) ( y6 y5 ) )
t4 = angVectors cqb ( V ( x8 x7 ) ( y8 y7 ) )
t = minimum [ t1 , t2 , t3 , t4 ]
cpa' = rotVector cpa t
cpb' = rotVector cpb t
cqa' = rotVector cqa t
cqb' = rotVector cqb t
ang' = ang + t
( pa' , pb' , qa' , qb' ) = fN [ t1 , t2 , t3 , t4 ] t where
fN [ t1 , t2 , t3 , t4 ] t
| t == t1 = ( mod ( pa + 1 ) n , pb , qa , qb )
| t == t2 = ( pa , mod ( pb + 1 ) n , qa , qb )
| t == t3 = ( pa , pb , mod ( qa + 1 ) n , qb )
| otherwise = ( pa , pb , qa , mod ( qb + 1 ) n )
width = distVec cpa' cpb'
length = distVec cqa' cqb'
area' = min area $ length * width
solve :: ( Num a , Ord a , Floating a ) => [ Point a ] -> a
solve [] = 0
solve [ p ] = 0
solve [ p1 , p2 ] = 0
solve [ p1 , p2 , p3 ] = 0
solve arr = rotCal arr' 0 [ pa , pb , qa , qb ] [ cpa , cpb , cqa , cqb ] area n where
y1 = minimumBy ( on compare fN1 ) arr
y2 = maximumBy ( on compare fN1 ) arr
x1 = minimumBy ( on compare fN2 ) arr
x2 = maximumBy ( on compare fN2 ) arr
pa = fromJust . findIndex ( == y1 ) $ arr
pb = fromJust . findIndex ( == y2 ) $ arr
qa = fromJust . findIndex ( == x1 ) $ arr
qb = fromJust . findIndex ( == x2 ) $ arr
cpa = V 1 0
cpb = V ( 1 ) 0
cqa = V 0 ( 1 )
cqb = V 0 1
area = 1e9
n = length arr
arr' = listArray ( 0 , n ) arr
fN1 ( P x y ) = y
fN2 ( P x y ) = x
final :: ( Num a , Ord a , Floating a ) => [ Point a ] -> a
final [] = 0
final [ p ] = 0
final [ p1 , p2 ] = 0
final [ p1 , p2 , p3 ] = 0
final arr = solve . convexHull $ arr
|