### bqf.hs

parent 7a45a386
 #+TITLE: Binary Quadratic Forms Tools #+AUTHOR: Han-Miru Kim #+PROPERTY: header-args :tangle ./bqf.hs * Binary Quadratic Forms ** Data A binary quadratic form ~ax^2 + bxy + cy^2~ is represented as a tuple ~(a,b,c)~. #+BEGIN_SRC haskell module BQF where data BQF = BQF (Int,Int,Int) deriving Eq instance Show BQF where show (BQF (a,b,c)) = "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ ")" #+END_SRC ** Basic Functions A form is reduced if ~-a < b <= a < c~ or ~0 <= b<= a = c~ #+BEGIN_SRC haskell discriminant :: BQF -> Int discriminant (BQF (a,b,c)) = b^2 - 4 * a * c isReduced :: BQF -> Bool isReduced (BQF (a,b,c)) | -a < b && b <= a && a < c = True | 0 <= b && b <= a && a == c = True | otherwise = False #+END_SRC ** Reduction Theory Reduction is done by first finding the ~n~ for which ~n > (b + sqrt D)/2a > n-1~ #+BEGIN_SRC haskell redcoeff :: BQF -> Int redcoeff (BQF (a,b,c)) = ceiling \$ (b' + d') / (2 * a') where b' = fromIntegral b d' = (sqrt . fromIntegral . discriminant) (BQF (a,b,c)) a' = fromIntegral a reduceStep :: BQF -> BQF reduceStep (BQF (a,b,c)) = BQF (a',b',c') where a' = a * n^2 - b * n + c b' = 2 * a * n - b c' = a n = redcoeff (BQF (a,b,c)) reduction :: BQF -> [BQF] reduction f = aux (iterate reduceStep f) [] -- take from infinite chain -- until there is repetition where aux (x:xs) y | x `elem` y = y ++ [x] | otherwise = aux xs (y ++ [x]) unreducedness :: BQF -> Int unreducedness = (length . (takeWhile (not isReduced)) . reduction) #+END_SRC ** Playground #+BEGIN_SRC haskell limit = 5 forms = [BQF (a,b,c) | a <- [- limit .. limit], b <- [- limit .. limit], c <- [- limit, limit]] #+END_SRC
 module BQF where data BQF = BQF (Int,Int,Int) deriving Eq instance Show BQF where show (BQF (a,b,c)) = "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ ")" discriminant :: BQF -> Int discriminant (BQF (a,b,c)) = b^2 - 4 * a * c isReduced :: BQF -> Bool isReduced (BQF (a,b,c)) | -a < b && b <= a && a < c = True | 0 <= b && b <= a && a == c = True | otherwise = False redcoeff :: BQF -> Int redcoeff (BQF (a,b,c)) = ceiling \$ (b' + d') / (2 * a') where b' = fromIntegral b d' = (sqrt . fromIntegral . discriminant) (BQF (a,b,c)) a' = fromIntegral a reduceStep :: BQF -> BQF reduceStep (BQF (a,b,c)) = BQF (a',b',c') where a' = a * n^2 - b * n + c b' = 2 * a * n - b c' = a n = redcoeff (BQF (a,b,c)) reduction :: BQF -> [BQF] reduction f = aux (iterate reduceStep f) [] -- take from infinite chain -- until there is repetition where aux (x:xs) y | x `elem` y = y ++ [x] | otherwise = aux xs (y ++ [x]) unreducedness :: BQF -> Int unreducedness = (length . (takeWhile (not isReduced)) . reduction) limit = 5 forms = [BQF (a,b,c) | a <- [- limit .. limit], b <- [- limit .. limit], c <- [- limit, limit]]
 isSquare :: Int -> Bool isSquare 1 = False isSquare n = truncate(sqrt(x)) * truncate(sqrt(x)) == n where x = fromIntegral n isntSquare = not . isSquare isFund :: Int -> Bool isFund x | (x `mod` 4 == 1) && isntSquare x = True | (x `mod` 4 == 0) && isntSquare (x `div` 4) && (x `div` 4) `elem` [2,3] = True | otherwise = False
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!