Freeモナドについて今更勉強してみた

5年ほど前、Freeモナドという言葉がHaskell界隈でよく見られました。
僕のフォローしている人たちが次々に解説記事をアップしていたように思います。
5年たった今になって、Freeモナドについて興味が湧いてきたので記事を書いてみることにしました。

Freeモナドの定義に行く前にFree型について説明します。

-- The kind of f is * -> * like Maybe, [].
-- The kind of a is * like Int, Char, [Char].
data Free f a = Pure a | Free (f (Free f a)) 

ここでfはカインド * -> * を持つ型コンストラクタであり、あとで述べるようにFunctorのインスタンスです。
aはカインド * のただの型です。
fが[]、aがIntの場合について調べてみましょう。

free1 :: Free [] Int
free1 = Pure 10

free2 :: Free [] Int
free2 = Free [Free [Free [Free []]]]

free3 :: Free [] Int
free3 = Free [Pure 10]

これら3つの定数関数はすべてFree [] aの型を持ちます。
直感的に言うとリストもリストのリストのリストもただの整数もすべて同じ型になっています。
これだけではFree型をどう使っていいのかわかりません。

これをモナドにしてみましょう。

-- functor is typeclass which "fmap" is defined
-- (<$>) :: Functor f => (a->b) -> f a -> f b
-- (<$>) = fmap
instance Functor f => Functor (Free f) where
  fmap f (Pure a) = Pure (f a)
  fmap f (Free fa) = Free (fmap (fmap f) fa)

instance Functor f => Monad (Free f) where
    return = Pure
    Pure a >>= k = k a
    Free fm >>= k = Free (fmap (>>= k) fm)

モナドになると何が良いのでしょうか?
簡単なゲームを作る例を見ながら、Freeモナドの利点を確認しましょう。

このゲームは

  1. 入力を受け取る
  2. 文字列を出力する
  3. 一秒待つ

の3つの要素の組み合わせで構成されています。
ゲームを表すデータ型がこれです。

data Game cont = GetInput (String -> cont) | Render String cont | Wait cont

instance Functor Game where
  fmap f (GetInput g) = GetInput (f . g)
  fmap f (Render str cont) = Render str (f cont)
  fmap f (Wait cont)     = Wait (f cont)

各コンストラクタは動作を行ったあとの続きの計算を持ちます。
例えば、GetInput fだったら入力を受け取ってfに渡すことで
続きの計算contを計算し、contを実行します。

ここでGameデータ型をFreeモナドと組み合わせて使う利点を説明します。

game1 :: Free Game ()
game1 = Free (Wait (Free (Render "Hello" (Pure ()))))

game1' :: Free Game ()
game1' = (Free (Wait (Pure ()))) >>  (Free (Render "Hello" (Pure ())))

一秒待って"Hello"と出力するゲームを2つの方法で記述してみました。
game1は愚直な記述、game1'は>>演算子を用いた記述です。

実はこの2つは全く同じものです。
game1'を定義にしたがって展開してみます。

(Free (Wait (Pure ()))) >>  (Free (Render "Hello" (Pure ())))
==> (Free (Wait (Pure ()))) >>= (\x -> (Free (Render "Hello" (Pure ()))))
==> Free (fmap (>>= (\x -> (Free (Render "Hello" (Pure ()))))) (Wait (Pure ())))
==> Free (Wait ((>>= (\x -> (Free (Render "Hello" (Pure ()))))) (Pure ())))
==> Free (Wait ((Pure ()) >>= (\x -> (Free (Render "Hello" (Pure ()))))))
==> Free (Wait (Free (Render "Hello" (Pure ()))))

同じになりましたね。
モナドの枠組みを使えばGameデータ型同士を簡単に合成できることがわかります。

input :: (String -> Free Game ()) -> Free Game ()
input f = Free (GetInput f)

render :: String -> Free Game ()
render str = Free (Render str (Pure ()))

wait :: Free Game ()
wait = Free (Wait (Pure ()))

miniGame = do
  render "Please input your name."
  input (\x -> render $ "Your name is " ++ x)
  wait
  render "End"

miniGame関数ではdo記法で3種類のGameコンストラクタを合成しています。
あとはFree Game ()をIO ()に変換する、つまり実際の入出力を行う部分を書けば完成です。

runGame :: Free Game () -> IO ()
runGame (Pure ()) = return ()
runGame (Free (Wait cont)) = runGame cont
runGame (Free (GetInput f)) = getLine >>= \s -> runGame (f s)
runGame (Free (Render str cont)) = putStrLn str >> runGame cont

main :: IO ()
main = runGame miniGame

コンパイルしてmain関数を実行すると名前を聞いてくれます。(ソースコードはこの記事の末尾にあります。)

結局Freeモナドを使うとどんな利点があるのでしょうか。
この記事の例ではゲームの構造と入出力が分離できています。
つまり、テストがしやすいということが言えます。
またゲームの構造だけ作っておいてあとで入出力の部分を差し替えたりするのも簡単です。
Freeモナドを使った2Dゲーム用のライブラリというのもあります。

参考

Freeモナドって何なのさっ!? - capriccioso String Creating(Object something){ return My.Expression(something); }

そろそろFreeモナドに関して一言いっとくか - モナドとわたしとコモナド

以下ソースコード

続きを読む

型レベル自然数を使って型付き行列を作ってみた

#動機 研究で行列計算ライブラリを使っているのですが、numpyはなぜか異なる型の行列同士を足せてしまいます。 このせいでデバッグがめちゃくちゃ大変でした。

こんな単純な間違いはコンパイル時に弾いてくれればいいのにと思ったので、違った型の行列は足せないようなちょっとしたライブラリを作ってみました。

※行列を安全に計算したい人のためには

Numeric.LinearAlgebra.Static

↑のライブラリが既に存在しました。不勉強ですみません。この記事は「型レベル自然数ってこんなに簡単に(僕でも)使えるんだ」、程度に読んでください。

型レベル変数

最近のGHCでは、自然数をパラメーターとするデータ型を定義できる。固定長リストの長さを型に持たせるとか、行列の大きさを型に持たせるとか、そういうことができる

引用元:Haskell (GHC) の型レベル自然数とリフレクションを試してみる

行列の大きさの情報を型に持たせることができる。 →やってみました

仕様

  • 行列の足し算・掛け算をサポートする・
  • 足し算/掛け算できないものを計算しようとしたらコンパイル時にエラーにする

実装

{-# LANGUAGE DataKinds, KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}

module SizeFixedMatrix where
import GHC.TypeLits
import Data.List.Split
import Data.List

data SizeFixedMatrix (h :: Nat) (w :: Nat) = MakeMartix [[Integer]] deriving (Eq,Show)

mat1 = MakeMartix [[1,2],[2,3]] :: (SizeFixedMatrix 2 2)
mat2 = MakeMartix [[2,9],[1,3],[4,3]] :: (SizeFixedMatrix 3 2)
mat3 = MakeMartix [[5,9],[3,3],[0,3]] :: (SizeFixedMatrix 3 2)


add :: SizeFixedMatrix p q -> SizeFixedMatrix p q -> SizeFixedMatrix p q
add (MakeMartix m1) (MakeMartix m2) = MakeMartix (map (\(a,b) -> map (\(c,d) -> c+d) (zip a b)) (zip m1 m2))

mul :: SizeFixedMatrix p q -> SizeFixedMatrix q r -> SizeFixedMatrix p r
mul (MakeMartix m1) (MakeMartix m2) = MakeMartix $ splitEvery (length (head m2)) [sum $ zipWith (*) v w | v <- m1, w <- transpose m2]

…これだけです。拍子抜けするくらい簡単に作れました。もう少し凝ったものを作りたかったのですが、締切に間に合いそうにありませんでした。

一応ちょこっとだけ解説しておくと

SizeFixedMatrix p q

が縦p行横q列の行列の型になります。

不適切な型同士でaddしたりmulしたりするとコンパイルエラーになるので安心してプログラミングできます。

結果

$stack ghci
(省略)
*Main FiniteField Lib SizeFixedMatrix> mat1
MakeMartix [[1,2],[2,3]]
*Main FiniteField Lib SizeFixedMatrix> mat2
MakeMartix [[2,9],[1,3],[4,3]]
*Main FiniteField Lib SizeFixedMatrix> mat3
MakeMartix [[5,9],[3,3],[0,3]]

足し算

*Main FiniteField Lib SizeFixedMatrix> add mat1 mat2

<interactive>:4:10: error:
    • Couldn't match type ‘3’ with ‘2’
      Expected type: SizeFixedMatrix 2 2
        Actual type: SizeFixedMatrix 3 2
    • In the second argument of ‘add’, namely ‘mat2’
      In the expression: add mat1 mat2
      In an equation for ‘it’: it = add mat1 mat2

mat1は2行2列の行列型、mat2は3行2列の行列型なので足せないと言われてしまいます

*Main FiniteField Lib SizeFixedMatrix> add mat2 mat3
MakeMartix [[7,18],[4,6],[4,6]]

掛け算

*Main FiniteField Lib SizeFixedMatrix> mul mat1 mat2

<interactive>:8:10: error:
    • Couldn't match type ‘3’ with ‘2’
      Expected type: SizeFixedMatrix 2 2
        Actual type: SizeFixedMatrix 3 2
    • In the second argument of ‘mul’, namely ‘mat2’
      In the expression: mul mat1 mat2
      In an equation for ‘it’: it = mul mat1 mat2
*Main FiniteField Lib SizeFixedMatrix> 

mat1*mat2(行列積)は存在しません

*Main FiniteField Lib SizeFixedMatrix> mul mat2 mat1
MakeMartix [[20,31],[7,11],[10,17]]

感想

型レベル変数などという難しい名前の機能をはじめて使いました。案外簡単に使えたので、他にも応用できると思います。

参考文献

CTF入門記

11月の終わりからCTFをかじり始めました。この熱意がいつまでつづくのか分からないのですがとりあえずこの二週間くらいでやったことを書いてみようと思います。

動機

CTFは高校の先輩に一年ほど前から勧められていたのですが放置していました。最近寒いし何か家の中でできることないかなと考えてCTFを思い出したので初めてみました。

絶望

別にPCを初めて触るわけでもないし、ksnctfのポイントの低い問題ならなんとかなるやろ…


舐めてました。難しすぎる。というわけで梅田の丸善ジュンク堂
セキュリティコンテストチャレンジブック -CTFで学ぼう! 情報を守るための戦い方-
をお買い上げてしまいました。その後も

などと(初心者なので)当然すぎる知識不足を露呈し続けました。

感動


初めて自力で解いたのはksnctf - 8 Basic is secure?だったと思います。嬉しかったですね。(小並感)

n番煎じのyesod入門ーとりあえずプロジェクトを作ってみる

yesodとは

haskellで作られたweb frameworkです。
Yesod Web Framework for Haskell

インストール

公式サイトのYesod quick start guideのとおりに

cabal install yesod-platform yesod-bin

すると依存関係がぶち壊れる可能性大なので
cabal-devを使ってインストールするのがおすすめ。*1

cabal install cabal-dev
mkdir -p ~/haskell/yesod
cd /haskell/yesod
cabal-dev install yesod-platform yesod-bin

*2 *3

プロジェクト作成

./cabal-dev/bin/yesod init

プロジェクト名ははmyFirstYesod、データベースはMySQLを使うことにしました。

起動

cd myFirstYesod/
../cabal-dev/bin/yesod --dev devel

http://localhost:3000/にアクセスするとテストページが表示されるはずです。

トラブルシューティング1

ここで

cabal: Cannot find the program 'ghc' at 'yesod-ghc-wrapper' or on the path

というエラーメッセージが出たら

cabal-dev/bin

cabal-dev/lib

にパスを通しましょう。

トラブルシューティング2

Resolving dependencies...
Configuring myFirstYesod-0.0.0...
cabal: At least the following dependencies are missing:
aeson -any,
conduit >=1.0,
fast-logger >=2.0,
hamlet ==1.1.*,
以下略

こんな感じのエラーが出たら...
"--dev"オプションをつけて起動していますか?
"--dev"オプションをつけないとcabal-devでインストールしたlibraryを読み込みません。*4

*1:最新版のcabalでcabal sandboxを使うのもアリかも。やったことないけど。2013年8月現在のHaskell開発環境 - maoeのブログ

*2:cabal-devについてはここを参考にしました。cabal の使い方 - melpon日記 - HaskellもC++もまともに扱えないへたれのページ

*3:そもそもこのインストール方法はここの丸パクリです。Yes, Yesod! - Just $ A sandbox

*4:yesodのマニュアルが見つからなかったのでこれは未確認情報です。

Haskellでインベーダーゲームを作ってみた

夏休みがあまりに暇なのでインベーダーゲームまがいの物を作ってみました。
ゲーム全体の状態を持つ変数をIORefで包み
一定時間毎に更新することでゲームの状態を変更・保持しています。
(IORefを使うとIOモナドの中で変数が更新できます。(実はよく分かってないのですが…))
  
基本的な四角形の描画、テクスチャの貼り付けは↓のコピペです。
HaskellとOpenGLを使って四角形を描画しテクスチャを貼り付ける - 春まで冬眠します
  
スクリーンショット

   

import Graphics.UI.GLUT hiding (Bitmap)
import qualified Graphics.Rendering.OpenGL.GL as GL
import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )
import Data.IORef
import Codec.Picture.Repa
import Data.Array.Repa as R hiding (reshape , map )
import qualified Data.Array.Repa.Repr.ForeignPtr as RF
import Foreign.ForeignPtr
import Data.Word()
import Control.Applicative
import Control.Monad
import Unsafe.Coerce

data Fighter = Fighter { xfighter::GLfloat , yfighter::GLfloat }
data Bullet = Bullet { xbullet::GLfloat , ybullet::GLfloat ,lbullet::Int  }
data Enemy = Enemy { xenemy::GLfloat , yenemy::GLfloat , lenemy::Int }
data Flame = Flame { xflame::GLfloat , yflame::GLfloat , lflame::Int }
data State = Start | Main deriving (Eq)
data Game = Game { fighter::Fighter,bullets::[Bullet],enemies::[Enemy],flames::[Flame],state::State,ftex::TextureObject,btex::TextureObject,etex::TextureObject,fltex::TextureObject,sttex::TextureObject }

cz :: GLfloat
cz = 50 -- character size

timerInterval :: Timeout
timerInterval = 40

inite h = map (\i->(Enemy i h 1)) [100,170..500]

main :: IO ()
main = do 
    
    --GLUTの初期化
    initialDisplayMode $= [RGBAMode, DoubleBuffered]
    initialWindowSize $= Size 640 480
    initialize "" []

    --ウィンドウを作る
    createWindow "invader"

    --テクスチャを読み込む
    texbullet <- loadTextureFromFile "./bullet.jpg"
    texfighter <- loadTextureFromFile "./fighter.jpg"
    texenemy <- loadTextureFromFile "./enemy.jpg"
    texflame <- loadTextureFromFile "./flame.jpg"
    texstart <- loadTextureFromFile "./start.jpg"
    texture Texture2D $= Enabled
    GL.blend $= GL.Enabled
    GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
    
    game <- newIORef (Game (Fighter 50 50) [(Bullet (1000) 50 0),(Bullet (1000) 50 0),(Bullet (1000) 50 0)] (concat [inite 450,inite 380,inite 310]) [] Start texfighter texbullet texenemy texflame texstart)
    

    displayCallback $= display game
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just (keyboardProc game)
    addTimerCallback timerInterval $ timerProc (display game)
    mainLoop

processBullet :: [Enemy] -> [Bullet] -> [Bullet]
--processBullet es bs = ((map f1) . (map f2) . (map f3)) bs
processBullet es bs = map (f1 . f2 . f3) bs
    where f1 b = b{ybullet=ybullet b+4}
          f2 b = if (ybullet b)>505 then b{lbullet=0} else b
          f3 b = if any (\e->g1 (lenemy e)>0&&g1 (xbullet b-xenemy e)<cz/2&&g1 (ybullet b-yenemy e)<cz/2) es
                    then b{lbullet=0}
                    else b
          g1 f = if f>0 then f else -f

processEnemy :: [Bullet] -> [Enemy] -> [Enemy]
--processEnemy bs es = ((map f4).(map f1).(map f2)) es
processEnemy bs es = map (f4 . f1 . f2) es
    where f1 e = if lenemy e`div`20`mod`2==0 then e{xenemy=xenemy e-2} else e{xenemy=xenemy e+2}
          f2 e = if any (\b->(lbullet b)>0&&g1 (xbullet b-xenemy e)<cz/2&&g1 (ybullet b-yenemy e)<cz/2) bs
                    then e{lenemy=0}
                    else e     
          g1 f = if f>0 then f else -f
          f4 e = if lenemy e>0 then e{yenemy=yenemy e-0.2,lenemy=lenemy e+1} else e

processFlame :: [Bullet] -> [Enemy] -> [Flame] -> [Flame]
processFlame bs es fs = ((Prelude.++ f4) . (filter f2) . (map f1)) fs
    where f1 f = f{lflame=lflame f-1}
          f2 f = (lflame f) > 0
          f3 (b,e) = if (lbullet b)>0&&(lenemy e)>0&&
                        g1 (xbullet b-xenemy e)<cz/2&&g1 (ybullet b-yenemy e)<cz/2
                        then [Flame {xflame=xenemy e,yflame=yenemy e,lflame=10}]
                        else []
          f4 = concat (map f3 g2)
          g1 f = if f>0 then f else -f
          g2 = concat (map (\b-> (map (\e->(b,e)) es)) bs)
          
processGame :: Game -> Game
processGame g = if state g == Main 
                   then g{bullets=processBullet (enemies g) (bullets g),
                              enemies=processEnemy (bullets g) (enemies g),
                              flames=processFlame (bullets g) (enemies g) (flames g)}
                   else g     

display :: IORef Game -> IO ()
display game = do
    g <-readIORef game
    modifyIORef game processGame
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    loadIdentity
    
    renderGame g
    swapBuffers

renderGame :: Game -> IO()
renderGame g = if state g == Main 
    then do
         mapM_ (renderBullet (btex g)) (bullets g)
         mapM_ (renderEnemy (etex g)) (enemies g)
         mapM_ (renderFlame (fltex g)) (flames g)
         render (xfighter (fighter g)) (yfighter (fighter g)) (ftex g)
    else do
         currentColor $= Color4 1 1 1 1 
         textureBinding Texture2D $= Just (sttex g)
         preservingMatrix $ do
           -- translate (Vector3 0 0 (0::Double))
             renderPrimitive Quads $ do
                 texCoord2f (TexCoord2 0 0)
                 vertex3f (Vertex3 0 0 0.0)
                 texCoord2f (TexCoord2 0 1)
                 vertex3f (Vertex3 0 480 0.0)
                 texCoord2f (TexCoord2 1 1)
                 vertex3f (Vertex3 640 480 0.0)
                 texCoord2f (TexCoord2 1 0)
                 vertex3f (Vertex3 640 0 0.0)        

renderBullet :: TextureObject -> Bullet -> IO ()
renderBullet texbullet b = if lbullet b > 0 then render (xbullet b) (ybullet b) texbullet
                                            else return ()     

renderEnemy :: TextureObject -> Enemy -> IO ()          
renderEnemy texenemy e = if lenemy e > 0 then render (xenemy e) (yenemy e) texenemy
                                         else return ()     

renderFlame :: TextureObject -> Flame -> IO()
renderFlame texflame f = if lflame f > 0 then render (xflame f) (yflame f) texflame
                                         else return ()     

render :: GLfloat -> GLfloat -> TextureObject -> IO ()
render x y tex = do
    currentColor $= Color4 1 1 1 1 
    textureBinding Texture2D $= Just tex
    preservingMatrix $ do
        -- translate (Vector3 0 0 (0::Double))
        renderPrimitive Quads $ do
            texCoord2f (TexCoord2 0 0)
            vertex3f (Vertex3 (x-cz/2) (y-cz/2) 0.0)
            texCoord2f (TexCoord2 0 1)
            vertex3f (Vertex3 (x-cz/2) (y+cz/2) 0.0)
            texCoord2f (TexCoord2 1 1)
            vertex3f (Vertex3 (x+cz/2) (y+cz/2) 0.0)
            texCoord2f (TexCoord2 1 0)
            vertex3f (Vertex3 (x+cz/2) (y-cz/2) 0.0)

texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()
vertex3f = vertex :: Vertex3 GLfloat -> IO ()
          

--タイマが呼ばれるたびにactを繰り返す
timerProc act = do
    act
    addTimerCallback timerInterval $ timerProc act

--ウィンドウのサイズが変更された時の処理
reshape :: Size -> IO()
reshape (Size w h)=do
    viewport $= (Position 0 0, (Size w h)) --ウィンドウ全体を使う
    matrixMode $= Projection
    loadIdentity
    ortho 0.0 640.0 0.0 480.0 (-1000.0) 1000.0
    matrixMode $= Modelview 0 

keyboardProc :: IORef Game -> Key -> t -> t1 -> t2 -> IO ()
keyboardProc game ch st _ _
    | ch == SpecialKey KeyLeft  = modifyIORef game (\g->g{fighter=changeX (-2) (fighter g)})
    | ch == SpecialKey KeyRight = modifyIORef game (\g->g{fighter=changeX 2 (fighter g)})
    | ch == Char ' ' = space (readIORef game)
    | otherwise            = return ()  
    where changeX dx f = if 0+cz<=xfighter f+dx&&xfighter f+dx<=640-cz 
                            then  f { xfighter = xfighter f + dx }
                            else f
          shot = modifyIORef game (\g->g{bullets=shotProcess (fighter g) (bullets g)})
          space g' = do
              g <- g'
              if state g == Main 
                  then shot 
                  else modifyIORef game (\g->g{state=Main})
    
          
shotProcess :: Fighter -> [Bullet] -> [Bullet]
shotProcess f bs = if (all (\b->ybullet b-50>yfighter f) bs) && (any (\b->lbullet b==0) bs)
                       then concat [[(head (filter (\b->lbullet b==0) bs)){xbullet=xfighter f,ybullet=yfighter f,lbullet=1}],
                                    (tail (filter (\b->lbullet b==0) bs)),
                                    (filter (\b->lbullet b/=0) bs)]
                       else bs


-- テクスチャをファイルから読み込む
-- 何をやっているのか未だによくわからない
-- FreeGameのサンプルをちょっといじったもの
loadTextureFromFile :: FilePath -> IO GL.TextureObject
loadTextureFromFile path = do
    content <- delay <$> (flipVertically.imgData) <$> either error id <$> (readImageRGBA path)
    let (Z :. width :. height :. _) = R.extent content
    [tex] <- GL.genObjectNames 1
    GL.textureBinding GL.Texture2D GL.$= Just tex
    GL.textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
    fptr <- liftM RF.toForeignPtr $ R.computeP $ content
    withForeignPtr fptr
        $ GL.texImage2D Nothing GL.NoProxy 0 GL.RGBA8 (GL.TextureSize2D (gsizei width) (gsizei height)) 0
        . GL.PixelData GL.RGBA GL.UnsignedInt8888
    return tex

gsizei :: Int -> GL.GLsizei
{-# INLINE gsizei #-}
gsizei x = unsafeCoerce x

Codeforces Round #176 div 2

久しぶりに(一年ぐらい)Codeforcesに出ました。
正解したのはA問題のみというひどい結果でした。
B問題はコーナーケースで落ち、C問題以降は
手も足も出ませんでした。
もう一度初心に帰って勉強する必要性を感じました。

A. IQ Test

  問題概要
    4x4の升目が与えられます。各升には"."または"#"が書かれています。
    16個の升のどれか一つを書き換えることによって同じ記号が書かれた
    2x2の正方形を得ることができるなら"YES"、できないなら"NO"と出力しなさい。
    ただし、何も書き換えない状態で条件を満たすなら"YES"と出力しなさい。
  解法
    16個の升のそれぞれについて書き換えて正方形が得られるかどうかを調べるだけです。
  ソースコード

#include <string>
#include <vector>
#include <algorithm>
#include <iostream>

using namespace std;

bool check(vector<string> &vs){
     for(int i=0;i<3;i++)
	  for(int j=0;j<3;j++)
	       if(vs[i][j]==vs[i+1][j]&&vs[i][j]==vs[i][j+1]&&vs[i][j]==vs[i+1][j+1])
		    return true;
     return false;
}

char opposite(char c){
     if(c=='#')return '.';
     else return '#';
}

int main(){
     vector<string> vs;
     for(int i=0;i<4;i++){
	  string s;
	  cin>>s;
	  vs.push_back(s);
     }
     string ans="NO";
     if(check(vs))
	  ans="YES";
     for(int i=0;i<4;i++)
	  for(int j=0;j<4;j++){
	       vs[i][j]=opposite(vs[i][j]);
	       if(check(vs))
		    ans="YES";
	       vs[i][j]=opposite(vs[i][j]);
	  }
     cout<<ans<<endl;
     return 0;
}

B. Pipeline

  問題概要
    自然数nとkが与えられます。
    k以下の互いに異なる自然数l_1,l_2,l_3,...,l_mが
    l_1-1+l_2-1+l_3-1+...+l_m-1=n-1
    を満たすときmの最小値を求めなさい。
    ただし、n=1のときはm=0です。
    (これは問題から主要な部分を抽出したものであり
     実際の問題文の日本語訳とはかなり異なります。)
  解法
    l_1-1+l_2-1+l_3-1+...+l_m-1>=n-1
    となるmを見つければ良いので(勘)
    l_1=k,l_2=k-1,l-3=k-2,...,l-m=k-m+1とします。
    このとき
    l_1-1+l_2-1+l_3-1+...+l_m-1=(k+k-m+1)*(k-k+m-1+1)/2-m であるので
    mの値を二分探索すれば良いです。
  ソースコード

#include <iostream>
#include <algorithm>

using namespace std;
typedef long long LL;

int main(){
     LL n,k;
     cin>>n>>k;
     if(n==1){
	  cout<<0<<endl;
	  return 0;
     }
     if(n<=k){
	  cout<<1<<endl;
	  return 0;
     }
     LL u=k-1,d=0;
     for(int i=0;i<100;i++){
	  LL m=(u+d)/2;
	  LL a=(k-m)*(k+m-1)/2;
	  if(n-1<=a)
	       d=m;
	  else
	       u=m;
     }
     // cout<<"u="<<u<<" d="<<d<<endl;
     if(n-1<=(k-u)*(k+u-1)/2)
	  cout<<k-u<<endl;
     else if(n-1<=(k-d)*(k+d-1)/2)
	  cout<<k-d<<endl;
     else
	  cout<<-1<<endl;
     return 0;
}

Marathon Match 78 の記録

最終的なアルゴリズム

  左上(0,0)を出発点として、盤面上に一本の線を引いていく。
  1マス進むことを一手として10手探索してはもっとも高い点数が
  得られるものを最終的な解に追加していく。このとき輪っかができなくなるものは除外する。
  探索と解の追加を繰り返して出発点に戻ってきたら終了する。

経過

  1:左上を始点として点数が最大になる輪っかを作るようなビーム探索を書く。
   (当時は自分が書いているものがビーム探索であるとは知らなかった。)
   ※ビーム探索とは幅優先探索において評価の高い解のみを残すような探索のこと。
  2:うーん、遅すぎる。
  3:だんだん保持する解の個数を減らす。
  4:あーもうこれは保持する解を一つにしてもいいんじゃない。
  5:保持する解を一つにする。
  6:10手づつ深さ優先探索して暫定解に付け足していって輪っかができたら終了するアルゴリズムに変更する。

結果

  105人中57位。
  初めてのマラソンマッチにしては健闘したと見るか、
  修行が足りないと見るかは判断が分かれるところ。(僕の頭の中では)

反省点

  大量のテストを簡単に実行できる環境を早めに構築するべきだった。
  (最終的にはコマンド一つで100個のテストケースを試すようにした。)
  更に、テストから得られた結果を簡単に判断できるようにするべきだった。

良かった点

  公式のビジュアライザを改造して、サイズやfillRatioをコマンド引数で変更できるようにし、
  更に正しくない(輪っかになっていない)解も目で見れるようにしたのは良かった。

最終提出コード

#include <iostream>
#include <cstdio>
#include <cstdlib>
#include <cmath>
#include <string>
#include <vector>
#include <queue>
#include <map>
#include <set>
#include <algorithm>
#include <functional>
#include <cstring>
#include <sstream>

#define FOR(i,k,n)  for (int i=(k); i<(int)(n); ++i)
#define REP(i,n)    FOR(i,0,n)
#define FORIT(i,c)	for(__typeof((c).begin())i=(c).begin();i!=(c).end();++i)
#define SZ(i) ((int)i.size())
#define pb          push_back
#define mp          make_pair
#define ALL(X)      (X).begin(),(X).end()
typedef long long LL;

// #define DFS_DEPTH 11
#define MAX_ANS_LENGTH 20200
#define INF 100000000

using namespace std;

int dfsDepth=10;
int mv[4][2]={{-1,0},{1,0},{0,-1},{0,1}};
int c2m(char c){if(c=='U')return 0;if(c=='D')return 1;if(c=='L')return 2;if(c=='R')return 3;return INF;}
int iabs(int n){if(0<=n)return n;else return -n;}
vector<string> dia;
int H,W;
int isVisited[110][110];
int nVisit[110][110];
int nTouch[110][110];
int bfs[110][110];
string udlr="UDLR";
string snake;
int point;
pair<pair<int,int>,string> ans;
int ystart,xstart,yhead,xhead,ygoal,xgoal;
class BIT{
public:
     int bit[MAX_ANS_LENGTH+10];
     int sum(int i){
	  i++;
	  int s=0;
	  while(0<i){
	       s+=bit[i];
	       i-=i&-i;
	  }
	  return s;
     }
     void add(int i,int x){
	  i++;
	  while(i<=MAX_ANS_LENGTH+5){
	       bit[i]+=x;
	       i+=i&-i;
	  }
     }
};
BIT turnCount;    

int rorlturn(char s,char t){//left turn = 1 right turn = -1
     if(s=='U'){if(t=='L')return 1;if(t=='R')return -1;}
     if(s=='L'){if(t=='D')return 1;if(t=='U')return -1;}
     if(s=='D'){if(t=='R')return 1;if(t=='L')return -1;}
     if(s=='R'){if(t=='U')return 1;if(t=='D')return -1;}
     return 0;
}

bool isInLoop(const int w,const int v,const char n,const int y,const int x,const char m,const int nv){
     if(y==0||y==H||x==0||x==W)return false;
     //右回りのループを検出
     int yy=y,xx=x;
     if(m=='U')xx--;
     if(m=='D')xx++;
     if(m=='L')yy++;
     if(m=='R')yy--;
     if(0<isVisited[yy][xx]&&turnCount.sum(nv)-turnCount.sum(nVisit[yy][xx]+1)<=-3)
	  return true;
     //左回りのループを検出
     yy=y,xx=x;
     if(m=='U')xx++;
     if(m=='D')xx--;
     if(m=='L')yy--;
     if(m=='R')yy++;
     if(0<isVisited[yy][xx]&&turnCount.sum(nv)-turnCount.sum(nVisit[yy][xx]+1)>=3)
	  return true;
     int yf=w+mv[c2m(n)][0],xf=v+mv[c2m(n)][1];
     if(yf==0||yf==H||xf==0||xf==W)return false;
     //右回りのループを検出
     yy=yf,xx=xf;
     if(n=='U')xx--;
     if(n=='D')xx++;
     if(n=='L')yy++;
     if(n=='R')yy--;
     if(0<isVisited[yy][xx]&&turnCount.sum(nv-1)-turnCount.sum(nVisit[yy][xx]+1)<=-3&&rorlturn(n,m)==-1)
     	  return true;
     //左回りのループを検出
     yy=yf,xx=xf;
     if(n=='U')xx++;
     if(n=='D')xx--;
     if(n=='L')yy--;
     if(n=='R')yy++;
     if(0<isVisited[yy][xx]&&turnCount.sum(nv-1)-turnCount.sum(nVisit[yy][xx]+1)>=3&&rorlturn(n,m)==1)
     	  return true;
     return false;
}

pair<pair<int,int>,string> DFS(const int y,const int x,const string s,const int p,const char l){
     if(dfsDepth==SZ(s)){
	  return make_pair(make_pair(p,iabs(ygoal-y)+iabs(xgoal-x)),s);
     }else{
	  vector<pair<pair<int,int>,string> > res;
	  for(int i=0;i<4;i++){
	       int yy=y+mv[i][0];
	       int xx=x+mv[i][1];
	       if(yy<0||H<yy||xx<0||W<xx)
		    continue;
	       if(ygoal==H&&xgoal==W&&yy<xx)
	       	    continue;
	       if(ygoal==H&&xgoal==W&&yy==xx&&i==0)
	       	    continue;
	        if(ygoal==H&&xgoal==W&&y==x+1&&i==2)
	       	    continue;
	       vector<int> tpos;
	       string ss=s+udlr[i];
	       char ll=udlr[i];
	       if(i==0){
		    if(0<x) tpos.push_back((y-1)*1000+x-1);
		    if(x<W) tpos.push_back((y-1)*1000+x);
	       }else if(i==1){
		    if(0<x) tpos.push_back(y*1000+x-1);
		    if(x<W) tpos.push_back(y*1000+x);
	       }else if(i==2){
		    if(0<y) tpos.push_back((y-1)*1000+x-1);
		    if(y<H) tpos.push_back(y*1000+x-1);
	       }else{
		    if(0<y) tpos.push_back((y-1)*1000+x);
		    if(y<H) tpos.push_back(y*1000+x);
	       }
	       int pp=p;
	       for(int j=0;j<SZ(tpos);j++){
		    int yyy=tpos[j]/1000,xxx=tpos[j]%1000;
		    if(nTouch[yyy][xxx]==dia[yyy][xxx]-'0')   pp--;
		    if(nTouch[yyy][xxx]+1==dia[yyy][xxx]-'0') pp++;
		    nTouch[yyy][xxx]++;
	       }
	       isVisited[yy][xx]++;
	       int oldnVisit=nVisit[yy][xx];
	       nVisit[yy][xx]=SZ(snake)+SZ(ss);
	       turnCount.add(SZ(snake)+SZ(ss),rorlturn(l,ll));
	       if((x==0&&i==0)||(y==H&&i==2)||(x==W&&i==1)||(y==0&&i==3)){
		    ;
	       }else if(ygoal==yy&&xgoal==xx){
		    if(2<snake.size()+ss.size()&&ans.first.first<point+pp)
			 ans=make_pair(make_pair(point+pp,iabs(ygoal-yy)+iabs(xgoal-xx)),snake+ss);
	       }else if(1<isVisited[yy][xx]){
		    ;
	       }else{
		    if(!isInLoop(y,x,l,yy,xx,udlr[i],SZ(snake)+SZ(ss))){
		     	 res.push_back(DFS(yy,xx,ss,pp,ll));
		    }
	       }
	       for(int j=0;j<SZ(tpos);j++){
		    int yyy=tpos[j]/1000,xxx=tpos[j]%1000;
		    nTouch[yyy][xxx]--;
	       }
	       isVisited[yy][xx]--;
	       nVisit[yy][xx]=oldnVisit;
	       turnCount.add(SZ(snake)+SZ(ss),-1*rorlturn(l,ll));
	  }
	  if(SZ(res)==0)
	       return make_pair(make_pair(-INF,iabs(ygoal-y)+iabs(xgoal-x)),"");
	  else{
	       sort(res.begin(),res.end());
	       return res.back();
	  }
     }
}

string solve(void){
     memset(turnCount.bit,0,sizeof(turnCount));
     turnCount.add(100,1);
     if(H<=20){
	  dfsDepth=12;
     }else if(H<=30){
	  dfsDepth=11;
     }else if(H<=40){
	  dfsDepth=10;
     }else if(H<=50){
	  dfsDepth=10;
     }else if(H<=60){
	  dfsDepth=9;
     }else if(H<=70){
	  dfsDepth=9;
     }else if(H<=80){
	  dfsDepth=9;
     }else if(H<=90){
	  dfsDepth=8;
     }else if(H<=100){
	  dfsDepth=8;
     }

     point=0;
     FOR(i,0,H)FOR(j,0,W)if(dia[i][j]=='0')point++;
     memset(isVisited,0,sizeof(isVisited));
     memset(nVisit,-1,sizeof(nVisit));
     memset(nTouch,0,sizeof(nTouch));
     ystart=0;xstart=0;isVisited[0][0]=1;nVisit[0][0]=0;
     yhead=1;xhead=0;isVisited[1][0]=1;nVisit[1][0]=1;
     ygoal=H;xgoal=W;
     snake="D";
     ans=make_pair(make_pair(-INF,iabs(ygoal-yhead)+iabs(xgoal-xhead)),"");
     nTouch[0][0]=1;
     if(dia[0][0]=='0')point--;
     if(dia[0][0]=='1')point++;
     for(int time=0;time<MAX_ANS_LENGTH/dfsDepth/2;time++){
	  pair<pair<int,int>,string> res=DFS(yhead,xhead,"",0,snake[SZ(snake)-1]);
	  if(res.first.first==-INF)break;
	  point+=res.first.first;
	  snake+=res.second;
	  FOR(i,0,SZ(res.second)){
	       char ch=res.second[i];
	       if(ch=='U')yhead--;
	       if(ch=='D')yhead++;
	       if(ch=='L')xhead--;
	       if(ch=='R')xhead++;
	       isVisited[yhead][xhead]++;
	       nVisit[yhead][xhead]=SZ(snake)-SZ(res.second)+i+1;
	       turnCount.add(SZ(snake)-SZ(res.second)+i,rorlturn(snake[SZ(snake)-SZ(res.second)+i-1],snake[SZ(snake)-SZ(res.second)+i]));
	  } 
     }
     fprintf(stderr,"ans.first.first=%d ans.second=\"%s\"\n",ans.first.first,ans.second.c_str());
     if(ans.first.first==-INF){
	  stringstream tss;
	  tss<<0<<" "<<0<<" "<<snake<<endl;
	  return tss.str();
     }

     pair<pair<int,int>,string> fans=ans;

     memset(isVisited,0,sizeof(isVisited));
     memset(nTouch,0,sizeof(nTouch));
     memset(nVisit,-1,sizeof(nVisit));
     memset(turnCount.bit,0,sizeof(turnCount.bit));
     yhead=0,xhead=0;
     isVisited[yhead][xhead]++;
     nVisit[yhead][xhead]=0;
     FOR(i,0,SZ(fans.second)){
	  char ch=fans.second[i];
	  if(ch=='U')yhead--;
	  if(ch=='D')yhead++;
	  if(ch=='L')xhead--;
	  if(ch=='R')xhead++;
	  isVisited[yhead][xhead]++;
	  nVisit[yhead][xhead]=i+1;
	  if(0<i)
	       turnCount.add(i,rorlturn(fans.second[i-1],fans.second[i]));
     }
     point=0;
     for(int y=0;y<H;y++)
	  for(int x=0;x<W;x++){
	       nTouch[y][x]+=(isVisited[y][x]&&isVisited[y+1][x]);
	       nTouch[y][x]+=(isVisited[y+1][x]&&isVisited[y+1][x+1]);
	       nTouch[y][x]+=(isVisited[y+1][x+1]&&isVisited[y][x+1]);
	       nTouch[y][x]+=(isVisited[y][x+1]&&isVisited[y+1][x]);
	       point+=(nTouch[y][x]==dia[y][x]-'0');
	  }

     snake=fans.second+"U";
     ystart=H;xstart=W;isVisited[H][W]=1;
     turnCount.add(SZ(snake)-1,rorlturn('R','U'));
     yhead=H-1;xhead=W;isVisited[H-1][W]=1;nVisit[H-1][W]=snake.size();
     ygoal=0;xgoal=0;
     ans=make_pair(make_pair(-INF,iabs(ygoal-yhead)+iabs(xgoal-xhead)),"");
     for(int time=0;time<MAX_ANS_LENGTH/dfsDepth/2;time++){
	  pair<pair<int,int>,string> res=DFS(yhead,xhead,"",0,snake[SZ(snake)-1]);
	  if(res.first.first==-INF)break;
	  point+=res.first.first;
	  snake+=res.second;
	  FOR(i,0,SZ(res.second)){
	       char ch=res.second[i];
	       if(ch=='U')yhead--;
	       if(ch=='D')yhead++;
	       if(ch=='L')xhead--;
	       if(ch=='R')xhead++;
	       isVisited[yhead][xhead]++;
	       nVisit[yhead][xhead]=SZ(snake)-SZ(res.second)+i+1;
	       turnCount.add(SZ(snake)-SZ(res.second)+i,rorlturn(snake[SZ(snake)-SZ(res.second)+i-1],snake[SZ(snake)-SZ(res.second)+i]));
	  }
     }

     fprintf(stderr,"ans.first.first=%d ans.second=\"%s\"\n",ans.first.first,ans.second.c_str());
     fprintf(stderr,"snake=\"%s\"\n",snake.c_str());
    
     if(ans.first.first==-INF){
	  stringstream tss;
	  tss<<0<<" "<<0<<" "<<snake<<endl;
	  return tss.str();
     }

     stringstream ss;
     ss<<0<<" "<<0<<" "<<ans.second;
     return ss.str();
}

class FixTheFence{
public:
     string findLoop(const vector<string>& __diagram){
	  dia=__diagram;
	  H=SZ(dia);
	  W=SZ(dia[0]);
	  return solve();
     }
};