-- | 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 = (a, StdGen) -> a
forall a b. (a, b) -> a
fst ((a, a) -> StdGen -> (a, StdGen)
forall g. RandomGen g => (a, a) -> g -> (a, g)
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 = Integer -> b
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> a -> a -> a
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 (Int -> Double -> Double -> Double
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 (Int -> Double -> Double -> Double
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 (Bool -> Ugen -> Bool
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
True

>>> u 5 ==** u 5 == u 1
True

>>> u 5 >** u 4 == u 1
True

>>> u 5 <=** u 5 == u 1
True

>>> abs (u (-1)) == u 1
True

>>> u 5 / u 2 == u 2.5
True

>>> min (u 2) (u 3) == u 2
True

>>> max (u 1) (u 3) == u 3
True

> 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 Int -> Maybe (Double -> Double -> Double)
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 Int -> Maybe (Double -> Double)
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 (Bool -> Ugen -> Bool
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 (Ugen -> Maybe Double) -> (Ugen -> Ugen) -> Ugen -> Maybe Double
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 Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
* Ugen
m
    (Bool
True, Bool
False) -> Ugen
u Ugen -> Ugen -> Ugen
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