我正在探索基于约束的搜索的自动边界。因此,我的起点是SEND MORE MONEY problem,带有solution based on nondeterministic selection without replacement。我修改了计算执行的样本数的方法,以便更好地衡量添加约束对搜索的影响。
import Control.Monad.State
import Control.Monad.Trans.List
import Control.Monad.Morph
import Data.List (foldl')
type CS a b = StateT [a] (ListT (State Int)) b
select' :: [a] -> [(a, [a])]
select' [] = []
select' (x:xs) = (x, xs) : [(y, x:ys) | ~(y, ys) <- select' xs]
select :: CS a a
select = do
i <- lift . lift $ get
xs <- get
lift . lift . put $! i + length xs
hoist (ListT . return) (StateT select')
runCS :: CS a b -> [a] -> ([b], Int)
runCS a xs = flip runState 0 . runListT $ evalStateT a xs
fromDigits :: [Int] -> Int
fromDigits = foldl' (\x y -> 10 * x + y) 0
sendMoreMoney :: ([(Int, Int, Int)], Int)
sendMoreMoney = flip runCS [0..9] $ do
[s,e,n,d,m,o,r,y] <- replicateM 8 select
let send = fromDigits [s,e,n,d]
more = fromDigits [m,o,r,e]
money = fromDigits [m,o,n,e,y]
guard $ s /= 0 && m /= 0 && send + more == money
return (send, more, money)
main :: IO ()
main = print sendMoreMoney
它工作正常,得到正确的结果,并且在搜索过程中保持一个平坦的堆配置文件。但即便如此,它还是很慢。它比不计算选择的情况慢了大约20倍。即使 * 这 * 也不可怕。我可以忍受为了收集这些性能数据而付出巨大的代价。
但我还是不想让性能变得毫无必要地糟糕,所以我决定在性能方面寻找容易实现的目标,而当我这样做时,我遇到了一些令人困惑的结果。
$ ghc -O2 -Wall -fforce-recomp -rtsopts statefulbacktrack.hs
[1 of 1] Compiling Main ( statefulbacktrack.hs, statefulbacktrack.o )
Linking statefulbacktrack ...
$ time ./statefulbacktrack
([(9567,1085,10652)],2606500)
real 0m6.960s
user 0m3.880s
sys 0m2.968s
这个系统时间是完全荒谬的。程序只执行一次输出。这一切都去哪里了?我的下一步是检查strace
。
$ strace -cf ./statefulbacktrack
([(9567,1085,10652)],2606500)
% time seconds usecs/call calls errors syscall
------ ----------- ----------- --------- --------- ----------------
98.38 0.033798 1469 23 munmap
1.08 0.000370 0 21273 rt_sigprocmask
0.26 0.000090 0 10638 clock_gettime
0.21 0.000073 0 10638 getrusage
0.07 0.000023 4 6 mprotect
0.00 0.000000 0 8 read
0.00 0.000000 0 1 write
0.00 0.000000 0 144 134 open
0.00 0.000000 0 10 close
0.00 0.000000 0 1 execve
0.00 0.000000 0 9 9 access
0.00 0.000000 0 3 brk
0.00 0.000000 0 1 ioctl
0.00 0.000000 0 847 sigreturn
0.00 0.000000 0 1 uname
0.00 0.000000 0 1 select
0.00 0.000000 0 13 rt_sigaction
0.00 0.000000 0 1 getrlimit
0.00 0.000000 0 387 mmap2
0.00 0.000000 0 16 15 stat64
0.00 0.000000 0 10 fstat64
0.00 0.000000 0 1 1 futex
0.00 0.000000 0 1 set_thread_area
0.00 0.000000 0 1 set_tid_address
0.00 0.000000 0 1 timer_create
0.00 0.000000 0 2 timer_settime
0.00 0.000000 0 1 timer_delete
0.00 0.000000 0 1 set_robust_list
------ ----------- ----------- --------- --------- ----------------
100.00 0.034354 44039 159 total
所以..strace
告诉我只有0.034354s花费在系统调用上。time
报告的sys
时间的其余部分去了哪里?
另一个数据点:GC时间真的很高。有没有简单的方法可以降低它?
$ ./statefulbacktrack +RTS -s
([(9567,1085,10652)],2606500)
5,541,572,660 bytes allocated in the heap
1,465,208,164 bytes copied during GC
27,317,868 bytes maximum residency (66 sample(s))
635,056 bytes maximum slop
65 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10568 colls, 0 par 1.924s 2.658s 0.0003s 0.0081s
Gen 1 66 colls, 0 par 0.696s 2.226s 0.0337s 0.1059s
INIT time 0.000s ( 0.001s elapsed)
MUT time 1.656s ( 2.279s elapsed)
GC time 2.620s ( 4.884s elapsed)
EXIT time 0.000s ( 0.009s elapsed)
Total time 4.276s ( 7.172s elapsed)
%GC time 61.3% (68.1% elapsed)
Alloc rate 3,346,131,972 bytes per MUT second
Productivity 38.7% of total user, 23.1% of total elapsed
系统信息:
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.10.1
$ uname -a
Linux debian 3.2.0-4-686-pae #1 SMP Debian 3.2.68-1+deb7u1 i686 GNU/Linux
在Windows 8.1上的VMWare Player 7.10中运行Debian 7虚拟机。
1条答案
按热度按时间hl0ma9xz1#
请确保在编译命令行中添加-H128
+RTS -s
你的评估看起来很好,所以你可以去那里。
如果您真的想在此虚拟机上处理迟缓问题,请提高虚拟机上的线程优先级(如果需要,还可以稍微提高虚拟机控制台)。
另一个意外的损失是由于GC的同步确认(因为这是多核系统上的SMP Debian)。
GC将在任何多核系统上执行更多的VM操作,这部分解释了61%的GC统计数据以及您的strace和time差异。
您实际上做得相当不错- -尤其是如果这是在i7或更高版本上,例如。
如果-H128选项不能解决这个问题,我会感到惊讶。
我是新来的,如果我能进一步帮助你,或者你有什么需要的话,请在发放赏金之前告诉我。