Haskellでオセロっぽいの作ってみた
細かいルールは調べてないし、実装もしてない。
他の言語ではオセロとか作ったことないから比較はできないけど、Haskellはすごい作りやすいなと思った。まだまだHaskell力が低いからうまく書けていないけど、それでも普通に作ると、短い関数を作ってそれを組み合わせていくようになる(気がする)し、なれるととても読みやすいように思う。
本当はroopの中のMaybeのcaseのあたりが微妙(IOモナドのdoのなかでMaybeモナドをうまく扱えてないような気がしてる)で、もっときれいに書きたかったのだけど、とりあえず完成させることにしたのでそれは後の課題。モナド変換子とかを使うとうまく書けるのかなと思っていて、そのへんを勉強していく予定。
あとdoctestが良い。Pythonで知った時に感動したけど、これくらい手軽にかけるとテスト書いていこうと思える。あとHaskellだと状態とかあんまないし、テストすごい書きやすい。
runhaskell reversi.hsで
12345678 ________ 1 ______X_ 2 ____OXO_ 3 ___OOX__ 4 ___XXX__ 5 ________ 6 ________ 7 ________ 8 O side turn. input x y.
こんな感じ。
ソースコードは以下
Board.hs
{-# OPTIONS -Wall #-} module Board ( Pos , Board , BoardInfo (BoardInfo, getSize, getBoard) , Mark (E, O, X) , isOnBoard , emptyBoard , roop , marksPosOf , markOf , rev , renderBoard -- DEBUG ) where import qualified Data.Map as M data Mark = E | O | X deriving (Eq) instance Show Mark where show E = "_" show O = "O" show X = "X" type Pos = (Int, Int) type Board = M.Map Pos Mark data BoardInfo = BoardInfo {getSize :: Int, getBoard :: Board} deriving (Show, Eq) data Result = Lose | Draw | Win emptyBoard :: Int -> BoardInfo emptyBoard boardSize = BoardInfo boardSize $ M.fromList [((x, y) , E) | x <- [1..boardSize], y <- [1..boardSize]] roop :: BoardInfo -> (BoardInfo -> Pos -> Mark -> BoardInfo) -> (BoardInfo -> Pos -> Mark -> Bool) -> (Board -> Mark -> Bool) -> (Board -> Mark -> Bool) -> (Board -> Mark -> Bool) -> Mark -> IO () roop boardInfo action canPut checkWin checkDraw checkLose mark = do renderBoard boardInfo boardInfo' <- turn boardInfo action canPut mark case checkFinish (getBoard boardInfo') checkWin checkDraw checkLose mark of Just Win -> do renderBoard boardInfo' putStrLn $ show mark ++ " side win!" Just Draw -> do renderBoard boardInfo' putStrLn "draw" Just Lose -> do renderBoard boardInfo' putStrLn $ show mark ++ " side lose!" Nothing -> roop boardInfo' action canPut checkWin checkDraw checkLose (rev mark) -- | Posが盤上かどうかを返す -- >>> isOnBoard 5 (1,5) -- True -- >>> isOnBoard 5 (1,6) -- False -- >>> isOnBoard 5 (6,3) -- False -- >>> isOnBoard 5 (0,5) -- False isOnBoard :: Int -> Pos -> Bool isOnBoard size (x, y) = (x >= 1 && x <= size) && (y >= 1 && y <= size) -- | boardInfoとPosとMarkをとりPos位置にMarkが置けるかをチェックして、おけるならばおいたboardInfoをRight boardInfoで返し、置けないならばLeft errを返す -- >>> let bi = BoardInfo {getSize = 2, getBoard = M.fromList [((1,1),O),((1,2),X),((2,1),E),((2,2),E)]} -- >>> let canPut boardInfo pos _ = (isOnBoard (getSize boardInfo) pos) && ((markOf (getBoard boardInfo) pos) == Just E) -- >>> putMark bi canPut (2,1) O -- Right (BoardInfo {getSize = 2, getBoard = fromList [((1,1),O),((1,2),X),((2,1),O),((2,2),_)]}) -- >>> putMark bi canPut (1,3) O -- Left "Can't put there." -- >>> putMark bi canPut (1,1) O -- Left "Can't put there." putMark :: BoardInfo -> (BoardInfo -> Pos -> Mark -> Bool) -> Pos -> Mark -> Either String BoardInfo putMark boardInfo canPut pos mark | canPut boardInfo pos mark = Right $ BoardInfo (getSize boardInfo) (M.insert pos mark (getBoard boardInfo)) | otherwise = Left "Can't put there." -- | Markを指定して、盤上のそのMarkすべての位置を返す -- >>> let b = M.fromList [((1,1),O),((1,2),X),((1,3),O),((2,1),E),((2,2),E),((2,3),O),((3,1),X),((3,2),E),((3,3),E)] :: Board -- >>> marksPosOf b O -- [(1,1),(1,3),(2,3)] -- >>> marksPosOf b X -- [(1,2),(3,1)] -- >>> marksPosOf b E -- [(2,1),(2,2),(3,2),(3,3)] marksPosOf :: Board -> Mark -> [Pos] marksPosOf board mark = map fst $ filter (\(_, m) -> m == mark) $ M.toList board -- | 位置を指定して、その位置にあるMarkをMaybe Markで返す markOf :: Board -> Pos -> Maybe Mark markOf board pos = M.lookup pos board -- | 標準入力から座標を入力させて(正しい入力でない場合は正しくなるまで繰り返す)、その座標にマークをおき、何らかの処理をして、 turn :: BoardInfo -> (BoardInfo -> Pos -> Mark -> BoardInfo) -> (BoardInfo -> Pos -> Mark -> Bool) -> Mark -> IO BoardInfo turn boardInfo action canPut mark = do putStrLn $ (show mark) ++ " side turn. input x y." pos <- inputToPos case putMark boardInfo canPut pos mark of Right boardInfo' -> return $ action boardInfo' pos mark Left err -> do putStrLn err turn boardInfo action canPut mark where inputToPos :: IO (Int, Int) inputToPos = do l <- getLine if length (words l) == 2 then return $ list2ToTuple2 $ map read $ words l else inputToPos list2ToTuple2 :: [Int] -> (Int, Int) list2ToTuple2 [n1, n2] = (n1, n2) list2ToTuple2 _ = error "list2ToTuple2 args error" -- | ボードを描画する renderBoard :: BoardInfo -> IO () renderBoard (BoardInfo size board) = do -- putStrLn "123\n " mapM_ (putStr . show . (\n -> if n >= 10 then n `mod` 10 else n)) [1..size] putStrLn "\n" mapM_ renderCol $ M.toList board putStrLn "\n" where renderCol :: (Pos, Mark) -> IO () renderCol ((x,y), mark) | y == size = putStrLn $ show mark ++ " " ++ show x | otherwise = putStr $ show mark rev :: Mark -> Mark rev O = X rev X = O rev E = E -- | ゲームが終了条件を満たしているかをチェックし、満たしていればJust結果を、満たしていなければNothingを返す checkFinish :: Board -> (Board -> Mark -> Bool) -> (Board -> Mark -> Bool) -> (Board -> Mark -> Bool) -> Mark -> Maybe Result checkFinish board win draw lose mark | win board mark = Just Win | draw board mark = Just Draw | lose board mark = Just Lose | otherwise = Nothing
reversi.hs
{-# OPTIONS -Wall #-} import Board import qualified Data.Map as M import Data.Maybe import Control.Monad -- import Debug.Trace boardSize :: Int boardSize = 8 data Direct = LeftUpD | UpD | RightUpD | LeftD | RightD | LeftDownD | DownD | RightDownD deriving (Show, Eq) -- | 指定PosのDirect方向の隣のPosを返す -- >>> neighbor (1,1) LeftDownD -- (0,2) -- >>> neighbor (1,1) UpD -- (1,0) -- >>> neighbor (1,1) RightUpD -- (2,0) -- >>> neighbor (1,1) LeftD -- (0,1) -- >>> neighbor (1,1) RightD -- (2,1) -- >>> neighbor (1,1) LeftDownD -- (0,2) -- >>> neighbor (1,1) DownD -- (1,2) -- >>> neighbor (1,1) RightDownD -- (2,2) neighbor :: Pos -> Direct -> Pos neighbor (x, y) dir | dir == LeftUpD = (x - 1, y - 1) | dir == UpD = (x, y - 1) | dir == RightUpD = (x + 1, y - 1) | dir == LeftD = (x - 1, y) | dir == RightD = (x + 1, y) | dir == LeftDownD = (x - 1, y + 1) | dir == DownD = (x, y + 1) | dir == RightDownD = (x + 1, y + 1) neighbor _ _ = error "bad args" allDirections :: [Direct] allDirections = [ LeftUpD, UpD , RightUpD , LeftD, RightD , LeftDownD, DownD, RightDownD] isFinished :: Board -> Bool isFinished board = length (marksPosOf board E) == 0 checkWin :: Board -> Mark -> Bool checkWin board mark = isFinished board && length (marksPosOf board mark) > length (marksPosOf board (rev mark)) checkDraw :: Board -> Mark -> Bool checkDraw board mark = isFinished board && length (marksPosOf board mark) == length (marksPosOf board (rev mark)) checkLose :: Board -> Mark -> Bool checkLose board mark = isFinished board && not (checkWin board mark) && not (checkDraw board mark) -- | 指定した位置から指定した方向の列の(Pos,Mark)のリストを返す -- >>> let bSize = 4 :: Int -- >>> let bi = BoardInfo bSize $ M.insert (3,3) O $ M.insert (3,2) X $ M.insert (2,3) X $ M.insert (2,2) O (getBoard (emptyBoard bSize)) -- >>> lineOfDirection bi (3,3) UpD -- [((3,2),X),((3,1),_)] -- >>> lineOfDirection bi (3,3) LeftUpD -- [((2,2),O),((1,1),_)] -- >>> lineOfDirection bi (4,4) LeftUpD -- [((3,3),O),((2,2),O),((1,1),_)] -- >>> lineOfDirection bi (4,3) LeftUpD -- [((3,2),X),((2,1),_)] -- >>> lineOfDirection bi (4,3) RightD -- [] lineOfDirection :: BoardInfo -> Pos -> Direct -> [(Pos, Mark)] lineOfDirection boardInfo pos dir | not (isOnBoard (getSize boardInfo) pos) || not (isOnBoard (getSize boardInfo) nextPos) || isNothing markOfNextPos = [] | otherwise = (nextPos, fromJust markOfNextPos) : (lineOfDirection boardInfo nextPos dir) where nextPos = neighbor pos dir markOfNextPos = markOf (getBoard boardInfo) nextPos -- | その(line::[(Pos,Mark)])は指定したmarkで挟めるlineか?はさめるならそのlineを、はさめないなら[]を返す -- >>> clippableLine O [((2,1),X),((3,1),X),((4,1),O)] -- [(2,1),(3,1)] -- >>> clippableLine O [((2,1),O),((3,1),X),((4,1),O)] -- [] -- >>> clippableLine O [((2,1),X),((3,1),X),((4,1),E)] -- [] clippableLine :: Mark -> [(Pos, Mark)] -> [Pos] clippableLine mark posMarks | length body < length posMarks && snd (posMarks!!(length body)) == mark = body | otherwise = [] where body = body' mark posMarks body' mark' (pm:pms) | snd pm == rev mark' = (fst pm) : (body' mark' pms) | otherwise = [] body' _ _ = [] -- | そこにmarkを置いた場合あいてのmarkを挟めるか -- >>> let bSize = 4 :: Int -- >>> let bi = BoardInfo bSize $ M.insert (3,3) O $ M.insert (3,2) X $ M.insert (2,3) X $ M.insert (2,2) O (getBoard (emptyBoard bSize)) canClip :: BoardInfo -> Pos -> Mark -> Bool canClip bi p m | not (any (\d -> clippableLine m (lineOfDirection bi p d) /= []) allDirections) = False -- | filter (\d -> clippableLine m (lineOfDirection bi p d) /= []) allDirections == [] = False | otherwise = True -- | そこにそのマークを置けるかどうか -- >>> let bi = initBoard 4 [((2,2),O), ((2,3),X),((3,2),X), ((3,3),O)] -- >>> canPut bi (1,3) O -- True -- >>> canPut bi (1,2) X -- True -- >>> canPut bi (1,3) X -- False canPut :: BoardInfo -> Pos -> Mark -> Bool -- canPut boardInfo pos mark = trace("is not OnBoard") ((isOnBoard (getSize boardInfo) pos)) -- && trace("not E") (((markOf (getBoard boardInfo) pos) == Just E)) -- && trace("can not clip") (canClip boardInfo pos mark) canPut boardInfo pos mark = isOnBoard (getSize boardInfo) pos && (markOf (getBoard boardInfo) pos) == Just E && canClip boardInfo pos mark -- | 指定した位置のmarkをひっくり返す turnBack :: Board -> [Pos] -> Board turnBack board ps = foldl (\b p -> M.insert p (revMark p) b) board ps where revMark :: Pos -> Mark revMark p = rev $ fromJust $ M.lookup p board -- | markをおいたあとにboardInfoがどのように変更されるか action :: BoardInfo -> Pos -> Mark -> BoardInfo action bi pos mark = BoardInfo bSize (turnBack b clippablePoses) where b = getBoard bi bSize = getSize bi dirs = filter (\d -> clippableLine mark (lineOfDirection bi pos d) /= []) allDirections clippablePoses = join $ map (\d -> clippableLine mark (lineOfDirection bi pos d)) dirs initBoard :: Int -> [(Pos, Mark)] -> BoardInfo initBoard bSize posMarks = BoardInfo bSize $ foldl (\b (pos, mark) -> M.insert pos mark b) (getBoard (emptyBoard bSize)) posMarks main :: IO () main = do let boardInfo = initBoard boardSize [((center,center),O), ((center,center+1),X),((center+1,center),X), ((center+1,center+1),O)] roop boardInfo action canPut checkWin checkDraw checkLose O where center = boardSize `div` 2
そのうち気が向いたらfayとかそういうのでjsにしてブラウザで動くようにしようかな。できるかどうかわからないけど。
[haskell]spotを動かしてみようとしたときのメモ
HaskellでJSON Web APIを作ると幸せになれるかもよ*1を読んで自分でもやってみたくなったので、とりあえずspotを動かしてみようと思った。
でまずhttps://github.com/fujimura/spotからspotをDLして、READMEにあるように
$ coffee -c -o static coffee/ $ runhaskell main.hs
してみたら`Network.Wai.Middleware.Static'が無い的なエラーがでる。
あ、と思ってscotty*2をDLして同じディレクトリに展開してもう一度runhaskell main.hsしたらText.Hastache.Contextが無い的なエラー。
で、cabal install hastacheしてもう一度runhaskell main.hsしたら、
InvalidYaml (Just "YamlException \"Yaml file not found: config/database.yml\"")
みたらconfig/database.ymlが無い、ほんでconfig/database.example.ymlがあるので、コピって作ってrunhaskell main.hsしたら、、、わーいなんとか動いた
しかし、
user error (SQLite3 returned ErrorCan'tOpen while attempting to perform open "db/development.sqlite3".)
と申されておる。
…続く
AppEngineでアプリのオフライン対応をやった
簡単だった(実は最初間違えててできてなかったけど)
メモ
以下の3つの手順をやっただけ
1) manifestファイルを作成する
CACHE MANIFEST # revision 1 ../ ../stylesheets/main.css ../stylesheets/iphone.css ../js/jquery.js ../js/gymmemo2.js
こんな感じでやった
2) manifestの指定をhtmlタグに書く
<html manifest="/manifest/cache-manifest.appcache">
3) mime_type: text/cache-manifestをapp.yamlに書く
application: gymm3mo version: 2 runtime: python api_version: 1 handlers: - url: /stylesheets static_dir: stylesheets - url: /js static_dir: js - url: /manifest static_dir: manifest mime_type: text/cache-manifest - url: /.* script: gymmemo.py
これがapacheとか使ってる場合と違うので最初わからなかった。
こんだけ、だったと思う。
ジムの記録アプリ
CoffeeScriptやらWeb Sqlを触ってみたくて作ってたジムの記録アプリがちょっと動いたのでアルファリリース。*1
http://gym-memo.appspot.com/
http://gymm3mo.appspot.com/
スマホ用。iPhoneでしか確認してないけど。
機能はまだトレーニング種目の追加とトレーニング記録の記録しかできない。削除も編集もまだできない。種目の編集や当日中の記録の削除はできるようになった。
データはWeb Sqlでローカルに保存してる。サーバに保存する機能もそのうち付ける予定。
一応オフライン対応も少ししたつもり。*2
"トレーニング種目"というところをクリックすると種目追加のフォームがでる。
phpと私シリーズその2
phpの機能でほかの言語よりも好きな機能を列挙していってみようと思う。
?:
エルビス演算子と呼ぶのだとどこで見た覚えがある。なぜそう呼ぶのかは書いてなかったけど、これはエルビスプレスリーが寝ているものに違いないと気づいたときにはちょっと嬉しかった。*1
これは三項の条件演算子の条件部と条件が真のとき返す値が同じだったら真のとき返す値を省略できるというもので
$a = $b ?: $c; // $a = $b ? $b : $c;と同じ
のように書ける。
たしかGroovyとかにもあった気がするけど、ほかでは知らない。便利。pythonにも入ればいいのに。*2
以上。ほかにphpにあって、perlやrubyやpython,javascriptにない機能で好きなやつ思いつかない。
phpと私シリーズその1
phpはプライベートではほとんど書かないのだけど、仕事ではcakeを使ってます。
で、昨日cakeのサイト見てたら見つけてちょっと笑ったやつ
この関数は、非推奨になりました。*1
*1:cakeが用意してた関数のショートネームがいろいろ廃止になってて、これはすごいはしご外しだなというお話
最近興味のあること
coffee-script
jquery
javascript
flask
python
html5
google chrome extention
上から順に興味がある。
なんでこんなに意味のないエントリ書いたかっていうと、技術系Advent Calendarに触発されて、12/1から12/25まで毎日ブログ書いてやろうと思ったけど、ネタも時間もなかったというのが理由
http://gihyo.jp/news/info/2011/12/0101