Edited at

PureScriptで関数型プログラミングに挑戦した

1/10 遅くなりましたが、やっと追記始めました

PureScriptで関数型プログラミングに挑戦した結果の紹介です。

リポジトリ https://github.com/maron8676/Advent_2018_MyPoker


PureScriptとは


  1. JavaScriptにコンパイルできるAltJSの一種

  2. Haskellに影響を受けている関数型プログラミング言語

  3. 既存のJavaScriptコードと組み合わせて使える

公式 http://www.purescript.org/

インストール方法などは以下の方が詳しく紹介してくださっているので、本記事では省略させていただきます。

純粋関数型スクリプト言語PureScriptのはじめかた


PureScriptで関数型プログラミングに挑戦した

最近、関数型プログラミングを勉強しているのですが、何かを作ってみるのが一番だと思い、トランプのポーカープログラムを作成しました。正確にはまだ手札の役判定だけです。

※勉強中のため、もっといい書き方あるよーという方がいたら教えてくださると助かります。

予定日から遅れてしまっているためいったん投稿しますが、どのような考えで書いていたかを随時追記していきます。


工夫したポイント

ポーカーの役判定で難しいところは以下の2つだと思っています


  1. ジョーカーはどのカードにもなれて、エースは1としても使える

  2. ジョーカーやエースを使ってなるべく強い役で判定する必要がある

今回は安直な実装ですが、ジョーカーやエースを含む手札からあり得る可能性を全て列挙することで1.を解決しました

2.については、強い役から順に判定してくことで解決できると思います(未実装)。


ファイル構成

以下の通りです。未実装部分があるためRank.pursは現状意味がない状態となっています。

ファイル名
内容

Main.purs
メイン処理

Card.purs
カードのモデル

Rank.purs
役のモデル


ジョーカーとエースの扱い

結果から出すとこんな感じになりました


Card.purs(一部)

-- | カード1枚を表す

type Card = Tuple Suit CardNum

-- | カードのスート
data Suit = Diamonds | Clubs | Hearts | Spades | StJoker

-- | スートの表示用文字列
instance showSuit :: Show Suit where
show Diamonds = "Diamonds"
show Clubs = "Clubs"
show Hearts = "Hearts"
show Spades = "Spades"
show StJoker = ""

-- | スートの同値関係
instance eqSuitInst :: Eq Suit where
eq _ StJoker = true
eq StJoker _ = true
eq a b = show a == show b

-- | スートの順序関係(手札ソートのために定義)
derive instance ordSuit :: Ord Suit

-- | カードの番号(強さ)
-- | OneはAceの別名として使う
data CardNum =
One |
Two |
Three |
Four |
Five |
Six |
Seven |
Eight |
Nine |
Ten |
Jack |
Queen |
King |
Ace |
Joker

-- | カードの番号(強さ)の表示用文字列
instance showCardNum :: Show CardNum where
show One = "A"
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 = "J"
show Queen = "Q"
show King = "K"
show Ace = "A"
show Joker = "JK"
derive instance eqCardNumInst :: Eq CardNum

-- | 番号(強さ)の順序関係(手札ソートのために定義)
derive instance ordCardNum :: Ord CardNum

-- | 1つ前の番号(強さ)のカード
pred :: CardNum -> CardNum
pred Ace = King
pred One = Joker
pred Two = Ace
pred Three = Two
pred Four = Three
pred Five = Four
pred Six = Five
pred Seven = Six
pred Eight = Seven
pred Nine = Eight
pred Ten = Nine
pred Jack = Ten
pred Queen = Jack
pred King = Queen
pred Joker = Joker

-- | 1つ次の番号(強さ)のカード
succ :: CardNum -> CardNum
succ Ace = Joker
succ One = Two
succ Two = Three
succ Three = Four
succ Four = Five
succ Five = Six
succ Six = Seven
succ Seven = Eight
succ Eight = Nine
succ Nine = Ten
succ Ten = Jack
succ Jack = Queen
succ Queen = King
succ King = Ace
succ Joker = Joker

-- | 第1引数のカードの1つ前の番号(強さ)が第2引数のカードである場合`True`を返す
isPred :: CardNum -> CardNum -> Boolean
isPred _ Joker = true
isPred Joker _ = true
isPred a b = pred a == b

-- | 第1引数のカードの1つ次の番号(強さ)が第2引数のカードである場合`True`を返す
isSucc :: CardNum -> CardNum -> Boolean
isSucc _ Joker = true
isSucc Joker _ = true
isSucc a b = succ a == b

-- | スートの種類数
cardinalitySuit :: Int
cardinalitySuit = length suits

-- | ジョーカー以外のカードの種類数
cardinalityCardNum :: Int
cardinalityCardNum = length normalCardNums

-- | カード全体の種類数
cardinalityCard :: Int
cardinalityCard = length cards

-- | 全てのスートのリスト
suits :: List Suit
suits = (Diamonds : Clubs : Hearts : Spades : Nil)

-- | 全ての番号(強さ)のリスト
normalCardNums :: List CardNum
normalCardNums = (Two : Three : Four : Five : Six : Seven : Eight : Nine : Ten : Jack : Queen : King : Ace : Nil)

-- | ジョーカー以外のカードのリスト
normalCards :: List Card
normalCards = Tuple <$> suits <*> normalCardNums

-- | 全てのカードのリスト
cards :: List Card
cards = (Tuple StJoker Joker) : normalCards

-- | ロイヤルストレートフラッシュ判定用リスト
royalStraight :: List CardNum
royalStraight = (Ten : Jack : Queen : King : Ace : Nil)



Main.purs(一部)

-- | エースと別名の1を入れ替える 他の番号はそのまま返す

flipAce :: CardNum -> CardNum
flipAce Ace = One
flipAce One = Ace
flipAce cardNum = cardNum

-- | エースを考慮して、カードの番号をあり得る可能性に展開する
expAceElm :: CardNum -> List CardNum
expAceElm cardNum = (identity : flipAce: Nil) <*> singleton cardNum

-- | エースを考慮して、カードの番号のリストをあり得る可能性に展開する
-- | 例 (A : 2 : 3 : 4 : 5 : Nil) -> ((A : 2 : 3 : 4 : 5 : Nil) : (1 : 2 : 3 : 4 : 5 : Nil) : Nil)
expAce :: List CardNum -> List (List CardNum)
expAce = map expAceElm >>> transpose >>> nub

-- | ジョーカーを考慮して、カードの番号をあり得る可能性に展開する
expJokerElm :: CardNum -> List CardNum
expJokerElm Joker = normalCardNums
expJokerElm cardNum = replicate cardinalityCardNum cardNum

-- | ジョーカーを考慮して、カードの番号のリストをあり得る可能性に展開する
-- | 例 (Joker : 2 : 3 : 4 : 5 : Nil) -> ((A : 2 : 3 : 4 : 5 : Nil) : (2 : 2 : 3 : 4 : 5 : Nil) : ... : (K : 2 : 3 : 4 : 5 : Nil) : Nil)
expJoker :: List CardNum -> List (List CardNum)
expJoker = map expJokerElm >>> transpose >>> nub

-- | エースとジョーカーを考慮して、カードの番号をあり得る可能性に展開する
expAceJokerElm :: CardNum -> List CardNum
expAceJokerElm = expJokerElm >=> expAceElm

-- | エースとジョーカーを考慮して、カードの番号のリストをあり得る可能性に展開する
expAceJoker :: List CardNum -> List (List CardNum)
expAceJoker = map expAceJokerElm >>> transpose >>> nub

-- | エースとジョーカーを考慮して、スートをあり得る可能性に展開する
expStJokerElm :: Suit -> List Suit
expStJokerElm StJoker = suits
expStJokerElm suit = replicate cardinalitySuit suit

-- | エースとジョーカーを考慮して、カードをあり得る可能性に展開する
expCardElm :: Card -> List Card
expCardElm card = (expSuit >=> expCardNum) card where
expSuit c = zip (expStJokerElm $ fst c) (replicate cardinalitySuit $ snd c)
expCardNum c = zip (replicate (cardinalityCardNum * length (Ace : One : Nil)) $ fst c) (expAceJokerElm $ snd c)

-- | エースとジョーカーを考慮して、カードのリストをあり得る可能性に展開する
expCard :: List Card -> List (List Card)
expCard = map expCardElm >>> transpose >>> nub



  • Card.pursについて

    内部的にはエースと1を両方持った方が処理しやすそうだったので、カードとしては、1から13、エースとジョーカーを定義することにしました。isPredやisSuccはもっといい書き方あるような気がするので直したいですね。


  • ジョーカーとエースの扱いとMain.pursについて

    expCard関数で、上記の「ジョーカーやエースを含む手札からあり得る可能性を全て列挙する」が実現されています。