Haskellで麻雀の得点計算するプログラムを書く。その1。
たまには実用的(?)なプログラムでも書いてみよう、ということで、Haskellで麻雀の得点でも計算してみようかな、などと始めてみました。
とりあえず今回は下ごしらえ的な部分です。
このエントリの要約
- リスト内包表記がすてき。
- 麻雀のルールが分からなくても(多分)読めます。
- 麻雀やり過ぎ(筆者が)。
- 起きるの遅すぎ(筆者が)。
- Partty.org便利
- というか長ぇよ。
あらまし
※本質ではないのでスキップしましょう
朝目が覚める。布団の中でうとうとしている。
そんなとき、ふとTwitterで麻雀とか面白そうかも。など頭によぎった。
MahjongBotがいて、これがゲームマスターになる。
こいつに@で「参加」とかtwitする。
四人集まったらMahjongBotが席やら親を決めて、Dで牌を配る。
親から@でMahjongBotの打牌を伝えて、Botは鳴ける人間に対してDで副露か通しを求める。
全員の副露/通しが決まる、もしくはtimeoutでBotはロン、カン、ポン、チーの優先度で副露か通しかをアナウンスする。
などなど...。
API制限で死ぬがなとか、Twitterだとリズム悪いだろ、とか、突っ込みどころはたくさんあるかもしれないけれど、できないこともないなーと。
で、もし作るとして、botはどこまで賢くなるべきか?というのを考えてみた。
というかこれはTwitter botに限らず、麻雀ソフトはどの程度賢くあるべきか?
もちろんルールすべてを掌握して、ゲーム進行を行えるだけの賢さがあれば十分だろうと思う。
逆に実装者の立場で、なるべく楽したかったら何処まで愚かしくすることが出来るのか?
もちろん麻雀のゲーム性を失わない範囲で。
まず、最低限必要なのは洗牌と配牌、そして各ユーザの所有する牌の保証/確認。
牌を保証しないと白のみ(文字通り白「しか」ない!)手だって出来てしまう。
副露可能かの確認は必要か?
例えば全員が明示的に副露/通しを行うようにすれば問題ない。
たとえ副露出来なくてもいちいち通しと言えばいい。プログラムはそれに従えばいい。
もしくは次の自摸者が明示的にツモをすればいい。
ツモる前に副露。ネットワークゲームでは遅延云々で難しそうだけど、実際の麻雀はそうだしアリではある。
最低待ち時間を設定してやれば、やたら早くツモって回線の細い相手に副露させない、などという意地の悪いことも封じられる。
では和了の確認は必要か?
得点計算はまず必要ない。プログラムする上で一番めんどうでかつ柔軟性が必要な部分であり、ルール調整なども考えれば費用対効果にあわない。
得点計算は人間にやらせる。
そう考えるならば和了っているかも人間に任せていいような気がする。
プログラムはただ愚鈍に知性を持たないタダの卓になればいい。
ツモと言われたら牌を送って手牌に足す、打牌と言われたらプレイヤーの手牌から消す、ロンと言われたらそのプレイヤーの牌を公開する、副露は手牌から必要は牌をださせてそれが手牌にあったかどうかを調べる。
初期化は必要だな。席決め親決め配牌、ドラ表示。
いや、席決めや親決めも人間にやらせよう。さいころの機能ぐらいは持ってていいかもしれない。
プレイヤーの見うる情報を提供するのは必要だ。河を始め残りの山、副露した牌、できれば手出しかツモ切りかもわかるといいかもしれない。
ただ、それだけでいい。
誤ロンだとか打牌し忘れだとか、そういうのは人間に任せよう。
うん。
などとぼやぼや考えていたのだけど、そういえば得点計算とかどう計算するのが賢いのだろう、などと思考が切り替わっていく。
上位役の存在をどうあつかうか?そもそも面子の切り分けは?高得点法があるから固定で牌を切れないな、とか、バックトラックが効きそうとか。
そんなこんな考えるうちにリスト内包表記で綺麗に表せるのでは?
いや、いける、いけるぞ?
よし、書こう。
で、起きました。
本日朝午前7時。
個人的にはかなり早起き。
牌を定義する
そんなわけで実装に入っていきます。
やはりHaskellを使うからには生のデータを扱いたくない。
数字そのままとか、そういうのは美しくない。
なのでdataで牌を定義しようではないか。
data Tile = CharactorTile Int | BambooTile Int | CircleTile Int | DragonTile Dragon | WindTile Wind data Dragon = White | Green | Red data Wind = East | South | West | North
こんな感じだろうか。
変数の命名規則がやたら西洋かぶれな感じがするが特に他意があるわけでない。
単純に名前を思いつかなかったしローマ字もやだなと思って英語にしただけだ。
...にしても三元牌がドラゴン*1って...。
麻雀が分からない人のために一応補足しておくと、麻雀には大きく分けて2種類の牌があって、1から9の数字がある数牌(シュウパイ)と字が書いてある(こともある)牌が字牌(ツーパイ)がある。
数牌のうち
といい、字牌のうち
といいます。
英語表記の対応としてはCharactorが萬子、Bambooが索子、Circleが筒子で、Dragonが三元牌、Windが風牌、です。
あと、略記法に関しては、数牌は数字の後に、m(萬子)、s(索子)、p(筒子)をつけたもの、字牌はw(白/White) g(發/Green) r(中/Red)、E(東/East)、S(南/South)、W(西/West)、N(北/North)とさせてもらいます。
略記法に関しては別の、というか、正しい書き方もあるのですが(萬子は漢数字など)、ここでは↑のものを使います。
牌には順番あって、「次」つまりsuccな関係が定義されてる。
数牌はそのまま番号をsuccした牌、ただし、9の次は1、三元牌は白→發→中→白、東→南→西→北→東と決まっている。
のようにループしている。のだけど、このsucc関係は実はあまり使わない。
ドラという概念の時にだけ使って、普段はループ無し、字牌にはsuccはない、という風なっている。
ということで、「次の牌」の関係を考えるとこの定義は実はめんどい。
なので、ちょいと手抜きして数字で管理してしまいます。
美しくないけど技巧的。
data Tile = Tile { getIndex :: Int } deriving (Eq,Ord)
indexで牌を管理します。indexの意味としては
とします。
いくつか未使用の数字がありますが、これがポイント。
もちろん、数牌の数字と1の位をあわせている、というのもありますが、10,20,30,32,34,36〜40,42,44,46の未使用領域がループ無し、字牌にsuccなし、に便利なんですよ。
まぁ、多分、世の麻雀プログラムは大体こういう定義を使っているのではないでしょうか。
ビット操作と関連させて16進数にして、0x20 && が1なら字牌、とか、0x0f && で数牌の数字が拾える、のように使うとなお便利そうですね。
ドラがらみの順序関係をEnumのsuccで定義しつつ、Intとの相互変換はindexで処理します。
instance Enum Tile where succ (Tile 9) = Tile 1 -- 9m -> 1m succ (Tile 19) = Tile 11 -- 9s -> 1s succ (Tile 29) = Tile 21 -- 9p -> 1p succ (Tile 31) = Tile 33 -- w -> g succ (Tile 33) = Tile 35 -- g -> r succ (Tile 35) = Tile 31 -- r -> w succ (Tile 41) = Tile 43 -- W -> S succ (Tile 43) = Tile 45 -- S -> E succ (Tile 45) = Tile 47 -- E -> N succ (Tile 47) = Tile 41 -- N -> W succ (Tile n) = Tile (succ n) fromEnum = getIndex toEnum = Tile
modとか不等号を使えばもうすこし綺麗になると思いますが、まぁこれはこれで。
ところでドラのsuccは得点計算にはあまり必要ないような...。
ドラ表示牌じゃなくてドラ現物牌を使えばいいだけで...。まあいいか。
さすがに数字のままは扱いづらいので、いくつか補助関数を用意します。
isValid :: Tile -> Bool isValid t = isSuitTile t || isHonorTile t --数牌 isSuitTile :: Tile -> Bool isSuitTile t = isCharacterTile t || isBambooTile t || isCircleTile t --字牌 isHonorTile :: Tile -> Bool isHonorTile t = isDragonTile t || isWindTile t --萬子 isCharacterTile :: Tile -> Bool isCharacterTile (Tile n) = 1 <= n && n <= 9 --索子 isBambooTile :: Tile -> Bool isBambooTile (Tile n) = 11 <= n && n <= 19 --筒子 isCircleTile :: Tile -> Bool isCircleTile (Tile n) = 21 <= n && n <= 29 --三元牌 isDragonTile :: Tile -> Bool isDragonTile (Tile n) = 31 == n || 33 == n || 35 == n --風牌 isWindTile :: Tile -> Bool isWindTile (Tile n) = 41 == n || 43 == n || 45 == n || 47 == n --すべての牌 allTiles :: [Tile] allTiles = [t | n <- [1..50], let t = Tile n, isValid t] --数牌から数字を得る。 getSuit :: Tile -> Int getSuit t@(Tile n) | isSuitTile t = n `mod` 10 | otherwise = error $ show t ++ " is NOT suit tile!"
前者のdataで牌の種類を表す定義だとこの辺はdataまわりのパターンマッチにできるのですが...。まぁ、方針ということで。
続いてShowとRead。
さすがにそのままでは使いづらいので糖衣的に定義です。
instance Show Tile where showsPrec _ (Tile n) | 1 <= n && n <= 9 = ((show (n + 0)) ++) . ("m"++) | 11 <= n && n <= 19 = ((show (n + 10)) ++) . ("s"++) | 21 <= n && n <= 29 = ((show (n + 20)) ++) . ("p"++) | 31 == n = ("w"++) -- White | 33 == n = ("g"++) -- Green | 35 == n = ("r"++) -- Red | 41 == n = ("E"++) -- East | 43 == n = ("S"++) -- South | 45 == n = ("W"++) -- West | 47 == n = ("N"++) -- North | otherwise = error "Unknown Tile!" showList x0 = let (ms,x1) = partition isCharacterTile x0 in let (ss,x2) = partition isBambooTile x1 in let (ps,x3) = partition isCircleTile x2 in let (ds,ws) = partition isDragonTile x3 in ((unwords $ filter (not . null) $ [ showSuitTiles ms "m" , showSuitTiles ss "s" , showSuitTiles ps "p" , (concat $ map show ds) , (concat $ map show ws) ])++) where showSuitTiles :: [Tile] -> ShowS showSuitTiles [] = const "" showSuitTiles ts = ((concat $ map (show . getSuit) ts) ++) instance Read Tile where readsPrec _ x0 = [(Tile n, x2) | (c:x1) <- [x0] , '1' <= c && c <= '9' , ('m':x2) <- [x1] , let n = (ord c) - (ord '1') + 1 + 0 ] ++[(Tile n, x2) | (c:x1) <- [x0] , '1' <= c && c <= '9' , ('s':x2) <- [x1] , let n = (ord c) - (ord '1') + 1 + 10 ] ++[(Tile n, x2) | (c:x1) <- [x0] , '1' <= c && c <= '9' , ('p':x2) <- [x1] , let n = (ord c) - (ord '1') + 1 + 20 ] ++[(Tile n, x1) | ('w':x1) <- [x0] , let n = 31 ] ++[(Tile n, x1) | ('g':x1) <- [x0] , let n = 33 ] ++[(Tile n, x1) | ('r':x1) <- [x0] , let n = 35 ] ++[(Tile n, x1) | ('E':x1) <- [x0] , let n = 41 ] ++[(Tile n, x1) | ('S':x1) <- [x0] , let n = 43 ] ++[(Tile n, x1) | ('W':x1) <- [x0] , let n = 45 ] ++[(Tile n, x1) | ('N':x1) <- [x0] , let n = 47 ] readList [] = [([],[])] readList x0 = [(ts,x4) | (ns,x1) <- [span isDigit x0] , not $ null ns , ('m':x2) <- [x1] , (_,x3) <- [span isSpace x2] , (rest,x4) <- readList x3 , let ts = sort $ map (Tile . (+ 0) . read . (:[])) ns ++ rest ] ++[(ts,x4) | (ns,x1) <- [span isDigit x0] , not $ null ns , ('s':x2) <- [x1] , (_,x3) <- [span isSpace x2] , (rest,x4) <- readList x3 , let ts = sort $ map (Tile . (+10) . read . (:[])) ns ++ rest ] ++[(ts,x4) | (ns,x1) <- [span isDigit x0] , not $ null ns , ('p':x2) <- [x1] , (_,x3) <- [span isSpace x2] , (rest,x4) <- readList x3 , let ts = sort $ map (Tile . (+20) . read . (:[])) ns ++ rest ] ++[(t:ts,x3) | (t,x1) <- reads x0 , (_,x2) <- [span isSpace x1] , (ts,x3) <- readList x2 ]
ちょっとハードコーディングが多くて汚いですね。
どこかにassocで持っておくとよいのかも。
show/readに関しては、番号だけが違う同じ数牌のリストは"1m 2m 3m"とではなく、"123m"とまとめて表記します。
readに関してはもうちょっと汎用的に、例えば筒子は"(123)"で入力できるとか、だとなおベターなのですがめんどくさいのでやめました。
実は今回一番手間取った部分です。
下にPartty.orgを張っておきますが、戸惑いっぷりが分かると思います。
再び補足です。
さて、牌の定義が終わったところで、次は面子(メンツ)について入っていきます。
面子はよく、面子を集めるだとか既に日本語になっていたりもしますが、それはそうと、実は麻雀用語って結構そこかしこにあるんですよね。
テンパるとかリーチ(立直)とか連チャン(連荘)とか...。
話がずれた。閑話休題。
麻雀のもっとも基本はこの面子を集めることにあります。
ゲーム開始時に配られる13個の牌を入れ替えていき、最終的には面子を4つと頭と呼ばれる部分を作ることが目的です。
面子は3枚の牌からなり、
- 全く同じ牌を集めた物を刻子(コーツ)
- 数字が1づつ異なる、同じ数牌を3枚集めた物(123mや567sなど)を順子(シュンツ)
と言います。この順子を作る際に出てくる「1づつ異なる」というのが前に出てきた、ループしない、字牌はsuccがない、順序と鳴ります。
つまり、"891m"であるとか、"912s"という順子は作れませんし、字牌はそもそも順子を作ることが出来ません("wgr"は順子ではない)。
ちなみに、刻子と順子のできそこない、つまり後一枚で刻子や順子になる二枚のことを、対子(トイツ)、塔子(ターツ)とか言います。
対子は同じ物二枚、とわかりやすいのですが、塔子の場合、
- 46m(5mが来ると456m)のように間を待つ嵌塔子(カンターツ*9 )
- 45s(3sだと345s、6sだと456s)のように両側を待つ両面塔子(リャンメンターツ)
- 12s(3sがくれば123s、9sは来ても無駄)の様に世が世なら――場所が場所なら両面塔子になれたのに端っこ故に片方が待てない辺塔子(ペンターツ)
があります。加えて既にある面子/刻子と塔子の組み合わせによっては(ry
またまた話ずれた。閑話休題。
で、先に出てきた頭と呼ばれる部分は対子、つまり同じ物二枚となります。
まとめると、1)まず13枚配られる、2)牌を入れ替えて面子x4と頭を作る、3)勝つ、という流れになります。
おぃおぃセニョール。
面子(3枚)*4 + 頭/対子(2枚) = 14枚で13枚じゃつくれないじゃないかよ。
ということなので、実はもう一枚ツモった(引いた)牌をあわせて面子x4と頭を作ります。
麻雀はポーカーなどと異なり牌を入れ替えていく際に、捨ててから引く、のではなく、引いてから捨てる、スタイルを取ります。
このとき一時的に14枚になった状態、この時に面子x4+頭の形になっているとアガリ(和了/ホーラとも)になります*10。
手牌が13枚のときに、あと何かいい牌が来れば和了になる、という時、聴牌(テンパイ)している、ないし、テンパっていると言い、和了るために必要な牌を当たり牌、ないし、待ち牌と言います。
例えば、"234m 444s 888s 56p 88s"の場合、あと4pか7pが来ると和了形になりますので、4pないし7pが待ち、47p(中国語発音でスーチーピンという場合が多い)待ちとなります。
このような例の場合何が待ちで、当たり牌が来たときにどこが面子になるのか、が分かりやすいのですが、実際にはもっと複雑になることも多いです。
ちょっと作為的な例ですが、"123m 123m 23m 555s 88p"の待ちはなんでしょう?
23mが両面塔子となっているので、14m待ち、ということが出来ます。
ところが順番を変えて"11m 222m 333m 555m 88p"とすると、11mと88pがそれぞれ対子なので、どちらか片方が刻子になって面子となれば、和了形ということができます。
つまり、1m 8p待ちということも出来ます。
あわせて、14m 8p待ち、となります。
さらにさらに、"1112345678999m"は何待ちでしょう?
左右対称なので、試しに"111m 234m 5m 678m 999m"と分けてみると、面子x4はすでに出来ているのであとは頭、つまり5mが来れば和了です。
あるいは"111m 234m 567m 8m 999m"と分けることも出来ます。この場合には、8mが当たり牌です。
"111m 234m 56m 789m 99m"なら56mが両面塔子で47m待ち、"11m 123m 456m 78m 999m"なら69m待ち...etc
結果的には123456789mのどれでも当たり!というすさまじい待ちとなります*11。
そんなこんなで、何が待ち牌なのか?これは和了形なのか?あるいは、どこが面子で何処が頭か?というのは、こと、初心者には難しい問題であったりします。
とくに何が待ち牌なのか、は結構重要な問題で、待ち牌を見逃してしまったり、捨ててしまったりするとなかなか大変なことになったりも...。
加えて、得点計算する上でもどういう形か?というのは非常に重要な問題になります。
と、いうことで、面子を探すことから始めます。
まずは面子の定義から。
data Meld = Sequence Tile | Identical Tile | Pair Tile deriving (Eq,Ord) instance Show Meld where show (Sequence t) = show [t, succ t, succ $ succ t] show (Identical t) = show [t, t, t] show (Pair t) = show [t, t]
面子はMeldでいいのかな?あとSequenceが順子、Identicalが刻子、Pairは頭で純粋には面子ではないのですが、ここでは便宜的に。
順子は先頭の一つさえ分かればあとは分かるはずなので、先頭の一つだけを使っています。
めんどくさがってsuccを使ってますが、891mとか912s、ESWやwgrは順子ではないので注意をば。
面子に関しては実は暗/明という概念や、刻子の兄分(?)である槓子というのも存在します。
その辺は後々拡張かな。
さて、その面子を拾ってくるわけですが、単純にはいかない。
順子を見つけたからと言って順子と決めつけると、実は別の解釈があったかも、ということになりかねない。
ということで、リスト内包表記を使っていきます。
まずは、面子一つを取り出す関数。
getMeld :: [Tile] -> [(Meld, [Tile])] getMeld x0 = nub $ [(Sequence t1, x3) | t1 <- x0 , let x1 = x0 \\ [t1] , t2 <- x1 , getIndex t2 - getIndex t1 == 1 , let x2 = x1 \\ [t2] , t3 <- x2 , getIndex t3 - getIndex t2 == 1 , let x3 = x2 \\ [t3] ] ++[(Identical t1, x3) | t1 <- x0 , let x1 = x0 \\ [t1] , t2 <- x1 , t2 == t1 , let x2 = x1 \\ [t2] , t3 <- x2 , t3 == t2 , let x3 = x2 \\ [t3] getPair :: [Tile] -> [(Meld, [Tile])] getPair x0 = nub [(Pair t1, x2) | t1 <- x0 , let x1 = x0 \\ [t1] , t2 <- x1 , let x2 = x1 \\ [t2] , t2 == t1 ] ]
基本的には牌のリストを受け取って、面子一つと、残りの牌を返します。
面子は複数あるかもしれないので全体がリストになっています。
リストの内包表記のまさに好例といったところでしょうか?非常にシンプルかつ綺麗だ、と自負しているのですが...。
それはともかく、流れとしては、bind(<-)を使って任意の牌を取り出しては、牌のリストから取り出した牌を消していきます。
順子の場合は連番ですので、差が1になっているかを枝刈り条件(?)というかガードとして使っています。
indexは先の通り、萬子と索子、筒子の間の20,30の未使用部分、各字牌の間未使用の偶数indexがそれぞれ、変な順子を作らないために役立ちます。
刻子はそのままです。
getPairは頭。やってことは同じ。
実際には結構無駄があって、例えば刻子111mは、1mにそれぞれabcと記号を振ると、abcという形の1m刻子のほか、acb、bacなど複数パターンを拾って来ちゃいます。
まぁ、スルー。nubがどうにかしてくれるさ。
で、そのgetMeldもまたまたリスト内包表記の中で活躍します。
getMelds :: [Tile] -> [([Meld], [Tile])] getMelds x0 = nub [(sort [m1,m2,m3,m4,m5], x5) | (m1,x1) <- getMeld x0 , (m2,x2) <- getMeld x1 , (m3,x3) <- getMeld x2 , (m4,x4) <- getMeld x3 , (m5,x5) <- getPair x4 ] getMelds2 :: [Tile] -> [((Tile, [Meld]), [Tile])] getMelds2 x0 = nub [((t,sort [m1,m2,m3,m4,m5]), x5) | t <- allTiles , (m1,x1) <- getMeld (t:x0) , (m2,x2) <- getMeld x1 , (m3,x3) <- getMeld x2 , (m4,x4) <- getMeld x3 , (m5,x5) <- getPair x4 ]
上はあがっているかどうか、あがっていたら面子の構成はどうなっているか、を、
下は聴牌しているかどうか、待ちは何か?を、それぞれ列挙します。
聴牌は後一枚あれば和了、という状態なので、愚直にすべての牌をくっつけては和了になるかを求めてます。
んー。愚直だ。
まぁ、そんな感じで面子構成は列挙できるようになったので次回は役とか考えていきたいと思います。
上位役とか複合役、その辺も一応実装は考えているので、気が向いたらその2、やります。
最後に、上のコードを実装する際に録画したPartty.org張っておきます。
Macだとずれることを確認したのでptyファイルを落としてcapttyで再生した方がいいかも。
画面サイズは140x40です。
*1:Wikipedia曰く刻子/槓子 にするだけで一飜→強くね?→ドラゴン、という発想らしい...。ドラゴンて。ちなみにドラの語源もドラゴン。ややこしい
*3:暴君かわいいです。でもニコぼが好き
*4:ただの棒にしか見えない。諸事情あって1だけ鳥が書いてある。穴あき貨幣の穴に通す串らしい
*5:よく数え間違える。一応配置が工夫されているので区別はちゃんとつくし、わざわざ1,2,3...と数えなくても分かるのだが、ときどき6sと9sを間違える...orz
*6:というかタダの丸。貨幣を表しているらしい
*8:読みは「トン」「ナン」「シャー」「ペー」
*9:カンタビーレではない
*10:実際には一飜縛りというルールがありあがれないこともあります
*11:ちなみにこれは純正九連宝燈(ジュンセイチューレンポートー)という役で出たら運を使い果たして死ぬ、と言われている役です