麻雀つくり中。。。

gistfile1.hs

import Data.List

-- 牌の定義
data HaiData = Manzu Int
             | Pinzu Int
             | Souzu Int
             | Ton
             | Nan
             | Sha
             | Pei
             | Haku
             | Hatsu
             | Chun
             | NONE
               deriving (Eq, Ord, Show)

-- 順子を作るとき用
nextHai :: HaiData -> HaiData
nextHai (Manzu 9) = NONE
nextHai (Manzu x) = Manzu (x+1)
nextHai (Pinzu 9) = NONE
nextHai (Pinzu x) = Pinzu (x+1)
nextHai (Souzu 9) = NONE
nextHai (Souzu x) = Souzu (x+1)
nextHai _         = NONE


--
-- 順子、刻子、対子を取得するための共通処理
-- HaiDataのリストが指定した手牌の中にあれば、リストと手牌から除いたものを返す。
--
getHaiCommon :: (() -> [HaiData]) -> [HaiData] -> ([HaiData], [HaiData])
getHaiCommon targetGen haiList =
    let
        targetList = targetGen()

        -- 指定したリストが手牌の中に存在するかをチェック
        checkExists :: [HaiData] -> [HaiData] -> Bool
        checkExists []         haiList = True
        checkExists targetList haiList =
            let
                hai = head targetList
            in
              if elem hai haiList
              then checkExists (tail targetList) (delete hai haiList)
              else False

        takeHai :: [HaiData] -> [HaiData] -> [HaiData]
        takeHai []         haiList = haiList
        takeHai targetList haiList =
            takeHai (tail targetList) (delete (head targetList) haiList)
    in
      if checkExists targetList haiList
      then (targetList, takeHai targetList haiList)
      else ([], haiList)


getShuntsu :: HaiData -> [HaiData] -> ([HaiData], [HaiData])
getShuntsu targetHai haiList =
    let
        -- 順子リスト
        gen = (\() -> [targetHai, nextHai targetHai, nextHai $ nextHai targetHai])
    in
      getHaiCommon gen haiList

getKotsu :: HaiData -> [HaiData] -> ([HaiData], [HaiData])
getKotsu targetHai haiList =
    let
        -- 刻子リスト
        gen = (\() -> take 3 $ repeat targetHai)
    in
      getHaiCommon gen haiList


{-
-- 使うかなと思ったけどまだ使っていない関数たち
getManzu :: [HaiData] -> [HaiData]
getManzu haiList = filter (\x -> case x of
                                   (Manzu _) -> True
                                   _         -> False) haiList
getPinzu :: [HaiData] -> [HaiData]
getPinzu haiList = filter (\x -> case x of
                                   (Pinzu _) -> True
                                   _         -> False) haiList
getSouzu :: [HaiData] -> [HaiData]
getSouzu haiList = filter (\x -> case x of
                                   (Souzu _) -> True
                                   _         -> False) haiList
-}


-- 面子型の定義
-- 下記でnubを使うため仕方なく定義
data Mentsu = Shuntsu
            | Kotsu
            | Toitsu
            deriving (Eq, Show)

-- 面子 -> 取得関数
getMentsuFunc :: Mentsu -> HaiData -> [HaiData] -> ([HaiData], [HaiData])
getMentsuFunc Shuntsu = getShuntsu
getMentsuFunc Kotsu   = getKotsu
getMentsuFunc Toitsu  = getToitsu

--
-- アガリの形式定義
-- 特殊形式はまだ定義していない
--
agariList = nub $ permutations [Shuntsu, Shuntsu, Shuntsu, Shuntsu, Toitsu] ++
                  permutations [Shuntsu, Shuntsu, Shuntsu, Kotsu,   Toitsu] ++
                  permutations [Shuntsu, Shuntsu, Kotsu,   Kotsu,   Toitsu] ++
                  permutations [Shuntsu, Kotsu,   Kotsu,   Kotsu,   Toitsu] ++
                  permutations [Kotsu,   Kotsu,   Kotsu,   Kotsu,   Toitsu]

-- 聴牌の形式定義
tempaiList = nub $ permutations [Shuntsu, Shuntsu, Shuntsu, Shuntsu] ++
                   permutations [Shuntsu, Shuntsu, Shuntsu, Kotsu  ] ++
                   permutations [Shuntsu, Shuntsu, Kotsu,   Kotsu  ] ++
                   permutations [Shuntsu, Kotsu,   Kotsu,   Kotsu  ] ++
                   permutations [Kotsu,   Kotsu,   Kotsu,   Kotsu  ] ++
                   permutations [Toitsu,  Shuntsu, Shuntsu, Shuntsu] ++
                   permutations [Toitsu,  Shuntsu, Shuntsu, Kotsu  ] ++
                   permutations [Toitsu,  Shuntsu, Kotsu,   Kotsu  ] ++
                   permutations [Toitsu,  Kotsu,   Kotsu,   Kotsu  ] ++
                   permutations [Toitsu,  Kotsu,   Kotsu,   Kotsu  ]


{-
-- 以前は関数で定義していたが、nubの適用のさせ方が分からなかったので、面子型を作った
agariFuncList = permutations [getShuntsu, getShuntsu, getShuntsu, getShuntsu, getToitsu] ++
                     permutations [getShuntsu, getShuntsu, getShuntsu, getKotsu,   getToitsu] ++
                     permutations [getShuntsu, getShuntsu, getKotsu,   getKotsu,   getToitsu] ++
                     permutations [getShuntsu, getKotsu,   getKotsu,   getKotsu,   getToitsu] ++
                     permutations [getKotsu,   getKotsu,   getKotsu,   getKotsu,   getToitsu]
-}


-- すべての牌。アガリ牌チェックで使用。
allHaiList = [Manzu 1, Manzu 2, Manzu 3, Manzu 4, Manzu 5, Manzu 6, Manzu 7, Manzu 8, Manzu 9,
              Pinzu 1, Pinzu 2, Pinzu 3, Pinzu 4, Pinzu 5, Pinzu 6, Pinzu 7, Pinzu 8, Pinzu 9,
              Souzu 1, Souzu 2, Souzu 3, Souzu 4, Souzu 5, Souzu 6, Souzu 7, Souzu 8, Souzu 9,
              Ton, Nan, Sha, Pei,
              Haku, Hatsu, Chun]


-- 手牌の中から指定した面子を取得する。
-- 面子は手牌の先頭から順に検索していく。
getMentsu mentsu haiList =
    let
        loop func haiList []         = ([],haiList)
        loop func haiList targetList =
            let
                result = func (head targetList) haiList
            in
              if fst result == []
              then loop func haiList (tail targetList)
              else result
    in
      loop (getMentsuFunc mentsu) haiList haiList


-- アガリリストが手牌とマッチするかチェックする。
isMatchAgari mentsuList haiList =
    let
        -- チェック対象の手牌がなくなったら合格
        loop (_,[]) _         = True
        -- 適用した関数の結果がNGの場合不合格
        loop ([],_) _         = False
        -- 関数をチェック対象の手牌に適用させつづける
        loop rest   mentsuList = loop (getMentsu (head mentsuList) (snd rest)) (tail mentsuList)
    in
      loop (getMentsu (head mentsuList) haiList) (tail mentsuList)


-- 聴牌リストが手牌とマッチするかチェックする。
isMatchTempai mentsuList haiList =
    let
        -- 適用した関数の結果がNGの場合不合格
        loop ([],_) _         = False
        -- チェック対象の手牌がなくなったら合格
        loop _ [] = True
        -- 関数をチェック対象の手牌に適用させつづける
        loop rest   mentsuList = loop (getMentsu (head mentsuList) (snd rest)) (tail mentsuList)
    in
      loop (getMentsu (head mentsuList) haiList) (tail mentsuList)



-- 手牌があがっているかチェック
-- 役とかは関係無しに3,3,3,3,2の形になっているかを見る。
-- 七対子、國士のチェックは未実装
isAgari haiList | length haiList /= 14 = False
                | otherwise            =
                    let
                        checkLoop []       = False
                        checkLoop funcList =
                            if isMatchAgari (head funcList) haiList
                            then True
                            else checkLoop (tail funcList)
                    in
                      checkLoop agariList


-- 聴牌していたらアガリ牌をリストで返す。
-- 13個+nの形式があがっているかをチェックするため、結構重い。
getAgarihai haiList | length haiList /= 13 = []
                    | otherwise            =
                        let
                            checkHai []           agari = agari
                            checkHai agariHaiList agari =
                                if isAgari $ head agariHaiList : haiList
                                then checkHai (tail agariHaiList) ((head agariHaiList):agari)
                                else checkHai (tail agariHaiList) agari
                        in
                          checkHai allHaiList []

-- 聴牌チェック
isTempai haiList | length haiList /= 13 = False
                 | otherwise            =
                     let
                         checkLoop []       = False
                         checkLoop funcList =
                             if isMatchTempai (head funcList) $ sort haiList
                             then True
                             else checkLoop (tail funcList)
                     in
                       checkLoop tempaiList