1 files changed, 76 insertions, 25 deletions
diff --git a/src/Mahjong/Hand.hs b/src/Mahjong/Hand.hs
index f58b602..13055ff 100644
--- a/src/Mahjong/Hand.hs
+++ b/src/Mahjong/Hand.hs
@@ -1,40 +1,91 @@
 module Hand where
 
 import Set
-import Pai
+import Tile
 import Data.List (sort)
 import Data.Maybe
+import Control.Monad
 
 data Hand = Hand {getHand::MSet, getCall::[MSet]}
+    deriving (Show)
 
 max2Win = 7
 
-pairs c (h:hs) = (if length (filter (==h) hs) >= c then 1 else 0) + (pairs $ filter (/=h) hs)
+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)
     where h' = filter is19 h
-normal h = maxmum $ map getSteps $ normal' (0,0,0) (0,0,0) (head orderedPai) $ sort $ h
-    where getSteps (p,w,m) = --pairs, waits, mianzi
-                        (if p == 0 then 1 else 0) +
-                        (min w' 4)+2*(max 0 (4-w'-m))
-                        where w' = (+) w $ max 0 (p-1)
-
-normal' (a,b,c) (p,w,m) cur (h:hs)
-    | cur == h = normal' (a,b,c+1) (p,w,m) cur hs
-    | a + b + c < 2 = -- TODO return
-    | a < 1 = if nextPai' cur == Nothing
-                then normal' (b,c,0) cur hs
-
-costM a b = (sum $ zipWith (snd.sMmin) a b,zipWith (fst.sMmin) a b)
-sMmin a b = if (a>b) then (a-b,0) else (0,b-a)
-
-parseCol xx@(a:b:c:xs) (t,m,p) =
-    concat []
-parseCol _ r = return r
-                                  
-normal h = cm = 
-    where cm = pairs 2 $ filter isCha h
-          cp = (pairs 1 $ filter isCha h) - cm
-          
+
+-- 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
+
+normalSet :: Hand -> [([MSet],[MSet],[MSet],MSet)]
+normalSet h = do
+    (set,r) <- setTest $ sort $ getHand h
+    (part,rr) <- partTest $ sort $ r
+    return (getCall h,set,part,rr)
+
+listen :: ([MSet],[MSet],[MSet],MSet) -> Int
+listen (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
+    where aaaTest = 
+            do
+                guard (t1==t2 && t1==t3)
+                (res,h) <- setTest ts
+                return ([t1,t2,t3]:res,h)
+          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 
+                (res,h) <- setTest rem
+                return ([t1,n1,n2]:res,h)
+          other = do
+            (res,h) <- setTest $ tail t
+            return (res,t1:h)
+setTest t = [([],t)]
+
+partTest :: MSet -> [([MSet],MSet)]
+partTest t@(t1:t2:ts) = aaTest ++ bcTest ++ bdTest ++ other
+    where aaTest = 
+            do
+                guard (t1==t2)
+                (res,h) <- partTest ts
+                return ([t1,t2]:res,h)
+          jn1 = nextTile' (Just t1)
+          jn2 = nextTile' jn1
+          bcTest = 
+            do 
+                n1 <- maybeToList jn1
+                guard (n1 `elem` t)
+                let rem = t `rmTile` t1 `rmTile` n1
+                (res,h) <- partTest rem
+                return ([t1,n1]:res,h)
+          bdTest =
+            do 
+                n2 <- maybeToList jn2
+                guard (n2 `elem` t)
+                let rem = t `rmTile` t1 `rmTile` n2
+                (res,h) <- partTest rem
+                return ([t1,n2]:res,h)
+          other = 
+            do
+                (res,h) <- partTest $ tail t
+                return (res,t1:h)
+partTest t = [([],t)]
+
+rmTile :: MSet -> MTile -> MSet
+rmTile ts t = (takeWhile (/=t) ts) ++ if h == [] then [] else tail h
+    where h = (dropWhile (/=t) ts)
+