├── AbstractRotation.agda ├── Amalgamation.agda ├── Ancillae.agda ├── Arrows └── Terms.agda ├── ArrowsOverAmalg.agda ├── CommMonoid.agda ├── Everything.agda ├── Float ├── LASig.agda └── RotMat.agda ├── FloatUtils.agda ├── GenericPi.agda ├── Instances.agda ├── LICENSE ├── LinearAlgebraSig.agda ├── Makefile ├── Pi ├── DefinedEquiv.agda ├── Equational.agda ├── Equivalences.agda ├── Language.agda ├── SyntaxToTagless.agda ├── Tagless.agda ├── TermReasoning.agda ├── Terms.agda └── Types.agda ├── PiH.agda ├── PiZ.agda ├── QPi ├── Equivalences.agda ├── Execute.agda ├── Measurement.agda ├── Semantics.agda ├── Syntax.agda ├── TermReasoning.agda └── Terms.agda ├── README.md ├── Reasoning.agda ├── SPi ├── Complementarity.agda └── Terms.agda ├── Simon.agda ├── StatesAndEffects.agda ├── Tests.agda ├── TestsSlow.agda └── Unitary.agda /AbstractRotation.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Signature of the rotation matrix we need 4 | 5 | module AbstractRotation where 6 | 7 | open import Data.Sum as Sum using (inj₁; inj₂; _⊎_) 8 | open import Data.Unit using (⊤; tt) 9 | 10 | open import LinearAlgebraSig using (LASig) 11 | 12 | record RotMat (L : LASig) : Set where 13 | open LASig L using (aut) 14 | field 15 | Rω : aut (⊤ ⊎ ⊤) 16 | Rω⁻¹ : aut (⊤ ⊎ ⊤) 17 | -------------------------------------------------------------------------------- /Amalgamation.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Amalgamation where 4 | 5 | -- Sequencing of 2 copies of a typed language 6 | 7 | ------------------------------------------------------------------------------------- 8 | record Categorical {U : Set} (rep : U → U → Set) : Set where 9 | field 10 | id : {t : U} → rep t t 11 | _∘_ : {t₁ t₂ t₃ : U} → rep t₁ t₂ → rep t₂ t₃ → rep t₁ t₃ 12 | 13 | module Build {U : Set} (_⟷_ : U → U → Set) where 14 | private 15 | variable 16 | t t₁ t₂ t₃ t₄ : U 17 | 18 | data TList : U → U → Set where 19 | nil : TList t t 20 | cons₁ : t₁ ⟷ t₂ → TList t₂ t₃ → TList t₁ t₃ 21 | cons₂ : t₁ ⟷ t₂ → TList t₂ t₃ → TList t₁ t₃ 22 | 23 | -- We have 2 different evaluators for the same interpretation, we can combine them 24 | module _ {rep : U → U → Set} (c : Categorical rep) where 25 | open Categorical c 26 | 27 | evalTL : (i₁ i₂ : ∀ {t₁ t₂} → t₁ ⟷ t₂ → rep t₁ t₂) → TList t₃ t₄ → rep t₃ t₄ 28 | evalTL i₁ i₂ nil = id 29 | evalTL i₁ i₂ (cons₁ x l) = (i₁ x) ∘ (evalTL i₁ i₂ l) 30 | evalTL i₁ i₂ (cons₂ x l) = (i₂ x) ∘ (evalTL i₁ i₂ l) 31 | -------------------------------------------------------------------------------- /Ancillae.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Define a sub-language of PiSyntax that is provably inhabited 4 | -- This is used later to define ancillae (thus the name). 5 | 6 | module Ancillae where 7 | 8 | open import Data.List using (List) 9 | open import Data.Maybe using (Maybe; just; nothing) 10 | 11 | open import Pi.Types using (U; I; _+ᵤ_; _×ᵤ_; ⟦_⟧; enum; 𝟚) 12 | open import Pi.Language using (_⟷_; id⟷; uniti⋆l; uniti⋆r; assocr⋆; !⟷) 13 | 14 | ------------------------------------------------------------------------------------- 15 | private 16 | variable 17 | t t₁ t₂ t₃ t₄ : U 18 | 19 | ------------------------------------------------------------------------------------- 20 | -- Ancillae 21 | 22 | -- This is the type of non-trivial Ancillas 23 | data Anc : Set where 24 | Two : Anc 25 | _×ₙ_ : Anc → Anc → Anc 26 | 27 | N : Set 28 | N = Maybe Anc 29 | 30 | -- Inject N into U 31 | N⇒U : N → U 32 | N⇒U nothing = I 33 | N⇒U (just Two) = I +ᵤ I 34 | N⇒U (just (x ×ₙ y)) = N⇒U (just x) ×ᵤ N⇒U (just y) 35 | 36 | enumN : (n : N) → List ⟦ N⇒U n ⟧ 37 | enumN n = enum (N⇒U n) 38 | 39 | -- Combining ancillas, i.e. product of ancillas 40 | a* : N → N → N 41 | a* (just x) (just y) = just (x ×ₙ y) 42 | a* (just x) nothing = just x 43 | a* nothing (just x) = just x 44 | a* nothing nothing = nothing 45 | 46 | -- "unpack" a product of ancillas (including none) into a proper product 47 | unpack : (n₁ n₂ : N) → N⇒U (a* n₁ n₂) ⟷ N⇒U n₁ ×ᵤ N⇒U n₂ 48 | unpack (just x) (just y) = id⟷ 49 | unpack (just x) nothing = uniti⋆r 50 | unpack nothing (just x) = uniti⋆l 51 | unpack nothing nothing = uniti⋆l 52 | 53 | ------------------------------------------------------------------------------------- 54 | ------------------------------------------------------------------------------------- 55 | -------------------------------------------------------------------------------- /Arrows/Terms.agda: -------------------------------------------------------------------------------- 1 | 2 | {-# OPTIONS --without-K --exact-split --safe #-} 3 | 4 | module Arrows.Terms where 5 | 6 | open import Pi.Types using (U; _+ᵤ_; _×ᵤ_; 𝟚) 7 | open import Pi.Language using (_⟷_; swap₊) 8 | open import Pi.Terms using (ctrl; cx; ccx) 9 | open import Amalgamation using (module Build) 10 | open Build (_⟷_) using (TList) 11 | open import ArrowsOverAmalg using (arr₁; arr₂; _>>>_; id; _***_) 12 | 13 | ------------------------------------------------------------------------------------- 14 | private 15 | variable 16 | t₁ t₂ : U 17 | 18 | ------------------------------------------------------------------------------------- 19 | -- Examples of terms in this language, taken from section 5.1 20 | 21 | X : TList (t₁ +ᵤ t₂) (t₂ +ᵤ t₁) 22 | X = arr₁ swap₊ 23 | 24 | CX : TList (𝟚 ×ᵤ 𝟚) (𝟚 ×ᵤ 𝟚) 25 | CX = arr₁ cx 26 | 27 | CCX : TList (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) 28 | CCX = arr₁ ccx 29 | 30 | H : TList (t₁ +ᵤ t₂) (t₂ +ᵤ t₁) 31 | H = arr₂ swap₊ 32 | 33 | Z : TList (t₁ +ᵤ t₂) (t₂ +ᵤ t₁) 34 | Z = H >>> X >>> H 35 | 36 | CZ : TList (𝟚 ×ᵤ 𝟚) (𝟚 ×ᵤ 𝟚) 37 | CZ = id *** H >>> CX >>> id *** H 38 | 39 | ------------------------------------------------------------------------------------- 40 | ------------------------------------------------------------------------------------- 41 | -------------------------------------------------------------------------------- /ArrowsOverAmalg.agda: -------------------------------------------------------------------------------- 1 | 2 | {-# OPTIONS --without-K --exact-split --safe #-} 3 | 4 | module ArrowsOverAmalg where 5 | 6 | open import Pi.Types using (U; I; _+ᵤ_; _×ᵤ_; 𝟚) 7 | open import Pi.Language using (_⟷_; _◎_; id⟷; 8 | swap⋆; swap₊; assocl⋆; assocr⋆; unite⋆l; uniti⋆l; !⟷; _⊗_) 9 | open import Amalgamation using (module Build) 10 | 11 | open Build (_⟷_) using (TList; nil; cons₁; cons₂) 12 | 13 | ------------------------------------------------------------------------------------- 14 | private 15 | variable 16 | t t₁ t₂ t₃ t₄ t₅ t₆ : U 17 | a b c d : U 18 | 19 | ------------------------------------------------------------------------------------- 20 | -- Form "Arrows" over a pairing of Pi languages. 21 | infixr 10 _>>>_ 22 | 23 | -- We use ₁ and ₂ instead of subscripts Z and H to be 24 | -- 1) more generic and 2) avoid the unpleasant issue that 25 | -- Agda doesn't actually define those subscripts. 26 | arr₁ : t₁ ⟷ t₂ -> TList t₁ t₂ 27 | arr₁ c = cons₁ c nil 28 | arr₂ : t₁ ⟷ t₂ -> TList t₁ t₂ 29 | arr₂ c = cons₂ c nil 30 | 31 | -- We can then lift a lot of things to this level: 32 | id : TList t t 33 | id = arr₁ id⟷ 34 | 35 | swap× : TList (t₁ ×ᵤ t₂) (t₂ ×ᵤ t₁) 36 | swap× = arr₁ swap⋆ 37 | assocl× : TList (t₁ ×ᵤ (t₂ ×ᵤ t₃)) ((t₁ ×ᵤ t₂) ×ᵤ t₃) 38 | assocl× = arr₁ assocl⋆ 39 | assocr× : TList ((t₁ ×ᵤ t₂) ×ᵤ t₃) (t₁ ×ᵤ (t₂ ×ᵤ t₃)) 40 | assocr× = arr₁ assocr⋆ 41 | unite*l : TList (I ×ᵤ t) t 42 | unite*l = arr₁ unite⋆l 43 | uniti*l : TList t (I ×ᵤ t) 44 | uniti*l = arr₁ uniti⋆l 45 | unite* : TList (t ×ᵤ I) t 46 | unite* = arr₁ (swap⋆ ◎ unite⋆l) 47 | uniti* : TList t (t ×ᵤ I) 48 | uniti* = arr₁ (uniti⋆l ◎ swap⋆) 49 | 50 | -- And we can make Arrows out of this too: 51 | first : {t₁ t₂ t₃ : U} → TList t₁ t₂ → TList (t₁ ×ᵤ t₃) (t₂ ×ᵤ t₃) 52 | first nil = nil 53 | first (cons₁ x y) = cons₁ (x ⊗ id⟷) (first y) 54 | first (cons₂ x y) = cons₂ (x ⊗ id⟷) (first y) 55 | 56 | _>>>_ : {t₁ t₂ t₃ : U} → TList t₁ t₂ → TList t₂ t₃ → TList t₁ t₃ 57 | nil >>> z = z 58 | (cons₁ x y) >>> z = cons₁ x (y >>> z) 59 | (cons₂ x y) >>> z = cons₂ x (y >>> z) 60 | 61 | -- Second, as usual, is definable using the above, but that is inefficient. 62 | -- Use a direct definition instead 63 | second : TList t₁ t₂ → TList (t₃ ×ᵤ t₁) (t₃ ×ᵤ t₂) 64 | -- second c = swap× >>> first c >>> swap× 65 | second nil = nil 66 | second (cons₁ x c) = cons₁ (id⟷ ⊗ x) (second c) 67 | second (cons₂ x c) = cons₂ (id⟷ ⊗ x) (second c) 68 | 69 | -- Warning: this is quadratic! 70 | inv : {t₁ t₂ : U} → TList t₁ t₂ → TList t₂ t₁ 71 | inv nil = nil 72 | inv (cons₁ x xs) = inv xs >>> (cons₁ (!⟷ x) nil) 73 | inv (cons₂ x xs) = inv xs >>> (cons₂ (!⟷ x) nil) 74 | 75 | -- This is slow? Implement directly instead 76 | _***_ : TList t₁ t₂ → TList t₃ t₄ → TList (t₁ ×ᵤ t₃) (t₂ ×ᵤ t₄) 77 | -- xs *** ys = first xs >>> second ys 78 | nil *** nil = nil 79 | nil *** cons₁ x ys = cons₁ (id⟷ ⊗ x) (nil *** ys) 80 | nil *** cons₂ x ys = cons₂ (id⟷ ⊗ x) (nil *** ys) 81 | cons₁ x xs *** nil = cons₁ (x ⊗ id⟷) (xs *** nil) 82 | cons₁ x xs *** cons₁ y ys = cons₁ (x ⊗ y) (xs *** ys) 83 | cons₁ x xs *** cons₂ y ys = cons₁ (x ⊗ id⟷) (cons₂ (id⟷ ⊗ y) (xs *** ys)) 84 | cons₂ x xs *** nil = cons₂ (x ⊗ id⟷) (xs *** nil) 85 | cons₂ x xs *** cons₁ y ys = cons₂ (x ⊗ id⟷) (cons₂ (id⟷ ⊗ y) (xs *** ys)) 86 | cons₂ x xs *** cons₂ y ys = cons₂ (x ⊗ y) (xs *** ys) 87 | 88 | ------------------------------------------------------------------------------------- 89 | ------------------------------------------------------------------------------------- 90 | -------------------------------------------------------------------------------- /CommMonoid.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module CommMonoid where 4 | 5 | -- Generate a "commutative monoid" structure over a given language 6 | -- It uses multiplicative notation, but doesn't assume that. 7 | 8 | record CMStructure : Set₁ where 9 | constructor CMon 10 | infixr 40 _×ᵤ_ 11 | field 12 | U : Set 13 | I : U 14 | _×ᵤ_ : U → U → U 15 | 16 | module Build (CM : CMStructure) where 17 | open CMStructure CM 18 | 19 | private 20 | variable 21 | t t₁ t₂ t₃ : U 22 | 23 | -- left-handed version of combinators as primary 24 | data _⇔_ : U → U → Set where 25 | unite⋆ : I ×ᵤ t ⇔ t 26 | uniti⋆ : t ⇔ I ×ᵤ t 27 | swap⋆ : t₁ ×ᵤ t₂ ⇔ t₂ ×ᵤ t₁ 28 | assocl⋆ : t₁ ×ᵤ (t₂ ×ᵤ t₃) ⇔ (t₁ ×ᵤ t₂) ×ᵤ t₃ 29 | assocr⋆ : (t₁ ×ᵤ t₂) ×ᵤ t₃ ⇔ t₁ ×ᵤ (t₂ ×ᵤ t₃) 30 | 31 | --------------------------------------------------------------------------- 32 | -------------------------------------------------------------------------------- /Everything.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split #-} 2 | -- Can't use --safe as QPi isn't. 3 | 4 | module Everything where 5 | 6 | -- The point of this module is to have one place that makes sure everything 7 | -- still does compile 8 | 9 | -- It is also a convenient place to give a mapping between the paper and the code. 10 | 11 | ------------------------------------------------------------------------------------ 12 | -- Preparatory constructions 13 | 14 | -- Set up the combinators that come with a commutative monoid. We'll end up 15 | -- using this 3 times, so it is worth the abstraction. 16 | open import CommMonoid 17 | 18 | -- Signature of the things that "Linear Algebra" must provide 19 | open import LinearAlgebraSig 20 | -- And the abstract rotation marix 21 | open import AbstractRotation 22 | 23 | ------------------------------------------------------------------------------------ 24 | -- Syntactic constructions 25 | 26 | -- - Pi.Types gives the representation of types (as a data-structure) 27 | -- - Pi.Language gives the representation of combinators (ditto, i.e. as syntax) 28 | -- and some additional combinators (that could be in the syntax) expressible using swap 29 | -- and the proof of reversibility of the syntax 30 | -- - Pi.Equation gives some syntax for presenting Pi in equational style 31 | -- - Pi.Terms gives some extra combinators (ctrl, cx, ccx) 32 | -- - Pi.Equivalences gives a (syntactic) language of Pi term equivalences 33 | -- - Pi.TermReasoning gives a syntax for doing equational reasoning over Pi terms 34 | -- - Pi.DefinedEquiv defines some extra equivalences (on items from Pi.Terms) 35 | 36 | -- Basically: the contents of 3.1 up to the semantics 37 | open import Pi.Types 38 | open import Pi.Language 39 | open import Pi.Equational 40 | open import Pi.Terms 41 | open import Pi.Equivalences 42 | open import Pi.TermReasoning 43 | open import Pi.DefinedEquiv 44 | 45 | -- PiTagless gives a representation independent version of PiSyntax. 46 | -- So rather than providing different evaluators for the syntax, one can instead provide 47 | -- instances (as records). 48 | -- The reversibility constraint is packed separately, as some instances are only 49 | -- "externally" reversible. 50 | open import Pi.Tagless 51 | -- and we can use syntax to generalize to any interpretation 52 | open import Pi.SyntaxToTagless 53 | 54 | -- Syntactic arrow constructions parameterized by evaluators in the tagless style 55 | open import Amalgamation 56 | open import ArrowsOverAmalg 57 | open import Arrows.Terms -- some examples 58 | open import Ancillae -- Defined PiSyntax sub-language for ancillaes 59 | open import StatesAndEffects 60 | open import SPi.Terms 61 | open import SPi.Complementarity 62 | 63 | -- Example written in the syntax (before any explicit rotation or unitaries) 64 | open import Simon 65 | 66 | ------------------------------------------------------------------------------------ 67 | -- Utilities useful in various places below 68 | open import FloatUtils 69 | 70 | -- an implementation of the signature of linear algebra for Float 71 | open import Float.LASig 72 | -- and the key rotation matrix in that signature 73 | open import Float.RotMat 74 | 75 | ------------------------------------------------------------------------------------ 76 | -- Two semantics for Pi rotated with respect to each other 77 | 78 | -- Unitary implements (most of?) Definition 6 of Section 4.2 79 | open import Unitary 80 | 81 | -- Interpretation over arbitrary basis of Unitary 82 | open import GenericPi 83 | 84 | -- PiZ give an instance of Pi where the "values" are Real-valued vectors indexed by 85 | -- [an enumeration of] a type (t : U). 86 | -- The combinators are then representation of linear actions from vectors to vectors, 87 | -- aka matrices. 88 | open import PiZ 89 | -- PiH gives an instance of Pi where the "values" are again Real-valued vectors indexed by 90 | -- [an enumeration of] a type (t : U). But this time the action is conjugated by R, i.e. 91 | -- "rotated". The result is still matrices, but in a different basis. 92 | open import PiH 93 | 94 | ------------------------------------------------------------------------------------ 95 | -- Instantiate generic semantics for full language 96 | 97 | open import Instances 98 | 99 | ------------------------------------------------------------------------------------ 100 | -- Examples 101 | 102 | open import Tests 103 | open import TestsSlow 104 | 105 | ------------------------------------------------------------------------------------ 106 | -- QPi: Syntax, semantics, execution, terms, measurement and reasoning 107 | 108 | open import QPi.Syntax 109 | open import QPi.Semantics 110 | open import QPi.Execute 111 | open import QPi.Terms 112 | open import QPi.Equivalences 113 | open import QPi.Measurement 114 | open import QPi.TermReasoning 115 | open import Reasoning 116 | 117 | ------------------------------------------------------------------------------------ 118 | -------------------------------------------------------------------------------- /Float/LASig.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Float Vectors, implemented as functions, as one representation of LASig 4 | 5 | module Float.LASig where 6 | 7 | open import Data.Float using (Float) 8 | open import Data.Product as Prod using (_×_; _,_) 9 | open import Data.Sum as Sum using (_⊎_; inj₁; inj₂) 10 | open import Data.Unit using (tt) 11 | open import Function.Base using (_∘_) 12 | 13 | open import LinearAlgebraSig using (LASig) 14 | 15 | private 16 | vec mat : Set → Set 17 | vec t = t → Float 18 | mat t = t → t → Float 19 | 20 | aut : Set → Set 21 | aut t = vec t → vec t 22 | 23 | -- make it clearer that this is direct product. 24 | _⊕_ : {t₁ t₂ : Set} → aut t₁ → aut t₂ → aut (t₁ ⊎ t₂) 25 | -- simple definition: 26 | -- c₁ ⊕ c₂ = λ f → Sum.[ c₁ (f ∘ inj₁) , c₂ (f ∘ inj₂) ] 27 | -- expanded: 28 | (c₁ ⊕ c₂) f (inj₁ x) = c₁ (f ∘ inj₁) x 29 | (c₁ ⊕ c₂) f (inj₂ y) = c₂ (f ∘ inj₂) y 30 | 31 | _⊗_ : {t₁ t₂ : Set} → aut t₁ → aut t₂ → aut (t₁ × t₂) 32 | _⊗_ {t₁} {t₂} c₁ c₂ f (v₁ , v₂) = c₁ (λ a → c₂ (λ b → f (a , b)) v₂) v₁ 33 | 34 | FloatVec : LASig 35 | FloatVec = record 36 | { vec = vec 37 | ; mat = mat 38 | ; _⊕_ = _⊕_ 39 | ; _⊗_ = _⊗_ 40 | ; unite+l = λ f → f ∘ inj₂ 41 | ; uniti+l = λ {f (inj₂ x) → f x } 42 | ; unite*l = λ f x → f (tt , x) 43 | ; uniti*l = λ f x → f (Prod.proj₂ x) 44 | ; swap+ = λ f → f ∘ Sum.swap 45 | ; swap× = λ f → f ∘ Prod.swap 46 | ; assocl+ = λ f → f ∘ Sum.assocʳ 47 | ; assocr+ = λ f → f ∘ Sum.assocˡ 48 | ; assocl* = λ f → f ∘ Prod.assocʳ 49 | ; assocr* = λ f → f ∘ Prod.assocˡ 50 | ; absorbl′ = λ { _ () } 51 | ; factorzr′ = λ {_ ( _ , () )} 52 | ; dist′ = λ f → f ∘ Sum.[ Prod.map₁ inj₁ , Prod.map₁ inj₂ ] 53 | ; factor′ = λ f → f ∘ λ { (a , b) → Sum.map (_, b) (_, b) a } 54 | ; idp = λ x → x 55 | ; _⊚_ = λ f g → g ∘ f 56 | ; _⊕′_ = λ f g h → Sum.[ f (h ∘ inj₁) , g (h ∘ inj₂) ] 57 | ; _⊛_ = λ A₁₃ B₂₄ v (i , j) → A₁₃ (λ a → B₂₄ (λ b → v (a , b)) j) i 58 | ; true = λ { (inj₁ x) → 0.0 ; (inj₂ y) → 1.0} 59 | ; false = λ { (inj₁ x) → 1.0 ; (inj₂ y) → 0.0} 60 | } 61 | -------------------------------------------------------------------------------- /Float/RotMat.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Explicit Rotation Matrix to be used by the main unitary model 4 | 5 | module Float.RotMat where 6 | 7 | open import Data.Float using (Float; _*_; _+_; -_; _-_) 8 | open import Data.Sum as Sum using (inj₁; inj₂; _⊎_) 9 | open import Data.Unit using (⊤; tt) 10 | 11 | open import LinearAlgebraSig using (LASig) 12 | open import AbstractRotation using (RotMat) 13 | open import Float.LASig 14 | open import FloatUtils using (cπ/8; sπ/8) 15 | 16 | open LASig FloatVec using (aut) 17 | 18 | Rω : aut (⊤ ⊎ ⊤) 19 | Rω f = Sum.[ (λ _ → cπ/8 * f (inj₁ tt) - sπ/8 * f (inj₂ tt)) , 20 | (λ _ → sπ/8 * f (inj₁ tt) + cπ/8 * f (inj₂ tt)) ] 21 | 22 | Rω⁻¹ : aut (⊤ ⊎ ⊤) 23 | Rω⁻¹ f = Sum.[ (λ _ → cπ/8 * f (inj₁ tt) + sπ/8 * f (inj₂ tt)) , 24 | (λ _ → - (sπ/8 * f (inj₁ tt)) + cπ/8 * f (inj₂ tt)) ] 25 | 26 | Rot : RotMat FloatVec 27 | Rot = record { Rω = Rω ; Rω⁻¹ = Rω⁻¹ } 28 | -------------------------------------------------------------------------------- /FloatUtils.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Various definitions around Float that get re-used 4 | 5 | module FloatUtils where 6 | 7 | open import Data.Float using (Float; cos; sin; _÷_; _≤ᵇ_; _<ᵇ_) 8 | open import Data.Bool using (Bool; _∧_; _∨_) 9 | 10 | π : Float 11 | π = 3.1415926535 12 | 13 | cπ/8 : Float 14 | cπ/8 = cos (π ÷ 8.0) 15 | sπ/8 : Float 16 | sπ/8 = sin (π ÷ 8.0) 17 | 18 | tooSmall : Float → Bool 19 | tooSmall a = ((0.0 ≤ᵇ a) ∧ (a <ᵇ 0.01)) ∨ ((a ≤ᵇ 0.0) ∧ (-0.01 <ᵇ a)) 20 | -------------------------------------------------------------------------------- /GenericPi.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module GenericPi where 4 | 5 | open import Pi.Types using (U; ⟦_⟧; 𝟚) 6 | open import Pi.Tagless using (Pi) 7 | open import LinearAlgebraSig using (LASig) 8 | 9 | ----------------------------------------------------------------------- 10 | -- This interpretation is "generic" in the sense that it works over an 11 | -- arbitrary basis. 12 | 13 | module _ (L : LASig) where 14 | 15 | private 16 | module LA = LASig L 17 | 18 | open LA using (linop; vec) 19 | 20 | Fwd : U → U → Set 21 | Fwd t₁ t₂ = linop ⟦ t₁ ⟧ ⟦ t₂ ⟧ 22 | 23 | -- The interpretations pretty much follow the types. The only tricky one is for product, 24 | -- which implements the Kronecker product. 25 | GenericPi : Pi Fwd 26 | GenericPi = record { LA } 27 | 28 | 29 | true false : vec ⟦ 𝟚 ⟧ 30 | true = LA.true 31 | false = LA.false 32 | -------------------------------------------------------------------------------- /Instances.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Show that Unitary has states and effects 4 | 5 | module Instances where 6 | 7 | import Data.Float as F 8 | open import Data.List using (head) 9 | open import Data.Maybe using (Maybe; just; nothing) 10 | open import Data.Product using (_×_; _,_; proj₁; proj₂) 11 | open import Data.Sum using (inj₁; inj₂) 12 | open import Data.Unit using (tt) 13 | 14 | open import Pi.Types using (U; I; _×ᵤ_; ⟦_⟧) 15 | open import Pi.Language using (_⟷_) 16 | open import Amalgamation using (module Build; Categorical) 17 | open Build (_⟷_) using (TList; evalTL) 18 | import ArrowsOverAmalg as A 19 | open import Ancillae using (N; N⇒U; enumN; Anc; Two; _×ₙ_) 20 | open import StatesAndEffects using (_↭_; lift) 21 | 22 | open import Unitary using (UVec) 23 | open import PiZ using (module MkPiZ) 24 | open import PiH using (module MkPiH) 25 | open import GenericPi using (Fwd) 26 | 27 | open import Float.LASig using (FloatVec) 28 | open import Float.RotMat using (Rot) 29 | 30 | open MkPiH FloatVec Rot using (evalH) 31 | open MkPiZ FloatVec using (evalZ) 32 | 33 | FC : Categorical (Fwd FloatVec) 34 | FC = record 35 | { id = λ x → x 36 | ; _∘_ = λ f g h x → g (f h) x 37 | } 38 | 39 | evalTL₁ : ∀ {t₁ t₂ : U} → TList t₁ t₂ → Fwd FloatVec t₁ t₂ 40 | evalTL₁ tl = evalTL FC evalZ evalH tl 41 | 42 | infixl 9 _○_ 43 | 44 | _○_ : {A B C : Set} → (A → B) → (B → C) → (A → C) 45 | f ○ g = λ a → g (f a) 46 | 47 | private 48 | effect : {t₂ : U} (n : N) → UVec FloatVec (t₂ ×ᵤ (N⇒U n)) → UVec FloatVec (t₂ ×ᵤ I) 49 | effect n f z = effect′ (head (enumN n)) 50 | where effect′ : Maybe ⟦ N⇒U n ⟧ → F.Float 51 | effect′ (just x) = f (proj₁ z , x) 52 | effect′ nothing = 0.0 -- if we had a vector, we could prove this cannot happen 53 | 54 | delta : (n : N) → (x : ⟦ N⇒U n ⟧) → F.Float 55 | delta (just Two) (inj₁ x) = 1.0 56 | delta (just Two) (inj₂ y) = 0.0 57 | delta (just (x₁ ×ₙ x₂)) x = delta (just x₁) (proj₁ x) F.* delta (just x₂) (proj₂ x) 58 | delta nothing _ = 1.0 59 | 60 | state : {t : U} (n : N) → UVec FloatVec (t ×ᵤ I) → UVec FloatVec (t ×ᵤ (N⇒U n)) 61 | state n f (x , i) = delta n i F.* f ( x , tt ) 62 | 63 | -- re-expand out to test each part 64 | evalSE : ∀ {t₁ t₂ : U} → t₁ ↭ t₂ → Fwd FloatVec t₁ t₂ 65 | evalSE (lift {n₁ = nothing} {nothing} z) = evalTL₁ A.uniti* ○ evalTL₁ z ○ evalTL₁ A.unite* 66 | evalSE (lift {n₁ = nothing} y@{just _} z) = evalTL₁ A.uniti* ○ evalTL₁ z ○ effect y ○ evalTL₁ A.unite* 67 | evalSE (lift x@{n₁ = just _} {nothing} z) = evalTL₁ A.uniti* ○ state x ○ evalTL₁ z ○ evalTL₁ A.unite* 68 | evalSE (lift x@{n₁ = just _} y@{just _} z) = evalTL₁ A.uniti* ○ state x ○ evalTL₁ z ○ effect y ○ evalTL₁ A.unite* 69 | --- evalSE (lift {n₁ = n₁} {n₂} z) = evalTL₁ A.uniti* ○ state n₁ ○ evalTL₁ z ○ effect n₂ ○ evalTL₁ A.unite* 70 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2023, Jacques Carette 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | 3. Neither the name of the copyright holder nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /LinearAlgebraSig.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- The signature of the types involved in Linear Algebra 4 | 5 | module LinearAlgebraSig where 6 | 7 | open import Data.Empty using (⊥) 8 | open import Data.Product using (_×_) 9 | open import Data.Sum using (_⊎_) 10 | open import Data.Unit using (⊤) 11 | 12 | private 13 | variable 14 | t t₁ t₂ t₃ t₄ : Set 15 | 16 | record LASig : Set₁ where 17 | field 18 | vec : Set → Set 19 | mat : Set → Set 20 | 21 | linop : Set → Set → Set 22 | linop s t = vec s → vec t 23 | 24 | aut : Set → Set 25 | aut t = linop t t 26 | 27 | field 28 | _⊕_ : {t₁ t₂ : Set} → aut t₁ → aut t₂ → aut (t₁ ⊎ t₂) 29 | _⊗_ : {t₁ t₂ : Set} → aut t₁ → aut t₂ → aut (t₁ × t₂) 30 | 31 | field 32 | unite+l : linop (⊥ ⊎ t) t 33 | uniti+l : linop t (⊥ ⊎ t) 34 | unite*l : linop (⊤ × t) t 35 | uniti*l : linop t (⊤ × t) 36 | swap+ : linop (t₁ ⊎ t₂) (t₂ ⊎ t₁) 37 | swap× : linop (t₁ × t₂) (t₂ × t₁) 38 | assocl+ : linop (t₁ ⊎ (t₂ ⊎ t₃)) ((t₁ ⊎ t₂) ⊎ t₃) 39 | assocr+ : linop ((t₁ ⊎ t₂) ⊎ t₃) (t₁ ⊎ (t₂ ⊎ t₃)) 40 | assocl* : linop (t₁ × (t₂ × t₃)) ((t₁ × t₂) × t₃) 41 | assocr* : linop ((t₁ × t₂) × t₃) (t₁ × (t₂ × t₃)) 42 | absorbl′ : linop (t × ⊥) ⊥ 43 | factorzr′ : linop ⊥ (t × ⊥) 44 | dist′ : linop ((t₁ ⊎ t₂) × t₃) ((t₁ × t₃) ⊎ (t₂ × t₃)) 45 | factor′ : linop ((t₁ × t₃) ⊎ (t₂ × t₃)) ((t₁ ⊎ t₂) × t₃) 46 | idp : linop t t 47 | _⊚_ : (linop t₁ t₂) → (linop t₂ t₃) → (linop t₁ t₃) 48 | _⊕′_ : (linop t₁ t₃) → (linop t₂ t₄) → (linop (t₁ ⊎ t₂) (t₃ ⊎ t₄)) 49 | _⊛_ : (linop t₁ t₃) → (linop t₂ t₄) → (linop (t₁ × t₂) (t₃ × t₄)) 50 | 51 | true : vec (⊤ ⊎ ⊤) 52 | false : vec (⊤ ⊎ ⊤) 53 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Everything.agda 2 | agda Everything.agda 3 | -------------------------------------------------------------------------------- /Pi/DefinedEquiv.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.DefinedEquiv where 4 | 5 | open import Pi.Types using (U) 6 | open import Pi.Language 7 | open import Pi.Terms using (x; cx) 8 | open import Pi.Equivalences -- take it all in, less trouble that way 9 | open import Pi.TermReasoning -- make it prettier 10 | 11 | private 12 | variable 13 | t₁ t₂ t₃ t₄ : U 14 | 15 | ------------------------------------------------------------------------------------- 16 | 17 | -- Definable terms 18 | comm-in-⊕ : {a a′ : t₁ ⟷ t₁} {b : t₂ ⟷ t₃} {c : t₃ ⟷ t₄} → a ◎ a′ ⟷₂ a′ ◎ a → 19 | (a ⊕ b) ◎ (a′ ⊕ c) ⟷₂ (a′ ⊕ b) ◎ (a ⊕ c) 20 | comm-in-⊕ {a = a} {a′} {b} {c} sw = begin 21 | (a ⊕ b) ◎ (a′ ⊕ c) ≈⟨ hom◎⊕⟷₂ ⟩ 22 | (a ◎ a′) ⊕ (b ◎ c) ≈⟨ resp⊕⟷₂ sw id⟷₂ ⟩ 23 | (a′ ◎ a) ⊕ (b ◎ c) ≈⟨ hom⊕◎⟷₂ ⟩ 24 | (a′ ⊕ b) ◎ (a ⊕ c) ∎ 25 | 26 | id-comm : {c : t₁ ⟷ t₂} → c ◎ id⟷ ⟷₂ id⟷ ◎ c 27 | id-comm = idr◎l ○ idl◎r 28 | 29 | xcx : id⟷ ⊗ x ◎ cx ⟷₂ cx ◎ id⟷ ⊗ x 30 | xcx = begin 31 | (id⟷ ⊗ x) ◎ cx ≈⟨ id⟷₂ ⟩ 32 | (id⟷ ⊗ x) ◎ dist ◎ (id⟷ ⊕ id⟷ ⊗ x) ◎ factor ≈⟨ split⊕-id⟷ ⟩⊗⟨id ⟩◎⟨id ⟩ 33 | ((id⟷ ⊕ id⟷) ⊗ x) ◎ dist ◎ (id⟷ ⊕ id⟷ ⊗ x) ◎ factor ≈⟨ assoc◎l ⟩ 34 | (((id⟷ ⊕ id⟷) ⊗ x) ◎ dist) ◎ (id⟷ ⊕ id⟷ ⊗ x) ◎ factor ≈⟨ dist⟷₂l ⟩◎⟨id ⟩ 35 | (dist ◎ (id⟷ ⊗ x) ⊕ (id⟷ ⊗ x)) ◎ (id⟷ ⊕ id⟷ ⊗ x) ◎ factor ≈⟨ assoc◎r ○ id⟩◎⟨ assoc◎l ⟩ 36 | dist ◎ ((id⟷ ⊗ x) ⊕ (id⟷ ⊗ x) ◎ (id⟷ ⊕ id⟷ ⊗ x)) ◎ factor ≈⟨ id⟩◎⟨ comm-in-⊕ id-comm ⟩◎⟨id ⟩ 37 | dist ◎ ((id⟷ ⊕ id⟷ ⊗ x) ◎ (id⟷ ⊗ x ⊕ id⟷ ⊗ x)) ◎ factor ≈⟨ assoc◎l ○ (assoc◎l ⟩◎⟨id) ○ assoc◎r ⟩ 38 | (dist ◎ (id⟷ ⊕ id⟷ ⊗ x)) ◎ (id⟷ ⊗ x ⊕ id⟷ ⊗ x) ◎ factor ≈⟨ id⟩◎⟨ factor⟷₂l ⟩ 39 | (dist ◎ (id⟷ ⊕ id⟷ ⊗ x)) ◎ factor ◎ (id⟷ ⊕ id⟷) ⊗ x ≈⟨ id⟩◎⟨ id⟩◎⟨ id⟷⊕id⟷⟷₂ ⟩⊗⟨id ⟩ 40 | (dist ◎ (id⟷ ⊕ id⟷ ⊗ x)) ◎ factor ◎ id⟷ ⊗ x ≈⟨ assoc◎l ○ assoc◎r ⟩◎⟨id ⟩ 41 | (dist ◎ (id⟷ ⊕ id⟷ ⊗ x) ◎ factor) ◎ id⟷ ⊗ x ≈⟨ id⟷₂ ⟩ 42 | (cx ◎ (id⟷ ⊗ x)) ∎ 43 | 44 | ------------------------------------------------------------------------------------- 45 | ------------------------------------------------------------------------------------- 46 | 47 | -------------------------------------------------------------------------------- /Pi/Equational.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Define syntax for presenting Pi using equational style 4 | 5 | module Pi.Equational where 6 | 7 | open import Relation.Binary.Bundles using (Setoid) 8 | import Relation.Binary.Reasoning.Setoid as SetoidR 9 | 10 | open import Pi.Types using (U) 11 | open import Pi.Language using (_⟷_; _◎_; id⟷; !⟷) 12 | 13 | private 14 | variable 15 | t t₁ t₂ t₃ : U 16 | 17 | ------------------------------------------------------------------------------------- 18 | -- Equational reasoning, from stdlib 19 | 20 | private 21 | PiSetoid : Setoid _ _ 22 | PiSetoid = record 23 | { Carrier = U 24 | ; _≈_ = _⟷_ 25 | ; isEquivalence = record 26 | { refl = id⟷ 27 | ; sym = !⟷ 28 | ; trans = _◎_ 29 | } 30 | } 31 | 32 | module Base = SetoidR PiSetoid 33 | 34 | open Base public 35 | hiding (step-≈) 36 | 37 | infixr 2 step-≈ 38 | 39 | step-≈ : ∀ (x : U) {y z} → y IsRelatedTo z → x ⟷ y → x IsRelatedTo z 40 | step-≈ = Base.step-≈ 41 | 42 | syntax step-≈ x y⟷z x⟷y = x ⟨ x⟷y ⟩ y⟷z 43 | 44 | ------------------------------------------------------------------------------------- 45 | ------------------------------------------------------------------------------------- 46 | -------------------------------------------------------------------------------- /Pi/Equivalences.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.Equivalences where 4 | 5 | open import Pi.Types 6 | open import Pi.Language 7 | 8 | infix 5 _⟷₂_ 9 | 10 | data _⟷₂_ : {t₁ t₂ : U} → (t₁ ⟷ t₂) → (t₁ ⟷ t₂) → Set where 11 | assoc◎l : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₂ ⟷ t₃} {c₃ : t₃ ⟷ t₄} → 12 | c₁ ◎ (c₂ ◎ c₃) ⟷₂ (c₁ ◎ c₂) ◎ c₃ 13 | assoc◎r : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₂ ⟷ t₃} {c₃ : t₃ ⟷ t₄} → 14 | ((c₁ ◎ c₂) ◎ c₃) ⟷₂ (c₁ ◎ (c₂ ◎ c₃)) 15 | assocl⊕l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 16 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 17 | ((c₁ ⊕ (c₂ ⊕ c₃)) ◎ assocl₊) ⟷₂ (assocl₊ ◎ ((c₁ ⊕ c₂) ⊕ c₃)) 18 | assocl⊕r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 19 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 20 | (assocl₊ ◎ ((c₁ ⊕ c₂) ⊕ c₃)) ⟷₂ ((c₁ ⊕ (c₂ ⊕ c₃)) ◎ assocl₊) 21 | assocl⊗l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 22 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 23 | ((c₁ ⊗ (c₂ ⊗ c₃)) ◎ assocl⋆) ⟷₂ (assocl⋆ ◎ ((c₁ ⊗ c₂) ⊗ c₃)) 24 | assocl⊗r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 25 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 26 | (assocl⋆ ◎ ((c₁ ⊗ c₂) ⊗ c₃)) ⟷₂ ((c₁ ⊗ (c₂ ⊗ c₃)) ◎ assocl⋆) 27 | assocr⊕r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 28 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 29 | (((c₁ ⊕ c₂) ⊕ c₃) ◎ assocr₊) ⟷₂ (assocr₊ ◎ (c₁ ⊕ (c₂ ⊕ c₃))) 30 | assocr⊗l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 31 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 32 | (assocr⋆ ◎ (c₁ ⊗ (c₂ ⊗ c₃))) ⟷₂ (((c₁ ⊗ c₂) ⊗ c₃) ◎ assocr⋆) 33 | assocr⊗r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 34 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 35 | (((c₁ ⊗ c₂) ⊗ c₃) ◎ assocr⋆) ⟷₂ (assocr⋆ ◎ (c₁ ⊗ (c₂ ⊗ c₃))) 36 | assocr⊕l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 37 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₅ ⟷ t₆} → 38 | (assocr₊ ◎ (c₁ ⊕ (c₂ ⊕ c₃))) ⟷₂ (((c₁ ⊕ c₂) ⊕ c₃) ◎ assocr₊) 39 | dist⟷₂l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 40 | {a : t₁ ⟷ t₂} {b : t₃ ⟷ t₄} {c : t₅ ⟷ t₆} → 41 | ((((a ⊕ b) ⊗ c) ◎ dist)) ⟷₂ ((dist ◎ ((a ⊗ c) ⊕ (b ⊗ c)))) 42 | dist⟷₂r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 43 | {a : t₁ ⟷ t₂} {b : t₃ ⟷ t₄} {c : t₅ ⟷ t₆} → 44 | (dist ◎ ((a ⊗ c) ⊕ (b ⊗ c))) ⟷₂ (((a ⊕ b) ⊗ c) ◎ dist) 45 | factor⟷₂l : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 46 | {a : t₁ ⟷ t₂} {b : t₃ ⟷ t₄} {c : t₅ ⟷ t₆} → 47 | (((a ⊗ c) ⊕ (b ⊗ c)) ◎ factor) ⟷₂ (factor ◎ ((a ⊕ b) ⊗ c)) 48 | factor⟷₂r : {t₁ t₂ t₃ t₄ t₅ t₆ : U} 49 | {a : t₁ ⟷ t₂} {b : t₃ ⟷ t₄} {c : t₅ ⟷ t₆} → 50 | (factor ◎ ((a ⊕ b) ⊗ c)) ⟷₂ (((a ⊗ c) ⊕ (b ⊗ c)) ◎ factor) 51 | idl◎l : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → (id⟷ ◎ c) ⟷₂ c 52 | idl◎r : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → c ⟷₂ (id⟷ ◎ c) 53 | idr◎l : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → (c ◎ id⟷) ⟷₂ c 54 | idr◎r : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → c ⟷₂ (c ◎ id⟷) 55 | linv◎l : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → (c ◎ !⟷ c) ⟷₂ id⟷ 56 | linv◎r : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → id⟷ ⟷₂ (c ◎ !⟷ c) 57 | rinv◎l : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → (!⟷ c ◎ c) ⟷₂ id⟷ 58 | rinv◎r : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → id⟷ ⟷₂ (!⟷ c ◎ c) 59 | unite₊l⟷₂l : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 60 | (unite₊l ◎ c₂) ⟷₂ ((c₁ ⊕ c₂) ◎ unite₊l) 61 | unite₊l⟷₂r : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 62 | ((c₁ ⊕ c₂) ◎ unite₊l) ⟷₂ (unite₊l ◎ c₂) 63 | uniti₊l⟷₂l : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 64 | (uniti₊l ◎ (c₁ ⊕ c₂)) ⟷₂ (c₂ ◎ uniti₊l) 65 | uniti₊l⟷₂r : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 66 | (c₂ ◎ uniti₊l) ⟷₂ (uniti₊l ◎ (c₁ ⊕ c₂)) 67 | unite₊r⟷₂l : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 68 | (unite₊r ◎ c₂) ⟷₂ ((c₂ ⊕ c₁) ◎ unite₊r) 69 | unite₊r⟷₂r : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 70 | ((c₂ ⊕ c₁) ◎ unite₊r) ⟷₂ (unite₊r ◎ c₂) 71 | uniti₊r⟷₂l : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 72 | (uniti₊r ◎ (c₂ ⊕ c₁)) ⟷₂ (c₂ ◎ uniti₊r) 73 | uniti₊r⟷₂r : {t₁ t₂ : U} {c₁ : O ⟷ O} {c₂ : t₁ ⟷ t₂} → 74 | (c₂ ◎ uniti₊r) ⟷₂ (uniti₊r ◎ (c₂ ⊕ c₁)) 75 | swapl₊⟷₂ : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} → 76 | (swap₊ ◎ (c₁ ⊕ c₂)) ⟷₂ ((c₂ ⊕ c₁) ◎ swap₊) 77 | swapr₊⟷₂ : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} → 78 | ((c₂ ⊕ c₁) ◎ swap₊) ⟷₂ (swap₊ ◎ (c₁ ⊕ c₂)) 79 | unitel⋆⟷₂l : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 80 | (unite⋆l ◎ c₂) ⟷₂ ((c₁ ⊗ c₂) ◎ unite⋆l) 81 | uniter⋆⟷₂l : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 82 | ((c₁ ⊗ c₂) ◎ unite⋆l) ⟷₂ (unite⋆l ◎ c₂) 83 | unitil⋆⟷₂l : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 84 | (uniti⋆l ◎ (c₁ ⊗ c₂)) ⟷₂ (c₂ ◎ uniti⋆l) 85 | unitir⋆⟷₂l : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 86 | (c₂ ◎ uniti⋆l) ⟷₂ (uniti⋆l ◎ (c₁ ⊗ c₂)) 87 | unitel⋆⟷₂r : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 88 | (unite⋆r ◎ c₂) ⟷₂ ((c₂ ⊗ c₁) ◎ unite⋆r) 89 | uniter⋆⟷₂r : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 90 | ((c₂ ⊗ c₁) ◎ unite⋆r) ⟷₂ (unite⋆r ◎ c₂) 91 | unitil⋆⟷₂r : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 92 | (uniti⋆r ◎ (c₂ ⊗ c₁)) ⟷₂ (c₂ ◎ uniti⋆r) 93 | unitir⋆⟷₂r : {t₁ t₂ : U} {c₁ : I ⟷ I} {c₂ : t₁ ⟷ t₂} → 94 | (c₂ ◎ uniti⋆r) ⟷₂ (uniti⋆r ◎ (c₂ ⊗ c₁)) 95 | swapl⋆⟷₂ : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} → 96 | (swap⋆ ◎ (c₁ ⊗ c₂)) ⟷₂ ((c₂ ⊗ c₁) ◎ swap⋆) 97 | swapr⋆⟷₂ : {t₁ t₂ t₃ t₄ : U} {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} → 98 | ((c₂ ⊗ c₁) ◎ swap⋆) ⟷₂ (swap⋆ ◎ (c₁ ⊗ c₂)) 99 | id⟷₂ : {t₁ t₂ : U} {c : t₁ ⟷ t₂} → c ⟷₂ c 100 | trans⟷₂ : {t₁ t₂ : U} {c₁ c₂ c₃ : t₁ ⟷ t₂} → 101 | (c₁ ⟷₂ c₂) → (c₂ ⟷₂ c₃) → (c₁ ⟷₂ c₃) 102 | _⊡_ : {t₁ t₂ t₃ : U} 103 | {c₁ : t₁ ⟷ t₂} {c₂ : t₂ ⟷ t₃} {c₃ : t₁ ⟷ t₂} {c₄ : t₂ ⟷ t₃} → 104 | (c₁ ⟷₂ c₃) → (c₂ ⟷₂ c₄) → (c₁ ◎ c₂) ⟷₂ (c₃ ◎ c₄) 105 | resp⊕⟷₂ : {t₁ t₂ t₃ t₄ : U} 106 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₁ ⟷ t₂} {c₄ : t₃ ⟷ t₄} → 107 | (c₁ ⟷₂ c₃) → (c₂ ⟷₂ c₄) → (c₁ ⊕ c₂) ⟷₂ (c₃ ⊕ c₄) 108 | resp⊗⟷₂ : {t₁ t₂ t₃ t₄ : U} 109 | {c₁ : t₁ ⟷ t₂} {c₂ : t₃ ⟷ t₄} {c₃ : t₁ ⟷ t₂} {c₄ : t₃ ⟷ t₄} → 110 | (c₁ ⟷₂ c₃) → (c₂ ⟷₂ c₄) → (c₁ ⊗ c₂) ⟷₂ (c₃ ⊗ c₄) 111 | -- -- below are the combinators added for the RigCategory structure 112 | id⟷⊕id⟷⟷₂ : {t₁ t₂ : U} → (id⟷ {t₁} ⊕ id⟷ {t₂}) ⟷₂ id⟷ 113 | split⊕-id⟷ : {t₁ t₂ : U} → (id⟷ {_+ᵤ_ t₁ t₂}) ⟷₂ (id⟷ ⊕ id⟷) 114 | hom⊕◎⟷₂ : {t₁ t₂ t₃ t₄ t₅ t₆ : U} {c₁ : t₅ ⟷ t₁} {c₂ : t₆ ⟷ t₂} 115 | {c₃ : t₁ ⟷ t₃} {c₄ : t₂ ⟷ t₄} → 116 | ((c₁ ◎ c₃) ⊕ (c₂ ◎ c₄)) ⟷₂ ((c₁ ⊕ c₂) ◎ (c₃ ⊕ c₄)) 117 | hom◎⊕⟷₂ : {t₁ t₂ t₃ t₄ t₅ t₆ : U} {c₁ : t₅ ⟷ t₁} {c₂ : t₆ ⟷ t₂} 118 | {c₃ : t₁ ⟷ t₃} {c₄ : t₂ ⟷ t₄} → 119 | ((c₁ ⊕ c₂) ◎ (c₃ ⊕ c₄)) ⟷₂ ((c₁ ◎ c₃) ⊕ (c₂ ◎ c₄)) 120 | id⟷⊗id⟷⟷₂ : {t₁ t₂ : U} → (id⟷ {t₁} ⊗ id⟷ {t₂}) ⟷₂ id⟷ 121 | split⊗-id⟷ : {t₁ t₂ : U} → (id⟷ {_×ᵤ_ t₁ t₂}) ⟷₂ (id⟷ ⊗ id⟷) 122 | hom⊗◎⟷₂ : {t₁ t₂ t₃ t₄ t₅ t₆ : U} {c₁ : t₅ ⟷ t₁} {c₂ : t₆ ⟷ t₂} 123 | {c₃ : t₁ ⟷ t₃} {c₄ : t₂ ⟷ t₄} → 124 | ((c₁ ◎ c₃) ⊗ (c₂ ◎ c₄)) ⟷₂ ((c₁ ⊗ c₂) ◎ (c₃ ⊗ c₄)) 125 | hom◎⊗⟷₂ : {t₁ t₂ t₃ t₄ t₅ t₆ : U} {c₁ : t₅ ⟷ t₁} {c₂ : t₆ ⟷ t₂} 126 | {c₃ : t₁ ⟷ t₃} {c₄ : t₂ ⟷ t₄} → 127 | ((c₁ ⊗ c₂) ◎ (c₃ ⊗ c₄)) ⟷₂ ((c₁ ◎ c₃) ⊗ (c₂ ◎ c₄)) 128 | -- -- associativity triangle 129 | triangle⊕l : {t₁ t₂ : U} → 130 | (unite₊r {t₁} ⊕ id⟷ {t₂}) ⟷₂ (assocr₊ ◎ (id⟷ ⊕ unite₊l)) 131 | triangle⊕r : {t₁ t₂ : U} → 132 | (assocr₊ ◎ (id⟷ {t₁} ⊕ unite₊l)) ⟷₂ (unite₊r ⊕ id⟷ {t₂}) 133 | triangle⊗l : {t₁ t₂ : U} → 134 | ((unite⋆r {t₁}) ⊗ id⟷ {t₂}) ⟷₂ (assocr⋆ ◎ (id⟷ ⊗ unite⋆l)) 135 | triangle⊗r : {t₁ t₂ : U} → 136 | (assocr⋆ ◎ (id⟷ {t₁} ⊗ unite⋆l)) ⟷₂ (unite⋆r ⊗ id⟷ {t₂}) 137 | pentagon⊕l : {t₁ t₂ t₃ t₄ : U} → 138 | _⟷₂_ {((t₁ +ᵤ t₂) +ᵤ t₃) +ᵤ t₄} 139 | (assocr₊ ◎ assocr₊) 140 | (((assocr₊ ⊕ id⟷) ◎ assocr₊) ◎ (id⟷ ⊕ assocr₊)) 141 | pentagon⊕r : {t₁ t₂ t₃ t₄ : U} → 142 | _⟷₂_ {((t₁ +ᵤ t₂) +ᵤ t₃) +ᵤ t₄} 143 | (((assocr₊ ⊕ id⟷ {t₄}) ◎ assocr₊) ◎ (id⟷ ⊕ assocr₊)) 144 | (assocr₊ ◎ assocr₊) 145 | pentagon⊗l : {t₁ t₂ t₃ t₄ : U} → 146 | _⟷₂_ {((t₁ ×ᵤ t₂) ×ᵤ t₃) ×ᵤ t₄} (assocr⋆ ◎ assocr⋆) 147 | (((assocr⋆ ⊗ id⟷ {t₄}) ◎ assocr⋆) ◎ (id⟷ ⊗ assocr⋆)) 148 | pentagon⊗r : {t₁ t₂ t₃ t₄ : U} → 149 | _⟷₂_ {((t₁ ×ᵤ t₂) ×ᵤ t₃) ×ᵤ t₄} 150 | (((assocr⋆ ⊗ id⟷ {t₄}) ◎ assocr⋆) ◎ (id⟷ ⊗ assocr⋆)) 151 | (assocr⋆ ◎ assocr⋆) 152 | -- -- from the braiding 153 | -- -- unit coherence 154 | unite₊l-coh-l : {t₁ : U} → _⟷₂_ {O +ᵤ t₁} unite₊l (swap₊ ◎ unite₊r) 155 | unite₊l-coh-r : {t₁ : U} → _⟷₂_ {O +ᵤ t₁} (swap₊ ◎ unite₊r) unite₊l 156 | unite⋆l-coh-l : {t₁ : U} → _⟷₂_ {I ×ᵤ t₁} unite⋆l (swap⋆ ◎ unite⋆r) 157 | unite⋆l-coh-r : {t₁ : U} → _⟷₂_ {I ×ᵤ t₁} (swap⋆ ◎ unite⋆r) unite⋆l 158 | hexagonr⊕l : {t₁ t₂ t₃ : U} → 159 | _⟷₂_ {(t₁ +ᵤ t₂) +ᵤ t₃} 160 | ((assocr₊ ◎ swap₊) ◎ assocr₊) 161 | (((swap₊ ⊕ id⟷) ◎ assocr₊) ◎ (id⟷ ⊕ swap₊)) 162 | hexagonr⊕r : {t₁ t₂ t₃ : U} → 163 | _⟷₂_ {(t₁ +ᵤ t₂) +ᵤ t₃} 164 | (((swap₊ ⊕ id⟷) ◎ assocr₊) ◎ (id⟷ ⊕ swap₊)) 165 | ((assocr₊ ◎ swap₊) ◎ assocr₊) 166 | hexagonl⊕l : {t₁ t₂ t₃ : U} → 167 | _⟷₂_ {t₁ +ᵤ (t₂ +ᵤ t₃)} 168 | ((assocl₊ ◎ swap₊) ◎ assocl₊) 169 | (((id⟷ ⊕ swap₊) ◎ assocl₊) ◎ (swap₊ ⊕ id⟷)) 170 | hexagonl⊕r : {t₁ t₂ t₃ : U} → 171 | _⟷₂_ {t₁ +ᵤ (t₂ +ᵤ t₃)} 172 | (((id⟷ ⊕ swap₊) ◎ assocl₊) ◎ (swap₊ ⊕ id⟷)) 173 | ((assocl₊ ◎ swap₊) ◎ assocl₊) 174 | hexagonr⊗l : {t₁ t₂ t₃ : U} → 175 | _⟷₂_ {(t₁ ×ᵤ t₂) ×ᵤ t₃} 176 | ((assocr⋆ ◎ swap⋆) ◎ assocr⋆) 177 | (((swap⋆ ⊗ id⟷) ◎ assocr⋆) ◎ (id⟷ ⊗ swap⋆)) 178 | hexagonr⊗r : {t₁ t₂ t₃ : U} → 179 | _⟷₂_ {(t₁ ×ᵤ t₂) ×ᵤ t₃} 180 | (((swap⋆ ⊗ id⟷) ◎ assocr⋆) ◎ (id⟷ ⊗ swap⋆)) 181 | ((assocr⋆ ◎ swap⋆) ◎ assocr⋆) 182 | hexagonl⊗l : {t₁ t₂ t₃ : U} → 183 | _⟷₂_ {t₁ ×ᵤ (t₂ ×ᵤ t₃)} 184 | ((assocl⋆ ◎ swap⋆) ◎ assocl⋆) 185 | (((id⟷ ⊗ swap⋆) ◎ assocl⋆) ◎ (swap⋆ ⊗ id⟷)) 186 | hexagonl⊗r : {t₁ t₂ t₃ : U} → 187 | _⟷₂_ {t₁ ×ᵤ (t₂ ×ᵤ t₃)} 188 | (((id⟷ ⊗ swap⋆) ◎ assocl⋆) ◎ (swap⋆ ⊗ id⟷)) 189 | ((assocl⋆ ◎ swap⋆) ◎ assocl⋆) 190 | absorbl⟷₂l : {t₁ t₂ : U} {c₁ : t₁ ⟷ t₂} → 191 | ((c₁ ⊗ id⟷ {O}) ◎ absorbl) ⟷₂ (absorbl ◎ id⟷ {O}) 192 | absorbl⟷₂r : {t₁ t₂ : U} {c₁ : t₁ ⟷ t₂} → 193 | (absorbl ◎ id⟷ {O}) ⟷₂ ((c₁ ⊗ id⟷ {O}) ◎ absorbl) 194 | factorzr⟷₂l : {t₁ t₂ : U} {c₁ : t₁ ⟷ t₂} → 195 | (id⟷ ◎ factorzr) ⟷₂ (factorzr ◎ (c₁ ⊗ id⟷)) 196 | factorzr⟷₂r : {t₁ t₂ : U} {c₁ : t₁ ⟷ t₂} → 197 | (factorzr ◎ (c₁ ⊗ id⟷)) ⟷₂ (id⟷ ◎ factorzr) 198 | -- from the coherence conditions of RigCategory 199 | assocl₊-dist-dist⟷₂l : {t₁ t₂ t₃ t₄ : U} → 200 | _⟷₂_ {(t₁ +ᵤ t₂ +ᵤ t₃) ×ᵤ t₄} 201 | (((assocl₊ ⊗ id⟷ {t₄}) ◎ dist) ◎ (dist ⊕ id⟷)) 202 | ((dist ◎ (id⟷ ⊕ dist)) ◎ assocl₊) 203 | assocl₊-dist-dist⟷₂r : {t₁ t₂ t₃ t₄ : U} → 204 | ((dist {t₁} ◎ (id⟷ ⊕ dist {t₂} {t₃} {t₄})) ◎ assocl₊) ⟷₂ 205 | (((assocl₊ ⊗ id⟷) ◎ dist) ◎ (dist ⊕ id⟷)) 206 | 207 | ------------------------------------------------------------------------------------- 208 | -- This is invertible too 209 | !⟷₂ : {t₁ t₂ : U} {c₁ c₂ : t₁ ⟷ t₂} → c₁ ⟷₂ c₂ → c₂ ⟷₂ c₁ 210 | !⟷₂ assoc◎l = assoc◎r 211 | !⟷₂ assoc◎r = assoc◎l 212 | !⟷₂ assocl⊕l = assocl⊕r 213 | !⟷₂ assocl⊕r = assocl⊕l 214 | !⟷₂ assocl⊗l = assocl⊗r 215 | !⟷₂ assocl⊗r = assocl⊗l 216 | !⟷₂ assocr⊕r = assocr⊕l 217 | !⟷₂ assocr⊗l = assocr⊗r 218 | !⟷₂ assocr⊗r = assocr⊗l 219 | !⟷₂ assocr⊕l = assocr⊕r 220 | !⟷₂ dist⟷₂l = dist⟷₂r 221 | !⟷₂ dist⟷₂r = dist⟷₂l 222 | !⟷₂ factor⟷₂l = factor⟷₂r 223 | !⟷₂ factor⟷₂r = factor⟷₂l 224 | !⟷₂ idl◎l = idl◎r 225 | !⟷₂ idl◎r = idl◎l 226 | !⟷₂ idr◎l = idr◎r 227 | !⟷₂ idr◎r = idr◎l 228 | !⟷₂ linv◎l = linv◎r 229 | !⟷₂ linv◎r = linv◎l 230 | !⟷₂ rinv◎l = rinv◎r 231 | !⟷₂ rinv◎r = rinv◎l 232 | !⟷₂ unite₊l⟷₂l = unite₊l⟷₂r 233 | !⟷₂ unite₊l⟷₂r = unite₊l⟷₂l 234 | !⟷₂ uniti₊l⟷₂l = uniti₊l⟷₂r 235 | !⟷₂ uniti₊l⟷₂r = uniti₊l⟷₂l 236 | !⟷₂ unite₊r⟷₂l = unite₊r⟷₂r 237 | !⟷₂ unite₊r⟷₂r = unite₊r⟷₂l 238 | !⟷₂ uniti₊r⟷₂l = uniti₊r⟷₂r 239 | !⟷₂ uniti₊r⟷₂r = uniti₊r⟷₂l 240 | !⟷₂ swapl₊⟷₂ = swapr₊⟷₂ 241 | !⟷₂ swapr₊⟷₂ = swapl₊⟷₂ 242 | !⟷₂ unitel⋆⟷₂l = uniter⋆⟷₂l 243 | !⟷₂ uniter⋆⟷₂l = unitel⋆⟷₂l 244 | !⟷₂ unitil⋆⟷₂l = unitir⋆⟷₂l 245 | !⟷₂ unitir⋆⟷₂l = unitil⋆⟷₂l 246 | !⟷₂ unitel⋆⟷₂r = uniter⋆⟷₂r 247 | !⟷₂ uniter⋆⟷₂r = unitel⋆⟷₂r 248 | !⟷₂ unitil⋆⟷₂r = unitir⋆⟷₂r 249 | !⟷₂ unitir⋆⟷₂r = unitil⋆⟷₂r 250 | !⟷₂ swapl⋆⟷₂ = swapr⋆⟷₂ 251 | !⟷₂ swapr⋆⟷₂ = swapl⋆⟷₂ 252 | !⟷₂ id⟷₂ = id⟷₂ 253 | !⟷₂ (trans⟷₂ x x₁) = trans⟷₂ (!⟷₂ x₁) (!⟷₂ x) 254 | !⟷₂ (x ⊡ x₁) = !⟷₂ x ⊡ !⟷₂ x₁ 255 | !⟷₂ (resp⊕⟷₂ x x₁) = resp⊕⟷₂ (!⟷₂ x) (!⟷₂ x₁) 256 | !⟷₂ (resp⊗⟷₂ x x₁) = resp⊗⟷₂ (!⟷₂ x) (!⟷₂ x₁) 257 | !⟷₂ id⟷⊕id⟷⟷₂ = split⊕-id⟷ 258 | !⟷₂ split⊕-id⟷ = id⟷⊕id⟷⟷₂ 259 | !⟷₂ hom⊕◎⟷₂ = hom◎⊕⟷₂ 260 | !⟷₂ hom◎⊕⟷₂ = hom⊕◎⟷₂ 261 | !⟷₂ id⟷⊗id⟷⟷₂ = split⊗-id⟷ 262 | !⟷₂ split⊗-id⟷ = id⟷⊗id⟷⟷₂ 263 | !⟷₂ hom⊗◎⟷₂ = hom◎⊗⟷₂ 264 | !⟷₂ hom◎⊗⟷₂ = hom⊗◎⟷₂ 265 | !⟷₂ triangle⊕l = triangle⊕r 266 | !⟷₂ triangle⊕r = triangle⊕l 267 | !⟷₂ triangle⊗l = triangle⊗r 268 | !⟷₂ triangle⊗r = triangle⊗l 269 | !⟷₂ pentagon⊕l = pentagon⊕r 270 | !⟷₂ pentagon⊕r = pentagon⊕l 271 | !⟷₂ pentagon⊗l = pentagon⊗r 272 | !⟷₂ pentagon⊗r = pentagon⊗l 273 | !⟷₂ unite₊l-coh-l = unite₊l-coh-r 274 | !⟷₂ unite₊l-coh-r = unite₊l-coh-l 275 | !⟷₂ unite⋆l-coh-l = unite⋆l-coh-r 276 | !⟷₂ unite⋆l-coh-r = unite⋆l-coh-l 277 | !⟷₂ hexagonr⊕l = hexagonr⊕r 278 | !⟷₂ hexagonr⊕r = hexagonr⊕l 279 | !⟷₂ hexagonl⊕l = hexagonl⊕r 280 | !⟷₂ hexagonl⊕r = hexagonl⊕l 281 | !⟷₂ hexagonr⊗l = hexagonr⊗r 282 | !⟷₂ hexagonr⊗r = hexagonr⊗l 283 | !⟷₂ hexagonl⊗l = hexagonl⊗r 284 | !⟷₂ hexagonl⊗r = hexagonl⊗l 285 | !⟷₂ absorbl⟷₂l = absorbl⟷₂r 286 | !⟷₂ absorbl⟷₂r = absorbl⟷₂l 287 | !⟷₂ factorzr⟷₂l = factorzr⟷₂r 288 | !⟷₂ factorzr⟷₂r = factorzr⟷₂l 289 | !⟷₂ assocl₊-dist-dist⟷₂l = assocl₊-dist-dist⟷₂r 290 | !⟷₂ assocl₊-dist-dist⟷₂r = assocl₊-dist-dist⟷₂l 291 | 292 | ------------------------------------------------------------------------------------- 293 | ------------------------------------------------------------------------------------- 294 | 295 | -------------------------------------------------------------------------------- /Pi/Language.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.Language where 4 | 5 | open import Pi.Types using (U; O; I; _+ᵤ_; _×ᵤ_; 𝟚) 6 | open import CommMonoid using (CMStructure; CMon; module Build) 7 | 8 | ------------------------------------------------------------------------------------- 9 | -- 1-combinators 10 | 11 | private 12 | variable 13 | t t₁ t₂ t₃ t₄ : U 14 | 15 | infix 30 _⟷_ 16 | infixr 10 _◎_ 17 | infixr 20 _⊕_ 18 | infixr 30 _⊗_ 19 | 20 | -- Set things up 21 | CM× CM+ : CMStructure 22 | CM× = CMon U I _×ᵤ_ 23 | CM+ = CMon U O _+ᵤ_ 24 | 25 | module M× = Build CM× 26 | module M+ = Build CM+ 27 | 28 | data _⟷_ : U → U → Set where 29 | id⟷ : t ⟷ t 30 | add : t₁ M+.⇔ t₂ → t₁ ⟷ t₂ 31 | mult : t₁ M×.⇔ t₂ → t₁ ⟷ t₂ 32 | dist : (t₁ +ᵤ t₂) ×ᵤ t₃ ⟷ (t₁ ×ᵤ t₃) +ᵤ (t₂ ×ᵤ t₃) 33 | factor : {t₁ t₂ t₃ : U} → (t₁ ×ᵤ t₃) +ᵤ (t₂ ×ᵤ t₃) ⟷ (t₁ +ᵤ t₂) ×ᵤ t₃ 34 | absorbl : t ×ᵤ O ⟷ O 35 | factorzr : O ⟷ t ×ᵤ O 36 | _◎_ : (t₁ ⟷ t₂) → (t₂ ⟷ t₃) → (t₁ ⟷ t₃) 37 | _⊕_ : (t₁ ⟷ t₃) → (t₂ ⟷ t₄) → (t₁ +ᵤ t₂ ⟷ t₃ +ᵤ t₄) 38 | _⊗_ : (t₁ ⟷ t₃) → (t₂ ⟷ t₄) → (t₁ ×ᵤ t₂ ⟷ t₃ ×ᵤ t₄) 39 | 40 | pattern unite⋆l = mult M×.unite⋆ 41 | pattern uniti⋆l = mult M×.uniti⋆ 42 | pattern swap⋆ = mult M×.swap⋆ 43 | pattern assocl⋆ = mult M×.assocl⋆ 44 | pattern assocr⋆ = mult M×.assocr⋆ 45 | 46 | pattern unite₊l = add M+.unite⋆ 47 | pattern uniti₊l = add M+.uniti⋆ 48 | pattern swap₊ = add M+.swap⋆ 49 | pattern assocl₊ = add M+.assocl⋆ 50 | pattern assocr₊ = add M+.assocr⋆ 51 | 52 | ------------------------------------------------------------------------------------- 53 | -- Inverse 54 | !⟷ : t₁ ⟷ t₂ → t₂ ⟷ t₁ 55 | !⟷ unite₊l = uniti₊l 56 | !⟷ uniti₊l = unite₊l 57 | !⟷ unite⋆l = uniti⋆l 58 | !⟷ uniti⋆l = unite⋆l 59 | !⟷ swap₊ = swap₊ 60 | !⟷ swap⋆ = swap⋆ 61 | !⟷ assocl₊ = assocr₊ 62 | !⟷ assocr₊ = assocl₊ 63 | !⟷ assocl⋆ = assocr⋆ 64 | !⟷ assocr⋆ = assocl⋆ 65 | !⟷ absorbl = factorzr 66 | !⟷ factorzr = absorbl 67 | !⟷ dist = factor 68 | !⟷ factor = dist 69 | !⟷ id⟷ = id⟷ 70 | !⟷ (c₁ ◎ c₂) = !⟷ c₂ ◎ !⟷ c₁ 71 | !⟷ (c₁ ⊕ c₂) = !⟷ c₁ ⊕ !⟷ c₂ 72 | !⟷ (c₁ ⊗ c₂) = !⟷ c₁ ⊗ !⟷ c₂ 73 | 74 | ------------------------------------------------------------------------------------- 75 | -- Definitional extension of the language; these are often terms in the language. 76 | 77 | unite₊r : {t : U} → t +ᵤ O ⟷ t 78 | unite₊r = swap₊ ◎ unite₊l 79 | 80 | uniti₊r : {t : U} → t ⟷ t +ᵤ O 81 | uniti₊r = uniti₊l ◎ swap₊ 82 | 83 | unite⋆r : {t : U} → t ×ᵤ I ⟷ t 84 | unite⋆r = swap⋆ ◎ unite⋆l 85 | 86 | uniti⋆r : {t : U} → t ⟷ t ×ᵤ I 87 | uniti⋆r = uniti⋆l ◎ swap⋆ 88 | 89 | ------------------------------------------------------------------------------------- 90 | ------------------------------------------------------------------------------------- 91 | -------------------------------------------------------------------------------- /Pi/SyntaxToTagless.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.SyntaxToTagless where 4 | 5 | open import Pi.Types using (U) 6 | open import Pi.Language -- all of it 7 | open import Pi.Tagless 8 | 9 | ------------------------------------------------------------------------------------- 10 | 11 | private 12 | variable 13 | t t₁ t₂ t₃ t₄ : U 14 | 15 | -- Generalize the raw Pi Syntax 16 | 17 | generalize : {t₁ t₂ : U} {_⇿_ : U → U → Set} → Pi _⇿_ → (t₁ ⟷ t₂) → t₁ ⇿ t₂ 18 | generalize p unite₊l = Pi.unite+l p 19 | generalize p uniti₊l = Pi.uniti+l p 20 | generalize p unite⋆l = Pi.unite*l p 21 | generalize p uniti⋆l = Pi.uniti*l p 22 | generalize p swap₊ = Pi.swap+ p 23 | generalize p swap⋆ = Pi.swap× p 24 | generalize p assocl₊ = Pi.assocl+ p 25 | generalize p assocr₊ = Pi.assocr+ p 26 | generalize p assocl⋆ = Pi.assocl* p 27 | generalize p assocr⋆ = Pi.assocr* p 28 | generalize p absorbl = Pi.absorbl′ p 29 | generalize p factorzr = Pi.factorzr′ p 30 | generalize p dist = Pi.dist′ p 31 | generalize p factor = Pi.factor′ p 32 | generalize p id⟷ = Pi.idp p 33 | generalize p (c ◎ c₁) = Pi._⊚_ p (generalize p c) (generalize p c₁) 34 | generalize p (c ⊕ c₁) = Pi._⊕′_ p (generalize p c) (generalize p c₁) 35 | generalize p (c ⊗ c₁) = Pi._⊛_ p (generalize p c) (generalize p c₁) 36 | 37 | ------------------------------------------------------------------------------------- 38 | ------------------------------------------------------------------------------------- 39 | -------------------------------------------------------------------------------- /Pi/Tagless.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.Tagless where 4 | 5 | open import Pi.Types using (U; O; I; _+ᵤ_; _×ᵤ_) 6 | 7 | ------------------------------------------------------------------------------------- 8 | 9 | private 10 | variable 11 | t t₁ t₂ t₃ t₄ : U 12 | 13 | -- The basic language itself 14 | 15 | record Pi (_⇿_ : U → U → Set) : Set where 16 | infixr 50 _⊚_ _⊛_ 17 | 18 | field 19 | unite+l : (O +ᵤ t) ⇿ t 20 | uniti+l : t ⇿ (O +ᵤ t) 21 | unite*l : (I ×ᵤ t) ⇿ t 22 | uniti*l : t ⇿ (I ×ᵤ t) 23 | swap+ : (t₁ +ᵤ t₂) ⇿ (t₂ +ᵤ t₁) 24 | swap× : (t₁ ×ᵤ t₂) ⇿ (t₂ ×ᵤ t₁) 25 | assocl+ : (t₁ +ᵤ (t₂ +ᵤ t₃)) ⇿ ((t₁ +ᵤ t₂) +ᵤ t₃) 26 | assocr+ : ((t₁ +ᵤ t₂) +ᵤ t₃) ⇿ (t₁ +ᵤ (t₂ +ᵤ t₃)) 27 | assocl* : (t₁ ×ᵤ (t₂ ×ᵤ t₃)) ⇿ ((t₁ ×ᵤ t₂) ×ᵤ t₃) 28 | assocr* : ((t₁ ×ᵤ t₂) ×ᵤ t₃) ⇿ (t₁ ×ᵤ (t₂ ×ᵤ t₃)) 29 | absorbl′ : (t ×ᵤ O) ⇿ O 30 | factorzr′ : O ⇿ (t ×ᵤ O) 31 | dist′ : ((t₁ +ᵤ t₂) ×ᵤ t₃) ⇿ ((t₁ ×ᵤ t₃) +ᵤ (t₂ ×ᵤ t₃)) 32 | factor′ : ((t₁ ×ᵤ t₃) +ᵤ (t₂ ×ᵤ t₃)) ⇿ ((t₁ +ᵤ t₂) ×ᵤ t₃) 33 | idp : t ⇿ t 34 | _⊚_ : t₁ ⇿ t₂ → t₂ ⇿ t₃ → t₁ ⇿ t₃ 35 | _⊕′_ : t₁ ⇿ t₃ → t₂ ⇿ t₄ → (t₁ +ᵤ t₂) ⇿ (t₃ +ᵤ t₄) 36 | _⊛_ : t₁ ⇿ t₃ → t₂ ⇿ t₄ → (t₁ ×ᵤ t₂) ⇿ (t₃ ×ᵤ t₄) 37 | 38 | -- And a witness that it's reversible 39 | 40 | record PiR (_⇿_ : U → U → Set) : Set where 41 | field 42 | pi : Pi _⇿_ 43 | !_ : t₁ ⇿ t₂ → t₂ ⇿ t₁ 44 | open Pi pi public 45 | 46 | -- It's reversible 47 | 48 | reverse : {_⇿_ : U → U → Set} → Pi _⇿_ → Pi (λ x y → y ⇿ x) 49 | reverse p = record 50 | { unite+l = uniti+l 51 | ; uniti+l = unite+l 52 | ; unite*l = uniti*l 53 | ; uniti*l = unite*l 54 | ; swap+ = swap+ 55 | ; swap× = swap× 56 | ; assocl+ = assocr+ 57 | ; assocr+ = assocl+ 58 | ; assocl* = assocr* 59 | ; assocr* = assocl* 60 | ; absorbl′ = factorzr′ 61 | ; factorzr′ = absorbl′ 62 | ; dist′ = factor′ 63 | ; factor′ = dist′ 64 | ; idp = idp 65 | ; _⊚_ = λ f g → g ⊚ f 66 | ; _⊕′_ = _⊕′_ 67 | ; _⊛_ = _⊛_ 68 | } 69 | where open Pi p 70 | 71 | ------------------------------------------------------------------------------------- 72 | ------------------------------------------------------------------------------------- 73 | -------------------------------------------------------------------------------- /Pi/TermReasoning.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Define syntax for presenting Pi using equational style 4 | 5 | module Pi.TermReasoning where 6 | 7 | open import Relation.Binary.Bundles using (Setoid) 8 | import Relation.Binary.Reasoning.Setoid as SetoidR 9 | 10 | open import Pi.Types using (U) 11 | open import Pi.Language using (_⟷_; _◎_; _⊗_; _⊕_) 12 | open import Pi.Equivalences using (_⟷₂_; trans⟷₂; id⟷₂; !⟷₂; _⊡_; resp⊗⟷₂; resp⊕⟷₂) 13 | 14 | ------------------------------------------------------------------------------------- 15 | -- Equational reasoning, from stdlib 16 | 17 | private 18 | ⟷₂Setoid : {t₁ t₂ : U} → Setoid _ _ 19 | ⟷₂Setoid {t₁} {t₂} = record 20 | { Carrier = t₁ ⟷ t₂ 21 | ; _≈_ = _⟷₂_ 22 | ; isEquivalence = record 23 | { refl = id⟷₂ 24 | ; sym = !⟷₂ 25 | ; trans = trans⟷₂ 26 | } 27 | } 28 | 29 | module Base {t₁ t₂} = SetoidR (⟷₂Setoid {t₁} {t₂}) 30 | 31 | open Base public 32 | 33 | -- Extra combinators to make more things pretty 34 | private 35 | variable 36 | t₁ t₂ t₃ : U 37 | c₁ c₂ c₃ c₄ : t₁ ⟷ t₂ 38 | 39 | infixr 4 _○_ 40 | infixr 4 _⟩◎⟨_ id⟩◎⟨_ 41 | infixl 5 _⟩◎⟨id 42 | infixr 6 _⟩⊗⟨_ id⟩⊗⟨_ 43 | infixl 7 _⟩⊗⟨id 44 | 45 | _○_ : (c₁ ⟷₂ c₂) → (c₂ ⟷₂ c₃) → (c₁ ⟷₂ c₃) 46 | _○_ = trans⟷₂ 47 | 48 | _⟩◎⟨_ : (c₁ ⟷₂ c₃) → (c₂ ⟷₂ c₄) → (c₁ ◎ c₂) ⟷₂ (c₃ ◎ c₄) 49 | _⟩◎⟨_ = _⊡_ 50 | 51 | id⟩◎⟨_ : (c₂ ⟷₂ c₄) → (c₁ ◎ c₂) ⟷₂ (c₁ ◎ c₄) 52 | id⟩◎⟨_ = id⟷₂ ⊡_ 53 | 54 | _⟩◎⟨id : (c₁ ⟷₂ c₃) → (c₁ ◎ c₂) ⟷₂ (c₃ ◎ c₂) 55 | _⟩◎⟨id = _⊡ id⟷₂ 56 | 57 | _⟩⊗⟨_ : (c₁ ⟷₂ c₃) → (c₂ ⟷₂ c₄) → (c₁ ⊗ c₂) ⟷₂ (c₃ ⊗ c₄) 58 | _⟩⊗⟨_ = resp⊗⟷₂ 59 | 60 | id⟩⊗⟨_ : (c₂ ⟷₂ c₄) → (c₁ ⊗ c₂) ⟷₂ (c₁ ⊗ c₄) 61 | id⟩⊗⟨_ = resp⊗⟷₂ id⟷₂ 62 | 63 | _⟩⊗⟨id : (c₁ ⟷₂ c₃) → (c₁ ⊗ c₂) ⟷₂ (c₃ ⊗ c₂) 64 | d ⟩⊗⟨id = resp⊗⟷₂ d id⟷₂ 65 | 66 | ------------------------------------------------------------------------------------- 67 | ------------------------------------------------------------------------------------- 68 | -------------------------------------------------------------------------------- /Pi/Terms.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.Terms where 4 | 5 | open import Pi.Types using (U; _×ᵤ_; 𝟚) 6 | open import Pi.Language using (_⟷_; id⟷; _◎_; _⊕_; _⊗_; dist; factor; swap₊) 7 | 8 | private 9 | variable 10 | t : U 11 | 12 | ------------------------------------------------------------------------------------- 13 | -- Common terms 14 | 15 | ctrl : t ⟷ t → (𝟚 ×ᵤ t) ⟷ (𝟚 ×ᵤ t) 16 | ctrl c = dist ◎ (id⟷ ⊕ id⟷ ⊗ c) ◎ factor 17 | 18 | x : 𝟚 ⟷ 𝟚 19 | x = swap₊ 20 | 21 | cx : 𝟚 ×ᵤ 𝟚 ⟷ 𝟚 ×ᵤ 𝟚 22 | cx = ctrl x 23 | 24 | ccx : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⟷ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 25 | ccx = ctrl cx 26 | 27 | ------------------------------------------------------------------------------------- 28 | ------------------------------------------------------------------------------------- 29 | -------------------------------------------------------------------------------- /Pi/Types.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module Pi.Types where 4 | 5 | open import Data.Bool using (Bool; true; false; _∧_) 6 | open import Data.Empty using (⊥) 7 | open import Data.List using (List; []; _∷_; _++_; map; cartesianProduct) 8 | open import Data.Product as Prod using (_,_; _×_) 9 | open import Data.Sum as Sum using (_⊎_; inj₁; inj₂) 10 | open import Data.Unit using (⊤; tt) 11 | 12 | ------------------------------------------------------------------------------------- 13 | -- Types 14 | 15 | data U : Set where 16 | O : U 17 | I : U 18 | _+ᵤ_ : U → U → U 19 | _×ᵤ_ : U → U → U 20 | 21 | infixr 40 _+ᵤ_ _×ᵤ_ 22 | 23 | private 24 | variable 25 | t t₁ t₂ t₃ t₄ : U 26 | 27 | -- Intended meaning 28 | ⟦_⟧ : (t : U) → Set 29 | ⟦ O ⟧ = ⊥ 30 | ⟦ I ⟧ = ⊤ 31 | ⟦ t₁ +ᵤ t₂ ⟧ = ⟦ t₁ ⟧ ⊎ ⟦ t₂ ⟧ 32 | ⟦ t₁ ×ᵤ t₂ ⟧ = ⟦ t₁ ⟧ × ⟦ t₂ ⟧ 33 | 34 | -- inhabitants of U have decidable equality 35 | _≟_ : {t : U} → ⟦ t ⟧ → ⟦ t ⟧ → Bool 36 | _≟_ {I} tt tt = true 37 | _≟_ {t₁ +ᵤ t₂} (inj₁ v) (inj₁ w) = v ≟ w 38 | _≟_ {t₁ +ᵤ t₂} (inj₁ v) (inj₂ w) = false 39 | _≟_ {t₁ +ᵤ t₂} (inj₂ v) (inj₁ w) = false 40 | _≟_ {t₁ +ᵤ t₂} (inj₂ v) (inj₂ w) = v ≟ w 41 | _≟_ {t₁ ×ᵤ t₂} (v₁ , w₁) (v₂ , w₂) = v₁ ≟ v₂ ∧ w₁ ≟ w₂ 42 | 43 | -- we can enumerate our types 44 | enum : (t : U) → List ⟦ t ⟧ 45 | enum O = [] 46 | enum I = tt ∷ [] 47 | enum (t₁ +ᵤ t₂) = map inj₁ (enum t₁) ++ map inj₂ (enum t₂) 48 | enum (t₁ ×ᵤ t₂) = cartesianProduct (enum t₁) (enum t₂) 49 | 50 | ------------------------------------------------------------------------------------- 51 | -- Common types that recur, give them abbreviations 52 | 53 | 𝟚 : U 54 | 𝟚 = I +ᵤ I 55 | 56 | pattern 𝔽 = inj₁ tt 57 | pattern 𝕋 = inj₂ tt 58 | ------------------------------------------------------------------------------------- 59 | ------------------------------------------------------------------------------------- 60 | -------------------------------------------------------------------------------- /PiH.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module PiH where 4 | 5 | open import Function using (_∘_) 6 | 7 | open import Pi.Types using (U; 𝟚) 8 | open import Pi.Language using (_⟷_) 9 | open import Pi.SyntaxToTagless using (generalize) 10 | open import GenericPi using (Fwd; GenericPi) 11 | open import Unitary using (UVec; module Build) 12 | open import LinearAlgebraSig using (LASig) 13 | open import AbstractRotation using (RotMat) 14 | 15 | module MkPiH (L : LASig) (RM : RotMat L) where 16 | open LASig L using (true; false) 17 | open Build L RM using (R; R⁻¹) 18 | 19 | ----------------------------------------------------------------------- 20 | -- An evaluator for H can re-use GenericPi and conjugate before/after: 21 | evalH : {t₁ t₂ : U} → t₁ ⟷ t₂ → Fwd L t₁ t₂ 22 | evalH {t₁} {t₂} c = R⁻¹ t₂ ∘ generalize (GenericPi L) c ∘ R t₁ 23 | 24 | trueH falseH : UVec L 𝟚 25 | trueH = R⁻¹ 𝟚 true 26 | falseH = R⁻¹ 𝟚 false 27 | 28 | -------------------------------------------------------------------------------- /PiZ.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module PiZ where 4 | 5 | open import Pi.Types using (U; 𝟚) 6 | open import Pi.Language using (_⟷_) 7 | open import Pi.SyntaxToTagless using (generalize) 8 | open import GenericPi using (Fwd; GenericPi) 9 | open import Unitary using (UVec) 10 | open import LinearAlgebraSig using (LASig) 11 | 12 | module MkPiZ (L : LASig) where 13 | open LASig L using (true; false) 14 | 15 | ----------------------------------------------------------------------- 16 | -- Below we start the work that correspoints to the Z interpretation 17 | 18 | -- An evaluator for Z can re-use GenericPi directly: 19 | evalZ : {t₁ t₂ : U} → t₁ ⟷ t₂ → Fwd L t₁ t₂ 20 | evalZ {t₁} {t₂} c = generalize (GenericPi L) c 21 | 22 | trueZ falseZ : UVec L 𝟚 23 | trueZ = true 24 | falseZ = false 25 | -------------------------------------------------------------------------------- /QPi/Equivalences.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module QPi.Equivalences where 4 | 5 | open import Pi.Types using (U; _×ᵤ_) 6 | open import Pi.Language as Π using (_◎_; _⟷_; id⟷; !⟷; _⊗_) 7 | import Pi.Terms as ΠT 8 | open import Pi.Equivalences 9 | open import QPi.Syntax 10 | open import QPi.Terms using (ctrlZ; one; copyZ; copyϕ; X; Z; 11 | H; minus; plus; cx; cz) 12 | 13 | --------------------------------------------------------------------------- 14 | -- Some of the equations 15 | 16 | infix 10 _≡_ 17 | 18 | private 19 | variable 20 | t t₁ t₂ t₃ : U 21 | c c₁ c₂ c₃ : t₁ ⟷ t₂ 22 | d d₁ d₂ d₃ d₄ : t₁ ⇔ t₂ 23 | 24 | data _≡_ : {t₁ t₂ : U} → (t₁ ⇔ t₂) → (t₁ ⇔ t₂) → Set where 25 | classicalZ : (c₁ ⟷₂ c₂) → (arrZ c₁ ≡ arrZ c₂) 26 | classicalϕ : (c₁ ⟷₂ c₂) → (arrϕ c₁ ≡ arrϕ c₂) 27 | -- arrow axioms 28 | arrZidL : arrZ (id⟷ {t}) ≡ id⇔ 29 | arrZidR : id⇔ ≡ arrZ (id⟷ {t}) 30 | arrϕidL : arrϕ (id⟷ {t}) ≡ id⇔ 31 | arrϕidR : id⇔ ≡ arrϕ (id⟷ {t}) 32 | arrZL : (arrZ (c₁ ◎ c₂)) ≡ (arrZ c₁ >>> arrZ c₂) 33 | arrZR : (arrZ c₁ >>> arrZ c₂) ≡ (arrZ (c₁ ◎ c₂)) 34 | arrϕL : (arrϕ (c₁ ◎ c₂)) ≡ (arrϕ c₁ >>> arrϕ c₂) 35 | arrϕR : (arrϕ c₁ >>> arrϕ c₂) ≡ (arrϕ (c₁ ◎ c₂)) 36 | arrZL* : (arrZ (c₁ ⊗ c₂)) ≡ (arrZ c₁ *** arrZ c₂) 37 | arrZR* : (arrZ c₁ *** arrZ c₂) ≡ (arrZ (c₁ ⊗ c₂)) 38 | arrϕL* : (arrϕ (c₁ ⊗ c₂)) ≡ (arrϕ c₁ *** arrϕ c₂) 39 | arrϕR* : (arrϕ c₁ *** arrϕ c₂) ≡ (arrϕ (c₁ ⊗ c₂)) 40 | -- monoidal coherence 41 | assoc>>>l : (d₁ >>> (d₂ >>> d₃)) ≡ ((d₁ >>> d₂) >>> d₃) 42 | assoc>>>r : ((d₁ >>> d₂) >>> d₃) ≡ (d₁ >>> (d₂ >>> d₃)) 43 | assocl***l : ((d₁ *** (d₂ *** d₃)) >>> assocl⋆) ≡ (assocl⋆ >>> ((d₁ *** d₂) *** d₃)) 44 | assocl***r : (assocl⋆ >>> ((d₁ *** d₂) *** d₃)) ≡ ((d₁ *** (d₂ *** d₃)) >>> assocl⋆) 45 | assocr***l : (assocr⋆ >>> (d₁ *** (d₂ *** d₃))) ≡ (((d₁ *** d₂) *** d₃) >>> assocr⋆) 46 | assocr***r : (((d₁ *** d₂) *** d₃) >>> assocr⋆) ≡ (assocr⋆ >>> (d₁ *** (d₂ *** d₃))) 47 | idl>>>l : (id⇔ >>> d) ≡ d 48 | idl>>>r : d ≡ (id⇔ >>> d) 49 | idr>>>l : (d >>> id⇔) ≡ d 50 | idr>>>r : d ≡ (d >>> id⇔) 51 | -- other combinators ok; not just swap; but not zero/assertZero 52 | linv>>>l : (swap⋆ >>> inv swap⋆) ≡ id⇔ {t₁ ×ᵤ t₂} 53 | linv>>>r : id⇔ {t₁ ×ᵤ t₂} ≡ (swap⋆ >>> inv swap⋆) 54 | rinv>>>l : (inv swap⋆ >>> swap⋆ ) ≡ id⇔ {t₁ ×ᵤ t₂} 55 | rinv>>>r : id⇔ {t₁ ×ᵤ t₂} ≡ (inv swap⋆ >>> swap⋆ ) 56 | unitel⋆≡r : (unite⋆r >>> d₂) ≡ ((d₂ *** d₁) >>> unite⋆r) 57 | uniter⋆≡r : ((d₂ *** d₁) >>> unite⋆r) ≡ (unite⋆r >>> d₂) 58 | unitil⋆≡r : (uniti⋆r >>> (d₂ *** d₁)) ≡ (d₂ >>> uniti⋆r) 59 | unitir⋆≡r : (d₂ >>> uniti⋆r) ≡ (uniti⋆r >>> (d₂ *** d₁)) 60 | swapl⋆≡ : (swap⋆ >>> (d₁ *** d₂)) ≡ ((d₂ *** d₁) >>> swap⋆) 61 | swapr⋆≡ : ((d₂ *** d₁) >>> swap⋆) ≡ (swap⋆ >>> (d₁ *** d₂)) 62 | id≡ : d ≡ d 63 | trans≡ : (d₁ ≡ d₂) → (d₂ ≡ d₃) → (d₁ ≡ d₃) 64 | -- congruence; functor 65 | cong≡ : (d₁ ≡ d₃) → (d₂ ≡ d₄) → ((d₁ >>> d₂) ≡ (d₃ >>> d₄)) 66 | cong*** : (d₁ ≡ d₃) → (d₂ ≡ d₄) → ((d₁ *** d₂) ≡ (d₃ *** d₄)) 67 | homL*** : ((d₁ *** d₂) >>> (d₃ *** d₄)) ≡ ((d₁ >>> d₃) *** (d₂ >>> d₄)) 68 | homR*** : ((d₁ >>> d₃) *** (d₂ >>> d₄)) ≡ ((d₁ *** d₂) >>> (d₃ *** d₄)) 69 | id***id : {t₁ t₂ : U} → (id⇔ {t₁} *** id⇔ {t₂}) ≡ id⇔ 70 | split***-id : {t₁ t₂ : U} → (id⇔ {_×ᵤ_ t₁ t₂}) ≡ (id⇔ *** id⇔) 71 | -- execution equations 72 | e1L : zero >>> assertZero ≡ id⇔ 73 | e1R : id⇔ ≡ zero >>> assertZero 74 | e2L : (zero *** id⇔) >>> ctrlZ c ≡ zero *** id⇔ 75 | e2R : zero *** id⇔ ≡ (zero *** id⇔) >>> ctrlZ c 76 | e3L : (one *** id⇔) >>> ctrlZ c ≡ one *** arrZ c 77 | e3R : one *** arrZ c ≡ (one *** id⇔) >>> ctrlZ c 78 | -- complementarity 79 | C : ((copyZ *** id⇔) >>> assocr⋆ >>> (id⇔ *** (inv copyϕ)) >>> 80 | (id⇔ *** copyϕ) >>> assocl⋆ >>> ((inv copyZ) *** id⇔)) 81 | ≡ id⇔ 82 | C˘ : id⇔ ≡ ((copyZ *** id⇔) >>> assocr⋆ >>> (id⇔ *** (inv copyϕ)) >>> 83 | (id⇔ *** copyϕ) >>> assocl⋆ >>> ((inv copyZ) *** id⇔)) 84 | 85 | --------------------------------------------------------------------------- 86 | 87 | -- _≡_ should be an equivalence relation, so invertible. It's syntactically 88 | -- so close, may as well finish it. 89 | !≡ : {t₁ t₂ : U} {c₁ c₂ : t₁ ⇔ t₂} → c₁ ≡ c₂ → c₂ ≡ c₁ 90 | !≡ (classicalZ x) = classicalZ (!⟷₂ x) 91 | !≡ (classicalϕ x) = classicalϕ (!⟷₂ x) 92 | !≡ arrZidL = arrZidR 93 | !≡ arrZidR = arrZidL 94 | !≡ arrϕidL = arrϕidR 95 | !≡ arrϕidR = arrϕidL 96 | !≡ arrZL = arrZR 97 | !≡ arrZR = arrZL 98 | !≡ arrϕL = arrϕR 99 | !≡ arrϕR = arrϕL 100 | !≡ arrZL* = arrZR* 101 | !≡ arrZR* = arrZL* 102 | !≡ arrϕL* = arrϕR* 103 | !≡ arrϕR* = arrϕL* 104 | !≡ assoc>>>l = assoc>>>r 105 | !≡ assoc>>>r = assoc>>>l 106 | !≡ assocl***l = assocl***r 107 | !≡ assocl***r = assocl***l 108 | !≡ assocr***l = assocr***r 109 | !≡ assocr***r = assocr***l 110 | !≡ idl>>>l = idl>>>r 111 | !≡ idl>>>r = idl>>>l 112 | !≡ idr>>>l = idr>>>r 113 | !≡ idr>>>r = idr>>>l 114 | !≡ linv>>>l = linv>>>r 115 | !≡ linv>>>r = linv>>>l 116 | !≡ rinv>>>l = rinv>>>r 117 | !≡ rinv>>>r = rinv>>>l 118 | !≡ unitel⋆≡r = uniter⋆≡r 119 | !≡ uniter⋆≡r = unitel⋆≡r 120 | !≡ unitil⋆≡r = unitir⋆≡r 121 | !≡ unitir⋆≡r = unitil⋆≡r 122 | !≡ swapl⋆≡ = swapr⋆≡ 123 | !≡ swapr⋆≡ = swapl⋆≡ 124 | !≡ id≡ = id≡ 125 | !≡ (trans≡ x x₁) = trans≡ (!≡ x₁) (!≡ x) 126 | !≡ (cong≡ x x₁) = cong≡ (!≡ x) (!≡ x₁) 127 | !≡ (cong*** x x₁) = cong*** (!≡ x) (!≡ x₁) 128 | !≡ homL*** = homR*** 129 | !≡ homR*** = homL*** 130 | !≡ id***id = split***-id 131 | !≡ split***-id = id***id 132 | !≡ e1L = e1R 133 | !≡ e1R = e1L 134 | !≡ e2L = e2R 135 | !≡ e2R = e2L 136 | !≡ e3L = e3R 137 | !≡ e3R = e3L 138 | !≡ C = C˘ 139 | !≡ C˘ = C 140 | -------------------------------------------------------------------------------- /QPi/Execute.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K #-} 2 | 3 | -- Infrastructure to "run" examples 4 | 5 | module QPi.Execute where 6 | 7 | open import Data.Float using (Float) 8 | open import Data.Bool using (Bool; if_then_else_) 9 | open import Data.Product using (_×_; _,_) 10 | open import Data.List using (List; _∷_; []; map; foldr) 11 | open import Relation.Binary.PropositionalEquality using (_≡_; refl) 12 | 13 | open import Pi.Types using (U; O; ⟦_⟧; enum; _≟_) 14 | open import FloatUtils using (tooSmall) 15 | open import LinearAlgebraSig using (LASig) 16 | open import Float.LASig using (FloatVec) 17 | 18 | open import Instances using (evalSE) 19 | 20 | open import QPi.Syntax using (_⇔_) 21 | open import QPi.Semantics using (embed) 22 | 23 | open LASig FloatVec using (vec; mat) 24 | 25 | --------------------------------------------------------------------------- 26 | 27 | private 28 | variable 29 | t t₁ t₂ : U 30 | 31 | --------------------------------------------------------------------------- 32 | -- Infrastructure for running things 33 | 34 | K : U → Set 35 | K t = vec ⟦ t ⟧ 36 | 37 | show : {t : U} → K t → List (⟦ t ⟧ × Float) 38 | show {t} v = 39 | foldr (λ i r → let a = v i in if tooSmall a then r else (i , a) ∷ r) 40 | [] 41 | (enum t) 42 | 43 | ket : mat ⟦ t ⟧ 44 | ket v w = if v ≟ w then 1.0 else 0.0 45 | 46 | run : (t₁ ⇔ t₂) → K t₁ → List (⟦ t₂ ⟧ × Float) 47 | run c v = show (evalSE (embed c) v) 48 | 49 | showAll : {t₁ t₂ : U} → (t₁ ⇔ t₂) → List (⟦ t₁ ⟧ × List (⟦ t₂ ⟧ × Float)) 50 | showAll {t₁} c = map (λ v → (v , run c (ket v))) (enum t₁) 51 | 52 | --------------------------------------------------------------------------- 53 | --------------------------------------------------------------------------- 54 | -------------------------------------------------------------------------------- /QPi/Measurement.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K #-} 2 | 3 | -- Examples of QPi that are based on discarding information (and are thus 4 | -- not reversible). Right now, postulate the existence of 'discard'. 5 | 6 | module QPi.Measurement where 7 | 8 | open import Pi.Types using (U; I; _×ᵤ_; 𝟚) 9 | open import Pi.Language as Π using (_⟷_) 10 | import Pi.Terms as ΠT 11 | 12 | open import QPi.Syntax 13 | open import QPi.Terms using (copyZ; copyϕ; map3***; plus; amp; repeat; u) 14 | open import QPi.Equivalences using (_≡_) 15 | --------------------------------------------------------------------------- 16 | 17 | private 18 | variable 19 | t t₁ t₂ : U 20 | 21 | --------------------------------------------------------------------------- 22 | 23 | -- postulate measurement 24 | postulate 25 | discard : t ⇔ I 26 | discardL : (d : t₁ ⇔ t₂) → d >>> discard ≡ discard 27 | 28 | fst : (t₁ ×ᵤ t₂) ⇔ t₁ 29 | fst = (id⇔ *** discard) >>> unite⋆r 30 | 31 | snd : (t₁ ×ᵤ t₂) ⇔ t₂ 32 | snd = swap⋆ >>> fst 33 | 34 | measureZ measureϕ : 𝟚 ⇔ 𝟚 35 | measureZ = copyZ >>> fst 36 | measureϕ = copyϕ >>> fst 37 | 38 | grover₃ : I ×ᵤ I ×ᵤ I ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 39 | grover₃ = map3*** plus >>> 40 | repeat 3 (u >>> amp) >>> 41 | map3*** measureZ 42 | 43 | --------------------------------------------------------------------------- 44 | --------------------------------------------------------------------------- 45 | -------------------------------------------------------------------------------- /QPi/Semantics.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module QPi.Semantics where 4 | 5 | open import Pi.Types using (U) 6 | open import Pi.Language as Π using (_⟷_) 7 | open import ArrowsOverAmalg using (arr₁; arr₂) 8 | open import StatesAndEffects using (_↭_; arr; _>>>>_; invSE) 9 | renaming (_***_ to _****_; zero to kzero; assertZero to bzero) 10 | 11 | open import QPi.Syntax 12 | 13 | --------------------------------------------------------------------------- 14 | -- Semantics 15 | 16 | private 17 | variable 18 | t t₁ t₂ : U 19 | 20 | private 21 | pizA : (t₁ ⟷ t₂) → t₁ ↭ t₂ 22 | pizA c = arr (arr₁ c) 23 | 24 | embed : (t₁ ⇔ t₂) → t₁ ↭ t₂ 25 | embed (arrZ c) = pizA c 26 | embed (arrϕ c) = arr (arr₂ c) 27 | embed unite⋆l = pizA Π.unite⋆l 28 | embed uniti⋆l = pizA Π.uniti⋆l 29 | embed swap⋆ = pizA Π.swap⋆ 30 | embed assocl⋆ = pizA Π.assocl⋆ 31 | embed assocr⋆ = pizA Π.assocr⋆ 32 | embed id⇔ = pizA Π.id⟷ 33 | embed (d₁ >>> d₂) = embed d₁ >>>> embed d₂ 34 | embed (d₁ *** d₂) = embed d₁ **** embed d₂ 35 | embed zero = kzero 36 | embed assertZero = bzero 37 | 38 | --------------------------------------------------------------------------- 39 | --------------------------------------------------------------------------- 40 | -------------------------------------------------------------------------------- /QPi/Syntax.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module QPi.Syntax where 4 | 5 | open import Pi.Types using (U; I; _×ᵤ_; 𝟚) 6 | open import Pi.Language using (_⟷_; !⟷) 7 | open import CommMonoid using (CMStructure; CMon; module Build) 8 | 9 | --------------------------------------------------------------------------- 10 | -- The surface Quantum Pi language 11 | 12 | infix 10 _⇔_ 13 | infixr 30 _>>>_ 14 | infixr 40 _***_ 15 | 16 | private 17 | variable 18 | t t₁ t₂ t₃ t₄ : U 19 | 20 | -- Set things up 21 | CM : CMStructure 22 | CM = CMon U I _×ᵤ_ 23 | 24 | module M = Build CM 25 | 26 | data _⇔_ : U → U → Set where 27 | arrZ : (t₁ ⟷ t₂) → (t₁ ⇔ t₂) 28 | arrϕ : (t₁ ⟷ t₂) → (t₁ ⇔ t₂) 29 | mult : t₁ M.⇔ t₂ → t₁ ⇔ t₂ 30 | id⇔ : t ⇔ t 31 | _>>>_ : (t₁ ⇔ t₂) → (t₂ ⇔ t₃) → (t₁ ⇔ t₃) 32 | _***_ : (t₁ ⇔ t₃) → (t₂ ⇔ t₄) → (t₁ ×ᵤ t₂ ⇔ t₃ ×ᵤ t₄) 33 | zero : I ⇔ 𝟚 34 | assertZero : 𝟚 ⇔ I 35 | 36 | pattern unite⋆l = mult M.unite⋆ 37 | pattern uniti⋆l = mult M.uniti⋆ 38 | pattern swap⋆ = mult M.swap⋆ 39 | pattern assocl⋆ = mult M.assocl⋆ 40 | pattern assocr⋆ = mult M.assocr⋆ 41 | 42 | -- These are right-biased 43 | unite⋆r : {t : U} → t ×ᵤ I ⇔ t 44 | unite⋆r = swap⋆ >>> unite⋆l 45 | 46 | uniti⋆r : {t : U} → t ⇔ t ×ᵤ I 47 | uniti⋆r = uniti⋆l >>> swap⋆ 48 | 49 | inv : t₁ ⇔ t₂ → t₂ ⇔ t₁ 50 | inv (arrZ c) = arrZ (!⟷ c) 51 | inv (arrϕ c) = arrϕ (!⟷ c) 52 | inv (unite⋆l) = uniti⋆l 53 | inv (uniti⋆l) = unite⋆l 54 | inv (swap⋆) = swap⋆ 55 | inv (assocl⋆) = assocr⋆ 56 | inv (assocr⋆) = assocl⋆ 57 | inv id⇔ = id⇔ 58 | inv (d₁ >>> d₂) = inv d₂ >>> inv d₁ 59 | inv (d₁ *** d₂) = inv d₁ *** inv d₂ 60 | inv zero = assertZero 61 | inv assertZero = zero 62 | 63 | --------------------------------------------------------------------------- 64 | -------------------------------------------------------------------------------- /QPi/TermReasoning.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module QPi.TermReasoning where 4 | 5 | open import Relation.Binary.Bundles using (Setoid) 6 | import Relation.Binary.Reasoning.Setoid as SetoidR 7 | 8 | open import Pi.Types using (U) 9 | open import QPi.Syntax using (_⇔_; _>>>_; _***_) 10 | open import QPi.Equivalences using (_≡_; id≡; trans≡; !≡; cong≡; cong***) 11 | 12 | --------------------------------------------------------------------------- 13 | private 14 | variable 15 | t t₁ t₂ t₃ : U 16 | d d₁ d₂ d₃ d₄ : t₁ ⇔ t₂ 17 | 18 | -- Equational reasoning, from stdlib 19 | 20 | private 21 | ≡Setoid : {t₁ t₂ : U} → Setoid _ _ 22 | ≡Setoid {t₁} {t₂} = record 23 | { Carrier = t₁ ⇔ t₂ 24 | ; _≈_ = _≡_ 25 | ; isEquivalence = record 26 | { refl = id≡ 27 | ; sym = !≡ 28 | ; trans = trans≡ 29 | } 30 | } 31 | 32 | module Base {t₁ t₂} = SetoidR (≡Setoid {t₁} {t₂}) 33 | 34 | open Base public hiding (step-≈; step-≡) 35 | 36 | infixr 2 step-≡ 37 | step-≡ : (x : t₁ ⇔ t₂) {y z : t₁ ⇔ t₂} → 38 | _IsRelatedTo_ y z → x ≡ y → x IsRelatedTo z 39 | step-≡ = Base.step-≈ 40 | 41 | syntax step-≡ x y≡z x≡y = x ≡⟨ x≡y ⟩ y≡z 42 | 43 | -- Cheat and use ◎ for >>> and ⊗ for ***, else we don't save enough 44 | infixr 4 _⟩◎⟨_ id⟩◎⟨_ 45 | infixl 5 _⟩◎⟨id 46 | infixr 6 _⟩⊗⟨_ id⟩⊗⟨_ 47 | infixl 7 _⟩⊗⟨id 48 | infixr 3 _◯_ 49 | 50 | _◯_ : (d₁ ≡ d₂) → (d₂ ≡ d₃) → (d₁ ≡ d₃) 51 | _◯_ = trans≡ 52 | 53 | _⟩◎⟨_ : (d₁ ≡ d₃) → (d₂ ≡ d₄) → (d₁ >>> d₂) ≡ (d₃ >>> d₄) 54 | _⟩◎⟨_ = cong≡ 55 | 56 | id⟩◎⟨_ : (d₂ ≡ d₄) → (d₁ >>> d₂) ≡ (d₁ >>> d₄) 57 | id⟩◎⟨_ = cong≡ id≡ 58 | 59 | _⟩◎⟨id : (d₁ ≡ d₃) → (d₁ >>> d₂) ≡ (d₃ >>> d₂) 60 | d ⟩◎⟨id = cong≡ d id≡ 61 | 62 | _⟩⊗⟨_ : (d₁ ≡ d₃) → (d₂ ≡ d₄) → (d₁ *** d₂) ≡ (d₃ *** d₄) 63 | _⟩⊗⟨_ = cong*** 64 | 65 | id⟩⊗⟨_ : (d₂ ≡ d₄) → (d₁ *** d₂) ≡ (d₁ *** d₄) 66 | id⟩⊗⟨_ = cong*** id≡ 67 | 68 | _⟩⊗⟨id : (d₁ ≡ d₃) → (d₁ *** d₂) ≡ (d₃ *** d₂) 69 | e ⟩⊗⟨id = cong*** e id≡ 70 | 71 | --------------------------------------------------------------------------- 72 | --------------------------------------------------------------------------- 73 | 74 | -------------------------------------------------------------------------------- /QPi/Terms.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | module QPi.Terms where 4 | 5 | open import Data.Nat using (ℕ; zero; suc) 6 | 7 | open import Pi.Types using (U; I; _×ᵤ_; 𝟚) 8 | open import Pi.Language as Π using (_⟷_) 9 | import Pi.Terms as ΠT 10 | 11 | open import QPi.Syntax 12 | 13 | --------------------------------------------------------------------------- 14 | 15 | private 16 | variable 17 | t t₁ t₂ : U 18 | 19 | --------------------------------------------------------------------------- 20 | -- Infrastructure for examples 21 | 22 | repeat : ℕ → (t ⇔ t) → (t ⇔ t) 23 | repeat 0 c = id⇔ 24 | repeat 1 c = c 25 | repeat (suc n@(suc _)) c = c >>> repeat n c 26 | 27 | map3*** : (t₁ ⇔ t₂) → ((t₁ ×ᵤ t₁ ×ᵤ t₁) ⇔ (t₂ ×ᵤ t₂ ×ᵤ t₂)) 28 | map3*** f = f *** f *** f 29 | 30 | map4*** : (t₁ ⇔ t₂) → ((t₁ ×ᵤ t₁ ×ᵤ t₁ ×ᵤ t₁) ⇔ (t₂ ×ᵤ t₂ ×ᵤ t₂ ×ᵤ t₂)) 31 | map4*** f = f *** f *** f *** f 32 | 33 | --------------------------------------------------------------------------- 34 | -- Examples 35 | 36 | -- Basic gates, states, and effects 37 | 38 | X H Z : 𝟚 ⇔ 𝟚 39 | X = arrZ Π.swap₊ 40 | H = arrϕ Π.swap₊ 41 | Z = H >>> X >>> H 42 | 43 | ctrlZ : (t ⟷ t) → 𝟚 ×ᵤ t ⇔ 𝟚 ×ᵤ t 44 | ctrlZ c = arrZ (ΠT.ctrl c) 45 | 46 | cx cz : 𝟚 ×ᵤ 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 47 | cx = ctrlZ Π.swap₊ 48 | cz = id⇔ *** H >>> cx >>> id⇔ *** H 49 | 50 | ccx : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 51 | ccx = arrZ ΠT.ccx 52 | 53 | one plus minus : I ⇔ 𝟚 54 | one = zero >>> X 55 | plus = zero >>> H 56 | minus = plus >>> Z 57 | 58 | assertOne assertPlus assertMinus : 𝟚 ⇔ I 59 | assertOne = X >>> assertZero 60 | assertPlus = H >>> assertZero 61 | assertMinus = Z >>> assertPlus 62 | 63 | {-- 64 | 65 | showAll X 66 | (𝕋 , (𝔽 , 1) ∷ []) ∷ 67 | (𝔽 , (𝕋 , 1) ∷ []) ∷ 68 | [] 69 | 70 | showAll H 71 | (𝕋 , (𝕋 , 0.7071067811706743) ∷ (𝔽 , 0.707106781202421) ∷ []) ∷ 72 | (𝔽 , (𝕋 , 0.707106781202421) ∷ (𝔽 , -0.7071067811706743) ∷ []) ∷ 73 | [] 74 | 75 | showAll cx 76 | ((𝕋 , 𝕋) , ((𝕋 , 𝔽) , 1) ∷ []) ∷ 77 | ((𝕋 , 𝔽) , ((𝕋 , 𝕋) , 1) ∷ []) ∷ 78 | ((𝔽 , 𝕋) , ((𝔽 , 𝕋) , 1) ∷ []) ∷ 79 | ((𝔽 , 𝔽) , ((𝔽 , 𝔽) , 1) ∷ []) ∷ 80 | [] 81 | 82 | --} 83 | 84 | -- Classical structures 85 | 86 | copyZ copyϕ : 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 87 | copyZ = uniti⋆r >>> (id⇔ *** zero) >>> cx 88 | copyϕ = H >>> copyZ >>> (H *** H) 89 | 90 | -- Simon 91 | 92 | cxGroup : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⟷ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 93 | cxGroup = Π.id⟷ 94 | 95 | simon : I ×ᵤ I ×ᵤ I ×ᵤ I ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 96 | simon = map4*** zero >>> 97 | H *** H *** id⇔ *** id⇔ >>> 98 | arrZ cxGroup >>> 99 | H *** H *** id⇔ *** id⇔ 100 | 101 | -- Grover 102 | 103 | amp : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 104 | amp = map3*** H >>> 105 | map3*** X >>> 106 | id⇔ *** id⇔ *** H >>> 107 | ccx >>> 108 | id⇔ *** id⇔ *** H >>> 109 | map3*** X >>> 110 | map3*** H 111 | 112 | u : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 113 | u = id⇔ *** id⇔ *** id⇔ 114 | 115 | -- Complex numbers 116 | -- ctrl S 117 | 118 | ctrlS : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⇔ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 119 | ctrlS = (id⇔ *** id⇔ *** H) >>> 120 | ccx >>> 121 | (id⇔ *** id⇔ *** H) >>> 122 | ccx 123 | 124 | {-- 125 | showAll ctrlS 126 | ((𝔽 , 𝔽 , 𝔽) , ((𝔽 , 𝔽 , 𝔽) , 1.0000000000000004) ∷ []) ∷ 127 | ((𝔽 , 𝔽 , 𝕋) , ((𝔽 , 𝔽 , 𝕋) , 1.0000000000000004) ∷ []) ∷ 128 | ((𝔽 , 𝕋 , 𝔽) , ((𝔽 , 𝕋 , 𝔽) , 1.0000000000000004) ∷ []) ∷ 129 | ((𝔽 , 𝕋 , 𝕋) , ((𝔽 , 𝕋 , 𝕋) , 1.0000000000000004) ∷ []) ∷ 130 | ((𝕋 , 𝔽 , 𝔽) , ((𝕋 , 𝔽 , 𝔽) , 1.0000000000000004) ∷ []) ∷ 131 | ((𝕋 , 𝔽 , 𝕋) , ((𝕋 , 𝔽 , 𝕋) , 1.0000000000000004) ∷ []) ∷ 132 | ((𝕋 , 𝕋 , 𝔽) , ((𝕋 , 𝕋 , 𝕋) , 1.0000000000000004) ∷ []) ∷ 133 | ((𝕋 , 𝕋 , 𝕋) , ((𝕋 , 𝕋 , 𝔽) , -1.0000000000000002) ∷ []) ∷ 134 | [] 135 | 136 | --} 137 | 138 | --------------------------------------------------------------------------- 139 | --------------------------------------------------------------------------- 140 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![DOI](https://zenodo.org/badge/595292039.svg)](https://zenodo.org/badge/latestdoi/595292039) 2 | # QuantumPi 3 | Code repository for our work on Quantum Pi "How to Bake a Quantum \Pi" 4 | 5 | Tested with Agda version 2.6.4.1, stdlib-2.0 and agda-categories 0.2.0. 6 | Things should work with 2.6.4.3 as well. Interactive versions have been 7 | tested with Emacs 27.2 (on Linux, MacOS and WSL). 8 | 9 | ## Source install 10 | You need to install Agda and stdlib-2.0. See 11 | [Agda installation](https://agda.readthedocs.io/en/latest/getting-started/installation.html) and [Library Management](https://agda.readthedocs.io/en/latest/tools/package-system.html) for the standard ways to do this. Warning: if you 12 | have not done this before, this can be quite finicky. Please seek the help 13 | of someone who has done it before. 14 | 15 | For the purposes of these instructions, we will assume as unix-like system 16 | (so any flavour of Linux, MacOS X or WSL on Windows) with command-line 17 | instructions. Although it appears possible to do things via Visual Studio, 18 | we have not tested this in any way. 19 | 20 | To check everything, simply do 21 | ``` 22 | make 23 | ``` 24 | (though this only really does) 25 | ``` 26 | agda Everything.agda 27 | ``` 28 | at the command line. This should take less than 30 seconds, where the 29 | bulk of the time will be spent checking `TestsSlow.agda`. 30 | 31 | ## Looking at the Code 32 | 33 | The best entry points is `Everything.agda` which gives a quick overview 34 | of what is all the files. The basic verification that we can indeed 35 | correctly interpret some quantum circuits are in the modules `Tests` 36 | and `TestsSlow`. 37 | -------------------------------------------------------------------------------- /Reasoning.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --allow-unsolved-metas #-} 2 | 3 | module Reasoning where 4 | 5 | open import Relation.Binary.Bundles using (Setoid) 6 | import Relation.Binary.Reasoning.Setoid as SetoidR 7 | 8 | open import Pi.Types using (U) 9 | open import Pi.Language as Π using (_◎_; _⟷_; id⟷; !⟷; _⊗_) 10 | import Pi.Terms as ΠT 11 | open import Pi.Equivalences 12 | open import Pi.DefinedEquiv using (xcx) 13 | open import QPi.Syntax 14 | open import QPi.Terms using (ctrlZ; one; copyZ; copyϕ; X; Z; 15 | H; minus; plus; cx; cz) 16 | open import QPi.Equivalences 17 | open import QPi.Measurement using (measureϕ; measureZ; fst; discard; discardL) 18 | open import QPi.TermReasoning 19 | using (begin_; _∎; step-≡; _⟩◎⟨id; id⟩◎⟨_; id⟩⊗⟨_; _⟩⊗⟨id; _◯_; _⟩⊗⟨_) 20 | 21 | --------------------------------------------------------------------------- 22 | -- Extra infrastructure, much of it inspired by agda-categories 23 | 24 | private 25 | variable 26 | t t₁ t₂ t₃ : U 27 | c c₁ c₂ c₃ c₄ : t₁ ⟷ t₂ 28 | d d₁ d₂ d₃ d₄ : t₁ ⇔ t₂ 29 | 30 | class*>R : arrZ c₁ *** arrZ c₂ >>> arrZ c₃ ≡ arrZ (c₁ Π.⊗ c₂ Π.◎ c₃) 31 | class*>R = arrZR* ⟩◎⟨id ◯ arrZR 32 | 33 | class*>L : arrZ (c₁ Π.⊗ c₂ Π.◎ c₃) ≡ arrZ c₁ *** arrZ c₂ >>> arrZ c₃ 34 | class*>L = arrZL ◯ arrZL* ⟩◎⟨id 35 | 36 | class>*R : arrZ c₁ >>> arrZ c₂ *** arrZ c₃ ≡ arrZ (c₁ Π.◎ c₂ Π.⊗ c₃) 37 | class>*R = id⟩◎⟨ arrZR* ◯ arrZR 38 | 39 | class>*L : arrZ (c₁ Π.◎ c₂ Π.⊗ c₃) ≡ arrZ c₁ >>> arrZ c₂ *** arrZ c₃ 40 | class>*L = arrZL ◯ id⟩◎⟨ arrZL* 41 | 42 | pullʳ : (d₁ >>> d₂ ≡ d₃) → (d >>> d₁) >>> d₂ ≡ d >>> d₃ 43 | pullʳ eq = assoc>>>r ◯ id⟩◎⟨ eq 44 | 45 | pullˡ : (d₁ >>> d₂ ≡ d₃) → d₁ >>> d₂ >>> d ≡ d₃ >>> d 46 | pullˡ eq = assoc>>>l ◯ eq ⟩◎⟨id 47 | 48 | cancelʳ : (d₁ >>> d₂ ≡ id⇔) → (d >>> d₁) >>> d₂ ≡ d 49 | cancelʳ inverse = pullʳ inverse ◯ idr>>>l 50 | 51 | cancelˡ : (d₁ >>> d₂ ≡ id⇔) → d₁ >>> (d₂ >>> d) ≡ d 52 | cancelˡ inverse = pullˡ inverse ◯ idl>>>l 53 | 54 | insertˡ : (d₁ >>> d₂ ≡ id⇔) → d ≡ d₁ >>> (d₂ >>> d) 55 | insertˡ inverse = !≡ (cancelˡ inverse) 56 | 57 | -- bifunctoriality of *** lets one sequence 58 | seq₂₁*** : d₁ *** d₂ ≡ (id⇔ *** d₂) >>> (d₁ *** id⇔) 59 | seq₂₁*** = idl>>>r ⟩⊗⟨ idr>>>r ◯ homR*** 60 | 61 | --------------------------------------------------------------------------- 62 | -- Example proofs 63 | 64 | xInv : (X >>> X) ≡ id⇔ 65 | xInv = begin 66 | X >>> X ≡⟨ arrZR ⟩ 67 | arrZ (Π.swap₊ ◎ Π.swap₊) ≡⟨ classicalZ linv◎l ⟩ 68 | arrZ id⟷ ≡⟨ arrZidL ⟩ 69 | id⇔ ∎ 70 | 71 | hadInv : (H >>> H) ≡ id⇔ 72 | hadInv = arrϕR ◯ classicalϕ linv◎l ◯ arrϕidL 73 | 74 | 1*HInv : (id⇔ {t₁} *** H) >>> (id⇔ *** H) ≡ id⇔ 75 | 1*HInv = homL*** ◯ idl>>>l ⟩⊗⟨ hadInv ◯ id***id 76 | 77 | minusZ≡plus : (minus >>> Z) ≡ plus 78 | minusZ≡plus = begin 79 | (minus >>> Z) 80 | ≡⟨ id≡ ⟩ 81 | ((plus >>> H >>> X >>> H) >>> H >>> X >>> H) 82 | ≡⟨ ((assoc>>>l ◯ assoc>>>l) ⟩◎⟨id ) ◯ pullʳ assoc>>>l ⟩ 83 | (((plus >>> H) >>> X) >>> (H >>> H) >>> X >>> H) 84 | ≡⟨ id⟩◎⟨ ((hadInv ⟩◎⟨id) ◯ idl>>>l) ⟩ 85 | (((plus >>> H) >>> X) >>> X >>> H) 86 | ≡⟨ pullʳ assoc>>>l ⟩ 87 | ((plus >>> H) >>> (X >>> X) >>> H) 88 | ≡⟨ id⟩◎⟨ (xInv ⟩◎⟨id ◯ idl>>>l) ⟩ 89 | ((plus >>> H) >>> H) 90 | ≡⟨ cancelʳ hadInv ⟩ 91 | plus ∎ 92 | 93 | oneMinusPlus : ((one *** minus) >>> cz) ≡ (one *** plus) 94 | oneMinusPlus = begin 95 | (one *** minus) >>> (id⇔ *** H) >>> cx >>> (id⇔ *** H) 96 | ≡⟨ assoc>>>l ◯ (homL*** ⟩◎⟨id) ⟩ 97 | ((one >>> id⇔) *** (minus >>> H)) >>> cx >>> (id⇔ *** H) 98 | ≡⟨ idr>>>l ⟩⊗⟨id ⟩◎⟨id ⟩ 99 | (one *** (minus >>> H))>>> cx >>> (id⇔ *** H) 100 | ≡⟨ idl>>>r ⟩⊗⟨ idr>>>r ⟩◎⟨id ⟩ 101 | ((id⇔ >>> one) *** ((minus >>> H) >>> id⇔)) >>> cx >>> (id⇔ *** H) 102 | ≡⟨ homR*** ⟩◎⟨id ◯ assoc>>>r ⟩ 103 | (id⇔ *** (minus >>> H)) >>> (one *** id⇔) >>> cx >>> (id⇔ *** H) 104 | ≡⟨ id⟩◎⟨ (assoc>>>l ◯ e3L ⟩◎⟨id) ⟩ 105 | (id⇔ *** (minus >>> H)) >>> (one *** X) >>> (id⇔ *** H) 106 | ≡⟨ id⟩◎⟨ (homL*** ◯ (idr>>>l ⟩⊗⟨id)) ⟩ 107 | (id⇔ *** (minus >>> H)) >>> (one *** (X >>> H)) 108 | ≡⟨ homL*** ◯ (idl>>>l ⟩⊗⟨ assoc>>>r ) ⟩ 109 | one *** (minus >>> H >>> X >>> H) 110 | ≡⟨ id⟩⊗⟨ minusZ≡plus ⟩ 111 | (one *** plus) ∎ 112 | 113 | 114 | xcxA : id⇔ *** X >>> cx ≡ cx >>> id⇔ *** X 115 | xcxA = begin 116 | id⇔ *** X >>> cx ≡⟨ arrZidR ⟩⊗⟨id ⟩◎⟨id ◯ class*>R ⟩ 117 | arrZ ((id⟷ Π.⊗ Π.swap₊) Π.◎ ΠT.cx) ≡⟨ classicalZ xcx ⟩ 118 | arrZ (ΠT.cx Π.◎ (id⟷ Π.⊗ Π.swap₊)) ≡⟨ class>*L ◯ id⟩◎⟨ arrZidL ⟩⊗⟨id ⟩ 119 | cx >>> id⇔ *** X ∎ 120 | 121 | zhcx : (id⇔ *** Z) >>> (id⇔ *** H) >>> cx ≡ cz >>> (id⇔ *** H) >>> (id⇔ *** X) 122 | zhcx = begin 123 | (id⇔ *** Z) >>> (id⇔ *** H) >>> cx 124 | ≡⟨ id≡ ⟩ 125 | (id⇔ *** (H >>> X >>> H)) >>> (id⇔ *** H) >>> cx 126 | ≡⟨ assoc>>>l ◯ (homL*** ◯ (idl>>>l ⟩⊗⟨id)) ⟩◎⟨id ⟩ 127 | (id⇔ *** ((H >>> X >>> H) >>> H)) >>> cx 128 | ≡⟨ id⟩⊗⟨ pullʳ (cancelʳ hadInv) ⟩◎⟨id ⟩ 129 | id⇔ *** (H >>> X) >>> cx 130 | ≡⟨ (idl>>>r ⟩⊗⟨id ◯ homR***) ⟩◎⟨id ◯ assoc>>>r ⟩ 131 | (id⇔ *** H) >>> (id⇔ *** X) >>> cx 132 | ≡⟨ id⟩◎⟨ xcxA ⟩ 133 | (id⇔ *** H) >>> cx >>> (id⇔ *** X) 134 | ≡⟨ id⟩◎⟨ id⟩◎⟨ insertˡ 1*HInv ⟩ 135 | (id⇔ *** H) >>> cx >>> (id⇔ *** H) >>> (id⇔ *** H) >>> (id⇔ *** X) 136 | ≡⟨ assoc>>>l ◯ assoc>>>l ◯ assoc>>>r ⟩◎⟨id ⟩ 137 | (id⇔ *** H >>> cx >>> id⇔ *** H) >>> (id⇔ *** H) >>> (id⇔ *** X) 138 | ≡⟨ id≡ ⟩ 139 | cz >>> (id⇔ *** H) >>> (id⇔ *** X) ∎ 140 | 141 | measure : measureϕ ≡ (H >>> measureZ >>> H) 142 | measure = begin 143 | measureϕ ≡⟨ id≡ ⟩ -- definition 144 | copyϕ >>> fst ≡⟨ id≡ ⟩ -- definitions 145 | (H >>> copyZ >>> (H *** H)) >>> (id⇔ *** discard) >>> unite⋆r 146 | ≡⟨ assoc>>>l ⟩◎⟨id ◯ assoc>>>r ◯ id⟩◎⟨ assoc>>>l ⟩ 147 | (H >>> copyZ) >>> ((H *** H) >>> (id⇔ *** discard)) >>> unite⋆r 148 | ≡⟨ id⟩◎⟨ homL*** ⟩◎⟨id ⟩ 149 | (H >>> copyZ) >>> ((H >>> id⇔) *** (H >>> discard)) >>> unite⋆r 150 | ≡⟨ id⟩◎⟨ idr>>>l ⟩⊗⟨ discardL H ⟩◎⟨id ⟩ 151 | (H >>> copyZ) >>> H *** discard >>> unite⋆r 152 | ≡⟨ id⟩◎⟨ seq₂₁*** ⟩◎⟨id ⟩ 153 | (H >>> copyZ) >>> (id⇔ *** discard >>> H *** id⇔) >>> unite⋆r 154 | ≡⟨ assoc>>>r ◯ id⟩◎⟨ (assoc>>>l ◯ assoc>>>l ⟩◎⟨id ◯ assoc>>>r) ⟩ 155 | H >>> (copyZ >>> id⇔ *** discard) >>> (H *** id⇔) >>> unite⋆r 156 | ≡⟨ id⟩◎⟨ id⟩◎⟨ uniter⋆≡r ⟩ 157 | H >>> (copyZ >>> id⇔ *** discard) >>> (unite⋆r >>> H) 158 | ≡⟨ id⟩◎⟨ (assoc>>>l ◯ assoc>>>r ⟩◎⟨id) ⟩ 159 | H >>> (copyZ >>> id⇔ *** discard >>> unite⋆r) >>> H 160 | ≡⟨ id≡ ⟩ 161 | (H >>> measureZ >>> H) ∎ 162 | 163 | --------------------------------------------------------------------------- 164 | 165 | -------------------------------------------------------------------------------- /SPi/Complementarity.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Complementarity equations 4 | 5 | module SPi.Complementarity where 6 | 7 | open import Relation.Binary.PropositionalEquality using (_≡_; refl) 8 | 9 | open import Pi.Types using (U) 10 | open import StatesAndEffects using (_↭_; _>>>>_; id; assocr×; _***_; swap; invSE) 11 | open import SPi.Terms using (copyZ; copyH) 12 | 13 | private 14 | variable 15 | t₁ t₂ : U 16 | 17 | ------------------------------------------------------------------------------------- 18 | -- complementarity equations 19 | 20 | -- Define this equivalence for display purposes, and hack it to be ≡ for now, 21 | -- until a proper equivalence can be defined. 22 | 23 | infix 4 _≈_ 24 | 25 | _≈_ : t₁ ↭ t₂ → t₁ ↭ t₂ → Set 26 | _≈_ x y = x ≡ y 27 | 28 | -- Just typecheck them 29 | eqZ₁ eqZ₂ eqZ₃ eqZ₄ : Set 30 | eqZ₁ = copyZ >>>> (id *** copyZ) ≈ copyZ >>>> (copyZ *** id) >>>> assocr× 31 | eqZ₂ = copyZ >>>> swap ≈ copyZ 32 | eqZ₃ = copyZ >>>> invSE copyZ ≈ id 33 | eqZ₄ = (copyZ *** id) >>>> (id *** copyZ) ≈ (id *** copyZ) >>>> (copyZ *** id) 34 | 35 | eqH₁ eqH₂ eqH₃ eqH₄ : Set 36 | eqH₁ = copyH >>>> (id *** copyH) ≈ copyH >>>> (copyH *** id) >>>> assocr× 37 | eqH₂ = copyH >>>> swap ≈ copyH 38 | eqH₃ = copyH >>>> invSE copyH ≈ id 39 | eqH₄ = (copyH *** id) >>>> (id *** copyH) ≈ (id *** copyH) >>>> (copyH *** id) 40 | 41 | eqZH : Set 42 | eqZH = (copyZ *** id) >>>> (id *** (invSE copyH)) >>>> (id *** copyH) >>>> ((invSE copyZ) *** id) ≈ id 43 | 44 | ------------------------------------------------------------------------------------- 45 | ------------------------------------------------------------------------------------- 46 | -------------------------------------------------------------------------------- /SPi/Terms.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Defining various terms over the StatesAndEffects version of Pi 4 | 5 | module SPi.Terms where 6 | 7 | open import Data.Maybe using (nothing) 8 | open import Relation.Binary.PropositionalEquality using (_≡_; refl) 9 | 10 | open import Pi.Types using (U; I; _+ᵤ_; _×ᵤ_; 𝟚) 11 | open import Pi.Language using (_⟷_; !⟷) 12 | open import Ancillae 13 | open import Amalgamation using (module Build) 14 | open Build (_⟷_) using (TList; cons₁) 15 | import ArrowsOverAmalg as A 16 | open A using (_>>>_) 17 | import Arrows.Terms as AT 18 | open import StatesAndEffects 19 | 20 | ------------------------------------------------------------------------------------- 21 | private 22 | variable 23 | t t₁ t₂ t₃ t₄ : U 24 | 25 | ------------------------------------------------------------------------------------- 26 | -- Example terms 27 | 28 | -- Sanity check 29 | inv0 : invSE zero ≡ assertZero 30 | inv0 = refl 31 | 32 | -- Additional combinators for complementarity 33 | 34 | X : (t₁ +ᵤ t₂) ↭ (t₂ +ᵤ t₁) 35 | X = arr AT.X 36 | 37 | CX : (𝟚 ×ᵤ 𝟚) ↭ (𝟚 ×ᵤ 𝟚) 38 | CX = arr AT.CX 39 | 40 | CCX : (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) ↭ (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) 41 | CCX = arr AT.CCX 42 | 43 | H : (t₁ +ᵤ t₂) ↭ (t₂ +ᵤ t₁) 44 | H = arr AT.H 45 | 46 | Z : (t₁ +ᵤ t₂) ↭ (t₂ +ᵤ t₁) 47 | Z = arr AT.Z 48 | 49 | CZ : (𝟚 ×ᵤ 𝟚) ↭ (𝟚 ×ᵤ 𝟚) 50 | CZ = arr AT.CZ 51 | 52 | copyZ : 𝟚 ↭ (𝟚 ×ᵤ 𝟚) 53 | copyZ = uniti* >>>> id *** zero >>>> CX 54 | 55 | copyH : 𝟚 ↭ (𝟚 ×ᵤ 𝟚) 56 | copyH = H >>>> copyZ >>>> H *** H 57 | 58 | -- Special states and effects 59 | 60 | one : I ↭ 𝟚 61 | one = zero >>>> X 62 | plus : I ↭ 𝟚 63 | plus = zero >>>> H 64 | minus : I ↭ 𝟚 65 | minus = plus >>>> Z 66 | 67 | assertOne : 𝟚 ↭ I 68 | assertOne = X >>>> assertZero 69 | assertPlus : 𝟚 ↭ I 70 | assertPlus = H >>>> assertZero 71 | assertMinus : 𝟚 ↭ I 72 | assertMinus = Z >>>> assertZero 73 | 74 | ------------------------------------------------------------------------------------- 75 | ------------------------------------------------------------------------------------- 76 | -------------------------------------------------------------------------------- /Simon.agda: -------------------------------------------------------------------------------- 1 | 2 | {-# OPTIONS --without-K --exact-split --safe #-} 3 | 4 | module Simon where 5 | 6 | open import Pi.Types 7 | open import Pi.Language 8 | open import Pi.Equational 9 | open import Pi.Terms 10 | import ArrowsOverAmalg as A 11 | open import StatesAndEffects 12 | 13 | private 14 | variable 15 | t t₁ t₂ t₃ t₄ : U 16 | 17 | -- Simon fragments 18 | 19 | A[B[CD]]→[AC][BD] : t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟷ (t₁ ×ᵤ t₃) ×ᵤ (t₂ ×ᵤ t₄) 20 | A[B[CD]]→[AC][BD] {t₁} {t₂} {t₃} {t₄} = begin 21 | t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟨ id⟷ ⊗ assocl⋆ ⟩ 22 | t₁ ×ᵤ (t₂ ×ᵤ t₃) ×ᵤ t₄ ⟨ id⟷ ⊗ swap⋆ ⊗ id⟷ ⟩ 23 | t₁ ×ᵤ (t₃ ×ᵤ t₂) ×ᵤ t₄ ⟨ id⟷ ⊗ assocr⋆ ⟩ 24 | t₁ ×ᵤ t₃ ×ᵤ (t₂ ×ᵤ t₄) ⟨ assocl⋆ ⟩ 25 | (t₁ ×ᵤ t₃) ×ᵤ (t₂ ×ᵤ t₄) ∎ 26 | 27 | A[B[CD]]→[AD][BC] : t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟷ (t₁ ×ᵤ t₄) ×ᵤ (t₂ ×ᵤ t₃) 28 | A[B[CD]]→[AD][BC] {t₁} {t₂} {t₃} {t₄} = begin 29 | t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟨ id⟷ ⊗ assocl⋆ ⟩ 30 | t₁ ×ᵤ (t₂ ×ᵤ t₃) ×ᵤ t₄ ⟨ id⟷ ⊗ swap⋆ ⟩ 31 | t₁ ×ᵤ t₄ ×ᵤ (t₂ ×ᵤ t₃) ⟨ assocl⋆ ⟩ 32 | (t₁ ×ᵤ t₄) ×ᵤ (t₂ ×ᵤ t₃) ∎ 33 | 34 | A[B[CD]]→[BC][AD] : t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟷ (t₂ ×ᵤ t₃) ×ᵤ (t₁ ×ᵤ t₄) 35 | A[B[CD]]→[BC][AD] {t₁} {t₂} {t₃} {t₄} = begin 36 | t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟨ id⟷ ⊗ assocl⋆ ⟩ 37 | t₁ ×ᵤ (t₂ ×ᵤ t₃) ×ᵤ t₄ ⟨ id⟷ ⊗ swap⋆ ⟩ 38 | t₁ ×ᵤ t₄ ×ᵤ (t₂ ×ᵤ t₃) ⟨ assocl⋆ ⟩ 39 | (t₁ ×ᵤ t₄) ×ᵤ (t₂ ×ᵤ t₃) ⟨ swap⋆ ⟩ 40 | (t₂ ×ᵤ t₃) ×ᵤ (t₁ ×ᵤ t₄) ∎ 41 | 42 | A[B[CD]]→[BD][AC] : t₁ ×ᵤ (t₂ ×ᵤ (t₃ ×ᵤ t₄)) ⟷ (t₂ ×ᵤ t₄) ×ᵤ (t₁ ×ᵤ t₃) 43 | A[B[CD]]→[BD][AC] {t₁} {t₂} {t₃} {t₄} = A[B[CD]]→[AC][BD] ◎ swap⋆ 44 | 45 | [AC][BD]→[AD][BC] : {t₁ t₂ t₃ t₄ : U} → (t₁ ×ᵤ t₃) ×ᵤ (t₂ ×ᵤ t₄) ⟷ (t₁ ×ᵤ t₄) ×ᵤ (t₂ ×ᵤ t₃) 46 | [AC][BD]→[AD][BC] {t₁} {t₂} {t₃} {t₄} = begin 47 | (t₁ ×ᵤ t₃) ×ᵤ (t₂ ×ᵤ t₄) ⟨ assocr⋆ ⟩ 48 | t₁ ×ᵤ (t₃ ×ᵤ (t₂ ×ᵤ t₄)) ⟨ id⟷ ⊗ assocl⋆ ⟩ 49 | t₁ ×ᵤ ((t₃ ×ᵤ t₂) ×ᵤ t₄) ⟨ id⟷ ⊗ swap⋆ ⟩ 50 | t₁ ×ᵤ (t₄ ×ᵤ (t₃ ×ᵤ t₂)) ⟨ assocl⋆ ⟩ 51 | (t₁ ×ᵤ t₄) ×ᵤ (t₃ ×ᵤ t₂) ⟨ id⟷ ⊗ swap⋆ ⟩ 52 | (t₁ ×ᵤ t₄) ×ᵤ (t₂ ×ᵤ t₃) ∎ 53 | 54 | -- The 2 Hadamard gates 55 | simon₁ : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⟷ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 56 | simon₁ = swap₊ ⊗ swap₊ ⊗ id⟷ ⊗ id⟷ 57 | 58 | -- The core of the circuit 59 | simon₂ : 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⟷ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 60 | simon₂ = 61 | A[B[CD]]→[AC][BD] ◎ (cx ⊗ id⟷) ◎ 62 | [AC][BD]→[AD][BC] ◎ (cx ⊗ id⟷) ◎ -- swap⋆ to do [AD][BC]→[BC][AD] 63 | swap⋆ ◎ (cx ⊗ id⟷) ◎ 64 | -- up to renaming, [AC][BD]→[AD][BC] does the same as [BC][AD]→[BD][AC] 65 | [AC][BD]→[AD][BC] ◎ (cx ⊗ id⟷) ◎ !⟷ A[B[CD]]→[BD][AC] 66 | 67 | {-- 68 | 69 | 1 -> unit intro 70 | 1 x 1 x 1 x 1 -> zero 71 | 2 x 2 x 2 x 2 -> simon1 ; simon2 ; simon1 72 | 73 | --} 74 | 75 | simon : I ↭ (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) 76 | simon = 77 | arr (A.uniti*l A.>>> 78 | A.id A.*** A.uniti*l A.>>> 79 | A.id A.*** (A.id A.*** A.uniti*l)) >>>> 80 | 81 | (zero *** (zero *** (zero *** zero))) >>>> 82 | 83 | arr (A.arr₂ simon₁ A.>>> 84 | A.arr₁ simon₂ A.>>> 85 | A.arr₂ simon₁) 86 | 87 | 88 | -------------------------------------------------------------------------------- /StatesAndEffects.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Lifting an abstract list over a pair of representations. 4 | 5 | module StatesAndEffects where 6 | 7 | open import Data.Maybe using (nothing) 8 | 9 | open import Pi.Types using (U;I; _+ᵤ_; _×ᵤ_) 10 | open import Pi.Language using (_⟷_; !⟷) 11 | open import Ancillae using (N; N⇒U; a*; unpack) 12 | open import Amalgamation using (module Build) 13 | open Build (_⟷_) using (TList; cons₁) 14 | import ArrowsOverAmalg as A 15 | open A using (_>>>_) 16 | 17 | ------------------------------------------------------------------------------------- 18 | private 19 | variable 20 | t t₁ t₂ t₃ t₄ : U 21 | 22 | infixr 30 _↭_ 23 | 24 | -- Lifting an abstract pair 25 | data _↭_ : U → U → Set where 26 | lift : {n₁ n₂ : N} → TList (t₁ ×ᵤ N⇒U n₁) (t₂ ×ᵤ N⇒U n₂) → t₁ ↭ t₂ 27 | 28 | -- And now define the rest of the language 29 | -- lifting: 30 | arr : TList t₁ t₂ → t₁ ↭ t₂ 31 | arr c = lift {n₁ = nothing} {nothing} (A.unite* >>> c >>> A.uniti*) 32 | 33 | -- Then use that to lift id, swap, assoc and unit 34 | id : t ↭ t 35 | id = arr A.id 36 | swap : (t₁ ×ᵤ t₂) ↭ (t₂ ×ᵤ t₁) 37 | swap = arr A.swap× 38 | assocl× : (t₁ ×ᵤ (t₂ ×ᵤ t₃)) ↭ ((t₁ ×ᵤ t₂) ×ᵤ t₃) 39 | assocl× = arr A.assocl× 40 | assocr× : ((t₁ ×ᵤ t₂) ×ᵤ t₃) ↭ (t₁ ×ᵤ (t₂ ×ᵤ t₃)) 41 | assocr× = arr A.assocr× 42 | unite*l : (I ×ᵤ t) ↭ t 43 | unite*l = arr A.unite*l 44 | uniti*l : t ↭ (I ×ᵤ t) 45 | uniti*l = arr A.uniti*l 46 | unite* : (t ×ᵤ I) ↭ t 47 | unite* = arr A.unite* 48 | uniti* : t ↭ (t ×ᵤ I) 49 | uniti* = arr A.uniti* 50 | 51 | -- >>>> composition. 52 | -- Note how we have to unpack & pack up the ancillas 53 | -- This is needed to move between the types (and elided in the paper version) 54 | infixr 10 _>>>>_ 55 | _>>>>_ : t₁ ↭ t₂ → t₂ ↭ t₃ → t₁ ↭ t₃ 56 | lift {n₁ = n₁} {n₂} m >>>> lift {n₁ = n₃} {n₄} p = 57 | lift {n₁ = a* n₁ n₃} {a* n₄ n₂} 58 | (A.second (A.arr₁ (unpack n₁ n₃)) >>> 59 | A.assocl× >>> 60 | A.first m >>> 61 | A.assocr× >>> 62 | A.second A.swap× >>> 63 | A.assocl× >>> 64 | A.first p >>> 65 | A.assocr× >>> 66 | A.second (A.arr₁ (!⟷ (unpack n₄ n₂))) 67 | ) 68 | 69 | -- first 70 | -- Note how we don't use >>> twice, as that would do 2 full traversals 71 | firstSE : t₁ ↭ t₂ → (t₁ ×ᵤ t₃) ↭ (t₂ ×ᵤ t₃) 72 | firstSE (lift m) = lift 73 | (A.assocr× >>> 74 | A.second A.swap× >>> 75 | A.assocl× >>> 76 | A.first m >>> 77 | A.assocr× >>> 78 | A.second A.swap× >>> 79 | A.assocl× 80 | ) 81 | 82 | -- second and *** 83 | secondSE : t₁ ↭ t₂ → (t₃ ×ᵤ t₁) ↭ (t₃ ×ᵤ t₂) 84 | -- it is inefficient to do 3 passes, but quite difficult to do otherwise 85 | -- as the swaps are needed. 86 | secondSE c = swap >>>> firstSE c >>>> swap 87 | 88 | -- This is likewise inefficient 89 | _***_ : t₁ ↭ t₂ → t₃ ↭ t₄ → (t₁ ×ᵤ t₃) ↭ (t₂ ×ᵤ t₄) 90 | xs *** ys = firstSE xs >>>> secondSE ys 91 | 92 | -- inverse 93 | invSE : t₁ ↭ t₂ → t₂ ↭ t₁ 94 | invSE (lift m) = lift (A.inv m) 95 | 96 | -- The two fundamental pieces, the zero state and the assertZero effect: 97 | zero : I ↭ (I +ᵤ I) 98 | zero = lift A.swap× 99 | 100 | assertZero : (I +ᵤ I) ↭ I 101 | assertZero = lift A.swap× 102 | 103 | ------------------------------------------------------------------------------------- 104 | ------------------------------------------------------------------------------------- 105 | -------------------------------------------------------------------------------- /Tests.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --safe #-} 2 | 3 | --Note: not exact-split here, that's too much of a pain 4 | module Tests where 5 | 6 | open import Data.Float as F using (Float) 7 | open import Data.List using (List; _∷_; []; map) 8 | open import Data.Product using (_×_; _,_) 9 | open import Data.Sum using (inj₁; inj₂) 10 | open import Data.Unit using (tt) 11 | open import Function.Base using (_∘_) 12 | open import Relation.Binary.PropositionalEquality using (_≡_; refl) 13 | 14 | open import Pi.Types 15 | open import Pi.Language using (_⟷_; id⟷; swap₊; _⊗_) 16 | open import Amalgamation using (module Build) 17 | open Build (_⟷_) using (TList) 18 | import ArrowsOverAmalg as A 19 | import Arrows.Terms as AT 20 | open import StatesAndEffects using (_↭_; _>>>>_; zero; assertZero) 21 | open import SPi.Terms using (CX; plus; minus; one) 22 | open import Unitary renaming (module Build to UBuild) 23 | open import PiZ using (module MkPiZ) 24 | open import PiH using (module MkPiH) 25 | open import Instances using (evalTL₁; evalSE) 26 | open import Simon using (simon₁; simon₂) 27 | open import Float.LASig using (FloatVec) 28 | open import Float.RotMat using (Rot) 29 | 30 | module PH = MkPiH FloatVec Rot 31 | module PZ = MkPiZ FloatVec 32 | open UBuild FloatVec Rot using (R; R⁻¹) 33 | 34 | --------------------------------------------------------------------------------------- 35 | -- Infrastructure for testing 36 | 37 | show : {t : U} → (⟦ t ⟧ → Float) → List (⟦ t ⟧ × Float) 38 | show {t} v = map (λ i → (i , v i)) (enum t) 39 | 40 | -- Note: these tests are EVIL because they use the most brutal equality possible on the worst thing imaginable, i.e. Floats. 41 | 42 | -- Test things in Amalgamated language 43 | test-notH : show (evalTL₁ AT.H PH.trueH) ≡ (𝔽 , 0.9238795325155821) ∷ (𝕋 , -0.38268343235472) ∷ [] 44 | test-notH = refl 45 | 46 | test-id : show (evalTL₁ (A.id) PH.trueH) ≡ (𝔽 , 0.38268343235472) ∷ (𝕋 , 0.9238795325155821) ∷ [] 47 | test-id = refl 48 | 49 | test-Had-true : show (evalTL₁ AT.H PZ.trueZ) ≡ (𝔽 , 0.707106781202421) ∷ (𝕋 , -0.7071067811706743) ∷ [] 50 | test-Had-true = refl 51 | 52 | test-Had-false : show (evalTL₁ AT.H PZ.falseZ) ≡ (𝔽 , 0.7071067811706743) ∷ (𝕋 , 0.707106781202421) ∷ [] 53 | test-Had-false = refl 54 | 55 | test-vec2 : ⟦ 𝟚 ×ᵤ 𝟚 ⟧ → Float 56 | test-vec2 (𝕋 , 𝕋) = 1.0 57 | test-vec2 (𝕋 , 𝔽) = 0.0 58 | test-vec2 (𝔽 , 𝕋) = 0.0 59 | test-vec2 (𝔽 , 𝔽) = 0.0 60 | 61 | test-cxZ : show (evalTL₁ AT.CX test-vec2) ≡ 62 | ((𝔽 , 𝔽) , 0.0) ∷ 63 | ((𝔽 , 𝕋) , 0.0) ∷ 64 | ((𝕋 , 𝔽) , 1.0) ∷ 65 | ((𝕋 , 𝕋) , 0.0) ∷ 66 | [] 67 | test-cxZ = refl 68 | 69 | test-SE-cxZ = 70 | show (evalSE CX test-vec2) 71 | 72 | test-Had2-00 : show ((R⁻¹ (𝟚 ×ᵤ 𝟚) ∘ PZ.evalZ (id⟷ ⊗ swap₊) ∘ R (𝟚 ×ᵤ 𝟚)) test-vec2) ≡ 73 | ((𝔽 , 𝔽) , -1.1102230246251565e-16) ∷ 74 | ((𝔽 , 𝕋) , 0.0) ∷ 75 | ((𝕋 , 𝔽) , 0.707106781202421) ∷ 76 | ((𝕋 , 𝕋) , -0.7071067811706743) ∷ [] 77 | test-Had2-00 = refl 78 | 79 | test-Had2-0 : show (PH.evalH (id⟷ ⊗ swap₊) test-vec2) ≡ 80 | ((𝔽 , 𝔽) , -1.1102230246251565e-16) ∷ 81 | ((𝔽 , 𝕋) , 0.0) ∷ 82 | ((𝕋 , 𝔽) , 0.707106781202421) ∷ 83 | ((𝕋 , 𝕋) , -0.7071067811706743) ∷ 84 | [] 85 | test-Had2-0 = refl 86 | 87 | test-Had2-1 : show (evalTL₁ (A.id A.*** AT.H) test-vec2) ≡ 88 | ((𝔽 , 𝔽) , -1.1102230246251565e-16) ∷ 89 | ((𝔽 , 𝕋) , 0.0) ∷ 90 | ((𝕋 , 𝔽) , 0.707106781202421) ∷ 91 | ((𝕋 , 𝕋) , -0.7071067811706743) ∷ 92 | [] 93 | test-Had2-1 = refl 94 | 95 | test-Had2-2 : show (evalTL₁ (AT.X A.*** A.id) test-vec2) ≡ 96 | ((𝔽 , 𝔽) , 0.0) ∷ ((𝔽 , 𝕋) , 1.0) ∷ 97 | ((𝕋 , 𝔽) , 0.0) ∷ ((𝕋 , 𝕋) , 0.0) ∷ [] 98 | test-Had2-2 = refl 99 | 100 | test-Had2-3 : show (evalTL₁ (AT.H A.*** A.id) test-vec2) ≡ 101 | ((𝔽 , 𝔽) , 0.0) ∷ 102 | ((𝔽 , 𝕋) , 0.7071067812024212) ∷ 103 | ((𝕋 , 𝔽) , 0.0) ∷ 104 | ((𝕋 , 𝕋) , -0.7071067811706744) ∷ 105 | [] 106 | test-Had2-3 = refl 107 | 108 | inner-simon : TList (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) (𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚) 109 | inner-simon = A.arr₂ simon₁ A.>>> A.arr₁ simon₂ A.>>> A.arr₂ simon₁ 110 | 111 | test-vec4 : ⟦ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ×ᵤ 𝟚 ⟧ → Float 112 | test-vec4 (inj₁ _ , inj₁ _ , inj₁ _ , inj₁ _) = 1.0 113 | test-vec4 (_ , _ , _ , _) = 0.0 114 | 115 | -- the first part of Simon "works" decently now 116 | test-s₁ : show (evalTL₁ (A.arr₂ simon₁) test-vec4) ≡ 117 | ((𝔽 , 𝔽 , 𝔽 , 𝔽) , 0.49999999997755185) ∷ 118 | ((𝔽 , 𝔽 , 𝔽 , 𝕋) , 1.6348909148276115e-17) ∷ 119 | ((𝔽 , 𝔽 , 𝕋 , 𝔽) , 2.7755575614747768e-17) ∷ 120 | ((𝔽 , 𝔽 , 𝕋 , 𝕋) , -2.2893051763283195e-17) ∷ 121 | ((𝔽 , 𝕋 , 𝔽 , 𝔽) , 0.5) ∷ 122 | ((𝔽 , 𝕋 , 𝔽 , 𝕋) , 2.0237652028100054e-17) ∷ 123 | ((𝔽 , 𝕋 , 𝕋 , 𝔽) , 3.925231146709438e-17) ∷ 124 | ((𝔽 , 𝕋 , 𝕋 , 𝕋) , -2.1659708620061032e-17) ∷ 125 | ((𝕋 , 𝔽 , 𝔽 , 𝔽) , 0.5) ∷ 126 | ((𝕋 , 𝔽 , 𝔽 , 𝕋) , 2.0237652028100058e-17) ∷ 127 | ((𝕋 , 𝔽 , 𝕋 , 𝔽) , 3.925231146709438e-17) ∷ 128 | ((𝕋 , 𝔽 , 𝕋 , 𝕋) , -2.165970862006103e-17) ∷ 129 | ((𝕋 , 𝕋 , 𝔽 , 𝔽) , 0.5000000000224483) ∷ 130 | ((𝕋 , 𝕋 , 𝔽 , 𝕋) , 2.807041067731488e-17) ∷ 131 | ((𝕋 , 𝕋 , 𝕋 , 𝔽) , 2.7755575616510065e-17) ∷ 132 | ((𝕋 , 𝕋 , 𝕋 , 𝕋) , -3.3059056140334115e-17) ∷ [] 133 | test-s₁ = refl 134 | 135 | --------------------------------------------------------------------- 136 | -- Tests of effectful language 137 | 138 | <0|0> <0|+> <0|-> <0|1> : I ↭ I 139 | <0|0> = zero >>>> assertZero 140 | <0|+> = plus >>>> assertZero 141 | <0|-> = minus >>>> assertZero 142 | <0|1> = one >>>> assertZero 143 | 144 | -- Simple tests 145 | |0> : show (evalSE zero (λ tt → 1.0)) ≡ 146 | (𝔽 , 1.0) ∷ (𝕋 , 0.0) ∷ [] 147 | |0> = refl 148 | 149 | |1> : show (evalSE one (λ tt → 1.0)) ≡ 150 | (𝔽 , 0.0) ∷ (𝕋 , 1.0) ∷ [] 151 | |1> = refl 152 | 153 | <0| : show (evalSE assertZero λ {(inj₁ _) → 0.4; (inj₂ _) → 0.916}) ≡ (tt , 0.4) ∷ [] 154 | <0| = refl 155 | 156 | <0|0>≡1 : show (evalSE <0|0> (λ tt → 1.0)) ≡ (tt , 1.0) ∷ [] 157 | <0|0>≡1 = refl 158 | 159 | <0|+>≡1 : show (evalSE <0|+> (λ tt → 1.0)) ≡ (tt , 0.7071067811706743) ∷ [] 160 | <0|+>≡1 = refl 161 | 162 | <0|->≡1 : show (evalSE <0|-> (λ tt → 1.0)) ≡ (tt , 0.7071067812024211) ∷ [] 163 | <0|->≡1 = refl 164 | 165 | <0|1>≡1 : show (evalSE <0|1> (λ tt → 1.0)) ≡ (tt , 0.0) ∷ [] 166 | <0|1>≡1 = refl 167 | 168 | --------------------------------------------------------------------------------------- 169 | --------------------------------------------------------------------------------------- 170 | -------------------------------------------------------------------------------- /TestsSlow.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --safe #-} 2 | 3 | --Note: not exact-split here, that's too much of a pain 4 | module TestsSlow where 5 | 6 | open import Data.Float using (Float) 7 | open import Data.List using (_∷_; []) 8 | open import Data.Product using (_,_) 9 | open import Relation.Binary.PropositionalEquality using (_≡_; refl) 10 | 11 | open import Pi.Types using (𝕋; 𝔽) 12 | open import Instances using (evalTL₁) 13 | open import Tests using (inner-simon; test-vec4; show) 14 | 15 | -- takes ~22s on my MacBook Air 16 | -- indentation used to highlight real values from virtual 0s 17 | test-is : show (evalTL₁ inner-simon test-vec4) ≡ 18 | ((𝔽 , 𝔽 , 𝔽 , 𝔽) , 0.5000000000000001) ∷ 19 | ((𝔽 , 𝔽 , 𝔽 , 𝕋) , 4.738173134873553e-17) ∷ 20 | ((𝔽 , 𝔽 , 𝕋 , 𝔽) , 4.5106981034918784e-17) ∷ 21 | ((𝔽 , 𝔽 , 𝕋 , 𝕋) , 0.5000000000000001) ∷ 22 | ((𝔽 , 𝕋 , 𝔽 , 𝔽) , -2.24482377131352e-11) ∷ 23 | ((𝔽 , 𝕋 , 𝔽 , 𝕋) , 3.350394354180222e-17) ∷ 24 | ((𝔽 , 𝕋 , 𝕋 , 𝔽) , 1.8013739550477034e-17) ∷ 25 | ((𝔽 , 𝕋 , 𝕋 , 𝕋) , 2.244829322428643e-11) ∷ 26 | ((𝕋 , 𝔽 , 𝔽 , 𝔽) , -2.2448209957559584e-11) ∷ 27 | ((𝕋 , 𝔽 , 𝔽 , 𝕋) , 5.7483679261733055e-18) ∷ 28 | ((𝕋 , 𝔽 , 𝕋 , 𝔽) , 5.1923354385602495e-18) ∷ 29 | ((𝕋 , 𝔽 , 𝕋 , 𝕋) , 2.24482377131352e-11) ∷ 30 | ((𝕋 , 𝕋 , 𝔽 , 𝔽) , 0.5000000000000002) ∷ 31 | ((𝕋 , 𝕋 , 𝔽 , 𝕋) , 8.129419882522301e-18) ∷ 32 | ((𝕋 , 𝕋 , 𝕋 , 𝔽) , -1.7351405419289864e-17) ∷ 33 | ((𝕋 , 𝕋 , 𝕋 , 𝕋) , -0.5000000000000001) ∷ [] 34 | test-is = refl 35 | -------------------------------------------------------------------------------- /Unitary.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K --exact-split --safe #-} 2 | 3 | -- Define Unitary and a particular automorphism 4 | 5 | module Unitary where 6 | 7 | open import Data.Product using (_,_) 8 | open import Data.Sum using (inj₁; inj₂) 9 | open import Function using (_∘_; id) 10 | 11 | open import LinearAlgebraSig using (LASig) 12 | open import AbstractRotation using (RotMat) 13 | open import Pi.Types using (U; O; I; _+ᵤ_; _×ᵤ_; ⟦_⟧) 14 | 15 | UVec : (L : LASig) (t : U) → Set 16 | UVec L t = LASig.vec L ⟦ t ⟧ 17 | 18 | module Build (L : LASig) (RM : RotMat L) where 19 | open LASig L using (vec; aut; _⊕_; _⊗_) 20 | open RotMat RM 21 | 22 | -- Family R from Definition 6 in Section 4.3 23 | -- It is more complicated here because inequations are not constructive. 24 | -- Note that we use v below to choose which *row* we're in. 25 | -- This definition also assumes 'x' is in normal form, i.e. contains no 26 | -- occurences of "O +ᵤ _", "I ×ᵤ _" (or its symmetric form). 27 | R : (x : U) → aut ⟦ x ⟧ 28 | R O = id 29 | R I = id 30 | R (O +ᵤ y) = R O ⊕ R y 31 | R (I +ᵤ O) = R I ⊕ R O 32 | R (I +ᵤ I) = Rω 33 | R (I +ᵤ z@(y +ᵤ y′)) = R I ⊕ R z 34 | R (I +ᵤ z@(y ×ᵤ y′)) = R I ⊕ R z 35 | R (z@(x +ᵤ x′) +ᵤ y) = R z ⊕ R y 36 | R (z@(x ×ᵤ x′) +ᵤ y) = R z ⊕ R y 37 | R (x ×ᵤ y) = R x ⊗ R y 38 | 39 | -- Simpler to define R⁻¹ explicitly 40 | R⁻¹ : (x : U) → aut ⟦ x ⟧ 41 | R⁻¹ O = id 42 | R⁻¹ I = id 43 | R⁻¹ (O +ᵤ y) = R⁻¹ O ⊕ R⁻¹ y 44 | R⁻¹ (I +ᵤ O) = R⁻¹ I ⊕ R⁻¹ O 45 | R⁻¹ (I +ᵤ I) = Rω⁻¹ 46 | R⁻¹ (I +ᵤ z@(y +ᵤ y′)) = R⁻¹ I ⊕ R⁻¹ z 47 | R⁻¹ (I +ᵤ z@(y ×ᵤ y′)) = R⁻¹ I ⊕ R⁻¹ z 48 | R⁻¹ (z@(x +ᵤ x′) +ᵤ y) = R⁻¹ z ⊕ R⁻¹ y 49 | R⁻¹ (z@(x ×ᵤ x′) +ᵤ y) = R⁻¹ z ⊕ R⁻¹ y 50 | R⁻¹ (x ×ᵤ y) = R⁻¹ x ⊗ R⁻¹ y 51 | --------------------------------------------------------------------------------