如何优化我的 Haskell，以免内存不足

Question

对于在线算法课程，我正试图编写一个程序，使用近似算法计算城市的旅行推销员距离：

1. 从第一个城市开始游览
2. 反复访问最近的城市，但旅游尚未访问。如果打成平手，去最近的最低城市指数例如，如果第三和第五个城市都有与第一个城市的距离相同(并且比其他任何城市都近城市)，然后旅行应该从第一个城市开始第三个城市
3. 一旦每个城市都参观过一次，就返回第一个城市完成游览

我正试图用Haskell编写一个解决方案，我让它处理小数据集，但它在大输入上耗尽了内存(该课程有大约33000个城市的输入)

-- Fold data: cities map, distances map, visited map, list of visited cities and each distance,
-- and current city
data TS = TS (M.Map Int City) (M.Map (Int,Int) Double) (M.Map Int Bool) ([(Int,Double)]) (Int)
run :: String -> String
run input = let cm = parseInput input -- cityMap contains cities (index,xPos,yPos)
n = length $ M.keys cm
dm = buildDistMap cm -- distanceMap :: M.Map (Int,Int) Double
-- which is the distance between cities a and b
ts = TS cm dm (M.fromList [(1,True)]) [(1,0.0)] 1
(TS _ _ _ beforeLast _) = foldl' (ts _ -> exec ts n) ts [2..n]
completed = end beforeLast dm
in show $ floor $ sum $ map ((_,d) -> d) $ completed
exec :: TS -> Int -> TS
exec (TS cm dm visited ordered curr) n =
let candidateIndexes = [(i)|i<-[1..n],M.member i visited == False]
candidates = map (i -> let (Just x) = M.lookup (curr,i) dm in (x,i)) candidateIndexes
(dist,best) = head $ sortBy bestCity candidates
visited' = M.insert best True visited
ordered' = (best,dist) : ordered
in  TS cm dm visited' ordered' best
end :: [(Int,Double)] -> M.Map (Int,Int) Double -> [(Int,Double)]
end ordering dm = let (latest,_) = head ordering
(Just dist) = M.lookup (latest,1) dm
in (1,dist) : ordering
bestCity :: (Double,Int) -> (Double,Int) -> Ordering
bestCity (d1,i1) (d2,i2) =
if compare d1 d2 == EQ
then compare i1 i2
else compare d1 d2

起初，我将函数exec作为递归函数编写，而不是通过foldl'调用它。我认为将其更改为使用foldl'可以解决我的问题，因为foldl'是严格的。然而，它在内存使用方面似乎没有什么不同。我尝试过不使用优化和-O2优化来编译我的程序。

我知道它一定是在内存中保持多个循环，因为我可以使用对34000个数字进行排序而不会出现问题

> sort $ [34000,33999..1]

我到底做错了什么？

这里有parseInput和buildDistMap函数，但它们不是我问题的来源

data City = City Int Double Double deriving (Show, Eq)
-- Init
parseInput :: String -> M.Map Int City
parseInput input =
M.fromList
$ zip [1..]
$ map (((i:x:y:_) -> City (read i) (read x) (read y)) . words)
$ tail
$ lines input
buildDistMap :: M.Map Int City -> M.Map (Int,Int) Double
buildDistMap cm =
let n = length $ M.keys cm
bm = M.fromList $ zip [(i,i)|i<-[1..n]] (repeat 0) :: M.Map (Int,Int) Double
perms = [(x,y)|x<-[1..n],y<-[1..n],x/=y]
in foldl' (dm (x,y) -> M.insert (x,y) (getDist cm dm (x,y)) dm) bm perms
getDist :: M.Map Int City -> M.Map (Int,Int) Double -> (Int,Int) -> Double
getDist cm dm (x,y) =
case M.lookup (y,x) dm
of (Just v) -> v
Nothing -> let (Just (City _ x1 y1)) = M.lookup x cm
(Just (City _ x2 y2)) = M.lookup y cm
in eDist (x1,y1) (x2,y2)
eDist :: (Double,Double) -> (Double,Double) -> Double
eDist (x1,y1) (x2,y2) = sqrt $ p2 (x2 - x1) + p2 (y2 - y1)
where p2 x = x ^ 2

和一些测试输入

tc1 = "6n
1 2 1n
2 4 0n
3 2 0n
4 0 0n
5 4 3n
6 0 3"

Answer 1

data TS = TS (M.Map Int City) (M.Map (Int,Int) Double) (M.Map Int Bool) ([(Int,Double)]) (Int)

(TS _ _ _ beforeLast _) = foldl' (ts _ -> exec ts n) ts [2..n]

exec :: TS -> Int -> TS
exec (TS cm dm visited ordered curr) n =
let ...
in  TS cm dm visited' ordered' best

foldl'做得比你希望的要少得多。它使TS构造函数在每一步都进行评估，但评估过程中没有任何内容需要评估visited'、ordered'或best。(cm和dm在循环中没有修改，所以它们不能堆叠未评估的thunk。)

解决这一问题的最佳方法是使exec返回的TS构造函数的求值充分依赖于对visited'、ordered'和best的求值。

M.Map总是严格的，所以评估一个映射意味着评估整个结构。值是否也一样取决于您导入它的方式，但这在这里并不相关。您插入的值是一个null构造函数，因此它已经被完全求值。因此，将CCD_ 21评估为WHNF就足够了。

Int不是嵌套类型，因此将best求值为WHNF就足够了。

[(Int, Double)](外部括号是多余的，列表括号对其内容进行分组)有点棘手。列表并不严格，对也不严格。但从结构模式来看，这是一个只有预科生的结构。因此，你不需要担心尾巴。如果列表是在进来时评估的，那么只要有新的头，就会对输出进行评估。不幸的是，这意味着你必须小心处理这对。其中一半与上面构建的best值相同，所以这还不错。如果它被评估了，它就被评估了！(尽管这确实表明你不需要在每次迭代时都传递它，但你可以只使用ordered的前面。)这对的另一半是Double，它也是非嵌套的，所以WHNF就足够了。

在这种特殊的情况下，由于不同的方法是必要的，我可能只使用seq来处理这个问题。

let ... all the same stuff ...
in  visited' `seq` dist `seq` best `seq` TS ... all the same stuff ...

请注意，我会小心地强制使用最小数量的值来删除不必要的thunk嵌套。(,)和(:)构造函数不需要评估，只需要评估它们的参数——嵌套的thunk可能会在这里构建。(<thunk <expression> <expression>>和<constructor <expression> <expression>>的内存消耗有什么区别？)

Answer 2

感谢Carl极其详细的回答。同时感谢Daniel指出缓存大量的距离实际上可能会导致我的内存问题。我假设，因为我的代码已经通过了那个函数，所以我有足够的内存来完成它——忘记了Haskell是懒惰的，我只是在实际使用exec函数时才在它中构建映射

我现在用更干净的方式解决了这个问题。我使用的是我仍然需要访问的所有城市指数的Data.Set，然后因为这些城市是按X值的顺序给出的，我知道飞机上最近的城市也将是按指数计算的最近城市。知道了这一点，我设置了一个值，在每次迭代时从索引两侧的集合中提取一个切片，并使用这个切片来检查到我当前城市的距离，这使我能够在每次迭代中计算到下一个城市的距离而无需缓存大量数据。

-- How many cities in each direction (index) to consider
-- smaller is faster but less accurate
searchWidth = 1000 :: Int
data TS = TS (M.Map Int City) (S.Set Int) [(Double,Int)] Int
run :: String -> String
run input =
let cm = parseInput input
n = length $ M.keys cm
toVisit = S.fromList [1..n]
ts = TS cm toVisit [(0.0,1)] 1
(TS _ _ beforeLast _) = foldl' (ts i -> trace (concat [show i,"/",show n]) exec ts) ts [2..n]
afterLast = end cm beforeLast
in show $ floor $ sum $ map ((d,_) -> d) afterLast
exec :: TS -> TS
exec (TS cm toVisit visited curr) =
let (Just (City _ cx cy)) = M.lookup curr cm
index = S.findIndex curr toVisit
toVisit' = S.deleteAt index toVisit
lb = let x = index - searchWidth in if x < 0 then 0 else x
ub = let x = index + searchWidth - lb in if x >= length toVisit' then (length toVisit') else x
candidateIndexes = S.take ub $ S.drop lb toVisit'
candidates = S.map (i -> let (Just (City _ x y)) = M.lookup i cm in (eDist (x,y) (cx,cy),i)) candidateIndexes
(dist,next) = S.findMin candidates
visited' = (dist,next) : visited
in toVisit' `seq` dist `seq` next `seq` TS cm toVisit' visited' next
end :: M.Map Int City -> [(Double,Int)] -> [(Double,Int)]
end cm visited =
let (_,currI) = head visited
(Just (City _ cx cy)) = M.lookup currI cm
(Just (City _ lx ly)) = M.lookup 1 cm
dist = eDist (cx,cy) (lx,ly)
in (dist,1) : visited

使用Data.Set还有一个额外的好处，那就是它可以自动对里面的值进行排序，从而使获得下一个旅行地点变得微不足道。

我意识到这不是世界上最好的Haskell代码，我正在做一些顽皮的事情，比如直接从映射中匹配Just，而不是使用Maybe值。此外，有人向我指出，我应该使用记录而不是data类型来构建我的TS