{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Piecewise where
import Data.Ix (Ix, )
import qualified Algebra.RealRing as RealRing
import NumericPrelude.Numeric
import NumericPrelude.Base
type T t y sig = [PieceData t y sig]
newtype Piece t y sig =
Piece {forall t y sig. Piece t y sig -> y -> y -> t -> sig
computePiece :: y
-> y
-> t
-> sig}
pieceFromFunction :: (y -> y -> t -> sig) -> Piece t y sig
pieceFromFunction :: forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
pieceFromFunction = (y -> y -> t -> sig) -> Piece t y sig
forall t y sig. (y -> y -> t -> sig) -> Piece t y sig
Piece
data PieceData t y sig =
PieceData {forall t y sig. PieceData t y sig -> Piece t y sig
pieceType :: Piece t y sig,
forall t y sig. PieceData t y sig -> y
pieceY0 :: y,
forall t y sig. PieceData t y sig -> y
pieceY1 :: y,
forall t y sig. PieceData t y sig -> t
pieceDur :: t}
newtype PieceRightSingle y = PRS y
newtype PieceRightDouble y = PRD y
data PieceDist t y sig = PD t (Piece t y sig) y
infixr 5 -|#, #|-, =|#, #|=, |#, #|
( #|-) :: (t, Piece t y sig) -> (PieceRightSingle y, T t y sig) ->
(PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #|- :: forall t y sig.
(t, Piece t y sig)
-> (PieceRightSingle y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|- (PRS y
y1, T t y sig
xs) = (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, T t y sig
xs)
(-|#) :: y -> (PieceDist t y sig, T t y sig) ->
(PieceRightSingle y, T t y sig)
y
y0 -|# :: forall y t sig.
y
-> (PieceDist t y sig, T t y sig)
-> (PieceRightSingle y, T t y sig)
-|# (PD t
d Piece t y sig
c y
y1, T t y sig
xs) = (y -> PieceRightSingle y
forall y. y -> PieceRightSingle y
PRS y
y0, Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y0 y
y1 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs)
( #|=) :: (t, Piece t y sig) -> (PieceRightDouble y, T t y sig) ->
(PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #|= :: forall t y sig.
(t, Piece t y sig)
-> (PieceRightDouble y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|= (PRD y
y1, T t y sig
xs) = (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, T t y sig
xs)
(=|#) :: (y,y) -> (PieceDist t y sig, T t y sig) ->
(PieceRightDouble y, T t y sig)
(y
y01,y
y10) =|# :: forall y t sig.
(y, y)
-> (PieceDist t y sig, T t y sig)
-> (PieceRightDouble y, T t y sig)
=|# (PD t
d Piece t y sig
c y
y11, T t y sig
xs) = (y -> PieceRightDouble y
forall y. y -> PieceRightDouble y
PRD y
y01, Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y10 y
y11 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs)
( #|) :: (t, Piece t y sig) -> y ->
(PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #| :: forall t y sig.
(t, Piece t y sig) -> y -> (PieceDist t y sig, T t y sig)
#| y
y1 = (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, [])
(|#) :: y -> (PieceDist t y sig, T t y sig) ->
T t y sig
y
y0 |# :: forall y t sig. y -> (PieceDist t y sig, T t y sig) -> T t y sig
|# (PD t
d Piece t y sig
c y
y1, T t y sig
xs) = Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y0 y
y1 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs
data FlatPosition = FlatLeft | FlatRight
deriving (Int -> FlatPosition -> ShowS
[FlatPosition] -> ShowS
FlatPosition -> String
(Int -> FlatPosition -> ShowS)
-> (FlatPosition -> String)
-> ([FlatPosition] -> ShowS)
-> Show FlatPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlatPosition -> ShowS
showsPrec :: Int -> FlatPosition -> ShowS
$cshow :: FlatPosition -> String
show :: FlatPosition -> String
$cshowList :: [FlatPosition] -> ShowS
showList :: [FlatPosition] -> ShowS
Show, FlatPosition -> FlatPosition -> Bool
(FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool) -> Eq FlatPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlatPosition -> FlatPosition -> Bool
== :: FlatPosition -> FlatPosition -> Bool
$c/= :: FlatPosition -> FlatPosition -> Bool
/= :: FlatPosition -> FlatPosition -> Bool
Eq, Eq FlatPosition
Eq FlatPosition =>
(FlatPosition -> FlatPosition -> Ordering)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> FlatPosition)
-> (FlatPosition -> FlatPosition -> FlatPosition)
-> Ord FlatPosition
FlatPosition -> FlatPosition -> Bool
FlatPosition -> FlatPosition -> Ordering
FlatPosition -> FlatPosition -> FlatPosition
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FlatPosition -> FlatPosition -> Ordering
compare :: FlatPosition -> FlatPosition -> Ordering
$c< :: FlatPosition -> FlatPosition -> Bool
< :: FlatPosition -> FlatPosition -> Bool
$c<= :: FlatPosition -> FlatPosition -> Bool
<= :: FlatPosition -> FlatPosition -> Bool
$c> :: FlatPosition -> FlatPosition -> Bool
> :: FlatPosition -> FlatPosition -> Bool
$c>= :: FlatPosition -> FlatPosition -> Bool
>= :: FlatPosition -> FlatPosition -> Bool
$cmax :: FlatPosition -> FlatPosition -> FlatPosition
max :: FlatPosition -> FlatPosition -> FlatPosition
$cmin :: FlatPosition -> FlatPosition -> FlatPosition
min :: FlatPosition -> FlatPosition -> FlatPosition
Ord, Ord FlatPosition
Ord FlatPosition =>
((FlatPosition, FlatPosition) -> [FlatPosition])
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Int)
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Int)
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Bool)
-> ((FlatPosition, FlatPosition) -> Int)
-> ((FlatPosition, FlatPosition) -> Int)
-> Ix FlatPosition
(FlatPosition, FlatPosition) -> Int
(FlatPosition, FlatPosition) -> [FlatPosition]
(FlatPosition, FlatPosition) -> FlatPosition -> Bool
(FlatPosition, FlatPosition) -> FlatPosition -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (FlatPosition, FlatPosition) -> [FlatPosition]
range :: (FlatPosition, FlatPosition) -> [FlatPosition]
$cindex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
index :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
$cunsafeIndex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
unsafeIndex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
$cinRange :: (FlatPosition, FlatPosition) -> FlatPosition -> Bool
inRange :: (FlatPosition, FlatPosition) -> FlatPosition -> Bool
$crangeSize :: (FlatPosition, FlatPosition) -> Int
rangeSize :: (FlatPosition, FlatPosition) -> Int
$cunsafeRangeSize :: (FlatPosition, FlatPosition) -> Int
unsafeRangeSize :: (FlatPosition, FlatPosition) -> Int
Ix, Int -> FlatPosition
FlatPosition -> Int
FlatPosition -> [FlatPosition]
FlatPosition -> FlatPosition
FlatPosition -> FlatPosition -> [FlatPosition]
FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
(FlatPosition -> FlatPosition)
-> (FlatPosition -> FlatPosition)
-> (Int -> FlatPosition)
-> (FlatPosition -> Int)
-> (FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition])
-> Enum FlatPosition
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FlatPosition -> FlatPosition
succ :: FlatPosition -> FlatPosition
$cpred :: FlatPosition -> FlatPosition
pred :: FlatPosition -> FlatPosition
$ctoEnum :: Int -> FlatPosition
toEnum :: Int -> FlatPosition
$cfromEnum :: FlatPosition -> Int
fromEnum :: FlatPosition -> Int
$cenumFrom :: FlatPosition -> [FlatPosition]
enumFrom :: FlatPosition -> [FlatPosition]
$cenumFromThen :: FlatPosition -> FlatPosition -> [FlatPosition]
enumFromThen :: FlatPosition -> FlatPosition -> [FlatPosition]
$cenumFromTo :: FlatPosition -> FlatPosition -> [FlatPosition]
enumFromTo :: FlatPosition -> FlatPosition -> [FlatPosition]
$cenumFromThenTo :: FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
enumFromThenTo :: FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
Enum)
splitDurations :: (RealRing.C t) => [t] -> [(Int, t)]
splitDurations :: forall t. C t => [t] -> [(Int, t)]
splitDurations [t]
ts0 =
let ([Int]
ds,[t]
ts) =
[(Int, t)] -> ([Int], [t])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, t)] -> ([Int], [t])) -> [(Int, t)] -> ([Int], [t])
forall a b. (a -> b) -> a -> b
$ ((Int, t) -> t -> (Int, t)) -> (Int, t) -> [t] -> [(Int, t)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(Int
_,t
fr) t
d -> t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
RealRing.splitFraction (t
frt -> t -> t
forall a. C a => a -> a -> a
+t
d))
(Int
0,t
1) [t]
ts0
in [Int] -> [t] -> [(Int, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail [Int]
ds) ((t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (t -> t -> t
forall a. C a => a -> a -> a
subtract t
1) [t]
ts)