Optymalizacja pamięci w Haskell, rurkach, attoparsec i kontenerach

Question

Próbuję dalej optymalizować mój parser i magazyn storage-attoparsec, ale mam problem z obniżeniem zużycia pamięci.

danego rachunku-parser.hs

{-# LANGUAGE RankNTypes #-} 
{-# LANGUAGE OverloadedStrings #-} 
{-# LANGUAGE NoImplicitPrelude #-} 

import Protolude hiding (for) 

import Data.Hashable 
import Data.IntMap.Strict (IntMap) 
import Data.Vector (Vector) 
import Pipes 
import Pipes.Parse 
import Pipes.Safe (MonadSafe, runSafeT) 
import qualified Data.Attoparsec.ByteString.Char8 as AB 
import qualified Data.IntMap.Strict as IM 
import qualified Data.Vector as Vector 
import qualified Pipes.Attoparsec as PA 
import qualified Pipes.ByteString as PB 
import qualified Pipes.Safe.Prelude as PSP 

-- accountid|account-name|contractid|code 

data AccountLine = AccountLine { 
    _accountId   :: !ByteString, 
    _accountName  :: !ByteString, 
    _accountContractId :: !ByteString, 
    _accountCode  :: !Word32 
    } deriving (Show) 

type MapCodetoAccountIdIdx = IntMap Int 

data Accounts = Accounts { 
    _accountIds :: !(Vector ByteString), 
    _cache  :: !(IntMap Int), 
    _accountCodes :: !MapCodetoAccountIdIdx 
    } deriving (Show) 


parseAccountLine :: AB.Parser AccountLine 
parseAccountLine = AccountLine <$> 
    getSubfield <* delim <*> 
    getSubfield <* delim <*> 
    getSubfield <* delim <*> 
    AB.decimal <* AB.endOfLine 
    where getSubfield = AB.takeTill (== '|') 
      delim = AB.char '|' 

-- 

aempty :: Accounts 
aempty = Accounts Vector.empty IM.empty IM.empty 

aappend :: Accounts -> AccountLine -> Accounts 
aappend (Accounts ids a2i cps) (AccountLine aid an cid cp) = 
    case IM.lookup (hash aid) a2i of 
     Nothing -> Accounts 
       (Vector.snoc ids (toS aid)) 
       (IM.insert (hash aid) (length ids) a2i) 
       (IM.insert (fromIntegral cp) (length ids) cps) 
     Just idx -> Accounts ids a2i (IM.insert (fromIntegral cp) idx cps) 

foldAccounts :: (Monad m) => Parser AccountLine m Accounts 
foldAccounts = foldAll aappend aempty identity 

readByteStringFile :: (MonadSafe m) => FilePath -> Producer' ByteString m() 
readByteStringFile file = PSP.withFile file ReadMode PB.fromHandle 

accountLines :: Text -> MonadSafe m => Producer AccountLine m (Either (PA.ParsingError, Producer ByteString m())()) 
accountLines filename = PA.parsed parseAccountLine (readByteStringFile (toS filename)) 


main :: IO() 
main = do 
    [filename] <- getArgs 
    x <- runSafeT $ runEffect $ Pipes.Parse.evalStateT foldAccounts (accountLines (toS filename)) 

    print $ sizes x 

sizes :: Accounts -> (Int, Int, Int) 
sizes (Accounts aid xxx acp) = (Vector.length aid, IM.size xxx, IM.size acp) 

skompilowany z GHC 8.0.2 (stack ghc -- -O2 -rtsopts -threaded -Wall account-parser.hs)

nie mogę uzyskać zużycie pamięci niżej. Muszę szybko wyszukiwać, dlatego IntMaps. Plik ma około 20 MB (i nie jest wydajny). Większość danych powinna być w stanie zmieścić się w 5 MB.

$ ./account-parser /tmp/accounts +RTS -s 
(5837,5837,373998) 
    1,631,040,680 bytes allocated in the heap 
    221,765,464 bytes copied during GC 
     41,709,048 bytes maximum residency (13 sample(s)) 
     2,512,560 bytes maximum slop 
       82 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  2754 colls,  0 par 0.105s 0.142s  0.0001s 0.0002s 
    Gen 1  13 colls,  0 par 0.066s 0.074s  0.0057s 0.0216s 

    TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) 

    SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) 

    INIT time 0.000s ( 0.001s elapsed) 
    MUT  time 0.324s ( 0.298s elapsed) 
    GC  time 0.171s ( 0.216s elapsed) 
    EXIT time 0.000s ( 0.005s elapsed) 
    Total time 0.495s ( 0.520s elapsed) 

    Alloc rate 5,026,660,297 bytes per MUT second 

    Productivity 65.5% of total user, 58.4% of total elapsed 

gc_alloc_block_sync: 0 
whitehole_spin: 0 
gen[0].sync: 0 
gen[1].sync: 0 

i profil:

Answer 1

Gdybym,

• usunąć pośredni zajrzeć do pamięci podręcznej
• użyć HashMap Text (Set Word32)
• Włącz w miejscu zagęszczania +RTS -c

Mogę uzyskać łączną pamięć do 34 MB, ale moje wyszukiwania teraz przechodzą do O (n). To jest prawdopodobnie najlepsze, co dostanę.

{-# LANGUAGE RankNTypes #-} 
{-# LANGUAGE OverloadedStrings #-} 
{-# LANGUAGE NoImplicitPrelude #-} 

import   Protolude hiding (for) 

import qualified Data.Attoparsec.ByteString.Char8 as AB 
import   Data.HashMap.Strict (HashMap) 
import qualified Data.HashMap.Strict as HashMap 
import   Data.Set (Set) 
import qualified Data.Set as Set 
import   Pipes 
import qualified Pipes.Attoparsec as PA 
import qualified Pipes.ByteString as PB 
import   Pipes.Parse 
import   Pipes.Safe (MonadSafe, runSafeT) 
import qualified Pipes.Safe.Prelude as PSP 

-- accountid|account-name|contractid|code 

data AccountLine = AccountLine { 
    _accountId   :: !ByteString, 
    _accountName  :: !ByteString, 
    _accountContractId :: !ByteString, 
    _accountCode  :: !Word32 
    } deriving (Show) 


newtype Accounts = Accounts (HashMap Text (Set Word32)) 
       deriving (Show) 

parseAccountLine :: AB.Parser AccountLine 
parseAccountLine = AccountLine <$> 
    getSubfield <* delim <*> 
    getSubfield <* delim <*> 
    getSubfield <* delim <*> 
    AB.decimal <* AB.endOfLine 
    where getSubfield = AB.takeTill (== '|') 
      delim = AB.char '|' 

-- 

aempty :: Accounts 
aempty = Accounts HashMap.empty 

aappend :: Accounts -> AccountLine -> Accounts 
aappend (Accounts cps) (AccountLine aid an cid cp) = 
    case HashMap.lookup (toS aid) cps of 
     Nothing -> Accounts (HashMap.insert (toS aid) (Set.singleton cp) cps) 
     Just value -> Accounts (HashMap.update (\codes -> Just (Set.insert cp value)) (toS aid) cps) 

foldAccounts :: (Monad m) => Parser AccountLine m Accounts 
foldAccounts = foldAll aappend aempty identity 

readByteStringFile :: (MonadSafe m) => FilePath -> Producer' ByteString m() 
readByteStringFile file = PSP.withFile file ReadMode PB.fromHandle 

accountLines :: Text -> MonadSafe m => Producer AccountLine m (Either (PA.ParsingError, Producer ByteString m())()) 
accountLines filename = PA.parsed parseAccountLine (readByteStringFile (toS filename)) 


main :: IO() 
main = do 
    [filename] <- getArgs 
    x <- runSafeT $ runEffect $ Pipes.Parse.evalStateT foldAccounts (accountLines (toS filename)) 

    print $ sizes x 

    -- print x 
    print $ lookupAccountFromCode x 254741 
    print $ lookupAccountFromCode x 196939 


sizes :: Accounts -> Int 
sizes (Accounts acp) = HashMap.size acp 

lookupAccountFromCode :: Accounts -> Word32 -> Maybe Text 
lookupAccountFromCode (Accounts accts) cp = do 
    let f a k v = bool a (Just k) (Set.member cp v) 
    HashMap.foldlWithKey' f Nothing accts 

i działa

$ ./account-parser /tmp/accounts +RTS -s -c 
5837 
Just "1-PCECJ5" 
Just "AANA-76KOUU" 
    1,652,177,904 bytes allocated in the heap 
     83,767,440 bytes copied during GC 
     17,563,800 bytes maximum residency (18 sample(s)) 
     751,144 bytes maximum slop 
       34 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  3083 colls,  0 par 0.058s 0.069s  0.0000s 0.0002s 
    Gen 1  18 colls,  0 par 0.115s 0.151s  0.0084s 0.0317s 

    TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) 

    SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) 

    INIT time 0.000s ( 0.002s elapsed) 
    MUT  time 0.263s ( 0.289s elapsed) 
    GC  time 0.173s ( 0.219s elapsed) 
    EXIT time 0.009s ( 0.008s elapsed) 
    Total time 0.445s ( 0.518s elapsed) 

    Alloc rate 6,286,682,587 bytes per MUT second 

    Productivity 61.0% of total user, 57.4% of total elapsed 

gc_alloc_block_sync: 0 
whitehole_spin: 0 
gen[0].sync: 0 
gen[1].sync: 0