import List
import Puzzle

data Kakro = K Int | W Int Int

instance Eq Kakro where
  (K x)   == (K y)   = x == y
  (W _ _) == (W _ _) = True
  _       == _       = False

instance Show Kakro where
  show (K x)   = show x
  show (W v h) = show v ++ "\\" ++ show h

instance Read Kakro where
  readsPrec _ s = case break ('\\'==) s of
	            (_,[])  -> [(K (read s), "")]
                    (v,_:h) -> [(W (read v) (read h),"")]

instance Puzzle Kakro where
  puzzleElm     = map K [1 .. 9]
  vacant = K 0
  candidate b (i,j) = intersect vcand hcand
    where vcand = nub (concat vcands) \\ vfixeds      -- タテ方向の候補
          hcand = nub (concat hcands) \\ hfixeds      -- ヨコ方向の候補
          vcands = filter (include vfixeds) $ kakroCalc vwa (length vgroup)
          hcands = filter (include hfixeds) $ kakroCalc hwa (length hgroup)
          vfixeds = filter (not . (vacant ==)) vgroup
          hfixeds = filter (not . (vacant ==)) hgroup
	  (W vwa _, vgroup) = getGroup j (transpose b !! i)
          (W _ hwa, hgroup) = getGroup i (b !! j)

getGroup :: Int -> [Kakro] -> (Kakro,[Kakro])
getGroup i ks = case splitAt i ks of
                  (ss,ts) -> case break (W 0 0 ==) ts of
                               (us,_) -> case break (W 0 0 ==) (reverse ss) of
                                           (rs,w:_) -> (w,reverse rs++us)

include :: Eq a => [a] -> [a] -> Bool        -- 部分集合かを判定する述語
include xs ys = null (xs \\ ys)

comb :: [a] -> Int -> [[a]]                  -- 組合せの生成
comb _  0 = [[]]
comb [] _ = []
comb (x:xs) n = [ (x:xs') | xs' <- comb xs (n-1) ] ++ comb xs n

kakroCalc :: Int       -- 和
          -> Int       -- マス目の数
          -> [[Kakro]] -- 指定された和になるKakro数字(1から9まで)の組合せ
kakroCalc s n = [ xs | xs <- comb puzzleElm n, s == sum (map (\ (K x) -> x) xs) ]

kakro :: Board Kakro -> [Board Kakro]
kakro = solve

instance Show (Board Kakro) where
  show = showBoard

instance Read (Board Kakro) where
  readsPrec _ s = [(readBoard s, "")]

sample :: Board Kakro
sample = read sampledata

sampledata :: String
sampledata 
 = unlines
   ["0\\0  17\\0  15\\0  23\\0  35\\0   0\\0   9\\0  15\\0  13\\0  11\\0"
   ,"0\\30  0      0      0      0      0\\22  0      0      0      0   "
   ,"0\\28  0      0      0      0     16\\10  0      0      0      0   "
   ,"0\\0  21\\0  23\\34  0      0      0      0      0      6\\0   7\\0"
   ,"0\\16  0      0     33\\17  0      0     16\\7   0      0      0   "
   ,"0\\29  0      0      0      0      7\\11  0      0      0      0   "
   ,"0\\22  0      0      0      8\\4   0      0      8\\4   0      0   "
   ,"0\\0  17\\0   8\\16  0      0      0      0      0      3\\0  10\\0"
   ,"0\\17  0      0      0      0      0\\14  0      0      0      0   "
   ,"0\\29  0      0      0      0      0\\11  0      0      0      0   "]

