1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
module Hand where
import Set
import Tile
import Data.List (sort)
import Data.Maybe
import Control.Monad
data Hand = Hand {getHand::MSet, getCall::[MSet]}
deriving (Show)
max2Win = 7
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
-- 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)
|
