Haskell 如何优化生成大型IntMap？_Haskell

Haskell 如何优化生成大型IntMap？

haskell

Haskell 如何优化生成大型IntMap？,haskell,Haskell,下面代码的allCases大小为2^20IntMap，其生成需要大量计算和内存。我不知道这是否是不可避免的成本，我怎样才能找出造成低效率的地方 import Control.Monad (forM_) import Control.Monad.ST import Data.Array import Data.Array.ST import Data.Bits import Data.List import qualified Data.IntMap as M type Switch = Int

下面代码的

allCases

大小为2^20

IntMap

，其生成需要大量计算和内存。我不知道这是否是不可避免的成本，我怎样才能找出造成低效率的地方

import Control.Monad (forM_)
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Bits
import Data.List
import qualified Data.IntMap as M

type Switch = Int
type Clock = Int

switches :: Array Switch [Clock]
switches = listArray (0, 9) [
  [0, 1, 2],
  [3, 7, 9, 11],
  [4, 10, 14, 15],
  [0, 4, 5, 6, 7],
  [6, 7, 8, 10, 12],
  [0, 2, 14, 15],
  [3, 14, 15],
  [4, 5, 7, 1, 15],
  [1, 2, 3, 4, 5],
  [3, 4, 5, 9, 13]]

type Quads = Int

intsToQuads :: [Int] -> Quads
intsToQuads [] = 0
intsToQuads (x:xs) = x .|. (intsToQuads xs `shiftL` 2)

switchCases :: [[Int]]
switchCases = sequence $ replicate 10 [0..3]

applySwitch :: Int -> STUArray s Int Int -> ST s ()
applySwitch sw clocks = forM_ (switches ! sw) $ \ix -> do
  clock <- readArray clocks ix
  writeArray clocks ix ((clock + 1) `rem` 4)

allCasesST :: Int -> STUArray s Int Int -> Int -> ST s (M.IntMap Int)
allCasesST ix clocks pushs
  | ix > 9 = do
    cs <- getElems clocks
    return (M.singleton (intsToQuads cs) pushs)
  | otherwise = do
    rs <- mapM next [pushs..pushs + 3]
    return (M.unions rs)
  where
    next pu = do
      rs <- allCasesST (ix + 1) clocks pu
      applySwitch ix clocks
      return rs

allCases :: M.IntMap Int
allCases = runST $ do
  st <- newArray (0,15) 0
  allCasesST 0 st 0

main = do
  putStrLn . show $ M.lookup 0 allCases
  return ()

.prof文件（为保持整洁进行了一些修改）

2017年12月25日星期一23:52时间和分配分析报告（最终版）
a、 exe+RTS-p-hc-xc-s-c-RTS
总时间=1.52秒（1000 us时1518个滴答声，1个处理器）
总alloc=1576087408字节（不包括分析开销）
成本中心模块SRC%时间%alloc
intsToQuads Main.hs:38:29-42 24.9 17.0
AllcaseSt Main.hs:55:13-23 13.7 20.2
applySwitch Main.hs:44:25-45 12.20.0
AllcaseSt Main.hs:51:11-25 10.5 44.2
applySwitch Main.hs:46:3-44 9.50.0
intsToQuads Main.hs:38:22-54 7.20.0
AllcaseSt.next Main.hs:58:13-41 6.2 5.7
intsToQuads Main.hs:38:29-53 4.20.0
applySwitch Main.hs:45:12-30 2.6 7.1
AllcaseSt.next Main.hs:59:7-27 2.2 0.0
AllcaseSt Main.hs:52:26-39 1.8 1.1
ApplySwitchMain.hs:（44,25）-（46,44）1.50.0
AllcaseSt Main.hs:52:13-46 1.4 2.7
AllcaseSt Main.hs:54:11-38 0.7 2.1
个人继承
成本中心SRC分录%time%alloc%time%alloc
主要0.1 0.0 100.0 100.0
CAF GHC.IO.Encoding.CodePage 0.0.0.0 0.0
CAF GHC.IO.Encoding 0.0 0.0.0 0.0
CAF GHC.IO.Handle.Text 0.0.0.0 0.0
CAF GHC.显示0.0.0.0.0
CAF GHC.IO.Handle.FD 0.0.0.0.0
CAF 0.0 0.0 99.9 100.0
所有主要病例。hs：（63,12）-（65,19）0.0 0.0 99.9 100.0
allCases Main.hs:64:9-25 0.0.0.0
AllcaseStST Main.hs:55:5-24 0 0.0 0.0 5.5 5.3
AllcaseSt Main.hs:55:13-23 0 5.5 5.3 5.5 5.3
AllcaseSt Main.hs:54:11-38 0.7 2.1 94.5 94.7
AllcaseSt.next Main.hs:59:7-27 0 0.1 0.0 0.5 0.0
applyswitchmain.hs:（44,25）-（46,44）0.0.0.30.0
applySwitch Main.hs:44:25-45 0.1 0.0 0.3 0.0
applySwitch Main.hs:45:12-30 0.0.0.0
applySwitch Main.hs:44:32-44 0.20.0 0.20.0
AllcaseSt.next Main.hs:58:13-41 06.2 5.7 93.3 92.5
AllcaseSt Main.hs:52:5-47 0.1 0.0 39.7 20.8
AllcaseSt Main.hs:52:13-46 0 1.4 2.7 39.6 20.8
AllcaseSt Main.hs:52:26-39 01.81.138.218.1
intsToQuads Main.hs:38:22-54 0 7.2 0.0 36.4 17.0
intsToQuads Main.hs:38:29-53 0 4.2 0.0 29.1 17.0
intsToQuads Main.hs:38:29-42 0 24.9 17.0 24.9 17.0
AllcaseSt Main.hs:55:5-24 0 0.1 0.0 8.3 14.9
AllcaseSt Main.hs:55:13-23 0 8.214.9 8.214.9
AllcaseSt Main.hs:51:11-25 0 10.5 44.2 10.5 44.2
AllcaseSt.next Main.hs:59:7-27 0 2.1 0.0 28.7 7.1
applyswitchmain.hs:（44,25）-（46,44）01.50.026.57.1
applySwitch Main.hs:44:25-45 0 12.1 0.0 25.0 7.1
applySwitch Main.hs:46:3-44 0 9.5 0.0 10.4 0.0
applySwitch Main.hs:46:25-43 0.9 0.0 0.9 0.0
applySwitch Main.hs:45:12-30 0 2.6 7.1 2.6 7.1
main main.hs:68:3-390.0.0.0
main main.hs:68:21-39 0.0.0.0
main main.hs:68:3-17 0.0.0.0
主开关.hs:（22,12）-（32,19）0.0.0.0
main main.hs:68:3-390.0.0.0
main main.hs:68:3-17 0.0.0.0

您的算法有点太懒了，您正在地图中放置未评估的Thunk

您的原始代码执行如下操作：

<<ghc: 1185249008 bytes, 1136 GCs, 85006914/288126544 avg/max bytes residency (10 samples), 827M in use, 0.000 INIT (0.002 elapsed), 0.595 MUT (0.605 elapsed), 1.830 GC (2.065 elapsed) :ghc>>
./jeiea +RTS -tstderr  2.43s user 0.32s system 99% cpu 2.773 total

这是72MB的驻留空间，大约1秒，但差异很大

编辑：

完整的代码并运行：

import Control.Monad (forM_)
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Bits
import Data.List
import qualified Data.IntMap as M

type Switch = Int
type Clock = Int

switches :: Array Switch [Clock]
switches = listArray (0, 9) [
  [0, 1, 2],
  [3, 7, 9, 11],
  [4, 10, 14, 15],
  [0, 4, 5, 6, 7],
  [6, 7, 8, 10, 12],
  [0, 2, 14, 15],
  [3, 14, 15],
  [4, 5, 7, 1, 15],
  [1, 2, 3, 4, 5],
  [3, 4, 5, 9, 13]]

type Quads = Int

intsToQuads :: [Int] -> Quads
intsToQuads [] = 0
intsToQuads (x:xs) = x .|. (intsToQuads xs `shiftL` 2)

switchCases :: [[Int]]
switchCases = sequence $ replicate 10 [0..3]

applySwitch :: Int -> STUArray s Int Int -> ST s ()
applySwitch sw clocks = forM_ (switches ! sw) $ \ix -> do
  clock <- readArray clocks ix
  let n = ((clock + 1) `rem` 4)
  n `seq` writeArray clocks ix n

allCasesST :: Int -> STUArray s Int Int -> Int -> ST s (M.IntMap Int)
allCasesST ix clocks pushs
  | ix > 9 = do
    cs <- getElems clocks
    let n = intsToQuads cs
    n `seq` return (M.singleton n pushs)
  | otherwise = do
    rs <- mapM next [pushs..pushs + 3]
    return (M.unions rs)
  where
    next pu = do
      let n = ix + 1
      rs <- n `seq` allCasesST n clocks pu
      applySwitch ix clocks
      return rs

allCases :: M.IntMap Int
allCases = runST $ do
  st <- newArray (0,15) 0
  allCasesST 0 st 0

main = do
  putStrLn . show $ M.lookup 0 allCases
  return ()

import-Control.Monad（表单）
进口管制站
导入数据。数组
导入Data.Array.ST
导入数据
导入数据。列表
将限定的Data.IntMap作为M导入
类型开关=Int
类型时钟=Int
开关：：阵列开关[时钟]
开关=listArray（0,9）[
[0, 1, 2],
[3, 7, 9, 11],
[4, 10, 14, 15],
[0, 4, 5, 6, 7],
[6, 7, 8, 10, 12],
[0, 2, 14, 15],
[3, 14, 15],
[4, 5, 7, 1, 15],
[1, 2, 3, 4, 5],
[3, 4, 5, 9, 13]]
类型Quads=Int
intsToQuads:：[Int]->Quads
intsToQuads[]=0
intsToQuads（x:xs）=x.|。（intsToQuads xs`shiftL`2）
开关箱：：[[Int]]
switchCases=序列$replicate 10[0..3]
applySwitch:：Int->stus数组Int->ST
<<ghc: 1185249008 bytes, 1136 GCs, 85006914/288126544 avg/max bytes residency (10 samples), 827M in use, 0.000 INIT (0.002 elapsed), 0.595 MUT (0.605 elapsed), 1.830 GC (2.065 elapsed) :ghc>>
./jeiea +RTS -tstderr  2.43s user 0.32s system 99% cpu 2.773 total

allCasesST :: Int -> STUArray s Int Int -> Int -> ST s (M.IntMap Int)
allCasesST ix clocks pushs
  | ix > 9 = do
    cs <- getElems clocks
    let n = intsToQuads cs
    n `seq` return (M.singleton n pushs)

<<ghc: 1151694576 bytes, 1104 GCs, 26972457/72834536 avg/max bytes residency (11 samples), 215M in use, 0.000 INIT (0.002 elapsed), 0.500 MUT (0.515 elapsed), 0.735 GC (0.816 elapsed) :ghc>>
./jeiea +RTS -tstderr  1.24s user 0.11s system 98% cpu 1.367 total

<<ghc: 1151694576 bytes, 1104 GCs, 26972457/72834536 avg/max bytes residency (11 samples), 215M in use, 0.000 INIT (0.002 elapsed), 0.389 MUT (0.395 elapsed), 0.517 GC (0.573 elapsed) :ghc>>

import Control.Monad (forM_)
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Bits
import Data.List
import qualified Data.IntMap as M

type Switch = Int
type Clock = Int

switches :: Array Switch [Clock]
switches = listArray (0, 9) [
  [0, 1, 2],
  [3, 7, 9, 11],
  [4, 10, 14, 15],
  [0, 4, 5, 6, 7],
  [6, 7, 8, 10, 12],
  [0, 2, 14, 15],
  [3, 14, 15],
  [4, 5, 7, 1, 15],
  [1, 2, 3, 4, 5],
  [3, 4, 5, 9, 13]]

type Quads = Int

intsToQuads :: [Int] -> Quads
intsToQuads [] = 0
intsToQuads (x:xs) = x .|. (intsToQuads xs `shiftL` 2)

switchCases :: [[Int]]
switchCases = sequence $ replicate 10 [0..3]

applySwitch :: Int -> STUArray s Int Int -> ST s ()
applySwitch sw clocks = forM_ (switches ! sw) $ \ix -> do
  clock <- readArray clocks ix
  let n = ((clock + 1) `rem` 4)
  n `seq` writeArray clocks ix n

allCasesST :: Int -> STUArray s Int Int -> Int -> ST s (M.IntMap Int)
allCasesST ix clocks pushs
  | ix > 9 = do
    cs <- getElems clocks
    let n = intsToQuads cs
    n `seq` return (M.singleton n pushs)
  | otherwise = do
    rs <- mapM next [pushs..pushs + 3]
    return (M.unions rs)
  where
    next pu = do
      let n = ix + 1
      rs <- n `seq` allCasesST n clocks pu
      applySwitch ix clocks
      return rs

allCases :: M.IntMap Int
allCases = runST $ do
  st <- newArray (0,15) 0
  allCasesST 0 st 0

main = do
  putStrLn . show $ M.lookup 0 allCases
  return ()

% time ./jeiea +RTS -tstderr
Just 0
<<ghc: 1151694576 bytes, 1104 GCs, 26972457/72834536 avg/max bytes residency (11 samples), 215M in use, 0.000 INIT (0.005 elapsed), 0.812 MUT (0.820 elapsed), 0.979 GC (1.093 elapsed) :ghc>>
./jeiea +RTS -tstderr  1.79s user 0.16s system 99% cpu 1.971 total