KLab若手エンジニアの これなぁに?

KLab株式会社の若手エンジニアによる技術ブログです。phpやRubyなどの汎用LLやJavaScript/actionScript等のクライアントサイドの内容、MySQL等のデータベース、その他フレームワークまで幅広く面白い情報を発信します。

2009年10月

Haskellでエコーサーバー

Haskellで、TCPのサーバーを書いてみたいと思い、手始めにエコーサーバーを書いてみました。 エコーサーバーというのは、クライアントからの入力をそのまま返すサーバーです。 以下の記事を参考にもっと簡単なものを作ってみます。 A simple TCP server | The Haskell Sequence
main = withSocketsDo $ do
         [p] <- getArgs
         let port = fromIntegral (read p :: Int)
         soc <- listenOn $ PortNumber port
         putStrLn $ "start server, listening on: " ++ show port
         acceptLoop soc `finally` sClose soc
main部分です。 ソケットを開いてlistenします。
acceptLoop soc = do
  (hd, host, port) <- accept soc
  forkOS $ echoLoop hd
  acceptLoop soc
mainのあとの処理です。 クライアントがきたら、accept(受け付け)して、新しいスレッドを生成し、そちらに処理を任せます。 新しいクラアントに対応しつづけるため、処理が終わってはいけませんので、こちらは無限ループを続けます。
echoLoop hd = do
  sequence_ (repeat (do { -- ioアクションの無限リスト
                          l <- hGetLine hd;
                          hPutStrLn hd l;
                          hFlush hd
                     }))
  `catch` (\(SomeException e) -> return ())
  `finally` hClose hd
クライアントごとの処理です。 こちらは、一行読み込んで一行そのまま書き込むという処理を繰り返しているだけです。 さっそく実行してみましょう。
$ ghc -o echoHS -O --make -threaded echosimple.hs
$ ./echoHS 8080
start server, listening on: 8080
別のコンソールをひらきアクセスしてみます。
$ telnet localhost 8080
hoge
hoge
aiu
aiu


できました! 30行程度で、エコーサーバーが完成しました。 ついでにRubyでも同じものを書いたのでそちらも掲載しておきます。
module Main where
import Network
import Monad
import System.IO
import System.Environment (getArgs)


import Control.Exception
import Control.Concurrent
import Prelude hiding (catch)


main = withSocketsDo $ do
         [p] <- getArgs
         let port = fromIntegral (read p :: Int)
         soc <- listenOn $ PortNumber port
         putStrLn $ "start server, listening on: " ++ show port
         acceptLoop soc `finally` sClose soc


acceptLoop soc = do
  (hd, host, port) <- accept soc
  forkOS $ echoLoop hd
  acceptLoop soc


echoLoop hd = do
  sequence_ (repeat (do { -- ioアクションの無限リスト
                          l <- hGetLine hd;
                          hPutStrLn hd l;
                          hFlush hd
                     }))
  `catch` (\(SomeException e) -> return ())
  `finally` hClose hd

require 'socket'
def main
    unless ARGV[0]
        puts "usage: #{$0} PORTNUMBER"
        exit(true)
    end
    soc = Socket.new(Socket::AF_INET, Socket::SOCK_STREAM, 0)
    sockaddr = Socket.sockaddr_in(ARGV[0].to_i, "0.0.0.0")
    soc.bind(sockaddr)
    soc.listen(5)
    puts "start server, listening on #{ARGV[0]}"
    accept_do(soc)
end

def accept_do(serv)
    while(true)
        soc, addr = serv.accept
        puts "new client"
        Thread.new(soc, &self::method(:echo_do))
    end
end
def echo_do(soc)
    while true
        buf = soc.gets
        puts "data: #{buf}"
        soc.puts(buf)
    end
end

main if($0==__FILE__)

天下一プログラマー本戦1問目の解説

天下一プログラマー実行委員の 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()

HTTPクライアントをpythonで作ろう

お初にお目にかかります。 ひよこエンジニアtakei-hです。ぴよぴよ。 さて、amo-k先輩からの課題にやっと手を付けました! さっそく本題です!

1.telnetを用いてHTTPリクエストを発行せよ!

telnetを用いて、僕らの味方「Yahoo!知恵袋」のトップページに対してHTTPリクエスト(GETメソッド)を発行してみましょう。 (リクエストメソッドにはGETのほかにPOSTなどがありますが、今回はGETのみを取り上げます)
telnet chiebukuro.yahoo.co.jp 80[エンター]
GET / HTTP/1.0[エンター][エンター]
上記のコマンドをコンソールで実行すると、webサーバからのレスポンスとして、以下に示されているヘッダーとメッセージボディ(Yahoo!知恵袋のHTML文書)が返ってきます。
HTTP/1.1 200 OK
Date: Wed, 07 Oct 2009 08:15:40 GMT
P3P: policyref="http://privacy.yahoo.co.jp/w3c/p3p.xml", CP="CAO DSP COR CUR ADM DEV TAI PSA PSD IVAi IVDi CONi TELo OTPi OUR DELi SAMi OTRi UNRi PUBi IND PHY ONL UNI PUR FIN COM NAV INT DEM CNT STA POL HEA PRE GOV"
Set-Cookie: Ychie=KcPItpD.70E_gAXpes9zvcGQj_3HKkwW; path=/; domain=.chiebukuro.yahoo.co.jp
Cache-Control: private
Connection: close
Content-Type: text/html; charset=UTF-8

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="description" content="あなたの疑問や知りたいことを、他の参加者に質問できるYahoo!知恵袋。疑問に思っていることを質問したり、知っている事柄についての質問に回答することで、参加している方がお互いに知恵や知識を教えあい、分かち合えるQ&Aサイト">
<title>Yahoo!知恵袋</title>
・・・後は省略・・・
ヘッダーには、「HTTP/1.1 200 OK」つまりHTTP/1.1というプロトコルでステータスコード200(取得成功)でメッセージがOKとなっています。ヘッダーとメッセージボディの間に改行(\r\n)が入っています。 このように、HTTPセッションでは本来の目的であるHTML文書のやりとりの前に、様々な情報をお互いやり取りしているのですね。 そして、そのやり取りの手順(プロトコル)がHTTP(HyperText Transfer Protocol)なのですね!

2.任意の言語を用いてTCPソケットを利用したHTTPクライアントを作成せよ!

昔のhonda-h先輩はrubyで実装されていたので、私はpythonで実装してみました。GETで取得して、メッセージボディのみを表示してみましょう。
#!/usr/local/bin/python2.4

import socket

host = "chiebukuro.yahoo.co.jp"
port = 80
sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)

try:
 sock.connect((host, port))
 sock.send("GET / HTTP/1.0\r\n\r\n")
 msg = ""
 while True:
  data = sock.recv(8192)
  if not data:
   break
  msg += data
 for m in msg.split("\r\n\r\n")[1:]:
  print m
 sock.close()
except socket.error, e:
 print "Error: %s" % e
TCPソケットを使うために
 sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
でソケットオブジェクトをつくり、問題1と同じようにGETメソッドを送っています。
 sock.send("GET / HTTP/1.0\r\n\r\n")
そうすると、問題1と同じようなレスポンスが返ってきます。そのレスポンスを"\r\n\r\n"を区切りとしてヘッダーとメッセージボディを切り分けています。 HTTPサーバもクライアントも根本はTCPソケットの張り合い。つまりTCPソケットを制するものは、HTTPを制す!ですね! 勉強になりました! ついでに、pythonにはHTTPクライアントライブラリhttplibがあり、とっても簡単にhttpクライアントが作れるようになっています。
#!/usr/local/bin/python2.4

import httplib

h = httplib.HTTPConnection('chiebukuro.yahoo.co.jp')
h.request('GET', '/')
r = h.getresponse()
if r.status == httplib.OK:
 data = r.read()
 print data

firefoxアドオン「FireMobileSimulator」に追加機能をコミットしました。

はじめまして、nagai-kです。 今回は、携帯サイト開発のサポートツール「FireMobileSimulator」のご紹介とそれをちょっとハックしたよ、ということを書いてみたいと思います。
FireMobileSimulatorは、主要3キャリア(DoCoMo/Au/SoftBank)の携帯端末ブラウザをシミュレートして、モバイルサイト開発を容易にするために作成されたFirefoxのアドオンです。
私は携帯サイトを開発する事がよくありますので、このアドオンは業務をする上で必須のツールになっています。 携帯サイトの開発で大変なことといえば、最終出力であるHTMLの確認です。 プログラムを修正するたびに、ファイルをサーバにアップロードして携帯から確認する・・・・。 そんなことをするのは大変なので、普段は「FireMobileSimulator」を使って、Firefox で確認しています。 ※もちろん最終的は確認は携帯端末の実機で行っていますよ^^ 今回はこの「FireMobileSimulator」を勝手にハックしてみました。 さらに、作者の方に送ってみたら正式に採用されてしまいました! 追加した機能は、
  • 特定のURL(ドメイン)だけで端末選択機能が有効になる機能
  • 端末ごとにUIDなどの個体識別番号を設定する機能
です。内容について詳しくはオフィシャルサイト「1.1.9リリースノート」をご覧ください。
【少しだけ技術的なはなし】 私自身はじめてのFirefoxアドオン開発だったので技術的に詳しくはないですが少し解説したいと思います。 解説の準備としてまず、「FireMobileSimulator」をこちらからダウンロードしてください。 ※Firefoxで左クリックするとインストールしようとしてしまうので、その場合は右クリックで保存してください。 ダウンロードしたxpiファイルを展開します。 (xpiファイルはzipと同じなので、Windowsであれば拡張子を"zip"に変えて展開できます。) 展開したフォルダの中に「/chrome/msim.jar」と言うファイルがあるので、これも展開しておきます。 (xpi同様に拡張子をzipに変えてでOKです。) これでソースを読む準備ができました。 「\components\msimModifyHeaders.js」が今回修正したファイルです。 このファイルに携帯をシミュレートするための端末情報やUIDをHTTPリクエストに付加したりする処理が含まれています。 ファイルを見ると、docomo、SoftBank、au別にHTTPリクエストの処理を変えているのがわかると思います。
if (carrier == "DC") {
  ~ docomo用のHTTPリクエスト処理 ~
		
} else if (carrier == "SB") {
  ~ SoftBank用のHTTPリクエスト処理 ~

} else if (carrier == "AU") {
  ~ au用のHTTPリクエスト処理 ~
}
HTTPリクエストをハックする場合はこの処理を書き換えてみてください。 JavaScriptとHTTPプロトコルがなんとなくわかっていれば、簡単にハックが可能だと思います。 ここでは省略しますが、デバッグメッセージをコンソールに出せるようにしておくと修正作業がはかどります。 とても簡単な説明ですが、大体こんな感じでコードの修正していきました。 このように簡単に手を入れる事ができますので、皆さんも是非Firefoxアドオンの拡張/作成をしてみてはいかがでしょう?

天下一プログラマーの予選・本戦問題の公開

本日は天下一(10/1)の日です。 天下一といえば7、8月にかけ 天下一プログラマーの予選・本戦をやりましたが、未だ全ての問題を公開していませんでした。 ということで遅くなりましたが今回出題した問題を全て公開します。
  1. WEB予選第1回(2009/7/5)
  2. WEB予選第2回(2009/7/15)
  3. WEB予選第3回(2009/7/25)
  4. 本戦(2009/8/1,2)
それぞれの問題の解説については準備が出来次第、更新するため今暫くお待ちください。
 KLab若手エンジニアブログのフッター