Mac Book Air のキーボード配列を設定したらめちゃくちゃはかどった

Mac Book Pro および Mac Book Air のキーボードは、数年使っているけどなかなか慣れないけど、何とかなった、という話。

悩みだったのは以下。

• Mac のノートは、右手側に option がないので、左手が死にそう
• control と caps の配置が Windows とは逆で、頭が混乱する
• アプリの切り替えが command + tab と option + tab に分かれていて、 とっさに切り替えられない

これらは、https://pqrs.org/osx/karabiner/index.html.ja というソフトと https://pqrs.org/osx/karabiner/seil.html.ja というソフトを導入することで解決しました。設定方法は割愛します。

変更したキーがこちら。

もともと control だった部分には fn を割り当てました。Windows ではここは Caps Lock で、Caps Lock は今後死ぬまで使わないキーだと思うので、僕にとってここはデッドスペースなんです。そして fn キーなんてめったに使わないので、必然的にここに収まる事になりました。

もともと caps だった部分には control を割り当てました。本当は右側にも control が欲しいのですが、Mac は Windows でいう Ctrl の機能が control と command に分割されている感じで、かつどちらかというと command の方が多用されているので、control は左側だけでもなんとかなります。ちなみに使い分けられ方で、どういう時に control でどういう時は command なのか、未だによくわかっていません。

もともと かな だった部分には、単独で押した場合は かな として、組み合わせた場合は option として機能するようにしました。こんな細やかなキーアサインができるとは！（この感動を伝えたくて久しぶりのブログ更新）

もともと fn だった部分には、右クリックを割り当てました。Windows のキーボードっぽくなって、使いやすさ倍増。

これ以外にも、キーリピート間隔を変更して、素早くカーソル移動ができるようにしました。Mac のデフォルトでは設定できないぐらいの小さな値が設定でき、僕は 10ms でリピートするようにしています。

それにしても Karabinar というソフトはすごいなぁ。Mac を使う上で必須アプリになりました。

あるポーカーの手役で最善手を検証してみる

Haskell でポーカー役判定処理を作ったので、これを使って遊んでみる。

以下の手札があったとする。

よくある感じの手札だと思う。

ここから、何をどう切ると、どれぐらいの期待値で勝利するのか、というのを検証してみたい。

ルールは以下とする。

• 一回だけチェンジ可能
• ジョーカーを一枚含む
• 相手に手役で勝つのが目的
• 相手は別のデッキを使っていて同じ手札とする

まずはこのケース。

ワンペアを残して、スリーカードを狙う（スリーカード狙い、と命名）。ツーペア、フルハウス、フォーカード、ファイブカードにもなりうる。確実にワンペア以上になるので、相手がブタになれば勝利できるという寸法。

次はこのケース。

フラッシュを狙いつつ、ストレートになってもまた良し（フラッシュ狙い、と命名）。ストレートフラッシュにもなり得、ワンペア、ツーペア、スリーカードも拾える。

続いてこのケース。

完全なストレート狙い（ストレート狙い、と命名）。約 1/13 でストレートになるが、これは果たして良い手なのだろうか。

最後はこのケース。

ワンペアと最高札のエースを残して、2 のワンペア同士ならエースで勝つ、エースとのツーペアの期待値も高いので、ツーペア同士でも勝ちを狙っていく方法（ツーペア狙い、と命名）。

それでは、それぞれの方針で 1 万回勝負させてみた結果が以下。

	スリーカード狙い	フラッシュ狙い	ストレート狙い	ツーペア狙い
スリーカード狙い勝率	-	70.61%	75.05%	33.85%
フラッシュ狙い勝率	29.60%	-	40.63%	30.47%
ストレート狙い勝率	24.95%	59.34%	-	22.67%
ツーペア狙い勝率	66.15%	69.53%	74.41%	-

この中で最強の勝率を誇るのはツーペア狙いだった。全ての方式に勝ち越している。特にスリーカード狙いに割と大差で勝ち越しているのが評価できると思う。

フラッシュ狙いが最も勝率が低い。2 枚交換してどちらもクラブじゃないといけないので、単純に 1/4 * 1/4 = 1/16 という確率になる。これは、1 枚交換でストレートを狙う確率 1/13 よりも明らかに分が悪いのが勝率に数値として出てしまった感じだ。

スリーカード狙いは、ツーペア狙いが天敵だけど、他には圧倒している。スリーカード狙いでスリーカード以上になる確率は 12% 程度しかなく、88% の確率でツーペアのままだ。エースを残したツーペアに負けてしまうのは致し方ない。また、フラッシュ狙いでブタになる確率は 67%、ストレート狙いでブタになる確率は 64% であり、スリーカード狙いの勝ちパターンは、相手がブタだった、というケースが大半を占める。

ストレート狙いは、この中では最もブタになる確率が高いが、フラッシュに勝ち越しているのはブタ同士でエースが残されているためだ。今回は辺張のストレート待ちなので分が悪いが、両面のストレート待ちなら期待値は倍になるので、勝率はかなり変わってくるだろう。

僕はこのケースならフラッシュ狙いでカードを切るんだけど、それはロマンチックだったんだと気がついた。ポーカーの手役でエースを含むツーペアはまあまあ良い手なので、そちらを狙ってくのがリアリズムなんだとも理解できた。

Haskell でポーカーの役判定処理 #3

Haskell でポーカーの役判定処理 #2 - satosystemsの日記 の続き。

だいぶ良くなったと思う。

改善したのは以下の箇所。

• Maybe をモナドとして使用するようにした
• リストに対してリスト操作関数を適切に使用するようにした
• ジョーカーを使うとフルハウスで勝敗判定に特別な処理が必要になるケースを実装

最初に書いた実装で、なんか変だなと思う部分は、やっぱりエレガントに書き直せる。
まだ書き直せそうな部分はコメントしてある。

module Poker (
  Suit(..),
  Rank(..),
  Card(..),
  Hand,
  HandRank(..),
  normalize,
  ranking,
) where

import Data.List (find, findIndices, group, sort)

data Suit = J | B | C | D | H | S deriving (Show, Ord, Eq, Enum)

instance Read Suit where
  readsPrec _ s = readSuit s

readSuit :: ReadS Suit
readSuit ('J':cs) = [(J, cs)]
readSuit ('B':cs) = [(B, cs)]
readSuit ('C':cs) = [(C, cs)]
readSuit ('D':cs) = [(D, cs)]
readSuit ('H':cs) = [(H, cs)]
readSuit ('S':cs) = [(S, cs)]
readSuit _        = []

data Rank = Zero | Two | Three | Four | Five | Six | Seven | Eight | Nine
          | Ten | Jack | Queen | King | Ace deriving (Ord, Eq, Enum)

instance Read Rank where
  readsPrec _ s = readRank s

readRank :: ReadS Rank
readRank ('0':cs)     = [(Zero, cs)]
readRank ('2':cs)     = [(Two, cs)]
readRank ('3':cs)     = [(Three, cs)]
readRank ('4':cs)     = [(Four, cs)]
readRank ('5':cs)     = [(Five, cs)]
readRank ('6':cs)     = [(Six, cs)]
readRank ('7':cs)     = [(Seven, cs)]
readRank ('8':cs)     = [(Eight, cs)]
readRank ('9':cs)     = [(Nine, cs)]
readRank ('1':'0':cs) = [(Ten, cs)]
readRank ('1':'1':cs) = [(Jack, cs)]
readRank ('1':'2':cs) = [(Queen, cs)]
readRank ('1':'3':cs) = [(King, cs)]
readRank ('1':cs)     = [(Ace, cs)]
readRank _            = []

instance Show Rank where
  show Zero  = "0"
  show Two   = "2"
  show Three = "3"
  show Four  = "4"
  show Five  = "5"
  show Six   = "6"
  show Seven = "7"
  show Eight = "8"
  show Nine  = "9"
  show Ten   = "10"
  show Jack  = "11"
  show Queen = "12"
  show King  = "13"
  show Ace   = "1"


data Card = Card { suit :: Suit, rank :: Rank }
  | J0 | B0
  | C2 | D2 | H2 | S2 | C3 | D3 | H3 | S3 | C4 | D4 | H4 | S4
  | C5 | D5 | H5 | S5 | C6 | D6 | H6 | S6 | C7 | D7 | H7 | S7
  | C8 | D8 | H8 | S8 | C9 | D9 | H9 | S9 | C10 | D10 | H10 | S10
  | C11 | D11 | H11 | S11 | C12 | D12 | H12 | S12
  | C13 | D13 | H13 | S13 | C1 | D1 | H1 | S1

labels = [ "J0", "B0"
         , "C2", "D2", "H2", "S2", "C3", "D3", "H3", "S3", "C4", "D4", "H4", "S4"
         , "C5", "D5", "H5", "S5", "C6", "D6", "H6", "S6", "C7", "D7", "H7", "S7"
         , "C8", "D8", "H8", "S8", "C9", "D9", "H9", "S9", "C10", "D10", "H10", "S10"
         , "C11", "D11", "H11", "S11", "C12", "D12", "H12", "S12"
         , "C13", "D13", "H13", "S13", "C1", "D1", "H1", "S1"
         ]

instance Show Card where
  show (Card su ra) = show su ++ show ra
  show J0           = labels !! 0
  show B0           = labels !! 1
  show C2           = labels !! 2
  show D2           = labels !! 3
  show H2           = labels !! 4
  show S2           = labels !! 5
  show C3           = labels !! 6
  show D3           = labels !! 7
  show H3           = labels !! 8
  show S3           = labels !! 9
  show C4           = labels !! 10
  show D4           = labels !! 11
  show H4           = labels !! 12
  show S4           = labels !! 13
  show C5           = labels !! 14
  show D5           = labels !! 15
  show H5           = labels !! 16
  show S5           = labels !! 17
  show C6           = labels !! 18
  show D6           = labels !! 19
  show H6           = labels !! 20
  show S6           = labels !! 21
  show C7           = labels !! 22
  show D7           = labels !! 23
  show H7           = labels !! 24
  show S7           = labels !! 25
  show C8           = labels !! 26
  show D8           = labels !! 27
  show H8           = labels !! 28
  show S8           = labels !! 29
  show C9           = labels !! 30
  show D9           = labels !! 31
  show H9           = labels !! 32
  show S9           = labels !! 33
  show C10          = labels !! 34
  show D10          = labels !! 35
  show H10          = labels !! 36
  show S10          = labels !! 37
  show C11          = labels !! 38
  show D11          = labels !! 39
  show H11          = labels !! 40
  show S11          = labels !! 41
  show C12          = labels !! 42
  show D12          = labels !! 43
  show H12          = labels !! 44
  show S12          = labels !! 45
  show C13          = labels !! 46
  show D13          = labels !! 47
  show H13          = labels !! 48
  show S13          = labels !! 49
  show C1           = labels !! 50
  show D1           = labels !! 51
  show H1           = labels !! 52
  show S1           = labels !! 53

instance Read Card where
  readsPrec _ s = readCard s

readCard :: ReadS Card
readCard s = case readSuit s of
  []          -> []
  [(su, cs1)] -> case readRank cs1 of
    []          -> []
    [(ra, cs2)] -> [(Card su ra, cs2)]

instance Ord Card where
  compare ca1 ca2 = compare (fromEnum ca1) (fromEnum ca2)

instance Enum Card where
  toEnum n = read $ labels !! n
  fromEnum ca = findIndices (show ca ==) labels !! 0

instance Eq Card where
  x == y = (fromEnum x) == (fromEnum y)

type Hand = [Card]

data HandRank = HighCard Card
              | OnePair Rank Card
              | TwoPair Rank Rank Card
              | ThreeCard Rank Card
              | Straight Card
              | Flush Card
              | FullHouse Rank Rank Card
              | FourCard Rank
              | StraightFlush Card
              | RoyalStraightFlush Suit
              | FiveCard Rank deriving (Show, Read, Eq, Ord)

wildcard :: Hand -> [Card]
wildcard ha = filter (\ca -> find (ca ==) ha == Nothing) [B0 .. S1]

normalize :: Card -> Card
normalize = (toEnum . fromEnum)

findMultiple :: Hand -> Int -> Maybe Rank
findMultiple ha n = find ((n ==) . length) (group (map rank ha)) >>= (return . head)

ranking :: Hand -> HandRank
ranking = ranking' . sort . map normalize

-- ここは書き直せそう。
-- Nothing の場合に次の処理を行う、というのが Maybe モナドの
-- 想定される使い方とは違うんじゃないかと。
ranking' :: Hand -> HandRank
ranking' ha@((Card J _):cs) = case last $ sort $ map ranking $ map (\ca -> sort $ ca:cs) (wildcard cs) of
  FullHouse ra1 ra2 _ -> FullHouse ra1 ra2 (last cs)
  other               -> other
ranking' ha = case maybeFiveCard ha of
  Just ra -> FiveCard ra
  Nothing -> case maybeRoyalStraightFlush ha of
    Just su -> RoyalStraightFlush su
    Nothing -> case maybeStraightFlush ha of
      Just ca -> StraightFlush ca
      Nothing -> case maybeFourCard ha of
        Just ra -> FourCard ra
        Nothing -> case maybeFullHouse ha of
          Just (ra1, ra2, ca) -> FullHouse ra1 ra2 ca
          Nothing             -> case maybeFlush ha of
            Just ca -> Flush ca
            Nothing -> case maybeStraight ha of
              Just ca -> Straight ca
              Nothing -> case maybeThreeCard ha of
                Just (ra, ca) -> ThreeCard ra ca
                Nothing -> case maybeTwoPair ha of
                  Just (ra1, ra2, ca) -> TwoPair ra1 ra2 ca
                  Nothing             -> case maybeOnePair ha of
                    Just (ra, ca) -> OnePair ra ca
                    Nothing       -> HighCard $ last ha

maybeFiveCard :: Hand -> Maybe Rank
maybeFiveCard ha@((Card B _):_) = maybeFourCard ha
maybeFiveCard _                 = Nothing

maybeRoyalStraightFlush :: Hand -> Maybe Suit
maybeRoyalStraightFlush ha@((Card su Ten):_) = maybeStraightFlush ha >> Just su
maybeRoyalStraightFlush _                    = Nothing

maybeStraightFlush :: Hand -> Maybe Card
maybeStraightFlush ha = maybeFlush ha >> maybeStraight ha >>= return

maybeFourCard :: Hand -> Maybe Rank
maybeFourCard ha = findMultiple ha 4

maybeFullHouse :: Hand -> Maybe (Rank, Rank, Card)
maybeFullHouse ha = findMultiple ha 2 >> maybeThreeCard ha >>= (\(ra, ca) -> return (ra, rank ca, last ha))

maybeFlush :: Hand -> Maybe Card
maybeFlush (ca1:cs) = if all (suit ca1 ==) (map suit cs) then Just $ last cs else Nothing

maybeStraight :: Hand -> Maybe Card
maybeStraight ((Card B _):_) = Nothing
maybeStraight ha             = maybeStraight' (map (\ca -> (fromEnum ca - 2) `div` 4) ha) (last ha)
maybeStraight' :: [Int] -> Card -> Maybe Card
maybeStraight' ns ca
  | ns == [0, 1, 2, 3, 12]                = Just ca
  | all (1 ==) (zipWith (-) (tail ns) ns) = Just ca
  | otherwise                             = Nothing

maybeThreeCard :: Hand -> Maybe (Rank, Card)
maybeThreeCard ha = findMultiple ha 3 >>= (\ra -> find (\ca -> ra /= rank ca) (reverse ha) >>= (\ca -> return (ra, ca)))

-- ツーペアとワンペアは group で書き直せる。
-- group の結果、[[a, a], [b, b], [c]] のようになるのがツーペア、
-- [[a], [b], [c, c], [d]] のようになるのがワンペア、
-- つまり length が 3 ならツーペアで 4 ならワンペア、
-- ツーペアの場合は a, b, c を取り出し、ワンペアなら c, d を取り出すという感じになる。
-- この部分の修正はまた今度行おう。
maybeTwoPair :: Hand -> Maybe (Rank, Rank, Card)
maybeTwoPair (ca1@(Card _ ra1):Card _ ra2:ca3@(Card _ ra3):Card _ ra4:[ca5@(Card _ ra5)])
  | ra1 == ra2 && ra3 == ra4 = Just (ra4, ra2, ca5)
  | ra1 == ra2 && ra4 == ra5 = Just (ra5, ra2, ca3)
  | ra2 == ra3 && ra4 == ra5 = Just (ra5, ra3, ca1)
  | otherwise                = Nothing

maybeOnePair :: Hand -> Maybe (Rank, Card)
maybeOnePair (Card _ ra1:Card _ ra2:ca3@(Card _ ra3):Card _ ra4:[ca5@(Card _ ra5)])
  | ra1 == ra2 = Just (ra2, ca5)
  | ra2 == ra3 = Just (ra3, ca5)
  | ra3 == ra4 = Just (ra4, ca5)
  | ra4 == ra5 = Just (ra5, ca3)
  | otherwise  = Nothing

Haskell でポーカーの役判定処理 #2

Haskell でポーカーの役判定処理 - satosystemsの日記 の続き。

ポーカーの役判定処理をイチから書き直した。
改善されたのは以下。

• エースが数値で最も強いルールに改善
• 絵柄による役の強さに改善
• ジョーカーがあっても判定できるように改善
• いくつかのバグを修正
• ロジックの改善

今ひとつよくわからない点は、コード内にコメントしてある。

ほとんどが Card というデータ型に関する悩み。具体的には Card は Card Suit Rank というコンストラクタと C2, C3, C4 というコンストラクタがあって、ロジックでは前者を、リテラルで書きたいときや入出力では後者を利用したいという要求から、Card データ型は Read, Show, Ord, Eq, Enum をすべて定義している。その実装が冗長なので何とかしたい。

module Poker (
  Suit(..),
  Rank(..),
  Card(..),
  Hand,
  HandRank(..),
  ranking,
) where

import Data.List (find, findIndices, sort)

-- 絵柄の弱い順に定義
-- J はジョーカーを表し、B は役判定処理でのブランクカードを表す
data Suit = J | B | C | D | H | S deriving (Show, Ord, Eq, Enum)

instance Read Suit where
  readsPrec _ s = readSuit s

readSuit :: ReadS Suit
readSuit ""       = []
readSuit ('J':cs) = [(J, cs)]
readSuit ('B':cs) = [(B, cs)]
readSuit ('C':cs) = [(C, cs)]
readSuit ('D':cs) = [(D, cs)]
readSuit ('H':cs) = [(H, cs)]
readSuit ('S':cs) = [(S, cs)]
readSuit _        = []

-- 数値の弱い順に定義
-- Zero はジョーカーとブランクカードでのみ利用される
data Rank = Zero | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Ord, Eq, Enum)

instance Read Rank where
  readsPrec _ s = readRank s

-- この部分をエレガントに書けないものか
readRank :: ReadS Rank
readRank ""           = []
readRank ('0':cs)     = [(Zero, cs)]
readRank ('2':cs)     = [(Two, cs)]
readRank ('3':cs)     = [(Three, cs)]
readRank ('4':cs)     = [(Four, cs)]
readRank ('5':cs)     = [(Five, cs)]
readRank ('6':cs)     = [(Six, cs)]
readRank ('7':cs)     = [(Seven, cs)]
readRank ('8':cs)     = [(Eight, cs)]
readRank ('9':cs)     = [(Nine, cs)]
readRank ('1':'0':cs) = [(Ten, cs)]
readRank ('1':'1':cs) = [(Jack, cs)]
readRank ('1':'2':cs) = [(Queen, cs)]
readRank ('1':'3':cs) = [(King, cs)]
readRank ('1':cs)     = [(Ace, cs)]
readRank _            = []

-- この部分をエレガントに書けないものか
instance Show Rank where
  show Zero  = "0"
  show Two   = "2"
  show Three = "3"
  show Four  = "4"
  show Five  = "5"
  show Six   = "6"
  show Seven = "7"
  show Eight = "8"
  show Nine  = "9"
  show Ten   = "10"
  show Jack  = "11"
  show Queen = "12"
  show King  = "13"
  show Ace   = "1"

data Card = Card { suit :: Suit, rank :: Rank }
  | J0 | B0
  | C2 | D2 | H2 | S2 | C3 | D3 | H3 | S3 | C4 | D4 | H4 | S4
  | C5 | D5 | H5 | S5 | C6 | D6 | H6 | S6 | C7 | D7 | H7 | S7
  | C8 | D8 | H8 | S8 | C9 | D9 | H9 | S9 | C10 | D10 | H10 | S10
  | C11 | D11 | H11 | S11 | C12 | D12 | H12 | S12
  | C13 | D13 | H13 | S13 | C1 | D1 | H1 | S1

-- Card のコンストラクタとほとんどかぶるこのリスト定義はなんとかならないか
labels = [ "J0", "B0"
         , "C2", "D2", "H2", "S2", "C3", "D3", "H3", "S3", "C4", "D4", "H4", "S4"
         , "C5", "D5", "H5", "S5", "C6", "D6", "H6", "S6", "C7", "D7", "H7", "S7"
         , "C8", "D8", "H8", "S8", "C9", "D9", "H9", "S9", "C10", "D10", "H10", "S10"
         , "C11", "D11", "H11", "S11", "C12", "D12", "H12", "S12"
         , "C13", "D13", "H13", "S13", "C1", "D1", "H1", "S1"
         ]

-- これも何とかならないものか
instance Show Card where
  show (Card su ra) = show su ++ show ra
  show J0           = labels !! 0
  show B0           = labels !! 1
  show C2           = labels !! 2
  show D2           = labels !! 3
  show H2           = labels !! 4
  show S2           = labels !! 5
  show C3           = labels !! 6
  show D3           = labels !! 7
  show H3           = labels !! 8
  show S3           = labels !! 9
  show C4           = labels !! 10
  show D4           = labels !! 11
  show H4           = labels !! 12
  show S4           = labels !! 13
  show C5           = labels !! 14
  show D5           = labels !! 15
  show H5           = labels !! 16
  show S5           = labels !! 17
  show C6           = labels !! 18
  show D6           = labels !! 19
  show H6           = labels !! 20
  show S6           = labels !! 21
  show C7           = labels !! 22
  show D7           = labels !! 23
  show H7           = labels !! 24
  show S7           = labels !! 25
  show C8           = labels !! 26
  show D8           = labels !! 27
  show H8           = labels !! 28
  show S8           = labels !! 29
  show C9           = labels !! 30
  show D9           = labels !! 31
  show H9           = labels !! 32
  show S9           = labels !! 33
  show C10          = labels !! 34
  show D10          = labels !! 35
  show H10          = labels !! 36
  show S10          = labels !! 37
  show C11          = labels !! 38
  show D11          = labels !! 39
  show H11          = labels !! 40
  show S11          = labels !! 41
  show C12          = labels !! 42
  show D12          = labels !! 43
  show H12          = labels !! 44
  show S12          = labels !! 45
  show C13          = labels !! 46
  show D13          = labels !! 47
  show H13          = labels !! 48
  show S13          = labels !! 49
  show C1           = labels !! 50
  show D1           = labels !! 51
  show H1           = labels !! 52
  show S1           = labels !! 53

instance Read Card where
  readsPrec _ s = readCard s

readCard :: ReadS Card
readCard "" = []
readCard s = case readSuit s of
  []          -> []
  [(su, cs1)] -> case readRank cs1 of
    []          -> []
    [(ra, cs2)] -> [(Card su ra, cs2)]

instance Ord Card where
  compare ca1 ca2 = compare (fromEnum ca1) (fromEnum ca2)

instance Enum Card where
  toEnum n = read $ labels !! n
  fromEnum ca = findIndices (show ca ==) labels !! 0

instance Eq Card where
  x == y = (fromEnum x) == (fromEnum y)

-- 配列にするとロジックが書きやすい
type Hand = [Card]

-- 役の弱い順に定義
data HandRank = HighCard Card
              | OnePair Rank Card
              | TwoPair Rank Rank Card
              | ThreeCard Rank
              | Straight Card
              | Flush Card
              | FullHouse Rank
              | FourCard Rank
              | StraightFlush Card
              | RoyalStraightFlush Suit
              | FiveCard Rank deriving (Show, Read, Eq, Ord)

wildcard :: Hand -> [Card]
wildcard ha = filter (\ca -> find (ca ==) ha == Nothing) [B0 .. S1]

ranking :: Hand -> HandRank
ranking = ranking' . sort . map (toEnum . fromEnum) -- 正規化してからロジックに渡す

-- ここの case of のネストはなんとかならないものか
ranking' :: Hand -> HandRank
ranking' ha@((Card J _):cs) = last $ sort $ map ranking $ map (\ca -> sort $ ca:cs) (wildcard cs)
ranking' ha = case maybeFiveCard ha of
  Just ra -> FiveCard ra
  Nothing -> case maybeRoyalStraightFlush ha of
    Just su -> RoyalStraightFlush su
    Nothing -> case maybeStraightFlush ha of
      Just ca -> StraightFlush ca
      Nothing -> case maybeFourCard ha of
        Just ra -> FourCard ra
        Nothing -> case maybeFullHouse ha of
          Just ra -> FullHouse ra
          Nothing -> case maybeFlush ha of
            Just ca -> Flush ca
            Nothing -> case maybeStraight ha of
              Just ca -> Straight ca
              Nothing -> case maybeThreeCard ha of
                Just ra -> ThreeCard ra
                Nothing -> case maybeTwoPair ha of
                  Just (ra1, ra2, ca) -> TwoPair ra1 ra2 ca
                  Nothing             -> case maybeOnePair ha of
                    Just (ra, ca) -> OnePair ra ca
                    Nothing       -> HighCard $ ha !! 4

maybeFiveCard :: Hand -> Maybe Rank
maybeFiveCard ha@((Card B _):cs) = maybeFourCard ha
maybeFiveCard _                  = Nothing

maybeRoyalStraightFlush :: Hand -> Maybe Suit
maybeRoyalStraightFlush ha@((Card su ra):cs) = case maybeStraightFlush ha of
  Nothing -> Nothing
  Just ca -> if ra == Ten then Just su else Nothing

maybeStraightFlush :: Hand -> Maybe Card
maybeStraightFlush ha = case maybeFlush ha of
  Nothing -> Nothing
  Just ca -> case maybeStraight ha of
    Nothing -> Nothing
    Just _  -> Just ca

maybeFourCard :: Hand -> Maybe Rank
maybeFourCard ha
  | all (1 ==) $ zipWith (-) (tail ha1) ha1 = Just $ rank $ ha !! 4
  | all (1 ==) $ zipWith (-) (tail ha2) ha2 = Just $ rank $ ha !! 0
  | otherwise                               = Nothing
  where ha1 = map fromEnum $ tail ha
        ha2 = map fromEnum $ init ha

maybeFullHouse :: Hand -> Maybe Rank
maybeFullHouse (Card _ ra1:Card _ ra2:Card _ ra3:Card _ ra4:[Card _ ra5])
  | ra1 == ra2 && ra1 == ra3 && ra4 == ra5 = Just ra1
  | ra1 == ra2 && ra3 == ra4 && ra3 == ra5 = Just ra3
  | otherwise                              = Nothing
maybeFullHouse ha = error $ show ha

maybeFlush :: Hand -> Maybe Card
maybeFlush ((Card B _):_) = Nothing
maybeFlush ha             = if all (\ca -> nu1 == num ca) (tail ha) then Just (ha !! 4) else Nothing
  where num ca  = (fromEnum ca - 2) `mod` 4
        nu1 = num $ ha !! 0

maybeStraight :: Hand -> Maybe Card
maybeStraight ((Card B _):_)          = Nothing
maybeStraight (ca1:ca2:ca3:ca4:[ca5]) = if isStraight [num ca1, num ca2, num ca3, num ca4, num ca5] then Just ca5 else Nothing
  where num ca = (fromEnum ca - 2) `div` 4
isStraight :: [Int] -> Bool
isStraight ns = all (1 ==) (zipWith (-) (tail ns) ns) || ns == [0, 1, 2, 3, 12]

maybeThreeCard :: Hand -> Maybe Rank
maybeThreeCard (Card _ ra1:Card _ ra2:Card _ ra3:Card _ ra4:[Card _ ra5])
  | ra1 == ra2 && ra1 == ra3 = Just ra1
  | ra2 == ra3 && ra2 == ra4 = Just ra2
  | ra3 == ra4 && ra3 == ra5 = Just ra3
  | otherwise                = Nothing

maybeTwoPair :: Hand -> Maybe (Rank, Rank, Card)
maybeTwoPair (ca1@(Card _ ra1):Card _ ra2:ca3@(Card _ ra3):Card _ ra4:[ca5@(Card _ ra5)])
  | ra1 == ra2 && ra3 == ra4 = if ra2 > ra4 then Just (ra2, ra4, ca5) else Just (ra4, ra2, ca5)
  | ra1 == ra2 && ra4 == ra5 = if ra2 > ra5 then Just (ra2, ra5, ca3) else Just (ra5, ra2, ca3)
  | ra2 == ra3 && ra4 == ra5 = if ra3 > ra5 then Just (ra3, ra5, ca1) else Just (ra5, ra3, ca1)
  | otherwise                = Nothing

maybeOnePair :: Hand -> Maybe (Rank, Card)
maybeOnePair (Card _ ra1:Card _ ra2:ca3@(Card _ ra3):Card _ ra4:[ca5@(Card _ ra5)])
  | ra1 == ra2 = Just (ra2, ca5)
  | ra2 == ra3 = Just (ra3, ca5)
  | ra3 == ra4 = Just (ra4, ca5)
  | ra4 == ra5 = Just (ra5, ca3)
  | otherwise  = Nothing

パターンマッチがまだ結構多い。

例えばスリーカードなら、ソート済みなので [2, 2, 2, 3, 4]、[2, 3, 3, 3, 4]、[2, 3, 4, 4, 4] のような先頭か真ん中か後ろに同じ番号が固まっているパターンしかないんだけど、これを

  | ra1 == ra2 && ra1 == ra3 = Just ra1
  | ra2 == ra3 && ra2 == ra4 = Just ra2
  | ra3 == ra4 && ra3 == ra5 = Just ra3
  | otherwise                = Nothing

のように力技で判定している。リスト操作で 3 枚あるカードがそれぞれ 2 である、3 である、4 である、ということがわかるようには書けないものか。

2014/08/22 追記

Data.List の group を使うと [2, 2, 2, 3, 4]、[2, 3, 3, 3, 4]、[2, 3, 4, 4, 4] がそれぞれ [ [2, 2, 2], [3], [4] ]、[ [2], [3, 3, 3], [4] ]、[ [2], [3], [4, 4, 4] ] のような形になるので、以下のように書き換えられる。

-- 元実装
maybeFullHouse (Card _ ra1:Card _ ra2:Card _ ra3:Card _ ra4:[Card _ ra5])
  | ra1 == ra2 && ra1 == ra3 && ra4 == ra5 = Just ra1
  | ra1 == ra2 && ra3 == ra4 && ra3 == ra5 = Just ra3
  | otherwise                              = Nothing

-- case of で書きなおしたもの
-- Just の使い方が不自然だしパターンマッチが汚い
maybeFullHouse (Card _ ra1:Card _ ra2:Card _ ra3:Card _ ra4:[Card _ ra5]) =
  case Just (group [ra1, ra2, ra3, ra4, ra5]) of
    Just ((ra:_:[_]):[_]) -> Just ra
    Just (_:([ra:_:[_]])) -> Just ra
    Just _                -> Nothing

-- if then else で書きなおしたもの
-- if else のネストが美しくない
maybeFullHouse (Card _ ra1:Card _ ra2:Card _ ra3:Card _ ra4:[Card _ ra5]) =
  if length l /= 2 then Nothing
    else if length l1 == 3 then Just $ l1 !! 0
      else Just $ l2 !! 0
  where l = group [ra1, ra2, ra3, ra4, ra5]
        l1 = l !! 0
        l2 = l !! 1

書きなおした実装がどちらもあまり良くない。

Haskell でポーカーの役判定処理

麻雀の役判定処理を Haskell で書いてみようかと思って、スモールスタートとしてポーカーの役判定処理を書いてみた。

最初はすべてのカードをデータコンストラクタとして定義する方法を検討していたんだけど、データコンストラクタが多くなりすぎてパターンマッチがしづらくなることがわかった。

カード番号を Int で持つ方法は汎用的なんだけど、番号は 1〜13 までしか存在しないという規約を型で表現できなくなってしまうのが微妙なところ。

たった 5 枚のカードの組み合わせで、ブタ合わせて 10 種類しか役がないポーカーで、こんなに長いコードになってしまうのなら、麻雀は一体どうなってしまうのだろうか・・・？

module Poker (
  Card,
  Hand,
  HandRank,
  ranking
) where

import Data.List (sort)

data Card = S Int | H Int | D Int | C Int deriving (Read, Show, Ord, Eq)
data Hand = Hand Card Card Card Card Card deriving (Show, Eq)
data HandRank = RoyalStraightFlush
              | StraightFlush
              | FourCard
              | FullHouse
              | Flush
              | Straight
              | ThreeCard
              | TwoPair
              | OnePair
              | HighCard deriving (Show, Read, Eq, Ord, Enum)

num :: Card -> Int
num (S n) = n
num (H n) = n
num (D n) = n
num (C n) = n

sort' :: Hand -> Hand
sort' (Hand c1 c2 c3 c4 c5) = Hand (h !! 0) (h !! 1) (h !! 2) (h !! 3) (h !! 4)
  where h = sort [c1, c2, c3, c4, c5]

ranking :: Hand -> HandRank
ranking = ranking' . sort'

ranking' :: Hand -> HandRank
ranking' h = case isRoyalStraightFlush h of
  True -> RoyalStraightFlush
  _ -> case isStraightFlush h of
    True -> StraightFlush
    _ -> case isFourCard h of
      True -> FourCard
      _ -> case isFullHouse h of
        True -> FullHouse
        _ -> case isFlush h of
          True -> Flush
          _ -> case isStraight h of
            True -> Straight
            _ -> case isThreeCard h of
              True -> ThreeCard
              _ -> case isTwoPair h of
                True -> TwoPair
                _ -> case isOnePair h of
                  True -> OnePair
                  _ -> HighCard

isRoyalStraightFlush :: Hand -> Bool
isRoyalStraightFlush (Hand (S 1) (S 10) (S 11) (S 12) (S 13)) = True
isRoyalStraightFlush (Hand (H 1) (H 10) (H 11) (H 12) (H 13)) = True
isRoyalStraightFlush (Hand (D 1) (D 10) (D 11) (D 12) (D 13)) = True
isRoyalStraightFlush (Hand (C 1) (C 10) (C 11) (C 12) (C 13)) = True
isRoyalStraightFlush _ = False

isStraightFlush :: Hand -> Bool
isStraightFlush h = case isFlush h of
  True -> isStraight h
  _ -> False

isFourCard :: Hand -> Bool
isFourCard (Hand c1 c2 c3 c4 c5) = case (n1 == n2, n1 == n3, n1 == n4, n1 == n5) of
  (True, True, True, _) -> True
  (True, True, _, True) -> True
  (True, _, True, True) -> True
  (_, True, True, True) -> True
  _ -> False
  where
    n1 = num c1
    n2 = num c2
    n3 = num c3
    n4 = num c4
    n5 = num c5

isFullHouse :: Hand -> Bool
isFullHouse = isFullHouse' . sort'
isFullHouse' :: Hand -> Bool
isFullHouse' (Hand c1 c2 c3 c4 c5) = isFullHouse'' $ sort [num c1, num c2, num c3, num c4, num c5]
isFullHouse'' :: [Int] -> Bool
isFullHouse'' (n1:n2:n3:n4:n5:[]) = (n1 == n2 && n1 == n3 && n4 == n5) || (n1 == n2 && n3 == n4 && n3 == n5)

isFlush :: Hand -> Bool
isFlush (Hand (S _) (S _) (S _) (S _) (S _)) = True
isFlush (Hand (H _) (H _) (H _) (H _) (H _)) = True
isFlush (Hand (D _) (D _) (D _) (D _) (D _)) = True
isFlush (Hand (C _) (C _) (C _) (C _) (C _)) = True
isFlush _ = False

isStraight :: Hand -> Bool
isStraight (Hand c1 c2 c3 c4 c5) = isStraight' (num c1) (num c2) (num c3) (num c4) (num c5)
isStraight' :: Int -> Int -> Int -> Int -> Int -> Bool
isStraight' 1 2 3 4 5 = True
isStraight' 2 3 4 5 6 = True
isStraight' 3 4 5 6 7 = True
isStraight' 4 5 6 7 8 = True
isStraight' 5 6 7 8 9 = True
isStraight' 6 7 8 9 10 = True
isStraight' 7 8 9 10 11 = True
isStraight' 8 9 10 11 12 = True
isStraight' 9 10 11 12 13 = True
isStraight' 1 10 11 12 13 = True
isStraight' _ _ _ _ _ = False

isThreeCard :: Hand -> Bool
isThreeCard (Hand c1 c2 c3 c4 c5) = case (n1 == n2, n1 == n3, n1 == n4, n1 == n5) of
  (_, _, True, True) -> True
  (_, True, _, True) -> True
  (_, True, True, _) -> True
  (True, _, _, True) -> True
  (True, _, True, _) -> True
  (True, True, _, _) -> True
  _ -> False
  where
    n1 = num c1
    n2 = num c2
    n3 = num c3
    n4 = num c4
    n5 = num c5

isTwoPair :: Hand -> Bool
isTwoPair (Hand c1 c2 c3 c4 c5) = case (n1 == n2, n1 == n3, n1 == n4, n1 == n5) of
  (True, _, _, _) -> isTwoPair' n3 n4 n5
  (_, True, _, _) -> isTwoPair' n2 n4 n5
  (_, _, True, _) -> isTwoPair' n2 n3 n5
  (_, _, _, True) -> isTwoPair' n2 n3 n4
  _ -> case (n2 == n3, n2 == n4, n2 == n5) of
    (True, _, _) -> n4 == n5
    (_, True, _) -> n3 == n5
    (_, _, True) -> n3 == n4
    _ -> False
  where
    n1 = num c1
    n2 = num c2
    n3 = num c3
    n4 = num c4
    n5 = num c5
    isTwoPair' n1 n2 n3 = case (n1 == n2, n1 == n2) of
      (True, _) -> True
      (_, True) -> True
      _ -> n2 == n3

isOnePair :: Hand -> Bool
isOnePair (Hand c1 c2 c3 c4 c5) = case (n1 == n2, n1 == n3, n1 == n4, n1 == n5) of
  (True, _, _, _) -> True
  (_, True, _, _) -> True
  (_, _, True, _) -> True
  (_, _, _, True) -> True
  _ -> case (n2 == n3, n2 == n4, n2 == n5) of
    (True, _, _) -> True
    (_, True, _) -> True
    (_, _, True) -> True
    _ -> case (n3 == n4, n3 == n5) of
      (True, _) -> True
      (_, True) -> True
      _ -> n4 == n5
  where
    n1 = num c1
    n2 = num c2
    n3 = num c3
    n4 = num c4
    n5 = num c5

Haskell で作成した DLL を秀丸マクロから呼び出す

秀丸で Haskell 開発環境をパワーアップさせるために、マクロから呼び出す DLL を Haskell で書ければハッピーになれると思い、調べた結果をまとめておきます。

環境

• OS: Windows 7
• Haskell: Haskell Platform 2013 2.0
  • GHC: ghc 7.6.3
• 秀丸: 8.35 32bit

はじめに

Haskell で DLL を作成するのは、過去においては Windows 版 GHC の特権だったようですが、今では他のプラットフォームでも共有ライブラリの作成ができるようです。Windows 版の DLL 作成方法は公式ドキュメント（13.6. Building and using Win32 DLLs）にも記載されています。ただし、このドキュメントは内容が古く、この手順通りに進めることができません。具体的には *_stub.o というオブジェクトは生成されません。

Haskell の実装

-- HsDLL.hs
{-# LANGUAGE ForeignFunctionInterface #-}

module HsDLL where

import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Ptr (nullPtr)

foreign import stdcall "windows.h SysAllocString" cSysAllocString :: CWString -> IO CWString
foreign export stdcall hsConcat :: CWString -> CWString -> IO CWString
foreign export stdcall hsAdd :: Int -> Int -> IO Int

hsConcat :: CWString -> CWString -> IO CWString
hsConcat a b = do
    s1 <- toHsString a
    s2 <- toHsString b
    cstr <- newCWString (s1 ++ s2)
    ret <- cSysAllocString cstr
    free cstr
    return ret
  -- peekCWString に NULLを与えるとクラッシュするため、NULLなら、空文字列に置換
  where toHsString s = if s == nullPtr
                       then return ""
                       else peekCWString s

hsAdd :: Int -> Int -> IO Int
hsAdd a b = return (a + b)

文字列連結と整数加算の Haskell 実装です。文字列連結の実装は Haskell で文字列型を使ったDLLの作成例 - happynowの日記 を流用させて頂きました。

コンパイルは以下のように行います。

ghc -c HsDLL.hs

C による補助コードの実装

Haskell の補助コードを C で実装します。

// StartEnd.c
#include <Rts.h>
#include <windows.h>

static void HsStart() {
    char *argv[] = {"ghcDll", NULL}, **args = argv;
    int argc = sizeof(argv) / sizeof(argv[0]) - 1;

    hs_init(&argc, &args);
}

static void HsEnd() {
    hs_exit();
}

BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved) {
    switch(fdwReason) {
    case DLL_PROCESS_ATTACH:
        HsStart();
        break;

    case DLL_PROCESS_DETACH:
        HsEnd();
        break;

    case DLL_THREAD_ATTACH:
        break;

    case DLL_THREAD_DETACH:
        break;
    }
    return  TRUE;
}

このコードにはいろいろお約束があり、まず argv は最初の要素が "ghcDll" であること、最後は NULL であること、であるにもかかわらず NULL 以外の要素数を初期化関数に渡さなければならないこと、その際ポインタで渡すことなどです。

上記のような感じで DLLMain 関数を実装しておくと秀丸マクロから使用する際に幸せになれるはずです。

コンパイルは以下のように行います。

ghc -c StartEnd.c

エクスポート関数定義ファイル

エクスポートする関数を以下のように HsDLL.def ファイルで定義します。

EXPORTS
  hsAdd      = hsAdd@8
  hsConcat   = hsConcat@8

これを定義しないと、秀丸から呼び出すことができません。逆に、これを定義することで C などから呼び出すのが面倒になります。

DLL のビルド

以下のようにビルドします。

ghc -shared -o HsDLL.dll HsDLL.o StartEnd.o HsDLL.def -loleaut32

これで HsDLL.dll が生成されます。これを秀丸マクロから呼び出します。

秀丸マクロによる動作確認コード実装

動作確認を秀丸マクロで行います。

// HsDLLTest.mac
loaddll "HsDLL.dll";

if (!result) {
	message "HsDLL.dllのロードに失敗しました。";
	endmacro;
}

#a = dllfunc("hsAdd", 2, 5);
message "2 + 5 = " + str(#a);

$b = dllfuncstrw("hsConcat", "hoge", "fuga");
message "hoge + fuga = " + $b;

freedll;

最近の秀丸で DLL に Unicode が渡せるようになっていて助かりました。

64bit 版秀丸に対応する場合は、いろいろ苦労することになると思います（そもそも Haskell で 64bit 版 DLL が生成できるかどうかわかりません）。

adb で簡単に YYYYMMDD-HHMMSS.png という日時ファイル名のスクリーンショットを取る方法

Windows の場合。

以下の内容を cap.cmd という名前で保存。

setlocal
set file=/sdcard/%date:~0,4%%date:~5,2%%date:~8,2%-%time:~0,2%%time:~3,2%%time:~6,2%.png

adb shell screencap -p %file%
adb pull %file% .
adb shell rm %file%

endlocal

実行はコマンドプロンプトで cap と入力するだけ。

カレントディレクトリにファイルが出来上がる

パスを通しておくと捗る。