0

对于在线算法课程,我正在尝试编写一个程序,该程序使用近似算法计算城市的旅行商距离:

  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]

我在这里到底做错了什么?

以防万一这里有什么用是parseInputandbuildDistMap函数,但它们不是我问题的根源

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 = "6\n\
  \1 2 1\n\
  \2 4 0\n\
  \3 2 0\n\
  \4 0 0\n\
  \5 4 3\n\
  \6 0 3"
4

2 回答 2

3
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。)

解决这个问题的最好方法是使TS返回的构造函数的求值充分exec依赖于求值visited', ordered', best

M.Map始终是脊椎严格的,因此评估地图完全意味着评估整个结构。这些值是否也取决于您导入它的方式,但结果与此处无关。您插入的值是一个空构造函数,因此它已经被完全评估。所以评估visited'WHNF 就足够了。

Int不是嵌套类型,因此评估best为 WHNF 就足够了。

[(Int, Double)](外部括号是多余的,列表括号对其内容进行分组)有点棘手。列表不是脊椎严格的,对也不是严格的。但是看看构造模式,这是一个仅前置的结构。因此,您无需担心尾巴。如果列表被评估进来,只要新的头在,输出就会被评估。不幸的是,这意味着你必须对这对小心一点。其中一半与best上面构造的值相同,所以还不错。如果它被评估,它被评估!(尽管这确实表明您不需要在每次迭代时都传递它,但您可以只使用 . 的前面ordered。)该对的另一半是 a 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>>

于 2021-03-06T18:09:19.400 回答
0

感谢卡尔非常详细的回答。还要感谢 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

使用 aData.Set还带来了额外的好处,它会自动对里面的值进行排序,从而使获得下一个旅行地点变得微不足道。

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

于 2021-03-06T21:58:40.543 回答