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
| 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 )
distPoints :: ( Num a , Ord a ) => Point a -> Point a -> a
distPoints ( P x1 y1 ) ( P x2 y2 ) = ( x1 x2 ) ^ 2 + ( y1 y2 ) ^ 2
rotCal :: ( Num a , Ord a , Floating a ) => Array Int ( Point a ) -> a -> Int -> Int -> Vector a -> Vector a -> a -> Int -> a
rotCal arr ang pa pb ca@( V ax ay ) cb@( V bx by ) dia n
| ang > pi = dia
| otherwise = rotCal arr ang' pa' pb' ca' cb' dia' 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 )
t1 = angVectors ca ( V ( x2 x1 ) ( y2 y1 ) )
t2 = angVectors cb ( V ( x4 x3 ) ( y4 y3 ) )
ca' = rotVector ca $ min t1 t2
cb' = rotVector cb $ min t1 t2
ang' = ang + min t1 t2
( pa' , pb' ) = if t1 < t2 then ( mod ( pa + 1 ) n , pb ) else ( pa , mod ( pb + 1 ) n )
dia' = max dia $ distPoints ( arr ! pa' ) ( arr ! pb' )
solve :: ( Num a , Ord a , Floating a ) => [ Point a ] -> a
solve [] = 0
solve [ p ] = 0
solve [ p1 , p2 ] = distPoints p1 $ p2
solve arr = rotCal arr' 0 pa pb ( V 1 0 ) ( V (1) 0 ) dia n where
y1 = minimumBy ( on compare fN ) arr
y2 = maximumBy ( on compare fN ) arr
pa = fromJust . findIndex ( == y1 ) $ arr
pb = fromJust . findIndex ( == y2 ) $ arr
dia = distPoints ( arr !! pa ) ( arr !! pb )
n = length arr
arr' = listArray ( 0 , n ) arr
fN ( P x y ) = y
final :: ( Num a , Ord a , Floating a ) => [ Point a ] -> a
final [] = 0
final [ p ] = 0
final [ p1 , p2 ] = distPoints p1 $ p2
final arr = solve . convexHull $ arr
format :: ( Num a , Ord a , Floating a ) => [ Int ] -> [ [ Point a ]]
format [] = []
format (x:xs ) = t : format b where
( a , b ) = splitAt ( 2 * x ) xs
t = helpFormat a where
helpFormat [] = []
helpFormat ( x' : y' : xs' ) = ( P ( fromIntegral x' ) ( fromIntegral y' ) ) : helpFormat xs'
readD :: BS.ByteString -> Int
readD = fst . fromJust . BS.readInt
main = BS.interact $ BS.unlines . map ( BS.pack . ( printf "%.0f" :: Double -> String ) .final ) . format . concat . map ( map readD . BS.words ) . tail . BS.lines
|