-- ACM Pacific NW Region Programming Contest, 11 November 2000 -- Problem G, Color Circles -- Sergio Antoy & Michael Hanus, Tue Nov 6 08:09:20 PST 2001 -- updated: Mon Sep 23 15:22:15 PDT 2002 import Char import Read data Arrow = Arrow Int Int Int data State = State Int Int Int [Int] [Arrow] final (State c d t _ _) = c==t || d==t move (State c d t u a) -- move c to x | let X, Y, Z free in a =:= X++[Arrow c x Z]++Y & (x==d) =:= False & Z =:= u !! (d-1) = State x d t u a where x free move (State c d t u a) -- move d to x | let X, Y, Z free in a =:= X++[Arrow d x Z]++Y & (x==c) =:= False & Z =:= u !! (c-1) = State c x t u a where x free data Path = First State | Succ Path State makePath p s | noLoop p s = Succ p s where noLoop (First (State c d _ _ _)) (State x y _ _ _) = False =:= (c==x && d==y || c==y && d==x) noLoop (Succ p (State c d _ _ _)) z | let u, v, w free in z =:= State x y u v w = False =:= (c==x && d==y || c==y && d==x) &> noLoop p z where x, y free solve p = if (final s) then p else solve (makePath p (move s)) where s = last p last (First s) = s last (Succ _ s) = s shortest [] = 0 shortest [x] = count x shortest (x:y:z) = shortest ((if (count x) <= (count y) then x else y):z) count (First _) = 0 count (Succ p _) = 1 + count p doOne p = print (shortest (findall (\X -> solve (First p) =:= X))) doAll (N:R:S:T:M:desc) = if (N==0) then return () else doOne (State R S T circles (arrows arrow_desc)) >> doAll next_game where (circles,desc1) = splitAt N desc (arrow_desc,next_game) = splitAt (M*3) desc1 arrows [] = [] arrows (sc:ec:cl:ars) = (Arrow sc ec cl) : arrows ars main = do input <- readFile "g.dat" doSolve (input=:=input) -- really read input file now doAll (map readNat (words input))