constructive-algebra 0.1.2 → 0.1.3

raw patch · 7 files changed

+353/−14 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• constructive-algebra.cabal +3/−1
• examples/Z_Examples.hs +6/−2
• src/Algebra/Matrix.hs +11/−10
• src/Algebra/Structures/BezoutDomain.hs +4/−0
• src/Algebra/Structures/Ring.hs +10/−1
• src/Algebra/TypeChar/Char.hs +160/−0
• src/Algebra/UPoly.hs +159/−0

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.2+Version:             0.1.3  Synopsis:            A library of constructive algebra. Description:         @@ -58,9 +58,11 @@                        Algebra.Structures.FieldOfFractions,                        Algebra.Structures.GCDDomain,                         Algebra.Structures.Coherent,+                       Algebra.TypeChar.Char,                        Algebra.Ideal,                        Algebra.Matrix,                        Algebra.PLM,+                       Algebra.UPoly,                        Algebra.Z,                        Algebra.Q                        

@@ -8,6 +8,7 @@ import Algebra.Structures.Coherent import Algebra.Ideal import Algebra.Matrix+import Algebra.PLM import Algebra.Z  @@ -36,9 +37,12 @@ ex6 :: Matrix Z ex6 = solve (Vec [1,2,3]) +-- ex7 :: Maybe (Matrix Z, Matrix Z)+ex7 :: Matrix Z+ex7 = solveMxN (M [Vec [1,3,-2], Vec [3,5,6]])  ------------------------------------------------------------------------------- -- PLM -ex7 :: Matrix Z-ex7 = computePLM_B (Id [2,3,4])+ex8 :: Matrix Z+ex8 = computePLM_B (Id [2,3,4])

@@ -1,9 +1,9 @@+{-# LANGUAGE TypeSynonymInstances #-} -- | A small simple matrix library. module Algebra.Matrix   ( Vector(Vec)   , unVec, lengthVec-  , Matrix(M)-  , matrix+  , Matrix(M), matrix   , matrixToVector, vectorToMatrix, unMVec, unM    , identity, mulM, addM, transpose, isSquareMatrix, dimension   ) where@@ -18,7 +18,7 @@ ------------------------------------------------------------------------------- -- | Row vectors -data Vector r = Vec [r] deriving (Eq)+newtype Vector r = Vec [r] deriving (Eq)  instance Show r => Show (Vector r) where   show (Vec vs) = show vs@@ -54,13 +54,13 @@ ------------------------------------------------------------------------------- -- | Matrices -data Matrix r = M [Vector r]+newtype Matrix r = M [Vector r]   deriving (Eq)  instance Show r => Show (Matrix r) where-  show (M xs) = case unlines $ map show xs of-    [] -> "[]"-    xs -> init xs+  show xs = case unlines (map show (unMVec xs)) of+    [] -> "[]" +    xs -> init xs ++ "\n"  instance (Eq r, Arbitrary r, Ring r) => Arbitrary (Matrix r) where   arbitrary = do n <- choose (1,10) :: Gen Int@@ -110,8 +110,9 @@  -- | Matrix addition. addM :: Ring r => Matrix r -> Matrix r -> Matrix r-addM (M xs) (M ys) | dimension (M xs) == dimension (M ys) = m-                   | otherwise = error "Bad dimensions in matrix addition"+addM (M xs) (M ys) +  | dimension (M xs) == dimension (M ys) = m+  | otherwise = error "Bad dimensions in matrix addition"   where   m = matrix (zipWith (zipWith (<+>)) (map unVec xs) (map unVec ys)) @@ -134,7 +135,7 @@ instance Ring r => Ring (Matrix r) where   (<+>) = add   (<*>) = mul-  neg (M xs d) = M [ map neg x | x <- xs ] d+  neg (Vec xs d) = Vec [ map neg x | x <- xs ] d   zero  = undefined  -} 

@@ -6,6 +6,7 @@ module Algebra.Structures.BezoutDomain   ( BezoutDomain(..)   , propBezoutDomain+  , dividesB   , intersectionB, intersectionBWitness   , solveB   ) where@@ -56,6 +57,9 @@              else whenFail (print "propIsSameIdeal") False      else whenFail (print "propToPrincipal") False +dividesB :: (BezoutDomain a, Eq a) => a -> a -> Bool+dividesB a b = a == x || a == neg x+    where (Id [x],_,_) = toPrincipal (Id [a,b])  ------------------------------------------------------------------------------- -- Euclidean domain -> Bezout domain

@@ -2,7 +2,7 @@ module Algebra.Structures.Ring    ( Ring(..)   , propRing-  , (<->), (<^>)+  , (<->), (<^>), (*>)   , sumRing, productRing   ) where @@ -11,6 +11,7 @@  infixl 8 <^> infixl 7 <*>+infixl 7 *> infixl 6 <+> infixl 6 <-> @@ -107,3 +108,11 @@ x <^> y = if y < 0               then error "<^>: Input should be positive"              else x <*> x <^> (y-1)++-- | Multiply from left with an integer; n *> x means x + x + ... + x, n times.+(*>) :: Ring a => Int -> a -> a+n *> x = sumRing $ replicate n x++-- Multiply from right with an integer.+-- (<*) :: Ring a => a -> Integer -> a+-- x <* n = sumRing $ replicate n x

@@ -0,0 +1,160 @@+{-# LANGUAGE EmptyDataDecls #-}+-- | Type level characters. Used for representing the variable name in +-- univariate polynomials.+module Algebra.TypeChar.Char where++data A_+instance Show A_ where show _ = "a"++data B_+instance Show B_ where show _ = "b"++data C_+instance Show C_ where show _ = "c"++data D_+instance Show D_ where show _ = "d"++data E_+instance Show E_ where show _ = "e"++data F_+instance Show F_ where show _ = "f"++data G_+instance Show G_ where show _ = "g"++data H_+instance Show H_ where show _ = "h"++data I_+instance Show I_ where show _ = "i"++data J_+instance Show J_ where show _ = "j"++data K_+instance Show K_ where show _ = "k"++data L_+instance Show L_ where show _ = "l"++data M_+instance Show M_ where show _ = "m"++data N_+instance Show N_ where show _ = "n"++data O_+instance Show O_ where show _ = "o"++data P_+instance Show P_ where show _ = "p"++data Q_+instance Show Q_ where show _ = "q"++data R_+instance Show R_ where show _ = "r"++data S_+instance Show S_ where show _ = "s"++data T_+instance Show T_ where show _ = "t"++data U_+instance Show U_ where show _ = "u"++data V_+instance Show V_ where show _ = "v"++data W_+instance Show W_ where show _ = "w"++data X_+instance Show X_ where show _ = "x"++data Y_+instance Show Y_ where show _ = "y"++data Z_+instance Show Z_ where show _ = "z"++data A+instance Show A where show _ = "A"++data B+instance Show B where show _ = "B"++data C+instance Show C where show _ = "C"++data D+instance Show D where show _ = "D"++data E+instance Show E where show _ = "E"++data F+instance Show F where show _ = "F"++data G+instance Show G where show _ = "G"++data H+instance Show H where show _ = "H"++data I+instance Show I where show _ = "I"++data J+instance Show J where show _ = "J"++data K+instance Show K where show _ = "K"++data L+instance Show L where show _ = "L"++data M+instance Show M where show _ = "M"++data N+instance Show N where show _ = "N"++data O+instance Show O where show _ = "O"++data P+instance Show P where show _ = "P"++data Q+instance Show Q where show _ = "Q"++data R+instance Show R where show _ = "R"++data S+instance Show S where show _ = "S"++data T+instance Show T where show _ = "T"++data U+instance Show U where show _ = "U"++data V+instance Show V where show _ = "V"++data W+instance Show W where show _ = "W"++data X+instance Show X where show _ = "X"++data Y+instance Show Y where show _ = "Y"++data Z+instance Show Z where show _ = "Z"

@@ -0,0 +1,159 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}+module Algebra.UPoly +  ( UPoly(..)+  , deg+  , Qx, x+  , toUPoly, monomial+  , lt, deriv+  , sqfr, sqfrDec+  ) where++import Data.List+import Test.QuickCheck+import Control.Monad (liftM)++import Algebra.TypeChar.Char hiding (Q)+import Algebra.Structures.Field+import Algebra.Structures.BezoutDomain+import Algebra.Structures.EuclideanDomain+import Algebra.Structures.StronglyDiscrete+import Algebra.Ideal+import Algebra.Q++-- | Polynomials over a commutative ring, indexed by a phantom type x that +-- denote the name of the variable that the polynomial is over. For example +-- UPoly Q X_ is Q[x] and UPoly Q T_ is Q[t].+newtype CommutativeRing r => UPoly r x = UP [r]+  deriving (Eq,Ord)++-- | The degree of the polynomial.+deg :: CommutativeRing r => UPoly r x -> Integer+deg (UP xs) | length xs < 2 = 0+            | otherwise = (toInteger $ length xs) - 1++-- | Useful shorthand for Q[x].+type Qx = UPoly Q X_++-- | The variable x in Q[x].+x :: Qx+x = UP [zero,one]++-- | Take a list and construct a polynomial by removing all zeroes in the end.+toUPoly :: (CommutativeRing r, Eq r) => [r] -> UPoly r x+toUPoly = UP . reverse . dropWhile (==zero) . reverse++-- | Take an element of the ring and the degree of the desired monomial, for +-- example: monomial 3 7 = 3x^7+monomial :: CommutativeRing r => r -> Integer -> UPoly r x+monomial a i = UP $ replicate (fromInteger i) zero ++ [a]++-- | Compute the leading term of a polynomial.+lt :: CommutativeRing r => UPoly r x -> r+lt (UP []) = zero+lt (UP xs) = last xs++-- | Formal derivative of polynomials in k[x].+deriv :: CommutativeRing r => UPoly r x -> UPoly r x+deriv (UP ps) = UP $ zipWith (*>) [1..] (tail ps)++-- | Funny integration:+integrate :: (Enum b, Field b, Integral k, Field k, Fractional b) => UPoly k x -> UPoly b x+integrate (UP ps) = UP $ 0.0 : zipWith (/) (map fromIntegral ps) [1..]++instance (CommutativeRing r, Eq r, Show r, Show x) => Show (UPoly r x) where+  show (UP []) = "0"+  show (UP ps) = init $ fixSign $ concat +                  [ show' (show (undefined :: x)) p n+                  | (p,n) <- zip ps [0..]+                  , p /= zero ]+    where+    show' :: (CommutativeRing r, Show r) => String -> r -> Integer -> String+    show' x p 0 = show p ++ "+"+    show' x p 1 = if p == one then x ++ "+" else show p ++ x ++ "+"+    show' x p n = if p == one  +                     then x ++ "^" ++ show n ++ "+" +                     else show p ++ x ++ "^" ++ show n ++ "+"+    +    fixSign []  = []+    fixSign [x] = [x]+    fixSign ('+':'-':xs) = '-' : fixSign xs+    fixSign (x:xs)       = x : fixSign xs++instance (CommutativeRing r, Eq r, Arbitrary r) => Arbitrary (UPoly r x) where+  arbitrary = liftM (toUPoly . take 5) arbitrary++-- Addition of polynomials.+addUP :: (CommutativeRing r, Eq r) => UPoly r x -> UPoly r x -> UPoly r x+addUP (UP ps) (UP qs) | length ps >= length qs = add' ps qs +                      | otherwise              = add' qs ps+  where add' a b = toUPoly $ zipWith (<+>) a b ++ drop (length b) a ++-- Multiplication of polynomials.+mulUP :: (CommutativeRing r, Eq r) => UPoly r x -> UPoly r x -> UPoly r x+mulUP (UP ps) (UP qs) = toUPoly $ m ps qs 0+  where+  m ps qs r | r > length ps + length qs - 2 = []+            | otherwise = c r 0 (length ps-1) (length qs-1) : m ps qs (r+1)+  +  c (-1) _ _ _ = zero+  c r k m n | r > m || k > n = c (r-1) (k+1) m n+            | otherwise      = ps !! r <*> qs !! k <+> c (r-1) (k+1) m n++instance (CommutativeRing r, Eq r) => Ring (UPoly r x) where+  (<+>)       = addUP+  zero        = UP []+  one         = UP [one]+  neg (UP ps) = UP $ map neg ps+  (<*>)       = mulUP++instance (Show r, Field r, Num r, Show x) => Num (UPoly r x) where+  (+)    = (<+>)+  (-)    = (<->)+  (*)    = (<*>)+  abs    = fromInteger . d+  signum = undefined -- Is it possible to define this?+  fromInteger x = UP [fromInteger x]++instance (CommutativeRing r, Eq r) => CommutativeRing (UPoly r x) where+instance (CommutativeRing r, Eq r) => IntegralDomain (UPoly r x) where++-- Polynomial rings are Euclidean.+instance (Field k, Eq k) => EuclideanDomain (UPoly k x) where+  d (UP ps)             = fromIntegral (length ps) - 1+  quotientRemainder f g = qr zero f+    where+    -- This is the division algorithm in k[x]. Page 39 in Cox.+    qr q r | d g <= d r = qr (q <+> monomial (lt r </> lt g) (d r - d g))+                            (r <-> monomial (lt r </> lt g) (d r - d g) <*> g)+           | otherwise = (q,r)++-- Now that we know that the polynomial ring k[x] is a Bezout domain it is+-- possible to implement membership in an ideal of k[x]. f is a member of the+-- ideal <f1,...,fn> if the rest is zero when dividing f with the principal+-- ideal <h>.+-- instance (Field k, Eq k, Show x) => StronglyDiscrete (UPoly k x) where+--  member p ps = modulo p h == zero +--    where Id [h] = (\(a,_,_) -> a) $ toPrincipal ps++-- Square free decomposition.+-- Teo Mora; Solving Polynomial Equations Systems I. pg 69-70+-- Works only for Char 0+--TODO: Add check for char+--square free associate of f+-- | Square free decomposition of a polynomial. +sqfr :: (Num k, Field k) => UPoly k x -> UPoly k x+sqfr f = f `quotient` euclidAlg f f'+  where f' = deriv f++-- | Distinct power factorization, aka square free decomposition+sqfrDec :: (Num k, Field k) => UPoly k x -> [UPoly k x]+sqfrDec f = help p q+  where +  p = euclidAlg f (deriv f)+  q = f `quotient` p +  +  help p q | d q < 1    = []+           | otherwise  = t : help (p `quotient` s) s+    where +    s = euclidAlg p q+    t = q `quotient` s