diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2025-02-24 22:10:47 +0100 | 
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2025-02-24 22:11:24 +0100 | 
| commit | 3631b758acfb2585809fdb0755e1a8e7afe3b9b7 (patch) | |
| tree | cba5d6b110e3b7679d7558ad30e7454fc6716616 /test/Main.hs | |
| parent | cbb0dd08449cddd141145a2d2f280e3457279b47 (diff) | |
Dual arrays is >100x faster than 'ad' on large fneural
ad:Numeric.AD.Double / ad-dual:Numeric.ADDual.Array.Internal
Prelude> 1.129e-3 / 41.89e-6  -- neural-100
26.951539746956314
Prelude> 34.67e-3 / 156.9e-6  -- neural-180
220.9687699171447
Prelude> 79.03e-3 / 178.6e-6  -- neural-500
442.4972004479283
Prelude> 365.3e-3 / 665.5e-6  -- neural-2000
548.9105935386928
Diffstat (limited to 'test/Main.hs')
| -rw-r--r-- | test/Main.hs | 44 | 
1 files changed, 32 insertions, 12 deletions
diff --git a/test/Main.hs b/test/Main.hs index a04533f..f149ab7 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -8,35 +8,55 @@ import Test.Tasty.Hedgehog  import Test.Tasty.HUnit  import qualified Numeric.AD as AD +import qualified Numeric.AD.Double as AD.Double  import Numeric.ADDual +import qualified Numeric.ADDual.Array.Internal as ADDA  import Numeric.ADDual.Examples -(~==) :: (Foldable t, Fractional a, Ord a, Show (t a)) => t a -> t a -> PropertyT IO () -a ~== b -  | length (toList a) == length (toList b) -  , and (zipWith close (toList a) (toList b)) -  = return () -  | otherwise -  = diff a (\_ _ -> False) b -  where -    close x y = abs (x - y) < 1e-5 || -                  (let m = max (abs x) (abs y) in m > 1e-5 && abs (x - y) / m < 1e-5) +(~=) :: (Fractional a, Ord a) => a -> a -> Bool +x ~= y = abs (x - y) < 1e-5 || (let m = max (abs x) (abs y) in m > 1e-5 && abs (x - y) / m < 1e-5) + +(~==) :: (Fractional a, Ord a, Show a) => a -> a -> PropertyT IO () +x ~== y = diff x (~=) y + +(~=!) :: (Foldable t, Fractional a, Ord a) => t a -> t a -> Bool +a ~=! b = length (toList a) == length (toList b) && and (zipWith (~=) (toList a) (toList b)) + +(~==!) :: (Foldable t, Fractional a, Ord a, Show (t a)) => t a -> t a -> PropertyT IO () +a ~==! b = diff a (~=!) b  main :: IO ()  main = defaultMain $ testGroup "Tests"    [testCase "product [1..5]" $        gradient' @Double product [1..5] 1 @?= (120, [120, 60, 40, 30, 24]) +    ,testProperty "neural 80" $ property $ do        input <- forAll (genNeuralInput 80)        let (res, grad) = gradient' fneural input 1        res === fneural input -      grad ~== AD.grad fneural input +      grad ~==! AD.grad fneural input +      AD.grad fneural input === AD.Double.grad fneural input +    ,testProperty "neural 150" $ property $ do        input <- forAll (genNeuralInput 150)        let (res, grad) = gradient' fneural input 1        res === fneural input -      grad ~== AD.grad fneural input +      grad ~==! AD.grad fneural input +      AD.grad fneural input === AD.Double.grad fneural input +     +  ,testProperty "primal neural == neural_A" $ property $ do +      input <- forAll (genNeuralInput_A 100) +      let resA = fneural_A input +      let res = fneural (cvtFNeuralAtoFNeural input) +      resA ~== res + +  ,testProperty "neural_A 100" $ property $ do +      input <- forAll (genNeuralInput_A 100) +      let (resA, gradA) = ADDA.gradient' fneural_A input 1 +      let (res, grad) = gradient' fneural (cvtFNeuralAtoFNeural input) 1 +      resA ~== res +      cvtFNeuralAtoFNeural gradA ~==! grad    ]  | 
