Created
November 2, 2017 06:14
-
-
Save naohaq/5ffc8a7ea6be11c27fdea37a462dea8f to your computer and use it in GitHub Desktop.
An extension field of ℚ
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- -*- coding: utf-8-unix -*- -} | |
module Q2357 | |
( ExtR2(..) | |
, ExtR3(..) | |
, ExtR5(..) | |
, ExtR7(..) | |
, Q2357 | |
, factor | |
, root2 | |
, root3 | |
, root5 | |
, root7 | |
, flatten | |
) where | |
import Data.Ratio | |
data ExtR2 a = ExtR2 a a deriving Eq | |
instance (Show a, Num a, Ord a) => Show (ExtR2 a) where | |
show (ExtR2 0 0) = "0" | |
show (ExtR2 0 y) = "(" ++ show y ++ ")√2" | |
show (ExtR2 x 0) = show x | |
show (ExtR2 x y) = show x ++ " + (" ++ show y ++ ")√2" | |
data ExtR3 a = ExtR3 a a deriving Eq | |
instance (Show a, Num a, Ord a) => Show (ExtR3 a) where | |
show (ExtR3 0 0) = "0" | |
show (ExtR3 0 y) = "(" ++ show y ++ ")√3" | |
show (ExtR3 x 0) = show x | |
show (ExtR3 x y) = show x ++ " + (" ++ show y ++ ")√3" | |
data ExtR5 a = ExtR5 a a deriving Eq | |
instance (Show a, Num a, Ord a) => Show (ExtR5 a) where | |
show (ExtR5 0 0) = "0" | |
show (ExtR5 0 y) = "(" ++ show y ++ ")√5" | |
show (ExtR5 x 0) = show x | |
show (ExtR5 x y) = show x ++ " + (" ++ show y ++ ")√5" | |
data ExtR7 a = ExtR7 a a deriving Eq | |
instance (Show a, Num a, Ord a) => Show (ExtR7 a) where | |
show (ExtR7 0 0) = "0" | |
show (ExtR7 0 y) = "(" ++ show y ++ ")√7" | |
show (ExtR7 x 0) = show x | |
show (ExtR7 x y) = show x ++ " + (" ++ show y ++ ")√7" | |
positive_r :: (Num a, Ord a) => a -> a -> a -> Bool | |
positive_r r x y | (x >= 0) && (y >= 0) = True | |
| (x >= 0) && (y < 0) = ( x*x - r*y*y) >= 0 | |
| (x < 0) && (y >= 0) = (- x*x + r*y*y) >= 0 | |
| otherwise = False | |
instance (Num a, Ord a) => Num (ExtR2 a) where | |
(ExtR2 x y) + (ExtR2 z w) = ExtR2 (x+z) (y+w) | |
(ExtR2 x y) * (ExtR2 z w) = ExtR2 x' y' | |
where x' = x*z + 2*y*w | |
y' = y*z + x*w | |
(ExtR2 x y) - (ExtR2 z w) = ExtR2 (x-z) (y-w) | |
negate (ExtR2 x y) = ExtR2 (negate x) (negate y) | |
abs z@(ExtR2 x y) | positive_r 2 x y = z | |
| otherwise = negate z | |
signum (ExtR2 0 0) = 0 | |
signum (ExtR2 x y) | positive_r 2 x y = 1 | |
| otherwise = -1 | |
fromInteger x = ExtR2 (fromInteger x) 0 | |
instance (Num a, Ord a) => Ord (ExtR2 a) where | |
x <= y = positive_r 2 z w | |
where ExtR2 z w = y - x | |
instance (Num a, Ord a) => Num (ExtR3 a) where | |
(ExtR3 x y) + (ExtR3 z w) = ExtR3 (x+z) (y+w) | |
(ExtR3 x y) * (ExtR3 z w) = ExtR3 x' y' | |
where x' = x*z + 3*y*w | |
y' = y*z + x*w | |
(ExtR3 x y) - (ExtR3 z w) = ExtR3 (x-z) (y-w) | |
negate (ExtR3 x y) = ExtR3 (negate x) (negate y) | |
abs z@(ExtR3 x y) | positive_r 3 x y = z | |
| otherwise = negate z | |
signum (ExtR3 0 0) = 0 | |
signum (ExtR3 x y) | positive_r 3 x y = 1 | |
| otherwise = -1 | |
fromInteger x = ExtR3 (fromInteger x) 0 | |
instance (Num a, Ord a) => Ord (ExtR3 a) where | |
x <= y = positive_r 3 z w | |
where ExtR3 z w = y - x | |
instance (Num a, Ord a) => Num (ExtR5 a) where | |
(ExtR5 x y) + (ExtR5 z w) = ExtR5 (x+z) (y+w) | |
(ExtR5 x y) * (ExtR5 z w) = ExtR5 x' y' | |
where x' = x*z + 5*y*w | |
y' = y*z + x*w | |
(ExtR5 x y) - (ExtR5 z w) = ExtR5 (x-z) (y-w) | |
negate (ExtR5 x y) = ExtR5 (negate x) (negate y) | |
abs z@(ExtR5 x y) | positive_r 5 x y = z | |
| otherwise = negate z | |
signum (ExtR5 0 0) = 0 | |
signum (ExtR5 x y) | positive_r 5 x y = 1 | |
| otherwise = -1 | |
fromInteger x = ExtR5 (fromInteger x) 0 | |
instance (Num a, Ord a) => Ord (ExtR5 a) where | |
x <= y = positive_r 5 z w | |
where ExtR5 z w = y - x | |
instance (Num a, Ord a) => Num (ExtR7 a) where | |
(ExtR7 x y) + (ExtR7 z w) = ExtR7 (x+z) (y+w) | |
(ExtR7 x y) * (ExtR7 z w) = ExtR7 x' y' | |
where x' = x*z + 7*y*w | |
y' = y*z + x*w | |
(ExtR7 x y) - (ExtR7 z w) = ExtR7 (x-z) (y-w) | |
negate (ExtR7 x y) = ExtR7 (negate x) (negate y) | |
abs z@(ExtR7 x y) | positive_r 7 x y = z | |
| otherwise = negate z | |
signum (ExtR7 0 0) = 0 | |
signum (ExtR7 x y) | positive_r 7 x y = 1 | |
| otherwise = -1 | |
fromInteger x = ExtR7 (fromInteger x) 0 | |
instance (Num a, Ord a) => Ord (ExtR7 a) where | |
x <= y = positive_r 7 z w | |
where ExtR7 z w = y - x | |
instance (Fractional a, Ord a) => Fractional (ExtR2 a) where | |
fromRational x = ExtR2 (fromRational x) 0 | |
recip x@(ExtR2 a b) = ExtR2 (a / c) (negate b / c) | |
where y = ExtR2 a (negate b) | |
(ExtR2 c _) = x * y | |
instance (Fractional a, Ord a) => Fractional (ExtR3 a) where | |
fromRational x = ExtR3 (fromRational x) 0 | |
recip x@(ExtR3 a b) = ExtR3 (a / c) (negate b / c) | |
where y = ExtR3 a (negate b) | |
(ExtR3 c _) = x * y | |
instance (Fractional a, Ord a) => Fractional (ExtR5 a) where | |
fromRational x = ExtR5 (fromRational x) 0 | |
recip x@(ExtR5 a b) = ExtR5 (a / c) (negate b / c) | |
where y = ExtR5 a (negate b) | |
(ExtR5 c _) = x * y | |
instance (Fractional a, Ord a) => Fractional (ExtR7 a) where | |
fromRational x = ExtR7 (fromRational x) 0 | |
recip x@(ExtR7 a b) = ExtR7 (a / c) (negate b / c) | |
where y = ExtR7 a (negate b) | |
(ExtR7 c _) = x * y | |
showWithSign :: (Show a, Num a, Ord a) => a -> String | |
showWithSign x | x >= 0 = "+(" ++ show (abs x) ++ ")" | |
| otherwise = "-(" ++ show (abs x) ++ ")" | |
type Q2357 = ExtR7 (ExtR5 (ExtR3 (ExtR2 Rational))) | |
flatten :: Q2357 -> String | |
flatten (ExtR7 (ExtR5 (ExtR3 (ExtR2 xq xr2) (ExtR2 xr3 xr6)) (ExtR3 (ExtR2 xr5 xr10) (ExtR2 xr15 xr30))) (ExtR5 (ExtR3 (ExtR2 xr7 xr14) (ExtR2 xr21 xr42)) (ExtR3 (ExtR2 xr35 xr70) (ExtR2 xr105 xr210)))) | |
| xq == 0 = rs | |
| otherwise = show xq ++ rs | |
where xs = [xr2,xr3,xr5,xr6,xr7,xr10,xr14,xr15,xr21,xr30,xr35,xr42,xr70,xr105,xr210] | |
cs = map (("√"++).show) [2,3,5,6,7,10,14,15,21,30,35,42,70,105,210] | |
ys = map (\(c,x)->showWithSign x++c) $ filter ((/=0).snd) $ zip cs xs | |
rs = foldr (++) [] ys | |
root2 :: Q2357 | |
root2 = ExtR7 (ExtR5 (ExtR3 (ExtR2 0 1) 0) 0) 0 | |
root3 :: Q2357 | |
root3 = ExtR7 (ExtR5 (ExtR3 0 1) 0) 0 | |
root5 :: Q2357 | |
root5 = ExtR7 (ExtR5 0 1) 0 | |
root7 :: Q2357 | |
root7 = ExtR7 0 1 | |
factor :: Q2357 -> Q2357 | |
factor (ExtR7 (ExtR5 (ExtR3 (ExtR2 xq xr2) (ExtR2 xr3 xr6)) (ExtR3 (ExtR2 xr5 xr10) (ExtR2 xr15 xr30))) (ExtR5 (ExtR3 (ExtR2 xr7 xr14) (ExtR2 xr21 xr42)) (ExtR3 (ExtR2 xr35 xr70) (ExtR2 xr105 xr210)))) | |
= fromInteger num / fromInteger den | |
where den = foldr lcm 1 $ map denominator [xq,xr2,xr3,xr5,xr6,xr7,xr10,xr14,xr15,xr21,xr30,xr35,xr42,xr70,xr105,xr210] | |
num = foldr gcd 0 $ map numerator [xq,xr2,xr3,xr5,xr6,xr7,xr10,xr14,xr15,xr21,xr30,xr35,xr42,xr70,xr105,xr210] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment