1日1個 @nabetani さんの作った問題を解くAdventCalendarの14日目です。

今日の問題は http://nabetani.sakura.ne.jp/hena/ord14crosscircle/ にあります。

module Doukaku.CrossCircle (solve) where

solve :: String -> String
solve = show . (`div` 2) . sum . map (uncurry countPoints) . searchLines

countPoints :: Eq a => [a] -> [a] -> Int
countPoints [] _ = 0
countPoints (x:xs) ys = (+ countPoints xs ys) . length . filter (== x) $ ys

searchLines :: Eq a => [a] -> [([a], [a])]
searchLines = searchLines' []

searchLines' :: Eq a => [a] -> [a] -> [([a], [a])]
searchLines' _ [] = []
searchLines' ds (x:xs) = (searchLines'' [] x xs ds) ++ searchLines' (x:ds) xs

searchLines'' :: Eq a => [a] -> a -> [a] -> [a] -> [([a], [a])]
searchLines'' _ _ [] _ = []
searchLines'' ds t0 (t:ts) cp
  | t == t0   = (ds, ts ++ cp) : tails
  | otherwise = tails
  where
    tails = searchLines'' (t:ds) t0 ts cp

題意を素直に式に直しただけなので計算量的に無理かと思いましたが、そうでもありませんでした。searchLinesで円上の直線を列挙します。ただし、直線は、直線の一方にある点の集合と他方にある点の集合の２つの集合によって表します。countPointsは直線上にできる交点の数を求めます。直線の左右の集合に同じ名前の点があれば交点が一個できますので、その数を数えているだけです。

この方法だと直線ごとに交点を数えるので一つの交点につき2回カウントしています。なので、最後に2で割る必要があります。

http://qiita.com/Nabetani/items/66806c9dc14a96f2fd42 に他の方の回答もありますので、見ると参考になるでしょう。