1D Haskell列表上的随机访问性能

时间：2017-10-25 13:04:28

标签： performance haskell

我有一个Haskell程序，它使用Metropolis模拟Ising模型 算法。主要操作是模板操作，它取下一个的总和 2D中的邻居然后将其与中心元素相乘。那么 元素可能已更新。

在C ++中，我获得了不错的性能，我使用一维数组然后线性化 使用简单的索引算术访问它。在过去的几个月里，我已经拿起Haskell来拓宽视野，并尝试在那里实施Ising模型。数据结构只是tabstop：

的列表 
tabstop

然后我有一些固定的范围：

Bool

检索特定晶格点的type Spin = Bool type Lattice = [Spin] 函数，包括周期性边界条件：

extent = 30

我在C ++中使用相同的东西并且在那里工作正常，但我知道 get保证我可以快速随机访问。

在分析时，我发现-- Wrap a coordinate for periodic boundary conditions. wrap :: Int -> Int wrap = flip mod $ extent -- Converts an unbounded (x,y) index into a linearized index with periodic -- boundary conditions. index :: Int -> Int -> Int index x y = wrap x + wrap y * extent -- Retrieve a single element from the lattice, automatically performing -- periodic boundary conditions. get :: Lattice -> Int -> Int -> Spin get l x y = l !! index x y 函数占用了大量资源 计算时间：

std::vector

我已经读过Haskell列表只有在前面推/弹元素时才有用，所以只有在将它用作堆栈时才会给出性能。

当我“更新”格子时，我使用get然后使用COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc get Main ising.hs:36:1-26 153 899100 8.3 0.4 9.2 1.9 index Main ising.hs:31:1-36 154 899100 0.5 1.2 0.9 1.5 wrap Main ising.hs:26:1-24 155 0 0.4 0.4 0.4 0.4 neighborSum Main ising.hs:(40,1)-(43,56) 133 899100 4.9 16.6 46.6 25.3 spin Main ising.hs:(21,1)-(22,17) 135 3596400 0.5 0.4 0.5 0.4 neighborSum.neighbors Main ising.hs:43:9-56 134 899100 0.9 0.7 0.9 0.7 neighborSum.retriever Main ising.hs:42:9-40 136 899100 0.4 0.0 40.2 7.6 neighborSum.retriever.\ Main ising.hs:42:32-40 137 3596400 0.2 0.0 39.8 7.6 get Main ising.hs:36:1-26 138 3596400 33.7 1.4 39.6 7.6 index Main ising.hs:31:1-36 139 3596400 3.1 4.7 5.9 6.1 wrap Main ising.hs:26:1-24 141 0 2.7 1.4 2.7 1.4 返回一个更改了一个元素的新列表。

我能做些相对简单的事情来改善随机访问性能吗？

完整的代码在这里：

splitAt

3 个答案:

答案 0 :(得分：8)

您始终可以使用Data.Vector.Unboxed，这与std::vector基本相同。它具有非常快速的随机访问，但它并不真正允许纯功能更新†。您仍然可以通过ST monad工作来完成此类更新，事实上这可能是一种可以提供最佳性能的解决方案，但它并不是Haskell惯用的。

更好：使用允许查找和更新以及日志（ n ）的功能结构 - ish time;这是基于树的结构的典型特征。 IntMap应该可以很好地运作。

我不建议这样做。通常，在Haskell中，您希望完全避免处理任何索引。正如你所说，像Metropolis这样的算法实际上是基于模板。每次旋转的操作都不应该比其直接邻居看到更多，因此最好相应地构建程序。

即使在一个简单的列表中，也很容易实现对直接邻居的有效访问：实现

neighboursInList :: [a] -> [(a, (Maybe a, Maybe a))]

然后，实际算法在这些本地环境中仅为map。

对于周期性情况，你应该实际上使它像

data Lattice a = Lattice
     { latticeNodes :: [a]
     , latticeLength :: Int }
   deriving (Functor)

data NodeInLattice a = NodeInLattice
     { thisNode :: a
     , xPrev, xNext, yPrev, yNext :: a }
   deriving (Functor)

neighboursInLattice :: Lattice a -> Lattice (NodeInLattice a)

这种方法有很多优点：

  • 无法制作索引错误。
  • 您不依赖于快速随机访问。
  • 可以很好地并行化。例如，repa library内置了模板支持。在超级计算机上运行的所有代码必须使用类似的东西，因为访问位于集群中另一个节点上的随机元素， way 比访问处理器自己的节点内存慢。

† 要纯功能更新矢量，您需要制作完整的副本。

答案 1 :(得分：3)

关闭分析后，您的原始版本将在我的笔记本电脑上运行约5秒钟。

将代码转换为使用不可变的，未装箱的向量（来自Data.Vector.Unboxed）是一种简单的修改，并将运行时间缩短到大约1.8秒。分析该版本表明时间由非常慢的System.Random生成器控制。

使用基于random-mersenne-pure64包的自定义生成器，我可以将运行时间缩短到大约0.32秒。使用线性同余发生器可将时间缩短至0.22秒。

重新分析，瓶颈似乎是检查向量操作的边界，因此用“不安全”对应物替换它们会使运行时间缩短到大约0.17秒。

此时，转换为可变的，未装箱的向量（这是一个比以前更复杂的修改）并没有明显改善性能，但我没有非常努力地优化它。 （我已经看到其他算法从使用可变载体中获益匪浅。）

我的LCG版本的最终代码如下。我试图尽可能多地保留原始代码。

一个恼人的位是为随机索引生成指定extentBits的必要性，并注意如果范围是2的幂，则算法将是最有效的（因为randomIndex生成索引使用给定数量的extentBits，并重新尝试直到索引小于extent。）

请注意，我决定在最终格子中打印True的数量，而不是使用dummy调用，因为它对于基准测试来说更可靠。

import Data.Bits ((.&.), shiftL)
import Data.Word
import qualified Data.Vector as V

type Spin = Bool
type Lattice = V.Vector Spin

-- Lattice extent is fixed to a square.
extent, extentBits, volume :: Int
extent = 30
extentBits = 5  -- no of bits s.t. 2**5 >= 30
volume = extent * extent

temperature :: Double
temperature = 0.0

-- Converts a `Spin` into `+1` or `-1`.
spin :: Spin -> Int
spin True = 1
spin False = (-1)

-- Wrap a coordinate for periodic boundary conditions.
wrap :: Int -> Int
wrap = flip mod $ extent

-- Converts an unbounded (x,y) index into a linearized index with periodic
-- boundary conditions.
index :: Int -> Int -> Int
index x y = wrap x + wrap y * extent

-- Retrieve a single element from the lattice, automatically performing
-- periodic boundary conditions.
get :: Lattice -> Int -> Int -> Spin
get l x y = l `V.unsafeIndex` index x y

-- Toggle the spin of an element
toggle :: Lattice -> Int -> Int -> Lattice
toggle l x y = l `V.unsafeUpd` [(i, not (l `V.unsafeIndex` i))] -- flip bit at index i
  where i = index x y

-- Computes the sum of neighboring spins.
neighborSum :: Lattice -> Int -> Int -> Int
neighborSum l x y = sum $ map spin $ map (uncurry (get l)) neighbors
    where
        neighbors = [(x+1,y), (x-1,y), (x,y+1), (x,y-1)]

-- Computes the energy difference at a certain lattice site if it would be
-- flipped.
energy :: Lattice -> Int -> Int -> Int
energy l x y = 2 * neighborSum l x y * spin (get l x y)

-- Populates a lattice given a random seed.
initLattice :: Int -> (Lattice,MyGen)
initLattice s = (l, rng')
    where
        rng = newMyGen s
        (allRandom, rng') = go [] rng volume
        go out r 0 = (out, r)
        go out r n = let (a,r') = randBool r
                     in go (a:out) r' (n-1)

        l = V.fromList allRandom

-- Performs a single Metropolis update at the given lattice site.
update :: (Lattice, MyGen) -> Int -> Int -> (Lattice, MyGen)
update (l, rng) x y
  | doUpdate = (toggle l x y, rng')
  | otherwise = (l, rng')
    where
        doUpdate = (shift < 0) || (exp (- fromIntegral shift / temperature) > r)
        shift = energy l x y
        (r, rng') = randDouble rng

-- A full sweep through the lattice.
doSweep :: (Lattice, MyGen) -> (Lattice, MyGen)
doSweep (l, rng) = iterate updateRand (l, rng) !! (extent * extent)

updateRand :: (Lattice, MyGen) -> (Lattice, MyGen)
updateRand (l, rng)
  = let (x, rng') = randIndex rng
        (y, rng'') = randIndex rng'
    in  update (l, rng'') x y

-- Creates a random lattice and performs five sweeps.
main :: IO ()
main = do let lrngs = iterate doSweep (initLattice 2)
              l = fst (lrngs !! 1000)
          print $ V.length (V.filter id l)  -- count the Trues

-- * Random number generation

data MyGen = MyGen Word32

newMyGen :: Int -> MyGen
newMyGen = MyGen . fromIntegral

-- | Get a (positive) integer with given number of bits.
randInt :: Int -> MyGen -> (Int, MyGen)
randInt bits (MyGen s) =
  let s' = 1664525 * s + 1013904223
      mask = (1 `shiftL` bits) - 1
  in  (fromIntegral (s' .&. mask), MyGen s')

-- | Random Bool value
randBool :: MyGen -> (Bool, MyGen)
randBool g = let (i, g') = randInt 1 g
             in  (if i==1 then True else False, g')

-- | Random index
randIndex :: MyGen -> (Int, MyGen)
randIndex g = let (i, g') = randInt extentBits g
              in if i >= extent then randIndex g' else (i, g')

-- | Random [0,1]
randDouble :: MyGen -> (Double, MyGen)
randDouble rng = let (ri, rng') = randInt 32 rng
                 in (fromIntegral ri / (2**32), rng')

如果您更喜欢使用MT生成器，则可以修改导入并替换一些定义，如下所示。请注意，我在测试randInt时没有太努力，所以我不是百分之百确定它是100％正确的，因为那里正在进行所有的纠结。

import Data.Bits ((.|.), shiftL, shiftR, xor)
import Data.Word
import qualified Data.Vector as V
import System.Random.Mersenne.Pure64

-- replace these definitions:

-- | Mersenne-Twister generator w/ pool of bits
data MyGen = MyGen PureMT !Int !Word64 !Int !Word64

newMyGen :: Int -> MyGen
newMyGen seed = MyGen (pureMT (fromIntegral seed)) 0 0 0 0

-- | Split w into bottom n bits and rest
splitBits :: Int -> Word64 -> (Word64, Word64)
splitBits n w =
  let w2 = w `shiftR` n             -- top 64-n bits
      w1 = (w2 `shiftL` n) `xor` w  -- bottom n bits
  in (w1, w2)

-- | Get a (positive) integer with given number of bits.
randInt :: Int -> MyGen -> (Int, MyGen)
randInt bits (MyGen p lft1 w1 lft2 w2)
  -- generate at least 64 bits
  | let lft = lft1 + lft2, lft < 64
  = let w1' = w1 .|. (w2 `shiftL` lft1)
        (w2', p') = randomWord64 p
    in randInt bits (MyGen p' lft w1' 64 w2')
  | bits > 64 = error "randInt has max of 64 bits"
  -- if not enough bits in first word, get needed bits from second
  | bits > lft1
  = let needed = bits - lft1
        (bts, w2') = splitBits needed w2
        out = (w1 `shiftL` needed) .|. bts
    in (fromIntegral out, MyGen p (lft2 - needed) w2' 0 0)
  -- otherwise, just take enough bits from first word
  | otherwise
  = let (out, w1') = splitBits bits w1
    in (fromIntegral out, MyGen p (lft1 - bits) w1' lft2 w2)

答案 2 :(得分：-1)

还有另一种方法：随机访问列表（单链接或双链接，或者根本不链接）。它的最坏情况是按索引访问O（log（n）），不需要有序数据。它不是“跳过”列表，也不是Okasaki的列表，也不是Haskell的列表。性能很棒（在第29个元素上最多测试2个，十亿分之一）。您可以在此ARTICLE（https://www.linkedin.com/pulse/random-access-list-armando-giuseppe-bonatto-minella/）

中找到有关此结构的信息
相关问题
最新问题