module Combinatorics.Battleship.Count.CountMap (
T,
KeyCount,
Path(Path),
readFile,
writeFile,
fromList,
fromListStorable,
fromListExternal,
writeSorted,
fromMap,
singleton,
size,
toAscList,
toMap,
mergeMany,
propMerge,
) where
import qualified Combinatorics.Battleship.Count.Frontier as Frontier
import qualified Combinatorics.Battleship.Count.Counter as Counter
import qualified Combinatorics.Battleship.Fleet as Fleet
import Combinatorics.Battleship.Count.Counter (add)
import Combinatorics.Battleship.Size (Nat, N10, )
import qualified System.IO.Temp as Temp
import System.Directory (removeFile, )
import System.FilePath ((</>), )
import qualified Data.StorableVector.Lazy.Pointer as SVP
import qualified Data.StorableVector.Lazy as SVL
import Data.Map (Map, )
import qualified Data.Map as Map
import qualified Control.Concurrent.PooledIO.Independent as Pool
import Control.DeepSeq (NFData, rnf, )
import Control.Monad (liftM2, zipWithM_, foldM, forM_, )
import Control.Applicative ((<$>), )
import Control.Functor.HT (void, )
import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.Match as Match
import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Data.Semigroup (Semigroup, (<>))
import Data.List.HT (sliceVertical, )
import Text.Printf (printf, )
import Data.Word (Word64, )
import Foreign.Storable
(Storable, sizeOf, alignment,
poke, peek, pokeByteOff, peekByteOff, )
import Prelude hiding (readFile, writeFile, )
type Count64 = Word64
type Count128 = Counter.Composed Word64 Word64
newtype T w a = Cons (SVL.Vector (Element w a))
deriving (T w a -> T w a -> Bool
(T w a -> T w a -> Bool) -> (T w a -> T w a -> Bool) -> Eq (T w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a. (Storable a, Eq a) => T w a -> T w a -> Bool
/= :: T w a -> T w a -> Bool
$c/= :: forall w a. (Storable a, Eq a) => T w a -> T w a -> Bool
== :: T w a -> T w a -> Bool
$c== :: forall w a. (Storable a, Eq a) => T w a -> T w a -> Bool
Eq)
instance (Nat w, Show a, Storable a) => Show (T w a) where
showsPrec :: Int -> T w a -> ShowS
showsPrec Int
prec (Cons Vector (Element w a)
x) =
Bool -> ShowS -> ShowS
showParen (Int
precInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"CountMap.fromAscList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Element w a] -> ShowS
forall a. Show a => a -> ShowS
shows (Vector (Element w a) -> [Element w a]
forall a. Storable a => Vector a -> [a]
SVL.unpack Vector (Element w a)
x)
instance (Storable a) => NFData (T w a) where
rnf :: T w a -> ()
rnf (Cons Vector (Element w a)
x) = Vector (Element w a) -> ()
forall a. NFData a => a -> ()
rnf Vector (Element w a)
x
data Element w a =
Element {
Element w a -> Key w
_elementKey :: Key w,
Element w a -> a
_elementCount :: a
} deriving (Element w a -> Element w a -> Bool
(Element w a -> Element w a -> Bool)
-> (Element w a -> Element w a -> Bool) -> Eq (Element w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a. Eq a => Element w a -> Element w a -> Bool
/= :: Element w a -> Element w a -> Bool
$c/= :: forall w a. Eq a => Element w a -> Element w a -> Bool
== :: Element w a -> Element w a -> Bool
$c== :: forall w a. Eq a => Element w a -> Element w a -> Bool
Eq, Int -> Element w a -> ShowS
[Element w a] -> ShowS
Element w a -> String
(Int -> Element w a -> ShowS)
-> (Element w a -> String)
-> ([Element w a] -> ShowS)
-> Show (Element w a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a. (Nat w, Show a) => Int -> Element w a -> ShowS
forall w a. (Nat w, Show a) => [Element w a] -> ShowS
forall w a. (Nat w, Show a) => Element w a -> String
showList :: [Element w a] -> ShowS
$cshowList :: forall w a. (Nat w, Show a) => [Element w a] -> ShowS
show :: Element w a -> String
$cshow :: forall w a. (Nat w, Show a) => Element w a -> String
showsPrec :: Int -> Element w a -> ShowS
$cshowsPrec :: forall w a. (Nat w, Show a) => Int -> Element w a -> ShowS
Show)
type Key w = (Frontier.T w, Fleet.T)
type KeyCount w a = (Key w, a)
instance (Storable a) => Storable (Element w a) where
sizeOf :: Element w a -> Int
sizeOf ~(Element ~(T w
front, T
fleet) a
cnt) =
T w -> Int
forall a. Storable a => a -> Int
sizeOf T w
front Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T -> Int
forall a. Storable a => a -> Int
sizeOf T
fleet Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Storable a => a -> Int
sizeOf a
cnt
alignment :: Element w a -> Int
alignment ~(Element ~(T w
front, T
fleet) a
cnt) =
T w -> Int
forall a. Storable a => a -> Int
alignment T w
front Int -> Int -> Int
forall a. Integral a => a -> a -> a
`lcm` T -> Int
forall a. Storable a => a -> Int
alignment T
fleet Int -> Int -> Int
forall a. Integral a => a -> a -> a
`lcm` a -> Int
forall a. Storable a => a -> Int
alignment a
cnt
poke :: Ptr (Element w a) -> Element w a -> IO ()
poke Ptr (Element w a)
ptr (Element (T w
front, T
fleet) a
cnt) = do
Ptr (Element w a) -> Int -> T w -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Element w a)
ptr Int
0 T w
front
Ptr (Element w a) -> Int -> T -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Element w a)
ptr (T w -> Int
forall a. Storable a => a -> Int
sizeOf T w
front) T
fleet
Ptr (Element w a) -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Element w a)
ptr (T w -> Int
forall a. Storable a => a -> Int
sizeOf T w
front Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T -> Int
forall a. Storable a => a -> Int
sizeOf T
fleet) a
cnt
peek :: Ptr (Element w a) -> IO (Element w a)
peek Ptr (Element w a)
ptr = do
T w
front <- Ptr (Element w a) -> Int -> IO (T w)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Element w a)
ptr Int
0
T
fleet <- Ptr (Element w a) -> Int -> IO T
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Element w a)
ptr (T w -> Int
forall a. Storable a => a -> Int
sizeOf T w
front)
a
cnt <- Ptr (Element w a) -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Element w a)
ptr (T w -> Int
forall a. Storable a => a -> Int
sizeOf T w
front Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T -> Int
forall a. Storable a => a -> Int
sizeOf T
fleet)
Element w a -> IO (Element w a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((T w, T) -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element (T w
front, T
fleet) a
cnt)
defaultChunkSize :: SVL.ChunkSize
defaultChunkSize :: ChunkSize
defaultChunkSize = Int -> ChunkSize
SVL.chunkSize Int
512
fromAscList :: (Storable a) => [KeyCount w a] -> T w a
fromAscList :: [KeyCount w a] -> T w a
fromAscList =
Vector (Element w a) -> T w a
forall w a. Vector (Element w a) -> T w a
Cons (Vector (Element w a) -> T w a)
-> ([KeyCount w a] -> Vector (Element w a))
-> [KeyCount w a]
-> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkSize -> [Element w a] -> Vector (Element w a)
forall a. Storable a => ChunkSize -> [a] -> Vector a
SVL.pack ChunkSize
defaultChunkSize ([Element w a] -> Vector (Element w a))
-> ([KeyCount w a] -> [Element w a])
-> [KeyCount w a]
-> Vector (Element w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyCount w a -> Element w a) -> [KeyCount w a] -> [Element w a]
forall a b. (a -> b) -> [a] -> [b]
map ((Key w -> a -> Element w a) -> KeyCount w a -> Element w a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key w -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element)
fromMap :: (Storable a) => Map (Key w) a -> T w a
fromMap :: Map (Key w) a -> T w a
fromMap = [KeyCount w a] -> T w a
forall a w. Storable a => [KeyCount w a] -> T w a
fromAscList ([KeyCount w a] -> T w a)
-> (Map (Key w) a -> [KeyCount w a]) -> Map (Key w) a -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Key w) a -> [KeyCount w a]
forall k a. Map k a -> [(k, a)]
Map.toAscList
fromList :: (Counter.C a, Storable a) => [KeyCount w a] -> T w a
fromList :: [KeyCount w a] -> T w a
fromList = Map (Key w) a -> T w a
forall a w. Storable a => Map (Key w) a -> T w a
fromMap (Map (Key w) a -> T w a)
-> ([KeyCount w a] -> Map (Key w) a) -> [KeyCount w a] -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [KeyCount w a] -> Map (Key w) a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith a -> a -> a
forall a. C a => a -> a -> a
add
fromListStorable :: (Counter.C a, Storable a) => [KeyCount w a] -> T w a
fromListStorable :: [KeyCount w a] -> T w a
fromListStorable = [T w a] -> T w a
forall a. Monoid a => [a] -> a
mconcat ([T w a] -> T w a)
-> ([KeyCount w a] -> [T w a]) -> [KeyCount w a] -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyCount w a -> T w a) -> [KeyCount w a] -> [T w a]
forall a b. (a -> b) -> [a] -> [b]
map ((Key w -> a -> T w a) -> KeyCount w a -> T w a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key w -> a -> T w a
forall a w. Storable a => Key w -> a -> T w a
singleton)
toAscList :: (Storable a) => T w a -> [KeyCount w a]
toAscList :: T w a -> [KeyCount w a]
toAscList (Cons Vector (Element w a)
m) = (Element w a -> KeyCount w a) -> [Element w a] -> [KeyCount w a]
forall a b. (a -> b) -> [a] -> [b]
map Element w a -> KeyCount w a
forall w a. Element w a -> KeyCount w a
pairFromElement ([Element w a] -> [KeyCount w a])
-> [Element w a] -> [KeyCount w a]
forall a b. (a -> b) -> a -> b
$ Vector (Element w a) -> [Element w a]
forall a. Storable a => Vector a -> [a]
SVL.unpack Vector (Element w a)
m
toMap :: (Storable a) => T w a -> Map (Key w) a
toMap :: T w a -> Map (Key w) a
toMap = [(Key w, a)] -> Map (Key w) a
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(Key w, a)] -> Map (Key w) a)
-> (T w a -> [(Key w, a)]) -> T w a -> Map (Key w) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T w a -> [(Key w, a)]
forall a w. Storable a => T w a -> [KeyCount w a]
toAscList
singleton :: (Storable a) => Key w -> a -> T w a
singleton :: Key w -> a -> T w a
singleton Key w
key a
cnt = Vector (Element w a) -> T w a
forall w a. Vector (Element w a) -> T w a
Cons (Vector (Element w a) -> T w a) -> Vector (Element w a) -> T w a
forall a b. (a -> b) -> a -> b
$ Element w a -> Vector (Element w a)
forall a. Storable a => a -> Vector a
SVL.singleton (Element w a -> Vector (Element w a))
-> Element w a -> Vector (Element w a)
forall a b. (a -> b) -> a -> b
$ Key w -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element Key w
key a
cnt
pairFromElement :: Element w a -> KeyCount w a
pairFromElement :: Element w a -> KeyCount w a
pairFromElement (Element Key w
key a
cnt) = (Key w
key, a
cnt)
size :: T w a -> Int
size :: T w a -> Int
size (Cons Vector (Element w a)
x) = Vector (Element w a) -> Int
forall a. Vector a -> Int
SVL.length Vector (Element w a)
x
newtype Path w a = Path {Path w a -> String
getPath :: FilePath}
writeFile :: (Storable a) => Path w a -> T w a -> IO ()
writeFile :: Path w a -> T w a -> IO ()
writeFile (Path String
path) (Cons Vector (Element w a)
xs) = String -> Vector (Element w a) -> IO ()
forall a. Storable a => String -> Vector a -> IO ()
SVL.writeFile String
path Vector (Element w a)
xs
readFile :: (Storable a) => Path w a -> IO (T w a)
readFile :: Path w a -> IO (T w a)
readFile (Path String
path) =
Vector (Element w a) -> T w a
forall w a. Vector (Element w a) -> T w a
Cons (Vector (Element w a) -> T w a)
-> ((IOError, Vector (Element w a)) -> Vector (Element w a))
-> (IOError, Vector (Element w a))
-> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError, Vector (Element w a)) -> Vector (Element w a)
forall a b. (a, b) -> b
snd ((IOError, Vector (Element w a)) -> T w a)
-> IO (IOError, Vector (Element w a)) -> IO (T w a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChunkSize -> String -> IO (IOError, Vector (Element w a))
forall a.
Storable a =>
ChunkSize -> String -> IO (IOError, Vector a)
SVL.readFileAsync ChunkSize
defaultChunkSize String
path
formatPath :: FilePath -> Int -> Path w a
formatPath :: String -> Int -> Path w a
formatPath String
dir = String -> Path w a
forall w a. String -> Path w a
Path (String -> Path w a) -> (Int -> String) -> Int -> Path w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
dir String -> ShowS
</>) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"extsort%04d"
mergeFiles ::
(Counter.C a, Storable a) => Path w a -> Path w a -> Path w a -> IO ()
mergeFiles :: Path w a -> Path w a -> Path w a -> IO ()
mergeFiles Path w a
input0 Path w a
input1 Path w a
output = do
Path w a -> T w a -> IO ()
forall a w. Storable a => Path w a -> T w a -> IO ()
writeFile Path w a
output (T w a -> IO ()) -> IO (T w a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (T w a -> T w a -> T w a) -> IO (T w a) -> IO (T w a) -> IO (T w a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 T w a -> T w a -> T w a
forall a w. (C a, Storable a) => T w a -> T w a -> T w a
merge (Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
readFile Path w a
input0) (Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
readFile Path w a
input1)
String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path w a -> String
forall w a. Path w a -> String
getPath Path w a
input0
String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path w a -> String
forall w a. Path w a -> String
getPath Path w a
input1
sequenceLast :: (Monad m) => a -> [m a] -> m a
sequenceLast :: a -> [m a] -> m a
sequenceLast a
deflt = (a -> m a -> m a) -> a -> [m a] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\a
_ m a
act -> m a
act) a
deflt
fromListExternal ::
(Counter.C a, Storable a) => Int -> [KeyCount w a] -> IO (T w a)
fromListExternal :: Int -> [KeyCount w a] -> IO (T w a)
fromListExternal Int
bucketSize [KeyCount w a]
xs = do
let dir :: String
dir = String
"/tmp"
Int
lastN <-
Int -> [IO Int] -> IO Int
forall (m :: * -> *) a. Monad m => a -> [m a] -> m a
sequenceLast (-Int
1) ([IO Int] -> IO Int) -> [IO Int] -> IO Int
forall a b. (a -> b) -> a -> b
$
(Int -> T w a -> IO Int) -> [Int] -> [T w a] -> [IO Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\Int
n T w a
bucket -> Path w a -> T w a -> IO ()
forall a w. Storable a => Path w a -> T w a -> IO ()
writeFile (String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir Int
n) T w a
bucket IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n)
[Int
0 ..] ([T w a] -> [IO Int]) -> [T w a] -> [IO Int]
forall a b. (a -> b) -> a -> b
$
([KeyCount w a] -> T w a) -> [[KeyCount w a]] -> [T w a]
forall a b. (a -> b) -> [a] -> [b]
map [KeyCount w a] -> T w a
forall a w. (C a, Storable a) => [KeyCount w a] -> T w a
fromList ([[KeyCount w a]] -> [T w a]) -> [[KeyCount w a]] -> [T w a]
forall a b. (a -> b) -> a -> b
$
Int -> [KeyCount w a] -> [[KeyCount w a]]
forall a. Int -> [a] -> [[a]]
sliceVertical Int
bucketSize [KeyCount w a]
xs
case String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lastN) of
Path w a
finalPath -> do
[(Int, Int)] -> ((Int, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [(Int, Int)] -> [(Int, Int)]
forall a. Int -> [a] -> [a]
take Int
lastN ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0) [Int
lastNInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 ..]) (((Int, Int) -> IO ()) -> IO ()) -> ((Int, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\(Int
srcN, Int
dstN) ->
Path w a -> Path w a -> Path w a -> IO ()
forall a w.
(C a, Storable a) =>
Path w a -> Path w a -> Path w a -> IO ()
mergeFiles
(String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir Int
srcN)
(String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir (Int
srcNInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
(String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir Int
dstN Path w a -> Path w a -> Path w a
forall a. a -> a -> a
`asTypeOf` Path w a
finalPath)
Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
readFile Path w a
finalPath
pairs :: [a] -> [(a,a)]
pairs :: [a] -> [(a, a)]
pairs (a
x0:a
x1:[a]
xs) = (a
x0,a
x1) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
pairs [a]
xs
pairs (a
_:[a]
_) = []
pairs [] = String -> [(a, a)]
forall a. HasCallStack => String -> a
error String
"pairs: even number of elements"
writeSorted ::
(Counter.C a, Storable a) => Path w a -> [[KeyCount w a]] -> IO ()
writeSorted :: Path w a -> [[KeyCount w a]] -> IO ()
writeSorted Path w a
dst [[KeyCount w a]]
xs =
String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
Temp.withSystemTempDirectory String
"battleship" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
let chunks :: [T w a]
chunks = ([KeyCount w a] -> T w a) -> [[KeyCount w a]] -> [T w a]
forall a b. (a -> b) -> [a] -> [b]
map [KeyCount w a] -> T w a
forall a w. (C a, Storable a) => [KeyCount w a] -> T w a
fromList [[KeyCount w a]]
xs
let unary :: [()]
unary = [T w a] -> [()]
forall (f :: * -> *) a. Functor f => f a -> f ()
void [T w a]
chunks
let paths :: [Path w a]
paths =
(() -> Int -> Path w a) -> [()] -> [Int] -> [Path w a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\() -> String -> Int -> Path w a
forall w a. String -> Int -> Path w a
formatPath String
dir) ([()] -> [()]
forall a. [a] -> [a]
init ([()] -> [()]) -> [()] -> [()]
forall a b. (a -> b) -> a -> b
$ [()] -> [()]
forall a. [a] -> [a]
init ([()] -> [()]) -> [()] -> [()]
forall a b. (a -> b) -> a -> b
$ [()]
unary [()] -> [()] -> [()]
forall a. [a] -> [a] -> [a]
++ [()]
unary) [Int
0..]
[Path w a] -> [Path w a] -> [Path w a]
forall a. [a] -> [a] -> [a]
++
[Path w a
dst]
[IO ()] -> IO ()
Pool.run ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Path w a -> T w a -> IO ()) -> [Path w a] -> [T w a] -> [IO ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Path w a -> T w a -> IO ()
forall a w. Storable a => Path w a -> T w a -> IO ()
writeFile [Path w a]
paths [T w a]
chunks
((Path w a, Path w a) -> Path w a -> IO ())
-> [(Path w a, Path w a)] -> [Path w a] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ((Path w a -> Path w a -> Path w a -> IO ())
-> (Path w a, Path w a) -> Path w a -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Path w a -> Path w a -> Path w a -> IO ()
forall a w.
(C a, Storable a) =>
Path w a -> Path w a -> Path w a -> IO ()
mergeFiles) ([Path w a] -> [(Path w a, Path w a)]
forall a. [a] -> [(a, a)]
pairs [Path w a]
paths) ([()] -> [Path w a] -> [Path w a]
forall b a. [b] -> [a] -> [a]
Match.drop [()]
unary [Path w a]
paths)
empty :: (Storable a) => T w a
empty :: T w a
empty = Vector (Element w a) -> T w a
forall w a. Vector (Element w a) -> T w a
Cons Vector (Element w a)
forall a. Storable a => Vector a
SVL.empty
merge :: (Counter.C a, Storable a) => T w a -> T w a -> T w a
merge :: T w a -> T w a -> T w a
merge (Cons Vector (Element w a)
xs0) (Cons Vector (Element w a)
ys0) =
Vector (Element w a) -> T w a
forall w a. Vector (Element w a) -> T w a
Cons (Vector (Element w a) -> T w a) -> Vector (Element w a) -> T w a
forall a b. (a -> b) -> a -> b
$
ChunkSize
-> ((Pointer (Element w a), Pointer (Element w a))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a))))
-> (Pointer (Element w a), Pointer (Element w a))
-> Vector (Element w a)
forall b a.
Storable b =>
ChunkSize -> (a -> Maybe (b, a)) -> a -> Vector b
SVL.unfoldr ChunkSize
defaultChunkSize
(\(Pointer (Element w a)
xt,Pointer (Element w a)
yt) ->
case (Pointer (Element w a) -> Maybe (Element w a, Pointer (Element w a))
forall a. Storable a => Pointer a -> Maybe (a, Pointer a)
SVP.viewL Pointer (Element w a)
xt, Pointer (Element w a) -> Maybe (Element w a, Pointer (Element w a))
forall a. Storable a => Pointer a -> Maybe (a, Pointer a)
SVP.viewL Pointer (Element w a)
yt) of
(Maybe (Element w a, Pointer (Element w a))
Nothing, Maybe (Element w a, Pointer (Element w a))
Nothing) -> Maybe (Element w a, (Pointer (Element w a), Pointer (Element w a)))
forall a. Maybe a
Nothing
(Just (Element w a
x,Pointer (Element w a)
xs), Maybe (Element w a, Pointer (Element w a))
Nothing) -> (Element w a, (Pointer (Element w a), Pointer (Element w a)))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a)))
forall a. a -> Maybe a
Just (Element w a
x, (Pointer (Element w a)
xs,Pointer (Element w a)
yt))
(Maybe (Element w a, Pointer (Element w a))
Nothing, Just (Element w a
y,Pointer (Element w a)
ys)) -> (Element w a, (Pointer (Element w a), Pointer (Element w a)))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a)))
forall a. a -> Maybe a
Just (Element w a
y, (Pointer (Element w a)
xt,Pointer (Element w a)
ys))
(Just (Element Key w
xkey a
xcnt, Pointer (Element w a)
xs),
Just (Element Key w
ykey a
ycnt, Pointer (Element w a)
ys)) -> (Element w a, (Pointer (Element w a), Pointer (Element w a)))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a)))
forall a. a -> Maybe a
Just ((Element w a, (Pointer (Element w a), Pointer (Element w a)))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a))))
-> (Element w a, (Pointer (Element w a), Pointer (Element w a)))
-> Maybe
(Element w a, (Pointer (Element w a), Pointer (Element w a)))
forall a b. (a -> b) -> a -> b
$
case Key w -> Key w -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key w
xkey Key w
ykey of
Ordering
EQ -> (Key w -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element Key w
xkey (a -> a -> a
forall a. C a => a -> a -> a
add a
xcnt a
ycnt), (Pointer (Element w a)
xs,Pointer (Element w a)
ys))
Ordering
LT -> (Key w -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element Key w
xkey a
xcnt, (Pointer (Element w a)
xs,Pointer (Element w a)
yt))
Ordering
GT -> (Key w -> a -> Element w a
forall w a. Key w -> a -> Element w a
Element Key w
ykey a
ycnt, (Pointer (Element w a)
xt,Pointer (Element w a)
ys)))
(Vector (Element w a) -> Pointer (Element w a)
forall a. Storable a => Vector a -> Pointer a
SVP.cons Vector (Element w a)
xs0, Vector (Element w a) -> Pointer (Element w a)
forall a. Storable a => Vector a -> Pointer a
SVP.cons Vector (Element w a)
ys0)
propMerge :: [KeyCount N10 Count64] -> [KeyCount N10 Count64] -> Bool
propMerge :: [KeyCount N10 Count64] -> [KeyCount N10 Count64] -> Bool
propMerge [KeyCount N10 Count64]
xs [KeyCount N10 Count64]
ys =
let xm :: Map (Key N10) Count64
xm = (Count64 -> Count64 -> Count64)
-> [KeyCount N10 Count64] -> Map (Key N10) Count64
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Count64 -> Count64 -> Count64
forall a. C a => a -> a -> a
add [KeyCount N10 Count64]
xs
ym :: Map (Key N10) Count64
ym = (Count64 -> Count64 -> Count64)
-> [KeyCount N10 Count64] -> Map (Key N10) Count64
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Count64 -> Count64 -> Count64
forall a. C a => a -> a -> a
add [KeyCount N10 Count64]
ys
in T N10 Count64 -> T N10 Count64 -> T N10 Count64
forall a w. (C a, Storable a) => T w a -> T w a -> T w a
merge (Map (Key N10) Count64 -> T N10 Count64
forall a w. Storable a => Map (Key w) a -> T w a
fromMap Map (Key N10) Count64
xm) (Map (Key N10) Count64 -> T N10 Count64
forall a w. Storable a => Map (Key w) a -> T w a
fromMap Map (Key N10) Count64
ym)
T N10 Count64 -> T N10 Count64 -> Bool
forall a. Eq a => a -> a -> Bool
==
Map (Key N10) Count64 -> T N10 Count64
forall a w. Storable a => Map (Key w) a -> T w a
fromMap ((Count64 -> Count64 -> Count64)
-> Map (Key N10) Count64
-> Map (Key N10) Count64
-> Map (Key N10) Count64
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Count64 -> Count64 -> Count64
forall a. C a => a -> a -> a
add Map (Key N10) Count64
xm Map (Key N10) Count64
ym)
{-# SPECIALISE mergeMany :: [T w Count64] -> T w Count64 #-}
{-# SPECIALISE mergeMany :: [T w Count128] -> T w Count128 #-}
{-# INLINEABLE mergeMany #-}
mergeMany :: (Counter.C a, Storable a) => [T w a] -> T w a
mergeMany :: [T w a] -> T w a
mergeMany = T w a -> (T [] (T w a) -> T w a) -> Maybe (T [] (T w a)) -> T w a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T w a
forall a w. Storable a => T w a
empty ((T w a -> T w a -> T w a) -> T [] (T w a) -> T w a
forall a. (a -> a -> a) -> T [] a -> a
NonEmpty.foldBalanced T w a -> T w a -> T w a
forall a w. (C a, Storable a) => T w a -> T w a -> T w a
merge) (Maybe (T [] (T w a)) -> T w a)
-> ([T w a] -> Maybe (T [] (T w a))) -> [T w a] -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T w a] -> Maybe (T [] (T w a))
forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a)
NonEmpty.fetch
instance (Counter.C a, Storable a) => Semigroup (T w a) where
<> :: T w a -> T w a -> T w a
(<>) = T w a -> T w a -> T w a
forall a w. (C a, Storable a) => T w a -> T w a -> T w a
merge
instance (Counter.C a, Storable a) => Monoid (T w a) where
mempty :: T w a
mempty = T w a
forall a w. Storable a => T w a
empty
mappend :: T w a -> T w a -> T w a
mappend = T w a -> T w a -> T w a
forall a w. (C a, Storable a) => T w a -> T w a -> T w a
merge
mconcat :: [T w a] -> T w a
mconcat = [T w a] -> T w a
forall a w. (C a, Storable a) => [T w a] -> T w a
mergeMany