オフラインリアルタイムどう書くの過去問を解きながら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
他の過去問も解いています。(解けそうな問題から書いてます。。。汗)