Commit 203168bf authored by Han-Miru Kim's avatar Han-Miru Kim
Browse files

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!
Please register or to comment