レイトン教授ってなによ？

id:matarillo さんが、ここ とか ここ で書いている問題を解いてみました。
基本的には枝刈りありの全数探索。
c から c' までノードを一つ一つ辿りながら、a から a' までのルートと、b から b' までのルートが残っているかを都度確かめていきます。どちらかのルートが途切れたら、探索打ち切り。
この枝刈りが強力で、実行は一瞬でした。
もう一つのポイントは探索するルートとして cc' を選んだことです。
ルート aa' とかを探索した場合、ルート bb' や cc' が個別に成り立ったとしても、同時に成り立つかは分からないので、もう一度探索しなくてはなりません。
それに対してルート cc' はルート aa' と bb' の“間に”あって、ちょっとでもブレると aa' か bb' のどちらかが途切れてしまうので、解を一気に絞り込めます。（答えを知ってからやってるのでちょっとズルい気もしますが）

import Data.List

type Vertex = Int
type Graph = [[Vertex]]

main = print $ search graph 17

graph :: Graph
graph = [[0,1],[0,10],[0,21],[1,2],[1,28],[2,3],[2,6],[3,4],[4,5],[4,8],[5,6],
    [5,7],[6,11],[7,14],[8,9],[8,10],[9,16],[10,29],[11,14],[11,28],[12,13],[12,20],
    [12,27],[13,14],[13,19],[15,16],[15,18],[15,29],[16,17],[17,18],[18,26],[19,22],
    [19,28],[20,22],[20,25],[21,24],[21,29],[22,23],[23,24],[24,25],[25,26],[26,27]]

search :: Graph -> Vertex -> [[Vertex]]
search es 7 = [[7]]
search es c = map (c :) $ concat [ search es' c' |
    let (e, es') = partition (elem c) es,
    connected es' 23 9,
    connected es' 27 3,
    c' <- filter (/= c) $ concat e ]

connected :: Graph -> Vertex -> Vertex -> Bool
connected es v0 v1 = any (elem v1) $ unfoldr phi (es, [v0])
    where
    phi (es, vs) = if null e then Nothing else Just (vs',(es',vs'))
        where
        (e, es') = partition (any (flip elem vs)) es
        vs' = concat e \\ vs

c:\Haskell>runghc mata.hs
[[17,18,26,25,20,22,19,28,1,0,10,8,4,5,7]]