synthesizer-core-0.4: src/Test/Sound/Synthesizer/Plain/Analysis.hs

module Test.Sound.Synthesizer.Plain.Analysis (tests) where

import qualified Synthesizer.Plain.Analysis as Analysis

import qualified Algebra.Algebraic             as Algebraic
import qualified Algebra.RealField             as RealField
import qualified Algebra.Field                 as Field
import qualified Algebra.RealRing              as RealRing
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import qualified Algebra.NormedSpace.Maximum   as NormedMax
import qualified Algebra.NormedSpace.Euclidean as NormedEuc
import qualified Algebra.NormedSpace.Sum       as NormedSum

import qualified MathObj.LaurentPolynomial as LPoly

-- import Algebra.Module((*>))

import Data.List (genericLength)

import Test.QuickCheck (test, Property, (==>))
import Test.Utility (approxEqual)

-- import qualified Algebra.Ring                  as Ring
-- import qualified Algebra.Additive              as Additive

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


volumeVectorMaximum :: (NormedMax.C y y, RealRing.C y) => [y] -> Bool
volumeVectorMaximum xs =
   Analysis.volumeVectorMaximum xs == Analysis.volumeMaximum xs

volumeVectorEuclidean :: (NormedEuc.C y y, Algebraic.C y, Eq y) => y -> [y] -> Bool
volumeVectorEuclidean x xs =
   let ys = x:xs
   in  Analysis.volumeVectorEuclidean ys == Analysis.volumeEuclidean ys

volumeVectorEuclideanSqr :: (NormedEuc.Sqr y y, Field.C y, Eq y) => y -> [y] -> Bool
volumeVectorEuclideanSqr x xs =
   let ys = x:xs
   in  Analysis.volumeVectorEuclideanSqr ys == Analysis.volumeEuclideanSqr ys

volumeVectorSum :: (NormedSum.C y y, RealField.C y) => y -> [y] -> Bool
volumeVectorSum x xs =
   let ys = x:xs
   in  Analysis.volumeVectorSum ys == Analysis.volumeSum ys



bounds :: Ord a => a -> [a] -> Bool
bounds x xs =
   let ys = x:xs
   in  Analysis.bounds ys  ==  (minimum ys, maximum ys)


spread :: RealField.C a => (a,a) -> Bool
spread b =
   sum (map snd (Analysis.spread b)) == one


histogramDiscrete :: Int -> [Int] -> Bool
histogramDiscrete x xs =
   let ys = x:xs
   in  Analysis.histogramDiscreteArray ys ==
       Analysis.histogramDiscreteIntMap ys

histogramDiscreteLength :: [Int] -> Bool
histogramDiscreteLength xs =
   sum (snd (Analysis.histogramDiscreteIntMap xs)) == length xs

histogramDiscreteConcat :: [Int] -> [Int] -> Bool
histogramDiscreteConcat xs ys =
   let xHist = Analysis.histogramDiscreteIntMap xs
       yHist = Analysis.histogramDiscreteIntMap ys
       xyHist0 =
          LPoly.add
             (uncurry LPoly.Cons xHist)
             (uncurry LPoly.Cons yHist)
       xyHist1 =
          uncurry LPoly.Cons
             (Analysis.histogramDiscreteIntMap (xs++ys))
   in  if null (LPoly.coeffs xyHist0)
         then LPoly.coeffs xyHist0 == LPoly.coeffs xyHist1
         else xyHist0 == xyHist1


histogramLinear :: Int -> [Int] -> Bool
histogramLinear x xs =
   let ys = map fromIntegral (x:xs) :: [Double]
   in  Analysis.histogramLinearArray ys ==
       Analysis.histogramLinearIntMap ys


histogramLinearLength :: Int -> [Int] -> Bool
histogramLinearLength x xs =
   let ys = map fromIntegral (x:xs) :: [Double]
   in  approxEqual 1e-10
          (genericLength ys)
          (sum (snd (Analysis.histogramLinearIntMap ys)) + 1)
{-
With eps = 1e-15

Falsifiable, after 83 tests:
-20
[32,-41,11,-25,-17,-27,32,-36,7,-36,38]

Falsifiable, after 78 tests:
10
[-35,-28,-28,-24,-4,-29,-14,-29,-20,7,33,-2,-14,-4,7,-40,-5,-12]
-}



centroid :: (Field.C a, Eq a) => [a] -> Property
centroid xs =
   sum xs /= zero ==>
      Analysis.centroid xs == Analysis.centroidAlt xs
-- Test.QuickCheck.test (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))

histogramDCOffset :: Int -> Int -> [Int] -> Property
histogramDCOffset x0 x1 xs =
   let x = x0:x1:xs
       (offset, hist) = Analysis.histogramDiscreteArray x
   in  sum x /= 0 ==>
          fromIntegral offset + Analysis.centroid (map fromIntegral hist) ==
          (Analysis.directCurrentOffset (map fromIntegral x) :: Rational)



tests :: [(String, IO ())]
tests =
   ("volumeVectorMaximum", test (volumeVectorMaximum :: [Rational] -> Bool)) :
   -- test may fail due to rounding errors, but so far the computation is exactly the same
   ("volumeVectorEuclidean", test (volumeVectorEuclidean :: Double -> [Double] -> Bool)) :
   ("volumeVectorEuclideanSqr", test (volumeVectorEuclideanSqr :: Rational -> [Rational] -> Bool)) :
   ("volumeVectorSum", test (volumeVectorSum :: Rational -> [Rational] -> Bool)) :
   ("bounds", test (bounds :: Rational -> [Rational] -> Bool)) :
   ("spread", test (spread :: (Rational,Rational) -> Bool)) :
   ("histogramDiscrete", test (histogramDiscrete :: Int -> [Int] -> Bool)) :
   ("histogramDiscreteLength", test (histogramDiscreteLength :: [Int] -> Bool)) :
   ("histogramDiscreteConcat", test (histogramDiscreteConcat :: [Int] -> [Int] -> Bool)) :
   ("histogramLinear", test (histogramLinear :: Int -> [Int] -> Bool)) :
   ("histogramLinearLength", test (histogramLinearLength :: Int -> [Int] -> Bool)) :
   ("centroid", test (centroid :: [Rational] -> Property)) :
   ("histogramDCOffset", test (histogramDCOffset :: Int -> Int -> [Int] -> Property)) :
   []