Testsuite: delete Windows line endings [skip ci] (#11631)
[ghc.git] / testsuite / tests / rts / T2047.hs
1 module Main where
2
3 import qualified Data.Set as Set
4 import Control.Monad
5 import Data.List
6
7 ---
8 ---
9 ---
10
11 data Direction = DirUp | DirLeft | DirRight | DirDown
12 deriving (Eq,Ord,Show,Read)
13
14 directions = [DirUp,DirLeft,DirRight,DirDown]
15
16 coordOffset DirUp = (-1,0)
17 coordOffset DirLeft = (0,-1)
18 coordOffset DirRight = (0,1)
19 coordOffset DirDown = (1,0)
20
21 move (r,c) d = (r+dr,c+dc) where (dr,dc) = coordOffset d
22
23 sortPair (x,y) =
24 case compare x y of
25 EQ -> (x,y)
26 LT -> (x,y)
27 GT -> (y,x)
28 mapPair12 f (x,y) = (f x,f y)
29
30 cachedUsingList f = f'
31 where
32 list = map f [0..]
33 f' i = list !! i
34
35 nubSorted [] = []
36 nubSorted (x:xs) = nubSorted' x xs
37 where
38 nubSorted' x [] = [x]
39 nubSorted' x (y:ys)
40 | x == y = nubSorted' x ys
41 | otherwise = x : nubSorted' y ys
42
43 ---
44 ---
45 ---
46
47 size = 21
48 largestExplicitlyEnumeratedArea = 7
49
50 type Cell = (Int,Int)
51 type Edge = (Cell,Cell)
52
53 mkEdge cell1 cell2 = sortPair (cell1,cell2)
54
55 cellsAround area = nubSorted $ sort $
56 do
57 cell <- area
58 dir <- directions
59 let cell2 = move cell dir
60 guard $ cell2 `notElem` area
61 return $ cell2
62
63 increaseAreas areas = nubSorted $ sort $
64 do
65 area <- areas
66 cell2 <- cellsAround area
67 return $ sort $ cell2 : area
68 getAreas :: Int -> [[Cell]]
69 getAreasRaw 1 = [[(0,0)]]
70 getAreasRaw n = areas
71 where
72 areas = increaseAreas $ getAreas $ n - 1
73 getAreas = cachedUsingList getAreasRaw
74
75 getEdges area = mapPair12 (map snd) $ partition fst $ nubSorted $ sort $
76 do
77 cell <- area
78 dir <- directions
79 let cell2 = move cell dir
80 let isInternal = cell2 `elem` area
81 return (isInternal,mkEdge cell cell2)
82
83 type SizedArea = (Int,((Set.Set Cell,Set.Set Cell),(Set.Set Edge,Set.Set Edge)))
84 getExtendedAreas n =
85 do
86 area <- getAreas n
87 let areaAround = cellsAround area
88 let edgeInfo = getEdges area
89 return ((Set.fromList area,Set.fromList areaAround),mapPair12 Set.fromList edgeInfo)
90
91 getSizedAreasThrough :: Int -> [SizedArea]
92 getSizedAreasThrough n =
93 do
94 n' <- [1 .. n]
95 extendedArea <- getExtendedAreas n'
96 return $ (n',extendedArea)
97
98 sizeForSizedArea (asize,_) = asize
99 allSizedAreas = getSizedAreasThrough largestExplicitlyEnumeratedArea
100
101 main = print $ allSizedAreas
102