この記事は Haskell Advenct Calender の17日目の記事です。遅れてしまって申し訳ありません。svg画像が表示できるブラウザで閲覧してください。
学科の課題で夏休みにHaskellで リバーシAIの実装 を行ったのですが、その際に考えた盤面処理のアルゴリズムを画像として可視化したいなと思っていたので、Haskellで図形描画をするライブラリである Diagrams を使って行いました。
ビット演算を駆使してビットを並び替えるようなアルゴリズムは好きなのですが、そうしたアルゴリズムは概して暗号じみています(ビット反転 などが例)。その手のアルゴリズムを上手く画像で表現する、めずらしい試みかと思います。
リバーシのAIを実装する際に用いる、盤面を保持するためのデータ構造の一つです。ビットボードという名前は、石が置かれているかどうかが1ビットで表現されて、ビット演算によって操作するということを意味します。64bitマシンの場合、盤面の各位置に黒の石が置かれているかどうかを表すビットベクトルは,64bit整数、即ちCPUのレジスタ一つだけの空間消費で表現できます。白の石についても同様です。つまり、盤面全体がレジスタ二つに収まるということで、高速な処理が期待できます。
リバーシの実装において絶対に必要になってくるのは、
です。ナイーブにやってもさほど重くはないですが、探索速度に効いてくるので無限に高速化したい部分です。
このうち、石を打てる位置の列挙に関しては、盤面の全体を同時に処理する効率のよい実装が比較的シンプルに可能です。解説が http://d.hatena.ne.jp/ainame/20100426/1272236395 にありますが、上下左右斜めの各方向について、盤面をシフトしながら石を置ける位置の候補を表すビットベクトルを取り出して、全ての候補をORしてやるイメージで、ビットベクトルとして石を打てる位置がまとめて得られます。なお、まとめて得た位置を順に取り出すには,単純にループしても良いですが、y=x&(-x)によってxの一番低い位置で立っているビットが取り出せるという有名なビット演算のテクニックを使うとより高速です。
次に、盤面を更新する処理を考えます。まず、この処理は明らかに上下左右斜めの8方向について独立に行うことができます。上向きと下向きといった180度違いの方向を別々に処理するのはもったいないので、何とか上手いことして同時に処理するようにすれば、4方向についての処理に帰着できます。
この処理を行うために、まず着目している方向の列上での石の並びを、黒と白の両方について、8bitのビットベクトルとして取得します。そして、何らかの方法によって、列上で裏返る石がどれかを示す8bitベクトルを取得します。次に、元々の64bitの盤面上の適切な位置に、8bitベクトル上のビットを戻します。ここまでできれば各方向について裏返る石の場所が分かるので、元の盤面にXORしてやれば新しい盤面が得られます。
列上で裏返る石を取得する方法ですが、普通にループで処理することも可能ですし、またルックアップテーブルを使った凝った実装( Edaxというリバーシプログラムでの実装 のコメントや https://github.com/grafi-tt/tatsuki/tree/2f85835c5aab83c3c60999a37a51fa4794c84285#一つの列をひっくり返した結果の取得 を参照)が存在します。斜めの方向の場合は、盤面の両端をまたぐケースの処理が必要になったりもしますが。
残るは、8bitベクトルを得る処理と、8bitベクトルを元の盤面上の位置に戻す処理です。ビット演算や特定のパターンによる乗算を駆使することで可能ですが、ソースコードは暗号じみたものになります。そこで、この部分を可視化することを試みました。
記事の冒頭の画像を確認してください。まず、画像はリバーシの盤面に対応しており、つまりビットボード実装では各マス目が64bit整数の各ビットに対応しています。ここで、LSB(右端のビット)を一番右下のマスに対応させ、MSB(左端のビット)を一番左上のマスに対応させます。ビットが左にずれるごとに左のマスにずれていき、8bit左にずれた地点で、一つ上のマスに移動するような対応とします。
ビット演算を繰り返すにしたがって、行った演算に従って64bit整数中のそれぞれのビットが移動します。冒頭の画像や以下に示す画像では、それぞれのビットに元の盤面での位置ごとに違う色を割り当ててやって、各演算ごとに動かしています。こうすることで、ビットの移動が視覚的に追跡できてアルゴリズムの理解が容易になります。
さて、盤面上で左右方向に並んだ駒を8bitベクトルとして得ることを考えます。この際、着目する左右方向の列として8通りの列を選ぶことができます。画像中のそれぞれの三角形の色相は、「元々の盤面でどの列に所属しているビットであるか」を示します。一方三角形の濃度は、列の中で何番目にあたるかを示します。
0から7までの自然数nを固定して、n番目の列に着目するとします。n={0,1,2,3,4,5,6,7}について、それぞれ{赤,橙,金,草,緑,水,紺,紫}色に対応させています。色の選択は、CIELAB表色系において明度や色相に相当するパラメータをずらしていくことで行いました。sRGBのディスプレイで表示すると色が変になったり区別がつきにくくなったりしたので、比較的マシになるパラメータを探して決定しました(MacBook Airで作業していたものの、他のディスプレイでは違うかもしれません。また、色覚異常がある場合の見え方などは考慮していません。ご容赦ください。)。
n番目の列を8bitビットベクトルとして取り出すためには、nビットだけシフトするといった、nの値に依存する処理が当然必要となります。n=0のときの処理を追跡するのが東北東の方角にある三角形です。そこから反時計回りに、n=1、n=2…のときの処理を追跡させて、東南東の方角においてn=7のときの処理を追跡させます。元々の盤面においてn番目の列以外に所属するビットが三角形の中に入るとすれば、そのビットは8bitベクトルの中には現れない余計なビットということになります。つまり、決まった方角の三角形は決まった色が入るべきであって、そうでなければ余計ということになります。余計である場所には、分かりやすくするためにグレーの線をいれています。
8bitベクトルを得て、そこから裏返る石の8bitベクトルを得て、元の盤面上に復元するという処理ですが、裏返る石を得る部分はビットの移動には関係ないので、省略して続けて書いてしまっています。
元々の盤面。nをy座標(xy座標は、右下端が0で左上端が7。以下同様)とする。
n×8ビット右シフト
ビットマスク
8bitのベクトルが得られました。
n×8ビット左シフト
元の盤面上の位置に復元されました。
元々の盤面。nはx座標。
nビット右シフト
ビットマスク
1 0 0 0 0 0 0 0
0 1 0 0 0 0 0 0
0 0 1 0 0 0 0 0
0 0 0 1 0 0 0 0
0 0 0 0 1 0 0 0
0 0 0 0 0 1 0 0
0 0 0 0 0 0 1 0
0 0 0 0 0 0 0 1
を掛ける
56bit右シフト
8bitのベクトルが得られました。
1 0 0 0 0 0 0 0
0 1 0 0 0 0 0 0
0 0 1 0 0 0 0 0
0 0 0 1 0 0 0 0
0 0 0 0 1 0 0 0
0 0 0 0 0 1 0 0
0 0 0 0 0 0 1 0
0 0 0 0 0 0 0 1
を掛ける
ビットマスク
7-nビット右シフト
元の盤面上の位置に復元されました。
元の盤面。nは (y座標 - x座標) (mod 8)。
n×8ビット右循環シフト
ビットマスク
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
を掛ける
56bit右シフト
8bitのベクトルが得られました。
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
を掛ける
ビットマスク
n×8ビット左循環シフト
元の盤面上の位置に復元されました。
元の盤面。nは (y座標 + x座標 - 7) (mod 8)。
n×8ビット右循環シフト
ビットマスク
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
を掛ける
56bit右シフト
8bitのベクトルが得られました。
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 1
を掛ける
ビットマスク
n×8ビット左循環シフト
元の盤面上の位置に復元されました。
ここまでの画像は、一旦テキスト形式として元になるデータを記述しておいて、Parsecでデータを読み取って適当なデータ構造に格納し、それをDiagramsで処理して描画するという形で生成しています。なお、元になるデータはどうせプログラムの実行結果を示すものなのだから、ビットボードの実際の実装を走らせることで自動生成することも考えたのですが、オーバーフローやアンダーフローの情報が消えてしまうので手書きを選びました。なおテキスト形式のデータは画像のalt属性としてこっそり埋め込んでいます。
ライブラリのDiagramsに関してですが、関数型プログラミングらしいcomposableなやりかたで画像を構築できるのは中々小気味良いと感じました。ただ、APIが可能な限り型クラスで抽象化されているので、どういう型クラスで抽象化されているのか慣れるまでが大変です。 公式のチュートリアル を見れば雰囲気は分かった気になるのですが、チュートリアルに現れない望みの図形を描こうとすると結局Haddockのドキュメントや実装のソース自体を読まないとどうにもなりません。ドキュメントに嘘は見当たらないし、ソースコードもバックエンドの操作を扱う部分はいざ知らないが比較的高級なコンビネータ部分は読みやすかったので、悪くないとは思います。
以下がソースコードです。 drawBoardWithFlow 関数以下が、Diagramsによる描画処理となります。
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, TypeFamilies #-}
import Control.Applicative
import Data.Foldable (foldMap)
import Data.Monoid
import System.IO (hPutStrLn, stderr)
import System.Environment (getArgs)
import Data.Array
import Text.Parsec.String
import Text.Parsec hiding ((<|>))
import Data.Char (digitToInt)
import Data.Colour.CIE (cieLAB, Chromaticity, mkChromaticity)
import Diagrams.Backend.Cairo
import Diagrams.TwoD.Size
import Diagrams.TwoD.Text
import Diagrams.Prelude hiding (position, (<>))
-- types
data BoardRange = R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 deriving (Ix, Enum, Bounded, Ord, Eq, Show)
newtype LaneIx = LaneIx BoardRange deriving (Ix, Enum, Bounded, Ord, Eq, Show)
newtype BoardRowIx = BoardRowIx BoardRange deriving (Ix, Enum, Bounded, Ord, Eq, Show)
newtype BoardColIx = BoardColIx BoardRange deriving (Ix, Enum, Bounded, Ord, Eq, Show)
newtype ColorRowIx = ColorRowIx BoardRange deriving (Ix, Enum, Bounded, Ord, Eq, Show)
newtype ColorColIx = ColorColIx BoardRange deriving (Ix, Enum, Bounded, Ord, Eq, Show)
data Position = Position (Array LaneIx (Maybe (ColorRowIx, ColorColIx)))
data Board = Board (Array BoardRowIx (Array BoardColIx Position))
data BoardWithFlow = BoardWithFlow (Maybe Board) Board (Maybe Board)
-- main
main :: IO ()
main = do
inputPath <- head <$> getArgs
res <- parseFromFile boardWithFlow inputPath
case res of
Right brdF -> renderCairo (inputPath ++ ".svg") (mkSizeSpec (Just 328) Nothing) $ drawBoardWithFlow brdF
Left err -> hPutStrLn stderr $ show err
-- parser
arrayRange :: (Bounded a, Ix a) => (a, a)
arrayRange = (minBound, maxBound)
boardWithFlow = BoardWithFlow <$> optionMaybe (try (board <* ovfSep)) <*> board <*> optionMaybe (try (udfSep *> board))
ovfSep = string ">>>" <* newline
udfSep = string "<<<" <* newline
board = Board . listArray arrayRange <$> count 8 line
line = listArray arrayRange <$> count 8 position <* newline
position = Position <$> (numbers <|> strictNumbers) <* skipMany (char ' ')
numbers = listArray arrayRange . zipWith (\i -> ((,) (toEnum i) <$>)) [0 .. 7] . reverse <$> count 8 numberMaybe
strictNumbers = (listArray arrayRange . reverse <$>) $ (:) <$> (char '!' *> strictNumberMaybe) <*> count 7 (char '-' *> strictNumberMaybe)
strictNumberMaybe = dontCare *> dontCare <|> Just <$> ((,) <$> number <*> number)
numberMaybe = dontCare <|> Just <$> number
number :: Enum e => Parser e -- deal with monomorphic restriction
number = toEnum . digitToInt <$> oneOf ['0' .. '7']
dontCare = char '_' *> pure Nothing
-- drawer
maybeHomo :: Monoid b => (a -> b) -> Maybe a -> b
maybeHomo f Nothing = mempty
maybeHomo f (Just a) = f a
drawBoardWithFlow :: (Backend b R2, Renderable (Path R2) b, Renderable Text b) => BoardWithFlow -> Diagram b R2
drawBoardWithFlow (BoardWithFlow mOvf brd mUdf) =
strutY 0.5
===
maybeHomo (\ovf ->
alignL (strutX 0.5 ||| (alignB $ drawBoard (1/128) white ovf) ||| strutX 0.3 ||| (moveOriginBy (0 ^& (-0.3)) . font "Futura" . fontSize 0.8 $ baselineText "overflow"))
===
alignL (padY 5 . lw 0 . fc black $ roundedRect 20.5 0.125 0.06125)
) mOvf
===
alignL (strutX 0.5 ||| (drawBoard (1/16) white brd) ||| strutX 4)
===
maybeHomo (\udf ->
alignL (padY 5 . lw 0 . fc black $ roundedRect 20.5 0.125 0.06125)
===
alignL (strutX 0.5 ||| (alignT $ drawBoard (1/128) white udf) ||| strutX 0.3 ||| (moveOriginBy (0 ^& 0.3) . font "Futura" . fontSize 0.8 $ topLeftText "underflow"))
) mUdf
===
strutY 0.5
drawBoard :: (Backend b R2, Renderable (Path R2) b) => Double -> Colour Double -> Board -> Diagram b R2
drawBoard bdw bgc (Board board) = centerXY $ g (elems board)
where
g = foldr (\line e -> f (elems line) === e) mempty
f = foldr (\pos e -> drawPosition bdw bgc pos ||| e) mempty
drawPosition :: (Backend b R2, Renderable (Path R2) b) => Double -> Colour Double -> Position -> Diagram b R2
drawPosition bdw bgc (Position ary) = bg bgc $ lw bdw (square 2) <> item
where
item = foldMap (\(li, mrc) -> maybe mempty (\(ri, ci) -> drawPiece li ri ci) $ mrc) $ assocs ary
drawPiece :: (Backend b R2, Renderable (Path R2) b) => LaneIx -> ColorRowIx -> ColorColIx -> Diagram b R2
drawPiece li ri ci = guard <> piece
where
li' = fromEnum li
ri' = fromEnum ri
ps = [1 ^& 0, 1 ^& 1, 0 ^& 1, (-1) ^& 1, (-1) ^& 0, (-1) ^& (-1), 0 ^& (-1), 1 ^& (-1), 1 ^& 0]
piece = lw (1 / 128) . lc black . fc (pieceColor ri ci) $ strokeLocLoop . mapLoc closeLine $ fromVertices [origin, ps !! li', ps !! (li'+1)]
guard | fromEnum li' == ri' = mempty
| otherwise = lw 0 . fc neutral . strokeLocLoop . mapLoc closeLine $ fromVertices [0.375 *. (ps !! li'), 0.375 *. (ps !! (li'+1)), 0.625 *. (ps !! (li'+1)), 0.625 *. (ps !! li')]
-- CIELAB: tuned parameters to make it viewable on sRGB monitor (tested on MacBook Air)
pieceColor :: ColorRowIx -> ColorColIx -> Colour Double
pieceColor ri ci = cieLAB whitePointD65 l (sat * cos deg) (sat * sin deg)
where
l = 85 - fromIntegral (fromEnum ci) * 6.5
deg = pi * [0.03, 0.28, 0.53, 0.72, 1.00, 1.28, 1.63, 1.80] !! fromEnum ri
sat = 47
neutral :: Colour Double
neutral = cieLAB whitePointD65 (85 - 3.5 * 6.5) 0 0
whitePointD65 = mkChromaticity 0.31271 0.32902
SVGBackendによってネイティブでSVG画像を出力することもできるのですが、フォントを指定しようと思うとCairoBackendによってcairoを通す必要があります(Futuraを使いたかったのです)。OS Xへのcairoのインストールは、まずXQuartzをインストールしてから、ソースコードを普通にmakeすれば大丈夫でした。cairoが入ってしまえば、Diagramsもそのcairoサポートもcabalであっさり入ります。
ParsecとDiagrams以外には特に凝ったライブラリは使わずにゴリゴリと書いています。Diagramsを使ったコーディングがだいたいどんな感じかという雰囲気は出ていると思います。図形はモノイドであって、モノイド同士の二項演算によって重ねていけるのは結構面白いです。
載せるとあまりに記事が長くなりそうなので割愛します。 https://github.com/grafi-tt/tatsuki/blob/2f85835c5aab83c3c60999a37a51fa4794c84285/Reversi/Tatsuki/BitBoard.hs を見てください。暗号的ですが。
ビット演算に記号が無いといくらなんでも実装がきついものの、一般的なビット演算の記号はモナドの記号と被るし循環シフトの記号も考えないといけないので、いっそあやしいUnicodeの記号を使っているところが面白い点です。GHC7.6.xでは循環シフト命令の出力がサポートされていない https://ghc.haskell.org/trac/ghc/ticket/7337 のは残念です。LLVMバックエンドではStrength Reductionで抽出されるらしいですが。