ツリーの中の距離 ref: http://qiita.com/nobsun/items/8a221f312db34cece78f

E11.hs

{-# LANGUAGE FlexibleContexts #-}
module E11 where

import Data.List
import Data.Ord
import qualified Data.Set as S
import Data.Tree
import Math.NumberTheory.ArithmeticFunctions

type NodeID = Int
type Path   = [NodeID]

data Label = Label { nodeID :: NodeID
                   , label  :: Int
                   , path   :: Path
                   } deriving (Eq,Show)

childSeeds :: Int -> [Int]
childSeeds = map succ . init . tail . S.elems . divisors

gentree :: (Int,Int,Int) -> (NodeID, Path, [Path], [Path]) -> (Tree Label, (NodeID, Path, [Path], [Path]))
gentree (n,s,e) (nid,pth,ss,ts) = (Node (Label nid n pth) children, (nid1, pth, ss2, ts2))
  where
    ss2 = if n == s then (nid:pth) : ss1 else ss1
    ts2 = if n == e then (nid:pth) : ts1 else ts1
    ((nid1,ss1,ts1),children) = mapAccumL gen (nid,ss,ts) $ childSeeds n
    gen (nid',ss',ts') n' = case gentree (n',s,e) (succ nid',nid:pth,ss',ts') of
      (t,(nid'',_,ss'',ts'')) -> ((nid'',ss'',ts''),t)

paths :: (Tree Label, (NodeID, Path, [Path], [Path])) -> [Path]
paths (_,(_,_,ss,ts)) = [ (s `union` t) \\ (s `intersect` t) | s <- ss, t <- ts ]

check :: (Tree Label, (NodeID, Path, [Path], [Path])) -> ([Path],[Path])
check (_,(_,_,ss,ts)) =(ss,ts)

readIni :: String -> (Int,Int,Int)
readIni s = case break (':'==) s of
  (xs,_:ys) -> case break (','==) ys of
    (zs,_:ws) -> (read xs,read zs,read ws)

e11 :: Problem -> Answer
e11 = show
    . minimum
    . map length
    . paths
    . flip gentree (0,[],[],[])
    . readIni

type Problem = String
type Answer  = String

type Test = (Problem, Answer)
{- |
>>> test ( "50:6,3", "1" )
True
>>> test ( "98:5,11", "4" )
True    
>>> test ( "1000:33,20", "7" )
True    
>>> test ( "514:9,18", "8" )
True    
>>> test ( "961:5,4", "3" )
True    
>>> test ( "1369:1369,3", "2" )
True    
>>> test ( "258:16,12", "5" )
True    
>>> test ( "235:13,3", "2" )
True    
>>> test ( "1096:19,17", "8" )
True    
>>> test ( "847:7,17", "6" )
True    
>>> test ( "1932:3,5", "2" )
True    
>>> test ( "2491:4,8", "3" )
True    
>>> test ( "840:421,36", "2" )
True    
>>> test ( "1430:37,111", "3" )
True    
>>> test ( "496:17,9", "2" )
True    
>>> test ( "891:6,10", "1" )
True    
>>> test ( "1560:196,21", "2" )
True    
>>> test ( "516:20,12", "5" )
True    
>>> test ( "696:30,59", "2" )
True    
>>> test ( "1760:5,441", "2" )
True    
>>> test ( "1736:11,26", "5" )
True    
>>> test ( "1518:17,34", "4" )
True    
>>> test ( "806:63,16", "5" )
True    
>>> test ( "1920:3,97", "2" )
True    
>>> test ( "1150:13,22", "4" )
True    
>>> test ( "920:116,5", "1" )
True    
>>> test ( "2016:7,337", "2" )
True    
>>> test ( "408:9,25", "2" )
True    
>>> test ( "735:36,8", "2" )
True    
>>> test ( "470:5,31", "2" )
True    
>>> test ( "2100:12,351", "3" )
True    
>>> test ( "870:36,10", "1" )
True    
>>> test ( "1512:253,13", "2" )
True    
>>> test ( "697:12,15", "3" )
True    
>>> test ( "1224:5,14", "2" )
True    
>>> test ( "986:125,17", "3" )
True    
>>> test ( "864:12,13", "3" )
True    
>>> test ( "500:21,51", "2" )
True    
>>> test ( "819:33,21", "4" )
True    
>>> test ( "594:55,3", "2" )
True    
>>> test ( "638:17,24", "3" )
True
-}
test :: Test -> Bool
test (p,a) = e11 p == a