オフラインリアルタイムどう書くの過去問を解きながらHaskellの勉強中です。

ということで、第14回オフラインリアルタイムどう書くの参考問題をHaskellで書きました。

問題の詳細はhttp://nabetani.sakura.ne.jp/hena/ord14crosscircle/です。

方針は至って単純です。

入力文字列を点のリストに変換
点のリストから全ての線を作る
全ての線の組に対して交差するかチェックして、交差すればカウントアップ

circle.hs

import Control.Applicative

--点を表すデータ型
data Point = Point { name :: Char, no :: Int }
mkPoint :: Char -> Int -> Point
mkPoint c n = Point { name = c , no = n }

instance Ord Point where
	compare x y = compare (no x) (no y)

instance Eq Point where
	x == y = (name x) == (name y) && (no x) == (no y)

instance Show Point where
	show p = (name p) : show (no p)


--線を表すデータ型
data Line = Line { from :: Point, to :: Point }
mkLine :: Point -> Point -> Line
mkLine x y = Line { from = x, to = y }

instance Eq Line where
	x == y = ((from x) == (from y) && (to x) == (to y)) || (from x) == (to y) && (to x) == (from y)

instance Show Line where
		show l = show (from l) ++ "-" ++ show (to l)

--線が交差するか判定
cross :: Line -> Line -> Bool
cross x y = (from x) < (from y) && (to x) > (from y) && (to x) < (to y) || (from y) < (from x) && (to y) > (from x) && (to y) < (to x)

--入力文字列を点のリストに変換
stringToPoints :: String -> [Point]
stringToPoints str = zipWith (\c n -> mkPoint c n) str [1..]

--点のリストから線のリストを作る
pointsToLines :: [Point] -> [Line]
pointsToLines [] = []
pointsToLines (x:xs) = concatMap (mkLine' x) xs ++ pointsToLines xs
	where
		mkLine' :: Point -> Point -> [Line]
		mkLine' p1 p2 | (name p1) == (name p2) = [mkLine p1 p2]
		              | otherwise = []

--線のリストから交点の数を返す
countCrossLines :: [Line] -> Int
countCrossLines [] = 0
countCrossLines (x:xs) = foldl (countup x) 0 xs + countCrossLines xs
	where
		countup :: Line -> Int -> Line -> Int
		countup l1 n l2 | cross l1 l2 = n + 1
		                | otherwise = n

solve :: String -> String
solve = show . countCrossLines . pointsToLines . stringToPoints


main = do
    tests <- map words <$> lines <$> getContents
    mapM (\t -> print $ runTest solve t) tests
    where
        runTest f t = f (head t) == last t

テストデータ

test.txt

aabbca1bcb	14	
111ZZZ	0	
v	0	
ww	0	
xxx	0	
yyyy	1	
zzzzz	5	
abcdef	0	
abcaef	0	
abbaee	0	
abcacb	2	
abcabc	3	
abcdabcd	6	
abcadeabcade	23	
abcdeedcba	0	
abcdeaedcba	8	
abcdeaedcbad	16	
QQQQXXXX	2	
QwQQmQXmXXwX	14	
111222333	0	
aaAAaA	4	
121232313	12	
1ab1b	1	
abcdefbadcfe	12	
abxcdefbadcfex	14	
dtnwtkt	0	
mvubvpp	0	
moggscd	0	
kzkjzpkw	2	
fbifybre	1	
rrrfjryki	1	
wrbbdwsdwtx	2	
vvucugvxbvgx	9	
ojkjzyasjwbfjj	5	
ggffyuxnkyypifff	5	
vcgtcqlwrepwvkkogl	4	
xeqtmmgppwcjpcisogxbs	4	
lukltpeucrqfvcupnpxwmoj	6	
zpzswlkkoqwwndwpfdpkhtzgtn	31	
bkfeflagfvluelududqjcvfyvytfw	45	
rvqbhfmcjjqlpqzulzerxgyowiwrfkmhw	26	
qyxvpdtoeexbqsethwjwmqszcxxjnsdoeaet	144	
rjmsgmswhcolmpbhmpncziymydyalrcnevsrespj	133	
oxetnyjzjbysnwktfwzndlejfndsqeetsnjvsicyjehd	395	
wzvddnddzogywcqxbyvagbzmsmtcmrrlbnebmvhaemjouaqim	219	
karhphxcxqgsyorhusbumbqzocuzvnwzwcpxgsksrviihxrgsrhji	461	
oxgbononhqdxzmkysgijwvxljpaazmgkurkpffeuwywwuyxhyfkicgyzyc	441	
sdgsrddwsrwqthhdvhrjhgtxwgurgyiygtktgtughtogzaqmcafkljgpniddsvb	1077	
qemhecchkgzhxmdcsltwhpoyhkapckkkzosmklcvzkiiucrvzzznmhjfcdumuflavxik	1711	
ffqmsirwpxrzfkbvmmfeptkbhnrvfcywthkwkbycmayhhkgvuyecbwwofwthlmzruphrcujwhr	2440

他の過去問も解いています。（解けそうな問題から書いてます。。。汗）