home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / FastSort.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  1.5 KB  |  45 lines
  1. module FastSort where
  2. import Gofer
  3.  
  4. {- list sorting: see L.C.Paulson, ML for the working programmer, Cambidge, p100
  5. -- The list is split into ascending chunks which are then merged in pairs.
  6.  
  7. samsort l = sorting [] 0 l
  8.   where    sorting ls k []        = head(mergepairs ls 0)
  9.     sorting    ls k (x:xs)    = sorting (mergepairs (run:ls) kinc) kinc tl
  10.       where    (run, tl)    = nextrun [x] xs
  11.         kinc        = k+1
  12.     nextrun run []        = (reverse run, [])
  13.     nextrun    rs@(r:_) xl@(x:xs)
  14.         | x<r        = (reverse rs, xl)
  15.         | otherwise    = nextrun (x:rs) xs
  16.     mergepairs [l] _ = [l]
  17.     mergepairs lx@(l1:l2:ls) k
  18.         | k`mod`2 == 1    = lx
  19.         | otherwise    = mergepairs((merge l1 l2):ls) (k/2)
  20. -}
  21.  
  22. -- this mergesort uses a partioning mechanism like quicksort to build
  23. -- longer initial sequences. It also uses a non-counting mergePairs.
  24. -- Bob Buckley 30-MAR-93 (Bob.Buckley@levels.unisa.edu.au)
  25.  
  26. msort xs = mergePhase (runPhase xs)
  27.   where    mergePhase [x]        = x
  28.     mergePhase [x,y]    = merge x y    -- redundant case
  29.     mergePhase l        = mergePhase (mergePairs l)
  30.     mergePairs [x1,x2]    = [merge x1 x2]    -- redundant case
  31.     mergePairs (x1:x2:xs)    = merge x1 x2 : mergePairs xs
  32.     mergePairs l        = l        -- note: l=[] or l=[_]
  33.     runPhase []    = [[]]
  34.     runPhase (e:es) = takeAsc [e] es
  35.     takeAsc asc []    = [reverse asc]
  36.     takeAsc xs@(x:_) zs@(z:zr)
  37.         | x<=z        = takeAsc (z:xs) zr
  38.         | otherwise    = takeDec xs [z] zr
  39.     takeDec asc dec []    = [merge (reverse asc) dec]
  40.     takeDec xs@(x:_) ys@(y:_) zs@(z:zr)
  41.         | z<y        = takeDec xs (z:ys) zr
  42.         | x<=z        = takeDec (z:xs) ys zr
  43.         | otherwise    = merge (reverse xs) ys : runPhase zs
  44.  
  45.