{- |
Functions for 'StorableVector' that allow control of the size of individual chunks.

This is import for an application like the following:
You want to mix audio signals that are relatively shifted.
The structure of chunks of three streams may be illustrated as:

> [____] [____] [____] [____] ...
>   [____] [____] [____] [____] ...
>     [____] [____] [____] [____] ...

When we mix the streams (@zipWith3 (\x y z -> x+y+z)@)
with respect to the chunk structure of the first signal,
computing the first chunk requires full evaluation of all leading chunks of the stream.
However the last value of the third leading chunk
is much later in time than the last value of the first leading chunk.
We like to reduce these dependencies using a different chunk structure,
say

> [____] [____] [____] [____] ...
>   [__] [____] [____] [____] ...
>     [] [____] [____] [____] ...

-}
module Data.StorableVector.Lazy.Pattern (
   Vector,
   ChunkSize,
   chunkSize,
   defaultChunkSize,
   LazySize,

   empty,
   singleton,
   pack,
   unpack,
   packWith,
   unpackWith,
   unfoldrN,
   iterateN,
   cycle,
   replicate,
   null,
   length,
   cons,
   append,
   concat,
   map,
   reverse,
   foldl,
   foldl',
   any,
   all,
   maximum,
   minimum,
   viewL,
   viewR,
   switchL,
   switchR,
   scanl,
   mapAccumL,
   mapAccumR,
   crochetL,
   take,
   drop,
   splitAt,
   takeVectorPattern,
   splitAtVectorPattern,
   dropMarginRem,
   dropMargin,
   dropWhile,
   takeWhile,
   span,
   filter,
   zipWith,
   zipWith3,
   zipWith4,
   zipWithSize,
   zipWithSize3,
   zipWithSize4,
{-
   pad,
   cancelNullVector,
-}
   ) where

import Numeric.NonNegative.Class ((-|))
import qualified Numeric.NonNegative.Chunky as LS
import qualified Data.StorableVector.Lazy as LSV
import qualified Data.StorableVector as V

import Data.StorableVector.Lazy (Vector(SV), ChunkSize(ChunkSize))

import Data.StorableVector.Lazy (
   chunkSize, defaultChunkSize,
   empty, singleton, unpack, unpackWith, cycle,
   null, cons, append, concat, map, reverse,
   foldl, foldl', any, all, maximum, minimum,
   viewL, viewR, switchL, switchR,
   scanl, mapAccumL, mapAccumR, crochetL,
   dropMarginRem, dropMargin,
   dropWhile, takeWhile, span, filter, 
   zipWith, zipWith3, zipWith4, 
   )

import qualified Data.List as List

import qualified Data.List.HT as ListHT
import Data.Tuple.HT (mapPair, mapFst, forcePair, swap, )

import Control.Monad (liftM2, liftM3, liftM4, guard, )

import Foreign.Storable (Storable)

import Data.Maybe (Maybe(Just, Nothing))
import Data.Tuple (fst, snd, curry, uncurry)
import Prelude (Int, (.), ($), (<=), flip, return, fmap, not)


type LazySize = LS.T ChunkSize

-- * Introducing and eliminating 'Vector's

{-
Actually, this is lazy enough:

> LSV.unpack $ pack (LS.fromChunks [10,15]) (['a'..'y'] List.++ Prelude.undefined)
"abcdefghijklmnopqrstuvwxy"
-}
pack :: (Storable a) => LazySize -> [a] -> Vector a
pack :: forall a. Storable a => LazySize -> [a] -> Vector a
pack LazySize
size =
   forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size forall a. [a] -> Maybe (a, [a])
ListHT.viewL


{-# INLINE packWith #-}
packWith :: (Storable b) => LazySize -> (a -> b) -> [a] -> Vector b
packWith :: forall b a. Storable b => LazySize -> (a -> b) -> [a] -> Vector b
packWith LazySize
size a -> b
f =
   forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
ListHT.viewL)


{-
{-# INLINE unfoldrNAlt #-}
unfoldrNAlt :: (Storable b) =>
      LazySize
   -> (a -> Maybe (b,a))
   -> a
   -> (Vector b, Maybe a)
unfoldrNAlt (LS.Cons size) f x =
   let go sz y =
          case sz of
             [] -> ([], y)
             (ChunkSize s : ss) ->
                maybe
                   ([], Nothing)
                   ((\(c,a1) -> mapFst (c:) $ go ss a1) .
                    V.unfoldrN s (fmap (mapSnd f)))
                   (f y)
   in  mapFst SV $ go size (Just x)
-}

{-# INLINE unfoldrN #-}
unfoldrN :: (Storable b) =>
      LazySize
   -> (a -> Maybe (b,a))
   -> a
   -> (Vector b, Maybe a)
unfoldrN :: forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size a -> Maybe (b, a)
f =
   let go :: [ChunkSize] -> Maybe a -> ([Vector b], Maybe a)
go [ChunkSize]
sz Maybe a
y =
          forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
          case [ChunkSize]
sz of
             [] -> ([], Maybe a
y)
             (ChunkSize Int
s : [ChunkSize]
ss) ->
                let m :: Maybe (Vector b, Maybe a)
m =
                       do a
a0 <- Maybe a
y
                          let p :: (Vector b, Maybe a)
p = forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
V.unfoldrN Int
s a -> Maybe (b, a)
f a
a0
                          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall a. Vector a -> Bool
V.null (forall a b. (a, b) -> a
fst (Vector b, Maybe a)
p)))
                          forall (m :: * -> *) a. Monad m => a -> m a
return (Vector b, Maybe a)
p
                in  case Maybe (Vector b, Maybe a)
m of
                       Maybe (Vector b, Maybe a)
Nothing -> ([], forall a. Maybe a
Nothing)
                       Just (Vector b
c,Maybe a
a1) -> forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Vector b
cforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [ChunkSize] -> Maybe a -> ([Vector b], Maybe a)
go [ChunkSize]
ss Maybe a
a1
   in  forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall a. [Vector a] -> Vector a
SV forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChunkSize] -> Maybe a -> ([Vector b], Maybe a)
go (forall a. T a -> [a]
LS.toChunks LazySize
size) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just


{-# INLINE iterateN #-}
iterateN :: Storable a => LazySize -> (a -> a) -> a -> Vector a
iterateN :: forall a. Storable a => LazySize -> (a -> a) -> a -> Vector a
iterateN LazySize
size a -> a
f =
   forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size (\a
x -> forall a. a -> Maybe a
Just (a
x, a -> a
f a
x))

{-
Tries to be time and memory efficient
by reusing subvectors of a chunk
until a larger chunk is needed.
However, it can be a memory leak
if a huge chunk is followed by many little ones.
-}
replicate :: Storable a => LazySize -> a -> Vector a
replicate :: forall a. Storable a => LazySize -> a -> Vector a
replicate LazySize
size a
x =
   forall a. [Vector a] -> Vector a
SV forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
      (\Vector a
v (ChunkSize Int
m) ->
         if Int
m forall a. Ord a => a -> a -> Bool
<= forall a. Vector a -> Int
V.length Vector a
v
           then (Vector a
v, forall a. Storable a => Int -> Vector a -> Vector a
V.take Int
m Vector a
v)
           else let v1 :: Vector a
v1 = forall a. Storable a => Int -> a -> Vector a
V.replicate Int
m a
x
                in  (Vector a
v1,Vector a
v1))
      forall a. Storable a => Vector a
V.empty forall a b. (a -> b) -> a -> b
$
   forall a. T a -> [a]
LS.toChunks LazySize
size

{-
replicate :: Storable a => LazySize -> a -> Vector a
replicate size x =
   SV $ List.map (\(ChunkSize m) -> V.replicate m x) (LS.toChunks size)
-}


-- * Basic interface

length :: Vector a -> LazySize
length :: forall a. Vector a -> LazySize
length = forall a. C a => [a] -> T a
LS.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall a. Vector a -> ChunkSize
chunkLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
LSV.chunks

chunkLength :: V.Vector a -> ChunkSize
chunkLength :: forall a. Vector a -> ChunkSize
chunkLength = Int -> ChunkSize
ChunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Int
V.length

decrementLimit :: V.Vector a -> LazySize -> LazySize
decrementLimit :: forall a. Vector a -> LazySize -> LazySize
decrementLimit Vector a
x LazySize
y =
   LazySize
y forall a. C a => a -> a -> a
-| forall a. C a => a -> T a
LS.fromNumber (forall a. Vector a -> ChunkSize
chunkLength Vector a
x)

intFromChunkSize :: ChunkSize -> Int
intFromChunkSize :: ChunkSize -> Int
intFromChunkSize (ChunkSize Int
x) = Int
x

intFromLazySize :: LazySize -> Int
intFromLazySize :: LazySize -> Int
intFromLazySize =
   forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
List.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map ChunkSize -> Int
intFromChunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> [a]
LS.toChunks



-- * sub-vectors

{- |
Generates laziness breaks
wherever either the lazy length number or the vector has a chunk boundary.
-}
{-# INLINE take #-}
take :: (Storable a) => LazySize -> Vector a -> Vector a
take :: forall a. Storable a => LazySize -> Vector a -> Vector a
take LazySize
n = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Storable a =>
LazySize -> Vector a -> (Vector a, Vector a)
splitAt LazySize
n

{- |
Preserves the chunk pattern of the lazy vector.
-}
{-# INLINE takeVectorPattern #-}
takeVectorPattern :: (Storable a) => LazySize -> Vector a -> Vector a
takeVectorPattern :: forall a. Storable a => LazySize -> Vector a -> Vector a
takeVectorPattern LazySize
_ (SV []) = forall a. Storable a => Vector a
empty
takeVectorPattern LazySize
n (SV (Vector a
x:[Vector a]
xs)) =
   if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null (forall a. T a -> [a]
LS.toChunks LazySize
n)
     then forall a. Storable a => Vector a
empty
     else
       let remain :: LazySize
remain = forall a. Vector a -> LazySize -> LazySize
decrementLimit Vector a
x LazySize
n
       in  forall a. [Vector a] -> Vector a
SV forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$
           if forall a. C a => T a -> Bool
LS.isNull LazySize
remain
             then (forall a. Storable a => Int -> Vector a -> Vector a
V.take (LazySize -> Int
intFromLazySize LazySize
n) Vector a
x, [])
             else
               (Vector a
x, forall a. Vector a -> [Vector a]
LSV.chunks forall a b. (a -> b) -> a -> b
$ forall a. Storable a => LazySize -> Vector a -> Vector a
take LazySize
remain forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [Vector a] -> Vector a
LSV.fromChunks [Vector a]
xs)

{-# INLINE drop #-}
drop :: (Storable a) => LazySize -> Vector a -> Vector a
drop :: forall a. Storable a => LazySize -> Vector a -> Vector a
drop LazySize
size Vector a
xs =
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Storable a => Int -> Vector a -> Vector a
LSV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkSize -> Int
intFromChunkSize)) Vector a
xs (forall a. T a -> [a]
LS.toChunks LazySize
size)

{-# INLINE splitAt #-}
splitAt ::
   (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)
splitAt :: forall a.
Storable a =>
LazySize -> Vector a -> (Vector a, Vector a)
splitAt LazySize
size Vector a
xs =
   forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall a. Storable a => [Vector a] -> Vector a
LSV.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
      (\Vector a
xs0 ChunkSize
n ->
         forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
LSV.splitAt (ChunkSize -> Int
intFromChunkSize ChunkSize
n) Vector a
xs0)
      Vector a
xs (forall a. T a -> [a]
LS.toChunks LazySize
size)

{-# INLINE splitAtVectorPattern #-}
splitAtVectorPattern ::
   (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)
splitAtVectorPattern :: forall a.
Storable a =>
LazySize -> Vector a -> (Vector a, Vector a)
splitAtVectorPattern LazySize
n0 =
   forall a b. (a, b) -> (a, b)
forcePair forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null (forall a. T a -> [a]
LS.toChunks LazySize
n0)
     then (,) forall a. Storable a => Vector a
empty
     else
       let recourse :: LazySize -> [Vector a] -> ([Vector a], [Vector a])
recourse LazySize
n [Vector a]
xt =
              forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
              case [Vector a]
xt of
                 [] -> ([], [])
                 (Vector a
x:[Vector a]
xs) ->
                    let remain :: LazySize
remain = forall a. Vector a -> LazySize -> LazySize
decrementLimit Vector a
x LazySize
n
                    in  if forall a. C a => T a -> Bool
LS.isNull LazySize
remain
                          then forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((forall a. a -> [a] -> [a]
:[]), (forall a. a -> [a] -> [a]
:[Vector a]
xs)) forall a b. (a -> b) -> a -> b
$
                               forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
V.splitAt (LazySize -> Int
intFromLazySize LazySize
n) Vector a
x
                          else forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Vector a
xforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ LazySize -> [Vector a] -> ([Vector a], [Vector a])
recourse LazySize
remain [Vector a]
xs
       in  forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a. [Vector a] -> Vector a
SV, forall a. [Vector a] -> Vector a
SV) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}.
Storable a =>
LazySize -> [Vector a] -> ([Vector a], [Vector a])
recourse LazySize
n0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
LSV.chunks


{-# INLINE [0] zipWithSize #-}
zipWithSize :: (Storable a, Storable b, Storable c) =>
      LazySize
   -> (a -> b -> c)
   -> Vector a
   -> Vector b
   -> Vector c
zipWithSize :: forall a b c.
(Storable a, Storable b, Storable c) =>
LazySize -> (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWithSize LazySize
size a -> b -> c
f =
   forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size (\(Vector a
xt,Vector b
yt) ->
      forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
         (\(a
x,Vector a
xs) (b
y,Vector b
ys) -> (a -> b -> c
f a
x b
y, (Vector a
xs,Vector b
ys)))
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector a
xt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector b
yt)))

{-# INLINE zipWithSize3 #-}
zipWithSize3 ::
   (Storable a, Storable b, Storable c, Storable d) =>
   LazySize -> (a -> b -> c -> d) ->
   (Vector a -> Vector b -> Vector c -> Vector d)
zipWithSize3 :: forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
LazySize
-> (a -> b -> c -> d)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
zipWithSize3 LazySize
size a -> b -> c -> d
f Vector a
s0 Vector b
s1 Vector c
s2 =
   forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size (\(Vector a
xt,Vector b
yt,Vector c
zt) ->
      forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3
         (\(a
x,Vector a
xs) (b
y,Vector b
ys) (c
z,Vector c
zs) ->
             (a -> b -> c -> d
f a
x b
y c
z, (Vector a
xs,Vector b
ys,Vector c
zs)))
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector a
xt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector b
yt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector c
zt))
      (Vector a
s0,Vector b
s1,Vector c
s2)

{-# INLINE zipWithSize4 #-}
zipWithSize4 ::
   (Storable a, Storable b, Storable c, Storable d, Storable e) =>
   LazySize -> (a -> b -> c -> d -> e) ->
   (Vector a -> Vector b -> Vector c -> Vector d -> Vector e)
zipWithSize4 :: forall a b c d e.
(Storable a, Storable b, Storable c, Storable d, Storable e) =>
LazySize
-> (a -> b -> c -> d -> e)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
zipWithSize4 LazySize
size a -> b -> c -> d -> e
f Vector a
s0 Vector b
s1 Vector c
s2 Vector d
s3 =
   forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
unfoldrN LazySize
size (\(Vector a
xt,Vector b
yt,Vector c
zt,Vector d
wt) ->
      forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4
         (\(a
x,Vector a
xs) (b
y,Vector b
ys) (c
z,Vector c
zs) (d
w,Vector d
ws) ->
             (a -> b -> c -> d -> e
f a
x b
y c
z d
w, (Vector a
xs,Vector b
ys,Vector c
zs,Vector d
ws)))
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector a
xt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector b
yt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector c
zt)
         (forall a. Storable a => Vector a -> Maybe (a, Vector a)
viewL Vector d
wt))
      (Vector a
s0,Vector b
s1,Vector c
s2,Vector d
s3)

{-
{- |
Ensure a minimal length of the list by appending pad values.
-}
{-# ONLINE pad #-}
pad :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a
pad size y n0 =
   let recourse n xt =
          if n<=0
            then xt
            else
              case xt of
                 [] -> chunks $ replicate size n y
                 x:xs -> x : recourse (n - V.length x) xs
   in  SV . recourse n0 . chunks

padAlt :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a
padAlt size x n xs =
   append xs
      (let m = length xs
       in  if n>m
             then replicate size (n-m) x
             else empty)
-}