-- 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.Lists as Lists
import qualified Util.Pretty as Pretty
import qualified Util.Serialize as Serialize
import qualified Util.TimeVector as TimeVector
import           Util.TimeVector (Sample(..), X)
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
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
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.<+> forall a. Pretty a => a -> Doc
Pretty.format v
vector
        where
        offset_s :: Text
offset_s
            | X
offset forall a. Ord a => a -> a -> Bool
> X
0 = Text
"+" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty X
offset
            | Bool
otherwise = 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) = forall a. Serialize a => Putter a
Serialize.put X
offset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put v
vec
    get :: Get (Signal v)
get = forall v. X -> v -> Signal v
Signal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall a. NFData a => a -> ()
DeepSeq.rnf X
offset seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
DeepSeq.rnf v
vec seq :: forall a b. a -> b -> b
`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 (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
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
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
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty X
x1 forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty y
y1
        forall a. Semigroup a => a -> a -> a
<> Text
")--(" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty X
x2 forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty y
y2 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 = forall v. X -> v -> Signal v
Signal X
0 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 = forall v. v -> Signal v
from_vector forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList [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 forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
TimeVector.uncons (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 forall a. Ord a => a -> a -> Bool
<= -X
RealTime.large Bool -> Bool -> Bool
&& forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample a)
rest ->
        forall a. a -> Maybe a
Just a
y1
    Maybe (Sample a, v (Sample 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 forall (v :: * -> *) a. Vector v a => v a -> Maybe (a, v a)
TimeVector.uncons (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 forall a. Ord a => a -> a -> Bool
<= (X
from forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset NumSignal
sig) Bool -> Bool -> Bool
&& forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((forall a. Eq a => a -> a -> Bool
==Double
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. Sample y -> y
sy) Vector (Sample Double)
rest -> forall a. a -> Maybe a
Just Double
y
        | forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all ((forall a. Eq a => a -> a -> Bool
==Double
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. Sample y -> y
sy) (forall v. Signal v -> v
_vector NumSignal
sig) -> forall a. a -> Maybe a
Just Double
0
        | Bool
otherwise -> forall a. Maybe a
Nothing
    Maybe (Sample Double, Vector (Sample Double))
Nothing -> 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 = forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
V.all (Double -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. Sample y -> y
sy) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall a. Eq a => a -> a -> Bool
== X
0 = forall v. Signal v -> v
_vector SignalS v y
sig
    | Bool
otherwise = forall (v :: * -> *) y.
Vector v (Sample y) =>
(X -> X) -> v (Sample y) -> v (Sample y)
TimeVector.map_x (forall a. Num a => a -> a -> a
+X
offset) (forall v. Signal v -> v
_vector SignalS v y
sig)
    where offset :: X
offset = 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 =
    forall v. v -> Signal v
from_vector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {y}. [Sample y] -> [Sample y]
drop_coincident
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {y}. [Sample y] -> [Sample y]
drop_initial_dup
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
Maybe.catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL forall {y}.
Maybe (Sample y)
-> Sample y -> (Maybe (Sample y), Maybe (Sample y))
in_order 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]
_)) | forall y. Sample y -> X
sx Sample y
s1 forall a. Eq a => a -> a -> Bool
== 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 = (forall a. a -> Maybe a
Just Sample y
cur, forall a. a -> Maybe a
Just Sample y
cur)
    in_order (Just Sample y
prev) Sample y
cur
        | forall y. Sample y -> X
sx Sample y
cur forall a. Ord a => a -> a -> Bool
< forall y. Sample y -> X
sx Sample y
prev = (forall a. a -> Maybe a
Just Sample y
prev, forall a. Maybe a
Nothing)
        | Bool
otherwise = (forall a. a -> Maybe a
Just Sample y
cur, 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 forall a. Eq a => a -> a -> Bool
== X
x2 =
        [Sample y] -> [Sample y]
drop_coincident forall a b. (a -> b) -> a -> b
$ forall y. X -> y -> Sample y
Sample X
x1 y
y1 forall a. a -> [a] -> [a]
: [Sample y]
sn
    drop_coincident (Sample y
s1:[Sample y]
sn) = Sample y
s1 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 forall v. Signal v -> X
_offset SignalS v y
sig forall a. Eq a => a -> a -> Bool
== X
0 then forall a. a -> a
id else forall a b. (a -> b) -> [a] -> [b]
map (forall {y}. X -> Sample y -> Sample y
plus (forall v. Signal v -> X
_offset SignalS v y
sig))) forall a b. (a -> b) -> a -> b
$
        forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList (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) = forall y. X -> y -> Sample y
Sample (X
nforall 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 forall a. Eq a => a -> a -> Bool
== X
0 then forall a. a -> a
id else forall a b. (a -> b) -> [a] -> [b]
map (forall {y}. X -> Sample y -> Sample y
plus X
offset)) forall a b. (a -> b) -> a -> b
$
        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) = forall y. X -> y -> Sample y
Sample (X
nforall 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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 = forall a b. (a -> b) -> [a] -> [b]
map forall y. Sample y -> (X, y)
TimeVector.to_pair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map forall y. Sample y -> (X, y)
TimeVector.to_pair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
        forall y. X -> y -> Sample y
Sample X
x1 y
y1 forall a. a -> [a] -> [a]
: forall y. X -> y -> Sample y
Sample X
x2 y
y2 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 = forall y. [Sample y] -> [Segment y]
samples_to_segments forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall y. [Sample y] -> [Segment y]
go
    where
    go :: [Sample y] -> [Segment y]
go [] = []
    go [Sample X
x y
y]
        | X
x forall a. Ord a => a -> a -> Bool
< X
RealTime.large = [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 forall a. Eq a => a -> a -> Bool
== X
x2 = [Sample y] -> [Segment y]
go [Sample y]
xs
        | Bool
otherwise = forall y. X -> y -> X -> y -> Segment y
Segment X
x1 y
y1 X
x2 y
y2 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 forall a. Eq a => a -> a -> Bool
== x
x2 = forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)]
simplify [(x, y)]
xys
simplify [(x, y)]
xys = 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 forall a. Eq a => a -> a -> Bool
== a
y2 Bool -> Bool -> Bool
&& a
y2 forall a. Eq a => a -> a -> Bool
== a
y3 = [(a, a)] -> [(a, a)]
go ((a
x1, a
y1) forall a. a -> [a] -> [a]
: [(a, a)]
xys)
        | a
x1 forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& a
x2 forall a. Eq a => a -> a -> Bool
== a
x3 = [(a, a)] -> [(a, a)]
go ((a
x1, a
y1) 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 forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& a
y1 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 = forall v. v -> Signal v
from_vector forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> SignalS v y -> X -> Maybe y
at :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> SignalS v y -> X -> Maybe y
at Interpolate y
interpolate (Signal X
offset v (Sample y)
vec) X
x_
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
    | Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Eq a => a -> a -> Bool
== forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec = forall a. a -> Maybe a
Just (forall y. Sample y -> y
sy (forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i))
    | Bool
otherwise =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Interpolate y
interpolate (forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec Int
i) (forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec (Int
iforall a. Num a => a -> a -> a
+Int
1)) X
x
    where
    i :: Int
i = 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_ 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 -> SignalS v y -> X
    -> Maybe y
at_negative :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> SignalS v y -> X -> Maybe y
at_negative Interpolate y
interpolate SignalS v y
signal X
x = do
    Segment X
x1 y
y1 X
x2 y
y2 <- forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> SignalS v y -> X -> Maybe (Segment y)
segment_at_orientation Orientation
Types.Negative SignalS v y
signal X
x
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Interpolate y
interpolate (forall y. X -> y -> Sample y
Sample X
x1 y
y1) (forall y. X -> y -> Sample y
Sample X
x2 y
y2) X
x

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

segment_at_orientation :: V.Vector v (Sample y) => Types.Orientation
    -> SignalS v y -> X -> Maybe (Segment y)
segment_at_orientation :: forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> SignalS v y -> X -> Maybe (Segment y)
segment_at_orientation Orientation
orient (Signal X
offset v (Sample y)
vec) X
x =
    forall {y}. Segment y -> Segment y
bump forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) y.
Vector v (Sample y) =>
Orientation -> X -> v (Sample y) -> Maybe (Int, Segment y)
segment_at_v Orientation
orient (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) = forall y. X -> y -> X -> y -> Segment y
Segment (X
x1forall a. Num a => a -> a -> a
+X
offset) y
y1 (X
x2forall 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
    | Bool
otherwise =
        let Sample X
x1 y
y1 = 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 forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
vec
                then forall y. X -> y -> Sample y
Sample X
RealTime.large y
y1
                else forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.unsafeIndex v (Sample y)
vec (Int
iforall a. Num a => a -> a -> a
+Int
1)
        in forall a. a -> Maybe a
Just (Int
i, 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 -> forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Int
TimeVector.index_below
        Orientation
Types.Positive -> 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 forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head (forall v. Signal v -> v
_vector SignalS v y
sig) of
    Maybe (Sample y)
Nothing -> forall a. Maybe a
Nothing
    Just (Sample X
x y
y) -> forall a. a -> Maybe a
Just (forall v. Signal v -> X
_offset SignalS v y
sig 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 forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last (forall v. Signal v -> v
_vector SignalS v y
sig) of
    Maybe (Sample y)
Nothing -> forall a. Maybe a
Nothing
    Just (Sample X
x y
y) -> forall a. a -> Maybe a
Just (forall v. Signal v -> X
_offset SignalS v y
sig 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
    | forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
null SignalS v a
sig = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall y. Sample y -> y
sy forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a.
Vector v a =>
(a -> a -> Ordering) -> v a -> a
V.minimumBy (\Sample a
a Sample a
b -> forall a. Ord a => a -> a -> Ordering
compare (forall y. Sample y -> y
sy Sample a
a) (forall y. Sample y -> y
sy Sample a
b)) forall a b. (a -> b) -> a -> b
$
        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
    | forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
null SignalS v a
sig = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall y. Sample y -> y
sy forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a.
Vector v a =>
(a -> a -> Ordering) -> v a -> a
V.maximumBy (\Sample a
a Sample a
b -> forall a. Ord a => a -> a -> Ordering
compare (forall y. Sample y -> y
sy Sample a
a) (forall y. Sample y -> y
sy Sample a
b)) forall a b. (a -> b) -> a -> b
$
        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 = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Num a => a -> a -> a
+ forall v. Signal v -> X
_offset Signal (v (Sample y))
sig) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. Sample y -> (X, y)
TimeVector.to_pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    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 forall a. Num a => a -> a -> a
+ forall v. Signal v -> X
_offset Signal (v (Sample y))
sig) y
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
_ [] = 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 =
    forall v. v -> Signal v
from_vector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => [v a] -> v a
V.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v (Sample y)] -> [v (Sample y)]
try_strip_duplicates forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {v :: * -> *}.
Vector v (Sample y) =>
[v (Sample y)] -> [v (Sample y)]
chunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector 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 forall y. Sample y -> X
sx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
v2forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
        Just X
x1 -> case 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)
v1forall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
            Just Sample y
end
                | forall y. Sample y -> X
sx Sample y
end forall a. Ord a => a -> a -> Bool
< X
x1 -> v (Sample y)
v1 forall a. a -> [a] -> [a]
: forall {v :: * -> *} {y}.
Vector v (Sample y) =>
Sample y -> v (Sample y)
extension Sample y
end forall a. a -> [a] -> [a]
: [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
clippedforall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
                | Bool
otherwise -> v (Sample y)
v1 forall a. a -> [a] -> [a]
: [v (Sample y)] -> [v (Sample y)]
chunks (v (Sample y)
clippedforall a. a -> [a] -> [a]
:[v (Sample y)]
vs)
            where
            clipped :: v (Sample y)
clipped = 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 = forall (v :: * -> *) a. Vector v a => a -> v a
V.singleton (forall y. X -> y -> Sample y
Sample X
x1 (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 -> forall a. a -> a
id
        Just y -> y -> Bool
eq -> 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) <- forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample t)
v1
        , Just (Sample X
x2 t
y2) <- forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head v (Sample t)
v2
        , X
x1 forall a. Eq a => a -> a -> Bool
== X
x2 Bool -> Bool -> Bool
&& t -> t -> Bool
eq t
y1 t
y2 =
            v (Sample t)
v1 forall a. a -> [a] -> [a]
: (t -> t -> Bool) -> [v (Sample t)] -> [v (Sample t)]
strip_duplicates t -> t -> Bool
eq (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1 v (Sample t)
v2 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 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 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
_) -> 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, 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
    | forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
v = forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
drop_after_v (X
x forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset SignalS v y
sig) (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 forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
V.!? Int
i of
    Maybe (Sample y)
Nothing -> forall (v :: * -> *) a. Vector v a => v a
V.empty
    Just (Sample X
x1 y
_) -> forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (if X
x1 forall a. Ord a => a -> a -> Bool
>= X
x then Int
iforall a. Num a => a -> a -> a
+Int
1 else Int
iforall a. Num a => a -> a -> a
+Int
2) v (Sample y)
vec
    where i :: Int
i = 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
    | forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
v = forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> X -> v (Sample y) -> v (Sample y)
clip_after_v Interpolate y
interpolate (X
x forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset SignalS v y
sig) (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
_] <- forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList v (Sample y)
clipped, X
x0 forall a. Eq a => a -> a -> Bool
== X
x = forall (v :: * -> *) a. Vector v a => v a
V.empty
    | Bool
otherwise = case forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample y)
clipped of
        Maybe (Sample y)
Nothing -> forall (v :: * -> *) a. Vector v a => v a
V.empty
        Just (Sample X
x2 y
_)
            | X
x forall a. Ord a => a -> a -> Bool
< X
x2, Just y
y <- forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> SignalS v y -> X -> Maybe y
at Interpolate y
interpolate (forall v. v -> Signal v
from_vector v (Sample y)
vec) X
x ->
                forall (v :: * -> *) a. Vector v a => v a -> a -> v a
V.snoc (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v (Sample y)
clipped forall a. Num a => a -> a -> a
- Int
1) v (Sample y)
clipped) (forall y. X -> y -> Sample y
Sample X
x y
y)
            | Bool
otherwise -> v (Sample y)
clipped
    where clipped :: v (Sample y)
clipped = 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
    | forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null Vector (Sample Double)
clipped = forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | [Sample X
x0 Double
_] <- forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList Vector (Sample Double)
clipped, X
x0 forall a. Eq a => a -> a -> Bool
== X
x = forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = 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 forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset NumSignal
sig) (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 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 forall a. Eq a => a -> a -> Bool
== Double
y2 -> Vector (Sample Double)
prefix
        | Bool
otherwise -> forall (v :: * -> *) a. Vector v a => v a -> a -> v a
V.snoc Vector (Sample Double)
prefix (forall y. X -> y -> Sample y
Sample X
x (Stack => 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 = forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.take (Int
iforall 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
    | forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v (Sample y)
clipped = forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    | Bool
otherwise = Signal { _offset :: X
_offset = 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_before (X
x forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset SignalS v y
sig) (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 forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (X, y)
head SignalS v y
clipped of
    Maybe (X, y)
Nothing -> forall (v :: * -> *) a. Vector v a => Signal (v a)
empty
    Just (X
x1, y
_)
        | X
x1 forall a. Ord a => a -> a -> Bool
< X
x, Just y
y <- forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> SignalS v y -> X -> Maybe y
at Interpolate y
interpolate SignalS v y
sig X
x ->
            forall v. v -> Signal v
from_vector forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => a -> v a -> v a
V.cons (forall y. X -> y -> Sample y
Sample X
x y
y) (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1 (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 = 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 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 forall a. Ord a => a -> a -> Bool
< X
x, Just y
y <- forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> SignalS v y -> X -> Maybe y
at Interpolate y
interpolate SignalS v y
sig X
x ->
            forall y. X -> y -> Sample y
Sample X
x y
y forall a. a -> [a] -> [a]
: forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples (forall a b. (a -> b) -> Signal a -> Signal b
modify_vector (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.drop Int
1) SignalS v y
clipped)
        | Bool
otherwise -> forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
clipped

    where clipped :: SignalS v y
clipped = 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 = forall v. Signal v -> X
_offset Signal v
sig 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 = forall v. v -> Signal v
from_vector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall v. v -> Signal v
from_vector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
TimeVector.map_y Double -> Double
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector 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 = forall a b. (a -> b) -> Signal a -> Signal b
modify_vector forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> Signal a -> Signal b
modify_vector forall a b. (a -> b) -> a -> b
$ 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sample y] -> [Sample y]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall v. v -> Signal v
from_vector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall a. Eq a => a -> a -> Bool
== X
x1 Bool -> Bool -> Bool
&& X
x1 forall a. Eq a => a -> a -> Bool
== X
x2 ->
        forall v. v -> Signal v
from_vector forall a b. (a -> b) -> a -> b
$ 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 (forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last v (Sample y)
pre, 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
_)) ->
                    forall (v :: * -> *) a. Vector v a => a -> v a
V.singleton (forall y. X -> y -> Sample y
Sample X
x y
y)
                (Maybe (Sample y), Maybe (Sample y))
_ -> forall (v :: * -> *) a. Vector v a => v a
V.empty
            , forall {v :: * -> *} {y}.
Vector v (Sample y) =>
v (Sample y) -> v (Sample y)
drop1 v (Sample y)
post
            ]
            where
            pre :: v (Sample y)
pre = 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 = 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 = forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
to_vector SignalS v y
sig
    clipped :: v (Sample y)
clipped = forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> v (Sample y)
TimeVector.drop_before_strict (X
x forall a. Num a => a -> a -> a
- forall v. Signal v -> X
_offset SignalS v y
sig) (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 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 forall a. Eq a => a -> a -> Bool
== X
x2 -> 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
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
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 = forall v. X -> v -> Signal v
Signal X
0 (forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
V.map Sample Double -> Sample Double
swap (forall v. Signal v -> v
_vector NumSignal
sig))
    where
    swap :: Sample Double -> Sample Double
swap (Sample X
x Double
y) =
        forall y. X -> y -> Sample y
Sample (Double -> X
RealTime.seconds Double
y) (X -> Double
RealTime.to_seconds (X
x forall a. Num a => a -> a -> a
+ 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 =
    forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {d}. Segment d -> (Double, d, Double, d)
to_double forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall a. Num a => a -> a -> a
- Double
x1)
        , if Double
y1 forall a. Eq a => a -> a -> Bool
== Double
y2
            then [forall {y}. Double -> y -> Sample y
to_sample Double
x1 (Double -> Double
f Double
0), forall {y}. Double -> y -> Sample y
to_sample Double
x2 (Double -> Double
f (Double
x2 forall a. Num a => a -> a -> a
- Double
x1))]
            else [forall {y}. Double -> y -> Sample y
to_sample Double
x (Double -> Double
f (Double
x forall a. Num a => a -> a -> a
- Double
x1)) | Double
x <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' Double
x1 Double
x2 (Double
1forall a. Fractional a => a -> a -> a
/Double
srate)]
        )
        where
        f :: Double -> Double
f Double
x = Double
n forall a. Num a => a -> a -> a
* Double
xforall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
y1forall a. Num a => a -> a -> a
*Double
x forall a. Num a => a -> a -> a
+ Double
accum
        n :: Double
n = (Double
y2 forall a. Num a => a -> a -> a
- Double
y1) forall a. Fractional a => a -> a -> a
/ (Double
x2 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 =
    forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall a b. (a -> b) -> a -> b
$ 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 = 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) = 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 (forall a b. (a -> b) -> [a] -> [b]
map forall y. Sample y -> X
sx [Sample Double]
as) (forall a b. (a -> b) -> [a] -> [b]
map forall y. Sample y -> X
sx [Sample Double]
bs)

resample_num :: [X] -> [Sample Y] -> [Y]
resample_num :: [X] -> [Sample Double] -> [Double]
resample_num = 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 (forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples SignalS v y
asig, 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 forall a. Ord a => a -> a -> Bool
< X
bx -> ([Sample y]
as, forall y. X -> y -> Sample y
Sample X
bx y
zero forall a. a -> [a] -> [a]
: [Sample y]
bs)
        | X
bx forall a. Ord a => a -> a -> Bool
< X
ax -> (forall y. X -> y -> Sample y
Sample X
ax y
zero 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 = 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 forall a. Eq a => a -> a -> Bool
== a
b = a
a forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
as [a]
bs
        | a
a forall a. Ord a => a -> a -> Bool
< a
b = a
a forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
as (a
bforall a. a -> [a] -> [a]
:[a]
bs)
        | Bool
otherwise = a
b forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go (a
aforall 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 =
    -- Lists.rotate zips up the samples from each signal.
    forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith X -> [Double] -> Sample Double
make [X]
xs forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
Lists.rotate forall a b. (a -> b) -> a -> b
$
        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 = forall y. X -> y -> Sample y
Sample X
x ([Double] -> Double
merge [Double]
ys)
    xs :: [X]
xs = [[X]] -> [X]
sample_xs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall y. Sample y -> X
sx) [[Sample Double]]
samples
    samples :: [[Sample Double]]
samples = forall a b. (a -> b) -> [a] -> [b]
map (forall y. y -> [Sample y] -> [Sample y]
add_zero_transition Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall y1 y2.
(y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ 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 = forall y1 y2.
(y1 -> y2) -> y2 -> Interpolate y1 -> [X] -> [Sample y1] -> [y2]
resample_ forall a. a -> Maybe a
Just 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 =
    forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL [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 forall a. Eq a => a -> a -> Bool
== X
x1 = if X
x1 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 forall a. Ord a => a -> a -> Bool
>= X
x2 = [Sample y1] -> X -> ([Sample y1], y2)
get [Sample y1]
s2s X
x
        | X
x forall a. Ord a => a -> a -> Bool
> X
x1 = ([Sample y1]
ss, y1 -> y2
present forall a b. (a -> b) -> a -> b
$ Interpolate y1
interpolate (forall y. X -> y -> Sample y
Sample X
x1 y1
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 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]
_) = forall y. X -> y -> Sample y
Sample X
x y
zero 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 = forall {a}. Ord a => [[a]] -> [a]
go
    where
    go :: [[a]] -> [a]
go [] = []
    go [[a]]
xss_ = case forall a. Ord a => [a] -> Maybe a
Lists.minimum [a]
xs of
        Maybe a
Nothing -> [[a]] -> [a]
go (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[a]]
xss)
        Just a
x -> a
x forall a. a -> [a] -> [a]
: [[a]] -> [a]
go (forall a b. (a -> b) -> [a] -> [b]
map (forall {t}. (t -> Bool) -> [t] -> [t]
drop1 (forall a. Eq a => a -> a -> Bool
==a
x)) [[a]]
xss)
        where
        xs :: [a]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
List.head [[a]]
xss
        xss :: [[a]]
xss = forall {t}. (t -> Bool) -> [t] -> [t]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall (v :: * -> *) y.
Vector v (Sample y) =>
[Sample y] -> SignalS v y
from_samples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Sample Double, Maybe (Sample Double)) -> [Sample Double]
resample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(a, Maybe a)]
Lists.zipNext forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = [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 forall a. Eq a => a -> a -> Bool
== Double
y2 Bool -> Bool -> Bool
|| X
x1 forall a. Eq a => a -> a -> Bool
== X
x2 = [forall y. X -> y -> Sample y
Sample X
x1 Double
y1]
        | Bool
otherwise =
            [ forall y. X -> y -> Sample y
Sample X
x (Stack => X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2 X
x)
            | X
x <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' X
x1 X
x2 (X
1forall 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 =
    forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => (a -> k) -> [a] -> [a]
Lists.dropDups forall y. Sample y -> y
sy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => (a -> k) -> [a] -> [a]
Lists.dropInitialDups forall y. Sample y -> X
sx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
to_samples
    where
    make :: [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make [] = forall a. Maybe a
Nothing
    make [Sample X
x Double
y] = forall a. a -> Maybe a
Just ([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 forall a. Eq a => a -> a -> Bool
== Double
y2 = forall a. a -> Maybe a
Just ([forall y. X -> y -> Sample y
Sample X
x1 Double
y1], [Sample Double]
s2s)
        | X
x1 forall a. Ord a => a -> a -> Bool
>= X
x2 = [Sample Double] -> Maybe ([Sample Double], [Sample Double])
make [Sample Double]
s2s
        | Bool
otherwise = 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 =
        [ forall y. X -> y -> Sample y
Sample X
x (Stack => X -> Double -> X -> Double -> X -> Double
TimeVector.y_at X
x1 Double
y1 X
x2 Double
y2 X
x)
        | X
x <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' X
x1 X
x2 (X
1forall a. Fractional a => a -> a -> a
/X
srate)
        ]