Dual arrays is >100x faster than 'ad' on large fneuralHEADmaster

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

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
   ]