-- Copyright 2017 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

{-# LANGUAGE CPP #-}
-- | The 'Signal' type and functions.
module Util.Segment (
    Signal, SignalS, Interpolate
    , Segment(..)
    , X, Sample(..)
    -- * construct / destruct
    , empty
    , constant, constant_val, constant_val_num
    , all_y
    , beginning
    , from_vector, to_vector
    , from_samples, to_samples, to_samples_desc
    , from_pairs, to_pairs, to_pairs_desc
    , from_segments, to_segments, samples_to_segments
    , simplify
    , unfoldr
    , with_ptr

    -- * query
    , null
    , at, at_negative, segment_at
    , head, last
    , maximum, minimum
    , find

    -- * concat
    , concat, prepend
    -- * slice
    , drop_after, clip_after, num_clip_after
    , drop_before, clip_before, clip_before_samples
    -- * transform
    , shift
    , map_y, map_y_linear, map_x
    -- , map_segments
    , transform_samples, map_err

    -- ** hacks
    , drop_discontinuity_at

    -- * Boxed
    , Boxed
    -- * NumSignal
    , NumSignal
    , num_interpolate, num_interpolate_s
    , invert
    , integrate
    -- * resample
    , linear_operator
    , resample_num, resample_maybe
    , sample_xs, add_zero_transition
    -- * piecewise constant
    , to_piecewise_constant
#ifdef TESTING
    , module Util.Segment
#endif
) where
import           Prelude hiding (concat, head, last, maximum, minimum, null)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Storable as Vector.Storable

import qualified Foreign

import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import qualified Util.TimeVector as TimeVector
import           Util.TimeVector (X, Sample(..))
import qualified Util.Vector

import qualified Perform.RealTime as RealTime
import qualified Ui.Types as Types

import           Global


{- | A signal modeled as segments.  Presumably the segments are linear, but
    since you pass your own 'Interpolate', nothing in this module enforces
    that, though there are some transformations that are only valid for linear
    segments.

    A signal has no value before its first sample, and maintains a constant
    value of the last sample forever.  There is an implicit discontinuity
    to the first sample, so if @x@ is the first sample, then @[(x, y), ..]@ is
    implicitly @[(x, Nothing), (x, y), ...]@.  'NumSignal' uses 0 for not set,
    so unless the first @y@ is also 0 it becomes @[(x, 0), (x, y), ..]@.

    This comes with a built-in X offset, so translation is cheap, via 'shift'.

    Each X should be >= the previous X, and there shouldn't be more than two
    equal Xs in a row.  The first ensures that binary search works, and the
    second insures that I don't try to interpolate a zero length segment.
    Construction via 'from_samples' should establish them, and transformations
    should maintain them.

    However, a few functions in here can break them, e.g. 'map_x' and 'invert',
    and I think trying to fix them would be expensive.  So be careful with
    those.  Functions should be robust against zero length segments, but if you
    break ordering you're out of luck.

    If the @y@ value doesn't have an Eq instance, there's no way to filter
    out redundant segments like @[(0, 1), (1, 1), (2, 1)]@.  Functions
    specialized to 'NumSignal' may make some effort to do that, but only if it
    seems worth it.
-}
data Signal v = Signal {
    forall v. Signal v -> X
_offset :: !X
    , forall v. Signal v -> v
_vector :: !v
    } deriving (Signal v -> Signal v -> Bool
(Signal v -> Signal v -> Bool)
-> (Signal v -> Signal v -> Bool) -> Eq (Signal v)
forall v. Eq v => Signal v -> Signal v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal v -> Signal v -> Bool
$c/= :: forall v. Eq v => Signal v -> Signal v -> Bool
== :: Signal v -> Signal v -> Bool
$c== :: forall v. Eq v => Signal v -> Signal v -> Bool
Eq, Int -> Signal v -> ShowS
[Signal v] -> ShowS
Signal v -> String
(Int -> Signal v -> ShowS)
-> (Signal v -> String) -> ([Signal v] -> ShowS) -> Show (Signal v)
forall v. Show v => Int -> Signal v -> ShowS
forall v. Show v => [Signal v] -> ShowS
forall v. Show v => Signal v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signal v] -> ShowS
$cshowList :: forall v. Show v => [Signal v] -> ShowS
show :: Signal v -> String
$cshow :: forall v. Show v => Signal v -> String
showsPrec :: Int -> Signal v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Signal v -> ShowS
Show)

type SignalS v y = Signal (v (Sample y))

type Interpolate y = Sample y -> Sample y -> X -> y

instance Pretty v => Pretty (Signal v) where
    format :: Signal v -> Doc
format (Signal X
offset v
vector) = Doc
"Signal" Doc -> Doc -> Doc
Pretty.<+> Text -> Doc
Pretty.text Text
offset_s
        Doc -> Doc -> Doc
Pretty.<+> v -> Doc
forall a. Pretty a => a -> Doc
Pretty.format v
vector
        where
        offset_s :: Text
offset_s
            | X
offset X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
0 = Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text
forall a. Pretty a => a -> Text
pretty X
offset
            | Bool
otherwise = X -> Text
forall a. Pretty a => a -> Text
pretty X
offset

instance Serialize.Serialize v => Serialize.Serialize (Signal v) where
    put :: Putter (Signal v)
put (Signal X
offset v
vec) = Putter X
forall a. Serialize a => Putter a
Serialize.put X
offset PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter v
forall a. Serialize a => Putter a
Serialize.put v
vec
    get :: Get (Signal v)
get = X -> v -> Signal v
forall v. X -> v -> Signal v
Signal (X -> v -> Signal v) -> Get X -> Get (v -> Signal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get X
forall a. Serialize a => Get a
Serialize.get Get (v -> Signal v) -> Get v -> Get (Signal v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get v
forall a. Serialize a => Get a
Serialize.get

instance DeepSeq.NFData v => DeepSeq.NFData (Signal v) where
    rnf :: Signal v -> ()
rnf (Signal X
offset v
vec) = X -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf X
offset () -> () -> ()
`seq` v -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf v
vec () -> () -> ()
`seq` ()

modify_vector :: (a -> b) -> Signal a -> Signal b
modify_vector :: forall a b. (a -> b) -> Signal a -> Signal b
modify_vector a -> b
modify Signal a
sig = Signal a
sig { _vector :: b
_vector = a -> b
modify (Signal a -> a
forall v. Signal v -> v
_vector Signal a
sig) }

data Segment y = Segment {
    forall y. Segment y -> X
_x1 :: !X, forall y. Segment y -> y
_y1 :: !y
    , forall y. Segment y -> X
_x2 :: !X, forall y. Segment y -> y
_y2 :: !y
    } deriving (Segment y -> Segment y -> Bool
(Segment y -> Segment y -> Bool)
-> (Segment y -> Segment y -> Bool) -> Eq (Segment y)
forall y. Eq y => Segment y -> Segment y -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment y -> Segment y -> Bool
$c/= :: forall y. Eq y => Segment y -> Segment y -> Bool
== :: Segment y -> Segment y -> Bool
$c== :: forall y. Eq y => Segment y -> Segment y -> Bool
Eq, Int -> Segment y -> ShowS
[Segment y] -> ShowS
Segment y -> String
(Int -> Segment y -> ShowS)
-> (Segment y -> String)
-> ([Segment y] -> ShowS)
-> Show (Segment y)
forall y. Show y => Int -> Segment y -> ShowS
forall y. Show y => [Segment y] -> ShowS
forall y. Show y => Segment y -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment y] -> ShowS
$cshowList :: forall y. Show y => [Segment y] -> ShowS
show :: Segment y -> String
$cshow :: forall y. Show y => Segment y -> String
showsPrec :: Int -> Segment y -> ShowS
$cshowsPrec :: forall y. Show y => Int -> Segment y -> ShowS
Show)

instance Pretty y => Pretty (Segment y) where
    pretty :: Segment y -> Text
pretty (Segment X
x1 y
y1 X
x2 y
y2) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text
forall a. Pretty a => a -> Text
pretty X
x1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> y -> Text
forall a. Pretty a => a -> Text
pretty y
y1
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")--(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text
forall a. Pretty a => a -> Text
pretty X
x2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> y -> Text
forall a. Pretty a => a -> Text
pretty y
y2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- * construct / destruct

empty :: V.Vector v a => Signal (v a)
empty :: forall (v :: * -> *) a. Vector v a => Signal (v a)
empty = X -> v a -> Signal (v a)
forall v. X -> v -> Signal v
Signal X
0 v a
forall (v :: * -> *) a. Vector v a => v a
V.empty

constant :: V.Vector v (Sample y) => y -> SignalS v y
constant :: forall (v :: * -> *) y. Vector v (Sample y) => y -> SignalS v y
constant y
a = v (Sample y) -> Signal (v (Sample y))
forall v. v -> Signal v
from_vector (v (Sample y) -> Signal (v (Sample y)))
-> v (Sample y) -> Signal (v (Sample y))
forall a b. (a -> b) -> a -> b
$ [Sample y] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList [X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
beginning y
a]

constant_val :: V.Vector v (Sample a) => SignalS v a -> Maybe a
constant_val :: forall (v :: * -> *) a.
Vector v (Sample a) =>
SignalS v a -> Maybe a
constant_val SignalS v a
sig = case v (Sample a) -> Maybe (Sample a, v (Sample a))
forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
TimeVector.uncons (SignalS v a -> v (Sample a)
forall v. Signal v -> v
_vector SignalS v a
sig) of
    -- This will naturally disregard 'shift's, which is as it should be for
    -- so-called constant signals.
    Just (Sample X
x1 a
y1, v (Sample a)
rest) | X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= -X
RealTime.large Bool -> Bool -> Bool
&& v (Sample a) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample a)
rest ->
        a -> Maybe a
forall a. a -> Maybe a
Just a
y1
    Maybe (Sample a, v (Sample a))
_ -> Maybe a
forall a. Maybe a
Nothing

-- | 'constant_val' for 'NumSignal's can be more clever, because it can compare
-- Ys.  Also NumSignals are implicitly 0 before the first sample.
constant_val_num :: X -> NumSignal -> Maybe Y
constant_val_num :: X -> NumSignal -> Maybe Double
constant_val_num X
from NumSignal
sig = case Vector (Sample Double)
-> Maybe (Sample Double, Vector (Sample Double))
forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
TimeVector.uncons (NumSignal -> Vector (Sample Double)
forall v. Signal v -> v
_vector NumSignal
sig) of
    -- I compare multiple samples because a track might have redundant
    -- values, but I still want to detect if it's constant.
    Just (Sample X
x Double
y, Vector (Sample Double)
rest)
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= (X
from X -> X -> X
forall a. Num a => a -> a -> a
- NumSignal -> X
forall v. Signal v -> X
_offset NumSignal
sig) Bool -> Bool -> Bool
&& (Sample Double -> Bool) -> Vector (Sample Double) -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
y) (Double -> Bool)
-> (Sample Double -> Double) -> Sample Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample Double -> Double
forall y. Sample y -> y
sy) Vector (Sample Double)
rest -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y
        | (Sample Double -> Bool) -> Vector (Sample Double) -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) (Double -> Bool)
-> (Sample Double -> Double) -> Sample Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample Double -> Double
forall y. Sample y -> y
sy) (NumSignal -> Vector (Sample Double)
forall v. Signal v -> v
_vector NumSignal
sig) -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0
        | Bool
otherwise -> Maybe Double
forall a. Maybe a
Nothing
    Maybe (Sample Double, Vector (Sample Double))
Nothing -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0

all_y :: (Y -> Bool) -> NumSignal -> Bool
all_y :: (Double -> Bool) -> NumSignal -> Bool
all_y Double -> Bool
f = (Sample Double -> Bool) -> Vector (Sample Double) -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all (Double -> Bool
f (Double -> Bool)
-> (Sample Double -> Double) -> Sample Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample Double -> Double
forall y. Sample y -> y
sy) (Vector (Sample Double) -> Bool)
-> (NumSignal -> Vector (Sample Double)) -> NumSignal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> Vector (Sample Double)
forall v. Signal v -> v
_vector

-- | Use this as the stand-in for "since the beginning of time."
beginning :: RealTime.RealTime
beginning :: X
beginning = -X
RealTime.larger

from_vector :: v -> Signal v
from_vector :: forall v. v -> Signal v
from_vector = X -> v -> Signal v
forall v. X -> v -> Signal v
Signal X
0

to_vector :: V.Vector v (Sample y) => SignalS v y -> v (Sample y)
to_vector :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector SignalS v y
sig
    | X
offset X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0 = SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig
    | 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)
TimeVector.map_x (X -> X -> X
forall a. Num a => a -> a -> a
+X
offset) (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)
    where offset :: X
offset = SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig

-- | The final sample extends for "all time".  However, there's no value before
-- the first sample.  The reason is that I'd have to have a zero value for y,
-- and there isn't really an appropriate one for pitch.
--
-- TODO I could simplify straight lines, but then I'd need Eq on y.  Maybe do
-- that separately for NumSignal.
from_samples :: V.Vector v (Sample y) => [Sample y] -> SignalS v y
from_samples :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples =
    v (Sample y) -> Signal (v (Sample y))
forall v. v -> Signal v
from_vector (v (Sample y) -> Signal (v (Sample y)))
-> ([Sample y] -> v (Sample y))
-> [Sample y]
-> Signal (v (Sample y))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample y] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList ([Sample y] -> v (Sample y))
-> ([Sample y] -> [Sample y]) -> [Sample y] -> v (Sample y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample y] -> [Sample y]
forall {y}. [Sample y] -> [Sample y]
drop_coincident
        ([Sample y] -> [Sample y])
-> ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample y] -> [Sample y]
forall {y}. [Sample y] -> [Sample y]
drop_initial_dup
        ([Sample y] -> [Sample y])
-> ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Sample y)] -> [Sample y]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe (Sample y)] -> [Sample y])
-> ([Sample y] -> [Maybe (Sample y)]) -> [Sample y] -> [Sample y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Sample y), [Maybe (Sample y)]) -> [Maybe (Sample y)]
forall a b. (a, b) -> b
snd ((Maybe (Sample y), [Maybe (Sample y)]) -> [Maybe (Sample y)])
-> ([Sample y] -> (Maybe (Sample y), [Maybe (Sample y)]))
-> [Sample y]
-> [Maybe (Sample y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Sample y)
 -> Sample y -> (Maybe (Sample y), Maybe (Sample y)))
-> Maybe (Sample y)
-> [Sample y]
-> (Maybe (Sample y), [Maybe (Sample y)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL Maybe (Sample y)
-> Sample y -> (Maybe (Sample y), Maybe (Sample y))
forall {y}.
Maybe (Sample y)
-> Sample y -> (Maybe (Sample y), Maybe (Sample y))
in_order Maybe (Sample y)
forall a. Maybe a
Nothing
    where
    -- Since the first sample comes from 0, I can drop leading dups.
    drop_initial_dup :: [Sample y] -> [Sample y]
drop_initial_dup (Sample y
s1 : ss :: [Sample y]
ss@(Sample y
s2 : [Sample y]
_)) | Sample y -> X
forall y. Sample y -> X
sx Sample y
s1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== Sample y -> X
forall y. Sample y -> X
sx Sample y
s2 = [Sample y] -> [Sample y]
drop_initial_dup [Sample y]
ss
    drop_initial_dup [Sample y]
s = [Sample y]
s
    -- Drop out-of-order samples.
    in_order :: Maybe (Sample y)
-> Sample y -> (Maybe (Sample y), Maybe (Sample y))
in_order Maybe (Sample y)
Nothing Sample y
cur = (Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just Sample y
cur, Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just Sample y
cur)
    in_order (Just Sample y
prev) Sample y
cur
        | Sample y -> X
forall y. Sample y -> X
sx Sample y
cur X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< Sample y -> X
forall y. Sample y -> X
sx Sample y
prev = (Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just Sample y
prev, Maybe (Sample y)
forall a. Maybe a
Nothing)
        | Bool
otherwise = (Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just Sample y
cur, Sample y -> Maybe (Sample y)
forall a. a -> Maybe a
Just Sample y
cur)
    -- Abbreviate coincident samples.
    drop_coincident :: [Sample y] -> [Sample y]
drop_coincident (Sample X
x1 y
y1 : Sample y
_ : sn :: [Sample y]
sn@(Sample X
x2 y
_ : [Sample y]
_)) | X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 =
        [Sample y] -> [Sample y]
drop_coincident ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> a -> b
$ X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x1 y
y1 Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y]
sn
    drop_coincident (Sample y
s1:[Sample y]
sn) = Sample y
s1 Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y] -> [Sample y]
drop_coincident [Sample y]
sn
    drop_coincident [] = []

to_samples :: V.Vector v (Sample y) => SignalS v y -> [Sample y]
to_samples :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
sig =
    (if SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0 then [Sample y] -> [Sample y]
forall a. a -> a
id else (Sample y -> Sample y) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> [a] -> [b]
map (X -> Sample y -> Sample y
forall {y}. X -> Sample y -> Sample y
plus (SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig))) ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> a -> b
$
        v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)
    where
    plus :: X -> Sample y -> Sample y
plus X
n (Sample X
x y
y) = X -> y -> Sample y
forall y. X -> y -> Sample y
Sample (X
nX -> X -> X
forall a. Num a => a -> a -> a
+X
x) y
y
-- to_samples = V.toList . to_vector
-- TODO verify that TimeVector.map_x fuses with V.toList so there is no extra
-- vector.

to_samples_desc :: V.Vector v (Sample y) => SignalS v y -> [Sample y]
to_samples_desc :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples_desc (Signal X
offset v (Sample y)
vec) =
    (if X
offset X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0 then [Sample y] -> [Sample y]
forall a. a -> a
id else (Sample y -> Sample y) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> [a] -> [b]
map (X -> Sample y -> Sample y
forall {y}. X -> Sample y -> Sample y
plus X
offset)) ([Sample y] -> [Sample y]) -> [Sample y] -> [Sample y]
forall a b. (a -> b) -> a -> b
$
        v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Util.Vector.to_reverse_list v (Sample y)
vec
    where
    plus :: X -> Sample y -> Sample y
plus X
n (Sample X
x y
y) = X -> y -> Sample y
forall y. X -> y -> Sample y
Sample (X
nX -> X -> X
forall a. Num a => a -> a -> a
+X
x) y
y

from_pairs :: V.Vector v (Sample y) => [(X, y)] -> SignalS v y
from_pairs :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[(X, y)] -> SignalS v y
from_pairs = [Sample y] -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample y] -> SignalS v y)
-> ([(X, y)] -> [Sample y]) -> [(X, y)] -> SignalS v 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) => SignalS v y -> [(X, y)]
to_pairs :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v 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)
TimeVector.to_pair ([Sample y] -> [(X, y)])
-> (SignalS v y -> [Sample y]) -> SignalS v y -> [(X, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples

to_pairs_desc :: V.Vector v (Sample y) => SignalS v y -> [(X, y)]
to_pairs_desc :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [(X, y)]
to_pairs_desc = (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)
TimeVector.to_pair ([Sample y] -> [(X, y)])
-> (SignalS v y -> [Sample y]) -> SignalS v y -> [(X, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples_desc

from_segments :: V.Vector v (Sample y) => [Segment y] -> SignalS v y
from_segments :: forall (v :: * -> *) y.
Vector v (Sample y) =>
[Segment y] -> SignalS v y
from_segments = [Sample y] -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample y] -> SignalS v y)
-> ([Segment y] -> [Sample y]) -> [Segment y] -> SignalS v y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment y] -> [Sample y]
forall {y}. [Segment y] -> [Sample y]
to_list
    where
    to_list :: [Segment y] -> [Sample y]
to_list (Segment X
x1 y
y1 X
x2 y
y2 : [Segment y]
segments) =
        X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x1 y
y1 Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x2 y
y2 Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Segment y] -> [Sample y]
to_list [Segment y]
segments
    to_list [] = []

to_segments :: V.Vector v (Sample y) => SignalS v y -> [Segment y]
to_segments :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Segment y]
to_segments = [Sample y] -> [Segment y]
forall y. [Sample y] -> [Segment y]
samples_to_segments ([Sample y] -> [Segment y])
-> (SignalS v y -> [Sample y]) -> SignalS v y -> [Segment y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples

samples_to_segments :: [Sample y] -> [Segment y]
samples_to_segments :: forall y. [Sample y] -> [Segment y]
samples_to_segments = [Sample y] -> [Segment y]
forall y. [Sample y] -> [Segment y]
go
    where
    go :: [Sample y] -> [Segment y]
go [] = []
    go [Sample X
x y
y]
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
RealTime.large = [X -> y -> X -> y -> Segment y
forall y. X -> y -> X -> y -> Segment y
Segment X
x y
y X
RealTime.large y
y]
        | Bool
otherwise = []
    go (Sample X
x1 y
y1 : xs :: [Sample y]
xs@(Sample X
x2 y
y2 : [Sample y]
_))
        | X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 = [Sample y] -> [Segment y]
go [Sample y]
xs
        | Bool
otherwise = X -> y -> X -> y -> Segment y
forall y. X -> y -> X -> y -> Segment y
Segment X
x1 y
y1 X
x2 y
y2 Segment y -> [Segment y] -> [Segment y]
forall a. a -> [a] -> [a]
: [Sample y] -> [Segment y]
go [Sample y]
xs

-- | Simplify away redundant samples.
simplify :: (Eq x, Eq y) => [(x, y)] -> [(x, y)]
simplify :: forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)]
simplify ((x
x1, y
_) : xys :: [(x, y)]
xys@((x
x2, y
_) : [(x, y)]
_)) | x
x1 x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x2 = [(x, y)] -> [(x, y)]
forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)]
simplify [(x, y)]
xys
simplify [(x, y)]
xys = [(x, y)] -> [(x, y)]
forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)]
go [(x, y)]
xys
    where
    -- Drop samples in the middle of horizontal and vertical lines.
    go :: [(a, a)] -> [(a, a)]
go ((a
x1, a
y1) : (a
x2, a
y2) : xys :: [(a, a)]
xys@((a
x3, a
y3) : [(a, a)]
_))
        | a
y1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y2 Bool -> Bool -> Bool
&& a
y2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y3 = [(a, a)] -> [(a, a)]
go ((a
x1, a
y1) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
xys)
        | a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& a
x2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x3 = [(a, a)] -> [(a, a)]
go ((a
x1, a
y1) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
xys)
    -- Identical samples are always redundant.
    go ((a
x1, a
y1) : xys :: [(a, a)]
xys@((a
x2, a
y2) : [(a, a)]
_))
        | a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& a
y1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y2 = [(a, a)] -> [(a, a)]
go [(a, a)]
xys
    go [(a, a)]
xys = [(a, a)]
xys
{-# INLINEABLE simplify #-}
{-# SPECIALIZE simplify :: [(X, Y)] -> [(X, Y)] #-}

unfoldr :: V.Vector v (Sample y) => (state -> Maybe ((X, y), state)) -> state
    -> SignalS v y
unfoldr :: forall (v :: * -> *) y state.
Vector v (Sample y) =>
(state -> Maybe ((X, y), state)) -> state -> SignalS v y
unfoldr state -> Maybe ((X, y), state)
gen state
state = v (Sample y) -> Signal (v (Sample y))
forall v. v -> Signal v
from_vector (v (Sample y) -> Signal (v (Sample y)))
-> v (Sample y) -> Signal (v (Sample y))
forall a b. (a -> b) -> a -> b
$ (state -> Maybe ((X, y), state)) -> state -> v (Sample y)
forall (v :: * -> *) y state.
Vector v (Sample y) =>
(state -> Maybe ((X, y), state)) -> state -> v (Sample y)
TimeVector.unfoldr state -> Maybe ((X, y), state)
gen state
state

-- | Get a Ptr to the vector.  This is 'Vector.Storable.unsafeWith'.
with_ptr :: Foreign.Storable a =>
    Signal (Vector.Storable.Vector a) -> (X -> Foreign.Ptr a -> Int-> IO b)
    -> IO b
with_ptr :: forall a b.
Storable a =>
Signal (Vector a) -> (X -> Ptr a -> Int -> IO b) -> IO b
with_ptr (Signal X
offset Vector a
vec) X -> Ptr a -> Int -> IO b
action = Vector a -> (Ptr a -> Int -> IO b) -> IO b
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
TimeVector.with_ptr Vector a
vec (X -> Ptr a -> Int -> IO b
action X
offset)

-- * query

null :: V.Vector v (Sample y) => SignalS v y -> Bool
null :: forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
null = v (Sample y) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null (v (Sample y) -> Bool)
-> (SignalS v y -> v (Sample y)) -> SignalS v y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector

-- | The arguments may seem backwards, but I've always done it this way, and it
-- seems to be more convenient in practice.
at :: V.Vector v (Sample y) => Interpolate y -> X -> SignalS v y -> Maybe y
at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> Maybe y
at Interpolate y
interpolate X
x_ (Signal X
offset v (Sample y)
vec)
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe y
forall a. Maybe a
Nothing
    | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec = y -> Maybe y
forall a. a -> Maybe a
Just (Sample y -> y
forall y. Sample y -> y
sy (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 =
        y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> y -> Maybe y
forall a b. (a -> b) -> a -> b
$ Interpolate y
interpolate (v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i) (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)) X
x
    where
    i :: Int
i = X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
TimeVector.highest_index X
x v (Sample y)
vec
    x :: X
x = X
x_ X -> X -> X
forall a. Num a => a -> a -> a
- X
offset

-- | Like 'at', but if the x matches a discontinuity, take the value before
-- instead of after.
at_negative :: V.Vector v (Sample y) => Interpolate y -> X -> SignalS v y
    -> Maybe y
at_negative :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> Maybe y
at_negative Interpolate y
interpolate X
x SignalS v y
signal = do
    Segment X
x1 y
y1 X
x2 y
y2 <- Orientation -> X -> SignalS v y -> Maybe (Segment y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> SignalS v y -> Maybe (Segment y)
segment_at_orientation Orientation
Types.Negative X
x SignalS v y
signal
    y -> Maybe y
forall (m :: * -> *) a. Monad m => a -> m a
return (y -> Maybe y) -> y -> Maybe y
forall a b. (a -> b) -> a -> b
$ Interpolate y
interpolate (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x1 y
y1) (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x2 y
y2) X
x

segment_at :: V.Vector v (Sample y) => X -> SignalS v y -> Maybe (Segment y)
segment_at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> Maybe (Segment y)
segment_at  = Orientation -> X -> SignalS v y -> Maybe (Segment y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> SignalS v y -> Maybe (Segment y)
segment_at_orientation Orientation
Types.Positive

segment_at_orientation :: V.Vector v (Sample y) => Types.Orientation -> X
    -> SignalS v y -> Maybe (Segment y)
segment_at_orientation :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> SignalS v y -> Maybe (Segment y)
segment_at_orientation Orientation
orient X
x (Signal X
offset v (Sample y)
vec) =
    Segment y -> Segment y
forall {y}. Segment y -> Segment y
bump (Segment y -> Segment y)
-> ((Int, Segment y) -> Segment y) -> (Int, Segment y) -> Segment y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Segment y) -> Segment y
forall a b. (a, b) -> b
snd ((Int, Segment y) -> Segment y)
-> Maybe (Int, Segment y) -> Maybe (Segment y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Orientation -> X -> v (Sample y) -> Maybe (Int, Segment y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> v (Sample y) -> Maybe (Int, Segment y)
segment_at_v Orientation
orient (X
x X -> X -> X
forall a. Num a => a -> a -> a
- X
offset) v (Sample y)
vec
    where bump :: Segment y -> Segment y
bump (Segment X
x1 y
y1 X
x2 y
y2) = X -> y -> X -> y -> Segment y
forall y. X -> y -> X -> y -> Segment y
Segment (X
x1X -> X -> X
forall a. Num a => a -> a -> a
+X
offset) y
y1 (X
x2X -> X -> X
forall a. Num a => a -> a -> a
+X
offset) y
y2

segment_at_v :: V.Vector v (Sample y) => Types.Orientation -> X -> v (Sample y)
    -> Maybe (Int, Segment y)
segment_at_v :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> v (Sample y) -> Maybe (Int, Segment y)
segment_at_v Orientation
orient X
x v (Sample y)
vec
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (Int, Segment y)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let Sample X
x1 y
y1 = v (Sample y) -> Int -> Sample y
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i
            Sample X
x2 y
y2 = if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 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
                then X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
RealTime.large y
y1
                else 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)
        in (Int, Segment y) -> Maybe (Int, Segment y)
forall a. a -> Maybe a
Just (Int
i, X -> y -> X -> y -> Segment y
forall y. X -> y -> X -> y -> Segment y
Segment X
x1 y
y1 X
x2 y
y2)
    where
    i :: Int
i = X -> v (Sample y) -> Int
get X
x v (Sample y)
vec
    get :: X -> v (Sample y) -> Int
get = case Orientation
orient of
        Orientation
Types.Negative -> X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
TimeVector.index_below
        Orientation
Types.Positive -> X -> v (Sample y) -> Int
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
TimeVector.highest_index

head :: V.Vector v (Sample y) => SignalS v y -> Maybe (X, y)
head :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
head SignalS v y
sig = case v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig) of
    Maybe (Sample y)
Nothing -> Maybe (X, y)
forall a. Maybe a
Nothing
    Just (Sample X
x y
y) -> (X, y) -> Maybe (X, y)
forall a. a -> Maybe a
Just (SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig X -> X -> X
forall a. Num a => a -> a -> a
+ X
x, y
y)

last :: V.Vector v (Sample y) => SignalS v y -> Maybe (X, y)
last :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
last SignalS v y
sig = case v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig) of
    Maybe (Sample y)
Nothing -> Maybe (X, y)
forall a. Maybe a
Nothing
    Just (Sample X
x y
y) -> (X, y) -> Maybe (X, y)
forall a. a -> Maybe a
Just (SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig X -> X -> X
forall a. Num a => a -> a -> a
+ X
x, y
y)

minimum, maximum :: (V.Vector v (Sample a), Ord a) => SignalS v a -> Maybe a
minimum :: forall (v :: * -> *) a.
(Vector v (Sample a), Ord a) =>
SignalS v a -> Maybe a
minimum SignalS v a
sig
    | SignalS v a -> Bool
forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
null SignalS v a
sig = 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
$ Sample a -> a
forall y. Sample y -> y
sy (Sample a -> a) -> Sample a -> a
forall a b. (a -> b) -> a -> b
$ (Sample a -> Sample a -> Ordering) -> v (Sample a) -> Sample a
forall (v :: * -> *) a.
Vector v a =>
(a -> a -> Ordering) -> v a -> a
V.minimumBy (\Sample a
a Sample a
b -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Sample a -> a
forall y. Sample y -> y
sy Sample a
a) (Sample a -> a
forall y. Sample y -> y
sy Sample a
b)) (v (Sample a) -> Sample a) -> v (Sample a) -> Sample a
forall a b. (a -> b) -> a -> b
$
        SignalS v a -> v (Sample a)
forall v. Signal v -> v
_vector SignalS v a
sig
maximum :: forall (v :: * -> *) a.
(Vector v (Sample a), Ord a) =>
SignalS v a -> Maybe a
maximum SignalS v a
sig
    | SignalS v a -> Bool
forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
null SignalS v a
sig = 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
$ Sample a -> a
forall y. Sample y -> y
sy (Sample a -> a) -> Sample a -> a
forall a b. (a -> b) -> a -> b
$ (Sample a -> Sample a -> Ordering) -> v (Sample a) -> Sample a
forall (v :: * -> *) a.
Vector v a =>
(a -> a -> Ordering) -> v a -> a
V.maximumBy (\Sample a
a Sample a
b -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Sample a -> a
forall y. Sample y -> y
sy Sample a
a) (Sample a -> a
forall y. Sample y -> y
sy Sample a
b)) (v (Sample a) -> Sample a) -> v (Sample a) -> Sample a
forall a b. (a -> b) -> a -> b
$
        SignalS v a -> v (Sample a)
forall v. Signal v -> v
_vector SignalS v a
sig

find :: V.Vector v (Sample y) => (X -> y -> Bool) -> Signal (v (Sample y))
    -> Maybe (X, y)
find :: forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> y -> Bool) -> Signal (v (Sample y)) -> Maybe (X, y)
find X -> y -> Bool
f Signal (v (Sample y))
sig = (X -> X) -> (X, y) -> (X, y)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (X -> X -> X
forall a. Num a => a -> a -> a
+ Signal (v (Sample y)) -> X
forall v. Signal v -> X
_offset Signal (v (Sample y))
sig) ((X, y) -> (X, y)) -> (Sample y -> (X, y)) -> Sample y -> (X, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample y -> (X, y)
forall y. Sample y -> (X, y)
TimeVector.to_pair (Sample y -> (X, y)) -> Maybe (Sample y) -> Maybe (X, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Sample y -> Bool) -> v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Maybe a
V.find (\(Sample X
x y
y) -> X -> y -> Bool
f (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ Signal (v (Sample y)) -> X
forall v. Signal v -> X
_offset Signal (v (Sample y))
sig) y
y) (Signal (v (Sample y)) -> v (Sample y)
forall v. Signal v -> v
_vector Signal (v (Sample y))
sig)

-- * concat

-- | Concatenate signals, where signals to the right replace the ones to the
-- left where they overlap.
concat :: V.Vector v (Sample y) => Maybe (y -> y -> Bool)
    -- ^ signals with Eq y can drop some redundant samples
    -> Interpolate y -> [SignalS v y] -> SignalS v y
concat :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe (y -> y -> Bool)
-> Interpolate y -> [SignalS v y] -> SignalS v y
concat Maybe (y -> y -> Bool)
_ Interpolate y
_ [] = SignalS v y
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
concat Maybe (y -> y -> Bool)
_ Interpolate y
_ [SignalS v y
sig] = SignalS v y
sig
concat Maybe (y -> y -> Bool)
maybe_eq Interpolate y
interpolate [SignalS v y]
sigs =
    v (Sample y) -> SignalS v y
forall v. v -> Signal v
from_vector (v (Sample y) -> SignalS v y)
-> ([SignalS v y] -> v (Sample y)) -> [SignalS v y] -> SignalS v y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [v a] -> v a
V.concat ([v (Sample y)] -> v (Sample y))
-> ([SignalS v y] -> [v (Sample y)])
-> [SignalS v y]
-> v (Sample y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> [v (Sample y)]
try_strip_duplicates ([v (Sample y)] -> [v (Sample y)])
-> ([SignalS v y] -> [v (Sample y)])
-> [SignalS v y]
-> [v (Sample y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> [v (Sample y)]
forall a. [a] -> [a]
reverse ([v (Sample y)] -> [v (Sample y)])
-> ([SignalS v y] -> [v (Sample y)])
-> [SignalS v y]
-> [v (Sample y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> [v (Sample y)]
forall {v :: * -> *}.
Vector v (Sample y) =>
[v (Sample y)] -> [v (Sample y)]
chunks ([v (Sample y)] -> [v (Sample y)])
-> ([SignalS v y] -> [v (Sample y)])
-> [SignalS v y]
-> [v (Sample y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> [v (Sample y)]
forall a. [a] -> [a]
reverse
        ([v (Sample y)] -> [v (Sample y)])
-> ([SignalS v y] -> [v (Sample y)])
-> [SignalS v y]
-> [v (Sample y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignalS v y -> v (Sample y)) -> [SignalS v y] -> [v (Sample y)]
forall a b. (a -> b) -> [a] -> [b]
map SignalS v y -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector ([SignalS v y] -> SignalS v y) -> [SignalS v y] -> SignalS v y
forall a b. (a -> b) -> a -> b
$ [SignalS v y]
sigs
    where
    chunks :: [v (Sample y)] -> [v (Sample y)]
chunks [] = []
    chunks [v (Sample y)
v] = [v (Sample y)
v]
    -- head of v1 cuts of tail of v2
    -- v1:     |--->        |--->
    -- v2:   |--->        |->
    -- vs: |--->     => |->
    chunks (v (Sample y)
v1:v (Sample y)
v2:[v (Sample y)]
vs) = case Sample y -> X
forall y. Sample y -> X
sx (Sample y -> X) -> Maybe (Sample y) -> Maybe X
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head v (Sample y)
v1 of
        Maybe X
Nothing -> [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
v2v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
        Just X
x1 -> case v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample y)
clipped of
            Maybe (Sample y)
Nothing -> [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
v1v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
            Just Sample y
end
                | Sample y -> X
forall y. Sample y -> X
sx Sample y
end X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
x1 -> v (Sample y)
v1 v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: Sample y -> v (Sample y)
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
Sample y -> v (Sample y)
extension Sample y
end v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
clippedv (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
                | Bool
otherwise -> v (Sample y)
v1 v (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
: [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
clippedv (Sample y) -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
            where
            clipped :: v (Sample y)
clipped = Interpolate y -> X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> v (Sample y) -> v (Sample y)
clip_after_v Interpolate y
interpolate X
x1 v (Sample y)
v2
            extension :: Sample y -> v (Sample y)
extension Sample y
end = 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
x1 (Sample y -> y
forall y. Sample y -> y
sy Sample y
end))
    try_strip_duplicates :: [v (Sample y)] -> [v (Sample y)]
try_strip_duplicates = case Maybe (y -> y -> Bool)
maybe_eq of
        Maybe (y -> y -> Bool)
Nothing -> [v (Sample y)] -> [v (Sample y)]
forall a. a -> a
id
        Just y -> y -> Bool
eq -> (y -> y -> Bool) -> [v (Sample y)] -> [v (Sample y)]
forall {v :: * -> *} {t}.
Vector v (Sample t) =>
(t -> t -> Bool) -> [v (Sample t)] -> [v (Sample t)]
strip_duplicates y -> y -> Bool
eq
    -- If I have Eq, I can strip redundant Y values.
    strip_duplicates :: (t -> t -> Bool) -> [v (Sample t)] -> [v (Sample t)]
strip_duplicates t -> t -> Bool
eq (v (Sample t)
v1 : v (Sample t)
v2 : [v (Sample t)]
vs)
        | Just (Sample X
x1 t
y1) <- v (Sample t) -> Maybe (Sample t)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample t)
v1
        , Just (Sample X
x2 t
y2) <- v (Sample t) -> Maybe (Sample t)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head v (Sample t)
v2
        , X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 Bool -> Bool -> Bool
&& t -> t -> Bool
eq t
y1 t
y2 =
            v (Sample t)
v1 v (Sample t) -> [v (Sample t)] -> [v (Sample t)]
forall a. a -> [a] -> [a]
: (t -> t -> Bool) -> [v (Sample t)] -> [v (Sample t)]
strip_duplicates t -> t -> Bool
eq (Int -> v (Sample t) -> v (Sample t)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1 v (Sample t)
v2 v (Sample t) -> [v (Sample t)] -> [v (Sample t)]
forall a. a -> [a] -> [a]
: [v (Sample t)]
vs)
    strip_duplicates t -> t -> Bool
eq (v (Sample t)
v1 : [v (Sample t)]
vs) = v (Sample t)
v1 v (Sample t) -> [v (Sample t)] -> [v (Sample t)]
forall a. a -> [a] -> [a]
: (t -> t -> Bool) -> [v (Sample t)] -> [v (Sample t)]
strip_duplicates t -> t -> Bool
eq [v (Sample t)]
vs
    strip_duplicates t -> t -> Bool
_ [] = []

-- | With 'concat', each signal start clips the signal to its left.  This is
-- the other way around, the final sample in the first signal is taken as its
-- end, and it replaces the start of the second signal.
prepend :: V.Vector v (Sample y) => Maybe (y -> y -> Bool) -> Interpolate y
    -> SignalS v y -> SignalS v y -> SignalS v y
prepend :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe (y -> y -> Bool)
-> Interpolate y -> SignalS v y -> SignalS v y -> SignalS v y
prepend Maybe (y -> y -> Bool)
eq Interpolate y
interpolate SignalS v y
sig1 SignalS v y
sig2 = case SignalS v y -> Maybe (X, y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
last SignalS v y
sig1 of
    Maybe (X, y)
Nothing -> SignalS v y
sig2
    Just (X
x, y
_) -> Maybe (y -> y -> Bool)
-> Interpolate y -> [SignalS v y] -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe (y -> y -> Bool)
-> Interpolate y -> [SignalS v y] -> SignalS v y
concat Maybe (y -> y -> Bool)
eq Interpolate y
interpolate [SignalS v y
sig1, Interpolate y -> X -> SignalS v y -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> SignalS v y
clip_before Interpolate y
interpolate X
x SignalS v y
sig2]

-- * slice

-- | Drop the segments after the given time.  The last segment may overlap it.
drop_after :: V.Vector v (Sample y) => X -> SignalS v y -> SignalS v y
drop_after :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> SignalS v y
drop_after X
x SignalS v y
sig
    | v (Sample y) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
v = SignalS v y
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig, _vector :: v (Sample y)
_vector = v (Sample y)
v }
    where v :: v (Sample y)
v = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after_v (X
x X -> X -> X
forall a. Num a => a -> a -> a
- SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig) (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)

drop_after_v :: V.Vector v (Sample y) => X -> v (Sample y) -> v (Sample y)
drop_after_v :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after_v 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
    Maybe (Sample y)
Nothing -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
    Just (Sample X
x1 y
_) -> Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (if X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x then Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) 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
TimeVector.index_below X
x v (Sample y)
vec

-- | This is like 'drop_after', but meant to clip the signal directly on x,
-- rather than at the first sample >=x.  This means I might have to insert a
-- new sample, which means copying the signal.  This is intended to be a "drop
-- at and after", but since signals extend infinitely to the right, I can only
-- go up to x.  TODO maybe signals should go to Nothing >= the last sample?
--
-- If the signal has only a point exactly at x, then return the empty signal.
-- This is because the first sample is effectively a transition from Nothing,
-- or 0.
clip_after :: V.Vector v (Sample y) => Interpolate y -> X -> SignalS v y
    -> SignalS v y
clip_after :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> SignalS v y
clip_after Interpolate y
interpolate X
x SignalS v y
sig
    | v (Sample y) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
v = SignalS v y
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig, _vector :: v (Sample y)
_vector = v (Sample y)
v }
    where v :: v (Sample y)
v = Interpolate y -> X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> v (Sample y) -> v (Sample y)
clip_after_v Interpolate y
interpolate (X
x X -> X -> X
forall a. Num a => a -> a -> a
- SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig) (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)

clip_after_v :: V.Vector v (Sample y) => Interpolate y -> X
    -> v (Sample y) -> v (Sample y)
clip_after_v :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> v (Sample y) -> v (Sample y)
clip_after_v Interpolate y
interpolate X
x v (Sample y)
vec
    | [Sample X
x0 y
_] <- v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList v (Sample y)
clipped, X
x0 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x = v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
    | Bool
otherwise = case v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample y)
clipped of
        Maybe (Sample y)
Nothing -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
        Just (Sample X
x2 y
_)
            | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
x2, Just y
y <- Interpolate y -> X -> SignalS v y -> Maybe y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> Maybe y
at Interpolate y
interpolate X
x (v (Sample y) -> SignalS v y
forall v. v -> Signal v
from_vector v (Sample y)
vec) ->
                v (Sample y) -> Sample y -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> a -> v a
V.snoc (Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (v (Sample y) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
clipped Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) v (Sample y)
clipped) (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x y
y)
            | Bool
otherwise -> v (Sample y)
clipped
    where clipped :: v (Sample y)
clipped = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after_v X
x v (Sample y)
vec

num_clip_after :: Bool -> X -> NumSignal -> NumSignal
num_clip_after :: Bool -> X -> NumSignal -> NumSignal
num_clip_after Bool
keep_last X
x NumSignal
sig
    | Vector (Sample Double) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null Vector (Sample Double)
clipped = NumSignal
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | [Sample X
x0 Double
_] <- Vector (Sample Double) -> [Sample Double]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList Vector (Sample Double)
clipped, X
x0 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x = NumSignal
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = NumSignal -> X
forall v. Signal v -> X
_offset NumSignal
sig, _vector :: Vector (Sample Double)
_vector = Vector (Sample Double)
clipped }
    where clipped :: Vector (Sample Double)
clipped = Bool -> X -> Vector (Sample Double) -> Vector (Sample Double)
num_clip_after_v Bool
keep_last (X
x X -> X -> X
forall a. Num a => a -> a -> a
- NumSignal -> X
forall v. Signal v -> X
_offset NumSignal
sig) (NumSignal -> Vector (Sample Double)
forall v. Signal v -> v
_vector NumSignal
sig)

-- | 'clip_after' specialized for 'Y'.  Since it has Eq, it can do an
-- additional optimization.
num_clip_after_v :: Bool -- ^ if False, inhibit the optimization that omits
    -- the end sample if it's a flat line
    -> X -> TimeVector.Unboxed -> TimeVector.Unboxed
num_clip_after_v :: Bool -> X -> Vector (Sample Double) -> Vector (Sample Double)
num_clip_after_v Bool
keep_last X
x Vector (Sample Double)
vec = case Orientation
-> X -> Vector (Sample Double) -> Maybe (Int, Segment Double)
forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> v (Sample y) -> Maybe (Int, Segment y)
segment_at_v Orientation
Types.Negative X
x Vector (Sample Double)
vec of
    Maybe (Int, Segment Double)
Nothing -> Vector (Sample Double)
vec
    Just (Int
i, Segment X
x1 Double
y1 X
x2 Double
y2)
        | Bool -> Bool
not Bool
keep_last Bool -> Bool -> Bool
&& Double
y1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y2 -> Vector (Sample Double)
prefix
        | Bool
otherwise -> Vector (Sample Double) -> Sample Double -> Vector (Sample Double)
forall (v :: * -> *) a. Vector v a => v a -> a -> v a
V.snoc Vector (Sample Double)
prefix (X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x (Stack => X -> Double -> X -> Double -> X -> Double
X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2 X
x))
        where prefix :: Vector (Sample Double)
prefix = Int -> Vector (Sample Double) -> Vector (Sample Double)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector (Sample Double)
vec

-- | Drop the segments before the given time.  The first segment will start at
-- or before the given time.
drop_before :: V.Vector v (Sample y) => X -> SignalS v y -> SignalS v y
drop_before :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> SignalS v y
drop_before X
x SignalS v y
sig
    | v (Sample y) -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
clipped = SignalS v y
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig, _vector :: v (Sample y)
_vector = v (Sample y)
clipped }
    where clipped :: v (Sample y)
clipped = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_before (X
x X -> X -> X
forall a. Num a => a -> a -> a
- SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig) (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)

-- | Like 'drop_before', but ensure that the signal starts exactly at the given
-- time by splitting a segment that crosses it.
clip_before :: V.Vector v (Sample y) => Interpolate y -> X -> SignalS v y
    -> SignalS v y
clip_before :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> SignalS v y
clip_before Interpolate y
interpolate X
x SignalS v y
sig = case SignalS v y -> Maybe (X, y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
head SignalS v y
clipped of
    Maybe (X, y)
Nothing -> SignalS v y
forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    Just (X
x1, y
_)
        | X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
x, Just y
y <- Interpolate y -> X -> SignalS v y -> Maybe y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> Maybe y
at Interpolate y
interpolate X
x SignalS v y
sig ->
            v (Sample y) -> SignalS v y
forall v. v -> Signal v
from_vector (v (Sample y) -> SignalS v y) -> v (Sample y) -> SignalS v y
forall a b. (a -> b) -> a -> b
$ Sample y -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => a -> v a -> v a
V.cons (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x y
y) (Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1 (SignalS v y -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector SignalS v y
clipped))
        | Bool
otherwise -> SignalS v y
clipped
    where clipped :: SignalS v y
clipped = X -> SignalS v y -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> SignalS v y
drop_before X
x SignalS v y
sig

-- TODO is this the same as 'to_samples . clip_before'?
clip_before_samples :: V.Vector v (Sample y) => Interpolate y -> X
    -> SignalS v y -> [Sample y]
clip_before_samples :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> [Sample y]
clip_before_samples Interpolate y
interpolate X
x SignalS v y
sig = case SignalS v y -> Maybe (X, y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
head SignalS v y
clipped of
    Maybe (X, y)
Nothing -> []
    Just (X
x1, y
_)
        | X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
x, Just y
y <- Interpolate y -> X -> SignalS v y -> Maybe y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> SignalS v y -> Maybe y
at Interpolate y
interpolate X
x SignalS v y
sig ->
            X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x y
y Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples ((v (Sample y) -> v (Sample y)) -> SignalS v y -> SignalS v y
forall a b. (a -> b) -> Signal a -> Signal b
modify_vector (Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1) SignalS v y
clipped)
        | Bool
otherwise -> SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
clipped

    where clipped :: SignalS v y
clipped = X -> SignalS v y -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> SignalS v y
drop_before X
x SignalS v y
sig

-- * transform

-- | Shift the signal in time.
shift :: X -> Signal v -> Signal v
shift :: forall v. X -> Signal v -> Signal v
shift X
offset Signal v
sig = Signal v
sig { _offset :: X
_offset = Signal v -> X
forall v. Signal v -> X
_offset Signal v
sig X -> X -> X
forall a. Num a => a -> a -> a
+ X
offset }

-- | Apply the _offset, and set it to 0.  Just for tests.
_flatten_shift :: V.Vector v (Sample y) => SignalS v y -> SignalS v y
_flatten_shift :: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> SignalS v y
_flatten_shift = v (Sample y) -> Signal (v (Sample y))
forall v. v -> Signal v
from_vector (v (Sample y) -> Signal (v (Sample y)))
-> (Signal (v (Sample y)) -> v (Sample y))
-> Signal (v (Sample y))
-> Signal (v (Sample y))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal (v (Sample y)) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector

-- | Map Ys.  This resamples the signal, so it's valid for a nonlinear
-- function.
map_y :: X -> (Y -> Y) -> NumSignal -> NumSignal
map_y :: X -> (Double -> Double) -> NumSignal -> NumSignal
map_y X
srate Double -> Double
f =
    Vector (Sample Double) -> NumSignal
forall v. v -> Signal v
from_vector (Vector (Sample Double) -> NumSignal)
-> (NumSignal -> Vector (Sample Double)) -> NumSignal -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double)
-> Vector (Sample Double) -> Vector (Sample Double)
forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
TimeVector.map_y Double -> Double
f (Vector (Sample Double) -> Vector (Sample Double))
-> (NumSignal -> Vector (Sample Double))
-> NumSignal
-> Vector (Sample Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> Vector (Sample Double)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector (NumSignal -> Vector (Sample Double))
-> (NumSignal -> NumSignal) -> NumSignal -> Vector (Sample Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> NumSignal -> NumSignal
resample_rate X
srate

-- | Map Ys.  Only valid if the function is linear.
map_y_linear :: V.Vector v (Sample y) => (y -> y) -> SignalS v y -> SignalS v y
map_y_linear :: forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> SignalS v y -> SignalS v y
map_y_linear y -> y
f = (v (Sample y) -> v (Sample y))
-> Signal (v (Sample y)) -> Signal (v (Sample y))
forall a b. (a -> b) -> Signal a -> Signal b
modify_vector ((v (Sample y) -> v (Sample y))
 -> Signal (v (Sample y)) -> Signal (v (Sample y)))
-> (v (Sample y) -> v (Sample y))
-> Signal (v (Sample y))
-> Signal (v (Sample y))
forall a b. (a -> b) -> a -> b
$ (y -> y) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
TimeVector.map_y y -> y
f

-- | Map Xs.  The slopes will definitely change unless the function is adding
-- a constant, but presumably that's what you want.
--
-- TODO this can break 'Signal' invariants.
map_x :: V.Vector v (Sample y) => (X -> X) -> SignalS v y -> SignalS v y
map_x :: forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> X) -> SignalS v y -> SignalS v y
map_x X -> X
f = (v (Sample y) -> v (Sample y))
-> Signal (v (Sample y)) -> Signal (v (Sample y))
forall a b. (a -> b) -> Signal a -> Signal b
modify_vector ((v (Sample y) -> v (Sample y))
 -> Signal (v (Sample y)) -> Signal (v (Sample y)))
-> (v (Sample y) -> v (Sample y))
-> Signal (v (Sample y))
-> Signal (v (Sample y))
forall a b. (a -> b) -> a -> b
$ (X -> X) -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> X) -> v (Sample y) -> v (Sample y)
TimeVector.map_x X -> X
f

transform_samples :: V.Vector v (Sample y) => ([Sample y] -> [Sample y])
    -> SignalS v y -> SignalS v y
transform_samples :: forall (v :: * -> *) y.
Vector v (Sample y) =>
([Sample y] -> [Sample y]) -> SignalS v y -> SignalS v y
transform_samples [Sample y] -> [Sample y]
f = [Sample y] -> SignalS v y
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample y] -> SignalS v y)
-> (SignalS v y -> [Sample y]) -> SignalS v y -> SignalS v y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample y] -> [Sample y]
f ([Sample y] -> [Sample y])
-> (SignalS v y -> [Sample y]) -> SignalS v y -> [Sample y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples

map_err :: V.Vector v (Sample y) => (Sample y -> Either err (Sample y))
    -> SignalS v y -> (SignalS v y, [err])
map_err :: forall (v :: * -> *) y err.
Vector v (Sample y) =>
(Sample y -> Either err (Sample y))
-> SignalS v y -> (SignalS v y, [err])
map_err Sample y -> Either err (Sample y)
f = (v (Sample y) -> SignalS v y)
-> (v (Sample y), [err]) -> (SignalS v y, [err])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first v (Sample y) -> SignalS v y
forall v. v -> Signal v
from_vector ((v (Sample y), [err]) -> (SignalS v y, [err]))
-> (SignalS v y -> (v (Sample y), [err]))
-> SignalS v y
-> (SignalS v y, [err])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sample y -> Either err (Sample y))
-> v (Sample y) -> (v (Sample y), [err])
forall (v :: * -> *) a err.
Vector v a =>
(a -> Either err a) -> v a -> (v a, [err])
TimeVector.map_err Sample y -> Either err (Sample y)
f (v (Sample y) -> (v (Sample y), [err]))
-> (SignalS v y -> v (Sample y))
-> SignalS v y
-> (v (Sample y), [err])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalS v y -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector

-- ** hacks

-- | Drop a x1==x2 discontinuity at the given time, if there is one.
-- Used for Block.trim_controls, which is a terrible hack that I'm trying to
-- get rid of.
drop_discontinuity_at :: V.Vector v (Sample y) => X -> SignalS v y
    -> SignalS v y
drop_discontinuity_at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> SignalS v y -> SignalS v y
drop_discontinuity_at X
x SignalS v y
sig = case v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList v (Sample y)
clipped of
    Sample X
x1 y
_ : Sample X
x2 y
_ : [Sample y]
_ | X
x X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x1 Bool -> Bool -> Bool
&& X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 ->
        v (Sample y) -> SignalS v y
forall v. v -> Signal v
from_vector (v (Sample y) -> SignalS v y) -> v (Sample y) -> SignalS v y
forall a b. (a -> b) -> a -> b
$ [v (Sample y)] -> v (Sample y)
forall (v :: * -> *) a. Vector v a => [v a] -> v a
V.concat
            [ v (Sample y)
pre
            -- Insert an extra sample to avoid changing the slope.
            , case (v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample y)
pre, v (Sample y) -> Maybe (Sample y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head v (Sample y)
post) of
                (Just (Sample X
_ y
y), Just (Sample X
x 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
x y
y)
                (Maybe (Sample y), Maybe (Sample y))
_ -> v (Sample y)
forall (v :: * -> *) a. Vector v a => v a
V.empty
            , v (Sample y) -> v (Sample y)
forall {v :: * -> *} {y}.
Vector v (Sample y) =>
v (Sample y) -> v (Sample y)
drop1 v (Sample y)
post
            ]
            where
            pre :: v (Sample y)
pre = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_at_after X
x v (Sample y)
vector
            post :: v (Sample y)
post = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_before_at X
x v (Sample y)
vector
    [Sample y]
_ -> SignalS v y
sig
    where
    vector :: v (Sample y)
vector = SignalS v y -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector SignalS v y
sig
    clipped :: v (Sample y)
clipped = X -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_before_strict (X
x X -> X -> X
forall a. Num a => a -> a -> a
- SignalS v y -> X
forall v. Signal v -> X
_offset SignalS v y
sig) (SignalS v y -> v (Sample y)
forall v. Signal v -> v
_vector SignalS v y
sig)
    -- Drop an extra x to avoid >2 samples in the same spot.
    drop1 :: v (Sample y) -> v (Sample y)
drop1 v (Sample y)
v = case v (Sample y) -> [Sample y]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList v (Sample y)
v of
        Sample X
x1 y
_ : Sample X
x2 y
_ : [Sample y]
_ | X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 -> Int -> v (Sample y) -> v (Sample y)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1 v (Sample y)
v
        [Sample y]
_ -> v (Sample y)
v

-- * Boxed

type Boxed y = Signal (TimeVector.Boxed y)

-- * NumSignal

type NumSignal = Signal TimeVector.Unboxed
type Y = TimeVector.UnboxedY

num_interpolate :: Interpolate Y
num_interpolate :: Interpolate Double
num_interpolate (Sample X
x1 Double
y1) (Sample X
x2 Double
y2) = Stack => X -> Double -> X -> Double -> X -> Double
X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2

num_interpolate_s :: Segment Y -> X -> Y
num_interpolate_s :: Segment Double -> X -> Double
num_interpolate_s (Segment X
x1 Double
y1 X
x2 Double
y2) = Stack => X -> Double -> X -> Double -> X -> Double
X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2

-- | Swap X and Y.  Y must be non-decreasing or this will break 'Signal'
-- invariants.
invert :: NumSignal -> NumSignal
invert :: NumSignal -> NumSignal
invert NumSignal
sig = X -> Vector (Sample Double) -> NumSignal
forall v. X -> v -> Signal v
Signal X
0 ((Sample Double -> Sample Double)
-> Vector (Sample Double) -> Vector (Sample Double)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
V.map Sample Double -> Sample Double
swap (NumSignal -> Vector (Sample Double)
forall v. Signal v -> v
_vector NumSignal
sig))
    where
    swap :: Sample Double -> Sample Double
swap (Sample X
x Double
y) =
        X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample (Double -> X
RealTime.seconds Double
y) (X -> Double
RealTime.to_seconds (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ NumSignal -> X
forall v. Signal v -> X
_offset NumSignal
sig))

-- | Integrate the signal.
--
-- Since the output will have more samples than the input, this needs
-- a sampling rate.  The sampling rate determines the resolution of the tempo
-- track.  So it can probably be fairly low resolution before having
-- a noticeable impact.
integrate :: X -> NumSignal -> NumSignal
integrate :: X -> NumSignal -> NumSignal
integrate X
srate_x =
    [Sample Double] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample Double] -> NumSignal)
-> (NumSignal -> [Sample Double]) -> NumSignal -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Sample Double]] -> [Sample Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[Sample Double]] -> [Sample Double])
-> (NumSignal -> [[Sample Double]]) -> NumSignal -> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, [[Sample Double]]) -> [[Sample Double]]
forall a b. (a, b) -> b
snd
        ((Double, [[Sample Double]]) -> [[Sample Double]])
-> (NumSignal -> (Double, [[Sample Double]]))
-> NumSignal
-> [[Sample Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
 -> (Double, Double, Double, Double) -> (Double, [Sample Double]))
-> Double
-> [(Double, Double, Double, Double)]
-> (Double, [[Sample Double]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL Double
-> (Double, Double, Double, Double) -> (Double, [Sample Double])
segment Double
0 ([(Double, Double, Double, Double)] -> (Double, [[Sample Double]]))
-> (NumSignal -> [(Double, Double, Double, Double)])
-> NumSignal
-> (Double, [[Sample Double]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Double -> (Double, Double, Double, Double))
-> [Segment Double] -> [(Double, Double, Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map Segment Double -> (Double, Double, Double, Double)
forall {d}. Segment d -> (Double, d, Double, d)
to_double ([Segment Double] -> [(Double, Double, Double, Double)])
-> (NumSignal -> [Segment Double])
-> NumSignal
-> [(Double, Double, Double, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [Segment Double]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Segment y]
to_segments
    where
    -- Integral of nx + k = nx^2 / 2 + kx
    to_double :: Segment d -> (Double, d, Double, d)
to_double (Segment X
x1 d
y1 X
x2 d
y2) = (X -> Double
s X
x1, d
y1, X -> Double
s X
x2, d
y2)
        where s :: X -> Double
s = X -> Double
RealTime.to_seconds
    to_sample :: Double -> y -> Sample y
to_sample Double
x y
y = X -> y -> Sample y
forall y. X -> y -> Sample y
Sample (Double -> X
RealTime.seconds Double
x) y
y
    segment :: Double
-> (Double, Double, Double, Double) -> (Double, [Sample Double])
segment Double
accum (Double
x1, Double
y1, Double
x2, Double
y2) =
        ( Double -> Double
f (Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1)
        , if Double
y1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y2
            then [Double -> Double -> Sample Double
forall {y}. Double -> y -> Sample y
to_sample Double
x1 (Double -> Double
f Double
0), Double -> Double -> Sample Double
forall {y}. Double -> y -> Sample y
to_sample Double
x2 (Double -> Double
f (Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1))]
            else [Double -> Double -> Sample Double
forall {y}. Double -> y -> Sample y
to_sample Double
x (Double -> Double
f (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1)) | Double
x <- Double -> Double -> Double -> [Double]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range' Double
x1 Double
x2 (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
srate)]
        )
        where
        f :: Double -> Double
f Double
x = Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xDouble -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
accum
        n :: Double
n = (Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1)
    srate :: Double
srate = X -> Double
RealTime.to_seconds X
srate_x

-- * resample

-- | Combine two vectors with the given function.  The signals are resampled
-- to have coincident samples, assuming linear interpolation.  This only works
-- for linear functions, so the result can also be represented with linear
-- segments.
linear_operator :: (Y -> Y -> Y) -> NumSignal -> NumSignal -> NumSignal
linear_operator :: (Double -> Double -> Double) -> NumSignal -> NumSignal -> NumSignal
linear_operator Double -> Double -> Double
merge NumSignal
asig NumSignal
bsig =
    [Sample Double] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample Double] -> NumSignal) -> [Sample Double] -> NumSignal
forall a b. (a -> b) -> a -> b
$ (X -> Double -> Double -> Sample Double)
-> [X] -> [Double] -> [Double] -> [Sample Double]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 X -> Double -> Double -> Sample Double
make (() -> [X]
get_xs ()) [Double]
as2 [Double]
bs2
    where
    make :: X -> Double -> Double -> Sample Double
make X
x Double
ay Double
by = X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x (Double -> Double -> Double
merge Double
ay Double
by)
    as2 :: [Double]
as2 = [X] -> [Sample Double] -> [Double]
resample_num (() -> [X]
get_xs ()) [Sample Double]
as
    bs2 :: [Double]
bs2 = [X] -> [Sample Double] -> [Double]
resample_num (() -> [X]
get_xs ()) [Sample Double]
bs
    ([Sample Double]
as, [Sample Double]
bs) = Double
-> NumSignal -> NumSignal -> ([Sample Double], [Sample Double])
forall (v :: * -> *) y.
Vector v (Sample y) =>
y -> SignalS v y -> SignalS v y -> ([Sample y], [Sample y])
to_samples2 Double
0 NumSignal
asig NumSignal
bsig
    -- The () is to prevent memoization, which should hopefully allow the
    -- intermediate list to fuse away.  Or maybe I should try to use vectors
    -- instead of lists?
    -- TODO profile
    get_xs :: () -> [X]
get_xs () = [X] -> [X] -> [X]
sample_xs2 ((Sample Double -> X) -> [Sample Double] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map Sample Double -> X
forall y. Sample y -> X
sx [Sample Double]
as) ((Sample Double -> X) -> [Sample Double] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map Sample Double -> X
forall y. Sample y -> X
sx [Sample Double]
bs)

resample_num :: [X] -> [Sample Y] -> [Y]
resample_num :: [X] -> [Sample Double] -> [Double]
resample_num = Double -> Interpolate Double -> [X] -> [Sample Double] -> [Double]
forall y. y -> Interpolate y -> [X] -> [Sample y] -> [y]
resample Double
0 Interpolate Double
num_interpolate

-- | Like 'to_samples', except the signal that starts later gets an extra
-- sample to transition from zero.
to_samples2 :: V.Vector v (Sample y) => y -> SignalS v y -> SignalS v y
    -> ([Sample y], [Sample y])
to_samples2 :: forall (v :: * -> *) y.
Vector v (Sample y) =>
y -> SignalS v y -> SignalS v y -> ([Sample y], [Sample y])
to_samples2 y
zero SignalS v y
asig SignalS v y
bsig = case (SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
asig, SignalS v y -> [Sample y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
bsig) of
    (as :: [Sample y]
as@(Sample X
ax y
_ : [Sample y]
_), bs :: [Sample y]
bs@(Sample X
bx y
_ : [Sample y]
_))
        | X
ax X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
bx -> ([Sample y]
as, X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
bx y
zero Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y]
bs)
        | X
bx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
ax -> (X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
ax y
zero Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y]
as, [Sample y]
bs)
    ([Sample y]
as, [Sample y]
bs) -> ([Sample y]
as, [Sample y]
bs)

-- | The output has the union of the Xs in the inputs, except where they match
-- exactly.  Discontinuities should get two Xs.
sample_xs2 :: [X] -> [X] -> [X]
sample_xs2 :: [X] -> [X] -> [X]
sample_xs2 = [X] -> [X] -> [X]
forall {a}. Ord a => [a] -> [a] -> [a]
go
    where
    go :: [a] -> [a] -> [a]
go [] [a]
bs = [a]
bs
    go [a]
as [] = [a]
as
    go (a
a:[a]
as) (a
b:[a]
bs)
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
as [a]
bs
        | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
as (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)
        | Bool
otherwise = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) [a]
bs

-- ** polymorphic implementation

-- | This should be the same as 'linear_operator', except using the
-- variable length functions.  I could replace linear_operator with this, but
-- I worry that it's less efficient.
_linear_operator2 :: ([Y] -> Y) -> NumSignal -> NumSignal -> NumSignal
_linear_operator2 :: ([Double] -> Double) -> NumSignal -> NumSignal -> NumSignal
_linear_operator2 [Double] -> Double
merge NumSignal
asig NumSignal
bsig =
    -- Seq.rotate zips up the samples from each signal.
    [Sample Double] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample Double] -> NumSignal) -> [Sample Double] -> NumSignal
forall a b. (a -> b) -> a -> b
$ (X -> [Double] -> Sample Double)
-> [X] -> [[Double]] -> [Sample Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith X -> [Double] -> Sample Double
make [X]
xs ([[Double]] -> [Sample Double]) -> [[Double]] -> [Sample Double]
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
Seq.rotate ([[Double]] -> [[Double]]) -> [[Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ ([Sample Double] -> [Double]) -> [[Sample Double]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ([X] -> [Sample Double] -> [Double]
resample_num [X]
xs) [[Sample Double]]
samples
    where
    make :: X -> [Double] -> Sample Double
make X
x [Double]
ys = X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x ([Double] -> Double
merge [Double]
ys)
    xs :: [X]
xs = [[X]] -> [X]
sample_xs ([[X]] -> [X]) -> [[X]] -> [X]
forall a b. (a -> b) -> a -> b
$ ([Sample Double] -> [X]) -> [[Sample Double]] -> [[X]]
forall a b. (a -> b) -> [a] -> [b]
map ((Sample Double -> X) -> [Sample Double] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map Sample Double -> X
forall y. Sample y -> X
sx) [[Sample Double]]
samples
    samples :: [[Sample Double]]
samples = (NumSignal -> [Sample Double]) -> [NumSignal] -> [[Sample Double]]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> [Sample Double] -> [Sample Double]
forall y. y -> [Sample y] -> [Sample y]
add_zero_transition Double
0 ([Sample Double] -> [Sample Double])
-> (NumSignal -> [Sample Double]) -> NumSignal -> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [Sample Double]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples) [NumSignal
asig, NumSignal
bsig]

resample :: y -> Interpolate y -> [X] -> [Sample y] -> [y]
resample :: forall y. y -> Interpolate y -> [X] -> [Sample y] -> [y]
resample = (y -> y) -> y -> Interpolate y -> [X] -> [Sample y] -> [y]
forall y1 y2.
(y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ y -> y
forall a. a -> a
id

-- | This is the same as 'resample', only for ys without a zero.
resample_maybe :: Interpolate y -> [X] -> [Sample y] -> [Maybe y]
resample_maybe :: forall y. Interpolate y -> [X] -> [Sample y] -> [Maybe y]
resample_maybe = (y -> Maybe y)
-> Maybe y -> Interpolate y -> [X] -> [Sample y] -> [Maybe y]
forall y1 y2.
(y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ y -> Maybe y
forall a. a -> Maybe a
Just Maybe y
forall a. Maybe a
Nothing

{-# INLINE resample_ #-}
resample_ :: (y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ :: forall y1 y2.
(y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ y1 -> y2
present y2
absent Interpolate y1
interpolate [X]
xs [Sample y1]
samples =
    ([Sample y1], [y2]) -> [y2]
forall a b. (a, b) -> b
snd (([Sample y1], [y2]) -> [y2]) -> ([Sample y1], [y2]) -> [y2]
forall a b. (a -> b) -> a -> b
$ ([Sample y1] -> X -> ([Sample y1], y2))
-> [Sample y1] -> [X] -> ([Sample y1], [y2])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL [Sample y1] -> X -> ([Sample y1], y2)
get [Sample y1]
samples [X]
xs
    where
    get :: [Sample y1] -> X -> ([Sample y1], y2)
get ss :: [Sample y1]
ss@(Sample X
x1 y1
y1 : s2s :: [Sample y1]
s2s@(Sample X
x2 y1
y2 : [Sample y1]
_)) X
x
        -- If it's a discontinuity, I want to consume the sample, or I won't
        -- see the after Y.  Each discontinuity should have 2 Xs, one for
        -- before and one for after.  This is brittle and depends on
        -- 'sample_xs2' emitting two Xs for a discontinuity and 'to_samples2'
        -- adding a "from zero" discontinuity to the first sample.  But
        -- otherwise I'd have to recognize a discontinuity here and emit one,
        -- which means this would have to be concatMap, which seems
        -- inefficient.  Of course maybe the whole thing is already so
        -- inefficient it doesn't matter.
        | X
x X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x1 = if X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 then ([Sample y1]
s2s, y1 -> y2
present y1
y1) else ([Sample y1]
ss, y1 -> y2
present y1
y1)
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x2 = [Sample y1] -> X -> ([Sample y1], y2)
get [Sample y1]
s2s X
x
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
x1 = ([Sample y1]
ss, y1 -> y2
present (y1 -> y2) -> y1 -> y2
forall a b. (a -> b) -> a -> b
$ Interpolate y1
interpolate (X -> y1 -> Sample y1
forall y. X -> y -> Sample y
Sample X
x1 y1
y1) (X -> y1 -> Sample y1
forall y. X -> y -> Sample y
Sample X
x2 y1
y2) X
x)
        | Bool
otherwise = ([Sample y1]
ss, y2
absent)
    get ss :: [Sample y1]
ss@[Sample X
x1 y1
y1] X
x
        | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x1 = ([Sample y1]
ss, y1 -> y2
present y1
y1)
        | Bool
otherwise = ([Sample y1]
ss, y2
absent)
    get [] X
_ = ([], y2
absent)

add_zero_transition :: y -> [Sample y] -> [Sample y]
add_zero_transition :: forall y. y -> [Sample y] -> [Sample y]
add_zero_transition y
zero ss :: [Sample y]
ss@(Sample X
x y
_ : [Sample y]
_) = X -> y -> Sample y
forall y. X -> y -> Sample y
Sample X
x y
zero Sample y -> [Sample y] -> [Sample y]
forall a. a -> [a] -> [a]
: [Sample y]
ss
add_zero_transition y
_ [] = []

-- | The output has the union of the Xs in the inputs, except where they match
-- exactly.  Discontinuities should get two Xs.  This is the list version of
-- 'sample_xs2'.
sample_xs :: [[X]] -> [X]
sample_xs :: [[X]] -> [X]
sample_xs = [[X]] -> [X]
forall {a}. Ord a => [[a]] -> [a]
go
    where
    go :: [[a]] -> [a]
go [] = []
    go [[a]]
xss_ = case [a] -> Maybe a
forall a. Ord a => [a] -> Maybe a
Seq.minimum [a]
xs of
        Maybe a
Nothing -> [[a]] -> [a]
go (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
tail [[a]]
xss)
        Just a
x -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
go (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Bool) -> [a] -> [a]
forall {t}. (t -> Bool) -> [t] -> [t]
drop1 (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)) [[a]]
xss)
        where
        xs :: [a]
xs = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
List.head [[a]]
xss
        xss :: [[a]]
xss = ([a] -> Bool) -> [[a]] -> [[a]]
forall {t}. (t -> Bool) -> [t] -> [t]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null) [[a]]
xss_
    drop1 :: (t -> Bool) -> [t] -> [t]
drop1 t -> Bool
f (t
x:[t]
xs) | t -> Bool
f t
x = [t]
xs
    drop1 t -> Bool
_ [t]
xs = [t]
xs


-- ** constant rate resamples

-- | This is like 'to_piecewise_constant', except it retains discontinuities,
-- which is important since it's used for 'map_y', which is still operating on
-- linear segments.  Or it's like 'resample', except it uses a constant rate
-- instead of [X].
resample_rate :: X -> NumSignal -> NumSignal
resample_rate :: X -> NumSignal -> NumSignal
resample_rate X
srate =
    [Sample Double] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples ([Sample Double] -> NumSignal)
-> (NumSignal -> [Sample Double]) -> NumSignal -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Sample Double, Maybe (Sample Double)) -> [Sample Double])
-> [(Sample Double, Maybe (Sample Double))] -> [Sample Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Sample Double, Maybe (Sample Double)) -> [Sample Double]
resample ([(Sample Double, Maybe (Sample Double))] -> [Sample Double])
-> (NumSignal -> [(Sample Double, Maybe (Sample Double))])
-> NumSignal
-> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample Double] -> [(Sample Double, Maybe (Sample Double))]
forall a. [a] -> [(a, Maybe a)]
Seq.zip_next ([Sample Double] -> [(Sample Double, Maybe (Sample Double))])
-> (NumSignal -> [Sample Double])
-> NumSignal
-> [(Sample Double, Maybe (Sample Double))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [Sample Double]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples
    where
    resample :: (Sample Double, Maybe (Sample Double)) -> [Sample Double]
resample (Sample X
x1 Double
y1, Maybe (Sample Double)
Nothing) = [X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x1 Double
y1]
    resample (Sample X
x1 Double
y1, Just (Sample X
x2 Double
y2))
        | Double
y1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y2 Bool -> Bool -> Bool
|| X
x1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x2 = [X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x1 Double
y1]
        | Bool
otherwise =
            [ X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x (Stack => X -> Double -> X -> Double -> X -> Double
X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2 X
x)
            | X
x <- X -> X -> X -> [X]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range' X
x1 X
x2 (X
1X -> X -> X
forall a. Fractional a => a -> a -> a
/X
srate)
            ]

-- TODO possible vector implementation that might fuse.  But this
-- requires Storable (a, b).
-- resample_rate :: X -> NumSignal -> NumSignal
-- resample_rate srate =
--     from_vector . V.concatMap resample . zip_next . to_vector
--     where
--     zip_next xs = V.zip xs (V.drop 1 xs)
--     resample (Sample x1 y1, Sample x2 y2) = V.fromList
--         [Sample x1 y1, Sample x2 y2]

to_piecewise_constant :: X -> NumSignal -> TimeVector.Unboxed
to_piecewise_constant :: X -> NumSignal -> Vector (Sample Double)
to_piecewise_constant X
srate =
    [Sample Double] -> Vector (Sample Double)
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList ([Sample Double] -> Vector (Sample Double))
-> (NumSignal -> [Sample Double])
-> NumSignal
-> Vector (Sample Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sample Double -> Double) -> [Sample Double] -> [Sample Double]
forall k a. Eq k => (a -> k) -> [a] -> [a]
Seq.drop_dups Sample Double -> Double
forall y. Sample y -> y
sy ([Sample Double] -> [Sample Double])
-> (NumSignal -> [Sample Double]) -> NumSignal -> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sample Double -> X) -> [Sample Double] -> [Sample Double]
forall k a. Eq k => (a -> k) -> [a] -> [a]
Seq.drop_initial_dups Sample Double -> X
forall y. Sample y -> X
sx ([Sample Double] -> [Sample Double])
-> (NumSignal -> [Sample Double]) -> NumSignal -> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Sample Double]] -> [Sample Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat
        ([[Sample Double]] -> [Sample Double])
-> (NumSignal -> [[Sample Double]]) -> NumSignal -> [Sample Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sample Double] -> Maybe ([Sample Double], [Sample Double]))
-> [Sample Double] -> [[Sample Double]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make ([Sample Double] -> [[Sample Double]])
-> (NumSignal -> [Sample Double]) -> NumSignal -> [[Sample Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [Sample Double]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples
    where
    make :: [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make [] = Maybe ([Sample Double], [Sample Double])
forall a. Maybe a
Nothing
    make [Sample X
x Double
y] = ([Sample Double], [Sample Double])
-> Maybe ([Sample Double], [Sample Double])
forall a. a -> Maybe a
Just ([X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x Double
y], [])
    make (Sample X
x1 Double
y1 : s2s :: [Sample Double]
s2s@(Sample X
x2 Double
y2 : [Sample Double]
_))
        | Double
y1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y2 = ([Sample Double], [Sample Double])
-> Maybe ([Sample Double], [Sample Double])
forall a. a -> Maybe a
Just ([X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x1 Double
y1], [Sample Double]
s2s)
        | X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x2 = [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make [Sample Double]
s2s
        | Bool
otherwise = ([Sample Double], [Sample Double])
-> Maybe ([Sample Double], [Sample Double])
forall a. a -> Maybe a
Just (X -> Double -> X -> Double -> [Sample Double]
segment X
x1 Double
y1 X
x2 Double
y2, [Sample Double]
s2s)
    segment :: X -> Double -> X -> Double -> [Sample Double]
segment X
x1 Double
y1 X
x2 Double
y2 =
        [ X -> Double -> Sample Double
forall y. X -> y -> Sample y
Sample X
x (Stack => X -> Double -> X -> Double -> X -> Double
X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2 X
x)
        | X
x <- X -> X -> X -> [X]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range' X
x1 X
x2 (X
1X -> X -> X
forall a. Fractional a => a -> a -> a
/X
srate)
        ]