-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Combinatorics, group theory, commutative algebra, non-commutative algebra -- -- Math library - combinatorics, group theory, commutative algebra, -- non-commutative algebra @package HaskellForMaths @version 0.1.8 module Math.Algebra.Group.StringRewriting newtype S S :: Int -> S instance Eq S instance Ord S instance Show S module Math.Common.ListSet module Math.Algebra.Group.PermutationGroup -- | Type for permutations, considered as group elements. newtype Permutation a P :: (Map a a) -> Permutation a -- | x .^ g returns the image of a vertex or point x under the action of -- the permutation g. The dot is meant to be a mnemonic for point or -- vertex. (.^) :: (Ord k) => k -> Permutation k -> k -- | b -^ g returns the image of an edge or block b under the action of the -- permutation g The dash is meant to be a mnemonic for edge or line or -- block. (-^) :: (Ord t) => [t] -> Permutation t -> [t] -- | Construct a permutation from a list of cycles. For example, p -- [[1,2,3],[4,5]] returns the permutation that sends 1 to 2, 2 to 3, 3 -- to 1, 4 to 5, 5 to 4 p :: (Ord a) => [[a]] -> Permutation a -- | A trick: g^-1 returns the inverse of g (^-) :: (Ord k, Show k) => Permutation k -> Int -> Permutation k -- | g ~^ h returns the conjugate of g by h. The tilde is meant to a -- mnemonic, because conjugacy is an equivalence relation. (~^) :: (Ord t, Show t) => Permutation t -> Permutation t -> Permutation t -- | x .^^ gs returns the orbit of the point or vertex x under the action -- of the gs (.^^) :: (Ord a) => a -> [Permutation a] -> [a] -- | b -^^ gs returns the orbit of the block or edge b under the action of -- the gs (-^^) :: (Ord t) => [t] -> [Permutation t] -> [[t]] -- | _C n returns generators for Cn, the cyclic group of order n _C :: (Integral a) => a -> [Permutation a] -- | _S n returns generators for Sn, the symmetric group on [1..n] _S :: (Integral a) => a -> [Permutation a] -- | _A n returns generators for An, the alternating group on [1..n] _A :: (Integral a) => a -> [Permutation a] -- | Given generators for a group, return a (sorted) list of all elements -- of the group. Implemented using a naive closure algorithm, so only -- suitable for small groups (|G| < 10000) elts :: (Num a, Ord a) => [a] -> [a] -- | Given generators for a group, return the order of the group (the -- number of elements). Implemented using a naive closure algorithm, so -- only suitable for small groups (|G| < 10000) order :: (Num a, Ord a) => [a] -> Int -- | conjClassReps gs returns a conjugacy class representatives and sizes -- for the group generated by gs. This implementation is only suitable -- for use with small groups (|G| < 10000). conjClassReps :: (Ord t, Show t) => [Permutation t] -> [(Permutation t, Int)] instance (Eq a) => Eq (Permutation a) instance (Ord a) => Ord (Permutation a) instance (Ord a, Show a) => Fractional (Permutation a) instance (Ord a, Show a) => Num (Permutation a) instance (Ord a, Show a) => Show (Permutation a) module Math.Algebra.Group.SchreierSims -- | Given generators for a group, determine whether a permutation is a -- member of the group, using Schreier-Sims algorithm isMember :: (Ord t, Show t) => [Permutation t] -> Permutation t -> Bool -- | Given generators for a group, return a (sorted) list of all elements -- of the group, using Schreier-Sims algorithm elts :: (Ord t, Show t) => [Permutation t] -> [Permutation t] -- | Given generators for a group, return the order of the group (the -- number of elements), using Schreier-Sims algorithm order :: (Ord t, Show t) => [Permutation t] -> Integer -- | A module defining a polymorphic data type for (simple, undirected) -- graphs, together with constructions of some common families of graphs, -- new from old constructions, and calculation of simple properties of -- graphs. module Math.Combinatorics.Graph -- | combinationsOf k xs returns the subsets of xs of size k. If xs is in -- ascending order, then the returned list is in ascending order combinationsOf :: (Integral t) => t -> [a] -> [[a]] -- | Datatype for graphs, represented as a list of vertices and a list of -- edges. Both the list of vertices and the list of edges, and also the -- 2-element lists representing the edges, are required to be in -- ascending order, without duplicates. data Graph a G :: [a] -> [[a]] -> Graph a -- | Safe constructor for graph from lists of vertices and edges. graph -- (vs,es) checks that vs and es are valid before returning the graph. graph :: (Ord t) => ([t], [[t]]) -> Graph t nullGraph :: Graph Int -- | c n is the cyclic graph on n vertices c :: (Integral t) => t -> Graph t -- | k n is the complete graph on n vertices k :: (Integral t) => t -> Graph t -- | Given a graph with vertices which are lists of small integers, eg -- [1,2,3], return a graph with vertices which are the numbers obtained -- by interpreting these as digits, eg 123. The caller is responsible for -- ensuring that this makes sense (eg that the small integers are all -- < 10) fromDigits :: (Integral a) => Graph [a] -> Graph a -- | Given a graph with vertices which are lists of 0s and 1s, return a -- graph with vertices which are the numbers obtained by interpreting -- these as binary digits. For example, [1,1,0] -> 6. fromBinary :: (Integral a) => Graph [a] -> Graph a -- | The diameter of a graph is maximum distance between two distinct -- vertices diameter :: (Ord t) => Graph t -> Int -- | The girth of a graph is the size of the smallest cycle that it -- contains. Note: If the graph contains no cycles, we return -1, -- representing infinity. girth :: (Eq t) => Graph t -> Int -- | kneser n k returns the kneser graph KG n,k - whose vertices are the -- k-element subsets of [1..n], with edges joining disjoint subsets kneser :: (Integral t) => t -> t -> Graph [t] instance (Eq a) => Eq (Graph a) instance (Ord a) => Ord (Graph a) instance (Show a) => Show (Graph a) module Math.Combinatorics.GraphAuts -- | Given a graph g, graphAuts g returns a strong generating set for the -- automorphism group of g. graphAuts :: (Ord a) => Graph a -> [Permutation a] module Math.Projects.Rubik module Math.Common.IntegerAsType class IntegerAsType a value :: (IntegerAsType a) => a -> Integer data M a b M :: a -> b -> M a b data TMinus1 data TZero data TOne data T2 data T3 data T5 data T7 data T11 data T13 data T17 data T19 data T23 data T29 data T31 data T37 data T41 data T43 data T47 data T53 data T59 data T61 data T67 data T71 data T73 data T79 data T83 data T89 data T97 instance IntegerAsType T97 instance IntegerAsType T89 instance IntegerAsType T83 instance IntegerAsType T79 instance IntegerAsType T73 instance IntegerAsType T71 instance IntegerAsType T67 instance IntegerAsType T61 instance IntegerAsType T59 instance IntegerAsType T53 instance IntegerAsType T47 instance IntegerAsType T43 instance IntegerAsType T41 instance IntegerAsType T37 instance IntegerAsType T31 instance IntegerAsType T29 instance IntegerAsType T23 instance IntegerAsType T19 instance IntegerAsType T17 instance IntegerAsType T13 instance IntegerAsType T11 instance IntegerAsType T7 instance IntegerAsType T5 instance IntegerAsType T3 instance IntegerAsType T2 instance IntegerAsType TOne instance IntegerAsType TZero instance IntegerAsType TMinus1 instance (IntegerAsType a, IntegerAsType b) => IntegerAsType (M a b) module Math.Algebra.Commutative.Monomial newtype Monomial ord Monomial :: (Map String Int) -> Monomial ord -- | Phantom type representing lex term ordering data Lex -- | Phantom type representing glex term ordering data Glex -- | Phantom type representing grevlex term ordering data Grevlex -- | Phantom type for an elimination term ordering. In the ordering, xis -- come before yjs come before zks, but within the xis, or yjs, or zks, -- grevlex ordering is used data Elim convertM :: Monomial a -> Monomial b supportM :: Monomial ord -> [Monomial ord] instance Eq (Monomial ord) instance Ord (Monomial Elim) instance Ord (Monomial Grevlex) instance Ord (Monomial Glex) instance Ord (Monomial Lex) instance Fractional (Monomial ord) instance Num (Monomial ord) instance Show (Monomial ord) module Math.Algebra.Field.Base -- | Q is just the rationals, but with a better show function than the -- Prelude version newtype Q Q :: Rational -> Q newtype Fp n Fp :: Integer -> Fp n class (Fractional fq) => FiniteField fq eltsFq :: (FiniteField fq) => fq -> [fq] basisFq :: (FiniteField fq) => fq -> [fq] -- | F2 is a type for the finite field with 2 elements type F2 = Fp T2 -- | f2 lists the elements of F2 f2 :: [F2] -- | F3 is a type for the finite field with 3 elements type F3 = Fp T3 -- | f3 lists the elements of F3 f3 :: [F3] -- | F5 is a type for the finite field with 5 elements type F5 = Fp T5 -- | f5 lists the elements of F5 f5 :: [F5] -- | F7 is a type for the finite field with 7 elements type F7 = Fp T7 -- | f7 lists the elements of F7 f7 :: [F7] type F11 = Fp T11 type F13 = Fp T13 type F17 = Fp T17 type F19 = Fp T19 type F23 = Fp T23 type F29 = Fp T29 type F31 = Fp T31 type F37 = Fp T37 type F41 = Fp T41 type F43 = Fp T43 type F47 = Fp T47 type F53 = Fp T53 type F59 = Fp T59 type F61 = Fp T61 type F67 = Fp T67 type F71 = Fp T71 type F73 = Fp T73 type F79 = Fp T79 type F83 = Fp T83 type F89 = Fp T89 type F97 = Fp T97 instance Eq (Fp n) instance Ord (Fp n) instance Eq Q instance Ord Q instance Num Q instance Fractional Q instance (IntegerAsType p) => FiniteField (Fp p) instance (IntegerAsType n) => Fractional (Fp n) instance (IntegerAsType n) => Num (Fp n) instance Show (Fp n) instance Show Q module Math.Algebra.Commutative.MPoly -- | Type for multivariate polynomials. ord is a phantom type defining how -- terms are ordered, r is the type of the ring we are working over. For -- example, a common choice will be MPoly Grevlex Q, meaning polynomials -- over Q with the grevlex term ordering newtype MPoly ord r MP :: [(Monomial ord, r)] -> MPoly ord r -- | Create a variable with the supplied name. By convention, variable -- names should usually be a single letter followed by none, one or two -- digits. var :: String -> MPoly Grevlex Q b :: MPoly Grevlex Q c :: MPoly Grevlex Q d :: MPoly Grevlex Q s :: MPoly Grevlex Q t :: MPoly Grevlex Q u :: MPoly Grevlex Q v :: MPoly Grevlex Q w :: MPoly Grevlex Q x :: MPoly Grevlex Q y :: MPoly Grevlex Q z :: MPoly Grevlex Q a :: MPoly Grevlex Q x1 :: MPoly Grevlex Q x2 :: MPoly Grevlex Q x3 :: MPoly Grevlex Q x0 :: MPoly Grevlex Q -- | Convert a polynomial to lex term ordering toLex :: MPoly ord k -> MPoly Lex k -- | Convert a polynomial to glex term ordering toGlex :: MPoly ord k -> MPoly Glex k -- | Convert a polynomial to grevlex term ordering toGrevlex :: MPoly ord k -> MPoly Grevlex k toElim :: MPoly ord k -> MPoly Elim k instance (Eq r) => Eq (MPoly ord r) instance (Ord (Monomial ord), Fractional r) => Fractional (MPoly ord r) instance (Ord (Monomial ord), Num r) => Num (MPoly ord r) instance (Show r, Num r) => Show (MPoly ord r) instance (Ord (Monomial ord), Ord r) => Ord (MPoly ord r) module Math.Algebra.Commutative.GBasis -- | Given a list of polynomials over a field, return a Groebner basis for -- the ideal generated by the polynomials gb :: (Ord (Monomial ord), Fractional k, Ord k) => [MPoly ord k] -> [MPoly ord k] module Math.Algebra.Field.Extension newtype UPoly a UP :: [a] -> UPoly a quotRemUP :: (Num k, Fractional k) => UPoly k -> UPoly k -> (UPoly k, UPoly k) class PolynomialAsType k poly pvalue :: (PolynomialAsType k poly) => (k, poly) -> UPoly k data ExtensionField k poly Ext :: (UPoly k) -> ExtensionField k poly data ConwayF4 type F4 = ExtensionField F2 ConwayF4 data ConwayF8 type F8 = ExtensionField F2 ConwayF8 data ConwayF9 type F9 = ExtensionField F3 ConwayF9 data ConwayF16 type F16 = ExtensionField F2 ConwayF16 data ConwayF25 type F25 = ExtensionField F5 ConwayF25 data ConwayF27 type F27 = ExtensionField F3 ConwayF27 data ConwayF32 type F32 = ExtensionField F2 ConwayF32 data Sqrt a Sqrt :: a -> Sqrt a type QSqrt2 = ExtensionField Q (Sqrt T2) type QSqrt3 = ExtensionField Q (Sqrt T3) type QSqrt5 = ExtensionField Q (Sqrt T5) type QSqrt7 = ExtensionField Q (Sqrt T7) type QSqrtMinus1 = ExtensionField Q (Sqrt TMinus1) type QSqrtMinus2 = ExtensionField Q (Sqrt (M TMinus1 T2)) type QSqrtMinus3 = ExtensionField Q (Sqrt (M TMinus1 T3)) type QSqrtMinus5 = ExtensionField Q (Sqrt (M TMinus1 T5)) conjugate :: ExtensionField Q (Sqrt d) -> ExtensionField Q (Sqrt d) instance (Eq k) => Eq (ExtensionField k poly) instance (Ord k) => Ord (ExtensionField k poly) instance (Eq a) => Eq (UPoly a) instance (Ord a) => Ord (UPoly a) instance (IntegerAsType n) => PolynomialAsType Q (Sqrt n) instance PolynomialAsType F2 ConwayF32 instance PolynomialAsType F3 ConwayF27 instance PolynomialAsType F5 ConwayF25 instance PolynomialAsType F2 ConwayF16 instance PolynomialAsType F3 ConwayF9 instance PolynomialAsType F2 ConwayF8 instance PolynomialAsType F2 ConwayF4 instance (FiniteField k, PolynomialAsType k poly) => FiniteField (ExtensionField k poly) instance (Num k, Fractional k, PolynomialAsType k poly) => Fractional (ExtensionField k poly) instance (Num k, Fractional k, PolynomialAsType k poly) => Num (ExtensionField k poly) instance (Num k) => Show (ExtensionField k poly) instance (Num a) => Num (UPoly a) instance (Show a, Num a) => Show (UPoly a) module Math.Algebra.NonCommutative.NCPoly newtype Monomial v M :: [v] -> Monomial v newtype NPoly r v NP :: [(Monomial v, r)] -> NPoly r v data Var X :: Var Y :: Var Z :: Var class Invertible a inv :: (Invertible a) => a -> a instance Eq Var instance Ord Var instance (Eq r, Eq v) => Eq (NPoly r v) instance (Eq v) => Eq (Monomial v) instance Show Var instance (Ord v, Show v, Fractional r) => Fractional (NPoly r v) instance (Ord v, Show v, Num r) => Num (NPoly r v) instance (Show r, Eq v, Show v) => Show (NPoly r v) instance (Ord r, Ord v) => Ord (NPoly r v) instance (Eq v, Show v) => Num (Monomial v) instance (Show v) => Show (Monomial v) instance (Ord v) => Ord (Monomial v) module Math.Algebra.NonCommutative.GSBasis module Math.Algebra.NonCommutative.TensorAlgebra data Basis E :: Int -> Basis data WeylGens X :: Int -> WeylGens D :: Int -> WeylGens instance Eq WeylGens instance Ord WeylGens instance Eq Basis instance Ord Basis instance Show WeylGens instance Show Basis module Math.Projects.KnotTheory.LaurentMPoly newtype LaurentMonomial LM :: (Map String Q) -> LaurentMonomial newtype LaurentMPoly r LP :: [(LaurentMonomial, r)] -> LaurentMPoly r instance (Eq r) => Eq (LaurentMPoly r) instance (Ord r) => Ord (LaurentMPoly r) instance Eq LaurentMonomial instance (Fractional r) => Fractional (LaurentMPoly r) instance (Num r) => Num (LaurentMPoly r) instance (Show r) => Show (LaurentMPoly r) instance Fractional LaurentMonomial instance Num LaurentMonomial instance Show LaurentMonomial instance Ord LaurentMonomial module Math.Projects.KnotTheory.Braid type LPQ = LaurentMPoly Q data BraidGens S :: Int -> BraidGens instance Eq BraidGens instance Ord BraidGens instance Invertible (NPoly LPQ BraidGens) instance Show BraidGens instance Invertible LPQ module Math.Projects.KnotTheory.TemperleyLieb data TemperleyLiebGens E :: Int -> TemperleyLiebGens instance Eq TemperleyLiebGens instance Ord TemperleyLiebGens instance Show TemperleyLiebGens module Math.Projects.KnotTheory.IwahoriHecke data IwahoriHeckeGens T :: Int -> IwahoriHeckeGens instance Eq IwahoriHeckeGens instance Ord IwahoriHeckeGens instance Invertible (NPoly LPQ IwahoriHeckeGens) instance Show IwahoriHeckeGens -- | A module providing elementary operations involving scalars, vectors, -- and matrices over a ring or field. Vectors are represented as [a], -- matrices as [[a]]. (No distinction is made between row and column -- vectors.) It is the caller's responsibility to ensure that the lists -- have the correct number of elements. -- -- The mnemonic for many of the arithmetic operations is that the number -- of angle brackets on each side indicates the dimension of the argument -- on that side. For example, v *> m is multiplication of a -- vector on the left by a matrix on the right. module Math.Algebra.LinearAlgebra -- | u + v returns the sum u+v of vectors (<+>) :: (Num a) => [a] -> [a] -> [a] -- | u - v returns the difference u-v of vectors (<->) :: (Num a) => [a] -> [a] -> [a] -- | k *> v returns the product k*v of the scalar k and the vector v (*>) :: (Num a) => a -> [a] -> [a] -- | u . v returns the dot product of vectors (also called inner or -- scalar product) (<.>) :: (Num a) => [a] -> [a] -> a -- | u * v returns the tensor product of vectors (also called outer -- or matrix product) (<*>) :: (Num a) => [a] -> [a] -> [[a]] -- | a b returns the sum a+b of matrices (<<+>>) :: (Num a) => [[a]] -> [[a]] -> [[a]] -- | a b returns the difference a-b of matrices (<<->>) :: (Num a) => [[a]] -> [[a]] -> [[a]] -- | a b returns the product a*b of matrices (<<*>>) :: (Num a) => [[a]] -> [[a]] -> [[a]] -- | k *> m returns the product k*m of the scalar k and the matrix m (*>>) :: (Num a) => a -> [[a]] -> [[a]] -- | m <* v is multiplication of a vector by a matrix on the left (<<*>) :: (Num a) => [[a]] -> [a] -> [a] -- | v *> m is multiplication of a vector by a matrix on the -- right (<*>>) :: (Num a) => [a] -> [[a]] -> [a] -- | iMx n is the n*n identity matrix iMx :: (Num t) => Int -> [[t]] -- | jMx n is the n*n matrix of all 1s jMx :: (Num t) => Int -> [[t]] -- | zMx n is the n*n matrix of all 0s zMx :: (Num t) => Int -> [[t]] -- | The inverse of a matrix (over a field), if it exists inverse :: (Fractional a) => [[a]] -> Maybe [[a]] reducedRowEchelonForm :: (Fractional a) => [[a]] -> [[a]] -- | The determinant of a matrix (over a field) det :: (Fractional a) => [[a]] -> a -- | Constructions of the finite geometries AG(n,Fq) and PG(n,Fq), their -- points, lines and flats, together with the incidence graphs between -- points and lines. module Math.Combinatorics.FiniteGeometry -- | ptsAG n fq returns the points of the affine geometry AG(n,Fq), where -- fq are the elements of Fq ptsAG :: (FiniteField a) => Int -> [a] -> [[a]] -- | ptsPG n fq returns the points of the projective geometry PG(n,Fq), -- where fq are the elements of Fq ptsPG :: (FiniteField a) => Int -> [a] -> [[a]] data ZeroOneStar Zero :: ZeroOneStar One :: ZeroOneStar Star :: ZeroOneStar -- | flatsPG n fq k returns the k-flats in PG(n,Fq), where fq are the -- elements of Fq flatsPG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]] -- | flatsAG n fq k returns the k-flats in AG(n,Fq), where fq are the -- elements of Fq flatsAG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]] -- | The lines (1-flats) in PG(n,fq) linesPG :: (FiniteField a) => Int -> [a] -> [[[a]]] -- | The lines (1-flats) in AG(n,fq) linesAG :: (FiniteField a) => Int -> [a] -> [[[a]]] -- | Incidence graph of PG(n,fq), considered as an incidence structure -- between points and lines incidenceGraphPG :: (Ord a, FiniteField a) => Int -> [a] -> Graph (Either [a] [[a]]) -- | Incidence graph of AG(n,fq), considered as an incidence structure -- between points and lines incidenceGraphAG :: (Ord a, FiniteField a) => Int -> [a] -> Graph (Either [a] [[a]]) instance Eq ZeroOneStar instance Show ZeroOneStar module Math.Combinatorics.Design data Design a D :: [a] -> [[a]] -> Design a instance (Eq a) => Eq (Design a) instance (Ord a) => Ord (Design a) instance (Show a) => Show (Design a) module Math.Combinatorics.StronglyRegularGraph data DesignVertex C :: DesignVertex P :: Integer -> DesignVertex B :: [Integer] -> DesignVertex instance Eq DesignVertex instance Ord DesignVertex instance Show DesignVertex module Math.Combinatorics.Hypergraph data Hypergraph a H :: [a] -> [[a]] -> Hypergraph a data Incidence a P :: a -> Incidence a B :: [a] -> Incidence a instance (Eq a) => Eq (Incidence a) instance (Ord a) => Ord (Incidence a) instance (Show a) => Show (Incidence a) instance (Eq a) => Eq (Hypergraph a) instance (Ord a) => Ord (Hypergraph a) instance (Show a) => Show (Hypergraph a) module Math.Projects.RootSystem data Type A :: Type B :: Type C :: Type D :: Type E :: Type F :: Type G :: Type basisElt :: Int -> Int -> [Q] module Math.Projects.ChevalleyGroup.Classical module Math.Projects.ChevalleyGroup.Exceptional newtype Octonion k O :: [(Int, k)] -> Octonion k instance (Eq k) => Eq (Octonion k) instance (Ord k) => Ord (Octonion k) instance (Ord k, Num k, Fractional k) => Fractional (Octonion k) instance (Ord k, Num k) => Num (Octonion k) instance (Show k) => Show (Octonion k)