本文共 15271 字,大约阅读时间需要 50 分钟。
正确性:它应当返回被测试文件的正确的字符数、单词数和行数。
速度(真实世界的时间):与wc的执行时间相比是快是慢?
最大常驻内存量:最多使用多少内存?内存使用量是常量还是线性的,或者是其他?
1stupid :: FilePath -> IO (Int, Int, Int)2stupid fp = do3 contents <- readFile fp4 return (length s, length (words s), length (lines s))
很不错,这段代码能正常运行,并且能获得与wc相同的结果——如果你愿意等的话。而我在测试大文件时开始不耐烦(它需要几分钟的时间),但在小文件(90MB)上的测试结果如下:
1import Data.List 2import Data.Char 3 4simpleFold :: FilePath -> IO (Int, Int, Int) 5simpleFold fp = do 6 countFile <$> readFile fp 7 8countFile :: String -> (Int, Int, Int) 9countFile s =10 let (cs, ws, ls, _) = foldl' go (0, 0, 0, False) s11 in (cs, ws, ls)12 where13 go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)14 go (cs, ws, ls, wasSpace) c =15 let addLine | c == '\n' = 116 | otherwise = 017 addWord | wasSpace = 018 | isSpace c = 119 | otherwise = 020 in (cs + 1, ws + addWord, ls + addLine, isSpace c)
结果这个版本遇到了更严重的问题!
程序运行花了几分钟,内存占用迅速超过了3GB!为什么会这样呢?我们使用的是严格版本的foldl'(后面的撇号 ' 表示它是严格的),但它只在“Weak Head Normal Form”(WHNF)中是严格的,也就是说,它在元组累加器中是严格的,但在实际的值中不是严格的!
这很讨厌,因为这意味着我们构造了一大堆巨大的加法操作,但只有在整个文件遍历结束后才进行求值!有时候,懒惰求值就会像这样偷偷地给我们挖坑。如果不注意,这种内存泄漏很容易就会搞垮你的Web服务器。
1{-# LANGUAGE BangPatterns #-} 2 3... 4 go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool) 5 go (!cs, !ws, !ls, !wasSpace) c = 6 let addLine | c == '\n' = 1 7 | otherwise = 0 8 addWord | wasSpace = 0 9 | isSpace c = 110 | otherwise = 011 in (cs + 1, ws + addWord, ls + addLine, isSpace c)
这一点小改动带来了近乎疯狂的性能提升。新的性能数据如下:
90MB测试文件
1import Data.Char 2import qualified Data.ByteString.Lazy.Char8 as BS 3 4simpleFold :: FilePath -> IO (Int, Int, Int) 5simpleFold fp = do 6 simpleFoldCountFile <$> BS.readFile fp 7 8simpleFoldCountFile :: BS.ByteString -> (Int, Int, Int) 9simpleFoldCountFile s =10 let (cs, ws, ls, _) = BS.foldl' go (0, 0, 0, False) s11 in (cs, ws, ls)12 where13 go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)14 go (!cs, !ws, !ls, !wasSpace) c =15 let addLine | c == '\n' = 116 | otherwise = 017 addWord | wasSpace = 018 | isSpace c = 119 | otherwise = 020 in (cs + 1, ws + addWord, ls + addLine, isSpace c)
这一点小改动将运行时间缩短到了将近一半!
90MB测试文件
1data CharType = IsSpace | NotSpace2 deriving Show34data Flux =5 Flux !CharType6 {-# UNPACK #-} !Int7 !CharType8 | Unknown9 deriving Show
这些类型只有在统计单词数时才需要。
1instance Semigroup Flux where2 Unknown <> x = x3 x <> Unknown = x4 Flux l n NotSpace <> Flux NotSpace n' r = Flux l (n + n' - 1) r5 Flux l n _ <> Flux _ n' r = Flux l (n + n') r67instance Monoid Flux where8 mempty = Unknown
这里的Unknown构造函数表示Monoidal幺元,实际上我们可以不用它,而是用Maybe将Semigroupo提升为Monoid,但Maybe会给半群添加操作带来不必要的懒惰性!所以为了简单起见,我只是将其定义为类型的一部分。
1flux :: Char -> Flux2flux c | isSpace c = Flux IsSpace 0 IsSpace3 | otherwise = Flux NotSpace 1 NotSpace
这很简单,非空格字符统计为“单词”,所谓单词就是以非空格开始并结束,所谓空白,就是一个长度为零的单词,两侧被空格字符包围。
1>>> foldMap flux "testing one two three"2Flux NotSpace 4 NotSpace34>>> foldMap flux "testing on" <> foldMap flux "e two three"5Flux NotSpace 4 NotSpace67>>> foldMap flux "testing one " <> foldMap flux " two three"8Flux NotSpace 4 NotSpace
似乎能正常工作!
1data Counts = 2 Counts { charCount :: {-# UNPACK #-} !Int 3 4 , wordCount :: !Flux 5 , lineCount :: {-# UNPACK #-} !Int 6 } 7 deriving (Show) 8 9instance Semigroup Counts where10 (Counts a b c) <> (Counts a' b' c') = Counts (a + a') (b <> b') (c + c')1112instance Monoid Counts where13 mempty = Counts 0 mempty 0
没问题!类似地,我们需要将单个字符变成Counts对象:
1countChar :: Char -> Counts2countChar c =3 Counts { charCount = 14 , wordCount = flux c5 , lineCount = if (c == '\n') then 1 else 06 }
尝试一下:
1>>> foldMap countChar "one two\nthree"2Counts {charCount = 13, wordCount = Flux NotSpace 3 NotSpace, lineCount = 1}
看起来不错!你可以用喜欢的内容来证实这个幺半群是正确的。
1module MonoidBSFold where 2 3import Data.Char 4import qualified Data.ByteString.Lazy.Char8 as BS 5 6monoidBSFold :: FilePath -> IO Counts 7monoidBSFold paths = monoidFoldFile <$> BS.readFile fp 8 9monoidFoldFile :: BS.ByteString -> Counts10monoidFoldFile = BS.foldl' (\a b -> a <> countChar b) mempty
我们将一部分复杂的内容移动到了Counts类型中,这样能大幅简化实现。一般来说这样做很好,因为测试单一数据类型比测试每个使用fold的地方要容易得多。
1monoidBSFold :: FilePath -> IO Counts2monoidBSFold paths = monoidBSFoldFile <$> BS.readFile fp3{-# INLINE monoidBSFold #-}45monoidBSFoldFile :: BS.ByteString -> Counts6monoidBSFoldFile = BS.foldl' (\a b -> a <> countChar b) mempty7{-# INLINE monoidBSFoldFile #-}8
我还给countChar和flux函数添加了INLINE。我们来看看有没有效果:
90MB测试文件
543MB测试文件
1import Types 2import Control.Monad 3import Data.Traversable 4import Data.Bits 5import GHC.Conc (numCapabilities) 6import Control.Concurrent.Async 7import Data.Foldable 8import System.IO 9import System.Posix.Files10import qualified Data.ByteString.Lazy.Char8 as BL11import Data.ByteString.Internal (c2w)12import GHC.IO.Handle1314multiCoreCount :: FilePath -> IO Counts15multiCoreCount fp = do16 putStrLn ("Using available cores: " <> show numCapabilities)17 size <- fromIntegral . fileSize <$> getFileStatus fp18 let chunkSize = fromIntegral (size `div` numCapabilities)19 fold <$!> (forConcurrently [0..numCapabilities-1] $ \n -> do20 -- Take all remaining bytes on the last capability due to integer division anomolies21 let limiter = if n == numCapabilities - 122 then id23 else BL.take (fromIntegral chunkSize)24 let offset = fromIntegral (n * chunkSize)25 fileHandle <- openBinaryFile fp ReadMode26 hSeek fileHandle AbsoluteSeek offset27 countBytes . limiter <$!> BL.hGetContents fileHandle)28{-# INLINE handleSplitUTF #-}2930countBytes :: BL.ByteString -> Counts31countBytes = BL.foldl' (\a b -> a <> countChar b) mempty32{-# INLINE countBytes #-}33
这里涉及了很多东西,我尽量详细地解释一下。
543MB测试文件
输入可以是ASCII或UTF-8编码。当然还有其他流行的编码方式,但根据我有限的经验,绝大部分现代文本文件都采用两者之一。实际上,有许多网站都在致力于让UTF-8成为唯一的编码格式。
我们仅把ASCII中的空格和换行当做空格和换行处理;MONGOLIAN VOWEL SEPARATOR等字符就不考虑了。
1import Data.Bits 2import Data.ByteString.Internal (c2w) 3countByte :: Char -> Counts 4countByte c = 5 Counts { 6 -- Only count bytes at the START of a codepoint, not continuation bytes 7 charCount = if (bitAt 7 && not (bitAt 6)) then 0 else 1 8 , wordCount = flux c 9 , lineCount = if (c == '\n') then 1 else 010 }11 where12 bitAt = testBit (c2w c)13{-# INLINE countByte #-}
这样就好了!现在我们可以处理UTF-8和ASCII了,我们甚至都不需要知道处理的是什么编码,就能永远给出正确的结果。
543MB文件
1module Streaming where 2 3import Types 4import Data.Traversable 5import GHC.Conc (numCapabilities) 6import System.IO (openFile, IOMode(..)) 7import qualified Streamly as S 8import qualified Streamly.Data.String as S 9import qualified Streamly.Prelude as S10import qualified Streamly.Internal.Memory.Array as A11import qualified Streamly.Internal.FileSystem.Handle as FH1213streamingBytestream :: FilePath -> IO Counts14streamingBytestream fp = do15 src <- openFile fp ReadMode16 S.foldl' mappend mempty17 $ S.aheadly18 $ S.maxThreads numCapabilities19 $ S.mapM countBytes20 $ FH.toStreamArraysOf 1024000 src21 where22 countBytes =23 S.foldl' (\acc c -> acc <> countByte c) mempty24 . S.decodeChar825 . A.toStream2627{-# INLINE streamingBytestream #-}
注意:这里用的streamly版本7.10是直接从Github代码库中获得的,很可能它很快就会被发不到hackage上。这段代码还使用了几个内部模块,我希望看到,像这段代码中的用例能够证明,这些模块应该暴露出来。
1FH.toStreamArraysOf 1024000 src
这一段从文件描述符中读取字节块放到Byte数组的流中。使用Byte数组可以比使用Lazy ByteString等更快!每1MB文件内容我们会使用一个单独的数组,这一点你可以根据情况调整。
1S.mapM countBytes
这里使用mapM在数组上运行countBytes函数;countBytes本身会根据数组创建流,然后使用我们的幺半群字节计数器来运行流fold:
1countBytes =2 S.foldl' (\acc c -> acc <> countByte c) mempty3 . S.decodeChar84 . A.toStream
接下来,我们告诉streamly在数组上并行运行map,从而实现让每个线程处理一个1MB的文件块。这里将线程的数量限制在了核心数量。一旦读入所有数据,就可以立即进行处理,我们的统计代码没有任何阻塞的理由,所以增加更多的线程只会给调度器带来额外的负担而已。
1S.maxThreads numCapabilities
1S.aheadly
此时我们已经统计了1MB的输入块,但我们依然需要累加所有输入块。这一点可以在另一个流fold中通过mappend实现:
1S.foldl' mappend mempty
就这些!来看看效果吧!
转载地址:http://bgiii.baihongyu.com/