天下一プログラマー実行委員の takada-at です。 今回は、本戦1日目の1問目にあたる「障害物ありNクイーン」を紹介します。

解答

20
-Q--*******Q----
---Q*******--Q--
----******-----Q
-----****Q------
-----***------Q-
------*-Q-------
----------Q*****
Q---------******
--Q-------******
----------Q*****
-----Q*Q--------
-----***-----Q--
----Q****------Q
----******--Q---
----*******---Q-
----*******Q----

問題について

エイト・クイーン・パズルの変形版です。問題文にある通り、他のクイーンが一手で移動できるマスを避け、盤面上にクイーンを置いていきます。
 ----*******-----
 ----*******-----
 ----******------
 -----****-------
 -----***--------
 ------*---------
 -----------*****
 ----------******
 ----------******
 -----------*****
 ------*---------
 -----***--------
 -----****-------
 ----******------
 ----*******-----
 ----*******-----
まず素朴にこのパズルを解く方法を考えてみましょう。 以下では、縦のラインを「列」、横のラインを「行」と呼ぶことにします。 左からi列目、上からj行目のマスを(i,j)と書きます。i,jは0から数えます。 各行に対し、左から右、上の行から下の行へクイーンを置いていくとしましょう。 最初に(0,0)に置いた場合、このクイーンの経路には他のクイーンは置けませんから、次にクイーンを置けるマスは(12,0)、さらにその次に置けるのは(2,0)となります。 最初に(1,0)に置いた場合は、次にクイーンを置けるマスは(12,0)、さらにその次に置けるのは(3,0)となります。 -最初に(0,0)に置いた場合
Qxxx*******Qxxxx
xxQx*******-----
-最初に(1,0)に置いた場合
xQxx*******Qxxxx
xxxQ*******-----
このように、「(0,0)に置く? / 置かない?」「(0,1)に置く? / 置かない?」というそれぞれの選択肢が運命の分かれ道となり、それによってその後にクイーンを置けるマスが変わっていきます。左側の矢印を「置く」、右側の矢印を「置かない」として、次に置けるマスを図示しますと、以下のようになります。 問題は、これらの経路の内、「置く」を選んだ回数が最大のものを探すことです。

アルゴリズム

このようなグラフの探索問題を解くアルゴリズムにはいくつかバリエーションがありますが、ここでは「深さ優先探索」を使います。 他にも代表的なアルゴリズムとして「幅優先探索」がありますが、エイト・クイーンのような問題の場合、考慮すべき経路の量が多く、ふさわしくありません。 http://ja.wikipedia.org/wiki/深さ優先探索 http://ja.wikipedia.org/wiki/幅優先探索 深さ優先探索の実装は、スタックを利用するか再帰を利用するのが一般的です。 Rubyで再帰を利用した場合の探索部分を以下に示します。
def depthFirst x, y, h
    return h if (h[:map].size==y) #それ以上行がないので終了
    max = h
    x.upto(h[:map][y].size-1) do |x1| 
    # y行目でx列目より右の、クイーンを置くことができるマスのそれぞれについて...
        next if h[:map][y][x1] != BRANK
        nmap = deepcopy(h[:map])
        setQueen(nmap, [x1,y])
        #クイーンを置いてみて、その後の運命を見定める
        r = depthFirst(x1+1, y, {:map=>nmap, :count=>h[:count]+1}) 
        #最大のものをとる
        if(max[:count] < r[:count])
            max = r
        end
    end
    #あえて置かないという選択肢も調べる
    r = depthFirst(0, y+1, h)
    if(max[:count] < r[:count])
        max = r
    end
    max
end
日本語で書くと以下のようになります。
  • y行目でx列目より右で、クイーンを置くことができるマスのそれぞれについて、
    • とりあえずクイーンを置いてみて、その右のマスに対し同じ操作を繰返す
    • それぞれの結果の内最大のものを取る
  • 行の右端まで行ったら下の行へ行く
  • それ以上行がなくなったら終了
あとはデータ構造です。 単純に考えれば盤面は二重配列にするのがよいでしょう。最適化を考え、ビットの配列にしてもよいですが、「何もない場合」「障害物」「クイーン」「クイーンの経路」といった状態が考えられるため、ビットの配列を複数持つ必要があります。 また、クイーンの数を比較するため、クイーンの合計数を盤面とは別に持つのもよいでしょう。

最適化

さて、以上を実装して解答が出れば話は簡単なのですが、この問題の場合、計算量の多さがネックになります。 素朴に解こうとすると一時間では計算が終わらないということにもなりかねません。 そこで、いくつか最適化の手段を考えていきましょう。 まず何度も繰り返すことになるクイーンの配置を最適化します。すべてのマスに対するクイーンの経路をあらかじめ計算してキャッシュ(メモ化)おきましょう。 あらかじめ計算しておけば、すべてのマス(障害物以外)を一度ずつ処理するだけで済みます。 経路の探索中は、同じマスに対し何度も何度もクイーンを配置する処理が必要になりますから、計算結果のキャッシュが有効にはたらくはずです。 さらに言えば、左から右、上から下に処理していくため、クイーンの経路は「右、右下、下、左下」の4つのみ考慮すれば済みます。左上や左にすでにクイーンがあった場合はそもそもそのマスにはクイーンを配置できません。
--x-*******-----
---xx****-------
xxxxQx*---------
---xxx-----*****
--x-x-x---******
左上、左、上にクイーンがないことはすでに確定しているため、考慮しなくていい。
また、以下のようなメモ化も考えられます。 パターン1とパターン2は違う盤面ですが、下から2つの行だけを見ると、同じ状態になっています。 ということは、下から2つの行を処理をする際にはどちらの場合でも同じ結果が出てくるはずです。つまり、「残りの行」の状態をキーにして結果をキャッシュして置くことで、いくつかの分岐を省略することができます。 とりわけ探索の後半は、ほとんどクイーンの経路で塗りつぶされた盤面を処理することになるはずですから、この処理が有効なはずです。 ただし、これによってメモリを食うことにもなるので、どの程度このキャッシュを働かせるかは微妙な選択でしょう。実際、言語によっては、このメモ化をしない場合の方が速くなることもありました。
---Q
Qxxx
xxQx
xxxx
x-xx
xxxx
パターン1
----
--Qx
Qxxx
xxxQ
x-xx
xxxx
パターン2
この探索の場合、網羅性を考えると、最適な配置のために「置ける場所にあえてクイーンを置かない」という選択肢も検討する必要があります。しかし、これによって探索する経路が大分増えてしまうのも事実です。 仮に「あえて置かない」選択肢を取らなかった場合の計算量が「n の m乗」(選択肢の数+深さ)だったとすると、「あえて置かない」選択肢を追加することで、概算で「(n+1) の m乗」にまで経路が増えてしまいます。 さらに言えば、「この行にはあえて置かない」という選択を10回繰り返したあとの経路などは、クイーンの数が最大になるとは考えづらいため、検討する必要がないものです。 よって、「あえて置かない」選択肢の回数を制限することにしましょう。この場合網羅性を犠牲にしているので、「クイーンの数が最大であること」を示さなければなりません。しかし「あえて置かない」選択肢の許容量を順次増やしていくことで最大の解を検討することもできるはずです。ところでその際、90度回転してから探索をはじめた方が都合がよくなります。これはこの盤面の特性によります。 障害物で分断された行(or列)のそれぞれを「ブロック」と呼ぶことにしましょう。縦のラインには、22ブロック(2つに分割された列が6、分割されていない列が10)あります。横のラインには、28ブロック(2つに分割された行が12、分割されていない行が4)あります。 縦または横のラインだけを見ていっても、1ブロックにクイーンを1つしか置けないのはあきらかです。つまり、縦のラインを見ていくと、この盤面におけるクイーンの最大値は22であることが明らかになります。縦のラインの方が最大値が低いため、横回転して縦のラインを基準に考えた方がよいのです。 実際には、この盤面の場合、「あえて置かない」選択肢の数は1回で十分であることがわかります。 計算を実行してみると、以上の最適化を組み合わせることで、Rubyでも10分程度、Haskellなどでは5分以下で解にたどりつくことができました。 解は以下のようになります。
20
-Q--*******Q----
---Q*******--Q--
----******-----Q
-----****Q------
-----***------Q-
------*-Q-------
----------Q*****
Q---------******
--Q-------******
----------Q*****
-----Q*Q--------
-----***-----Q--
----Q****------Q
----******--Q---
----*******---Q-
----*******Q----
この盤面が最大であることの証明は以下のようになります。 縦のラインに注目しましょう。クイーンが置かれていないブロックは(6,j)の列と、右から4列目、(11,j)の列だけです。ということは、もしクイーンを増やせるとしても、最大で2つにとどまります(1ブロックにクイーンを1つ以上置くことはできません)。 つまり余地が一つしかない以上、「2ブロック見逃す」という選択肢を考慮することで、置けるクイーンの数が増えることはありえません(理論上の最大値が22である以上、2つ見逃した時点で、20を超えることはないはずです)。 以上より、この解が最適解の1つであることがわかりました。 Ruby, Python, Haskellによるコードの例を以下に掲載します。 (Haskellは解答用言語に含まれていませんでしたが、おまけです)。 ---- haskell

{-# OPTIONS_GHC -O #-}
module Main where
import Array
import Data.List hiding (lookup, insert)
import Data.HashTable
import Time
import Control.Monad.Reader
import Prelude hiding (lookup)


type Node = (Int, Int)
data Board =  Board{count, miss :: Int, board :: Map}



{-- Term --}
data Term = Queen | Obstacle | Brank | Route deriving Eq
instance Show Term where
    showsPrec d t = showParen (d > 10) $ showString (showTerm t)

showTerm Brank  = "-"
showTerm Obstacle = "*"
showTerm Queen  = "Q"
showTerm Route  = "-"


showTermInternal Route  = "x"
showTermInternal t  = showTerm t

isBrank Brank = True
isBrank _ = False

isObstacle Obstacle = True
isObstacle _ = False

instance Read Term where
    readsPrec _ s = [(readTerm s, "")]

readTerm "-" = Brank
readTerm "*" = Obstacle
readTerm "Q" = Queen
readTerm "+" = Route
readC c = read [c]

{-- Map --}
data Map = Map {width, height :: !Int , points :: !(Array Node Term)}
instance Show Map where
    showsPrec d m = showParen (d>10) $ showString $ showMap m
instance Show Board where
    showsPrec d m = showParen (d>10) $ showString $ showBoard m
showMap :: Map -> String
showMap m = do r <- rows $! points m
               ( concatMap show r ) ++ "\n"
instance Read Map where
    readsPrec _ str = [(readMap str, "")]
readMap :: String -> Map
readMap str = Map w h $! array bnd $! vals
        where
          ls = lines str
          bnd = ((0,0),(w-1,h-1))
          w = length . head $ ls
          h = length ls
          vals = zip ([(x,y)|y <- [0..h-1], x<-[0..w-1]]) (map readC $ filter (/= '\n') str)

showBoard m = unlines [show (count m), show (board m)]


rowsFrom :: Array Node c ->Int-> [[c]]
{-# INLINE rowsFrom #-}
rowsFrom x l = [row i x | i <- range (l, u)]
    where (_, (_,u)) = bounds x
rowsTo :: Array Node c ->Int-> [[c]]
rowsTo x u = [row i x | i <- range (l, u-1)]
    where ((_,l), _) = bounds x

rows :: (Ix a, Ix b) => Array (a,b) c -> [[c]]
{-# INLINE rows #-}
rows x = [row i x | i <- range (l',u')]
    where ((_,l'),(_,u')) = bounds x


row :: (Ix a, Ix b) => b -> Array (a,b) c -> [c]
{-# INLINE row #-}
row i x = [x ! (ix, i) | ix <- range (l', u')]
    where ((l',_),(u',_)) = bounds x

rowIdx :: (Ix a, Ix b) => b -> Array (a,b) c -> [((a,b), c)]
{-# INLINE rowIdx #-}
rowIdx i x = [((ix,i), (x ! (ix, i))) | ix <- range (l', u')]
    where ((l',_),(u',_)) = bounds x

at :: Map -> (Int, Int) -> Term
{-# INLINE at #-}
at m (x,y) = (points m) ! (x,y)




{-- route --}
route :: Int -> Int -> Node -> [[Node]]
route w h (x,y) =
    [
     zip right (repeat y),
     zip right down,
     zip (repeat x) down,
     zip left down
    ]
    where
      left = [(x-1),(x-2)..0]
      right = [(x+1),(x+2)..(w-1)]
      up = [(y-1),(y-2)..0]
      down = [(y+1),(y+2)..(h-1)]


forRoute :: Map -> ((Int,Int) -> a) -> (Int,Int) -> [a]
forRoute m@Map{width=w,height=h} f (x,y) = do l <- route w h (x,y)
                                              map f $ takeWhile (not . isObstacle . (at m)) l

setQueen :: (Int, Int) -> Map -> Maybe Map
setQueen i@(x,y) m = if isBrank (at m i)
                     then
                         Just m {points = (points m) // ((i,Queen):values)}
                     else Nothing
    where
      values :: [((Int,Int), Term)]
      values = forRoute m set (x,y)
      set :: (Int,Int) -> ((Int,Int), Term)
      set j = (j, Route)

compareBoard :: Board -> Board -> Ordering
compareBoard Board {count=c1} Board {count=c2} = compare c1 c2

maxBoard :: Board -> Board -> Board
{-# INLINE maxBoard #-}
maxBoard x y = if count x >= count y then x else y
{-- memo --}
type RouteMemo = HashTable String [(Node, Term)]
type MapMemo = HashTable String (Int, Int, Array Node Term)
data Memo = Memo{mapMemo :: !MapMemo, routeMemo :: !RouteMemo}
type Memoise a = ReaderT Memo IO a
setQueenM :: Node -> Map -> Memoise (Maybe Map)
setQueenM i@(x,y) m =
    if isBrank (at m i) then
        do {
          memo <- asks routeMemo;
          Just rt <- liftIO $! (lookup memo (show i));
          return $! Just m{points = (points m) // ((i,Queen):rt)}}
    else return $! Nothing
makeRouteMemo :: Map -> IO (HashTable String [(Node, Term)])
makeRouteMemo mp = let w = width mp
                       h = height mp in
                   do hash <- new (==) hashString
                      setHash hash mp
                      return $! hash
    where
      setHash hash mp =
          let w = width mp
              h = height mp in
          sequence $!
          map (\p-> let (n,v) = p in
                     if v == Brank then
                         insert hash (show n) $!
                                zip (concat $! (map (takeWhile ((/=Obstacle).(at mp)))) $! route w h n)
                                    $ repeat Route
                     else return ()
               ) $! assocs $! points mp

memoKey :: Int -> Map -> String
{-# INLINE memoKey #-}
memoKey l m = do r <- (rowsFrom $! (points m)) l
                 (concatMap showTermInternal $! r)++"\n"
countUnder :: Int -> Board -> Int
{-# INLINE countUnder #-}
countUnder l Board{board=mp} = foldl (\x _-> x+1) 0 (filter (==Queen) (concat (rowsFrom (points mp) l)))
countAbove :: Int -> Board -> Int
{-# INLINE countAbove #-}
countAbove l Board{board=mp} = foldl (\x _-> x+1) 0 (filter (==Queen) (concat (rowsTo (points mp) l)))

copyUnder :: Int -> Array Node Term -> Map -> Map
copyUnder l pts m@Map{points=d} =
    case (d //)
           $! ([n | i<-range (low,(l-1)), n<-rowIdx i d]) ++
              assocs pts of
      npts -> m{points=npts}
    where
      ((_,low),(_,hi)) = bounds d
lookupMemo :: String -> Board -> Memoise (Maybe Board)
lookupMemo key bd@Board{board=mp} =
    do {
      memo <- asks mapMemo;
      r <- liftIO (lookup memo key);
       case r of {
                Just (cnt, y, pts) ->
                --do liftIO (putStrLn "lookup")
                    do
                      nar <- return $! copyUnder y pts mp
                      return $! (Just bd{count=cnt+(countAbove y $! bd),
                                                 board=nar})
                ;Nothing ->
                    return $! Nothing}}
insMemo :: Int -> String -> Board -> Memoise ()
insMemo y key bd@Board{board=mp} =
    let ((lx,ly),(hx,hy)) = bounds (points mp)
        nbnd = ((lx, y),(hx,hy))
        memo = array nbnd $! filter ((>=y).snd.fst) $! assocs (points mp) in
    do t <- asks mapMemo;
       return $! t `seq` memo `seq` y ;
       nct <- return $! countUnder y $! bd;
       liftIO(insert t key (nct, y, memo));
       t `seq` return ();


{--- 深さ優先 ---}
incMiss :: Board -> Board
incMiss b = b{miss=(miss b)+1}
deepFirst :: Int -> Board -> Memoise Board
deepFirst y r | y==(height (board r)) = return $! r
deepFirst _ r | miss r >= 5 = return $! r
{--
キャッシュすると余計重くなるのでやめた
deepFirst y route@Board{board=bd} |y>=12 =
    let key = memoKey y bd in
    do {
      memo <- (lookupMemo $! key) $! route;
      case memo of {
         Just m -> return $! m;
         Nothing -> do {
                      mx <- deepFirstIter 0 y route;
                      insMemo y key $! mx;
                      return $! mx
                    }}}
--}
deepFirst y r =
    deepFirstIter 0 y r


deepFirstIter :: Int -> Int -> Board -> Memoise Board
deepFirstIter x y route@Board{board=bd,count=ct} =
    let line = filter ((>=x).fst.fst) $! rowIdx y (points bd) in
    case filter ((==Brank).snd) $! line of
      [] -> (deepFirst (y+1)) $! route
      ls -> do {
              res <- mapM (\n ->
                           let ((x',_),_) = n in
                           do {
                             Just m <- setQueenM (x',y) bd;
                             m <- return $! m;
                             deepFirstIter (x'+1) y route{board=m,count=ct+1}}
                          ) ls;
              res2 <- (deepFirst (y+1)) $! (incMiss route); --あえて置かない
              res2 <- return $! res2;
              return $! foldl1' maxBoard $! (res2:res)
              --return $! foldl1' maxBoard $! res
            }


searchD :: Map -> IO (Int, Map)
searchD m =
    do hash <- makeRouteMemo $! m
       hash2 <- new (==) hashString
       b <- runReaderT (deepFirst 0 (Board 0 0 m)) ((Memo hash2) $! hash)
       return (count b, board b)

given =
    "----*******-----\n\
    \----*******-----\n\
    \----******------\n\
    \-----****-------\n\
    \-----***--------\n\
    \------*---------\n\
    \-----------*****\n\
    \----------******\n\
    \----------******\n\
    \-----------*****\n\
    \------*---------\n\
    \-----***--------\n\
    \-----****-------\n\
    \----******------\n\
    \----*******-----\n\
    \----*******-----\n"


given2 =
    "----*******-----\n\
    \-----****-------\n\
    \------*---------\n\
    \-----------*****\n\
    \----------******\n"
given6 =
    "-----***--------\n\
    \------*---------\n\
    \-----------*****\n\
    \----------******\n\
    \----------******\n\
    \-----------*****\n"




main :: IO ()
main = do pre <- getClockTime
          (r,m) <- searchD $ readMap given
          putStrLn (show r) >> putStrLn (show m)
          post <- getClockTime
          putStrLn $ show $ diffClockTimes post pre
          putStr $ show $
                   fromRational $ (/ 10^9) $ fromInteger $ tdPicosec $ diffClockTimes post pre
          putStrLn "[ms]"

------ ruby


BRANK = 0
OBSTACLE = 1
QUEEN = 2
ROUTE = 3
module Enumerable
    def drop d
        if self.size > d
            self.slice(d..-1)
        else
            []
        end
    end
end
def zip l,r
    if(l.size>r.size)
        l = l.slice(0,r.size)
    end
    l.zip(r)
end
def isObstacle(c)
    c == OBSTACLE
end
def isBrank(c)
    c == BRANK
end
def readPoint p
    case p
    when "-" : BRANK
    when "*" : OBSTACLE
    when "Q" : QUEEN
    when "+" : ROUTE
    end
end
def showPoint p
    if p==BRANK
        "-"
    elsif p==OBSTACLE
        "*"
    elsif p==QUEEN
        "Q"
    elsif p==ROUTE
        "-"
    end
end
def showPoint2 p
    if p==BRANK
        "-"
    elsif p==OBSTACLE
        "*"
    elsif p==QUEEN
        "Q"
    elsif p==ROUTE
        "+"
    end
end
def showmap m
    s = ""
    m.map do |l|
        l.map do |c|
            s += showPoint(c)
        end
        s += "\n"
    end
    s
end
def showmap2 m
    s = ""
    m.map do |l|
        l.map do |c|
            s += showPoint2(c)
        end
        s += "\n"
    end
    s
end
def readmap str
    m = []
    str.each_line do|l|
        m << l.chomp.split("").map do |c|
            readPoint(c)
        end
    end
    m
end
def deepcopy m
    r = []
    m.each do |l|
        r << l.dup
    end
    r
end
def routes(w,h,p)
    x, y = p
    right = ((x+1)..(w-1)).to_a
    left = []
    (x-1).downto(0){|c|left>>c}
    down = ((y+1)..(h-1)).to_a
    repeatx = Array.new(h,x)
    repeaty = Array.new(w,y)
    [zip(right, repeaty), zip(right,down), zip(repeatx, down), zip(left,down)]
end
def setQueen(m, p)
    x,y = p
    ros = @routes[x.to_s+","+y.to_s]
    if(isBrank(m[y][x]))
        m[y][x] = QUEEN
        ros.each do |row|
            row.each do |n|
                x1,y1 = n
                if(isObstacle(m[y1][x1]))
                    break
                else
                    m[y1][x1] = ROUTE
                end
            end
        end
        true
    else
        false
    end
end
def makeRoutes m
    rs = {}
    w, h = m[0].size, m.size
    m.each_with_index do |r, y|
        r.each_with_index do |n, x|
            if(n==BRANK)
                rs[x.to_s + "," + y.to_s] = routes(w, h, [x,y])
            end
        end
    end
    rs
end
def memokey l,m
    showmap2(m[l..-1])
end
def compose l, ms, md
    if l==0
        deepcopy(ms)
    else
        deepcopy(md[0..(l-1)]) + deepcopy(ms[l..-1])
    end
end
def countunder l, m
    m[l..-1].inject(0) do |r, i|
        i.inject(r) do |r2, i2|
            if(i2 == QUEEN)
                r2 += 1
            else
                r2
            end
        end
    end
end
def countabove l,m
    if l==0
        return 0
    end
    m[0..(l-1)].inject(0) do |r, i|
        i.inject(r) do |r2, i2|
            if(i2 == QUEEN)
                r2 += 1
            else
                r2
            end
        end
    end
end
def lookup h, key
    m = h[:map]
    if memo = @memo[key]
        l = memo[:line]
        memop = memo[:map]
        nmap = compose(l, memop, m)
        ncount = countunder(l, memop) + countabove(l, m)
        {
            :count => ncount,
            :map => nmap
        }
    else
        nil
    end
end
def insmemo a,line,key
    @memo[key] = {
        :line => line,
        :map => a[:map]
    }
end
@memo = {}
def depthFirst x, y, h
    return h if h[:map].size==y
    return h if h[:miss] >=1

    if x==0 && y>=0
        key = memokey(y, h[:map])
        if nh = lookup(h, key)
            return nh
        end
    end
    max = h
    f = false
    x.upto(h[:map][y].size-1) do |x1|
        next if h[:map][y][x1] != BRANK
        f = true unless f
        nmap = deepcopy(h[:map])
        setQueen(nmap, [x1,y])
        r = depthFirst(x1+1, y, {:map=>nmap, :count=>h[:count]+1, :miss=>h[:miss]})
        if(max[:count] < r[:count])
            max = r
        end
    end
    h[:miss]+=1 if f
    r = depthFirst(0, y+1, h)
    if(max[:count] < r[:count])
        max = r
    end
    insmemo(max, y, key) if x==0 && y>=0
    max
end
def dsearch(map)
    h = {:count => 0, :map=>map, :miss=>0}
    depthFirst(0,0,h)
end

GIVEN = <
---- python


from copy import deepcopy
from itertools import izip, repeat
from time import time
from sys import stdout

K = bytearray("""\
________........
................
................
................
###..........###
#####......#####
######....######
#####......#####
####........####
###..........###
##.....##.....##
......####......
......####......
......####......
......####......
......####......""").split()

given4 = bytearray("""\
....#######.....
.....####.......
......#.........
...........#####
..........######""").split()



def print_k(k):
    print '-'*16
    for l in k:
        print l
    #for l in zip(*k):
    #    print ''.join(chr(x) for x in l)

def count_q(k):
    sum = 0
    for l in k:
        sum += l.count('Q')
    return sum

WALL = ord('#')
def put(k, line, pos):
    k[line][pos] = 'Q'

    xleft = xrange(pos-1, -1, -1)
    xright= xrange(pos+1, len(k))
    #xup = xrange(line-1, -1, -1)
    xdown = xrange(line+1, len(k))

    def fill(ygen, xgen):
        for y,x in izip(ygen, xgen):
            if k[y][x] == WALL:
                break
            else:
                k[y][x] = '_'

    #fill(repeat(line), xleft)
    fill(repeat(line), xright)
    #fill(xup, repeat(pos))
    fill(xdown, repeat(pos))
    #fill(xup, xleft)
    #fill(xup, xright)
    fill(xdown, xleft)
    fill(xdown, xright)


memod = {}
def backtrack(k, line=0, pos=0):
    if line == 16:
        return k, 0
    POS = pos

    if POS == 0 and 4 <= line:
        memo_key = ''.join(str(x) for x in k[line:])
        mk, msum = memod.get(memo_key, (None, 0))
        if mk:
            nk = k[:]
            nk[line:] = mk
            return nk, msum

    best, max = k, 0

    pos = k[line].find('.', pos)
    while pos >= 0:
        nk = deepcopy(k)
        put(nk, line, pos)
        ok, osum = backtrack(nk, line, pos+1)
        osum += 1
        if osum > max:
            max = osum
            best = ok
        pos = k[line].find('.', pos+1)
    k[line] = str(k[line])
    ok, osum = backtrack(k, line+1, 0)
    if osum > max:
        max = osum
        best = ok

    if 4 <= line and POS == 0:
        memod[memo_key] = (tuple(str(x) for x in best[line:]), max)
    if line < 5:
        print_k(best)
    return best, max

def main():
    start = time()
    res, n = backtrack(K)
    end = time()
    print '=========='
    print n
    print_k(res)
    print (end - start) * 1000, '[ms]'


if __name__ == '__main__':
    main()