[Haskell] ICPC 2006 Domestic, Problem B

小さな関数を書いて繋ぎ合わせて答えを出す事にする。これもmainが書けてないのだがまぁ問題自体は解けたという事で。

まず、リストから重複を除いて整列させる関数。整列は実は重要では無いが、重複は除きたい。

-- sort & uniq
--
sortuniq :: Ord a => [a] -> [a]
sortuniq []        = []
sortuniq [x]       = [x]
sortuniq (p:xs)    = sortuniq smaller ++ [p] ++ sortuniq larger
                     where
                     smaller = [x | x <- xs, x < p]
                     larger  = [x | x <- xs, x > p]

Main> sortuniq [1,2,1,3,1,4]
[1,2,3,4]
Main> sortuniq [5,5,1,2,1,3,1,4]
[1,2,3,4,5]

次いで、電車を２つに分けたリストを作る。

-- spritStr
--
splitStr :: String -> [(String, String)]
splitStr s = map splitAtOnS [1 .. (length s - 1)]
             where
             splitAtOnS n = splitAt n s
-- splitAt :: Int -> [a] -> ([a],[a])

Main> splitStr "abcd"
[("a","bcd"),("ab","cd"),("abc","d")]

次いで、各ペアについて順序を反転するか否かで４通りづつ作る。重複があればここで除く。

-- reversePair
--
reversePair :: (String,String) -> [(String,String)]
reversePair (sa, sb) = sortuniq [(sa,sb), (sa,rsb), (rsa,sb), (rsa,rsb)]
                       where
                       rsa = reverse sa
                       rsb = reverse sb

Main> map reversePair $$
[[("a","bcd"),("a","dcb")],[("ab","cd"),("ab","dc"),("ba","cd"),("ba","dc")],[("abc","d"),("cba","d")]]
Main> concat $$
[("a","bcd"),("a","dcb"),("ab","cd"),("ab","dc"),("ba","cd"),("ba","dc"),("abc","d"),("cba","d")]

次いで、それらを連結する。

-- connectPair
--
connectPair :: (String,String) -> [String]
connectPair (sa,sb) = [sa ++ sb, sb ++ sa]


Main> map connectPair $$
[["abcd","bcda"],["adcb","dcba"],["abcd","cdab"],["abdc","dcab"],["bacd","cdba"],["badc","dcba"],["abcd","dabc"],["cbad","dcba"]]
Main> concat $$
["abcd","bcda","adcb","dcba","abcd","cdab","abdc","dcab","bacd","cdba","badc","dcba","abcd","dabc","cbad","dcba"]

次いで重複を除く。

trainPattern :: String -> [String]
trainPattern s = sortuniq $ concat $ map connectPair $ concat $ map reversePair (splitStr s)


Main> sortuniq $$
["abcd","abdc","adcb","bacd","badc","bcda","cbad","cdab","cdba","dabc","dcab","dcba"]
Main>

最後にリストの数を数える。

-- answer
--
answer :: String -> Int
answer s = length $ trainPattern s

Main> answer "aa"
1
Main> answer "abba"
6
Main> answer "abcd"
12
Main> answer "abcde"
18
Main>