Problem:
大きさが異なる n 個のコップと 3 つのトレイ（お盆）A，B，C があり，それらのコップは 3 つのトレイの上にそれぞれ何個かずつ一山に重ねて置かれている．ただし，どのトレイにおいても，そのトレイの中で一番小さいコップが一番下に， 2 番目に小さいコップがその上に， 3 番目に小さいコップがその上にと，小さい順に伏せて重ねてある．例えば，下図の右側は， n = 5 個のコップがトレイ A，B，C にそれぞれ 2 個，0 個，3 個重ねて置かれている状態を示している．

このように，コップの初期状態が与えられたとき，次の規則 1 〜 3 を守りながら，すべてのコップを A または C のどちらかのトレイに移動させるには何回移動を行えばよいかを求めたい．

（規則 1） 1 回に 1 つのコップだけを移動させることができる．それは，そのトレイにあるコップの中で一番上のコップ（つまり，一番大きいコップ）である．

（規則 2）大きいコップの上に小さいコップを重ねてはいけない．

（規則 3）コップ 1 個の直接移動は，トレイ A から B，B から A，B から C，C から B のみが許され， A から C への直接移動や C から A への直接移動は許されない．

　n 個のコップの初期状態と整数 m が与えられたとき， m 回以内の移動で， A または C のどちらかのトレイにすべてのコップをまとめて重ねることができるかどうかを判定し，可能な場合には移動回数の最小値を，不可能な場合には -1 を出力するプログラムを作成しなさい．

　入力ファイルの 1 行目には， n と m がこの順に空白を区切り文字として書いてある． 1 ≦ n ≦ 15 であり， 1 ≦ m ≦ 15000000 である． 2 行目，3 行目，4 行目には， 1 から n までの整数を何個かずつ 3 つのグループに分けて，それぞれのグループ内で小さい順（昇順）に並べたものが書いてある．ただし，各行の先頭（それらの整数の前）には，それらの個数が書いてある． 2 行目に書かれている整数（先頭の 1 つを除く）はトレイ A の上に重ねられている各コップの大きさを表す．同様に， 3 行目に書かれている整数（先頭の 1 つを除く）はトレイ B の上に重ねられている各コップの大きさを表し， 4 行目に書かれている整数（先頭の１つを除く）はトレイ C の上に重ねられている各コップの大きさを表す．

入力例１

入力例２

入力例３

入力例４

3 10

4 20

2 5

3 3

0

2 1 2

2 1 2

0

1 1

1 3

0

1 1

2 2 3

1 4

0

2 2 3

　

出力例１

出力例２

出力例３

出力例４

9

3

0

-1

入力

入力は複数のデータセットからなる．n, m がともに 0 のとき入力が終了する．データセットの数は 5 を超えない．

出力

データセットごとに、移動回数または -1 を１行に出力する．

入力例

3 10
0
1 1
2 2 3
4 20
2 1 2
1 3
1 4
2 5
2 1 2
0
0
3 3
0
1 1
2 2 3
0 0

出力例

9
3
0
-1

各データセットの出力（移動回数または -1）の後に改行を入れること．

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。

Solution in Haskell (judge verdict: Time Limit Exceeded)

{-# LANGUAGE BangPatterns#-}
module Main where

import System.IO.Unsafe
import Data.List
import Data.Maybe
import Control.Monad
import Data.Functor

main :: IO ()
main = do
  (cups,mvs) <- getNM
  unless (cups==0 && mvs==0) $
    do
      initState <- getState
      print $ solve mvs initState cups
      main
  where
    getNM::IO (Int,Int)
    getNM=do
       (n:m:_)<-map read . words <$> getLine
       return (n,m)
    getTray::IO [Int]
    getTray=do
      (n:try) <- map read . words <$> getLine
      return $ reverse $ take n try
    getState::IO GameState
    getState=do
      [ta,tb,tc] <-replicateM 3 getTray
      return $ GameState (Tray ta tb tc) Nothing

data Move=AB|BA|BC|CB deriving(Eq,Show)

data Tray=Tray {trayA::[Int]
              , trayB::[Int]
              , trayC::[Int]
               }deriving(Eq,Show)

data GameState=GameState {tray::Tray
                        , history::Maybe Move}deriving(Eq,Show)
--instance Eq GameState where
  --(GameState tr1 _)==(GameState tr2 _)=tr1==tr2

solveS1::Straight->Int
solveS1 (ToA x) =solveS x
solveS1 (ToC x)=solveS x
solveS::Int->Int
solveS 0=0
solveS !n=2 + (3 * solveS (n-1))

solve::Int->GameState->Int->Int
solve mvs state len=fromMaybe ( -1) $ solve' maxBound mvs [state] mvs len
  where
    solve'::Int->Int->[GameState]->Int->Int->Maybe Int
    solve' record m states !n l =
      case () of
        _ |null states -> Just record
          |record <= m-n ->Just record
          |0>n ->Nothing
          |otherwise ->      let (str,noStr)=split (isStraight1 . (`isStraight` l)) states
                                 anss=map ((+(m-n)) . solveS1 . (`isStraight` l)) str
                                 upds=concatMap (\s->moves (noReturn s) s) noStr
                             in solve' (minimum (record:anss)) m (del states $ nub upds) (n-1) l



move::Move->GameState->Maybe GameState
move mv (GameState tray hist)=do
  tray' <- move'' mv tray
  return $ GameState tray' (Just mv)
  where
    move''::Move->Tray->Maybe Tray
    move'' AB (Tray ta tb tc)=do
      (ta',tb') <- move' (ta,tb)
      return $ Tray ta' tb' tc
    move'' BA (Tray ta tb tc)=do
      (tb',ta') <- move' (tb,ta)
      return $ Tray ta' tb' tc
    move'' BC (Tray ta tb tc)=do
      (tb',tc') <- move' (tb,tc)
      return $ Tray ta tb' tc'
    move'' CB (Tray ta tb tc)=do
      (tc',tb') <- move' (tc,tb)
      return $ Tray ta tb' tc'
    move'::([Int],[Int])->Maybe([Int],[Int])
    move' ([],_)=Nothing
    move' (x:xs,[])=Just (xs,[x])
    move' (x:xs,tr@(y:ys))
      |x>y =Just (xs,x:tr)
      |otherwise=Nothing

moves::[Move]->GameState->[GameState]
moves mvs state=mapMaybe  (`move` state) mvs

isClear::GameState->Bool
isClear (GameState (Tray _ [] []) _)=True
isClear (GameState (Tray [] [] _) _)=True
isClear _ =False


noReturn::GameState->[Move]
noReturn (GameState _ hi)=noReturn' hi
  where
    noReturn'::Maybe Move->[Move]
    noReturn' (Just x)=filter (/= x) [AB,BA,BC,CB]
    noReturn' Nothing=[AB,BA,BC,CB]

data Straight=No|ToA Int|ToC Int
isStraight::GameState->Int->Straight
isStraight (GameState tr _) x=isStraight' tr x
  where
    isStraight'::Tray->Int->Straight
    isStraight' (Tray [] [] tc) n=ToC 0
    isStraight' (Tray ta [] []) n=ToA 0
    isStraight' (Tray ta [] tc) n=
      let [lenA,lenC]=map length [ta,tc] in
      case () of
        _ |head tc==n && head ta== n-lenC  ->ToA lenC
          |head ta==n && head tc== n-lenA  ->ToC lenA
          |otherwise->No
    isStraight' _ _=No

isStraight1::Straight->Bool
isStraight1 No=False
isStraight1 _=True

split::(a->Bool)->[a]->([a],[a])
split f list=foldr (\x (ts,fs)->if f x then (x:ts,fs) else (ts,x:fs)) ([],[]) list

del::Eq a=>[a]->[a]->[a]
del delList target=delList ++ filter (not . (`elem` delList)) target