[英]Haskell - Avoiding a control stack overflow with tree recursion
對於大學作業,我們必須研究背包問題的各種解決方案,然后在Haskell和Python中都實現一個解決方案。
我選擇了蠻力。 我意識到有更好的算法,但是選擇此方法的原因超出了本文的范圍。
但是,在我的兩次嘗試中,使用HUGS時都會導致控制堆棧溢出,而使用GHC時卻不會。
調查似乎指向一個關於嚴格性/惰性的問題,我的代碼最終會產生大量的重擊,而GHC的嚴格性分析似乎正在解決這個問題。
有人可以指出我在下面提供的代碼中出了什么問題,並就如何解決該問題給我帶頭。
注意:我只有4周的Haskell經驗,因此,與Haskell專家編寫的代碼相比,我的代碼天真。
編輯:在中添加了一些seq
語句使該程序在HUGS中工作。 但是,這似乎有點hack。 還有其他可能的改進嗎? 我已經接受了答案,但任何其他建議將不勝感激。
module Main where
import Debug.Trace
import Data.Maybe
type ItemInfo = (Double,Double)
type Item = (ItemInfo,[Char])
type Solution = (ItemInfo,[Item])
-- FilterTerminationCondition should be a function that returns True if this branch of brute force should be stopped.
type FilterTerminationCondition = (Solution -> Bool)
-- FilterComparator should return which, out of two solutions, is better.
-- Both solutions will have passed FilterTerminationCondition succesfully.
type FilterComparator = (Solution -> Solution -> Solution)
-- FilterUsesTerminatingSolution is a boolean which indicates, when FilterTerminationCondition has caused a branch to end, whether to use the set of items that caused the end of the branch (True) or the set of items immeidately before (False).
type FilterUsesTerminatingSolution = Bool
-- A Filter should contain lambada functions for FilterTerminationCondition and FilterComparator
type Filter = (FilterTerminationCondition,FilterComparator,FilterUsesTerminatingSolution)
-- A series of functions to extract the various items from the filter.
getFilterTerminationCondition :: Filter -> FilterTerminationCondition
getFilterTerminationCondition (ftcond,fcomp,futs) = ftcond
getFilterComparator :: Filter -> FilterComparator
getFilterComparator (ftcond,fcomp,futs) = fcomp
getFilterUsesTerminatingSolution :: Filter -> FilterUsesTerminatingSolution
getFilterUsesTerminatingSolution (ftcond,fcomp,futs) = futs
-- Aliases for fst and snd that make the code easier to read later on.
getSolutionItems :: Solution -> [Item]
getSolutionItems (info,items) = items
getItemInfo :: Item -> ItemInfo
getItemInfo (iteminfo,itemname) = iteminfo
getWeight :: ItemInfo -> Double
getWeight (weight,profit) = weight
getSolutionInfo :: Solution -> ItemInfo
getSolutionInfo (info,items) = info
getProfit :: ItemInfo -> Double
getProfit (weight,profit) = profit
knapsack :: Filter -> [Item] -> Solution -> Maybe Solution -> Maybe Solution
knapsack filter [] currentsolution bestsolution = if (getFilterTerminationCondition filter) currentsolution == (getFilterUsesTerminatingSolution filter) then knapsackCompareValidSolutions filter currentsolution bestsolution else bestsolution
knapsack filter (newitem:remainingitems) currentsolution bestsolution = let bestsolutionwithout = knapsack filter remainingitems currentsolution bestsolution
currentsolutionwith = (((getWeight $ getSolutionInfo currentsolution)+(getWeight $ getItemInfo newitem),(getProfit $ getSolutionInfo currentsolution)+(getProfit $ getItemInfo newitem)),((getSolutionItems currentsolution) ++ [newitem]))
in if (getFilterTerminationCondition filter) currentsolutionwith then knapsackCompareValidSolutions filter (if (getFilterUsesTerminatingSolution filter) then currentsolutionwith else currentsolution) bestsolutionwithout else knapsack filter remainingitems currentsolutionwith bestsolutionwithout
knapsackCompareValidSolutions :: Filter -> Solution -> Maybe Solution -> Maybe Solution
knapsackCompareValidSolutions filter currentsolution bestsolution = let returnval = case bestsolution of
Nothing -> currentsolution
Just solution -> (getFilterComparator filter) currentsolution solution
in Just returnval
knapsackStart :: Filter -> [Item] -> Maybe Solution
knapsackStart filter allitems = knapsack filter allitems ((0,0),[]) Nothing
knapsackProblemItems :: [Item]
knapsackProblemItems =
[
((4.13, 1.40),"Weapon and Ammunition"),
((2.13, 2.74),"Water"),
((3.03, 1.55),"Pith Helmet"),
((2.26, 0.82),"Sun Cream"),
((3.69, 2.38),"Tent"),
((3.45, 2.93),"Flare Gun"),
((1.09, 1.77),"Olive Oil"),
((2.89, 0.53),"Firewood"),
((1.08, 2.77),"Kendal Mint Cake"),
((2.29, 2.85),"Snake Repellant Spray"),
((3.23, 4.29),"Bread"),
((0.55, 0.34),"Pot Noodles"),
((2.82,-0.45),"Software Engineering Textbook"),
((2.31, 2.17),"Tinned food"),
((1.63, 1.62),"Pork Pie")
]
knapsackProblemMaxDistance :: Double -> Filter
knapsackProblemMaxDistance maxweight = ((\solution -> (getWeight $ getSolutionInfo solution) > maxweight),(\solution1 solution2 -> if (getProfit $ getSolutionInfo solution1) > (getProfit $ getSolutionInfo solution2) then solution1 else solution2),False)
knapsackProblemMinWeight :: Double -> Filter
knapsackProblemMinWeight mindays = ((\solution -> (getProfit $ getSolutionInfo solution) >= mindays),(\solution1 solution2 -> if (getWeight $ getSolutionInfo solution1) < (getWeight $ getSolutionInfo solution2) then solution1 else solution2),True)
knapsackProblem1 = knapsackStart (knapsackProblemMaxDistance 20) knapsackProblemItems
knapsackProblem2 = knapsackStart (knapsackProblemMaxDistance 25) knapsackProblemItems
knapsackProblem3 = knapsackStart (knapsackProblemMinWeight 25) knapsackProblemItems
如果我不得不猜測,我會說對knapsack
的currentsolution
和bestsolution
參數的評估不夠熱心。 您可以通過添加以下行來強制評估:
knapsack _ _ currentsolution bestsolution | currentsolution `seq` bestsolution `seq` False = undefined
在其他兩種情況之前。
另外,您應該考慮創建新的數據類型,而不是使用元組。 例如
data Filter = Filter
{ getFilterTerminationCondition :: FilterTerminationCondition
, getFilterComparator :: FilterComparator
, getFilterUsesTerminatingSolution :: FilterUsesTerminatingSolution }
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.