{-# LANGUAGE NoImplicitPrelude #-}
module Test.Sound.Synthesizer.Basic.NumberTheory (tests) where

import Synthesizer.Basic.NumberTheory (Order(Order), )
import qualified Synthesizer.Basic.NumberTheory as NT
import qualified Data.Set as Set

import Test.QuickCheck (Testable, Arbitrary, arbitrary, quickCheck, )

import qualified Algebra.Absolute              as Absolute

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


newtype Cardinal a = Cardinal a
   deriving (Show)

instance (Absolute.C a, Arbitrary a) => Arbitrary (Cardinal a) where
   arbitrary = fmap (Cardinal . abs) arbitrary


newtype Positive a = Positive a
   deriving (Show)

instance (Absolute.C a, Arbitrary a) => Arbitrary (Positive a) where
   arbitrary = fmap (Positive . (1+) . abs) arbitrary


simple ::
   (Testable t, Arbitrary (wrapper Integer), Show (wrapper Integer)) =>
   (wrapper Integer -> t) -> IO ()
simple = quickCheck

tests :: [(String, IO ())]
tests =
   ("primitiveRootsOfUnity naive vs. power",
      simple $ \(Cardinal m) order ->
         NT.primitiveRootsOfUnityNaive m order
         ==
         NT.primitiveRootsOfUnityPower m order) :
   ("primitiveRootsOfUnity naive vs. fullorbit",
      simple $ \(Cardinal m) order ->
         NT.primitiveRootsOfUnityNaive m order
         ==
         (Set.toAscList $ Set.fromList $
          NT.primitiveRootsOfUnityFullOrbit m order)) :
   ("Carmichael theorem",
      simple $ \(Positive a) (Positive b) ->
         NT.getOrder (NT.maximumOrderOfPrimitiveRootsOfUnity (lcm a b))
         ==
         lcm
            (NT.getOrder (NT.maximumOrderOfPrimitiveRootsOfUnity a))
            (NT.getOrder (NT.maximumOrderOfPrimitiveRootsOfUnity b))) :
   ("maximumOrderOfPrimitiveRootsOfUnity naive vs. integer",
      simple $ \(Positive m) ->
         NT.maximumOrderOfPrimitiveRootsOfUnityNaive m
         ==
         NT.maximumOrderOfPrimitiveRootsOfUnityInteger m) :
   ("number of rootsOfUnityPower, lcm",
      simple $ \(Positive m) ao@(Order a) bo@(Order b) ->
         let g = length . NT.rootsOfUnityPower m
         in  g (Order $ lcm a b) == lcm (g ao) (g bo)) :
   ("ringsWithPrimitiveRootsOfUnityAndUnits: minimal modulus",
      quickCheck $ \order@(Order expo) ->
         (head $ NT.ringsWithPrimitiveRootOfUnityAndUnit order)
         ==
         (head $ NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive
            [order] [expo])) :
   ("combine two rings with primitive roots of certain orders",
      quickCheck $ \m n ->
         let r = lcm
                   (head (NT.ringsWithPrimitiveRootOfUnityAndUnit m))
                   (head (NT.ringsWithPrimitiveRootOfUnityAndUnit n))
         in  NT.hasPrimitiveRootOfUnityInteger r m
             &&
             NT.hasPrimitiveRootOfUnityInteger r n) :
   ("combine many rings with primitive roots of certain orders",
      quickCheck $ \n0 ns0 ->
         let ns = take 3 $ map (\n -> 1 + mod n 10) (n0:ns0)
             order = NT.lcmMulti ns
         in  take 3 (NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive
                       (map Order ns) ns)
             ==
             take 3 (NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive
                       [Order order] [order])) :
{-
Unfortunately rings with certain units cannot be combined
while maintaining these elements as units.

Counterexample:
   ringsWithPrimitiveRootOfUnityAndUnit 2 = 3:...
   ringsWithPrimitiveRootOfUnityAndUnit 3 = 7:...
   But in Z_{3·7} the number 3 is no unit.

   ("combine rings with certain units",
      quickCheck $ \(Positive m) (Positive n) ->
         let r = fromIntegral $ lcm
                (head (NT.ringsWithPrimitiveRootOfUnityAndUnit m))
                (head (NT.ringsWithPrimitiveRootOfUnityAndUnit n))
         in  PID.coprime r m && PID.coprime r n) :
-}
   ("number of roots of unity lcm",
      quickCheck $ \(Positive n) (Positive k) (Positive l) ->
         let orders = NT.ordersOfRootsOfUnityInteger !! (n-1)
         in  lcm (orders!!(k-1)) (orders!!(l-1))
             ==
             orders !! (lcm k l - 1)) :
   ("number of roots of unity vs. primitive roots",
      quickCheck $ \(Positive n) (Positive k) ->
         (sum $ map snd $
          filter (flip divides k . fst) $
          zip
             [1..]
             (NT.ordersOfPrimitiveRootsOfUnityInteger !! (n-1)))
         ==
         NT.ordersOfRootsOfUnityInteger !! (n-1) !! (k-1)) :
   []