-- | Optimisations of Ugen graphs.
module Sound.Sc3.Ugen.Optimise where

import System.Random {- random -}

import Sound.Sc3.Common.Math.Operator
import Sound.Sc3.Common.Rate

import qualified Sound.Sc3.Ugen.Bindings.Db as Bindings {- hsc3 -}
import Sound.Sc3.Ugen.Types
import Sound.Sc3.Ugen.Util

-- | Constant form of 'rand' Ugen.
c_rand :: Random a => Int -> a -> a -> a
c_rand :: forall a. Random a => Int -> a -> a -> a
c_rand Int
z a
l a
r = forall a b. (a, b) -> a
fst (forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a
l,a
r) (Int -> StdGen
mkStdGen Int
z))

-- | Constant form of 'iRand' Ugen.
c_irand :: (Num b, RealFrac a, Random a) => Int -> a -> a -> b
c_irand :: forall b a. (Num b, RealFrac a, Random a) => Int -> a -> a -> b
c_irand Int
z a
l a
r = forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Random a => Int -> a -> a -> a
c_rand Int
z a
l a
r))

{- | Optimise 'Ugen' graph by re-writing 'rand' and 'iRand' Ugens that
have 'Constant' inputs.  This, of course, changes the nature of the
graph, it is no longer randomised at the server.  It's a useful
transformation for very large graphs which are being constructed
and sent each time the graph is played.

> import Sound.Sc3.Ugen.Dot {- hsc3-dot -}

> let u = sinOsc ar (randId 'a' 220 440) 0 * 0.1
> draw (u + ugen_optimise_ir_rand u)
-}
ugen_optimise_ir_rand :: Ugen -> Ugen
ugen_optimise_ir_rand :: Ugen -> Ugen
ugen_optimise_ir_rand =
  let f :: Ugen -> Ugen
f Ugen
u =
        case Ugen
u of
          Primitive_U Primitive Ugen
p ->
            case Primitive Ugen
p of
              Primitive
                Rate
InitialisationRate
                String
"Rand"
                [Constant_U (Constant Double
l ([],[]))
                ,Constant_U (Constant Double
r ([],[]))]
                [Rate
InitialisationRate]
                Special
_
                (Uid Int
z)
                ([],[]) -> Constant -> Ugen
Constant_U (Double -> ([Message], [Message]) -> Constant
Constant (forall a. Random a => Int -> a -> a -> a
c_rand Int
z Double
l Double
r) ([],[]))
              Primitive
                Rate
InitialisationRate
                String
"IRand"
                [Constant_U (Constant Double
l ([],[]))
                ,Constant_U (Constant Double
r ([],[]))]
                [Rate
InitialisationRate]
                Special
_
                (Uid Int
z)
                ([],[]) -> Constant -> Ugen
Constant_U (Double -> ([Message], [Message]) -> Constant
Constant (forall b a. (Num b, RealFrac a, Random a) => Int -> a -> a -> b
c_irand Int
z Double
l Double
r) ([],[]))
              Primitive Ugen
_ -> Ugen
u
          Ugen
_ -> Ugen
u
        in (Ugen -> Bool) -> (Ugen -> Ugen) -> Ugen -> Ugen
ugenTraverse (forall a b. a -> b -> a
const Bool
False) Ugen -> Ugen
f

{- | Optimise 'Ugen' graph by re-writing binary operators with
'Constant' inputs.  The standard graph constructors already do
this, however subsequent optimisations, ie. 'ugen_optimise_ir_rand'
can re-introduce these sub-graphs, and the /Plain/ graph
constructors are un-optimised.

> let u = constant
> u 5 * u 10 == u 50
> u 5 ==** u 5 == u 1
> u 5 >** u 4 == u 1
> u 5 <=** u 5 == u 1
> abs (u (-1)) == u 1
> u 5 / u 2 == u 2.5
> min (u 2) (u 3) == u 2
> max (u 1) (u 3) == u 3

> let u = lfPulse ar (2 ** randId 'α' (-9) 1) 0 0.5
> let u' = ugen_optimise_ir_rand u
> draw (mix (mce [u,u',ugen_optimise_const_operator u']))

> ugen_optimise_const_operator (Bindings.mulAdd 3 1 0) == 3
-}
ugen_optimise_const_operator :: Ugen -> Ugen
ugen_optimise_const_operator :: Ugen -> Ugen
ugen_optimise_const_operator =
  let f :: Ugen -> Ugen
f Ugen
u =
        case Ugen
u of
          Primitive_U Primitive Ugen
p ->
            case Primitive Ugen
p of
              Primitive
                Rate
_
                String
"BinaryOpUGen"
                [Constant_U (Constant Double
l ([],[]))
                ,Constant_U (Constant Double
r ([],[]))]
                [Rate
_]
                (Special Int
z)
                UgenId
_
                ([],[]) -> case forall n. (RealFrac n, Floating n) => Int -> Maybe (n -> n -> n)
binop_special_hs Int
z of
                             Just Double -> Double -> Double
fn -> Constant -> Ugen
Constant_U (Double -> ([Message], [Message]) -> Constant
Constant (Double -> Double -> Double
fn Double
l Double
r) ([],[]))
                             Maybe (Double -> Double -> Double)
_ -> Ugen
u
              Primitive
                Rate
_
                String
"UnaryOpUGen"
                [Constant_U (Constant Double
i ([],[]))]
                [Rate
_]
                (Special Int
z)
                UgenId
_
                ([],[]) -> case forall n. (RealFrac n, Floating n) => Int -> Maybe (n -> n)
uop_special_hs Int
z of
                             Just Double -> Double
fn -> Constant -> Ugen
Constant_U (Double -> ([Message], [Message]) -> Constant
Constant (Double -> Double
fn Double
i) ([],[]))
                             Maybe (Double -> Double)
_ -> Ugen
u
              Primitive Rate
_ String
"MulAdd" [Ugen
i, Ugen
m, Ugen
a] [Rate
_] Special
_ UgenId
_ ([],[]) -> Ugen -> Ugen -> Ugen -> Ugen
mulAddOptimised Ugen
i Ugen
m Ugen
a
              Primitive Ugen
_ -> Ugen
u
          Ugen
_ -> Ugen
u
  in (Ugen -> Bool) -> (Ugen -> Ugen) -> Ugen -> Ugen
ugenTraverse (forall a b. a -> b -> a
const Bool
False) Ugen -> Ugen
f

-- | 'u_constant' of 'ugen_optimise_ir_rand'.
constant_opt :: Ugen -> Maybe Sample
constant_opt :: Ugen -> Maybe Double
constant_opt = Ugen -> Maybe Double
u_constant forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> Ugen
ugen_optimise_ir_rand

{- | Constant optimising MulAdd.

> mulAddOptimised (sinOsc ar 440 0) 1 0 == sinOsc ar 440 0
> mulAddOptimised (sinOsc ar 440 0) 0.1 0 == sinOsc ar 440 0 * 0.1
> mulAddOptimised (sinOsc ar 440 0) 1 1 == sinOsc ar 440 0 + 1
> mulAddOptimised (sinOsc ar 440 0) 0.1 1 == mulAdd (sinOsc ar 440 0) 0.1 1
-}
mulAddOptimised :: Ugen -> Ugen -> Ugen -> Ugen
mulAddOptimised :: Ugen -> Ugen -> Ugen -> Ugen
mulAddOptimised Ugen
u Ugen
m Ugen
a =
  case (Double -> Ugen -> Bool
is_constant_of Double
1 Ugen
m,Double -> Ugen -> Bool
is_constant_of Double
0 Ugen
a) of
    (Bool
True,Bool
True) -> Ugen
u
    (Bool
False,Bool
True) -> Ugen
u forall a. Num a => a -> a -> a
* Ugen
m
    (Bool
True,Bool
False) -> Ugen
u forall a. Num a => a -> a -> a
+ Ugen
a
    (Bool
False,Bool
False) -> Ugen -> Ugen -> Ugen -> Ugen
Bindings.mulAdd Ugen
u Ugen
m Ugen
a