module Synthesizer.Utility where

import qualified Algebra.Module    as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Ring      as Ring
import qualified Algebra.Field     as Field

import System.Random (Random, RandomGen, randomRs, )

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


{-|
If two values are equal, then return one of them,
otherwise raise an error.
-}
{-# INLINE common #-}
common :: (Eq a) => String -> a -> a -> a
common :: forall a. Eq a => String -> a -> a -> a
common String
errorMsg a
x a
y =
   if a
x forall a. Eq a => a -> a -> Bool
== a
y
     then a
x
     else forall a. HasCallStack => String -> a
error String
errorMsg


-- * arithmetic


{-# INLINE fwrap #-}
fwrap :: RealField.C a => (a,a) -> a -> a
fwrap :: forall a. C a => (a, a) -> a -> a
fwrap (a
lo,a
hi) a
x = a
lo forall a. C a => a -> a -> a
+ forall a. C a => a -> a -> a
fmod (a
xforall a. C a => a -> a -> a
-a
lo) (a
hiforall a. C a => a -> a -> a
-a
lo)

{-# INLINE fmod #-}
fmod :: RealField.C a => a -> a -> a
fmod :: forall a. C a => a -> a -> a
fmod a
x a
y = forall a. C a => a -> a
fraction (a
xforall a. C a => a -> a -> a
/a
y) forall a. C a => a -> a -> a
* a
y

{-# INLINE fmodAlt #-}
fmodAlt :: RealField.C a => a -> a -> a
fmodAlt :: forall a. C a => a -> a -> a
fmodAlt a
x a
y = a
x forall a. C a => a -> a -> a
- forall a. C a => Integer -> a
fromInteger (forall a b. (C a, C b) => a -> b
floor (a
xforall a. C a => a -> a -> a
/a
y)) forall a. C a => a -> a -> a
* a
y

propFMod :: RealField.C a => a -> a -> Bool
propFMod :: forall a. C a => a -> a -> Bool
propFMod a
x a
y =
--   y /= 0 ==>
   forall a. C a => a -> a -> a
fmod a
x a
y forall a. Eq a => a -> a -> Bool
== forall a. C a => a -> a -> a
fmodAlt a
x a
y

{- |
This one should be more precise than 'affineCombAlt' in floating computations
whenever @x1@ is small and @x0@ is big.
-}
{-# INLINE affineComb #-}
affineComb :: (Module.C t y) => t -> (y,y) -> y
affineComb :: forall t y. C t y => t -> (y, y) -> y
affineComb t
phase (y
x0,y
x1) = (forall a. C a => a
Ring.oneforall a. C a => a -> a -> a
-t
phase) forall a v. C a v => a -> v -> v
*> y
x0 forall a. C a => a -> a -> a
+ t
phase forall a v. C a v => a -> v -> v
*> y
x1

affineCombAlt :: (Module.C t y) => t -> (y,y) -> y
affineCombAlt :: forall t y. C t y => t -> (y, y) -> y
affineCombAlt t
phase (y
x0,y
x1) = y
x0 forall a. C a => a -> a -> a
+ t
phase forall a v. C a v => a -> v -> v
*> (y
x1forall a. C a => a -> a -> a
-y
x0)


{-# INLINE balanceLevel #-}
balanceLevel :: (Field.C y) =>
   y -> [y] -> [y]
balanceLevel :: forall y. C y => y -> [y] -> [y]
balanceLevel y
center [y]
xs =
   let d :: y
d = y
center forall a. C a => a -> a -> a
- forall a. C a => [a] -> a
sum [y]
xs forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [y]
xs)
   in  forall a b. (a -> b) -> [a] -> [b]
map (y
dforall a. C a => a -> a -> a
+) [y]
xs

{-# INLINE randomRsBalanced #-}
randomRsBalanced :: (RandomGen g, Random y, Field.C y) =>
   g -> Int -> y -> y -> [y]
randomRsBalanced :: forall g y.
(RandomGen g, Random y, C y) =>
g -> Int -> y -> y -> [y]
randomRsBalanced g
g Int
n y
center y
width =
   forall y. C y => y -> [y] -> [y]
balanceLevel y
center (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (forall a. C a => a
zero,y
width) g
g)