linear diophantine equations

Math/NumberTheory/Diophantine.hs

@@ -1,7 +1,6 @@
 -- Module for Diophantine Equations and related functions
 
-{-# LANGUAGE RecordWildCards, BlockArguments, TypeApplications, PartialTypeSignatures #-}
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards, PartialTypeSignatures #-}
 {-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 
 module Math.NumberTheory.Diophantine
@@ -93,83 +92,17 @@ data LinearSolution a = LS { x,v,y,u :: a }
 
 -- | Produces an unique solution given any
 -- | arbitrary number k
-runLinearSolution :: _ => LinearSolution b -> b -> (b, b)
+runLinearSolution :: _ => LinearSolution a -> a -> (a, a)
 runLinearSolution LS {..} k =
   ( x + k*v, y - k*u )
 
 solveLinear :: _ => Linear a -> Maybe (LinearSolution a)
 solveLinear Lin {..} =
-    LS {..} <$ guard @Maybe do b /= 0 && q == 0
+    LS {..} <$ guard (b /= 0 && q == 0)
   where
     (d, e) = gcdExt a b
     (h, q) = divMod c d
     f      = div (a*e-d) (-b)
     (x, y) = (e*h, f*h)
     (u, v) = (quot a d, quot b d)
 
-----
-
--- https://en.wikipedia.org/wiki/Ku%E1%B9%AD%E1%B9%ADaka
---
--- "Find an integer such that it leaves a remainder of 'r1' when
--- divided by 'a' and a remainder of 'r2' when divided by 'b'
---
-data Kuṭṭaka i = Kuṭṭaka { r1,a,r2,b :: i }
-  deriving Show
-
-kuṭṭakaLinear :: _ => Kuṭṭaka i -> Linear i
-kuṭṭakaLinear Kuṭṭaka{..}
-  = Lin {..}
-  where
-    c = r2 - r1
-
-----
-
-{-
-   You are standing on a pogo stick at the surface of a circle of
-   circumferance C. A distance D away from you is a piece of candy.
-   Your pogo stick can only jump jumps of some integer length L.
-   How many hops H does it take to land on the candy?
-
-   Examples:
-     (C=10, D=1, L=2) -> no solution
-     (C=23, D=3, L=5) -> 19 hops
-
-   D = H*L (mod C)
-   D = H*L - T*C
--}
-
-data Pogo i
-   = Pogo { l :: i   -- Jump length
-          , d :: i   -- Initial distance to the candy
-          , c :: i } -- Circle circumference
-   deriving
-     ( Show, Eq, Ord
-     )
-
-pogoLinear Pogo {l=a, c=b, d=c} =
-  Lin {..}
-
-solvePogo p@Pogo {..} = do
-  let l = pogoLinear p
-  s <- solveLinear l
-  let (h,_) = runLinearSolution s 0
-  pure $ mod h c
-
-----
-
--- i*s1 == i*s2 + o  (mod c)
---
--- This is like Pogo, but the piece of candy is also moving
---
-data Race a = Race
-  { c  :: a -- Length of the cycle
-  , s1 :: a -- Speed itterator 1
-  , s2 :: a -- Speed itterator 2
-  , o  :: a -- Offset itterator 2
-  }
-  deriving Show
-
-raceLinear Race {..} =
-  Lin { b=c, c=o, a=s1-s2 }
-

test-suite/Math/NumberTheory/DiophantineTests.hs

@@ -2,6 +2,7 @@
 
 {-# LANGUAGE CPP       #-}
 
+{-# LANGUAGE RecordWildCards, GADTs #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module Math.NumberTheory.DiophantineTests
@@ -33,8 +34,17 @@ cornacchiaBruteForce (Positive d) (Positive a) = gcd d m /= 1 || findSolutions [
             where x2 = m - d*y*y
                   x = integerSquareRoot x2
 
+linearTest :: (a ~ Integer) => a -> a -> a -> a -> Bool
+linearTest a b c k =
+  case solveLinear Lin {..} of
+    Nothing -> True -- Disproving this would require a counter example
+    Just ls | (x, y) <- runLinearSolution ls k
+            -> a*x + b*y == c
+
+
 testSuite :: TestTree
 testSuite = testGroup "Diophantine"
   [ testSmallAndQuick "Cornacchia correct" cornacchiaTest
   , testSmallAndQuick "Cornacchia same solutions as brute force" cornacchiaBruteForce
+  , testSmallAndQuick "Linear correct" linearTest
   ]