external-sort (empty) → 0.1

raw patch · 4 files changed

+202/−0 lines, 4 filesdep +EdisonAPIdep +EdisonCoredep +basesetup-changed

Dependencies added: EdisonAPI, EdisonCore, base, binary, bytestring

Files

• Setup.hs +2/−0
• demo.hs +17/−0
• external-sort.cabal +22/−0
• src/Algorithms/ExternalSort.lhs +161/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,17 @@+{-# LANGUAGE PatternSignatures #-}+import Algorithms.ExternalSort+import Data.List+-- fast ++-- this will take a while but should eventurally return the right answer+main  = do+  (res :: Int) <- return . last =<< externalSort bigList+  putStrLn . show $ res+++-- pure, in-memory prelude sort will crash your computer+mainBadIdea  = putStrLn . show $ last $ sort bigList+++bigList :: [Int]+bigList = reverse [1..10^8]

@@ -0,0 +1,22 @@+Name:                external-sort+Version:             0.1+Synopsis:            Sort large arrays on your hard drive. Kind of like the unix util sort.+Description:         Sort arrays too large to fit in ram, by using your hard drive.+Category:            Algorithms+License:             BSD3+Author:              Ben Midfield++Maintainer:          thomashartman1 at gmail dot com++Stability:           ExperimentalCategory:            Other+Build-type:          Simple+Cabal-version: >=1.2++Build-Depends:   base >= 3, EdisonCore, EdisonAPI, bytestring, binary++hs-source-dirs:      src+Exposed-modules:+                     Algorithms.ExternalSort++Extra-Source-Files:+                     demo.hs

@@ -0,0 +1,161 @@+> {-# LANGUAGE PatternSignatures #-}+ +hi folks --++a haskell newbie here, searching for comments and wisdom on my code.++i had a project to try to implement "external sort" in haskell as a+learning exercise.  (external sort is sorting a list that is too large+to fit in main memory, by sorting in chunks, spooling to disk, and+then merging.  more properly there probably should be multiple stages,+but for simplicity i'm doing a one-stage external sort.)++the trick is the number of files can quickly grow very large, so it is+best to use one large file and seek inside it around.  however as one+can imagine the order-of-IO-operations becomes a bit tricky, if you're+seeking file handles around underneath Data.ByteString.Lazy's nose.+but late this night after not thinking about it for a while i had a+brainstorm: rewrite hGetContents to keep the handle position in the+right place!  it's all about judicious use of unsafeInterleaveIO.....++it seems to be rather fast, strangely faster than the usual "sort" at+times.  it also seems to have nice memory characteristics, though not+perfect.  it's hard to test because the normal "sort" function takes+too much RAM on large lists, making my computer swap like mad.++i'd appreciate any testing, comments and suggestions from the haskell+gods out there.  my thanks to the Data.ByteString.Lazy, Data.Binary,+and Data.Edison people, who made this rather easy, once I grokked+unsafeInterleaveIO.++thanks and take care, B++> module Algorithms.ExternalSort where++Sort a list of Ords "offline."  We're doing this to be able to sort+things without taking up too much memory (for example sorting lists+too large to fit in RAM.)  Laziness is imperative, as is the+order-of-operations.++> import Control.Monad+> import Data.List+> import qualified Data.Binary as Bin+> import qualified Data.ByteString.Lazy as B+> import qualified Data.ByteString as P -- (hGetNonBlocking, null)+> -- import Data.ByteString.Base -- (LazyByteString(LPS))+> import Foreign.Storable (sizeOf)+> import System.IO (openFile, hClose, hSeek, hTell, hIsEOF, hWaitForInput,+>                   Handle, IOMode(ReadMode, WriteMode),+>                   SeekMode(AbsoluteSeek))+> import System.IO.Unsafe (unsafeInterleaveIO)+>+> import qualified Data.Edison.Seq.ListSeq as LS+> import qualified Data.Edison.Coll.SplayHeap as Splay++Conceptually, we sort a list in blocks, spool blocks to disk, then+merge back.  However for IO performance it is better to read off+chunks of elements off the sorted blocks from disk instead of+elements-at-a-time.++It would be better if these were in KBytes instead of # of elements.++> blocksize :: Int+> blocksize = 10000++Turn a list into a list of chunks.++> slice :: Int -> [a] -> [[a]]+> slice _ [] = []+> slice size l = (take size l) : (slice size $ drop size l)++Turn a list into a list of blocks, each of which is sorted.++> blockify :: (Ord a) => Int -> [a] -> [[a]]+> blockify bsize l = map sort $ slice bsize l++Serialize a block, returning the (absolute) position of the start.++> dumpBlock :: (Ord a, Bin.Binary a) => Handle -> [a] -> IO Integer+> dumpBlock h b = do+>   start <- hTell h+>   B.hPut h $ Bin.encode b+>   return start++The actual sorting function.  We blockify the list, turning it into a+list of sorted blocks, and spool to disk, keeping track of offsets.+We then read back the blocks (lazily!), and merge them.++> externalSort [] = do return []+> externalSort l = do+>   h <- openFile "ExternalSort.bin" WriteMode+>   idx <- mapM (\x -> dumpBlock h x) (blockify blocksize l)+>   hClose h+>   h <- openFile "ExternalSort.bin" ReadMode+>   blocks <- mapM (\x -> do {bs <- hGetContentsWithCursor h x;+>                             return $ Bin.decode bs}) idx+>   return (kMerge $ blocks)++Merging chunks.  K-way merge (and in fact external sort in general) is+detailed in Knuth, where he recommends tournament trees.  The easiest+thing is to probably use one of Okasaki's heaps.  I'll use splay+heaps, because I don't know any better.++It would be better if I changed Ord for blocks to only check the first+element.++> kMerge :: (Ord a) => [[a]] -> [a]+> kMerge [] = []+> kMerge l =+>     let h = Splay.fromSeq l in+>     kM (Splay.minElem h) (Splay.deleteMin h)+>     where+>     kM :: (Ord a) => [a] -> Splay.Heap [a] -> [a]+>     kM l h+>         | h == Splay.empty = l+>         | otherwise =+>             let next = Splay.minElem h+>                 (f, b) = span (\x -> x <= head next) l+>             in+>             f ++ (kM next (if null b then Splay.deleteMin h+>                            else (Splay.insert b $ Splay.deleteMin h)))+>+> kMergeSort :: (Ord a) => [a] -> [a]+> kMergeSort l = kMerge $ blockify blocksize l++This is a version of hGetContents which resets its handle position+between reads, so is safe to use with interleaved handle seeking.++> hGetContentsWithCursor :: Handle -> Integer -> IO B.ByteString+> hGetContentsWithCursor = hGetContentsWithCursorN defaultChunkSize+>+> hGetContentsWithCursorN :: Int -> Handle -> Integer -> IO B.ByteString+> hGetContentsWithCursorN k h start = (lazyRead start) >>= return . B.fromChunks+>   where+>     lazyRead start = unsafeInterleaveIO $ loop start+>+>     loop start = do+>         hSeek h AbsoluteSeek start+>         ps <- P.hGetNonBlocking h k+>         --TODO: I think this should distinguish EOF from no data available+>         -- the otherlying POSIX call makes this distincion, returning either+>         -- 0 or EAGAIN+>         if P.null ps+>           then do eof <- hIsEOF h+>                   if eof then return []+>                          else hWaitForInput h (-1)+>                            >> (loop start)+>            else do+>               pos <- hTell h+>               pss <- lazyRead pos+>               return (ps : pss)+>+> defaultChunkSize :: Int+> defaultChunkSize = 32 * k - overhead+>    where k = 1024+>          overhead = 2 * sizeOf (undefined :: Int)++> test = do+>  let bigList :: [Int]+>      bigList = [10^9]+>  (res :: Int) <- return . last =<< externalSort bigList+>  putStrLn . show $ res