ハニカム歩き(2013.5.10の過去問)

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

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

module Doukaku.Honeycomb (solve) where

type Point = (Double, Double)
type Direction = (Double, Double)

solve :: String -> String
solve = map snd . scanl (\ (p, _) d -> moveOn p d) ((0, 0), 'A') . map direct

direct :: Char -> Direction
direct '0' = (0, 1)
direct '1' = (cos (pi / 6), sin (pi / 6))
direct '2' = (cos (pi / 6), - sin (pi / 6))
direct '3' = (0, - 1)
direct '4' = (- cos (pi / 6), - sin (pi / 6))
direct '5' = (- cos (pi / 6), sin (pi / 6))

(.>.) :: Direction -> Direction -> Direction
(x, y) .>. (x', y') = (x + x', y + y')

move :: Point -> Direction -> Point
move (x, y) (dx, dy) = (x + dx, y + dy)

moveOn :: Point -> Direction -> (Point, Char)
moveOn p d = let p' = move p d
             in case whereIs p' of
               Just c -> (p', c)
               Nothing -> (p, '!')

points :: [(Point, Char)]
points = zip points' alpha
  where
    alpha = ['A' .. 'Z'] ++ ['a' .. 'k']
    circle n = reset $ concatMap (replicate n . direct) "234501"
      where
        reset [] = direct '0' : []
        reset ds = init ds ++ (last ds .>. direct '0') : []
    directions = concatMap circle [0..]
    points' = scanl move (0, 0) directions

whereIs :: Point -> Maybe Char
whereIs pt = fmap snd . head' . filter (inIt pt . fst) $ points
  where
    head' [] = Nothing
    head' xs = Just . head $ xs

inIt :: Point -> Point -> Bool
inIt (x, y) (cx, cy) = (x - cx) ^ (2 :: Int) + (y - cy) ^ (2 :: Int) < 0.5 ^ (2 :: Int)

六角のマス目を長方形のマス目にうまくマッピングして扱うのが定石ですが、あえて幾何的に解きました。
(0, 0)の座標からスタートして、1の長さずつxy平面を移動させています。
六角形に対する点の当たり判定が面倒だったので、半径0.5の円で代用しました。
余程誤差が蓄積しない限り六角形の中心付近を移動するはずですので、実用上これで十分です。

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