如何优化此Haskell限制订单（包含代码，报告，图表）？
我写了限制订单簿的haskell版本，引用用C编写的这个版本：
https://github.com/jordanbaucke/Limit-Order-Book/blob/master/Others/C%2B%2B/engine.c
限价订单簿是许多股票和货币交易所用于计算货币和股票交易的机制。
此haskell版本（源代码进一步向下）向订单提交2000个随机限价订单，并计算平均执行价格。
main = do
orders <- randomOrders
let (orderBook, events) = foldr (\order (book, ev) -> let (b, e) = processOrder order book in (b, ev++e)) (empty, [])
(take 2000 orders)
let (total, count) = ((fromIntegral $ sum $ map executePrice events), fromIntegral $ length events)
print $ "Average execution price: " ++ show (total / count) ++ ", " ++ (show count) ++ " executions"
我用-O2编译它，并且在没有分析的情况下运行程序需要大约10秒钟。
time ./main
"Average execution price: 15137.667036215817, 2706.0 executions"
./main 9.90s user 0.09s system 89% cpu 11.205 total
我试图将程序设置为处理10000个订单，耗时160秒。
time ./main
"Average execution price: 15047.099824996354, 13714.0 executions"
./main 161.99s user 2.08s system 57% cpu 4:44.16 total
在不牺牲功能的情况下，我能做些什么才能大大加快速度？你认为有可能让它每秒处理10000个订单吗？
以下是使用+ RTS hc / hd / hy和hp2ps生成的内存使用情况图表（包含2000个订单）：
以下是源代码：
import Data.Array
import Data.List
import Data.Word
import Data.Maybe
import Data.Tuple
import Debug.Trace
import System.Random
import Control.Monad (replicateM)
-- Price is measured in smallest divisible unit of currency.
type Price = Word64
maximumPrice = 30000
type Quantity = Word64
type Trader a = a
type Entry a = (Quantity, Trader a)
type PricePoint a = [Entry a]
data OrderBook a = OrderBook {
pricePoints :: Array Price (PricePoint a),
minAsk :: Price,
maxBid :: Price
} deriving (Show)
data Side = Buy | Sell deriving (Eq, Show, Read, Enum, Bounded)
instance Random Side where
randomR (a, b) g =
case randomR (fromEnum a, fromEnum b) g of
(x, g') -> (toEnum x, g')
random g = randomR (minBound, maxBound) g
data Order a = Order {
side :: Side,
price :: Price,
size :: Quantity,
trader :: Trader a
} deriving (Show)
data Event a =
Execution {
buyer :: Trader a,
seller :: Trader a,
executePrice :: Price,
executeQuantity :: Quantity
} deriving (Show)
empty :: OrderBook a
empty = OrderBook {
pricePoints = array (1, maximumPrice) [(i, []) | i <- [1..maximumPrice]],
minAsk = maximumPrice,
maxBid = 0
}
insertOrder :: Order a -> OrderBook a -> OrderBook a
insertOrder (Order side price size t) (OrderBook pricePoints minAsk maxBid) =
OrderBook {
pricePoints = pricePoints // [(price, (pricePoints!price) ++ [(size, t)])],
maxBid = if side == Buy && maxBid < price then price else maxBid,
minAsk = if side == Sell && minAsk > price then price else minAsk
}
processOrder :: Order a -> OrderBook a -> (OrderBook a, [Event a])
processOrder order orderBook
| size /= 0 && price `comp` current =
let (_order, _ob, _events) = executeForPrice order{price=current} _orderBook
in (\(a,b) c -> (a,c++b)) (processOrder _order{price=price} _ob) _events
| otherwise = (insertOrder order orderBook, [])
where
Order side price size _ = order
(current, comp, _orderBook)
| side == Buy = (minAsk orderBook, (>=), orderBook{minAsk=current+1})
| side == Sell = (maxBid orderBook, (<=), orderBook{maxBid=current-1})
executeForPrice :: Order a -> OrderBook a -> (Order a, OrderBook a, [Event a])
executeForPrice order orderBook
| null pricePoint = (order, orderBook, [])
| entrySize < size = (\(a, b, c) d -> (a, b, d:c))
(executeForPrice order{size=size-entrySize} (set rest)) (execute entrySize)
| otherwise =
let entries
| entrySize > size = (entrySize-size, entryTrader):rest
| otherwise = rest
in (order{size=0}, set entries, [execute size])
where
pricePoint = (pricePoints orderBook)!price
(entrySize, entryTrader):rest = pricePoint
Order side price size trader = order
set = \p -> orderBook{pricePoints=(pricePoints orderBook)//[(price, p)]}
(buyer, seller) = (if side == Buy then id else swap) (trader, entryTrader)
execute = Execution buyer seller price
randomTraders :: IO [Int]
randomTraders = do
g <- newStdGen
return (randomRs (1, 3) g)
randomPrices :: IO [Word64]
randomPrices = do
g <- newStdGen
return (map fromIntegral $ randomRs (1 :: Int, fromIntegral maximumPrice) g)
randomSizes :: IO [Word64]
randomSizes = do
g <- newStdGen
return (map fromIntegral $ randomRs (1 :: Int, 10) g)
randomSides :: IO [Side]
randomSides = do
g <- newStdGen
return (randomRs (Buy, Sell) g)
randomOrders = do
sides <- randomSides
prices <- randomPrices
sizes <- randomSizes
traders <- randomTraders
let zipped = zip4 sides prices sizes traders
let orders = map (\(side, price, size, trader) -> Order side price size trader) zipped
return orders
main = do
orders <- randomOrders
let (orderBook, events) = foldr (\order (book, ev) -> let (b, e) = processOrder order book in (b, ev++e)) (empty, [])
(take 2000 orders)
let (total, count) = ((fromIntegral $ sum $ map executePrice events), fromIntegral $ length events)
print $ "Average execution price: " ++ show (total / count) ++ ", " ++ (show count) ++ " executions"
以下是分析报告：
ghc -rtsopts --make -O2 OrderBook.hs -o main -prof -auto-all -caf-all -fforce-recomp
time ./main +RTS -sstderr +RTS -hd -p -K100M && hp2ps -e8in -c main.hp
./main +RTS -sstderr -hd -p -K100M
"Average execution price: 15110.97202536367, 2681.0 executions"
3,184,295,808 bytes allocated in the heap
338,666,300 bytes copied during GC
5,017,560 bytes maximum residency (149 sample(s))
196,620 bytes maximum slop
14 MB total memory in use (2 MB lost due to fragmentation)
Generation 0: 4876 collections, 0 parallel, 1.98s, 2.01s elapsed
Generation 1: 149 collections, 0 parallel, 1.02s, 1.07s elapsed
INIT time 0.00s ( 0.00s elapsed)
MUT time 5.16s ( 5.24s elapsed)
GC time 3.00s ( 3.08s elapsed)
RP time 0.00s ( 0.00s elapsed)
PROF time 0.01s ( 0.01s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 8.17s ( 8.33s elapsed)
%GC time 36.7% (36.9% elapsed)
Alloc rate 617,232,166 bytes per MUT second
Productivity 63.1% of total user, 61.9% of total elapsed
./main +RTS -sstderr +RTS -hd -p -K100M 8.17s user 0.06s system 98% cpu 8.349 total
cat main.prof
Sun Feb 9 12:03 2014 Time and Allocation Profiling Report (Final)
main +RTS -sstderr -hd -p -K100M -RTS
total time = 0.64 secs (32 ticks @ 20 ms)
total alloc = 1,655,532,980 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
processOrder Main 46.9 81.2
insertOrder Main 21.9 0.0
executeForPrice Main 18.8 9.7
randomPrices Main 9.4 0.1
main Main 3.1 4.5
minAsk Main 0.0 2.1
maxBid Main 0.0 2.0
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 392 3 3.1 4.5 100.0 99.8
executePrice Main 417 2681 0.0 0.0 0.0 0.0
processOrder Main 398 5695463 46.9 81.2 87.5 95.0
executeForPrice Main 412 5695252 18.8 9.7 18.8 9.7
pricePoints Main 413 5695252 0.0 0.0 0.0 0.0
insertOrder Main 406 1999 21.9 0.0 21.9 0.0
minAsk Main 405 0 0.0 2.1 0.0 2.1
maxBid Main 400 0 0.0 2.0 0.0 2.0
randomOrders Main 393 1 0.0 0.0 9.4 0.2
randomTraders Main 397 1 0.0 0.0 0.0 0.0
randomSizes Main 396 2 0.0 0.1 0.0 0.1
randomPrices Main 395 2 9.4 0.1 9.4 0.1
randomSides Main 394 1 0.0 0.1 0.0 0.1
CAF:main14 Main 383 1 0.0 0.0 0.0 0.0
randomPrices Main 401 0 0.0 0.0 0.0 0.0
CAF:lvl42_r2wH Main 382 1 0.0 0.0 0.0 0.0
main Main 418 0 0.0 0.0 0.0 0.0
CAF:empty_rqz Main 381 1 0.0 0.0 0.0 0.0
empty Main 403 1 0.0 0.0 0.0 0.0
CAF:lvl40_r2wB Main 380 1 0.0 0.0 0.0 0.0
empty Main 407 0 0.0 0.0 0.0 0.0
CAF:lvl39_r2wz Main 379 1 0.0 0.0 0.0 0.1
empty Main 409 0 0.0 0.1 0.0 0.1
CAF:lvl38_r2wv Main 378 1 0.0 0.0 0.0 0.1
empty Main 410 0 0.0 0.1 0.0 0.1
CAF:maximumPrice Main 377 1 0.0 0.0 0.0 0.0
maximumPrice Main 402 1 0.0 0.0 0.0 0.0
CAF:lvl14_r2vF Main 350 1 0.0 0.0 0.0 0.0
executeForPrice Main 414 0 0.0 0.0 0.0 0.0
CAF:lvl12_r2vB Main 349 1 0.0 0.0 0.0 0.0
processOrder Main 415 0 0.0 0.0 0.0 0.0
CAF:lvl10_r2vx Main 348 1 0.0 0.0 0.0 0.0
processOrder Main 416 0 0.0 0.0 0.0 0.0
CAF:lvl8_r2vt Main 347 1 0.0 0.0 0.0 0.0
processOrder Main 399 0 0.0 0.0 0.0 0.0
CAF:lvl6_r2vp Main 346 1 0.0 0.0 0.0 0.0
empty Main 408 0 0.0 0.0 0.0 0.0
CAF:lvl4_r2vl Main 345 1 0.0 0.0 0.0 0.0
empty Main 411 0 0.0 0.0 0.0 0.0
CAF:lvl2_r2vh Main 344 1 0.0 0.0 0.0 0.0
empty Main 404 0 0.0 0.0 0.0 0.0
CAF GHC.Float 319 8 0.0 0.0 0.0 0.0
CAF GHC.Int 304 2 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 278 2 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 239 2 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 232 1 0.0 0.0 0.0 0.0
CAF System.Random 222 1 0.0 0.0 0.0 0.0
CAF Data.Fixed 217 3 0.0 0.0 0.0 0.0
CAF Data.Time.Clock.POSIX 214 2 0.0 0.0 0.0 0.0
我是Haskell的新手。我如何解释这些报告，它们意味着什么以及我可以做些什么来加快我的代码？
1 个答案:
答案 0 :(得分：6)
我们可以从您的分析中注意到两件事。内存中似乎有很多数组，也有相当数量的元组，或者更确切地说是元组投影函数。所以这些似乎是优化的良好目标。
我首先尝试用Data.Map替换数组，对我来说，将执行时间缩短了一半。这比您在问题的评论中报告的要大得多。你没有确切地说你如何使用地图，但我做的一件事是确保初始地图是空的，即我没有用很多空的价格点初始化它。为了实现这一点，我在findWithDefault中使用Data.Map，并在密钥不可用时返回一个空列表。如果你没有这样做，那么这可能是我获得比你更好的加速的原因。
我接着调查了元组选择函数。编写高性能Haskell时的一个常见技巧是确保正确地取消装箱。从函数中返回元组可能代价很高，而且您可以为两个最常调用的函数executePrice和processOrder执行此操作。在重写代码之前，我查看了GHC的中间代码，看看GHC是否已经设法自动取消元组。有关如何查看GHC中间表示的信息，请参阅此文章：Reading GHC Core。要查找的是函数是否具有返回类型(OrderBook a, [Event a])或(# OrderBook a, [Event a] #)。后者是好的，前者是坏的。
我发现GHC 不能够取消组合元组，所以我开始手动取消装箱processOrder的返回类型。为此，我必须使用专门的循环替换foldr中的main，因为foldr无法处理未装箱的元组。这给了适度的收益。然后我尝试取消装箱executeForPrice，但这导致了以下错误：https://ghc.haskell.org/trac/ghc/ticket/8762。可能有办法避免这个错误，但我没有进一步追求它。
另一项小改进：在OrderBook和Order类型中取消包装所有字段。它给了我一点点收获。
我希望这会有所帮助。祝你好运优化你的Haskell程序。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？