├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── propagator.jpg ├── src ├── Control │ ├── Algebra.idr │ └── Algebra │ │ ├── NumericInstances.idr │ │ └── VectorSpace.idr ├── Data │ ├── Matrix.idr │ ├── Matrix │ │ ├── Algebraic.idr │ │ └── Numeric.idr │ └── ZZ.idr ├── xquant.idr └── xquant │ ├── Base.idr │ ├── Core │ ├── Epsilon.idr │ ├── Helicity.idr │ ├── Interpretation.idr │ ├── NonZero.idr │ ├── Spectrum.idr │ └── Types.idr │ ├── Graph │ ├── Feynman.idr │ └── Marked.idr │ ├── Math │ ├── Hilbert.idr │ └── Set.idr │ └── Spinor │ ├── BKS.idr │ ├── Gamma.idr │ ├── SigKets.idr │ └── Sigmas.idr └── xquant.ipkg /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc 2 | .DS_Store 3 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | 3 | install: 4 | - cabal install idris 5 | 6 | script: 7 | - idris --install xquant.ipkg 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Clifford Scott Harvey 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | xquant [![Build Status](https://travis-ci.org/BlackBrane/xquant.svg?branch=master)](https://travis-ci.org/BlackBrane/xquant) 2 | ======= 3 | 4 | Relativity and quantum mechanics. Dependently-typed structures for physics in Idris. 5 | 6 | ![Feynman Propagator](propagator.jpg) 7 | 8 | _Feynman propagator with mass 20. [(Cyp)](https://commons.wikimedia.org/wiki/File:FeynmanPropagatorWithMass20.jpg)_ 9 | 10 | --- 11 | 12 | A set of Idris libraries for relativity and quantum physics, exploring library design for 13 | physical computations in the presence of full dependent types. 14 | 15 | Much of the functionality is not sufficiently performant for serious work, which could be addressed 16 | by interfacing with another runtime. For now the library is to be considered a prototype. 17 | 18 | Idris v0.19 at least is probably required. 19 | 20 | --- 21 | 22 | _Notes on a few constituent modules._ 23 | 24 | 25 | #### Sigmas 26 | Data types representing the quantum operators of the _n_-qubit state space, and functions on them, especially implementing their algebra. 27 | 28 | #### SigKets 29 | Data types for _n_-qubit state vectors, and functions involving both vectors and operators. In particular, we can calculate outcome probabilities and expectation values for any observables. 30 | 31 | #### Gamma 32 | Writing down a field theory for fermions requires a representation of the gamma matrix algebra. In even dimensions _(d = 2k + 2)_ this is a set of _d_ square matrixes with size _2^(k+1)_. The next odd-dimensional representation is formed by adding an additional matrix of the same size, corresponding to the product of all the others. We implement functions to recursively define gamma matrices of arbitrary dimension starting with _d = 2_. These numerical properties are enforced by the type system. 33 | 34 | #### Marked 35 | Data type `Marks` representing the number of ways to choose _n_ objects from a set of _m_, along with related functions and proofs. Used to make `ScalarGraph`s. 36 | 37 | #### Feynman 38 | Data type for correct-by-construction Feynman graph topologies with a fixed interaction order, i.e. a fixed number of line-endpoints connected to each vertex. 39 | 40 | #### Helicity 41 | Various constructions needed for the spinor helicity formalism for scattering amplitudes in quantum field theory. 42 | 43 | #### Spectrum 44 | Type-safe representations of quantum energy spectra and basis vectors, with cardinalities and degeneracies specified at the type level. Separate types for finite versus infinite dimensional systems. 45 | -------------------------------------------------------------------------------- /propagator.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fieldstrength/xquant/b94d87609aa63af2d88b6cca50f85b58a00fc92f/propagator.jpg -------------------------------------------------------------------------------- /src/Control/Algebra.idr: -------------------------------------------------------------------------------- 1 | module Control.Algebra 2 | 3 | infixl 6 <-> 4 | infixl 7 <.> 5 | 6 | 7 | ||| Sets equipped with a single binary operation that is associative, along with 8 | ||| a neutral element for that binary operation and inverses for all elements. 9 | ||| Must satisfy the following laws: 10 | ||| + Associativity of `<+>`: 11 | ||| forall a b c, a <+> (b <+> c) == (a <+> b) <+> c 12 | ||| + Neutral for `<+>`: 13 | ||| forall a, a <+> neutral == a 14 | ||| forall a, neutral <+> a == a 15 | ||| + Inverse for `<+>`: 16 | ||| forall a, a <+> inverse a == neutral 17 | ||| forall a, inverse a <+> a == neutral 18 | class Monoid a => Group a where 19 | inverse : a -> a 20 | 21 | (<->) : Group a => a -> a -> a 22 | (<->) left right = left <+> (inverse right) 23 | 24 | ||| Sets equipped with a single binary operation that is associative and 25 | ||| commutative, along with a neutral element for that binary operation and 26 | ||| inverses for all elements. Must satisfy the following laws: 27 | ||| 28 | ||| + Associativity of `<+>`: 29 | ||| forall a b c, a <+> (b <+> c) == (a <+> b) <+> c 30 | ||| + Commutativity of `<+>`: 31 | ||| forall a b, a <+> b == b <+> a 32 | ||| + Neutral for `<+>`: 33 | ||| forall a, a <+> neutral == a 34 | ||| forall a, neutral <+> a == a 35 | ||| + Inverse for `<+>`: 36 | ||| forall a, a <+> inverse a == neutral 37 | ||| forall a, inverse a <+> a == neutral 38 | class Group a => AbelianGroup a where { } 39 | 40 | ||| Sets equipped with two binary operations, one associative and commutative 41 | ||| supplied with a neutral element, and the other associative, with 42 | ||| distributivity laws relating the two operations. Must satisfy the following 43 | ||| laws: 44 | ||| 45 | ||| + Associativity of `<+>`: 46 | ||| forall a b c, a <+> (b <+> c) == (a <+> b) <+> c 47 | ||| + Commutativity of `<+>`: 48 | ||| forall a b, a <+> b == b <+> a 49 | ||| + Neutral for `<+>`: 50 | ||| forall a, a <+> neutral == a 51 | ||| forall a, neutral <+> a == a 52 | ||| + Inverse for `<+>`: 53 | ||| forall a, a <+> inverse a == neutral 54 | ||| forall a, inverse a <+> a == neutral 55 | ||| + Associativity of `<.>`: 56 | ||| forall a b c, a <.> (b <.> c) == (a <.> b) <.> c 57 | ||| + Distributivity of `<.>` and `<+>`: 58 | ||| forall a b c, a <.> (b <+> c) == (a <.> b) <+> (a <.> c) 59 | ||| forall a b c, (a <+> b) <.> c == (a <.> c) <+> (b <.> c) 60 | class AbelianGroup a => Ring a where 61 | (<.>) : a -> a -> a 62 | 63 | ||| Sets equipped with two binary operations, one associative and commutative 64 | ||| supplied with a neutral element, and the other associative supplied with a 65 | ||| neutral element, with distributivity laws relating the two operations. Must 66 | ||| satisfy the following laws: 67 | ||| 68 | ||| + Associativity of `<+>`: 69 | ||| forall a b c, a <+> (b <+> c) == (a <+> b) <+> c 70 | ||| + Commutativity of `<+>`: 71 | ||| forall a b, a <+> b == b <+> a 72 | ||| + Neutral for `<+>`: 73 | ||| forall a, a <+> neutral == a 74 | ||| forall a, neutral <+> a == a 75 | ||| + Inverse for `<+>`: 76 | ||| forall a, a <+> inverse a == neutral 77 | ||| forall a, inverse a <+> a == neutral 78 | ||| + Associativity of `<.>`: 79 | ||| forall a b c, a <.> (b <.> c) == (a <.> b) <.> c 80 | ||| + Neutral for `<.>`: 81 | ||| forall a, a <.> unity == a 82 | ||| forall a, unity <.> a == a 83 | ||| + Distributivity of `<.>` and `<+>`: 84 | ||| forall a b c, a <.> (b <+> c) == (a <.> b) <+> (a <.> c) 85 | ||| forall a b c, (a <+> b) <.> c == (a <.> c) <+> (b <.> c) 86 | class Ring a => RingWithUnity a where 87 | unity : a 88 | 89 | ||| Sets equipped with two binary operations – both associative, commutative and 90 | ||| possessing a neutral element – and distributivity laws relating the two 91 | ||| operations. All elements except the additive identity must have a 92 | ||| multiplicative inverse. Must satisfy the following laws: 93 | ||| 94 | ||| + Associativity of `<+>`: 95 | ||| forall a b c, a <+> (b <+> c) == (a <+> b) <+> c 96 | ||| + Commutativity of `<+>`: 97 | ||| forall a b, a <+> b == b <+> a 98 | ||| + Neutral for `<+>`: 99 | ||| forall a, a <+> neutral == a 100 | ||| forall a, neutral <+> a == a 101 | ||| + Inverse for `<+>`: 102 | ||| forall a, a <+> inverse a == neutral 103 | ||| forall a, inverse a <+> a == neutral 104 | ||| + Associativity of `<.>`: 105 | ||| forall a b c, a <.> (b <.> c) == (a <.> b) <.> c 106 | ||| + Unity for `<.>`: 107 | ||| forall a, a <.> unity == a 108 | ||| forall a, unity <.> a == a 109 | ||| + InverseM of `<.>`, except for neutral 110 | ||| forall a /= neutral, a <.> inverseM a == unity 111 | ||| forall a /= neutral, inverseM a <.> a == unity 112 | ||| + Distributivity of `<.>` and `<+>`: 113 | ||| forall a b c, a <.> (b <+> c) == (a <.> b) <+> (a <.> c) 114 | ||| forall a b c, (a <+> b) <.> c == (a <.> c) <+> (b <.> c) 115 | class RingWithUnity a => Field a where 116 | inverseM : (x : a) -> Not (x = Algebra.neutral) -> a 117 | 118 | sum' : (Foldable t, Monoid a) => t a -> a 119 | sum' = concat 120 | 121 | product' : (Foldable t, RingWithUnity a) => t a -> a 122 | product' = foldr (<.>) unity 123 | 124 | pow' : RingWithUnity a => a -> Nat -> a 125 | pow' _ Z = unity 126 | pow' x (S n) = x <.> pow' x n 127 | 128 | 129 | -- XXX todo: 130 | -- Structures where "abs" make sense. 131 | -- Euclidean domains, etc. 132 | -- Where to put fromInteger and fromRational? 133 | -------------------------------------------------------------------------------- /src/Control/Algebra/NumericInstances.idr: -------------------------------------------------------------------------------- 1 | ||| Instances of algebraic classes (group, ring, etc) for numeric data types, 2 | ||| and Complex number types. 3 | module Control.Algebra.NumericInstances 4 | 5 | import Control.Algebra 6 | import Control.Algebra.VectorSpace 7 | import Data.Complex 8 | import Data.ZZ 9 | 10 | 11 | instance Semigroup Integer where 12 | (<+>) = (+) 13 | 14 | instance Monoid Integer where 15 | neutral = 0 16 | 17 | instance Group Integer where 18 | inverse = (* -1) 19 | 20 | instance AbelianGroup Integer 21 | 22 | instance Ring Integer where 23 | (<.>) = (*) 24 | 25 | instance RingWithUnity Integer where 26 | unity = 1 27 | 28 | 29 | instance Semigroup Int where 30 | (<+>) = (+) 31 | 32 | instance Monoid Int where 33 | neutral = 0 34 | 35 | instance Group Int where 36 | inverse = (* -1) 37 | 38 | instance AbelianGroup Int 39 | 40 | instance Ring Int where 41 | (<.>) = (*) 42 | 43 | instance RingWithUnity Int where 44 | unity = 1 45 | 46 | 47 | instance Semigroup Float where 48 | (<+>) = (+) 49 | 50 | instance Monoid Float where 51 | neutral = 0 52 | 53 | instance Group Float where 54 | inverse = (* -1) 55 | 56 | instance AbelianGroup Float 57 | 58 | instance Ring Float where 59 | (<.>) = (*) 60 | 61 | instance RingWithUnity Float where 62 | unity = 1 63 | 64 | instance Field Float where 65 | inverseM f _ = 1 / f 66 | 67 | 68 | instance Semigroup Nat where 69 | (<+>) = (+) 70 | 71 | instance Monoid Nat where 72 | neutral = 0 73 | 74 | instance Semigroup ZZ where 75 | (<+>) = (+) 76 | 77 | instance Monoid ZZ where 78 | neutral = 0 79 | 80 | instance Group ZZ where 81 | inverse = (* -1) 82 | 83 | instance AbelianGroup ZZ 84 | 85 | instance Ring ZZ where 86 | (<.>) = (*) 87 | 88 | instance RingWithUnity ZZ where 89 | unity = 1 90 | 91 | 92 | instance Semigroup a => Semigroup (Complex a) where 93 | (<+>) (a :+ b) (c :+ d) = (a <+> c) :+ (b <+> d) 94 | 95 | instance Monoid a => Monoid (Complex a) where 96 | neutral = (neutral :+ neutral) 97 | 98 | instance Group a => Group (Complex a) where 99 | inverse (r :+ i) = (inverse r :+ inverse i) 100 | 101 | instance Ring a => AbelianGroup (Complex a) where {} 102 | 103 | instance Ring a => Ring (Complex a) where 104 | (<.>) (a :+ b) (c :+ d) = (a <.> c <-> b <.> d) :+ (a <.> d <+> b <.> c) 105 | 106 | instance RingWithUnity a => RingWithUnity (Complex a) where 107 | unity = (unity :+ neutral) 108 | 109 | instance RingWithUnity a => Module a (Complex a) where 110 | (<#>) x = map (x <.>) 111 | 112 | instance RingWithUnity a => InnerProductSpace a (Complex a) where 113 | (x :+ y) <||> z = realPart $ (x :+ inverse y) <.> z 114 | -------------------------------------------------------------------------------- /src/Control/Algebra/VectorSpace.idr: -------------------------------------------------------------------------------- 1 | module Control.Algebra.VectorSpace 2 | 3 | import public Control.Algebra 4 | 5 | infixl 5 <#> 6 | infixr 2 <||> 7 | 8 | 9 | ||| A module over a ring is an additive abelian group of 'vectors' endowed with a 10 | ||| scale operation multiplying vectors by ring elements, and distributivity laws 11 | ||| relating the scale operation to both ring addition and module addition. 12 | ||| Must satisfy the following laws: 13 | ||| 14 | ||| + Compatibility of scalar multiplication with ring multiplication: 15 | ||| forall a b v, a <#> (b <#> v) = (a <.> b) <#> v 16 | ||| + Ring unity is the identity element of scalar multiplication: 17 | ||| forall v, unity <#> v = v 18 | ||| + Distributivity of `<#>` and `<+>`: 19 | ||| forall a v w, a <#> (v <+> w) == (a <#> v) <+> (a <#> w) 20 | ||| forall a b v, (a <+> b) <#> v == (a <#> v) <+> (b <#> v) 21 | class (RingWithUnity a, AbelianGroup b) => Module a b where 22 | (<#>) : a -> b -> b 23 | 24 | ||| A vector space is a module over a ring that is also a field 25 | class (Field a, Module a b) => VectorSpace a b where {} 26 | 27 | ||| An inner product space is a module – or vector space – over a ring, with a binary function 28 | ||| associating a ring value to each pair of vectors. 29 | class Module a b => InnerProductSpace a b where 30 | (<||>) : b -> b -> a 31 | -------------------------------------------------------------------------------- /src/Data/Matrix.idr: -------------------------------------------------------------------------------- 1 | ||| Basic matrix operations with dimensionalities enforced 2 | ||| at the type level 3 | module Data.Matrix 4 | 5 | import public Data.Vect 6 | 7 | %default total 8 | 9 | ||| Matrix with n rows and m columns 10 | Matrix : Nat -> Nat -> Type -> Type 11 | Matrix n m a = Vect n (Vect m a) 12 | 13 | ||| Get the specified column of a matrix 14 | getCol : Fin m -> Matrix n m a -> Vect n a 15 | getCol f = map (index f) 16 | 17 | ||| Get the specified row of a matrix 18 | getRow : Fin n -> Matrix n m a -> Vect m a 19 | getRow = index 20 | 21 | ||| Delete the specified column of a matrix 22 | deleteCol : Fin (S m) -> Matrix n (S m) a -> Matrix n m a 23 | deleteCol f = map (deleteAt f) 24 | 25 | ||| Delete the specified row of a matrix 26 | deleteRow : Fin (S n) -> Matrix (S n) m a -> Matrix n m a 27 | deleteRow = deleteAt 28 | 29 | insertRow : Fin (S n) -> Vect m a -> Matrix n m a -> Matrix (S n) m a 30 | insertRow = insertAt 31 | 32 | insertCol : Fin (S m) -> Vect n a -> Matrix n m a -> Matrix n (S m) a 33 | insertCol f = zipWith (insertAt f) 34 | 35 | ||| Matrix element at specified row and column indices 36 | indices : Fin n -> Fin m -> Matrix n m a -> a 37 | indices f1 f2 = index f2 . index f1 38 | 39 | ||| Cast a vector from a standard Vect to a proper n x 1 matrix 40 | col : Vect n a -> Matrix n 1 a 41 | col = map (\x => [x]) 42 | 43 | ||| Cast a row from a standard Vect to a proper 1 x n matrix 44 | row : Vect n a -> Matrix 1 n a 45 | row r = [r] 46 | 47 | ||| Matrix formed by deleting specified row and col 48 | subMatrix : Fin (S n) -> Fin (S m) -> Matrix (S n) (S m) a -> Matrix n m a 49 | subMatrix r c = deleteRow r . deleteCol c 50 | 51 | ||| Flatten a matrix of matrices 52 | concatMatrix : Matrix n m (Matrix x y a) -> Matrix (n * x) (m * y) a 53 | concatMatrix = Vect.concat . map (map Vect.concat) . map transpose 54 | 55 | ||| All finite numbers of the specified level 56 | fins : (n : Nat) -> Vect n (Fin n) 57 | fins Z = Nil 58 | fins (S n) = FZ :: (map FS $ fins n) 59 | -------------------------------------------------------------------------------- /src/Data/Matrix/Algebraic.idr: -------------------------------------------------------------------------------- 1 | ||| Matrix operations with vector space dimensionalities enforced 2 | ||| at the type level. Uses operations from classes in `Control.Algebra` 3 | ||| and `Control.Algebra.VectorSpace`. 4 | module Data.Matrix.Algebraic 5 | 6 | import public Control.Algebra 7 | import public Control.Algebra.VectorSpace 8 | import public Control.Algebra.NumericInstances 9 | 10 | import public Data.Matrix 11 | 12 | 13 | %default total 14 | 15 | infixr 2 <:> -- vector inner product 16 | infixr 2 >< -- vector outer product 17 | infixr 2 <<>> -- matrix commutator 18 | infixr 2 >><< -- matrix anticommutator 19 | infixl 3 <\> -- row times a matrix 20 | infixr 4 -- matrix times a column 21 | infixr 5 <> -- matrix multiplication 22 | infixr 7 \&\ -- vector tensor product 23 | infixr 7 <&> -- matrix tensor product 24 | 25 | ----------------------------------------------------------------------- 26 | -- Vectors as members of algebraic classes 27 | ----------------------------------------------------------------------- 28 | 29 | instance Semigroup a => Semigroup (Vect n a) where 30 | (<+>)= zipWith (<+>) 31 | 32 | instance Monoid a => Monoid (Vect n a) where 33 | neutral = replicate _ neutral 34 | 35 | instance Group a => Group (Vect n a) where 36 | inverse = map inverse 37 | 38 | instance AbelianGroup a => AbelianGroup (Vect n a) where {} 39 | 40 | instance Ring a => Ring (Vect n a) where 41 | (<.>) = zipWith (<.>) 42 | 43 | instance RingWithUnity a => RingWithUnity (Vect n a) where 44 | unity = replicate _ unity 45 | 46 | instance RingWithUnity a => Module a (Vect n a) where 47 | (<#>) r = map (r <.>) 48 | 49 | instance RingWithUnity a => Module a (Vect n (Vect l a)) where 50 | (<#>) r = map (r <#>) 51 | -- should be Module a b => Module a (Vect n b), but results in 'overlapping instance' 52 | 53 | ----------------------------------------------------------------------- 54 | -- (Ring) Vector functions 55 | ----------------------------------------------------------------------- 56 | 57 | ||| Inner product of ring vectors 58 | (<:>) : Ring a => Vect n a -> Vect n a -> a 59 | (<:>) w v = foldr (<+>) neutral (zipWith (<.>) w v) 60 | 61 | ||| Tensor multiply (⊗) ring vectors 62 | (\&\) : Ring a => Vect n a -> Vect m a -> Vect (n * m) a 63 | (\&\) {n} {m} v w = zipWith (<.>) (oextend m v) (orep n w) where 64 | orep : (n : Nat) -> Vect m a -> Vect (n * m) a 65 | orep n v = concat $ replicate n v 66 | oextend : (n : Nat) -> Vect k a -> Vect (k * n) a 67 | oextend n w = concat $ map (replicate n) w 68 | 69 | ||| Standard basis vector with one nonzero entry, ring data type and vector-length unfixed 70 | basis : RingWithUnity a => (Fin d) -> Vect d a 71 | basis i = replaceAt i unity neutral 72 | 73 | ----------------------------------------------------------------------- 74 | -- Ring Matrix functions 75 | ----------------------------------------------------------------------- 76 | 77 | ||| Matrix times a column vector 78 | () : Ring a => Matrix n m a -> Vect m a -> Vect n a 79 | () m v = map (v <:>) m 80 | 81 | ||| Matrix times a row vector 82 | (<\>) : Ring a => Vect n a -> Matrix n m a -> Vect m a 83 | (<\>) r = map (r <:>) . transpose 84 | 85 | ||| Matrix multiplication 86 | (<>) : Ring a => Matrix n k a -> 87 | Matrix k m a -> 88 | Matrix n m a 89 | (<>) m1 m2 = map (<\> m2) m1 90 | 91 | ||| Tensor multiply (⊗) for ring matrices 92 | (<&>) : Ring a => Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) (w1 * w2) a 93 | (<&>) m1 m2 = zipWith (\&\) (stepOne m1 m2) (stepTwo m1 m2) where 94 | stepOne : Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) w1 a 95 | stepOne {h2} m1 m2 = concat $ map (replicate h2) m1 96 | stepTwo : Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) w2 a 97 | stepTwo {h1} m1 m2 = concat $ replicate h1 m2 98 | 99 | ||| Outer product between ring vectors 100 | (><) : Ring a => Vect n a -> Vect m a -> Matrix n m a 101 | (><) x y = col x <> row y 102 | 103 | ||| Matrix commutator 104 | (<<>>) : Ring a => Matrix n n a -> Matrix n n a -> Matrix n n a 105 | (<<>>) m1 m2 = (m1 <> m2) <-> (m2 <> m1) 106 | 107 | ||| Matrix anti-commutator 108 | (>><<) : Ring a => Matrix n n a -> Matrix n n a -> Matrix n n a 109 | (>><<) m1 m2 = (m1 <> m2) <+> (m2 <> m1) 110 | 111 | ||| Identity matrix 112 | Id : RingWithUnity a => Matrix d d a 113 | Id = map (\n => basis n) (fins _) 114 | 115 | ||| Square matrix from diagonal elements 116 | diag_ : Monoid a => Vect n a -> Matrix n n a 117 | diag_ = zipWith (\f => \x => replaceAt f x neutral) (fins _) 118 | 119 | ||| Combine two matrices to make a new matrix in block diagonal form 120 | blockDiag : Monoid a => Matrix n n a -> Matrix m m a -> Matrix (n+m) (n+m) a 121 | blockDiag g h = map (++ replicate _ neutral) g ++ map ((replicate _ neutral) ++) h 122 | 123 | 124 | ----------------------------------------------------------------------- 125 | -- Determinants 126 | ----------------------------------------------------------------------- 127 | 128 | ||| Alternating sum 129 | altSum : Group a => Vect n a -> a 130 | altSum (x::y::zs) = (x <-> y) <+> altSum zs 131 | altSum [x] = x 132 | altSum [] = neutral 133 | 134 | ||| Determinant of a 2-by-2 matrix 135 | det2 : Ring a => Matrix 2 2 a -> a 136 | det2 [[x1,x2],[y1,y2]] = x1 <.> y2 <-> x2 <.> y1 137 | 138 | ||| Determinant of a square matrix 139 | det : Ring a => Matrix (S (S n)) (S (S n)) a -> a 140 | det {n} m = case n of 141 | Z => det2 m 142 | (S k) => altSum . map (\c => indices FZ c m <.> det (subMatrix FZ c m)) 143 | $ fins (S (S (S k))) 144 | 145 | ----------------------------------------------------------------------- 146 | -- Matrix Algebra Properties 147 | ----------------------------------------------------------------------- 148 | 149 | -- TODO: Prove properties of matrix algebra for 'Verified' algebraic classes 150 | -------------------------------------------------------------------------------- /src/Data/Matrix/Numeric.idr: -------------------------------------------------------------------------------- 1 | ||| Matrix operations with vector space dimensionalities enforced 2 | ||| at the type level. Uses operations from the Num type class. 3 | module Data.Matrix.Numeric 4 | 5 | import public Data.Matrix 6 | 7 | %default total 8 | 9 | infixr 2 <:> -- vector inner product 10 | infixr 2 >< -- vector outer product 11 | infixr 2 <<>> -- matrix commutator 12 | infixr 2 >><< -- matrix anticommutator 13 | infixl 3 <\> -- row times a matrix 14 | infixr 4 -- matrix times a column 15 | infixr 5 <> -- matrix multiplication 16 | infixl 5 <#> -- matrix rescale 17 | infixl 5 <# -- vector rescale 18 | infixr 7 \&\ -- vector tensor product 19 | infixr 7 <&> -- matrix tensor product 20 | 21 | ----------------------------------------------------------------------- 22 | -- Vectors as members of Num 23 | ----------------------------------------------------------------------- 24 | 25 | instance Num a => Num (Vect n a) where 26 | (+) = zipWith (+) 27 | (*) = zipWith (*) 28 | fromInteger n = replicate _ (fromInteger n) 29 | 30 | instance Neg a => Neg (Vect n a) where 31 | (-) = zipWith (-) 32 | abs = map abs 33 | negate = map negate 34 | 35 | ----------------------------------------------------------------------- 36 | -- Vector functions 37 | ----------------------------------------------------------------------- 38 | 39 | ||| Inner product of ring vectors 40 | (<:>) : Num a => Vect n a -> Vect n a -> a 41 | (<:>) w v = sum $ zipWith (*) w v 42 | 43 | ||| Scale a numeric vector by a scalar 44 | (<#) : Num a => a -> Vect n a -> Vect n a 45 | (<#) r = map (r *) 46 | 47 | ||| Tensor multiply (⊗) numeric vectors 48 | (\&\) : Num a => Vect n a -> Vect m a -> Vect (n * m) a 49 | (\&\) {n} {m} v w = zipWith (*) (oextend m v) (orep n w) where 50 | orep : (n : Nat) -> Vect m a -> Vect (n * m) a 51 | orep n v = concat $ replicate n v 52 | oextend : (n : Nat) -> Vect k a -> Vect (k * n) a 53 | oextend n w = concat $ map (replicate n) w 54 | 55 | ||| Standard basis vector with one nonzero entry, numeric data type and vector-length unfixed 56 | basis : Num a => (Fin d) -> Vect d a 57 | basis i = replaceAt i 1 0 58 | 59 | ----------------------------------------------------------------------- 60 | -- Matrix functions 61 | ----------------------------------------------------------------------- 62 | 63 | ||| Matrix times a column vector 64 | () : Num a => Matrix n m a -> Vect m a -> Vect n a 65 | () m v = map (v <:>) m 66 | 67 | ||| Matrix times a row vector 68 | (<\>) : Num a => Vect n a -> Matrix n m a -> Vect m a 69 | (<\>) r m = map (r <:>) $ transpose m 70 | 71 | ||| Matrix multiplication 72 | (<>) : Num a => Matrix n k a -> 73 | Matrix k m a -> 74 | Matrix n m a 75 | (<>) m1 m2 = map (<\> m2) m1 76 | 77 | ||| Scale matrix by a scalar 78 | (<#>) : Num a => a -> Matrix n m a -> Matrix n m a 79 | (<#>) r = map (r <#) 80 | 81 | ||| Tensor multiply (⊗) for numeric matrices 82 | (<&>) : Num a => Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) (w1 * w2) a 83 | (<&>) m1 m2 = zipWith (\&\) (stepOne m1 m2) (stepTwo m1 m2) where 84 | stepOne : Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) w1 a 85 | stepOne {h2} m1 m2 = concat $ map (replicate h2) m1 86 | stepTwo : Matrix h1 w1 a -> Matrix h2 w2 a -> Matrix (h1 * h2) w2 a 87 | stepTwo {h1} m1 m2 = concat $ replicate h1 m2 88 | 89 | ||| Outer product between numeric vectors 90 | (><) : Num a => Vect n a -> Vect m a -> Matrix n m a 91 | (><) x y = col x <> row y 92 | 93 | ||| Matrix commutator 94 | (<<>>) : Neg a => Matrix n n a -> Matrix n n a -> Matrix n n a 95 | (<<>>) m1 m2 = (m1 <> m2) - (m2 <> m1) 96 | 97 | ||| Matrix anti-commutator 98 | (>><<) : Num a => Matrix n n a -> Matrix n n a -> Matrix n n a 99 | (>><<) m1 m2 = (m1 <> m2) + (m2 <> m1) 100 | 101 | ||| Identity matrix 102 | Id : Num a => Matrix d d a 103 | Id = map (\n => basis n) (fins _) 104 | 105 | ||| Square matrix from diagonal elements 106 | diag_ : Num a => Vect n a -> Matrix n n a 107 | diag_ = zipWith (\f => \x => replaceAt f x 0) (fins _) 108 | 109 | ||| Combine two matrices to make a new matrix in block diagonal form 110 | blockDiag : Num a => Matrix n n a -> Matrix m m a -> Matrix (n+m) (n+m) a 111 | blockDiag {n} {m} g h = map (++ replicate m 0) g ++ map ((replicate n 0) ++) h 112 | 113 | ----------------------------------------------------------------------- 114 | -- Determinants 115 | ----------------------------------------------------------------------- 116 | 117 | ||| Alternating sum 118 | altSum : Neg a => Vect n a -> a 119 | altSum (x::y::zs) = (x - y) + altSum zs 120 | altSum [x] = x 121 | altSum [] = 0 122 | 123 | ||| Determinant of a 2-by-2 matrix 124 | det2 : Neg a => Matrix 2 2 a -> a 125 | det2 [[x1,x2],[y1,y2]] = x1*y2 - x2*y1 126 | 127 | ||| Determinant of a square matrix 128 | det : Neg a => Matrix (S (S n)) (S (S n)) a -> a 129 | det {n} m = case n of 130 | Z => det2 m 131 | (S k) => altSum . map (\c => indices FZ c m * det (subMatrix FZ c m)) 132 | $ fins (S (S (S k))) 133 | -------------------------------------------------------------------------------- /src/Data/ZZ.idr: -------------------------------------------------------------------------------- 1 | module Data.ZZ 2 | 3 | import Decidable.Equality 4 | 5 | %default total 6 | %access public 7 | 8 | 9 | ||| An integer is either a positive `Nat` or the negated successor of a `Nat`. 10 | ||| 11 | ||| For example, 3 is `Pos 3` and -2 is `NegS 1`. Zero is arbitrarily chosen 12 | ||| to be positive. 13 | ||| 14 | data ZZ = Pos Nat | NegS Nat 15 | 16 | ||| Take the absolute value of a `ZZ` 17 | absZ : ZZ -> Nat 18 | absZ (Pos n) = n 19 | absZ (NegS n) = S n 20 | 21 | instance Show ZZ where 22 | show (Pos n) = show n 23 | show (NegS n) = "-" ++ show (S n) 24 | 25 | negNat : Nat -> ZZ 26 | negNat Z = Pos Z 27 | negNat (S n) = NegS n 28 | 29 | 30 | ||| Construct a `ZZ` as the difference of two `Nat`s 31 | minusNatZ : Nat -> Nat -> ZZ 32 | minusNatZ n Z = Pos n 33 | minusNatZ Z (S m) = NegS m 34 | minusNatZ (S n) (S m) = minusNatZ n m 35 | 36 | ||| Add two `ZZ`s. Consider using `(+) {a=ZZ}`. 37 | plusZ : ZZ -> ZZ -> ZZ 38 | plusZ (Pos n) (Pos m) = Pos (n + m) 39 | plusZ (NegS n) (NegS m) = NegS (S (n + m)) 40 | plusZ (Pos n) (NegS m) = minusNatZ n (S m) 41 | plusZ (NegS n) (Pos m) = minusNatZ m (S n) 42 | 43 | instance Eq ZZ where 44 | (Pos n) == (Pos m) = n == m 45 | (NegS n) == (NegS m) = n == m 46 | _ == _ = False 47 | 48 | 49 | instance Ord ZZ where 50 | compare (Pos n) (Pos m) = compare n m 51 | compare (NegS n) (NegS m) = compare m n 52 | compare (Pos _) (NegS _) = GT 53 | compare (NegS _) (Pos _) = LT 54 | 55 | ||| Multiply two `ZZ`s. Consider using `(*) {a=ZZ}`. 56 | multZ : ZZ -> ZZ -> ZZ 57 | multZ (Pos n) (Pos m) = Pos $ n * m 58 | multZ (NegS n) (NegS m) = Pos $ (S n) * (S m) 59 | multZ (NegS n) (Pos m) = negNat $ (S n) * m 60 | multZ (Pos n) (NegS m) = negNat $ n * (S m) 61 | 62 | ||| Convert an `Integer` to an inductive representation. 63 | fromInt : Integer -> ZZ 64 | fromInt n = if n < 0 65 | then NegS $ fromInteger {a=Nat} ((-n) - 1) 66 | else Pos $ fromInteger {a=Nat} n 67 | 68 | instance Cast Nat ZZ where 69 | cast n = Pos n 70 | 71 | instance Num ZZ where 72 | (+) = plusZ 73 | (*) = multZ 74 | fromInteger = fromInt 75 | 76 | mutual 77 | instance Neg ZZ where 78 | negate (Pos Z) = Pos Z 79 | negate (Pos (S n)) = NegS n 80 | negate (NegS n) = Pos (S n) 81 | 82 | (-) = subZ 83 | abs = cast . absZ 84 | 85 | ||| Subtract two `ZZ`s. Consider using `(-) {a=ZZ}`. 86 | subZ : ZZ -> ZZ -> ZZ 87 | subZ n m = plusZ n (negate m) 88 | 89 | 90 | instance Cast ZZ Integer where 91 | cast (Pos n) = cast n 92 | cast (NegS n) = (-1) * (cast n + 1) 93 | 94 | instance Cast Integer ZZ where 95 | cast = fromInteger 96 | 97 | 98 | -------------------------------------------------------------------------------- 99 | -- Properties 100 | -------------------------------------------------------------------------------- 101 | 102 | natPlusZPlus : (n : Nat) -> (m : Nat) -> (x : Nat) 103 | -> n + m = x -> (Pos n) + (Pos m) = Pos x 104 | natPlusZPlus n m x h = cong h 105 | 106 | natMultZMult : (n : Nat) -> (m : Nat) -> (x : Nat) 107 | -> n * m = x -> (Pos n) * (Pos m) = Pos x 108 | natMultZMult n m x h = cong h 109 | 110 | doubleNegElim : (z : ZZ) -> negate (negate z) = z 111 | doubleNegElim (Pos Z) = Refl 112 | doubleNegElim (Pos (S n)) = Refl 113 | doubleNegElim (NegS Z) = Refl 114 | doubleNegElim (NegS (S n)) = Refl 115 | 116 | -- Injectivity 117 | posInjective : Pos n = Pos m -> n = m 118 | posInjective Refl = Refl 119 | 120 | negSInjective : NegS n = NegS m -> n = m 121 | negSInjective Refl = Refl 122 | 123 | posNotNeg : Pos n = NegS m -> Void 124 | posNotNeg Refl impossible 125 | 126 | -- Decidable equality 127 | instance DecEq ZZ where 128 | decEq (Pos n) (NegS m) = No posNotNeg 129 | decEq (NegS n) (Pos m) = No $ negEqSym posNotNeg 130 | decEq (Pos n) (Pos m) with (decEq n m) 131 | | Yes p = Yes $ cong p 132 | | No p = No $ \h => p $ posInjective h 133 | decEq (NegS n) (NegS m) with (decEq n m) 134 | | Yes p = Yes $ cong p 135 | | No p = No $ \h => p $ negSInjective h 136 | 137 | -- Plus 138 | plusZeroLeftNeutralZ : (right : ZZ) -> 0 + right = right 139 | plusZeroLeftNeutralZ (Pos n) = Refl 140 | plusZeroLeftNeutralZ (NegS n) = Refl 141 | 142 | plusZeroRightNeutralZ : (left : ZZ) -> left + 0 = left 143 | plusZeroRightNeutralZ (Pos n) = cong $ plusZeroRightNeutral n 144 | plusZeroRightNeutralZ (NegS n) = Refl 145 | 146 | plusCommutativeZ : (left : ZZ) -> (right : ZZ) -> (left + right = right + left) 147 | plusCommutativeZ (Pos n) (Pos m) = cong $ plusCommutative n m 148 | plusCommutativeZ (Pos n) (NegS m) = Refl 149 | plusCommutativeZ (NegS n) (Pos m) = Refl 150 | plusCommutativeZ (NegS n) (NegS m) = cong {f=NegS} $ cong {f=S} $ plusCommutative n m 151 | -------------------------------------------------------------------------------- /src/xquant.idr: -------------------------------------------------------------------------------- 1 | module xquant 2 | 3 | import public xquant.Core.Types 4 | import public xquant.Core.NonZero 5 | import public xquant.Core.Spectrum 6 | import public xquant.Core.Interpretation 7 | import public xquant.Core.Helicity 8 | import public xquant.Core.Epsilon 9 | -------------------------------------------------------------------------------- /src/xquant/Base.idr: -------------------------------------------------------------------------------- 1 | module xquant.Base 2 | 3 | import public xquant 4 | 5 | import public xquant.Graph.Marked 6 | import public xquant.Graph.Feynman 7 | 8 | import public xquant.Math.Set 9 | import public xquant.Math.Hilbert 10 | 11 | import public xquant.Spinor.Gamma 12 | import public xquant.Spinor.Sigmas 13 | import public xquant.Spinor.SigKets 14 | import public xquant.Spinor.BKS 15 | -------------------------------------------------------------------------------- /src/xquant/Core/Epsilon.idr: -------------------------------------------------------------------------------- 1 | module math.Epsilon 2 | 3 | import xquant.Core.Types 4 | 5 | %default total 6 | 7 | 8 | class Epsilon a where 9 | infinitessimal : a -> Bool 10 | 11 | instance Epsilon Fl where 12 | infinitessimal x = abs x < 0.00000001 13 | 14 | instance Epsilon Amp where 15 | infinitessimal x = realPart (abs x) < 0.00000001 16 | 17 | instance Epsilon (Vect n Fl) where 18 | infinitessimal = all infinitessimal 19 | 20 | instance Epsilon (Vect n Amp) where 21 | infinitessimal = all infinitessimal 22 | 23 | instance Epsilon (Vect n (Vect m Fl)) where 24 | infinitessimal = all infinitessimal 25 | 26 | instance Epsilon (Vect n (Vect m Amp)) where 27 | infinitessimal = all infinitessimal 28 | 29 | sumSq : (Functor t, Foldable t, Neg a) => t a -> a 30 | sumSq = sum . map ((\n => n*n) . abs) 31 | 32 | data Real : Amp -> Type where 33 | IsReal : (z : Amp) -> {auto isinf : infinitessimal (imagPart z) = True} -> Real z 34 | 35 | {- 36 | *quantum> :r 37 | Type checking ./math/Epsilon.idr 38 | ./math/Epsilon.idr:20:10: 39 | Overlapping instance: Epsilon (Complex Double) already defined 40 | 41 | approximates : Epsilon 42 | -} 43 | 44 | {-} 45 | --instance (Neg a, Epsilon a) => Epsilon (Vect n a) where 46 | -- infinitessimal = infinitessimal . sumSq 47 | 48 | --data Infinitessimal : Type where 49 | -- Infini : Epsilon a => (x : a) -> {auto isep : infinitessimal x = True} -> Infinitessimal x 50 | 51 | -- data Unitary : (mat : Matrix n n (Complex Float)) -> Type where 52 | -- IsUnitary : {prf : mat <> dagger )} 53 | -} 54 | -------------------------------------------------------------------------------- /src/xquant/Core/Helicity.idr: -------------------------------------------------------------------------------- 1 | module xquant.Core.Helicity 2 | 3 | import xquant.Core.Types 4 | import Data.Matrix.Numeric 5 | 6 | %default total 7 | 8 | 9 | ---- Helicity type synonyms ---- 10 | 11 | Bispinor : Type 12 | Bispinor = Matrix 2 2 Amp 13 | 14 | Gamma : Type 15 | Gamma = Matrix 4 4 Amp 16 | 17 | ---- Constant bispinors: Pauli matrices, antisym tensor ---- 18 | 19 | private i : Amp 20 | i = 0 :+ 1 21 | 22 | %access public 23 | 24 | sx : Bispinor 25 | sx = [[0,1],[1,0]] 26 | 27 | sy : Bispinor 28 | sy = [[0,i],[-i,0]] 29 | 30 | sz : Bispinor 31 | sz = [[1,0],[0,-1]] 32 | 33 | ep : Bispinor 34 | ep = [[0,-1],[1,0]] 35 | 36 | 37 | ---- Momentum bispinors σ(p) ---- 38 | 39 | ||| Produce a bispinor from a Minkowski 4-vector 40 | bispin : Mink -> Bispinor 41 | bispin [e,px,py,pz] = (e <#> Id) 42 | + (px <#> sx) 43 | + (py <#> sy) 44 | + (pz <#> sz) 45 | 46 | 47 | ||| Produce a bispinor from a Minkowski 4-vector; 48 | ||| Upstairs spinor index (barred) version 49 | bispin' : Mink -> Bispinor 50 | bispin' [e,px,py,pz] = (e <#> Id) 51 | - (px <#> sx) 52 | - (py <#> sy) 53 | - (pz <#> sz) 54 | 55 | ||| Minkowski inner product 56 | mink : Mink -> Mink -> Amp 57 | mink (x0 :: xs) (y0 :: ys) = -(x0 * y0) + (xs <:> ys) 58 | 59 | ||| 60 | eta : Gamma 61 | eta = diag_ [-1,1,1,1] 62 | 63 | gx : Matrix 4 4 Amp 64 | gx = concatMatrix [[0,-sx],[sx,0]] 65 | 66 | gy : Matrix 4 4 Amp 67 | gy = concatMatrix [[0,-sy],[sy,0]] 68 | 69 | gz : Matrix 4 4 Amp 70 | gz = concatMatrix [[0,-sz],[sz,0]] 71 | 72 | g0 : Matrix 4 4 Amp 73 | g0 = concatMatrix {x=2} [[0,Id],[Id,0]] 74 | 75 | ||| Feynman slash: Dot a minkowski vector 76 | ||| into the gamma matrix vector 77 | slash : Mink -> Matrix 4 4 Amp 78 | slash [e,x,y,z] = (e <#> Id) 79 | + (x <#> gx) 80 | + (y <#> gy) 81 | + (z <#> gz) 82 | 83 | ||| 4 standard gamma matrices for D=4 84 | gammas : Vect 4 Gamma 85 | gammas = [g0,gx,gy,gz] 86 | 87 | 88 | ||| implicit conversion from Float to Complex Float 89 | private implicit toCF : Fl -> Amp 90 | toCF x = x :+ 0 91 | 92 | 93 | g5 : Gamma 94 | g5 = i <#> foldr1 (<>) gammas 95 | 96 | ||| Left-handed spinor projection 97 | pL : Gamma 98 | pL = 0.5 <#> (1 - g5) 99 | 100 | ||| Right-handed spinor projection 101 | pR : Gamma 102 | pR = 0.5 <#> (1 + g5) 103 | 104 | 105 | ||| Generate a vector from function 106 | vecGen : (Fin n -> a) -> Vect n a 107 | vecGen f = map f (fins _) 108 | 109 | ||| Generate a matrix from function 110 | matGen : (Fin n -> Fin m -> a) -> Matrix n m a 111 | matGen f = vecGen <$> vecGen f 112 | 113 | ||| Spin matrix 114 | spin : Fin 4 -> Fin 4 -> Gamma 115 | spin j k = i*(1/4) <#> index j gammas <<>> index k gammas 116 | -------------------------------------------------------------------------------- /src/xquant/Core/Interpretation.idr: -------------------------------------------------------------------------------- 1 | module xquant.Core.Interpretation 2 | 3 | import xquant.Core.Types 4 | 5 | %default total 6 | 7 | 8 | ||| Represents a mapping of a model (vector space) to 9 | ||| a physical system. Denoted by descriptive strings 10 | data Interpretation : Nat -> Type where 11 | Interpret : Vect n String -> Interpretation n 12 | 13 | dim : Interpretation n -> Nat 14 | dim {n} i = n 15 | 16 | Interp : Type 17 | Interp = (n : Nat ** Interpretation n) 18 | 19 | {-} 20 | ||| Representation of a possibly-composite quantum system 21 | ||| @ n the dimensionality of the physical system 22 | data System : (n : Nat) -> List Interp -> Type where 23 | ||| Representation of a quantum system with a distinct interpretation 24 | Single : (i : Interpretation n) -> System n [i] 25 | ||| Extend an quantum system by tensor multiplying by another hilbert space 26 | Extend : (i : Interpretation n) -> System m -> System (n * m) 27 | 28 | -} 29 | 30 | 31 | 32 | qubit : Interpretation 2 33 | qubit = Interpret ["Spin up", "Spin down"] 34 | 35 | 36 | ||| Type-safe representation of choice combinatorics 37 | ||| @ n total objects 38 | ||| @ m remaining unchosen 39 | ||| 40 | ||| For example this works fine: 41 | |||````idris example 42 | |||Choose FZ . Choose (FS FZ) $ (ChZero 2) 43 | |||```` 44 | ||| However both of these do not: 45 | |||````idris example 46 | |||Choose FZ . Choose FZ . Choose FZ $ (ChZero 2) 47 | |||```` 48 | |||````idris example 49 | |||Choose (FS FZ) . Choose FZ $ (ChZero 2) 50 | |||```` 51 | data Choice : (n : Nat) -> (m : Nat) -> Type where 52 | ||| No Choices yet 53 | ChZero : (n : Nat) -> Choice n n 54 | ||| 55 | Choose : (f : Fin (S m)) -> Choice n (S m) -> Choice n m 56 | -------------------------------------------------------------------------------- /src/xquant/Core/NonZero.idr: -------------------------------------------------------------------------------- 1 | module xquant.Core.NonZero 2 | 3 | import Data.Vect 4 | 5 | %default total 6 | 7 | data NonZero : Nat -> Type where 8 | NZ : {k : Nat} -> NonZero (S k) 9 | 10 | ||| works but takes a while when N > ~1000 11 | partial nonzero : (n : Nat) -> NonZero n 12 | nonzero (S k) = NZ 13 | 14 | NonZ : Type 15 | NonZ = (n : Nat ** NonZero n) 16 | 17 | ||| Vector of Non-zero naturals 18 | data NVect : (v : Vect n Nat) -> Type where 19 | Nil : NVect [] 20 | (::) : (n : Nat) -> NVect v -> {auto nz : NonZero n} -> NVect (n :: v) 21 | 22 | partial 23 | vtov : (v : Vect n Nat) -> NVect v 24 | vtov [] = [] 25 | vtov ((S k)::ns) = S k :: (vtov ns) 26 | -------------------------------------------------------------------------------- /src/xquant/Core/Spectrum.idr: -------------------------------------------------------------------------------- 1 | module xquant.Core.Spectrum 2 | 3 | import public xquant.Core.Types 4 | import public xquant.Core.NonZero 5 | import Data.Matrix.Algebraic 6 | 7 | 8 | %default total 9 | 10 | 11 | data SysType = Finite Nat | Infinite 12 | 13 | ||| Spectrum – list of energies – for 14 | ||| a finite-dimensional system 15 | data FSpectrum : Nat -> Type where 16 | FSpect : Vect n Fl -> FSpectrum n 17 | 18 | ||| Finite system degeneracy, i.e., 19 | ||| state multiplicity by energy level 20 | data FDegen : Nat -> Type where 21 | FDeg : {v : Vect n Nat} -> NVect v -> FDegen n 22 | 23 | size : FDegen n -> Nat 24 | size (FDeg {v} _) = sum v 25 | 26 | rep : FDegen n -> Type 27 | rep fd = StateSpace (size fd) Amp 28 | 29 | data FSystem : Nat -> Type where 30 | FSys : (fd : FDegen n) -> 31 | FSpectrum n -> 32 | rep fd -> 33 | FSystem n 34 | 35 | ||| Infinite system spectrum 36 | data ISpectrum = ISpect (Nat -> Fl) 37 | 38 | ||| Infinite system degeneracy 39 | ||| (state multiplicity by energy level) 40 | data IDegen : Type where 41 | IDeg : (Nat -> NonZ) -> IDegen 42 | -------------------------------------------------------------------------------- /src/xquant/Core/Types.idr: -------------------------------------------------------------------------------- 1 | module xquant.Core.Types 2 | 3 | import public Data.Complex 4 | import public Data.Matrix 5 | 6 | %default total 7 | 8 | 9 | Fl : Type 10 | Fl = Float 11 | 12 | Amp : Type 13 | Amp = Complex Fl 14 | 15 | 16 | ---- Hilbert Space types ---- 17 | 18 | ||| State vector type for n-dimensional complex Hilbert space 19 | StateSpace : Nat -> Type -> Type 20 | StateSpace n a = Vect n (Complex a) 21 | 22 | ||| Quantum observable type, n x n complex matrices 23 | Op : Nat -> Type -> Type 24 | Op n a = Matrix n n (Complex a) 25 | 26 | ||| Ket vector, a n x 1 matrix collumn 27 | KetSpace : Nat -> Type -> Type 28 | KetSpace n a = Matrix n 1 (Complex a) 29 | 30 | ||| Bra vector, a 1 x n matrix row 31 | BraSpace : Nat -> Type -> Type 32 | BraSpace n a = Matrix 1 n (Complex a) 33 | 34 | ||| Qubit state space type, 2^n dimensional Hilbert space 35 | Qubit : Nat -> Type -> Type 36 | Qubit n a = StateSpace (power 2 n) a 37 | 38 | ||| Qubit observable type 39 | QubitOp : Nat -> Type -> Type 40 | QubitOp n a = let m = power 2 n in Matrix m m (Complex a) 41 | 42 | ||| Qubit collumn vector type 43 | QubitKet : Nat -> Type -> Type 44 | QubitKet n a = let m = power 2 n in Matrix m 1 (Complex a) 45 | 46 | ||| Qubit row vector type 47 | QubitBra : Nat -> Type -> Type 48 | QubitBra n a = let m = power 2 n in Matrix 1 m (Complex a) 49 | 50 | 51 | 52 | c0 : Num a => Complex a 53 | c0 = 0 :+ 0 54 | 55 | c1 : Num a => Complex a 56 | c1 = 1 :+ 0 57 | 58 | ci : Num a => Complex a 59 | ci = 0 :+ 1 60 | 61 | m1 : (Neg a, Num a) => Complex a 62 | m1 = -1 :+ 0 63 | 64 | mi : (Neg a, Num a) => Complex a 65 | mi = 0 :+ -1 66 | 67 | -- sqn : (Foldable t, Functor t) => t Amp -> Amp 68 | -- sqn = sum' . map ((\x => conjugate x * x)) 69 | 70 | -- normalize : (Foldable t, Functor t) => t Amp -> t Amp 71 | -- normalize xs = let n = sqn xs in map (map (\x => xn)) 72 | -- Can't resolve type class Functor f 73 | -- normalize : Vect n 74 | 75 | ---- Relativistic types ---- 76 | 77 | Mink : Type 78 | Mink = Vect 4 Amp 79 | 80 | MinkR : Type 81 | MinkR = Vect 4 Fl 82 | -------------------------------------------------------------------------------- /src/xquant/Graph/Feynman.idr: -------------------------------------------------------------------------------- 1 | module xquant.Graph.Feynman 2 | 3 | import xquant.Graph.Marked 4 | import Control.Algebra 5 | 6 | %default total 7 | 8 | 9 | ||| Fixed interaction order scalar particle graph 10 | ||| @ n number of line endpoints attached to each vertex (interaction order) 11 | ||| @ l number of lines 12 | ||| @ v number of vertices 13 | ||| @ m which line endpoints are attached to vertices 14 | data ScalarGraph : (n : Nat) -> 15 | (l : Nat) -> 16 | (v : Nat) -> 17 | (m : Marks (2*l) j) -> 18 | Type where 19 | Grf : (n : Nat) -> 20 | (l : Nat) -> 21 | ScalarGraph n l Z allO 22 | vertex : (x : Marks (2*l) n) -> 23 | {y : Marks (2*l) j} -> 24 | (c : Compat x y) -> 25 | ScalarGraph n l v y -> 26 | ScalarGraph n l (S v) (markAdd c) 27 | 28 | ||| The number of external lines is the number of endpoints not connected to vertices 29 | external : ScalarGraph n p v m -> Nat 30 | external {n} {p} {v} g = 2*p `minus` n*v 31 | 32 | 33 | -- example: the interaction vertex in phi^3 theory 34 | phi3vertex : ScalarGraph 3 3 1 [O,X,O,X,O,X] 35 | phi3vertex = vertex [O,X,O,X,O,X] 36 | (ComOO $ ComXO $ ComOO $ ComXO $ ComOO $ ComXO ComZero) 37 | (Grf 3 3) 38 | 39 | 40 | ||| Directed Graph with fixed number of line-endpoints per vertex 41 | ||| @ n number of line endpoints attached to each vertex (interaction order) 42 | ||| @ l number of lines 43 | ||| @ v number of vertices 44 | ||| @ m which line endpoints are attached to vertices 45 | ||| @ h which line arrows are reversed 46 | data Digraph : (n : Nat) -> 47 | (l : Nat) -> 48 | (v : Nat) -> 49 | (m : Marks (2*l) j) -> 50 | (h : Marks l k) -> 51 | Type where 52 | DiGrf : (n : Nat) -> 53 | (l : Nat) -> 54 | Digraph n l Z empty (empty_ l) 55 | DiVrtx : (x : Marks (2*l) n) -> 56 | {y : Marks (2*l) j} -> 57 | (c : Compat x y) -> 58 | Digraph n l v y r -> 59 | Digraph n l (S v) (markAdd c) r 60 | 61 | 62 | 63 | ||| Very basic particle content. Should dramatically generalize from here 64 | ||| Here only takes number of scalars and fermions 65 | data ParticleContent = Particles Nat Nat 66 | 67 | data VertexType : Nat -> Type where 68 | VertType : (b : Nat) -> (f : Nat) -> VertexType (n + 2*m) 69 | 70 | 71 | -- data SFPropagator : Nat -> Type where 72 | -- SFProp : Marks 2 73 | 74 | ||| Directed Graph with fixed number of line-endpoints per vertex 75 | ||| @ s scalar lines 76 | ||| @ f fermion lines 77 | ||| @ v number of vertices 78 | ||| @ sm which scalar line endings are attached to vertices 79 | ||| @ fb which fermionic line _beginnings_ are attached to vertices 80 | ||| @ fe which fermionic line _end_points are attached to vertices 81 | data SimpScalarFermion : (s : Nat) -> 82 | (f : Nat) -> 83 | (v : Nat) -> 84 | (sm : Marks (2*s) i) -> 85 | (fb : Marks f j) -> 86 | (fe : Marks f j) -> Type where 87 | SFGrf : (s,f : Nat) -> 88 | SimpScalarFermion s f Z empty (empty_ _) (empty_ _) 89 | SFVrtx : SimpScalarFermion s f v sm fb fe -> 90 | {x : Marks (2*s) 1} -> 91 | {y : Marks f 1} -> 92 | {z : Marks f 1} -> 93 | (c : Compat x sm) -> 94 | (d : Compat y fb) -> 95 | (e : Compat z fe) -> 96 | SimpScalarFermion s f (S v) (markAdd c) (markAdd d) (markAdd e) 97 | -------------------------------------------------------------------------------- /src/xquant/Graph/Marked.idr: -------------------------------------------------------------------------------- 1 | module xquant.Graph.Marked 2 | 3 | -- import Pruviloj 4 | import xquant.Math.Set 5 | 6 | %default total 7 | 8 | ||| Marks are used to signify sets of sites that are either 9 | ||| occupied (X) or not (O) 10 | data Mark = X | O 11 | 12 | ||| Increment a Nat if X, do nothing if O. 13 | ||| Used to count total number of marks that are X. 14 | mS : Mark -> Nat -> Nat 15 | mS X = S 16 | mS O = id 17 | 18 | ||| Representation of a set of sites 19 | ||| @ n total number of sites 20 | ||| @ k numer that are occupied with X 21 | data Marks : (n : Nat) -> (k : Nat) -> Type where 22 | Nil : Marks Z Z 23 | (::) : (m : Mark) -> Marks n k -> Marks (S n) (mS m k) 24 | 25 | empty_ : (n : Nat) -> Marks n Z 26 | empty_ Z = [] 27 | empty_ (S k) = O :: empty_ k 28 | 29 | empty : {n : Nat} -> Marks n Z 30 | empty = empty_ _ 31 | 32 | insertMk : Fin n -> (y : Mark) -> Marks n j -> Marks (S n) (mS y j) 33 | insertMk FZ y m = y :: m 34 | insertMk (FS i) X (X :: m) = X :: insertMk i X m 35 | insertMk (FS i) O (X :: m) = X :: insertMk i O m 36 | insertMk (FS i) X (O :: m) = O :: insertMk i X m 37 | insertMk (FS i) O (O :: m) = O :: insertMk i O m 38 | 39 | --countMZero : (n : Nat) -> Set [empty_ n] 40 | 41 | 42 | data Compat : Marks n k -> Marks n j -> Type where 43 | ComZero : Compat [] [] 44 | ComOO : Compat q w -> Compat (O :: q) (O :: w) 45 | ComXO : Compat q w -> Compat (X :: q) (O :: w) 46 | ComOX : Compat q w -> Compat (O :: q) (X :: w) 47 | 48 | pL : {x : Marks n k} -> {y : Marks n j} -> Compat x y -> Marks n k 49 | pL {x} c = x 50 | 51 | pR : {x : Marks n k} -> {y : Marks n j} -> Compat x y -> Marks n j 52 | pR {y} c = y 53 | 54 | 55 | 56 | ||| Add two compatible marked sets together 57 | markAdd : {q : Marks n m} -> {w : Marks n j} -> Compat q w -> Marks n (m + j) 58 | markAdd ComZero = [] 59 | markAdd (ComOO c) = O :: (markAdd c) 60 | markAdd (ComOX c) ?= X :: (markAdd c) 61 | markAdd (ComXO c) = X :: (markAdd c) 62 | 63 | markAdd_lemma_1 = proof 64 | intros 65 | rewrite plusSuccRightSucc m j 66 | trivial 67 | 68 | {- 69 | markLem : Elab () 70 | markLem = do ns <- intros 71 | rewriteWith `(plusSuccRightSucc ~(Var m1) ~(Var j)) 72 | hypothesis 73 | 74 | mlem = %runElab markLem 75 | -} 76 | 77 | Marks_ : Nat -> Type 78 | Marks_ n = (m ** Marks n m) 79 | 80 | 81 | shift : LTE n m -> LTE n (S m) 82 | shift LTEZero = LTEZero 83 | shift (LTESucc l) = LTESucc (shift l) 84 | 85 | 86 | markBound : Marks n m -> LTE m n 87 | markBound [] = LTEZero 88 | markBound (X :: q) with (markBound q) 89 | | w = LTESucc w 90 | markBound (O :: q) with (markBound q) 91 | | LTEZero = LTEZero 92 | | LTESucc x = LTESucc $ shift x 93 | 94 | 95 | XXnotCompat : Compat (X :: ys) (X :: zs) -> Void 96 | XXnotCompat ComZero impossible 97 | 98 | XOunfold : Compat (X :: ys) (O :: zs) -> Compat ys zs 99 | XOunfold (ComXO c) = c 100 | 101 | OXunfold : Compat (O :: ys) (X :: zs) -> Compat ys zs 102 | OXunfold (ComOX c) = c 103 | 104 | OOunfold : Compat (O :: ys) (O :: zs) -> Compat ys zs 105 | OOunfold (ComOO c) = c 106 | 107 | 108 | antiCom : Not (Compat xs ys) -> Not $ Compat (q::xs) (w::ys) 109 | antiCom contra ComZero impossible 110 | 111 | 112 | decer : (m1 : Marks n i) -> (m2 : Marks n j) -> Dec (Compat m1 m2) 113 | decer [] [] = Yes ComZero 114 | decer (X :: ys) (X :: zs) = No XXnotCompat 115 | decer (X :: ys) (O :: zs) with (decer ys zs) 116 | decer (X :: ys) (O :: zs) | Yes prf = Yes $ ComXO prf 117 | decer (X :: ys) (O :: zs) | No contra = No $ antiCom contra 118 | decer (O :: ys) (X :: zs) with (decer ys zs) 119 | decer (O :: ys) (X :: zs) | Yes prf = Yes $ ComOX prf 120 | decer (O :: ys) (X :: zs) | No contra = No $ antiCom contra 121 | decer (O :: ys) (O :: zs) with (decer ys zs) 122 | decer (O :: ys) (O :: zs) | Yes prf = Yes $ ComOO prf 123 | decer (O :: ys) (O :: zs) | No contra = No $ antiCom contra 124 | 125 | partial 126 | add' : (m1 : Marks n i) -> (m2 : Marks n j) -> Compat m1 m2 127 | add' m1 m2 with (decer m1 m2) 128 | | Yes c = c 129 | 130 | 131 | data Compatible : List (Marks_ n) -> Marks_ n -> Type where 132 | OneCom : (m : Marks_ n) -> Compatible [m] m 133 | NextCom : (m : Marks_ n) 134 | -> Compatible l m0 135 | -> {c : Compat (getProof m) (getProof m0)} 136 | -> Compatible (m::l) (_ ** markAdd c) 137 | 138 | data CompatSet : Nat -> Type where 139 | CompSet : {m : Marks_ n} -> (Compatible l m) -> CompatSet n 140 | 141 | mkComp : Marks n j -> CompatSet n 142 | mkComp m = CompSet $ OneCom (_ ** m) 143 | 144 | partial comp' : (x : Marks_ n) -> Compatible l m -> (j ** Compatible (x::l) j) 145 | comp' {m} x allc with (decer (getProof x) (getProof m)) 146 | | Yes c = (_ ** NextCom {c} x allc) 147 | 148 | partial comp : (x : Marks_ n) -> CompatSet n -> CompatSet n 149 | comp x (CompSet c) = CompSet $ getProof $ comp' x c 150 | 151 | ||| A partition of a set of sites into subsets 152 | data Partition : (x : Marks n m) -> Type where 153 | POne : (y : Marks n m) -> Partition y 154 | PNext : (y : Marks n m) -> (c : Compat y z) -> Partition z -> Partition (markAdd c) 155 | 156 | 157 | ||| A complete partition of a set of sites into subsets 158 | data PartitionOfUnity : Nat -> Type where 159 | PUnity : {m : Marks n n} -> (p : Partition m) -> PartitionOfUnity n 160 | 161 | ||| A partition of a set of sites into subsets of a particular size 162 | ||| @ i the size of the subsets 163 | ||| @ x which sites are included in the partition 164 | data PartitionBy : (i : Nat) -> (x : Marks n m) -> Type where 165 | PBZero : PartitionBy i (empty_ n) 166 | PBNext : {y : Marks n i} -> (c : Compat y z) -> PartitionBy i z -> PartitionBy i (markAdd c) 167 | 168 | ||| A complete partition of a set of sites into subsets of a fixed size 169 | ||| @ i the size of the subsets 170 | ||| @ n the size of the partitioned set 171 | data PartitionOfUnityBy : (i : Nat) -> (n : Nat) -> Type where 172 | PUnityBy : {x : Marks n n} -> (p : PartitionBy i x) -> PartitionOfUnityBy i n 173 | 174 | 175 | ||| The dual of a marked set, status of every site switched 176 | dual : Marks n m -> Marks n (n `minus` m) 177 | dual [] = [] 178 | dual (X :: q) = O :: dual q 179 | dual (O :: q) ?= X :: dual q 180 | 181 | 182 | test1 : Partition [X,O] 183 | test1 = POne [X,O] 184 | 185 | test2 : Partition [X,X] 186 | test2 = PNext [O,X] (ComOX (ComXO ComZero)) test1 187 | 188 | 189 | ---------- Proofs ---------- 190 | 191 | 192 | 193 | minusSuccLeft : (n,m : Nat) -> LTE m n -> (S n) `minus` m = S (n `minus` m) 194 | minusSuccLeft n Z LTEZero = ?minusSuccLeft_rhs_1 195 | minusSuccLeft (S n) (S m) (LTESucc l) with (minusSuccLeft n m l) 196 | | eqn = ?minusSuccLeft_rhs_2 197 | 198 | minusSuccLeft_rhs_1 = proof 199 | intros 200 | rewrite sym $ minusZeroRight n 201 | trivial 202 | 203 | minusSuccLeft_rhs_2 = proof 204 | intros 205 | trivial 206 | 207 | dual_lemma_1 = proof 208 | intros 209 | let prf = markBound q 210 | let msl = minusSuccLeft n k prf 211 | rewrite sym msl 212 | trivial 213 | -------------------------------------------------------------------------------- /src/xquant/Math/Hilbert.idr: -------------------------------------------------------------------------------- 1 | module xquant.Math.Hilbert 2 | 3 | import xquant.Core.Types 4 | import Data.Matrix 5 | import Data.Complex 6 | 7 | -- Normalize 8 | normalize : StateSpace n Float -> StateSpace n Float 9 | normalize q = map (\(r :+ i) => (r / (sqrt sqn)) :+ (i / (sqrt sqn))) q where 10 | sqn : Double 11 | sqn = sum $ map ((\x => x*x) . magnitude) q 12 | 13 | conjugate : (Num a , Neg a) => Complex a -> Complex a 14 | conjugate (r :+ i) = r :+ -i 15 | 16 | -- Infix Hilbert inner product 17 | -- should be more general, but no official declaration for Num a => Num (Complex a) 18 | ||| Hilbert Inner product 19 | (<|>) : StateSpace n Float -> StateSpace n Float -> Complex Float 20 | (<|>) q w = sum $ zipWith (*) (map Complex.conjugate q) w 21 | 22 | 23 | -- Hermitian conjugate (adjoint) on complex matrices 24 | dagger : (Num a , Neg a) => Matrix n m (Complex a) -> Matrix m n (Complex a) 25 | dagger h = map (map Hilbert.conjugate) $ transpose h 26 | 27 | -- Complex number divide 28 | (/) : Complex Float -> Complex Float -> Complex Float 29 | (/) (a:+b) (c:+d) = let real = (a*c+b*d)/(c*c+d*d) 30 | imag = (b*c-a*d)/(c*c+d*d) 31 | in (real :+ imag) 32 | -------------------------------------------------------------------------------- /src/xquant/Math/Set.idr: -------------------------------------------------------------------------------- 1 | module xquant.Math.Set 2 | 3 | import public Data.Vect 4 | 5 | %default total 6 | 7 | ||| A vector of unique elements 8 | data Set : Vect n a -> Type where 9 | Nil : Set [] 10 | (::) : Not (Elem x xs) -> Set xs -> Set (x :: xs) 11 | 12 | ||| Elements of a type 13 | data HasElements : (t : Type) -> (v : Vect n t) -> Type where 14 | MkHas : {v : Vect n t} -> 15 | Set v -> 16 | ((x : t) -> Elem x v) -> 17 | HasElements t v 18 | 19 | data Cardinality : (t : Type) -> Nat -> Type where 20 | Cardinal : {v : Vect n t} -> HasElements t v -> Cardinality t n 21 | 22 | 23 | noElem : Elem x [] -> Void 24 | noElem Here impossible 25 | 26 | ---- Example: Bool ---- 27 | 28 | notElemTF : Elem True [False] -> Void 29 | notElemTF Here impossible 30 | notElemTF (There x) = noElem x 31 | 32 | setFalse : Set [False] 33 | setFalse = noElem :: [] 34 | 35 | set1 : (x : a) -> Set [a] 36 | set1 x = noElem :: [] 37 | 38 | 39 | setTrueFalse : Set [True, False] 40 | setTrueFalse = notElemTF :: setFalse 41 | 42 | boolHas : HasElements Bool [True,False] 43 | boolHas = MkHas setTrueFalse (\b => case b of 44 | True => Here 45 | False => There Here) 46 | 47 | boolHasTwo : Cardinality Bool 2 48 | boolHasTwo = Cardinal boolHas 49 | -------------------------------------------------------------------------------- /src/xquant/Spinor/BKS.idr: -------------------------------------------------------------------------------- 1 | module xquant.Spinor.BKS 2 | 3 | import Data.Vect 4 | import xquant.Spinor.Sigmas 5 | import xquant.Spinor.SigKets 6 | 7 | %default total 8 | 9 | ----------------------------------------------------------------------- 10 | -- Commutation 11 | ----------------------------------------------------------------------- 12 | 13 | ||| Individual Pauli operators commute iff they are identical up to a phase, 14 | ||| or if one of them is the identity 15 | data PauliComm : Pauli -> Pauli -> Type where 16 | PSame : (p : Pauli) -> PauliComm p p 17 | PIdRight : (p : Pauli) -> PauliComm p SI 18 | PIdLeft : (p : Pauli) -> PauliComm SI p 19 | 20 | ||| Pauli operators do not commute iff they are not identical up to a phase, 21 | ||| and one of them isn't the identity 22 | data PauliNonComm : Pauli -> Pauli -> Type where 23 | NonCommXY : PauliNonComm SX SY 24 | NonCommYZ : PauliNonComm SY SZ 25 | NonCommZX : PauliNonComm SZ SX 26 | NonCommSwap : PauliNonComm q w -> PauliNonComm w q 27 | 28 | ||| Decide whether two Pauli operators commute or not 29 | decCommPauli : (x : Pauli) -> (y : Pauli) -> Either (PauliComm x y) (PauliNonComm x y) 30 | decCommPauli SI p = Left $ PIdLeft p 31 | decCommPauli p SI = Left $ PIdRight p 32 | decCommPauli SX SX = Left $ PSame SX 33 | decCommPauli SY SY = Left $ PSame SY 34 | decCommPauli SZ SZ = Left $ PSame SZ 35 | decCommPauli SX SY = Right $ NonCommXY 36 | decCommPauli SY SX = Right $ NonCommSwap NonCommXY 37 | decCommPauli SY SZ = Right $ NonCommYZ 38 | decCommPauli SZ SY = Right $ NonCommSwap NonCommYZ 39 | decCommPauli SZ SX = Right $ NonCommZX 40 | decCommPauli SX SZ = Right $ NonCommSwap NonCommZX 41 | 42 | mutual 43 | ||| A pair of commuting Sigma operators is formed by prepending a pair of commuting Paulis 44 | ||| onto a pair of commuting Sigmas, or by prepending a pair of non-commuting Paulis onto 45 | ||| a pair of non-commuting Sigmas. Sigmas of level zero (pure numbers) trivially commute. 46 | data Commuting : Sigma n -> Sigma n -> Type where 47 | CommPhase : {s1,s2 : Sigma Z} -> Commuting s1 s2 48 | CommSame : PauliComm j k -> Commuting g h -> Commuting (Sig j g) (Sig k h) 49 | CommDiff : PauliNonComm j k -> NonCommuting g h -> Commuting (Sig j g) (Sig k h) 50 | 51 | ||| A pair of non-commuting Sigma operators is formed by prepending a pair of commuting Paulis 52 | ||| onto a pair of non-commuting Sigmas, or by prepending a pair of non-commuting Paulis onto 53 | ||| a pair of commuting Sigmas. 54 | data NonCommuting : Sigma n -> Sigma n -> Type where 55 | NoCommSame : PauliNonComm j k -> Commuting g h -> NonCommuting (Sig j g) (Sig k h) 56 | NoCommDiff : PauliComm j k -> NonCommuting g h -> NonCommuting (Sig j g) (Sig k h) 57 | 58 | ||| Decide whether two Sigma operators commute or not 59 | decComm : (x : Sigma n) -> (y : Sigma n) -> Either (Commuting x y) (NonCommuting x y) 60 | decComm (sPhase p1) (sPhase p2) = Left CommPhase 61 | decComm (Sig p1 s1) (Sig p2 s2) with (decComm s1 s2) 62 | decComm (Sig p1 s1) (Sig p2 s2) | commPrf with (decCommPauli p1 p2) 63 | decComm (Sig p1 s1) (Sig p2 s2) | Left cm | Left cmp = Left $ CommSame cmp cm 64 | decComm (Sig p1 s1) (Sig p2 s2) | Left cm | Right ncp = Right $ NoCommSame ncp cm 65 | decComm (Sig p1 s1) (Sig p2 s2) | Right nc | Left cmp = Right $ NoCommDiff cmp nc 66 | decComm (Sig p1 s1) (Sig p2 s2) | Right nc | Right ncp = Left $ CommDiff ncp nc 67 | 68 | commTest : Vect n (Sigma m) -> Bool 69 | commTest [] = True 70 | commTest (x :: xs) = all (commute x) xs && (commTest xs) 71 | 72 | data MutuallyCommuting : Vect n (Sigma m) -> Type where 73 | IsMutuallyCommuting : (v : Vect n $ Sigma m) -> 74 | commTest v = True -> 75 | MutuallyCommuting v 76 | 77 | data CommStatus : (x : Sigma n) -> (y : Sigma n) -> Type where 78 | Status_Comm : Commuting x y -> CommStatus x y 79 | Status_NoComm : NonCommuting x y -> CommStatus x y 80 | 81 | 82 | ----------------------------------------------------------------------- 83 | -- Even Parity (for each subspace & generator) datatype 84 | ----------------------------------------------------------------------- 85 | 86 | data Parity = Even | Odd 87 | 88 | data PauliParity = PParity Parity Parity Parity 89 | 90 | swap : Parity -> Parity 91 | swap Even = Odd 92 | swap Odd = Even 93 | 94 | updateP : Pauli -> PauliParity -> PauliParity 95 | updateP SX (PParity x y z) = PParity (swap x) y z 96 | updateP SY (PParity x y z) = PParity x (swap y) z 97 | updateP SZ (PParity x y z) = PParity x y (swap z) 98 | updateP SI p = p 99 | 100 | updateParity : Sigma n -> Vect n PauliParity -> Vect n PauliParity 101 | updateParity (sPhase ph) [] = [] 102 | updateParity (Sig pl s) (p::ps) = (updateP pl p) :: (updateParity s ps) 103 | 104 | ||| Sets of Sigma n operators can be classified by whether each Sigma occurs 105 | ||| an even or odd number of times in each single-qubit Hilbert Space 106 | data SigmaParity : Vect n (Sigma m) -> Vect m PauliParity -> Type where 107 | ParityZero : {m : Nat} -> SigmaParity [] (replicate m $ PParity Even Even Even) 108 | ParityNext : {v : Vect n (Sigma m)} -> 109 | (s : Sigma m) -> 110 | SigmaParity v p -> 111 | SigmaParity (s::v) (updateParity s p) 112 | 113 | data EvenParity : Vect n (Sigma m) -> Type where 114 | IsEven : {v : Vect n (Sigma m)} -> 115 | SigmaParity v (replicate m $ PParity Even Even Even) -> 116 | EvenParity v 117 | 118 | evenParity : (n : Nat) -> Vect n PauliParity 119 | evenParity n = replicate n $ PParity Even Even Even 120 | 121 | 122 | ----------------------------------------------------------------------- 123 | -- Multiply-to-Negative-Identity datatype 124 | ----------------------------------------------------------------------- 125 | 126 | data NegId : Vect n (Sigma m) -> Type where 127 | IsNegId : (v : Vect (S n) (Sigma m)) -> 128 | foldr1 (<>) v = negId m -> 129 | NegId v 130 | 131 | 132 | ----------------------------------------------------------------------- 133 | -- BKS Theorem datatype 134 | ----------------------------------------------------------------------- 135 | 136 | data BKS : Vect n (Sigma m) -> Type where 137 | MkBKS : MutuallyCommuting v -> 138 | NegId v -> 139 | EvenParity v -> 140 | BKS v 141 | 142 | 143 | ----------------------------------------------------------------------- 144 | -- 5-qubit BKS proof of David DiVincenzo & Asher Peres 145 | ----------------------------------------------------------------------- 146 | 147 | zzzzz : Sigma 5 148 | zzzzz = sZ <&> sZ <&> sZ <&> sZ <&> sZ 149 | 150 | zxIIx : Sigma 5 151 | zxIIx = sZ <&> sX <&> sI <&> sI <&> sX 152 | 153 | xzxII : Sigma 5 154 | xzxII = sX <&> sZ <&> sX <&> sI <&> sI 155 | 156 | IxzxI : Sigma 5 157 | IxzxI = sI <&> sX <&> sZ <&> sX <&> sI 158 | 159 | IIxzx : Sigma 5 160 | IIxzx = sI <&> sI <&> sX <&> sZ <&> sX 161 | 162 | xIIxz : Sigma 5 163 | xIIxz = sX <&> sI <&> sI <&> sX <&> sZ 164 | 165 | 166 | Asher_David : Vect 6 (Sigma 5) 167 | Asher_David = [zzzzz, 168 | zxIIx, 169 | xzxII, 170 | IxzxI, 171 | IIxzx, 172 | xIIxz] 173 | 174 | 175 | Asher_David_Commuting : MutuallyCommuting Asher_David 176 | Asher_David_Commuting = IsMutuallyCommuting Asher_David Refl 177 | 178 | Asher_David_NegId : NegId Asher_David 179 | Asher_David_NegId = IsNegId Asher_David Refl 180 | 181 | Asher_David_Parity : SigmaParity Asher_David $ evenParity 5 182 | Asher_David_Parity = ParityNext zzzzz $ 183 | ParityNext zxIIx $ 184 | ParityNext xzxII $ 185 | ParityNext IxzxI $ 186 | ParityNext IIxzx $ 187 | ParityNext xIIxz ParityZero 188 | 189 | Asher_David_EvenParity : EvenParity Asher_David 190 | Asher_David_EvenParity = IsEven Asher_David_Parity 191 | 192 | Asher_David_BKS : BKS Asher_David 193 | Asher_David_BKS = MkBKS Asher_David_Commuting Asher_David_NegId Asher_David_EvenParity 194 | 195 | 196 | ----------------------------------------------------------------------- 197 | -- 4-qubit BKS proof of Aravind-Chryssanthacopoulos-Harvey 198 | ----------------------------------------------------------------------- 199 | 200 | xxxx : Sigma 4 201 | xxxx = sX <&> sX <&> sX <&> sX 202 | 203 | xxzz : Sigma 4 204 | xxzz = sX <&> sX <&> sZ <&> sZ 205 | 206 | zxxz : Sigma 4 207 | zxxz = sZ <&> sX <&> sX <&> sZ 208 | 209 | zxzx : Sigma 4 210 | zxzx = sZ <&> sX <&> sZ <&> sX 211 | 212 | 213 | Aravind : Vect 4 (Sigma 4) 214 | Aravind = [xxxx, 215 | xxzz, 216 | zxxz, 217 | zxzx] 218 | 219 | Aravind_Commuting : MutuallyCommuting Aravind 220 | Aravind_Commuting = IsMutuallyCommuting Aravind Refl 221 | 222 | Aravind_NegId : NegId Aravind 223 | Aravind_NegId = IsNegId Aravind Refl 224 | 225 | Aravind_Parity : SigmaParity Aravind $ evenParity 4 226 | Aravind_Parity = ParityNext xxxx $ 227 | ParityNext xxzz $ 228 | ParityNext zxxz $ 229 | ParityNext zxzx ParityZero 230 | 231 | Aravind_Even_Parity : EvenParity Aravind 232 | Aravind_Even_Parity = IsEven Aravind_Parity 233 | 234 | Aravind_BKS : BKS Aravind 235 | Aravind_BKS = MkBKS Aravind_Commuting Aravind_NegId Aravind_Even_Parity 236 | -------------------------------------------------------------------------------- /src/xquant/Spinor/Gamma.idr: -------------------------------------------------------------------------------- 1 | module xquant.Spinor.Gamma 2 | 3 | import xquant.Core.Types 4 | import public Data.Matrix.Algebraic 5 | import public Control.Algebra.NumericInstances 6 | import public Data.Complex 7 | 8 | %default total 9 | 10 | -- Begin with two primative Gamma matrices, Γ0 and Γ1, generating Spin(2) 11 | 12 | ||| Γ0 = iσy 13 | g0 : Matrix 2 2 (Complex Integer) 14 | g0 = [[c0, c1], [m1, c0]] 15 | 16 | ||| Γ1 = σx 17 | g1 : Matrix 2 2 (Complex Integer) 18 | g1 = [[c0, c1], [c1, c0]] 19 | 20 | {- Construct gammas for even-dimensional spinor representations (D = 2k + 2) 21 | First tensor as follows: 22 | 23 | G^μ = Γ^mu <&> diag(-1,1), (where mu <- [0..D-2]) or equivalently, 24 | G^μ = Γ^mu <&> (g1 <> g0) 25 | 26 | Then adding two new gammas: 27 | 28 | G^{D-1} = Id <&> Γ1 = Id ⊗ σx 29 | G^D = Id <&> -iΓ0 = Id ⊗ σy -} 30 | 31 | ||| Gamma matrices for even dimensions D = 2k + 2, with size 2^(k+1) 32 | gammaEven : (k : Nat) -> Vect (k*2 + 2) $ Matrix (power 2 (S k)) (power 2 (S k)) (Complex Integer) 33 | gammaEven Z = [g0, g1] 34 | gammaEven (S k) ?= {Lemma_1} map (\g => g <&> (g1 <> g0)) (gammaEven k) ++ [Id <&> g1, mi <#> Id <&> g0] 35 | 36 | {- Matrices defined in this way satisy the gamma matrix algebra: 37 | 38 | {Γμ,Γν} = 2 η{μν} Id (upstairs indices) 39 | 40 | They also furnish Poincaré generators Σ^{μν} = −i[Γ^μ,Γ^ν] 41 | satisfying, by definition: i[Σμν,Σσρ] = ηνσΣμρ + ημρΣνσ − ηνρΣμσ − ημσΣνρ 42 | 43 | This holds in any dimensionality and in both Minkowski and Euclidean signatures. 44 | 45 | Now define the "fifth Gamma Matrix", denoted Γ -} 46 | 47 | ||| The "fifth gamma matrix" given by 48 | ||| 49 | ||| Γ = i^{–k} (Γ^0 ... Γ^{D-1}) 50 | ||| 51 | ||| forms an odd-dimensional (irriducible) spinor representation by adding to the appropriate (gammaEven k) 52 | gamma : Vect (k*2+2) $ Matrix (power 2 $ S k) (power 2 $ S k) (Complex Integer) -> 53 | Matrix (power 2 $ S k) (power 2 $ S k) (Complex Integer) 54 | gamma {k} gs = (pow' mi k) <#> (product' gs) 55 | 56 | {- Γ has eigenvalues of ±1 and satisfies: 57 | 58 | Γ^2 = 1 59 | {Γ,Γ^μ} = 0 60 | [Γ,Σ^{μν}] = 0 -} 61 | 62 | g3 : Matrix 2 2 (Complex Integer) 63 | g3 = product' $ with List [g0,g1] 64 | 65 | {- 66 | ||| Anticommutation relation, {Γμ,Γν} = 2 η{μν} Id, for D = 2 67 | D2_anticommRelation_00 : (g0 >><< g0) = ((-2 :+ 0) <#> Id) 68 | D2_anticommRelation_00 = Refl 69 | 70 | ||| Anticommutation relation, {Γμ,Γν} = 2 η{μν} Id, for D = 2 71 | D2_anticommRelation_01 : g0 >><< g1 = [neutral, neutral] 72 | D2_anticommRelation_01 = Refl 73 | 74 | ||| Anticommutation relation, {Γμ,Γν} = 2 η{μν} Id, for D = 2 75 | D2_anticommRelation_10 : g1 >><< g0 = [neutral, neutral] 76 | D2_anticommRelation_10 = Refl 77 | 78 | ||| Anticommutation relation, {Γμ,Γν} = 2 η{μν} Id, for D = 2 79 | D2_anticommRelation_11 : g1 >><< g1 = (2 :+ 0) <#> Id 80 | D2_anticommRelation_11 = Refl 81 | -} 82 | 83 | ---------- Proofs ---------- 84 | 85 | multTwoRightPlusTimesOne : (n : Nat) -> mult n 2 = n + (mult n 1) 86 | multTwoRightPlusTimesOne = proof 87 | intros 88 | rewrite (multRightSuccPlus n (S Z)) 89 | trivial 90 | 91 | multTwoRightPlus : (n : Nat) -> n * 2 = plus n n 92 | multTwoRightPlus = proof 93 | intros 94 | rewrite (sym $ multTwoRightPlusTimesOne n) 95 | rewrite (sym $ multOneRightNeutral n) 96 | trivial 97 | 98 | plusPlusZero : (x,y : Nat) -> x + y = x + (y + 0) 99 | plusPlusZero = proof 100 | intros 101 | rewrite (sym $ plusZeroRightNeutral y) 102 | trivial 103 | 104 | Lemma_1 = proof 105 | intros 106 | rewrite (plusZeroRightNeutral (plus (mult k 2) 2)) 107 | rewrite (sym $ plusSuccRightSucc (plus (mult k 2) 2) 0) 108 | rewrite (sym $ plusSuccRightSucc (plus (mult k 2) 2) 1) 109 | rewrite (sym $ plusZeroRightNeutral (power 2 k)) 110 | rewrite (sym $ plusZeroRightNeutral (power 2 k + (power 2 k))) 111 | rewrite (multTwoRightPlus (plus (power 2 k) (power 2 k))) 112 | rewrite (sym $ plusPlusZero (power 2 k) (power 2 k)) 113 | trivial 114 | -------------------------------------------------------------------------------- /src/xquant/Spinor/SigKets.idr: -------------------------------------------------------------------------------- 1 | module xquant.Spinor.SigKets 2 | 3 | import public xquant.Spinor.Sigmas 4 | import public xquant.Core.Types 5 | import public xquant.Math.Hilbert 6 | 7 | import Data.Matrix.Algebraic 8 | import Data.Complex 9 | import Data.ZZ 10 | 11 | infixl 3 <\> 12 | infixl 3 <|> 13 | infixr 4 14 | infixr 7 <&> 15 | 16 | %default total 17 | 18 | 19 | ---- State Data ---- 20 | 21 | 22 | ||| Spin orientation datatype - no identity option, unlike Pauli data type, 23 | ||| though it could possibly be added to represent a neutral density matrix 24 | data Orient = X | Y | Z 25 | 26 | data Spin = Up | Down 27 | 28 | instance Eq Spin where 29 | Up == Up = True 30 | Down == Down = True 31 | Up == Down = False 32 | Down == Up = False 33 | 34 | ||| basic spin orientation datatype 35 | data EigenSpin = Eigenspin Orient Spin 36 | 37 | ||| collumn 'ket' vector for multiple spins 38 | data KetSpins : Nat -> Type where 39 | kPhase : Phase -> KetSpins Z 40 | kS : EigenSpin -> KetSpins k -> KetSpins (S k) 41 | 42 | ||| row 'bra' vector for multiple spins 43 | data BraSpins : Nat -> Type where 44 | bPhase : Phase -> BraSpins Z 45 | bS : EigenSpin -> BraSpins k -> BraSpins (S k) 46 | 47 | ||| convert a bra to a ket 48 | bk : BraSpins n -> KetSpins n 49 | bk (bPhase p) = kPhase $ star p 50 | bk (bS e bs) = kS e (bk bs) 51 | 52 | ||| convert a ket to a bra 53 | kb : KetSpins n -> BraSpins n 54 | kb (kPhase p) = bPhase $ star p 55 | kb (kS e ks) = bS e (kb ks) 56 | 57 | ||| easy initialize bra 58 | bra : EigenSpin -> BraSpins 1 59 | bra e = bS e $ bPhase P1 60 | 61 | ||| easy initialize ket 62 | ket : EigenSpin -> KetSpins 1 63 | ket e = kS e $ kPhase P1 64 | 65 | instance Show Orient where 66 | show X = "X" 67 | show Y = "Y" 68 | show Z = "Z" 69 | 70 | instance Show Spin where 71 | show Up = "Up" 72 | show Down = "Dn" 73 | 74 | instance Show EigenSpin where 75 | show (Eigenspin o s) = (show o) ++ "-" ++ (show s) 76 | 77 | ||| EigenSpin shorthands 78 | upX : EigenSpin 79 | upX = Eigenspin X Up 80 | downX : EigenSpin 81 | downX = Eigenspin X Down 82 | 83 | upY : EigenSpin 84 | upY = Eigenspin Y Up 85 | downY : EigenSpin 86 | downY = Eigenspin Y Down 87 | 88 | upZ : EigenSpin 89 | upZ = Eigenspin Z Up 90 | downZ : EigenSpin 91 | downZ = Eigenspin Z Down 92 | 93 | uX : EigenSpin 94 | uX = upX 95 | dX : EigenSpin 96 | dX = downX 97 | 98 | uY : EigenSpin 99 | uY = upY 100 | dY : EigenSpin 101 | dY = downY 102 | 103 | uZ : EigenSpin 104 | uZ = upZ 105 | dZ : EigenSpin 106 | dZ = downZ 107 | 108 | ||| Single abstract sigma acting on ket 109 | ObsKet1 : Sigma 1 -> KetSpins 1 -> KetSpins 1 110 | ObsKet1 (Sig SI $ sPhase p1) (kS (Eigenspin o ud) (kPhase p2)) = kS (Eigenspin o ud) (kPhase $ p1 <+> p2) 111 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin X Up) (kPhase p2)) = kS (Eigenspin X Up) (kPhase $ p1 <+> p2) 112 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin X Down) (kPhase p2)) = kS (Eigenspin X Down) (kPhase $ p1 <+> p2 <+> M1) 113 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin Y Up) (kPhase p2)) = kS (Eigenspin Y Down) (kPhase $ p1 <+> p2 <+> Pi) 114 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin Y Down) (kPhase p2)) = kS (Eigenspin Y Up) (kPhase $ p1 <+> p2 <+> P1) 115 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin Z Up) (kPhase p2)) = kS (Eigenspin Z Down) (kPhase $ p1 <+> p2) 116 | ObsKet1 (Sig SX $ sPhase p1) (kS (Eigenspin Z Down) (kPhase p2)) = kS (Eigenspin Z Up) (kPhase $ p1 <+> p2) 117 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin X Up) (kPhase p2)) = kS (Eigenspin Y Up) (kPhase $ p1 <+> p2) 118 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin X Down) (kPhase p2)) = kS (Eigenspin Y Down) (kPhase $ p1 <+> p2 <+> M1) 119 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin Y Up) (kPhase p2)) = kS (Eigenspin Z Down) (kPhase $ p1 <+> p2 <+> Pi) 120 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin Y Down) (kPhase p2)) = kS (Eigenspin X Up) (kPhase $ p1 <+> p2 <+> Mi) 121 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin Z Up) (kPhase p2)) = kS (Eigenspin Z Down) (kPhase $ p1 <+> p2 <+> Pi) 122 | ObsKet1 (Sig SY $ sPhase p1) (kS (Eigenspin Z Down) (kPhase p2)) = kS (Eigenspin Z Up) (kPhase $ p1 <+> p2 <+> M1) 123 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin X Up) (kPhase p2)) = kS (Eigenspin X Down) (kPhase $ p1 <+> p2 <+> M1) 124 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin X Down) (kPhase p2)) = kS (Eigenspin X Up) (kPhase $ p1 <+> p2 <+> M1) 125 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin Y Up) (kPhase p2)) = kS (Eigenspin Y Down) (kPhase $ p1 <+> p2 <+> M1) 126 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin Y Down) (kPhase p2)) = kS (Eigenspin Y Up) (kPhase $ p1 <+> p2 <+> M1) 127 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin Z Up) (kPhase p2)) = kS (Eigenspin Z Up) (kPhase $ p1 <+> p2) 128 | ObsKet1 (Sig SZ $ sPhase p1) (kS (Eigenspin Z Down) (kPhase p2)) = kS (Eigenspin Z Down) (kPhase $ p1 <+> p2 <+> M1) 129 | 130 | timesPhase : Phase -> KetSpins n -> KetSpins n 131 | timesPhase p1 (kPhase p2) = kPhase (p1 <+> p2) 132 | timesPhase p1 (kS e es) = kS e (timesPhase p1 es) 133 | 134 | topOrientation : KetSpins (S n) -> Orient 135 | topOrientation (kS (Eigenspin o s) more) = o 136 | 137 | topKetSpin : KetSpins (S n) -> EigenSpin 138 | topKetSpin (kS e es) = e 139 | 140 | lastSpin : KetSpins (S k) -> EigenSpin 141 | lastSpin (kS e (kPhase ph)) = e 142 | lastSpin (kS e (kS e2 es)) = lastSpin (kS e2 es) 143 | 144 | kPack : EigenSpin -> KetSpins 1 145 | kPack e = kS e (kPhase P1) 146 | 147 | kGetPhase : KetSpins n -> Phase 148 | kGetPhase (kPhase p) = p 149 | kGetPhase (kS (Eigenspin o s) x) = kGetPhase x 150 | 151 | ||| Apply Sigma operator to abstract multi-qubit states 152 | ObsKet : Sigma n -> KetSpins n -> KetSpins n 153 | ObsKet (sPhase p1) (kPhase p2) = kPhase $ p1 <+> p2 154 | ObsKet (Sig pl s) (kS k ks) with (ObsKet1 (pack pl) (kPack k)) 155 | | r = kS (topKetSpin r) (timesPhase (kGetPhase r) (ObsKet s ks)) 156 | 157 | ||| Infix op for Sigma-Ket multiply 158 | () : Sigma n -> KetSpins n -> KetSpins n 159 | () = ObsKet 160 | 161 | ||| Infix op for Bra-Sigma multiply 162 | (<\>) : BraSpins n -> Sigma n -> BraSpins n 163 | (<\>) b s = kb $ ObsKet s (bk b) 164 | 165 | ||| Another alias for Bra-Sigma multiply, for maximal harmony with written convention 166 | (<|>) : BraSpins n -> Sigma n -> BraSpins n 167 | (<|>) = (<\>) 168 | 169 | instance Show (KetSpins n) where 170 | show (kPhase phase) = show phase 171 | show s = (Prefix s) ++ "[" ++ (suffix s) ++ "]" where 172 | suffix : KetSpins n -> String 173 | suffix (kPhase ph) = "" 174 | suffix (kS p (kPhase ph)) = (show p) 175 | suffix (kS p s) = (show p) ++ (suffix s) 176 | Prefix : KetSpins n -> String 177 | Prefix (kPhase (Sign a b)) = (if a then "-" else "") ++ (if b then "i " else "") 178 | Prefix (kS p s) = Prefix s 179 | 180 | ||| Tensor product for abstract multi-qubit kets 181 | ox : KetSpins n -> KetSpins m -> KetSpins (n + m) 182 | ox e (kPhase ph) ?= {Ket_OTimes_Lemma_1} timesPhase ph e 183 | ox (kPhase ph) e = timesPhase ph e 184 | ox (kS e1 es1) (kS e2 es2) ?= {Ket_OTimes_Lemma_2} ox (dropLast $ kS e1 es1) 185 | (kS (lastSpin $ kS e1 es1) (kS e2 es2)) where 186 | dropLast : KetSpins (S k) -> KetSpins k 187 | dropLast (kS e (kPhase ph)) = kPhase ph 188 | dropLast (kS e (kS e2 es)) = kS e (dropLast $ kS e2 es) 189 | 190 | ||| Infix tensor multiply kets 191 | Ket.(<&>) : KetSpins n -> KetSpins m -> KetSpins (n + m) 192 | Ket.(<&>) = ox 193 | 194 | ||| Infix tensor multiply bras 195 | Bra.(<&>) : BraSpins n -> BraSpins m -> BraSpins (n + m) 196 | Bra.(<&>) b1 b2 = kb $ ox (bk b1) (bk b2) 197 | 198 | 199 | ---- Numeric State & Operator Data ---- 200 | 201 | 202 | ||| Phase to complex number 203 | Phase.comZ : Phase -> Complex ZZ 204 | Phase.comZ (Sign False False) = c1 205 | Phase.comZ (Sign False True) = ci 206 | Phase.comZ (Sign True False) = m1 207 | Phase.comZ (Sign True True) = mi 208 | 209 | ||| Phase to complex float 210 | Phase.comF : Phase -> Complex Float 211 | Phase.comF (Sign False False) = c1 212 | Phase.comF (Sign False True) = ci 213 | Phase.comF (Sign True False) = m1 214 | Phase.comF (Sign True True) = mi 215 | 216 | ||| Integral Sigma 1's 217 | sx : QubitOp 1 ZZ 218 | sx = [[c0, c1], [c1, c0]] 219 | 220 | sy : QubitOp 1 ZZ 221 | sy = [[c0, mi], [ci, c0]] 222 | 223 | sz : QubitOp 1 ZZ 224 | sz = [[c1, c0], [c0, m1]] 225 | 226 | si : QubitOp 1 ZZ 227 | si = [[c1, c0], [c0, c1]] 228 | 229 | Pauli.comZ : Pauli -> QubitOp 1 ZZ 230 | Pauli.comZ SX = sx 231 | Pauli.comZ SY = sy 232 | Pauli.comZ SZ = sz 233 | Pauli.comZ SI = si 234 | 235 | ||| Floating Sigma 1's 236 | Pauli.comF : Pauli -> QubitOp 1 Float 237 | Pauli.comF SX = (0.5 :+ 0) <#> [[c0, c1], [c1, c0]] 238 | Pauli.comF SY = (0.5 :+ 0) <#> [[c0, mi], [ci, c0]] 239 | Pauli.comF SZ = (0.5 :+ 0) <#> [[c1, c0], [c0, m1]] 240 | Pauli.comF SI = (0.5 :+ 0) <#> [[c1, c0], [c0, c1]] 241 | 242 | ||| Sigma n to matrix 243 | Sigma.comF : Sigma n -> QubitOp n Float 244 | Sigma.comF (sPhase ph) = [[comF ph]] 245 | Sigma.comF (Sig p s) = (comF p) <&> (comF s) 246 | 247 | ||| Sigma n to matrix 248 | Sigma.comZ : Sigma n -> QubitOp n ZZ 249 | Sigma.comZ (sPhase ph) = [[comZ ph]] 250 | Sigma.comZ (Sig p s) = (comZ p) <&> (comZ s) 251 | 252 | 253 | ||| Numeric KetSpin vectors 254 | xUp : Qubit 1 Float 255 | xUp = normalize [c1, c1] 256 | 257 | xDown : Qubit 1 Float 258 | xDown = normalize [m1, c1] 259 | 260 | yUp : Qubit 1 Float 261 | yUp = normalize [mi, c1] 262 | 263 | yDown : Qubit 1 Float 264 | yDown = normalize [ci, c1] 265 | 266 | zUp : Qubit 1 Float 267 | zUp = [c1, c0] 268 | 269 | zDown : Qubit 1 Float 270 | zDown = [c0, c1] 271 | 272 | ||| [single] KetSpin to numeric vector 273 | Spin.matF : EigenSpin -> QubitKet 1 Float 274 | Spin.matF (Eigenspin X Up) = col xUp 275 | Spin.matF (Eigenspin X Down) = col xDown 276 | Spin.matF (Eigenspin Y Up) = col yUp 277 | Spin.matF (Eigenspin Y Down) = col yDown 278 | Spin.matF (Eigenspin Z Up) = col zUp 279 | Spin.matF (Eigenspin Z Down) = col zDown 280 | 281 | ||| [single] KetSpin to numeric vector 282 | KetSpins.matF : KetSpins n -> QubitKet n Float 283 | KetSpins.matF (kPhase ph) = [[comF ph]] 284 | KetSpins.matF (kS e k) = (Spin.matF e) <&> (KetSpins.matF k) 285 | 286 | ||| Bra to row-vector matrix 287 | BraSpins.matF : BraSpins n -> QubitBra n Float 288 | BraSpins.matF (bPhase ph) = [[comF (star ph)]] 289 | BraSpins.matF (bS e b) = (transpose $ Spin.matF e) <&> (BraSpins.matF b) 290 | 291 | ||| Bra times Ket to complex number 292 | Bra.(<\>) : Ring a => BraSpins n -> KetSpins n -> Complex Float 293 | Bra.(<\>) b k = index 0 $ index 0 $ (matF b) <> (matF k) 294 | 295 | 296 | ||| Sigma operators commute 297 | data Commutes : Sigma n -> Sigma n -> Type where 298 | CommZero : (x : Sigma Z) -> (y : Sigma Z) -> Commutes x y 299 | CommSucc : (a : Sigma 1) -> (b : Sigma 1) -> Commutes x y -> Commutes (a <&> x) (b <&> y) 300 | 301 | ||| Test for Sigma commutation 302 | commute : Sigma n -> Sigma n -> Bool 303 | commute (sPhase x) (sPhase y) = True 304 | commute (Sig p1 s1) (Sig p2 s2) = xor (p1 /= p2) $ commute s1 s2 305 | 306 | ||| Whether each non-identity Pauli operator occurs an even number of times 307 | qubitParity : List Pauli -> Vect 3 Bool 308 | qubitParity [] = [False, False, False] 309 | qubitParity (SI :: ss) = qubitParity ss 310 | qubitParity (SX :: ss) = updateAt 0 not $ qubitParity ss 311 | qubitParity (SY :: ss) = updateAt 1 not $ qubitParity ss 312 | qubitParity (SZ :: ss) = updateAt 2 not $ qubitParity ss 313 | 314 | ||| All Sigmas of a given order 315 | allSigmas : (n : Nat) -> List $ Sigma n 316 | allSigmas Z = [sPhase P1] 317 | allSigmas (S n) = allSigmas n >>= (\s => [Sig SI s, Sig SX s, Sig SY s, Sig SZ s]) 318 | 319 | ||| All pairs of Sigmas at the given order 320 | sigPair : (n : Nat) -> List $ Vect 2 (Sigma n) 321 | sigPair n = [ [s1,s2] | s1 <- (allSigmas n), s2 <- (allSigmas n) ] 322 | 323 | 324 | --------------- Proofs --------------- 325 | 326 | Ket_OTimes_Lemma_1 = proof 327 | intro 328 | rewrite (plusZeroRightNeutral n) 329 | intros 330 | trivial 331 | 332 | Ket_OTimes_Lemma_2 = proof 333 | intros 334 | rewrite sym $ plusSuccRightSucc k (S k1) 335 | trivial 336 | -------------------------------------------------------------------------------- /src/xquant/Spinor/Sigmas.idr: -------------------------------------------------------------------------------- 1 | module xquant.Spinor.Sigmas 2 | 3 | import public Control.Algebra 4 | 5 | infixr 5 <> 6 | infixr 7 <&> 7 | 8 | ------------------------------------------------------------------------------------------- 9 | -- Data for Sigma Operators • Complex signs (Phases) 10 | -- • Pauli operators 11 | -- • Higher Sigma operators 12 | -- (tensor products of Paulis with an overall phase) 13 | ------------------------------------------------------------------------------------------- 14 | 15 | ||| 4 primative complex phases, (+1), (+i), (-1), (-i), 16 | ||| bools represent minus sign and i presence respectively 17 | data Phase : Type where 18 | Sign : (minus : Bool) -> (i : Bool) -> Phase 19 | 20 | instance Show Phase where 21 | show (Sign False False) = "+1" 22 | show (Sign False True) = "+i" 23 | show (Sign True False) = "-1" 24 | show (Sign True True) = "-i" 25 | 26 | instance Eq Phase where 27 | (==) (Sign m1 i1) (Sign m2 i2) = (m1 == m2) && (i1 == i2) 28 | 29 | 30 | -- Exclusive OR 31 | xor : Bool -> Bool -> Bool 32 | xor a b = if a then not b else b 33 | 34 | instance Semigroup Phase where 35 | (<+>) (Sign as ai) (Sign bs bi) = Sign (xor (ai && bi) $ xor as bs) (xor ai bi) 36 | 37 | instance Monoid Phase where 38 | neutral = Sign False False 39 | 40 | instance Group Phase where 41 | inverse (Sign a b) = Sign (xor a b) b 42 | 43 | star : Phase -> Phase 44 | star (Sign a b) = Sign a (not b) 45 | 46 | -- Phase Shorthands - Capital 'P' for phases 47 | P1 : Phase 48 | P1 = Sign False False 49 | Pi : Phase 50 | Pi = Sign False True 51 | M1 : Phase 52 | M1 = Sign True False 53 | Mi : Phase 54 | Mi = Sign True True 55 | 56 | 57 | -- Pauli Data – Capital 'S' for basic sigma operators 58 | data Pauli = SI | SX | SY | SZ 59 | 60 | instance Show Pauli where 61 | show SI = "I" 62 | show SX = "x" 63 | show SY = "y" 64 | show SZ = "z" -- should be "σz" whene idris can print non-8-bit characters 65 | 66 | instance Eq Pauli where 67 | SI == SI = True 68 | SX == SX = True 69 | SY == SY = True 70 | SZ == SZ = True 71 | _ == _ = False 72 | 73 | 74 | -- Higher Sigma operator datatype, indexed by Nat 75 | data Sigma : Nat -> Type where 76 | sPhase : Phase -> Sigma Z 77 | Sig : Pauli -> Sigma k -> Sigma (S k) 78 | 79 | instance Show (Sigma n) where 80 | show (sPhase phase) = show phase 81 | show s = (Prefix s) ++ "[" ++ (suffix s) ++ "]" where 82 | suffix : Sigma n -> String 83 | suffix (sPhase ph) = "" 84 | suffix (Sig p (sPhase ph)) = (show p) 85 | suffix (Sig p s) = (show p) ++ (suffix s) 86 | Prefix : Sigma n -> String 87 | Prefix (sPhase (Sign a b)) = (if a then "-" else "") ++ (if b then "i " else "") 88 | Prefix (Sig p s) = Prefix s 89 | 90 | 91 | -- 4 Standard Sigma 1s 92 | sX : (Sigma 1) 93 | sX = Sig SX $ sPhase P1 94 | 95 | sY : Sigma 1 96 | sY = Sig SY $ sPhase P1 97 | 98 | sZ : Sigma 1 99 | sZ = Sig SZ $ sPhase P1 100 | 101 | sI : Sigma 1 102 | sI = Sig SI $ sPhase P1 103 | 104 | 105 | ------------------------------------------------------------------------------------------- 106 | -- Operations with Sigmas • Helper functions: getPhase, topPauli, lastPauli, pack 107 | -- • Scalar multiply 108 | -- • (Single) Sigma multiply 109 | -- • (Higher) Sigma multiply 110 | ------------------------------------------------------------------------------------------- 111 | 112 | -- Extract the Phase, first Pauli or last Pauli from a Sigma 113 | getPhase : Sigma n -> Phase 114 | getPhase (sPhase p) = p 115 | getPhase (Sig p s) = getPhase s 116 | 117 | topPauli : Sigma (S k) -> Pauli 118 | topPauli (Sig p s) = p 119 | 120 | lastPauli : Sigma (S k) -> Pauli 121 | lastPauli (Sig pl (sPhase ph)) = pl 122 | lastPauli (Sig pl (Sig pl2 s)) = lastPauli (Sig pl2 s) 123 | 124 | -- Pack a Pauli into a Sigma 125 | pack : Pauli -> Sigma 1 126 | pack s = Sig s $ sPhase P1 127 | 128 | 129 | -- Phase times a Sigma 130 | xPhaseSig.(*) : Phase -> Sigma n -> Sigma n 131 | xPhaseSig.(*) ph (sPhase ph2) = sPhase $ ph <+> ph2 132 | xPhaseSig.(*) ph (Sig pl s) = Sig pl $ ph * s 133 | 134 | xSigPhase.(*) : Sigma n -> Phase -> Sigma n 135 | xSigPhase.(*) s p = p * s 136 | 137 | -- Single Sigma multiply 138 | s1Mult : Sigma 1 -> Sigma 1 -> Sigma 1 139 | s1Mult (Sig x1 $ sPhase p1) (Sig x2 $ sPhase p2) = case x1 of 140 | SX => case x2 of 141 | SX => Sig SI (sPhase $ p1 <+> p2) 142 | SY => Sig SZ (sPhase $ p1 <+> p2 <+> Pi) 143 | SZ => Sig SY (sPhase $ p1 <+> p2 <+> Mi) 144 | SI => Sig SX (sPhase $ p1 <+> p2) 145 | SY => case x2 of 146 | SY => Sig SI (sPhase $ p1 <+> p2) 147 | SZ => Sig SX (sPhase $ p1 <+> p2 <+> Pi) 148 | SX => Sig SZ (sPhase $ p1 <+> p2 <+> Mi) 149 | SI => Sig SY (sPhase $ p1 <+> p2) 150 | SZ => case x2 of 151 | SZ => Sig SI (sPhase $ p1 <+> p2) 152 | SX => Sig SY (sPhase $ p1 <+> p2 <+> Pi) 153 | SY => Sig SX (sPhase $ p1 <+> p2 <+> Mi) 154 | SI => Sig SZ (sPhase $ p1 <+> p2) 155 | SI => case x2 of 156 | SI => Sig SI (sPhase $ p1 <+> p2) 157 | SX => Sig SX (sPhase $ p1 <+> p2) 158 | SY => Sig SY (sPhase $ p1 <+> p2) 159 | SZ => Sig SZ (sPhase $ p1 <+> p2) 160 | 161 | 162 | -- Higher Sigma mutiply 163 | sMult : Sigma n -> Sigma n -> Sigma n 164 | sMult (sPhase p1) (sPhase p2) = sPhase $ p1 <+> p2 165 | sMult (Sig pl1 s1) (Sig pl2 s2) with (s1Mult (pack pl1) (pack pl2)) 166 | sMult (Sig pl1 s1) (Sig pl2 s2) | r = Sig (topPauli r) ((getPhase r) * (sMult s1 s2)) 167 | 168 | -- Infix op for Sigma multiply 169 | (<>) : Sigma n -> Sigma n -> Sigma n 170 | (<>) = sMult 171 | 172 | 173 | -- Tensor multiply Sigmas ('otimes', i.e. ⊗ ) 174 | ox : Sigma n -> Sigma m -> Sigma (n + m) 175 | ox s (sPhase p) ?= {Sigma_OTimes_Lemma_1} p * s 176 | ox (sPhase p) s = p * s 177 | ox (Sig pl1 s1) (Sig pl2 s2) ?= {Sigma_OTimes_Lemma_2} ox (dropLast $ Sig pl1 s1) 178 | (Sig (lastPauli $ Sig pl1 s1) (Sig pl2 s2)) where 179 | dropLast : {k : Nat} -> Sigma (S k) -> Sigma k 180 | dropLast (Sig pl (sPhase ph)) = (sPhase ph) 181 | dropLast (Sig pl (Sig pl2 s)) = Sig pl (dropLast (Sig pl2 s)) 182 | 183 | -- Infix tensor multiply Sigmas 184 | (<&>) : Sigma n -> Sigma m -> Sigma (n + m) 185 | (<&>) = ox 186 | 187 | -- Tensor powers of a Sigma op 188 | opower : Sigma n -> (m : Nat) -> Sigma (n * m) 189 | opower s Z ?= {Sigma_Power_Lemma_1} sPhase P1 190 | opower s (S n) ?= {Sigma_Power_Lemma_2} s <&> (opower s n) 191 | 192 | negId : (n : Nat) -> Sigma n 193 | negId Z = sPhase M1 194 | negId (S n) = Sig SI $ negId n 195 | 196 | 197 | ---------- Proofs ---------- 198 | 199 | Sigma_OTimes_Lemma_1 = proof 200 | intro 201 | rewrite (plusZeroRightNeutral n) 202 | intros 203 | trivial 204 | 205 | Sigma_OTimes_Lemma_2 = proof 206 | intros 207 | rewrite sym $ plusSuccRightSucc k (S k1) 208 | trivial 209 | 210 | 211 | Sigma_Power_Lemma_1 = proof 212 | intros 213 | rewrite (sym $ multZeroRightZero n) 214 | trivial 215 | 216 | Sigma_Power_Lemma_2 = proof 217 | intros 218 | rewrite (sym $ multRightSuccPlus n n1) 219 | trivial 220 | -------------------------------------------------------------------------------- /xquant.ipkg: -------------------------------------------------------------------------------- 1 | package xquant 2 | 3 | sourcedir = src 4 | 5 | modules = xquant, 6 | xquant.Base, 7 | xquant.Graph.Marked, 8 | xquant.Graph.Feynman, 9 | xquant.Math.Set, 10 | xquant.Math.Hilbert, 11 | xquant.Spinor.Gamma, 12 | xquant.Spinor.Sigmas, 13 | xquant.Spinor.SigKets, 14 | xquant.Spinor.BKS, 15 | 16 | Data.Matrix, 17 | Data.Matrix.Algebraic, 18 | Data.Matrix.Numeric, 19 | Control.Algebra, 20 | Control.Algebra.VectorSpace, 21 | Control.Algebra.NumericInstances 22 | 23 | opts = "--no-tactic-deprecation-warnings" 24 | --------------------------------------------------------------------------------