7並べするプログラム。

某未来な感じなプログラミングコンテスト7並べするプログラム書けとか言われた。

その場では終わらなかったので、とりあえず家に帰ってhaskellでリベンジしてみた。
条件は

  • 言語は自由
  • 指定された形式のログを読み込み、その次の手を出すプログラムを作る。
  • プログラム作成の制限時間は1時間
  • だたし、単独のコンピュータで5秒以内に終わること。
  • バグはその場で死に

あと7並べのルールとして

  • パス4で死に
  • AとKはループして隣接
  • ゲームオーバーになったらそのプログラムの手札はすべて場に出される
  • 出せるカードは7から連続してつながる場合のみ

ログの形式は、最初二行がヘッダ(\sが半角スペース、\nが改行

(チーム数)\s(自分のチームID)\n
(カード)\s(カード)\s...\s(カード)\n -- 自分に配られたカード

残りがログ

(チームID)\s(カード)\n -- カードを出した場合
(チームID)\n -- パスした場合
(チームID)\s(カード)\s(カード)\s...\s(カード)\n -- ゲームオーバーになった場合、残りの手札を全部吐く。

このどれかの繰り返し。

カードはスート(A,B,C,D)と数字(A,2,3...9,T,J,Q,K)の組み合わせで2文字
ハートのエースなら"AA"、スペードの9なら"B9"など。

ログの例はこんな感じ

4 0
C5 C9 B5 AJ D2 D8 CA B9 CT D9 A2 AQ
0 D8
1 A8
2 C8
3 A9
0 C9
1 B6
2
3 AT
0 AJ
1 C6
2
3 B8
0 AQ
1
2 AK
3 A6
0 B9
1 AA
2 A5
3 D6
0 A2
1 A3
2 A4
3
0 CT
1 BT
2 BJ
3
0 D9
1 CJ
2 BQ
3 BK
0 B5
1 DT
2 DJ
3 BA
0 C5
1
2 C4
3 B2
0
1 B3
2 CQ
3 B4
0
1
2 DQ
3 DK
0
1 C2 D3 D4
2 C3
3 CK
0 CA
2 D5
3 DA
0 D2


上にも書いたけど、その場では終わらなくて逃げ出したんやけど、家でリベンジしてみた。

つーこって、こんなんなりました。
haskellで真っ当なプログラム書くのが初な上、実はほとんど理解してないというアレなんですが、どうにか形になりましたとさ。
所要時間は休憩いれて7時間ぐらいかな?
大半はhaskellの文法見てたけど。

import List
import Maybe

-- Incrementable / Decrementable
-- ++/--できるクラス。
-- methodはinc/decのみ
class Incrementable a where
	inc :: a -> a
class Decrementable a where
	dec :: a -> a

-- Suit: スート。A,B,C,Dがそれぞれハート,スペード,ダイヤ,クラブ
-- Eq, Ord, Show, Read
data Suit = HEART | SPADE | DIAMOND | CLUB deriving (Eq, Ord)
instance Show Suit where
	showsPrec _ HEART			= ('A':)
	showsPrec _ SPADE			= ('B':)
	showsPrec _ DIAMOND			= ('C':)
	showsPrec _ CLUB			= ('D':)
instance Read Suit where
	readsPrec _ ('A':rs)			= [(HEART, rs)]
	readsPrec _ ('B':rs)			= [(SPADE, rs)]
	readsPrec _ ('C':rs)			= [(DIAMOND, rs)]
	readsPrec _ ('D':rs)			= [(CLUB, rs)]
	readsPrec _ _				= [(error "Invaild Suit", [])]


-- Number: 数字。1から13まで。A 2 3 4 5 6 7 8 9 T J Q K
-- Eq, Ord, Show, Read, Incrementable, Decrementable
-- 13 <-> 1がループしている。
-- FIXME: NumとかInt使うべき?
data Number = ACE | DEUCE | TREY | CATER | CINQUE | SICE | SEVEN | EIGHT | NINE | TEN | KNAVE | QUEEN | KING deriving (Eq,Ord)
instance Show Number where
	showsPrec _ ACE				= ('A':)
	showsPrec _ DEUCE			= ('2':)
	showsPrec _ TREY			= ('3':)
	showsPrec _ CATER			= ('4':)
	showsPrec _ CINQUE			= ('5':)
	showsPrec _ SICE			= ('6':)
	showsPrec _ SEVEN			= ('7':)
	showsPrec _ EIGHT			= ('8':)
	showsPrec _ NINE			= ('9':)
	showsPrec _ TEN				= ('T':)
	showsPrec _ KNAVE			= ('J':)
	showsPrec _ QUEEN			= ('Q':)
	showsPrec _ KING			= ('K':)
instance Read Number where
	readsPrec _ ('A':rs)			= [(ACE, rs)]
	readsPrec _ ('2':rs)			= [(DEUCE, rs)]
	readsPrec _ ('3':rs)			= [(TREY, rs)]
	readsPrec _ ('4':rs)			= [(CATER, rs)]
	readsPrec _ ('5':rs)			= [(CINQUE, rs)]
	readsPrec _ ('6':rs)			= [(SICE, rs)]
	readsPrec _ ('7':rs)			= [(SEVEN, rs)]
	readsPrec _ ('8':rs)			= [(EIGHT, rs)]
	readsPrec _ ('9':rs)			= [(NINE, rs)]
	readsPrec _ ('T':rs)			= [(TEN, rs)]
	readsPrec _ ('J':rs)			= [(KNAVE, rs)]
	readsPrec _ ('Q':rs)			= [(QUEEN, rs)]
	readsPrec _ ('K':rs)			= [(KING, rs)]
	readsPrec _ _				= [(error "Invaild Number", [])]
instance Incrementable Number where
	inc ACE					= DEUCE
	inc DEUCE				= TREY
	inc TREY				= CATER
	inc CATER				= CINQUE
	inc CINQUE				= SICE
	inc SICE				= SEVEN
	inc SEVEN				= EIGHT
	inc EIGHT				= NINE
	inc NINE				= TEN
	inc TEN					= KNAVE
	inc KNAVE				= QUEEN
	inc QUEEN				= KING
	inc KING				= ACE
instance Decrementable Number where
	dec ACE					= KING
	dec DEUCE				= ACE
	dec TREY				= DEUCE
	dec CATER				= TREY
	dec CINQUE				= CATER
	dec SICE				= CINQUE
	dec SEVEN				= SICE
	dec EIGHT				= SEVEN
	dec NINE				= EIGHT
	dec TEN					= NINE
	dec KNAVE				= TEN
	dec QUEEN				= KNAVE
	dec KING				= QUEEN

-- Card: カード。スートと数字の組み合わせ。
-- Eq, Ord, Show, Read, Incrementable, Decrementable
data Card = Card {suit :: Suit, number :: Number} deriving (Eq,Ord)
instance Show Card where
	showsPrec _ (Card s n)			= shows s . shows n
	showList []				= id
	showList (x:xs)				= shows x . showl xs
						  where showl []	= id
						        showl (y:ys)	= (' ':) . shows y . showl ys
instance Read Card where
	readsPrec _ r				= [(Card s n, rs) | (s, r1) <- reads r
						                 , (n, rs) <- reads r1]
	readList []				= [([], [])]
	readList r				= [(x:xs, rs) | (x, r1) <- reads r
						              , (xs, rs) <- readl r1]
						  where readl []	= [([], [])]
						        readl (' ':rl)	= [(x:xs, rs) | (x, r1) <- reads rl
									              , (xs, rs) <- readl r1]
						        readl _		= [([], [])]
instance Incrementable Card where
	inc (Card s n)				= Card s (inc n)
instance Decrementable Card where
	dec (Card s n)				= Card s (dec n)

-- LogLine: ログの一行に対するdata。プレーヤIDと出したカード。
-- Show, Read
data LogLine = LogLine {logPlayer :: Int, logCards :: [Card]} deriving Show
instance Read LogLine where
	readsPrec _ r				= [(LogLine p cs, rs) | (p, r1) <- reads r
						                      , (cs, rs) <- readl r1]
						  where readl []	= [([],[])]
						        readl (' ':rl)	= reads rl
						        readl _		= [([],[])]

-- upperEdge / lowerEdge: あるカードからそれぞれ上/下にたどって行った最後のカード。
-- 返すカードはすでにfield上にあるものを返す。(つまりこのカードは出せない。)
upperEdge :: [Card] -> Card -> Maybe Card
upperEdge field card	= if inc (number card) == SEVEN
			    then Nothing
			    else if elem (inc card) field
			           then upperEdge field (inc card)
			           else Just card
lowerEdge :: [Card] -> Card -> Maybe Card
lowerEdge field card	= if dec (number card) == SEVEN
			    then Nothing
			    else if elem (dec card) field
			           then lowerEdge field (dec card)
			           else Just card

-- upperEdges / lowerEdges: upperEdgeとlowerEdgeを各スートの7に適応したリスト。
upperEdges :: [Card] -> [Card]
upperEdges field = catMaybes $ map (\s -> upperEdge field (Card s SEVEN)) allSuits
lowerEdges :: [Card] -> [Card]
lowerEdges field = catMaybes $ map (\s -> lowerEdge field (Card s SEVEN)) allSuits

-- candidates: fieldに出しうるカード。(つまりこれらのカードはfield上にはない)
candidates :: [Card] -> [Card]
candidates field = (map inc $ upperEdges field) ++ (map dec $ lowerEdges field)

-- candidatesInHand: fieldに出しうるカードのうちhandにあるカード。
candidatesInHand :: [Card] -> [Card] -> [Card]
candidatesInHand field = intersect (candidates field)

-- allSuits / allNumbers / allCards: 全スート,数字,カードを返す。
allSuits :: [Suit]
allSuits = [HEART, SPADE, DIAMOND, CLUB]
allNumbers :: [Number]
allNumbers = [ACE, DEUCE, TREY, CATER, CINQUE, SICE, SEVEN, EIGHT, NINE, TEN, KNAVE, QUEEN, KING]
allCards :: [Card]
allCards = [Card s n | s <- allSuits, n <- allNumbers]

-- sevens: 各スートの7を返す。
sevens :: [Card]
sevens = [Card s SEVEN | s <- allSuits ]

main :: IO ()
main = do myID <- (getLine >>= return . read . dropWhile (/=' '))						:: IO Int
	  hand <- (getLine >>= return . read)									:: IO [Card]
	  logs <- (getContents >>= return . map read . lines)							:: IO [LogLine]
	  field <- (return . (++ sevens) . concat . map logCards) logs						:: IO [Card]
	  myPassCount <- (return . length . filter (\l -> logPlayer l == myID && logCards l == [])) logs	:: IO Int

	  putStr "My ID: "		>> print myID
	  putStr "My Pass Count: "	>> print myPassCount
	  putStr "My Hands: "		>> print (sort (hand \\ field))
	  putStr "Field: "		>> print (sort field)
	  putStr "Others Hands: "	>> print (sort ((allCards \\ field) \\ hand))

	  putStrLn ""

	  -- あるカードを出したことによって、出せるようになるカード、その所有者が自分である場合は出しておっけー。
	  putStr "Optimal1: "		>> (print $ nub $ candidatesInHand field $
					                  filter (\card -> (length $ candidatesInHand field hand) ==
					                                   (length $ candidatesInHand (card:field) hand)) hand)

	  -- あるスートの最後の一枚なら出しておっけー。
	  putStr "Optimal2: "		>> (print $ nub $ candidatesInHand field $
	  				                  filter (\card -> upperEdge (card:field) (Card (suit card) SEVEN) == Nothing) hand)
	  -- 全8つのエッジすべてを所有している場合、パスしておく。(相手へのいやがらせ
	  putStr "Should I pass?: "	>> (print $ (myPassCount < 3) && (8 == (length $ candidatesInHand field hand)))
	  -- 出せる候補
	  putStr "Candidates: "		>> (print $ nub $ candidatesInHand field hand)
	  -- 候補がない場合はパスせざるを得ない。
	  putStr "must I pass?: "	>> (print $ (== 0) $ length $ intersect hand $ candidates field)

data Numberあたりがあまりイけてない感じ。
もちっとスマートにならんかねぇ...。
ReadとかShowのclassにする方法とか、だいぶ勉強になった...カナ?

showsPrec, showList, readsPrec, readList
このあたりの具体的な実装例があまり転がってなくて少し泣いた。
まぁ、でもなんとか。