大学の課題では、ナップザックの問題に対するさまざまな解決策を調査し、Haskell と Python の両方で解決策を実装する必要があります。
私は力ずくを選びました。より優れたアルゴリズムがあることは理解していますが、この選択の理由はこの記事の範囲を超えています。
ただし、両方の試行で、HUGS を使用するとコントロール スタック オーバーフローが発生しますが、GHC を使用すると発生しません。
調査の結果、厳密性/遅延性に関する問題が指摘されているようで、コードが過剰な量のサンクを生成することになり、GHC の厳密性分析によって問題が解決されているようです。
以下に提供したコードのどこが間違っているかを誰かが指摘し、問題を修正する方法について手がかりを与えることができますか.
注: 私は Haskell の経験が 4 週間しかないので、私のコードは Haskell の専門家が書いたものに比べて素朴であることを理解してください。
編集: にいくつかの ` seq` ステートメントを追加すると、プログラムが HUGS で機能するようになりました。しかし、それは少しハックのようです。他に考えられる改善点はありますか？回答を受け入れましたが、さらにアドバイスをいただければ幸いです。
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