第19回 オフラインリアルタイムどう書くの問題「不良セクタの隣」を、Haskellで解く

第19回 オフラインリアルタイムどう書くの問題「不良セクタの隣」を、Haskellで解きました。

sectors.hs

import Data.Ratio
import Data.List

hasIntersect :: (Ratio Int, Ratio Int, Int) -> (Ratio Int, Ratio Int, Int) -> Bool
hasIntersect (fst_a,snd_a,_) (fst_b,snd_b,_) = (fst_a<=snd_b && fst_b <=snd_a) || (fst_b <=snd_a && snd_a<=snd_b)

ranges n = take (8*n+2) $ [(low,up,n*100+(m `mod` (8*n))) | m<-[-1..], let w=(1%(8*n)), let low=(-w/2+(w*(m%1))), let up=low+w]

inRange n m = filter $ hasIntersect (ranges n !! (m+1))

neighbor' n m = (ranges n !! (m+1-1)) : (ranges n !! (m+1+1)) : neighbor'' n m
 where
   neighbor'' n m
     | n <= 1 = nub $ (inRange n m (ranges $ n+1))
     | n == 4 = nub $ (inRange n m (ranges $ n-1))
     | otherwise = nub ((inRange n m (ranges $ n-1)) ++
                        (inRange n m (ranges $ n+1)))

neighbor n = neighbor' (n `div` 100) (n `mod` 100)

reserved xs = map (!!0) $ filter (\ x -> length x > 1) $ group $ sort $ filter (\x->not (x `elem` xs)) $ map (\(_,_,n)->n) $ concatMap neighbor xs

test :: [Int] -> [Int] -> IO()
test s1 s2 = do
   putStrLn $ show $ reserved s1 == s2

main = do
   test [400,401,302] [300,301,402] {- 0 -}
   test [105,100,306,414] [] {- 1 -}
   test [100] [] {- 2 -}
   test [211] [] {- 3 -}
   test [317] [] {- 4 -}
   test [414] [] {- 5 -}
   test [100,106] [107] {- 6 -}
   test [205,203] [102,204] {- 7 -}
   test [303,305] [304] {- 8 -}
   test [407,409] [306,408] {- 9  -}
   test [104,103] [207] {- 10  -}
   test [204,203] [102,305]     {- 11  -}
   test [313,314] [209,418]     {- 12  -}
   test [419,418] [314]     {- 13  -}
   test [100,102,101] [201,203]     {- 14  -}
   test [103,206,309] [205,207,308,310]     {- 15  -}
   test [414,310,309] [206,311,413]     {- 16  -}
   test [104,102,206,307,102,202] [101,103,203,204,205,207,308]     {- 17  -}
   test [104,206,308,409,407] [103,205,207,306,307,309,408,410]     {- 18  -}
   test [313,406,213,301,409,422,412,102,428] []     {- 19  -}
   test [101,300,210,308,423,321,403,408,415] []     {- 20  -}
   test [304,316,307,207,427,402,107,431,412,418,424] []     {- 21  -}
   test [205,408,210,215,425,302,311,400,428,412] []     {- 22  -}
   test [200,311,306,412,403,318,427,105,420] []     {- 23  -}
   test [105,305,407,408,309,208,427] [104,209,306,406]     {- 24  -}
   test [311,304,322,404,429,305,316] [203,303,321,405,406,430]     {- 25  -}
   test [210,401,316,425,101] [211,315]     {- 26  -}
   test [414,403,404,416,428,421] [303,415]     {- 27  -}
   test [207,300,103,211,428] [104,206]     {- 28  -}
   test [322,314,310] []     {- 29  -}
   test [427,200,215] [100,323]     {- 30  -}
   test [311,402,424,307,318,430,323,305,201] [200,204,301,302,306,322,423,425,431]     {- 31  -}
   test [425,430,408] []     {- 32  -}
   test [202,320,209,426] [319,427]     {- 33  -}
   test [430,209,302,310,304,431,320] [202,303,323]     {- 34  -}
   test [208,206,406,424,213,312] [207,311,313]     {- 35  -}
   test [420,302,313,413,317,402] [301,403]     {- 36  -}
   test [319,306,309,418,204,411] [305,307,308,412]     {- 37  -}
   test [400,308,105,430,203,428,209] [104,210,429,431]     {- 38  -}
   test [200,305,214] [215]     {- 39  -}
   test [214,408,410,407,317,422] [306,316,409,423] {- 40  -}