Haskell - Tree Recursion - Out of Memory

时间:2017-11-30 07:38:58

标签: haskell recursion out-of-memory

以下代码包含任何实际逻辑"挖空"在带有-O标志的GHC 7.10.3上编译时仍然会耗尽内存。我不明白为什么一个简单的树递归,最多堆栈深度为52(标准卡片中的卡数)需要如此多的内存。我尝试在结果变量上使用seq,但这没有帮助。有人可以看看,让我知道为什么内存使用率如此之高,我该怎么做才能避免它?

import qualified Data.Map.Strict as M

type Card = (Int, Char)

compute_rank_multiplicity_map :: [Card] -> M.Map Int Int
compute_rank_multiplicity_map cards = M.fromList [(x, x) | (x, _) <- cards]

determine_hand :: [Card] -> (Int, [(Int, Int)])
determine_hand [] = error "Card list is empty!"
determine_hand cards = (0, mult_rank_desc_list)
  where rank_mult_map = compute_rank_multiplicity_map cards
        mult_rank_desc_list = M.toDescList rank_mult_map

check_kicker_logic :: [Card] -> (Int, Int)
check_kicker_logic cards =
  let first_cards = take 5 cards
      second_cards = drop 5 cards
      first_hand@(f_h, f_mrdl) = determine_hand first_cards
      second_hand@(s_h, s_mrdl) = determine_hand second_cards
  in if (first_hand > second_hand) || (first_hand < second_hand) -- is there a clear winner?
     then if (f_h == s_h) && (head f_mrdl) == (head s_mrdl) -- do we need kicker logic?
          then (1, 1)
          else (0, 1)
     else (0, 0)

card_deck :: [Card]
card_deck = [(r, s) | r <- [2 .. 14], s <- ['C', 'D', 'H', 'S']]

need_kicker_logic :: [Card] -> (Int, Int)
need_kicker_logic cards = visit_subset cards (length cards) [] 0 (0, 0)
  where visit_subset a_cards num_a_cards picked_cards num_picked_cards result@(num_kicker_logic, num_clear_winners)
          | num_cards_needed == 0 = (num_kicker_logic + nkl, num_clear_winners + ncw)
          | num_cards_needed > num_a_cards = result
          | otherwise = let result_1 = visit_subset (tail a_cards)
                                                    (num_a_cards - 1)
                                                    picked_cards
                                                    num_picked_cards
                                                    result
                            result_2 = visit_subset (tail a_cards)
                                                    (num_a_cards - 1)
                                                    ((head a_cards) : picked_cards)
                                                    (num_picked_cards + 1)
                                                    result_1
                        in result_2
          where num_cards_needed = 10 - num_picked_cards
                (nkl, ncw) = check_kicker_logic picked_cards


main :: IO ()
main =
  do
    putStrLn $ show $ need_kicker_logic card_deck

0 个答案:

没有答案