-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Generic functions over vectors of 'Sample's.

    The samples should be sorted, though this is currently not enforced by
    the constructors.  TODO fix that

    By default, this defines a piecewise-constant function, where each sample
    maintains its value until the next one.  However, samples can have
    coincident Xs, and this is used for a linear segment based implementation
    built on top of this.
-}
module Util.TimeVector (
    module Util.TimeVector
    , module Util.TimeVectorStorable
    , module Data.Vector.Generic
) where
import Prelude hiding (head, last, take)
import qualified Control.Monad.State.Strict as State
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as V
import Data.Vector.Generic
       (all, drop, foldl', length, null, take, toList, unsafeIndex)
import qualified Data.Vector.Storable as Storable

import qualified Foreign

import qualified Util.CallStack as CallStack
import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq
import Util.TimeVectorStorable (X, Sample(..))

import qualified Perform.RealTime as RealTime

import Global


x_to_double :: X -> Double
x_to_double :: X -> UnboxedY
x_to_double = X -> UnboxedY
RealTime.to_seconds

double_to_x :: Double -> X
double_to_x :: UnboxedY -> X
double_to_x = UnboxedY -> X
RealTime.seconds

type Boxed y = Vector.Vector (Sample y)

-- * unboxed

-- A number of functions in here are SPECIALIZEd on Unboxed.  This improves
-- performance significantly since the functions are heavily used and the
-- specialization likely enables some unboxing in inner loops.

-- There's no monoid instance for Boxed or Unboxed, and I leave it that way.
-- Implementations should implement their own Monoid with their own rules,
-- perhaps using 'merge_left', which is for piecewise-constant signals.

type Unboxed = Storable.Vector (Sample UnboxedY)
type UnboxedY = Double

to_foreign_ptr :: Storable.Storable a =>
    Storable.Vector a -> (Foreign.ForeignPtr a, Int)
to_foreign_ptr :: forall a. Storable a => Vector a -> (ForeignPtr a, Int)
to_foreign_ptr = Vector a -> (ForeignPtr a, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Int)
Storable.unsafeToForeignPtr0

with_ptr :: Storable.Storable a =>
    Storable.Vector a -> (Foreign.Ptr a -> Int -> IO b) -> IO b
with_ptr :: forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
with_ptr Vector a
v Ptr a -> Int -> IO b
action = Vector a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
Storable.unsafeWith Vector a
v ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> Int -> IO b
action Ptr a
ptr (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length Vector a
v)

-- * implementation

index :: V.Vector v a => v a -> Int -> a
index :: forall (v :: * -> *) a. Vector v a => v a -> Int -> a
index = v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
(V.!)

head, last :: V.Vector v a => v a -> Maybe a
head :: forall (v :: * -> *) a. Vector v a => v a -> Maybe a
head v a
v
    | v a -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v a
v = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v a
v Int
0
last :: forall (v :: * -> *) a. Vector v a => v a -> Maybe a
last v a
v
    | v a -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v a
v = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ v a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
V.last v a
v

uncons :: V.Vector v a => v a -> Maybe (a, v a)
uncons :: forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
uncons v a
v
    | v a -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v a
v = Maybe (a, v a)
forall a. Maybe a
Nothing
    | Bool
otherwise = (a, v a) -> Maybe (a, v a)
forall a. a -> Maybe a
Just (v a -> a
forall (v :: * -> *) a. Vector v a => v a -> a
V.unsafeHead v a
v, v a -> v a
forall (v :: * -> *) a. Vector v a => v a -> v a
V.unsafeTail v a
v)

-- ** TimeVector specific

-- | Construct a TimeVector from a list.
{-# SPECIALIZE from_pairs :: [(X, UnboxedY)] -> Unboxed #-}
{-# INLINEABLE from_pairs #-}
from_pairs :: V.Vector v (Sample y) => [(X, y)] -> v (Sample y)
from_pairs :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[(X, y)] -> v (Sample y)
from_pairs = [Sample y] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList ([Sample y] -> v (Sample y))
-> ([(X, y)] -> [Sample y]) -> [(X, y)] -> v (Sample y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X, y) -> Sample y) -> [(X, y)] -> [Sample y]
forall a b. (a -> b) -> [a] -> [b]
map ((X -> y -> Sample y) -> (X, y) -> Sample y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry X -> y -> Sample y
forall y. X -> y -> Sample y
Sample)

to_pairs :: V.Vector v (Sample y) => v (Sample y) -> [(X, y)]
to_pairs :: forall (v :: * -> *) y.
Vector v (Sample y) =>
v (Sample y) -> [(X, y)]
to_pairs = (Sample y -> (X, y)) -> [Sample y] -> [(X, y)]
forall a b. (a -> b) -> [a] -> [b]
map Sample y -> (X, y)
forall y. Sample y -> (X, y)
to_pair ([Sample y] -> [(X, y)])
-> (v (Sample y) -> [Sample y]) -> v (Sample y) -> [(X, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList

-- | Set the signal value, with a discontinuity.  See
-- NOTE [signal-discontinuity].
set :: V.Vector v (Sample y) => Maybe y -> X -> y -> v (Sample y)
set :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe y -> X -> y -> v (Sample y)
set Maybe y
prev_y X
x y
y = [(X, y)] -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
[(X, y)] -> v (Sample y)
from_pairs ([(X, y)] -> v (Sample y)) -> [(X, y)] -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ ([(X, y)] -> [(X, y)])
-> (y -> [(X, y)] -> [(X, y)]) -> Maybe y -> [(X, y)] -> [(X, y)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(X, y)] -> [(X, y)]
forall a. a -> a
id ((:) ((X, y) -> [(X, y)] -> [(X, y)])
-> (y -> (X, y)) -> y -> [(X, y)] -> [(X, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X
x,)) Maybe y
prev_y [(X
x, y
y)]

{-# SPECIALIZE constant :: UnboxedY -> Unboxed #-}
{-# INLINEABLE constant #-}
constant :: V.Vector v (Sample y) => y -> v (Sample y)
constant :: forall (v :: * -> *) y. Vector v (Sample y) => y -> v (Sample y)
constant y
y = Sample y -> v (Sample y)
forall (v :: * -> *) a. Vector v a => a -> v a
V.singleton (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample (-X
RealTime.larger) y
y)

constant_val :: Unboxed -> Maybe UnboxedY
constant_val :: Unboxed -> Maybe UnboxedY
constant_val Unboxed
vec = case Unboxed -> Maybe (Sample UnboxedY, Unboxed)
forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
uncons Unboxed
vec of
    Maybe (Sample UnboxedY, Unboxed)
Nothing -> UnboxedY -> Maybe UnboxedY
forall a. a -> Maybe a
Just UnboxedY
0
    Just (Sample X
x0 UnboxedY
y0, Unboxed
rest)
        -- I compare multiple samples because a track might have redundant
        -- values, but I still want to detect if it's constant.
        | X
x0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= -X
RealTime.large Bool -> Bool -> Bool
&& (Sample UnboxedY -> Bool) -> Unboxed -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((UnboxedY -> UnboxedY -> Bool
forall a. Eq a => a -> a -> Bool
==UnboxedY
y0) (UnboxedY -> Bool)
-> (Sample UnboxedY -> UnboxedY) -> Sample UnboxedY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample UnboxedY -> UnboxedY
forall y. Sample y -> y
sy) Unboxed
rest -> UnboxedY -> Maybe UnboxedY
forall a. a -> Maybe a
Just UnboxedY
y0
        | (Sample UnboxedY -> Bool) -> Unboxed -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((UnboxedY -> UnboxedY -> Bool
forall a. Eq a => a -> a -> Bool
==UnboxedY
0) (UnboxedY -> Bool)
-> (Sample UnboxedY -> UnboxedY) -> Sample UnboxedY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample UnboxedY -> UnboxedY
forall y. Sample y -> y
sy) Unboxed
vec -> UnboxedY -> Maybe UnboxedY
forall a. a -> Maybe a
Just UnboxedY
0
        | Bool
otherwise -> Maybe UnboxedY
forall a. Maybe a
Nothing

to_pair :: Sample y -> (X, y)
to_pair :: forall y. Sample y -> (X, y)
to_pair (Sample X
x y
y) = (X
x, y
y)

instance Pretty y => Pretty (Sample y) where
    format :: Sample y -> Doc
format (Sample X
x y
y) = X -> Doc
forall a. Pretty a => a -> Doc
Pretty.format X
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
Pretty.char Char
':' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> y -> Doc
forall a. Pretty a => a -> Doc
Pretty.format y
y

-- | TimeVectors should be sorted by the X value.  Return warnings for where
-- that's not true.
{-# SPECIALIZE check :: Unboxed -> [String] #-}
{-# INLINEABLE check #-}
check :: V.Vector v (Sample y) => v (Sample y) -> [String]
check :: forall (v :: * -> *) y.
Vector v (Sample y) =>
v (Sample y) -> [String]
check = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (v (Sample y) -> [String]) -> v (Sample y) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], (Integer, X)) -> [String]
forall a b. (a, b) -> a
fst (([String], (Integer, X)) -> [String])
-> (v (Sample y) -> ([String], (Integer, X)))
-> v (Sample y)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], (Integer, X)) -> Sample y -> ([String], (Integer, X)))
-> ([String], (Integer, X))
-> v (Sample y)
-> ([String], (Integer, X))
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
V.foldl' ([String], (Integer, X)) -> Sample y -> ([String], (Integer, X))
forall {a} {y}.
(Num a, Show a) =>
([String], (a, X)) -> Sample y -> ([String], (a, X))
check ([], (Integer
0, X
0))
    where
    check :: ([String], (a, X)) -> Sample y -> ([String], (a, X))
check ([String]
warns, (a
i, X
prev_x)) (Sample X
x y
_)
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
prev_x = ([String] -> [String]) -> ([String], (a, X)) -> ([String], (a, X))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
msg:) ([String], (a, X))
next
        | Bool
otherwise = ([String], (a, X))
next
        where
        msg :: String
msg = String
"index " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": x decreased: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> X -> String
forall a. Show a => a -> String
show X
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" < "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> X -> String
forall a. Show a => a -> String
show X
prev_x
        next :: ([String], (a, X))
next = ([String]
warns, (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, X
x))

-- | This is a merge where the vectors to the right will win in the case of
-- overlap.
{-# SPECIALIZE merge_right :: [Unboxed] -> Unboxed #-}
{-# INLINEABLE merge_right #-}
merge_right :: V.Vector v (Sample y) => [v (Sample y)] -> v (Sample y)
merge_right :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[v (Sample y)] -> v (Sample y)
merge_right [v (Sample y)
v] = v (Sample y)
v
merge_right [v (Sample y)]
vs = case [v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
[v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_start ([v (Sample y)] -> [v (Sample y)]
forall a. [a] -> [a]
reverse [v (Sample y)]
vs) of
    Maybe (v (Sample y), [v (Sample y)], X)
Nothing -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
    Just (v (Sample y)
v, [v (Sample y)]
vs, X
x) -> [v (Sample y)] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [v a] -> v a
V.concat ([v (Sample y)] -> v (Sample y)) -> [v (Sample y)] -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ [v (Sample y)] -> [v (Sample y)]
forall a. [a] -> [a]
reverse ([v (Sample y)] -> [v (Sample y)])
-> [v (Sample y)] -> [v (Sample y)]
forall a b. (a -> b) -> a -> b
$ v (Sample y)
v v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: X -> [v (Sample y)] -> [v (Sample y)]
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
X -> [v (Sample y)] -> [v (Sample y)]
trim X
x [v (Sample y)]
vs
    where
    -- I don't really like the double reverse, but it's easiest this way.
    trim :: X -> [v (Sample y)] -> [v (Sample y)]
trim X
prev_start (v (Sample y)
v : [v (Sample y)]
vs) =
        v (Sample y)
clipped v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: X -> [v (Sample y)] -> [v (Sample y)]
trim (X -> (Sample y -> X) -> Maybe (Sample y) -> X
forall b a. b -> (a -> b) -> Maybe a -> b
maybe X
prev_start Sample y -> X
forall y. Sample y -> X
sx (v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
head v (Sample y)
clipped)) [v (Sample y)]
vs
        where clipped :: v (Sample y)
clipped = Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
prev_start v (Sample y)
v) v (Sample y)
v
    trim X
_ [] = []
    next_start :: [v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_start [] = Maybe (v (Sample y), [v (Sample y)], X)
forall a. Maybe a
Nothing
    next_start (v (Sample y)
v:[v (Sample y)]
vs) = Maybe (v (Sample y), [v (Sample y)], X)
-> (Sample y -> Maybe (v (Sample y), [v (Sample y)], X))
-> Maybe (Sample y)
-> Maybe (v (Sample y), [v (Sample y)], X)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_start [v (Sample y)]
vs) (\Sample y
s -> ((v (Sample y), [v (Sample y)], X)
-> Maybe (v (Sample y), [v (Sample y)], X)
forall a. a -> Maybe a
Just (v (Sample y)
v, [v (Sample y)]
vs, Sample y -> X
forall y. Sample y -> X
sx Sample y
s)))
        (v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
head v (Sample y)
v)

-- | This is a merge where the vectors to the left will win in the case of
-- overlap.
{-# SPECIALIZE merge_left :: [Unboxed] -> Unboxed #-}
{-# INLINEABLE merge_left #-}
merge_left :: V.Vector v (Sample y) => [v (Sample y)] -> v (Sample y)
merge_left :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[v (Sample y)] -> v (Sample y)
merge_left [v (Sample y)
v] = v (Sample y)
v
merge_left [v (Sample y)]
vs = case [v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
[v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_end [v (Sample y)]
vs of
    Maybe (v (Sample y), [v (Sample y)], X)
Nothing -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
    Just (v (Sample y)
v, [v (Sample y)]
vs, X
x) -> [v (Sample y)] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [v a] -> v a
V.concat ([v (Sample y)] -> v (Sample y)) -> [v (Sample y)] -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ v (Sample y)
v v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: X -> [v (Sample y)] -> [v (Sample y)]
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
X -> [v (Sample y)] -> [v (Sample y)]
trim X
x [v (Sample y)]
vs
    where
    trim :: X -> [v (Sample y)] -> [v (Sample y)]
trim X
prev_end (v (Sample y)
v : [v (Sample y)]
vs) =
        v (Sample y)
clipped v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: X -> [v (Sample y)] -> [v (Sample y)]
trim (X -> (Sample y -> X) -> Maybe (Sample y) -> X
forall b a. b -> (a -> b) -> Maybe a -> b
maybe X
prev_end Sample y -> X
forall y. Sample y -> X
sx (v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
last v (Sample y)
clipped)) [v (Sample y)]
vs
        where clipped :: v (Sample y)
clipped = (Sample y -> Bool) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
V.dropWhile ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<=X
prev_end) (X -> Bool) -> (Sample y -> X) -> Sample y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample y -> X
forall y. Sample y -> X
sx) v (Sample y)
v
    trim X
_ [] = []
    next_end :: [v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_end [] = Maybe (v (Sample y), [v (Sample y)], X)
forall a. Maybe a
Nothing
    next_end (v (Sample y)
v:[v (Sample y)]
vs) = Maybe (v (Sample y), [v (Sample y)], X)
-> (Sample y -> Maybe (v (Sample y), [v (Sample y)], X))
-> Maybe (Sample y)
-> Maybe (v (Sample y), [v (Sample y)], X)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([v (Sample y)] -> Maybe (v (Sample y), [v (Sample y)], X)
next_end [v (Sample y)]
vs) (\Sample y
s -> ((v (Sample y), [v (Sample y)], X)
-> Maybe (v (Sample y), [v (Sample y)], X)
forall a. a -> Maybe a
Just (v (Sample y)
v, [v (Sample y)]
vs, Sample y -> X
forall y. Sample y -> X
sx Sample y
s))) (v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
last v (Sample y)
v)
    -- |--->        => |--->
    --   |--->             |->
    --     |--->             |->

-- | When signals are 'merge_left'd, the later one overrides the first one.
-- This is the other way: the first one will override the second.
{-# SPECIALIZE prepend :: Unboxed -> Unboxed -> Unboxed #-}
{-# INLINEABLE prepend #-}
prepend :: V.Vector v (Sample y) => v (Sample y) -> v (Sample y)
    -> v (Sample y)
prepend :: forall (v :: * -> *) y.
Vector v (Sample y) =>
v (Sample y) -> v (Sample y) -> v (Sample y)
prepend v (Sample y)
vec1 v (Sample y)
vec2 = case v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
last v (Sample y)
vec1 of
    Maybe (Sample y)
Nothing -> v (Sample y)
vec2
    Just (Sample X
x y
_) ->
        v (Sample y)
vec1 v (Sample y) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
V.++ (Sample y -> Bool) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
V.dropWhile ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<=X
x) (X -> Bool) -> (Sample y -> X) -> Sample y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample y -> X
forall y. Sample y -> X
sx) (X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before_strict X
x v (Sample y)
vec2)

-- | Same as 'sample_at', except don't return the X.
{-# SPECIALIZE at :: X -> Unboxed -> Maybe UnboxedY #-}
{-# INLINEABLE at #-}
at :: V.Vector v (Sample y) => X -> v (Sample y) -> Maybe y
at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe y
at X
x = ((X, y) -> y) -> Maybe (X, y) -> Maybe y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (X, y) -> y
forall a b. (a, b) -> b
snd (Maybe (X, y) -> Maybe y)
-> (v (Sample y) -> Maybe (X, y)) -> v (Sample y) -> Maybe y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> v (Sample y) -> Maybe (X, y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe (X, y)
sample_at X
x

-- | Find the sample at or before X.  Nothing if the X is before the first
-- sample.
{-# SPECIALIZE sample_at :: X -> Unboxed -> Maybe (X, UnboxedY) #-}
{-# INLINEABLE sample_at #-}
sample_at :: V.Vector v (Sample y) => X -> v (Sample y) -> Maybe (X, y)
sample_at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe (X, y)
sample_at X
x v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = (X, y) -> Maybe (X, y)
forall a. a -> Maybe a
Just ((X, y) -> Maybe (X, y)) -> (X, y) -> Maybe (X, y)
forall a b. (a -> b) -> a -> b
$ Sample y -> (X, y)
forall y. Sample y -> (X, y)
to_pair (Sample y -> (X, y)) -> Sample y -> (X, y)
forall a b. (a -> b) -> a -> b
$ v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i
    | Bool
otherwise = Maybe (X, y)
forall a. Maybe a
Nothing
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
highest_index X
x v (Sample y)
vec

-- | Find the sample before the given X.
{-# SPECIALIZE before :: X -> Unboxed -> Maybe (Sample UnboxedY) #-}
{-# INLINEABLE before #-}
before :: V.Vector v (Sample y) => X -> v (Sample y) -> Maybe (Sample y)
before :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe (Sample y)
before X
x v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just (Sample y -> Maybe (Sample y)) -> Sample y -> Maybe (Sample y)
forall a b. (a -> b) -> a -> b
$ v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    | Bool
otherwise = Maybe (Sample y)
forall a. Maybe a
Nothing
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec

-- | Samples at and above the given time.
ascending :: V.Vector v (Sample y) => X -> v (Sample y) -> [Sample y]
ascending :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> [Sample y]
ascending X
x v (Sample y)
vec =
    [ v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i
    | Int
i <- Int -> Int -> Int -> [Int]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range' (X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec) (v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec) Int
1
    ]

-- | Descending samples, starting below the time.
descending :: V.Vector v (Sample y) => X -> v (Sample y) -> [Sample y]
descending :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> [Sample y]
descending X
x v (Sample y)
vec =
    [v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i | Int
i <- Int -> Int -> Int -> [Int]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range (X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0 (-Int
1)]

-- * transform

-- | Shift the signal in time.
shift :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
shift :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
shift X
offset v (Sample y)
vec
    | X
offset X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0 = v (Sample y)
vec
    | Bool
otherwise = (X -> X) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> X) -> v (Sample y) -> v (Sample y)
map_x (X -> X -> X
forall a. Num a => a -> a -> a
+X
offset) v (Sample y)
vec

-- | Truncate a signal so it doesn't include the given X - RealTime.eta.  It's
-- just a view of the old signal, so it doesn't allocate a new signal.
{-# SPECIALIZE drop_at_after :: X -> Unboxed -> Unboxed #-}
{-# INLINEABLE drop_at_after #-}
drop_at_after :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_at_after :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_at_after X
x v (Sample y)
vec = Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below (X
x X -> X -> X
forall a. Num a => a -> a -> a
- X
RealTime.eta) v (Sample y)
vec) v (Sample y)
vec

drop_after :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_after :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after X
x = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_at_after (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ X
RealTime.eta X -> X -> X
forall a. Num a => a -> a -> a
+ X
RealTime.eta)

-- | Like 'drop_before_strict', except if there is no sample at @x@, keep one
-- sample before it to preserve the value at @x@.  If there are multiple
-- samples at @x@, drop all but the last one.  This is because they indicate
-- a discontinuity, but if you don't care about the previous value, then you
-- don't need the discontinuity.
{-# SPECIALIZE drop_before :: X -> Unboxed -> Unboxed #-}
{-# INLINEABLE drop_before #-}
drop_before :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_before :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before X
x v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec = Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
i v (Sample y)
vec
    | Bool
otherwise = Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop (v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) v (Sample y)
vec
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
highest_index X
x v (Sample y)
vec

-- | The reverse of 'drop_at_after': trim a signal's head up until, but not
-- including, the given X.
drop_before_strict :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_before_strict :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before_strict X
x v (Sample y)
vec = Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop (X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec) v (Sample y)
vec

-- | Like 'drop_before_strict', but also drop samples at the X.
drop_before_at :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_before_at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before_at X
x = (Sample y -> Bool) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
V.dropWhile ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<=X
x) (X -> Bool) -> (Sample y -> X) -> Sample y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample y -> X
forall y. Sample y -> X
sx) (v (Sample y) -> v (Sample y))
-> (v (Sample y) -> v (Sample y)) -> v (Sample y) -> v (Sample y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before_strict X
x

-- | Return samples to set the value at start and until end.  This means
-- samples start <= t < end, along with one < start if necessary to set
-- the initial value, and the end sample if start == end.
within :: V.Vector v (Sample y) => X -> X -> v (Sample y) -> v (Sample y)
within :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> X -> v (Sample y) -> v (Sample y)
within X
start X
end = (if X
start X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
end then X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after X
end else X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_at_after X
end)
    (v (Sample y) -> v (Sample y))
-> (v (Sample y) -> v (Sample y)) -> v (Sample y) -> v (Sample y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_before X
start

map_x :: V.Vector v (Sample y) => (X -> X) -> v (Sample y) -> v (Sample y)
map_x :: forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> X) -> v (Sample y) -> v (Sample y)
map_x X -> X
f = (Sample y -> Sample y) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
V.map ((Sample y -> Sample y) -> v (Sample y) -> v (Sample y))
-> (Sample y -> Sample y) -> v (Sample y) -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ \(Sample X
x y
y) -> X -> y -> Sample y
forall y. X -> y -> Sample y
Sample (X -> X
f X
x) y
y

map_y :: V.Vector v (Sample y) => (y -> y) -> v (Sample y) -> v (Sample y)
map_y :: forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
map_y y -> y
f = (Sample y -> Sample y) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
V.map ((Sample y -> Sample y) -> v (Sample y) -> v (Sample y))
-> (Sample y -> Sample y) -> v (Sample y) -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ \(Sample X
x y
y) -> X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x (y -> y
f y
y)

{-# SPECIALIZE map_err :: (Sample UnboxedY -> Either err (Sample UnboxedY))
    -> Unboxed -> (Unboxed, [err]) #-}
{-# INLINEABLE map_err #-}
-- | A map that can return error msgs.
map_err :: V.Vector v a => (a -> Either err a) -> v a -> (v a, [err])
map_err :: forall (v :: * -> *) a err.
Vector v a =>
(a -> Either err a) -> v a -> (v a, [err])
map_err a -> Either err a
f v a
vec = ([err] -> [err]) -> (v a, [err]) -> (v a, [err])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [err] -> [err]
forall a. [a] -> [a]
reverse ((v a, [err]) -> (v a, [err])) -> (v a, [err]) -> (v a, [err])
forall a b. (a -> b) -> a -> b
$ State [err] (v a) -> [err] -> (v a, [err])
forall s a. State s a -> s -> (a, s)
State.runState ((a -> StateT [err] Identity a) -> v a -> State [err] (v a)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
V.mapM a -> StateT [err] Identity a
forall {m :: * -> *}. MonadState [err] m => a -> m a
go v a
vec) []
    where
    go :: a -> m a
go a
sample =
        (err -> m a) -> (a -> m a) -> Either err a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\err
err -> ([err] -> [err]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (err
err:) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
sample) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either err a
f a
sample)

{-# SPECIALIZE sig_op :: UnboxedY -> (UnboxedY -> UnboxedY -> UnboxedY)
    -> Unboxed -> Unboxed -> Unboxed #-}
{-# INLINEABLE sig_op #-}
-- | Combine two vectors with the given function.  They will be resampled so
-- they have samples at the same time.
sig_op :: V.Vector v (Sample y) =>
    y -- ^ The implicit y value of a vector before its first sample.  It should
    -- probably be the identity for the operator.
    -> (y -> y -> y) -> v (Sample y) -> v (Sample y) -> v (Sample y)
sig_op :: forall (v :: * -> *) y.
Vector v (Sample y) =>
y -> (y -> y -> y) -> v (Sample y) -> v (Sample y) -> v (Sample y)
sig_op y
initial y -> y -> y
combine v (Sample y)
vec1 v (Sample y)
vec2 = ((y, y, Int, Int) -> Maybe (Sample y, (y, y, Int, Int)))
-> (y, y, Int, Int) -> v (Sample y)
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
V.unfoldr (y, y, Int, Int) -> Maybe (Sample y, (y, y, Int, Int))
go (y
initial, y
initial, Int
0, Int
0)
    where
    go :: (y, y, Int, Int) -> Maybe (Sample y, (y, y, Int, Int))
go (y
prev_ay, y
prev_by, Int
i1, Int
i2) =
        case y
-> y
-> Int
-> Int
-> Int
-> Int
-> v (Sample y)
-> v (Sample y)
-> Maybe (X, y, y, Int, Int)
forall (v1 :: * -> *) y1 (v2 :: * -> *) y2.
(Vector v1 (Sample y1), Vector v2 (Sample y2)) =>
y1
-> y2
-> Int
-> Int
-> Int
-> Int
-> v1 (Sample y1)
-> v2 (Sample y2)
-> Maybe (X, y1, y2, Int, Int)
resample1 y
prev_ay y
prev_by Int
len1 Int
len2 Int
i1 Int
i2 v (Sample y)
vec1 v (Sample y)
vec2 of
            Maybe (X, y, y, Int, Int)
Nothing -> Maybe (Sample y, (y, y, Int, Int))
forall a. Maybe a
Nothing
            Just (X
x, y
ay, y
by, Int
i1, Int
i2) ->
                (Sample y, (y, y, Int, Int)) -> Maybe (Sample y, (y, y, Int, Int))
forall a. a -> Maybe a
Just (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x (y -> y -> y
combine y
ay y
by), (y
ay, y
by, Int
i1, Int
i2))
    len1 :: Int
len1 = v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec1
    len2 :: Int
len2 = v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec2

-- | Polymorphic variant of 'sig_op'.
--
-- The signature is specialized to Boxed since you might as well use 'sig_op'
-- for Unboxed vectors.
sig_op_poly :: y1 -> y2 -> (y1 -> y2 -> y3) -> Boxed y1 -> Boxed y2 -> Boxed y3
sig_op_poly :: forall y1 y2 y3.
y1 -> y2 -> (y1 -> y2 -> y3) -> Boxed y1 -> Boxed y2 -> Boxed y3
sig_op_poly y1
initial1 y2
initial2 y1 -> y2 -> y3
combine Boxed y1
vec1 Boxed y2
vec2 =
    ((y1, y2, Int, Int) -> Maybe (Sample y3, (y1, y2, Int, Int)))
-> (y1, y2, Int, Int) -> Vector (Sample y3)
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
V.unfoldr (y1, y2, Int, Int) -> Maybe (Sample y3, (y1, y2, Int, Int))
go (y1
initial1, y2
initial2, Int
0, Int
0)
    where
    -- Yeah I could probably make 'sig_op' a specialization of this, but can't
    -- be bothered at the moment.
    go :: (y1, y2, Int, Int) -> Maybe (Sample y3, (y1, y2, Int, Int))
go (y1
prev_ay, y2
prev_by, Int
i1, Int
i2) =
        case y1
-> y2
-> Int
-> Int
-> Int
-> Int
-> Boxed y1
-> Boxed y2
-> Maybe (X, y1, y2, Int, Int)
forall (v1 :: * -> *) y1 (v2 :: * -> *) y2.
(Vector v1 (Sample y1), Vector v2 (Sample y2)) =>
y1
-> y2
-> Int
-> Int
-> Int
-> Int
-> v1 (Sample y1)
-> v2 (Sample y2)
-> Maybe (X, y1, y2, Int, Int)
resample1 y1
prev_ay y2
prev_by Int
len1 Int
len2 Int
i1 Int
i2 Boxed y1
vec1 Boxed y2
vec2 of
            Maybe (X, y1, y2, Int, Int)
Nothing -> Maybe (Sample y3, (y1, y2, Int, Int))
forall a. Maybe a
Nothing
            Just (X
x, y1
ay, y2
by, Int
i1, Int
i2) ->
                (Sample y3, (y1, y2, Int, Int))
-> Maybe (Sample y3, (y1, y2, Int, Int))
forall a. a -> Maybe a
Just (X -> y3 -> Sample y3
forall y. X -> y -> Sample y
Sample X
x (y1 -> y2 -> y3
combine y1
ay y2
by), (y1
ay, y2
by, Int
i1, Int
i2))
    len1 :: Int
len1 = Boxed y1 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length Boxed y1
vec1
    len2 :: Int
len2 = Boxed y2 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length Boxed y2
vec2

{-# INLINE resample1 #-}
resample1 :: (V.Vector v1 (Sample y1), V.Vector v2 (Sample y2)) => y1 -> y2
    -> Int -> Int -> Int -> Int
    -> v1 (Sample y1) -> v2 (Sample y2) -> Maybe (X, y1, y2, Int, Int)
resample1 :: forall (v1 :: * -> *) y1 (v2 :: * -> *) y2.
(Vector v1 (Sample y1), Vector v2 (Sample y2)) =>
y1
-> y2
-> Int
-> Int
-> Int
-> Int
-> v1 (Sample y1)
-> v2 (Sample y2)
-> Maybe (X, y1, y2, Int, Int)
resample1 y1
prev_ay y2
prev_by Int
len1 Int
len2 Int
i1 Int
i2 v1 (Sample y1)
vec1 v2 (Sample y2)
vec2
    | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len1 Bool -> Bool -> Bool
&& Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len2 = Maybe (X, y1, y2, Int, Int)
forall a. Maybe a
Nothing
    | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len1 = (X, y1, y2, Int, Int) -> Maybe (X, y1, y2, Int, Int)
forall a. a -> Maybe a
Just (X
bx, y1
prev_ay, y2
by, Int
i1, Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    | Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len2 = (X, y1, y2, Int, Int) -> Maybe (X, y1, y2, Int, Int)
forall a. a -> Maybe a
Just (X
ax, y1
ay, y2
prev_by, Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
i2)
    | X
ax X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
bx = (X, y1, y2, Int, Int) -> Maybe (X, y1, y2, Int, Int)
forall a. a -> Maybe a
Just (X
ax, y1
ay, y2
by, Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    | X
ax X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
bx = (X, y1, y2, Int, Int) -> Maybe (X, y1, y2, Int, Int)
forall a. a -> Maybe a
Just (X
ax, y1
ay, y2
prev_by, Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
i2)
    | Bool
otherwise = (X, y1, y2, Int, Int) -> Maybe (X, y1, y2, Int, Int)
forall a. a -> Maybe a
Just (X
bx, y1
prev_ay, y2
by, Int
i1, Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    where
    Sample X
ax y1
ay = v1 (Sample y1) -> Int -> Sample y1
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v1 (Sample y1)
vec1 Int
i1
    Sample X
bx y2
by = v2 (Sample y2) -> Int -> Sample y2
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v2 (Sample y2)
vec2 Int
i2

-- * util

{-# SPECIALIZE find_nonascending :: Unboxed -> [(X, UnboxedY)] #-}
{-# INLINEABLE find_nonascending #-}
-- | Find samples whose 'sx' is <= the previous X.
find_nonascending :: V.Vector v (Sample y) => v (Sample y) -> [(X, y)]
find_nonascending :: forall (v :: * -> *) y.
Vector v (Sample y) =>
v (Sample y) -> [(X, y)]
find_nonascending v (Sample y)
vec = case v (Sample y) -> Maybe (Sample y, v (Sample y))
forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
uncons v (Sample y)
vec of
    Maybe (Sample y, v (Sample y))
Nothing -> []
    Just (Sample y
x, v (Sample y)
xs) -> (Sample y -> (X, y)) -> [Sample y] -> [(X, y)]
forall a b. (a -> b) -> [a] -> [b]
map Sample y -> (X, y)
forall y. Sample y -> (X, y)
to_pair ([Sample y] -> [(X, y)]) -> [Sample y] -> [(X, y)]
forall a b. (a -> b) -> a -> b
$ [Sample y] -> [Sample y]
forall a. [a] -> [a]
reverse ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> a -> b
$ (X, [Sample y]) -> [Sample y]
forall a b. (a, b) -> b
snd ((X, [Sample y]) -> [Sample y]) -> (X, [Sample y]) -> [Sample y]
forall a b. (a -> b) -> a -> b
$ ((X, [Sample y]) -> Sample y -> (X, [Sample y]))
-> (X, [Sample y]) -> v (Sample y) -> (X, [Sample y])
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
V.foldl' (X, [Sample y]) -> Sample y -> (X, [Sample y])
forall {y}. (X, [Sample y]) -> Sample y -> (X, [Sample y])
go (Sample y -> X
forall y. Sample y -> X
sx Sample y
x, []) v (Sample y)
xs
    where
    go :: (X, [Sample y]) -> Sample y -> (X, [Sample y])
go (X
prev, [Sample y]
acc) Sample y
s
        | Sample y -> X
forall y. Sample y -> X
sx Sample y
s X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
prev = (Sample y -> X
forall y. Sample y -> X
sx Sample y
s, Sample y
s Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y]
acc)
        | Bool
otherwise = (Sample y -> X
forall y. Sample y -> X
sx Sample y
s, [Sample y]
acc)

{-# SPECIALIZE unfoldr :: (state -> Maybe ((X, UnboxedY), state)) -> state
    -> Unboxed #-}
{-# INLINEABLE unfoldr #-}
unfoldr :: V.Vector v (Sample y) => (state -> Maybe ((X, y), state)) -> state
    -> v (Sample y)
unfoldr :: forall (v :: * -> *) y state.
Vector v (Sample y) =>
(state -> Maybe ((X, y), state)) -> state -> v (Sample y)
unfoldr state -> Maybe ((X, y), state)
f = (state -> Maybe (Sample y, state)) -> state -> v (Sample y)
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
V.unfoldr ((state -> Maybe (Sample y, state)) -> state -> v (Sample y))
-> (state -> Maybe (Sample y, state)) -> state -> v (Sample y)
forall a b. (a -> b) -> a -> b
$ \state
st -> case state -> Maybe ((X, y), state)
f state
st of
    Maybe ((X, y), state)
Nothing -> Maybe (Sample y, state)
forall a. Maybe a
Nothing
    Just ((X
x, y
y), state
next) -> (Sample y, state) -> Maybe (Sample y, state)
forall a. a -> Maybe a
Just (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x y
y, state
next)

-- | Given a line defined by the two points, find the y at the given x.
-- Crashes if called on a vertical line (y0==y1).  Yeah, it's inconsistent
-- with 'x_at'.
y_at :: CallStack.Stack => X -> Double -> X -> Double -> X -> Double
y_at :: Stack => X -> UnboxedY -> X -> UnboxedY -> X -> UnboxedY
y_at X
x0 UnboxedY
y0 X
x1 UnboxedY
y1 X
x
    | X
x0 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x1 = Text -> UnboxedY
forall a. Stack => Text -> a
errorStack (Text -> UnboxedY) -> Text -> UnboxedY
forall a b. (a -> b) -> a -> b
$ Text
"y_at on vertical line: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ((X, UnboxedY), (X, UnboxedY), X) -> Text
forall a. Show a => a -> Text
showt ((X
x0, UnboxedY
y0), (X
x1, UnboxedY
y1), X
x)
    | Bool
otherwise = (UnboxedY
y1 UnboxedY -> UnboxedY -> UnboxedY
forall a. Num a => a -> a -> a
- UnboxedY
y0) UnboxedY -> UnboxedY -> UnboxedY
forall a. Fractional a => a -> a -> a
/ X -> UnboxedY
x_to_double (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0) UnboxedY -> UnboxedY -> UnboxedY
forall a. Num a => a -> a -> a
* X -> UnboxedY
x_to_double (X
x X -> X -> X
forall a. Num a => a -> a -> a
- X
x0) UnboxedY -> UnboxedY -> UnboxedY
forall a. Num a => a -> a -> a
+ UnboxedY
y0

-- | Given a line defined by the two points, find the x at the given y.
x_at :: X -> Double -> X -> Double -> Double -> Maybe X
x_at :: X -> UnboxedY -> X -> UnboxedY -> UnboxedY -> Maybe X
x_at X
x0 UnboxedY
y0 X
x1 UnboxedY
y1 UnboxedY
y
    | UnboxedY
y0 UnboxedY -> UnboxedY -> Bool
forall a. Eq a => a -> a -> Bool
== UnboxedY
y1 = Maybe X
forall a. Maybe a
Nothing -- line is horizontal
    | Bool
otherwise = X -> Maybe X
forall a. a -> Maybe a
Just (X -> Maybe X) -> X -> Maybe X
forall a b. (a -> b) -> a -> b
$
        UnboxedY -> X
double_to_x (UnboxedY
y UnboxedY -> UnboxedY -> UnboxedY
forall a. Num a => a -> a -> a
- UnboxedY
y0) X -> X -> X
forall a. Fractional a => a -> a -> a
/ (UnboxedY -> X
double_to_x (UnboxedY
y1 UnboxedY -> UnboxedY -> UnboxedY
forall a. Num a => a -> a -> a
- UnboxedY
y0) X -> X -> X
forall a. Fractional a => a -> a -> a
/ (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0)) X -> X -> X
forall a. Num a => a -> a -> a
+ X
x0

-- | Binary search for the highest index of the given X.  So the next value is
-- guaranteed to be >X, if it exists.  Return -1 if @x@ is before
-- the first element.  'RealTime.eta' is added to @x@, so a sample that's
-- almost the same will still be considered a match.
{-# SPECIALIZE highest_index :: X -> Unboxed -> Int #-}
{-# SPECIALIZE highest_index :: X -> Boxed y -> Int #-}
{-# INLINEABLE highest_index #-}
highest_index :: V.Vector v (Sample y) => X -> v (Sample y) -> Int
highest_index :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
highest_index X
x v (Sample y)
vec
    | v (Sample y) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
vec = -Int
1
    | Bool
otherwise = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_above (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ X
RealTime.eta) v (Sample y)
vec

-- | 'bsearch_below', but if you use it with take, it includes the first
-- element ==x.  TODO not sure how to explain it.
{-# SPECIALIZE bsearch_below_1 :: X -> Unboxed -> Int #-}
{-# INLINEABLE bsearch_below_1 #-}
bsearch_below_1 :: V.Vector v (Sample y) => X -> v (Sample y) -> Int
bsearch_below_1 :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below_1 X
x v (Sample y)
vec = case v (Sample y)
vec v (Sample y) -> Int -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
V.!? Int
i of
    Just Sample y
vi | Sample y -> X
forall y. Sample y -> X
sx Sample y
vi X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Maybe (Sample y)
_ -> Int
i
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec

-- | Search for the last index <x, or -1 if the first sample is already >x.
{-# SPECIALIZE index_below :: X -> Unboxed -> Int #-}
{-# INLINEABLE index_below #-}
index_below :: V.Vector v (Sample y) => X -> v (Sample y) -> Int
index_below :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
index_below X
x v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = case v (Sample y)
vec v (Sample y) -> Int -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
V.!? Int
i of
        Just (Sample X
x1 y
_) | X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x -> Int
0
        Maybe (Sample y)
_ -> -Int
1
    | Bool
otherwise = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    where i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec

-- | Binary search for the index of the first element that is >x, or one past
-- the end of the vector.
{-# SPECIALIZE bsearch_above :: X -> Unboxed -> Int #-}
{-# SPECIALIZE bsearch_above :: X -> Boxed y -> Int #-}
{-# INLINEABLE bsearch_above #-}
bsearch_above :: V.Vector v (Sample y) => X -> v (Sample y) -> Int
bsearch_above :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_above X
x v (Sample y)
vec = Int -> Int -> Int
go Int
0 (v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec)
    where
    go :: Int -> Int -> Int
go Int
low Int
high
        | Int
low Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
high = Int
low
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= Sample y -> X
forall y. Sample y -> X
sx (v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
mid) = Int -> Int -> Int
go (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
high
        | Bool
otherwise = Int -> Int -> Int
go Int
low Int
mid
        where mid :: Int
mid = (Int
low Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
high) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

-- | Binary search for the index of the first element ==x, or the last one <x.
-- So it will be <=x, or one past the end of the vector.  If you ues it with
-- take, it's everything <x.
{-# SPECIALIZE bsearch_below :: X -> Unboxed -> Int #-}
{-# SPECIALIZE bsearch_below :: X -> Boxed y -> Int #-}
{-# INLINEABLE bsearch_below #-}
bsearch_below :: V.Vector v (Sample y) => X -> v (Sample y) -> Int
bsearch_below :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
bsearch_below X
x v (Sample y)
vec = Int -> Int -> Int
go Int
0 (v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec)
    where
    go :: Int -> Int -> Int
go Int
low Int
high
        | Int
low Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
high = Int
low
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= Sample y -> X
forall y. Sample y -> X
sx (v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
mid) = Int -> Int -> Int
go Int
low Int
mid
        | Bool
otherwise = Int -> Int -> Int
go (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
high
        where mid :: Int
mid = (Int
low Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
high) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2