chi peng kangHEADmaster

1 files changed, 59 insertions, 25 deletions

diff --git a/src/Mahjong/Hand.hs b/src/Mahjong/Hand.hs
index 13055ff..c5446da 100644
--- a/src/Mahjong/Hand.hs
+++ b/src/Mahjong/Hand.hs
@@ -1,7 +1,7 @@
-module Hand where
+module Mahjong.Hand where
 
-import Set
-import Tile
+import Mahjong.Set
+import Mahjong.Tile
 import Data.List (sort)
 import Data.Maybe
 import Control.Monad
@@ -15,13 +15,16 @@ pairs :: Int -> [MTile] -> Int
 pairs c (h:hs) = (if length (filter (==h) hs) >= c then 1 else 0) + (pairs c $ filter (/=h) hs)
 pairs c [] = 0
 
-seven h = 7 - (pairs 1 h)
-mosou h = 14 - (pairs 0 h') - (if pairs 1 h' > 0 then 1 else 0)
+seven' h = 7 - (pairs 1 h)
+musou' h = 14 - (pairs 0 h') - (if pairs 1 h' > 0 then 1 else 0)
     where h' = filter is19 h
 
+seven = seven'.getHand
+musou = musou'.getHand
+
 -- For normal xAAA+yBCD+EE is easy
 --  First calculate the maximum number of x+y then the number of partials
-normal h = minimum $ map listen $ normalSet h
+normal h = minimum $ map nlisten $ normalSet h
 
 normalSet :: Hand -> [([MSet],[MSet],[MSet],MSet)]
 normalSet h = do
@@ -29,28 +32,28 @@ normalSet h = do
     (part,rr) <- partTest $ sort $ r
     return (getCall h,set,part,rr)
 
-listen :: ([MSet],[MSet],[MSet],MSet) -> Int
-listen (call,set,part,rr) = rem
+nlisten :: ([MSet],[MSet],[MSet],MSet) -> Int
+nlisten (call,set,part,rr) = rem
     where
         pair = min 1 $ length (filter (\(t1:t2:t) -> t1==t2) part)
         cal = 4 - (length call) - (length set)
         rem = cal * 2 - (min cal ((length part)-pair)) + 1 - pair
 
 setTest :: MSet -> [([MSet],MSet)]
-setTest t@(t1:t2:t3:ts) = (aaaTest)++(bcdTest)++other
+setTest t@(t1:t2:t3:ts) = (bcdTest)++(aaaTest)++other
     where aaaTest = 
             do
                 guard (t1==t2 && t1==t3)
                 (res,h) <- setTest ts
                 return ([t1,t2,t3]:res,h)
+          jt1 = Just t1
+          jn1 = nextTile jt1
+          jn2 = nextTile jn1
           bcdTest =
             do
-                n1 <- maybeToList $ nextTile' $ Just t1
-                n2 <- maybeToList $ nextTile' $ Just n1
-                guard (n1 `elem` t && n2 `elem` t)
-                let rem = t `rmTile` t1 `rmTile` n1 `rmTile` n2 
+                (tt,rem) <- tryTiles [jt1,jn1,jn2] t
                 (res,h) <- setTest rem
-                return ([t1,n1,n2]:res,h)
+                return (tt:res,h)
           other = do
             (res,h) <- setTest $ tail t
             return (res,t1:h)
@@ -63,29 +66,60 @@ partTest t@(t1:t2:ts) = aaTest ++ bcTest ++ bdTest ++ other
                 guard (t1==t2)
                 (res,h) <- partTest ts
                 return ([t1,t2]:res,h)
-          jn1 = nextTile' (Just t1)
-          jn2 = nextTile' jn1
+          jt1 = Just t1
+          jn1 = nextTile jt1
+          jn2 = nextTile jn1
           bcTest = 
             do 
-                n1 <- maybeToList jn1
-                guard (n1 `elem` t)
-                let rem = t `rmTile` t1 `rmTile` n1
+                (tt,rem) <- tryTiles [jn1,jt1] t
                 (res,h) <- partTest rem
-                return ([t1,n1]:res,h)
+                return (tt:res,h)
           bdTest =
             do 
-                n2 <- maybeToList jn2
-                guard (n2 `elem` t)
-                let rem = t `rmTile` t1 `rmTile` n2
+                (tt,rem) <- tryTiles [jn2,jt1] t
                 (res,h) <- partTest rem
-                return ([t1,n2]:res,h)
+                return (tt:res,h)
           other = 
             do
                 (res,h) <- partTest $ tail t
                 return (res,t1:h)
 partTest t = [([],t)]
 
-rmTile :: MSet -> MTile -> MSet
+rmTile :: Eq a => [a] -> a -> [a]
 rmTile ts t = (takeWhile (/=t) ts) ++ if h == [] then [] else tail h
     where h = (dropWhile (/=t) ts)
 
+listen :: Hand -> Int
+listen h = max 0 $ minimum $ [seven,musou,normal] <*> [h]
+
+nextTileSet :: Hand -> MSet
+nextTileSet h@(Hand hand call) = [ tile | tile <- orderedTile, (>) l $ listen $ Hand (tile:hand) call]
+    where 
+        l = listen h
+
+trySet :: [[Maybe MTile]] -> Hand -> [(MSet,Hand)]
+trySet tiles h@(Hand hand call) = map (\(tt,rr) -> (tt,Hand rr (tt:call))) $ concat $ tryTiles <$> tiles <*> [hand]
+
+chi :: Hand -> MTile -> [(MSet,Hand)]
+chi h t = trySet [[p2,p1],[p1,n1],[n1,n2]] h 
+    where
+        p1 = prevTile $ Just t
+        p2 = prevTile p1
+        n1 = nextTile $ Just t
+        n2 = nextTile n1
+
+peng :: Hand -> MTile -> [(MSet,Hand)]
+peng h t = trySet [[jt,jt]] h
+    where jt = Just t
+ankang :: Hand -> MTile -> [(MSet,Hand)]
+ankang h@(Hand hand call) t = trySet (map ((take 4).repeat.Just) orderedTile) (Hand (t:hand) call)
+mingkang :: Hand -> MTile -> [(MSet,Hand)]
+mingkang h t = trySet (map ((take 3).repeat.Just) [t]) h
+jiakang :: Hand -> MTile -> [(MSet,Hand)]
+jiakang h@(Hand hand call) t = [ (tt,Hand hand ((ht:tt):(call `rmTile` tt)))| tt<-call, let ht = head tt, let ts = (t:hand), ht `elem` ts]
+
+tryTiles :: [Maybe MTile] -> MSet -> [(MSet,MSet)]
+tryTiles tl ts = maybeToList $ do
+    tt <- sequence tl
+    guard $ all (`elem` ts) tt
+    return (tt,foldl rmTile ts tt)