{- |
In this modules we try to infer sampling parameters
using the unique-logic package.
Every signal is equipped with input and output parameters
that allow inference of sampling parameters.
However, this way, signals are functions
and their body cannot easily be shared.
In general signals should not be used explicitly.
Instead you should combine small signal processors to larger signal processors.
In fact, this boils down to "Control.Arrow" operations,
although we cannot use the @Arrow@ class.
We can however use the same set of combinators adapted to our needs.
We even cannot hide the peano numbers of unique-logic in the arrows,
since the number of needed peano counters depends on the number of inputs
and outputs of an arrow.
-}
{-
Inference by expressing a 'let' construct by a fixed point.
@
let input = ping
output = mix input (delay output)
in output
@
@
snd $ fix (\ ~(input, output) -> (ping, mix input (delay output)))
@
Split into atomic equations which fit the equation solver framework.
@
let input = ping
delayedOutput = delay output
output = mix input delayedOutput
in output
@
Enrich equations with information for the lazy knot.
Signal parameters for the function results
are included in the signals,
but signal parameters of the inputs are returned separately.
@
let input =
ping [parametersOf input, inputParam0]
(delayedOutput, outputParam0) =
delay [parametersOf delayedOutput, delayOutputParam0] output
(output, (inputParam0, delayOutputParam0)) =
mix [parametersOf output, outputParam0] input delayedOutput
in output
@
@
let input =
ping input [inputParam0]
(delayedOutput, outputParam0) =
delay delayedOutput [delayOutputParam0] output
(output, (inputParam0, delayOutputParam0)) =
mix output [outputParam0] input delayedOutput
in output
@
@
let input@(inputStream, inputParam0) =
ping [inputParam0, inputParam1]
(delayedOutput@(delayedOutputStream, delayedOutputParam0), outputParam1) =
delay [delayedOutputParam0, delayOutputParam1] output
(output@(outputStream, outputParam0), (inputParam1, delayOutputParam1)) =
mix [outputParam0, outputParam1] input delayedOutput
in output
@
The first list argument of each computation function contains signals,
but only the parameters are used and the data stream is ignored.
@
let input = ping [input]
(delayedOutput, output0) =
delay [delayedOutput, delayedOutput0] output
(output, (input0,delayedOutput0)) =
mix [output,output0] input delayedOutput
in output
@
Develop a simpler example:
Work out
@
envelope exponential oscillator
@
@
\zp0 ->
let x = exponential xp0
y = oscillator yp0
(z,(xp1,yp1)) = envelope zp0 x y
xp0 = closeCycle xp1
yp0 = closeCycle yp1
in z
@
Now with sharing of the 'exponential'.
The model is
@
let x = exponential
in envelope x (oscillator x)
@
or
@
snd $ fix \ (x, _) ->
(exponential, envelope x (oscillator x))
@
@
\zp0 ->
let x = exponential xp0
(y,xp1) = oscillator yp0 x
(z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y
xp0 = closeCycle xp2
yp0 = closeCycle yp1
in z
@
With fixed point operator
@
\((x,xp0), (_,zp0)) ->
let (y,xp1) = oscillator yp0 x
(z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y
yp0 = closeCycle yp1
in ((xp2, exponential xp0), (undefined,z))
@
Many generators with the same sample rate
can be handled elegantly with the monad (SharedVariable a).
@
\zp0 -> evalSharing $ mdo
x <- initial exponential
y <- share (oscillator yp0) x
(z,yp1) <- share (envelope zp0 y) x
let yp0 = closeCycle yp1
return z
@
-}
module Synthesizer.Inference.Fix where
import qualified Synthesizer.Physical.Signal as SigP
import qualified UniqueLogicNP.Lazy.SingleStep as Logic
-- * custom interface
type Parameter a = Logic.Variable a
type Result a = Parameter a
type Parameters t y = (Parameter t, Parameter y)
type Results t y = (Result t, Result y)
type InputSignal t t' y y' yv = SigP.T t (Parameter t') y (Parameter y') yv
type OutputSignal t t' y y' yv = SigP.T t (Result t') y (Result y') yv
infixr 9 .%, .%&
infixr 0 $%, $%%, $$%&
{- |
Combinator function:
Since the interim signal is not seen anywhere else,
we know of all influences to its value.
These are the backward-constraints of @f@
and the forward-constraints of @g@
and we can simply fuse them using 'Logic.closeCycle'.
*** The order of input and output values should be flipped,
in order to match that of @(->)@.
-}
{-
(.%) ::
((Parameters tc' yc', InputSignal tb tb' yb yb' ybv) ->
(OutputSignal tc tc' yc yc' ycv, Results tb' yb')) ->
((Parameters tb' yb', InputSignal ta ta' ya ya' yav) ->
(OutputSignal tb tb' yb yb' ybv, Results ta' ya')) ->
((Parameters tc' yc', InputSignal ta ta' ya ya' yav) ->
(OutputSignal tc tc' yc yc' ycv, Results ta' ya'))
-}
(.%) ::
((params, InputSignal ta ta' ya ya' yav) ->
(output, Results ta' ya')) ->
((Parameters ta' ya', input) ->
(OutputSignal ta ta' ya ya' yav, result)) ->
((params, input) ->
(output, result))
(f .% g) (zParams, x) =
let (y,xResults) = g (yParams,x)
(z,yResults) = f (zParams,y)
yParams = closeParameterCycles yResults
in (z,xResults)
($%) ::
((params, InputSignal ta ta' ya ya' yav) ->
(output, Results ta' ya')) ->
(Parameters ta' ya' ->
OutputSignal ta ta' ya ya' yav) ->
(params ->
output)
(f $% g) zParams =
let y = g yParams
(z,yResults) = f (zParams,y)
yParams = closeParameterCycles yResults
in z
($%%) ::
((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
(output, (Results ta' ya', Results tb' yb'))) ->
(Parameters ta' ya' -> OutputSignal ta ta' ya ya' yav,
Parameters tb' yb' -> OutputSignal tb tb' yb yb' ybv) ->
(params ->
output)
(f $%% (ga,gb)) zParams =
let ya = ga yaParams
yb = gb ybParams
(z,(yaResults,ybResults)) =
f (zParams,(ya,yb))
yaParams = closeParameterCycles yaResults
ybParams = closeParameterCycles ybResults
in z
(.%&) ::
((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
(output, (Results ta' ya', Results tb' yb'))) ->
(((Parameters ta' ya', Parameters tb' yb'), input) ->
((OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv), result)) ->
((params, input) ->
(output, result))
(f .%& g) (zParams, x) =
let ((ya,yb), xResults) = g ((yaParams,ybParams),x)
(z,(yaResults,ybResults)) = f (zParams,(ya,yb))
yaParams = closeParameterCycles yaResults
ybParams = closeParameterCycles ybResults
in (z,xResults)
{-
($%&) ::
((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->
(output, (Results ta' ya', Results tb' yb'))) ->
((Parameters ta' ya', Parameters tb' yb') ->
(OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->
(params ->
output)
(f $%& g) zParams =
let ya = ga yaParams
yb = gb ybParams
(z,(yaResults,ybResults)) = f (zParams,(ya,yb))
yaParams = closeParameterCycles yaResults
ybParams = closeParameterCycles ybResults
in z
-}
($$%&) ::
((paramsA, InputSignal ta ta' ya ya' yav) ->
(outputA, Results ta' ya'),
(paramsB, InputSignal tb tb' yb yb' ybv) ->
(outputB, Results tb' yb')) ->
((Parameters ta' ya', Parameters tb' yb') ->
(OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->
((paramsA,paramsB) ->
(outputA,outputB))
((fa,fb) $$%& x) (yaParams,ybParams) =
let (xa,xb) = x (xaParams,xbParams)
(ya,xaResults) = fa (yaParams,xa)
(yb,xbResults) = fb (ybParams,xb)
xaParams = closeParameterCycles xaResults
xbParams = closeParameterCycles xbResults
in (ya,yb)
{-
((paramsA, InputSignal t t' y y' yv) ->
(outputA, Results t' y')) ->
((paramsB, InputSignal t t' y y' yv) ->
(outputB, Results t' y')) ->
(Parameters t' y' ->
OutputSignal t t' y y' yv) ->
((paramsA,paramsB) ->
(outputA,outputB))
-}
{-
Is this function implemented correctly?
-}
share2 ::
(Parameters t' y' ->
OutputSignal t t' y y' yv) ->
((Parameters t' y', Parameters t' y') ->
(OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))
share2 x ((sr0,amp0),(sr1,amp1)) =
let srResult = Logic.merge sr0 sr1
ampResult = Logic.merge amp0 amp1
y = x (srResult, ampResult)
in (y, y)
share2' :: (Eq t', Eq y') =>
(Parameters t' y' ->
OutputSignal t t' y y' yv) ->
((Parameters t' y', Parameters t' y') ->
(OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))
share2' x ((sr0,amp0),(sr1,amp1)) =
let (sr0Result, sr1Result) = Logic.equal sr0 sr1
(amp0Result, amp1Result) = Logic.equal amp0 amp1
y0 = x (sr0Result, amp0Result)
y1 = x (sr1Result, amp1Result)
in (y0, SigP.replaceSamples (SigP.samples y0) y1)
fix ::
((Parameters t' y', InputSignal t t' y y' yv) ->
(OutputSignal t t' y y' yv, Results t' y')) ->
(Parameters t' y' ->
OutputSignal t t' y y' yv)
fix x (ySR,yAmp) =
let (y,(zSR,zAmp)) = x ((xSR,xAmp), y)
xSR = Logic.closeCycle $ Logic.merge ySR zSR
xAmp = Logic.closeCycle $ Logic.merge yAmp zAmp
{-
xSR = Logic.merge ySR zSR
xAmp = Logic.merge yAmp zAmp
-}
in y
{-
Probably this needs a different interface (signature)
in order to be used flawlessly in a signal processing algorithm.
-}
fixSampleRate ::
t' ->
OutputSignal t t' y y' yv ->
OutputSignal t t' y y' yv
fixSampleRate sr = SigP.replaceSampleRate (Logic.constant sr)
run ::
(Parameters t' y' ->
OutputSignal t t' y y' yv) ->
SigP.T t t' y y' yv
run x =
let y = x (sr,amp)
srResult = SigP.sampleRate y
ampResult = SigP.amplitude y
sr = Logic.closeCycle srResult
amp = Logic.closeCycle ampResult
in SigP.replaceParameters
(Logic.variableValue srResult)
(Logic.variableValue ampResult)
y
{-
Shall 'replaceParameter' check
whether the replaced variables have the same value?
-}
closeParameterCycles ::
Results t' y' -> Parameters t' y'
closeParameterCycles ~(sr,amp) =
(Logic.closeCycle sr, Logic.closeCycle amp)
-- * arrow interface
newtype Processor inSignal results params outSignal =
Processor ((params, inSignal) -> (outSignal, results))
infixr 1 <<<
{- |
The same as '(.%)'.
-}
(<<<) ::
Processor
(InputSignal t t' y y' yv) (Results t' y')
params output ->
Processor
input result
(Parameters t' y') (OutputSignal t t' y y' yv) ->
Processor input result params output
Processor f <<< Processor g = Processor $ f .% g