diff --git a/.github/workflows/coq-action.yml b/.github/workflows/coq-action.yml index 3c94d09..e984264 100644 --- a/.github/workflows/coq-action.yml +++ b/.github/workflows/coq-action.yml @@ -15,14 +15,16 @@ jobs: - '8.14' - '8.15' - '8.16' + - '8.17' - 'dev' ocaml_version: - 'default' fail-fast: false # don't stop jobs if one fails steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - uses: coq-community/docker-coq-action@v1 with: + opam_file: 'coq-vyzx.opam' before_install: | startGroup "Print opam config" opam pin -y coq-sqir https://github.com/inQWIRE/SQIR.git; diff --git a/.hooks/Name_validator.py b/.hooks/Name_validator.py index 43deea9..9438a9f 100755 --- a/.hooks/Name_validator.py +++ b/.hooks/Name_validator.py @@ -30,7 +30,7 @@ curr_dir = os.path.dirname(os.path.realpath(__file__)) src_dir = f"{curr_dir}/../src" -thm_token = "Theorem|Lemma|Fact|Remark|Corollary|Proposition|Property" +thm_token = "Theorem|Lemma|Fact|Remark|Corollary|Proposition|Property|Variable|Hypothesis" def_token = "Definition|Fixpoint|Inductive|Example" exists_thm_regex = re.compile(f".*({thm_token}|{def_token})\\s*(([a-z]|[A-Z]|_)([a-z]|[A-Z]|_|-|\\d)+)") def_name_ignore_regex = re.compile("\\s*\\(\\*\\s*\\@nocheck\\s+name\\s*\\*\\)") @@ -100,11 +100,14 @@ def replace_in_all(self, files : list[str], change_to : (str | None) = None): with open(file, "w") as f: f.write(content) - def ignore(self): + def ignore(self, reason : str): with open(self.file, "r") as f: lines = f.readlines() - lines.insert(self.line_no - 1, "(* @nocheck name *)\n") + insertion = "(* @nocheck name *)\n" + if len(reason.strip()) > 0: + insertion += f"(* {reason} *)\n" + lines.insert(self.line_no - 1, insertion) with open(self.file, "w") as f: lines = "".join(lines) @@ -191,7 +194,8 @@ def check_file_name(file_name : str, file_path : str) -> (Violation | None): violation.replace_in_all(all_files, change_to) break elif option == "i": - violation.ignore() + reason = input("Please type in the reason for ignoring (for documentation): ") + violation.ignore(reason) break elif option == "s": break diff --git a/README.md b/README.md index 3760722..c5c906c 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ Verifying the ZX Calculus ## Building VyZX -Tested with Coq 8.13-8.16. +Tested with Coq 8.14-8.16. First, install [QuantumLib](https://github.com/inQWIRE/QuantumLib) through opam. diff --git a/src/.Old/ComplexSemantics.v b/src/.Old/ComplexSemantics.v deleted file mode 100644 index 87b7b43..0000000 --- a/src/.Old/ComplexSemantics.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Export ZX. -Require Import externals.QuantumLib.Quantum. - -Local Open Scope ZX_scope. - -Definition braKetNM (bra: Matrix 2 1) (ket : Vector 2) n m : Matrix (2^n) (2^m) := - (n ⨂ ket) × (m ⨂ bra). -Transparent braKetNM. - -Local Open Scope matrix_scope. -Definition spiderSemanticsImpl (zx : ZXDiagram) (bra0 bra1 : Matrix 2 1) (ket0 ket1 : Vector 2) (α : R) (n m : nat) : Matrix (2 ^ n) (2 ^ m) := - (braKetNM bra0 ket0 n m) .+ (Cexp α) .* (braKetNM bra1 ket1 n m). -Transparent spiderSemanticsImpl. - -Definition spiderSemantics (zx : ZXDiagram) nodeIdx := - let v := getZXNMap zx nodeIdx in - let n := getInputCount zx nodeIdx in - let m := getOutputCount zx nodeIdx in - match v with - | Z_Spider α => spiderSemanticsImpl zx (bra 0) (bra 1) (ket 0) (ket 1) α n m - | X_Spider α => spiderSemanticsImpl zx (hadamard × (bra 0)) (hadamard × (bra 1)) (hadamard × (ket 0)) (hadamard × (ket 1)) α n m - end. - - -Local Close Scope matrix_scope. -Local Close Scope ZX_scope. diff --git a/src/.Old/Eigenstates.v b/src/.Old/Eigenstates.v deleted file mode 100644 index d00f41f..0000000 --- a/src/.Old/Eigenstates.v +++ /dev/null @@ -1,81 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Export ZX. - -Local Open Scope ZX_scope. - -Theorem ket_plus_state : ZX_semantics (Z_Spider 0 1 0) = √ 2 .* hadamard × (ket 0). -Proof. - simpl. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Theorem ket_minus_state : ZX_semantics (Z_Spider 0 1 PI) = √ 2 .* hadamard × (ket 1). -Proof. - simpl. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Theorem ket_0_state : ZX_semantics (X_Spider 0 1 0) = √ 2 .* (ket 0). -Proof. - simpl. - unfold X_semantics; simpl. - rewrite kron_1_l; try auto with wf_db. - unfold Z_semantics; simpl. - autorewrite with Cexp_db. - solve_matrix. - rewrite <- Csqrt2_sqrt. - rewrite <- Cmult_assoc. - rewrite Cinv_r; try nonzero. - rewrite Cmult_1_r; reflexivity. -Qed. - -Theorem ket_1_state : ZX_semantics (X_Spider 0 1 PI) = √ 2 .* (ket 1). -Proof. - simpl. - unfold X_semantics; simpl. - rewrite kron_1_l; try auto with wf_db. - unfold Z_semantics; simpl. - autorewrite with Cexp_db. - solve_matrix. - C_field_simplify; try lca; try apply Csqrt2_neq_0. -Qed. - -Theorem bra_plus_state : ZX_semantics (Z_Spider 1 0 0) = √ 2 .* (hadamard × (ket 0))†. -Proof. - simpl. - unfold Z_semantics; simpl. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Theorem bra_minus_state : ZX_semantics (Z_Spider 1 0 PI) = √ 2 .* (hadamard × (ket 1))†. -Proof. - simpl. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Theorem bra_0_state : ZX_semantics (X_Spider 1 0 0) = √ 2 .* (bra 0). -Proof. - simpl. - unfold_spider; try auto with wf_db. - autorewrite with Cexp_db. - solve_matrix. - C_field_simplify; try reflexivity; try apply Csqrt2_neq_0. -Qed. - -Theorem bra_1_state : ZX_semantics (X_Spider 1 0 PI) = √ 2 .* (bra 1). -Proof. - simpl. - unfold_spider; unfold_spider. - autorewrite with Cexp_db. - solve_matrix. - C_field_simplify; try lca; try apply Csqrt2_neq_0. -Qed. - -Local Close Scope ZX_scope. diff --git a/src/.Old/Fencepost.v b/src/.Old/Fencepost.v deleted file mode 100644 index deba191..0000000 --- a/src/.Old/Fencepost.v +++ /dev/null @@ -1,357 +0,0 @@ -Require Import ZX. -Require Import Rules. -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.Proportional. -Require Import externals.QuantumLib.VectorStates. -Require Import Coq.Logic.Eqdep_dec. - - -Local Open Scope R_scope. -Definition isZero (a : R) : bool := true. - -Definition isWire {nIn nOut} (D : ZX nIn nOut) : bool := - match D with - | X_Spider _ _ r | Z_Spider _ _ r => - match Req_EM_T r 0 with - | left _ => true - | _ => false - end - | _ => false - end. - -Fixpoint allWires {nIn nOut} (D : ZX nIn nOut) : bool := - match D with - | Compose D1 D2 | Stack D1 D2 => allWires D1 && allWires D2 - | other => isWire other - end. - -Fixpoint isSparseFencepost {nIn nOut} (D : ZX nIn nOut) : bool := - match D with - | Compose DL DR => isSparseFencepost DL && isSparseFencepost DR - | Stack DT DB => (allWires DT && isSparseFencepost DB) || (isSparseFencepost DT && allWires DB) - | _ => true - end. - -Fixpoint noComposes {nIn nOut} (D : ZX nIn nOut) : bool := - match D with - | Compose _ _ => false - | Stack DT DB => noComposes DT && noComposes DB - | _ => true - end. - -Inductive ZX_PostPred : forall {nIn nOut}, ZX nIn nOut -> Prop := - | Post_Empty : ZX_PostPred Empty - | Post_Cap : ZX_PostPred Cap - | Post_Cup : ZX_PostPred Cup - | Post_Swap : ZX_PostPred Swap - | Post_Z {nIn0 nOut0 α} : ZX_PostPred (Z_Spider nIn0 nOut0 α) - | Post_X {nIn0 nOut0 α} : ZX_PostPred (X_Spider nIn0 nOut0 α) - | Post_Stack {nIn0 nOut0 nIn1 nOut1} : - forall (zx0 : ZX nIn0 nOut0) (zx1 : ZX nIn1 nOut1), - ZX_PostPred zx0 -> ZX_PostPred zx1 -> ZX_PostPred (zx0 ↕ zx1). - -Lemma PostPred_reflect {nIn nOut} : forall (zx : ZX nIn nOut), reflect (ZX_PostPred zx) (noComposes zx). -Proof. - intros. - induction zx; (try (constructor; constructor)). - - simpl; destruct (noComposes zx1), (noComposes zx2). - 1: constructor; constructor; - [ inversion IHzx1; assumption - | inversion IHzx2; assumption ]. - all: constructor; unfold not; intros; - inversion H; subst; inversion IHzx1; inversion IHzx2; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; subst; - contradiction. - - constructor; unfold not; intros C; inversion C. -Qed. - -Lemma Post_Unstack_L {nIn0 nOut0 nIn1 nOut1} {zx0 : ZX nIn0 nOut0} {zx1 : ZX nIn1 nOut1} : - ZX_PostPred (zx0 ↕ zx1) -> ZX_PostPred zx0. -Proof. - intros; inversion H; subst. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; subst; assumption. -Qed. - -Lemma Post_Unstack_R {nIn0 nOut0 nIn1 nOut1} {zx0 : ZX nIn0 nOut0} {zx1 : ZX nIn1 nOut1} : - ZX_PostPred (zx0 ↕ zx1) -> ZX_PostPred zx1. -Proof. - intros; inversion H; subst. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; subst; assumption. -Qed. - -Lemma Post_NoComp {nIn nMid nOut} {zx0 : ZX nIn nMid} {zx1 : ZX nMid nOut} : - ~ (ZX_PostPred (zx0 ⟷ zx1)). -Proof. unfold not; intros; inversion H. Qed. - -Fixpoint isFencepost {nIn nOut} (D : ZX nIn nOut) : bool := - match D with - | Compose DL DR => isFencepost DL && isFencepost DR - | other => noComposes other - end. - -Inductive ZX_FencePred : forall {nIn nOut}, ZX nIn nOut -> Prop := - | IsPost {nIn0 nOut0} : forall (zx : ZX nIn0 nOut0), ZX_PostPred zx -> ZX_FencePred zx - | FenceCompose {nIn0 nMid0 nOut0} : - forall (zxl : ZX nIn0 nMid0) (zxr : ZX nMid0 nOut0), - ZX_FencePred zxl -> ZX_FencePred zxr -> - ZX_FencePred (zxl ⟷ zxr). - -Lemma FencePred_reflect {nIn nOut} : forall (zx : ZX nIn nOut), reflect (ZX_FencePred zx) (isFencepost zx). -Proof. - intros. - induction zx; try (constructor; constructor; constructor). - - simpl. - destruct (noComposes zx1) eqn:E1, (noComposes zx2) eqn:E2. - 1: constructor; constructor; - specialize (PostPred_reflect zx1); specialize (PostPred_reflect zx2); intros PP2 PP1; - rewrite E1 in PP1; rewrite E2 in PP2; - inversion PP1; inversion PP2; - constructor; assumption. - all: constructor; unfold not; intros C; - inversion C; subst; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H; subst; - inversion H2; subst; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H9; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H10; subst; - specialize (PostPred_reflect zx2); specialize (PostPred_reflect zx1); intros PP1 PP2; - rewrite E2 in PP2; - rewrite E1 in PP1; - inversion PP1; - inversion PP2; - contradiction. - - simpl. - destruct (isFencepost zx1), (isFencepost zx2). - 1: constructor; apply FenceCompose; [ inversion IHzx1 | inversion IHzx2 ]; assumption. - all: constructor; unfold not; intros C; - inversion C; - [ apply (inj_pair2_eq_dec _ Nat.eq_dec) in H; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H; subst; - inversion H2 - | apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; subst; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H4; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H4; subst; - inversion IHzx1; inversion IHzx2; - contradiction ]. -Qed. - -Lemma Fence_Unstack_L {nIn0 nOut0 nIn1 nOut1} {zx0 : ZX nIn0 nOut0} {zx1 : ZX nIn1 nOut1} : - ZX_FencePred (zx0 ↕ zx1) -> ZX_PostPred zx0. -Proof. - intros. - inversion H; subst. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; subst. - apply Post_Unstack_L in H3. - auto. -Qed. - -Lemma Fence_Unstack_R {nIn0 nOut0 nIn1 nOut1} {zx0 : ZX nIn0 nOut0} {zx1 : ZX nIn1 nOut1} : - ZX_FencePred (zx0 ↕ zx1) -> ZX_PostPred zx1. -Proof. - intros. - inversion H; subst. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; subst. - apply Post_Unstack_R in H3. - auto. -Qed. - -Lemma Fence_Decompose_L {nIn nMid nOut} {zx0 : ZX nIn nMid} {zx1 : ZX nMid nOut} : - ZX_FencePred (zx0 ⟷ zx1) -> ZX_FencePred zx0. -Proof. - intros. - inversion H. - - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; subst. - destruct (Post_NoComp H3). - - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H1; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H1; subst. - auto. -Qed. - -Lemma Fence_Decompose_R {nIn nMid nOut} {zx0 : ZX nIn nMid} {zx1 : ZX nMid nOut} : - ZX_FencePred (zx0 ⟷ zx1) -> ZX_FencePred zx1. -Proof. - intros. - inversion H. - - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H0; subst. - destruct (Post_NoComp H3). - - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H5; - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H5; subst. - auto. -Qed. - -Local Open Scope R_scope. -Inductive ZX_Post : nat -> nat -> Type := - | P_Empty : ZX_Post 0 0 - | P_X_Spider nIn nOut (α : R) : ZX_Post nIn nOut - | P_Z_Spider nIn nOut (α : R) : ZX_Post nIn nOut - | P_Cap : ZX_Post 0 2 - | P_Cup : ZX_Post 2 0 - | P_Swap : ZX_Post 2 2 - | P_Stack {nIn0 nIn1 nOut0 nOut1} (zx0 : ZX_Post nIn0 nOut0) (zx1 : ZX_Post nIn1 nOut1) : - ZX_Post (nIn0 + nIn1) (nOut0 + nOut1). -Local Close Scope R_scope. - -Inductive ZX_Fence : nat -> nat -> Type := - | FencePost {nIn nOut} (zxp : ZX_Post nIn nOut) : ZX_Fence nIn nOut - | F_Compose {nIn nMid nOut} (zx0 : ZX_Fence nIn nMid) (zx1 : ZX_Fence nMid nOut) : ZX_Fence nIn nOut. - -Fixpoint PostP_to_Post {nIn nOut} {zx : ZX nIn nOut} : ZX_PostPred zx -> ZX_Post nIn nOut. -Proof. - destruct zx. - - intros; apply P_Empty. - - intros; apply P_X_Spider; auto. - - intros; apply P_Z_Spider; auto. - - intros; apply P_Cap. - - intros; apply P_Cup. - - intros; apply P_Swap. - - intros; apply P_Stack. - + apply (PostP_to_Post _ _ zx1). - apply Post_Unstack_L in H. - auto. - + apply (PostP_to_Post _ _ zx2). - apply Post_Unstack_R in H. - auto. - - intros. - destruct (Post_NoComp H). -Defined. - - -Fixpoint FenceP_to_Fence {nIn nOut} {zx : ZX nIn nOut} : ZX_FencePred zx -> ZX_Fence nIn nOut. -Proof. - destruct zx. - - intros; apply FencePost; apply P_Empty. - - intros; apply FencePost; apply P_X_Spider; apply α. - - intros; apply FencePost; apply P_Z_Spider; apply α. - - intros; apply FencePost; apply P_Cap. - - intros; apply FencePost; apply P_Cup. - - intros; apply FencePost; apply P_Swap. - - intros; apply FencePost; apply P_Stack. - + apply Fence_Unstack_L in H. - apply (PostP_to_Post H). - + apply Fence_Unstack_R in H. - apply (PostP_to_Post H). - - intros. - apply (@F_Compose nIn nMid nOut). - + apply Fence_Decompose_L in H. - apply (FenceP_to_Fence _ _ _ H). - + apply Fence_Decompose_R in H. - apply (FenceP_to_Fence _ _ _ H). -Defined. - -Inductive ZX_Sparse_Obj : nat -> nat -> Type := - | SO_Empty : ZX_Sparse_Obj 0 0 - | SO_X_Spider nIn nOut (α : R) : ZX_Sparse_Obj nIn nOut - | SO_Z_Spider nIn nOut (α : R) : ZX_Sparse_Obj nIn nOut - | SO_Cap : ZX_Sparse_Obj 0 2 - | SO_Cup : ZX_Sparse_Obj 2 0 - | SO_Swap : ZX_Sparse_Obj 2 2. - -Inductive ZX_Sparse_Post : nat -> nat -> Type := - | SP_Stack {nIn nOut} above (object : ZX_Sparse_Obj nIn nOut) below : ZX_Sparse_Post (above + nIn + below) (above + nOut + below). - -Inductive ZX_Sparse_Fence : nat -> nat -> Type := - | SF_Post {nIn nOut} (p : ZX_Sparse_Post nIn nOut) : ZX_Sparse_Fence nIn nOut - | SF_Fence_Comp {nIn nMid nOut} (f1 : ZX_Sparse_Fence nIn nMid) (f2 : ZX_Sparse_Fence nMid nOut) : ZX_Sparse_Fence nIn nOut. - -Definition ZX_Sparse_Obj_to_ZX {nIn nOut} (o : ZX_Sparse_Obj nIn nOut) : ZX nIn nOut := - match o with - | SO_Empty => ⦰ - | SO_X_Spider nIn nOut α => X_Spider nIn nOut α - | SO_Z_Spider nIn nOut α => Z_Spider nIn nOut α - | SO_Cap => Cap - | SO_Cup => Cup - | SO_Swap => Swap - end. - -Definition ZX_Sparse_Post_to_ZX {nIn nOut} (p : ZX_Sparse_Post nIn nOut) : ZX nIn nOut := - match p with - | SP_Stack above object below => (nWire above ↕ ZX_Sparse_Obj_to_ZX object ↕ nWire below) - end. - -Fixpoint ZX_Sparse_Fence_to_ZX {nIn nOut} (f : ZX_Sparse_Fence nIn nOut) : ZX nIn nOut := - match f with - | SF_Post p => ZX_Sparse_Post_to_ZX p - | SF_Fence_Comp f1 f2 => ZX_Sparse_Fence_to_ZX f1 ⟷ ZX_Sparse_Fence_to_ZX f2 - end. - -Definition ZX_Sparse_Obj_semantics {nIn nOut} (obj : ZX_Sparse_Obj nIn nOut) : Matrix (2 ^ nOut) (2 ^ nIn) := - match obj with - | SO_Empty => I 1 - | SO_X_Spider _ _ α => X_semantics nIn nOut α - | SO_Z_Spider _ _ α => Z_semantics nIn nOut α - | SO_Cup => ZX_semantics Cup - | SO_Cap => ZX_semantics Cap - | SO_Swap => swap - end. - -Lemma WF_ZX_Sparse_Obj_semantics : forall {nIn nOut} (obj : ZX_Sparse_Obj nIn nOut), WF_Matrix (ZX_Sparse_Obj_semantics obj). -Proof. Opaque ZX_semantics. intros; destruct obj; simpl; restore_dims; auto with wf_db. Transparent ZX_semantics. Qed. - -Global Hint Resolve WF_ZX_Sparse_Obj_semantics : wf_db. - -Definition ZX_Sparse_Post_semantics {nIn nOut} (zxs : ZX_Sparse_Post nIn nOut) : Matrix (2 ^ nOut) (2 ^ nIn) := - match zxs with - | SP_Stack above obj below => - I (2 ^ above) ⊗ ZX_Sparse_Obj_semantics obj ⊗ I (2 ^ below) - end. - -Lemma WF_ZX_Sparse_Post_semantics : forall {nIn nOut} (p : ZX_Sparse_Post nIn nOut), WF_Matrix (ZX_Sparse_Post_semantics p). -Proof. intros; destruct p; simpl; auto with wf_db. Qed. - -Global Hint Resolve WF_ZX_Sparse_Post_semantics : wf_db. - -Fixpoint ZX_Sparse_Fence_semantics {nIn nOut} (zxs : ZX_Sparse_Fence nIn nOut) : Matrix (2 ^ nOut) (2 ^ nIn) := - match zxs with - | SF_Post zxsp => ZX_Sparse_Post_semantics zxsp - | SF_Fence_Comp zxf1 zxf2 => - ZX_Sparse_Fence_semantics zxf2 × ZX_Sparse_Fence_semantics zxf1 - end. - -Lemma WF_ZX_Sparse_Fence_semantics : forall {nIn nOut} (f : ZX_Sparse_Fence nIn nOut), WF_Matrix (ZX_Sparse_Fence_semantics f). -Proof. intros; induction f; simpl; auto with wf_db. Qed. - -Global Hint Resolve WF_ZX_Sparse_Fence_semantics : wf_db. - -Lemma ZX_Sparse_Obj_semantics_conversion : forall {nIn nOut} (obj : ZX_Sparse_Obj nIn nOut), ZX_Sparse_Obj_semantics obj = ZX_semantics (ZX_Sparse_Obj_to_ZX obj). -Proof. destruct obj; easy. Qed. - -Lemma ZX_Sparse_Post_semantics_conversion : forall {nIn nOut} (p : ZX_Sparse_Post nIn nOut), ZX_Sparse_Post_semantics p = ZX_semantics (ZX_Sparse_Post_to_ZX p). -Proof. - destruct p. - simpl. - rewrite ZX_Sparse_Obj_semantics_conversion. - rewrite 2 nwire_identity_semantics. - easy. -Qed. - -Lemma ZX_Sparse_Fence_semantics_conversion : forall {nIn nOut} (f : ZX_Sparse_Fence nIn nOut), ZX_Sparse_Fence_semantics f = ZX_semantics (ZX_Sparse_Fence_to_ZX f). -Proof. - intros. - induction f. - + apply ZX_Sparse_Post_semantics_conversion. - + simpl. - rewrite IHf1, IHf2. - easy. -Qed. - -Definition Height_Used_In {nIn nOut} (p : ZX_Sparse_Post nIn nOut) h := - match p with - | @SP_Stack nInObj _ above _ _ => h >= above \/ h < (above + nInObj) - end. - -Definition Height_Used_Out {nIn nOut} (p : ZX_Sparse_Post nIn nOut) h := - match p with - | @SP_Stack _ nOutObj above _ _ => h >= above \/ h < (above + nOutObj) - end. - -Definition NonInterference {nIn0 nOut0} (p0 : ZX_Sparse_Post nIn0 nOut0) {nIn1 nOut1} (p1 : ZX_Sparse_Post nIn1 nOut1) := forall h, Height_Used_Out p0 h -> ~(Height_Used_In p1 h). diff --git a/src/.Old/GateRules.v b/src/.Old/GateRules.v deleted file mode 100644 index e0530a3..0000000 --- a/src/.Old/GateRules.v +++ /dev/null @@ -1,127 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Export ZX. -Require Export Gates. -Require Export VyZX.Proportional. -Require Import Setoid. - -Local Open Scope ZX_scope. - -Local Transparent ZX_H. -Lemma ZX_H_is_H : ZX_semantics □ = Cexp (PI/4)%R .* hadamard. -Proof. - simpl. - unfold_spider; unfold_spider; simpl. - solve_matrix; - field_simplify_eq [Cexp_PI2 Cexp_PI4 Ci2 Csqrt2_sqrt2_inv Csqrt2_inv]; - try apply c_proj_eq; try simpl; try R_field_simplify; try reflexivity; (try split; try apply RtoC_neq; try apply sqrt2_neq_0; try auto). -Qed. -Local Opaque ZX_H. - -Lemma ZX_H_H_is_Wire_eq : ZX_semantics (□ ⟷ □) = Cexp (PI/2)%R .* ZX_semantics —. -Proof. - simpl. - rewrite wire_identity_semantics. - rewrite ZX_H_is_H. - rewrite Mscale_mult_dist_l. - rewrite Mscale_mult_dist_r. - rewrite MmultHH. - rewrite Mscale_assoc. - rewrite <- Cexp_add. - assert ((PI/4+PI/4 = PI/2)%R) as H by lra. - rewrite H. - reflexivity. -Qed. - -Local Transparent ZX_Z. -Local Transparent ZX_X. -Lemma ZX_X_is_X : ZX_semantics ZX_X = σx. -Proof. - simpl. - unfold_spider. - autorewrite with Cexp_db. - simpl. - rewrite kron_1_l; try auto with wf_db. - solve_matrix; - try (C_field_simplify; try lca; try nonzero). -Qed. - -Lemma ZX_Z_is_Z : ZX_semantics ZX_Z = σz. -Proof. - simpl. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Local Opaque ZX_Z. -Local Opaque ZX_X. - -Local Transparent ZX_Y. -Lemma ZX_Y_is_Y : ZX_semantics ZX_Y = -Ci .* σy. -Proof. - simpl. - rewrite ZX_X_is_X, ZX_Z_is_Z. - solve_matrix. -Qed. -Local Opaque ZX_Y. - -Local Open Scope R_scope. -Local Transparent ZX_CNOT_l. -Local Transparent ZX_CNOT_r. -Local Transparent ZX_CNOT. -Lemma ZX_CNOT_l_is_cnot : ZX_semantics ZX_CNOT_l = (/ √ 2)%C .* cnot. -Proof. - simpl. - rewrite wire_identity_semantics. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Lemma ZX_CNOT_equiv : ZX_semantics ZX_CNOT_l = ZX_semantics ZX_CNOT_r. -Proof. - simpl. - rewrite wire_identity_semantics. - unfold_spider. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Lemma ZX_CNOT_r_is_cnot : ZX_semantics ZX_CNOT_r = (/ √ 2)%C .* cnot. -Proof. - rewrite <- ZX_CNOT_equiv. - rewrite ZX_CNOT_l_is_cnot. - reflexivity. -Qed. - -Lemma ZX_CNOT_prop : ZX_CNOT_l ∝ ZX_CNOT_r. -Proof. - prop_exists_nonzero 1. - rewrite Mscale_1_l. - apply ZX_CNOT_equiv. -Qed. - -Notation ZX_CNOT_is_cnot := ZX_CNOT_l_is_cnot. -Local Opaque ZX_CNOT_l. -Local Opaque ZX_CNOT_r. -Local Opaque ZX_CNOT. - -Lemma hadamard_edge_compat : - forall nIn nMid nOut, - forall zx0 zx1 : ZX nIn nMid, zx0 ∝ zx1 -> - forall zx2 zx3 : ZX nMid nOut, zx2 ∝ zx3 -> - zx0 ⥈ zx2 ∝ zx1 ⥈ zx3. -Proof. - intros. - unfold hadamard_edge. - rewrite H, H0. - reflexivity. -Qed. - -Add Parametric Morphism (nIn nMid nOut : nat) : (@hadamard_edge nIn nMid nOut) - with signature (@proportional nIn nMid) ==> (@proportional nMid nOut) ==> - (@proportional nIn nOut) as hadamard_edge_mor. -Proof. apply hadamard_edge_compat; assumption. Qed. - -Local Close Scope R_scope. -Local Close Scope ZX_scope. diff --git a/src/.Old/Gates.v b/src/.Old/Gates.v deleted file mode 100644 index a59e72a..0000000 --- a/src/.Old/Gates.v +++ /dev/null @@ -1,62 +0,0 @@ -Require Import ZXCore. -From VyZX Require Import Proportional. - -Local Open Scope ZX_scope. - -(** Gate Definitions in the ZX Calculus *) - -Notation "'_S_'" := (Z 1 1 (PI / 2)) (at level 40). -Notation "'_T_'" := (Z 1 1 (PI / 4)) (at level 40). -Notation "'_Z_'" := (Z 1 1 PI) (at level 40). -Notation "'_X_'" := (X 1 1 PI) (at level 40). -Notation "'_Y_'" := (_Z_ ⟷ _X_) (at level 40). - -Notation "'_H_'" := - ((Z 1 1 (PI/2)) ⟷ (X 1 1 (PI/2)) ⟷ (Z 1 1 (PI/2))) - (at level 40). - -Notation "'_CNOT_'" := - ((Z 1 2 0 ↕ —) ⟷ (— ↕ X 2 1 0)). - -Notation "'_CNOT_R'" := - ((— ↕ X 1 2 0) ⟷ (Z 2 1 0 ↕ —)). - -Notation "'_NOTC_'" := - ((— ↕ Z 1 2 0 ) ⟷ (X 2 1 0 ↕ —)). - -Notation "'_NOTC_R'" := - ((X 1 2 0 ↕ —) ⟷ (— ↕ Z 2 1 0 )). - -(** Gate rewriting rules *) - -Lemma _H_is_Box : _H_ ∝ □. -Proof. - prep_proportional. - prop_exists_nonzero (Cexp (PI/4)). - simpl. - unfold X_semantics, Z_semantics. - Msimpl. - solve_matrix; - field_simplify_eq [Cexp_PI2 Cexp_PI4 Ci2 Csqrt2_sqrt2_inv Csqrt2_inv]; - try apply c_proj_eq; try simpl; try R_field_simplify; try reflexivity; (try split; try apply RtoC_neq; try apply sqrt2_neq_0; try auto). -Qed. - -Lemma _H_H_is_wire : □ ⟷ □ ∝ —. -Proof. - prep_proportional. - prop_exists_nonzero 1; Msimpl; simpl. - apply MmultHH. -Qed. - -Lemma _CNOT_equiv : - _CNOT_R ∝ _CNOT_. -Proof. - prep_proportional. - prop_exists_nonzero 1. - simpl. - Msimpl. - restore_dims. - - rewrite (kron_mixed_product (Z_semantics 2 1 0) (I 2) (I 2) (X_semantics 1 2 0)). - - diff --git a/src/.Old/Old.v b/src/.Old/Old.v deleted file mode 100644 index f98a852..0000000 --- a/src/.Old/Old.v +++ /dev/null @@ -1,585 +0,0 @@ - -Lemma Z_2_1_through_cap : forall α, - Z 2 1 α ↕ — ⟷ ⊃ ∝ (— ↕ — ↕ Z 1 2 α) ⟷ (— ↕ ⊃ ↕ —) ⟷ ⊃. -Proof. solve_prop 1. Qed. - -Lemma Grow_Z_Left_1_2 : forall {n m} α, - Z (S n) (S m) α ∝ - (Z 1 2 0 ↕ nWire n) ⟷ (— ↕ Z (S n) m α). -Proof. - intros. - rewrite Z_WrapOver_Top_Right. - rewrite Grow_Z_Left. - rewrite (nstack1_split 1 n). - fold (nWire n). fold (nWire 1). - rewrite stack_wire_distribute_l. - rewrite <- ZX_Compose_assoc. - rewrite (ZX_Stack_assoc_back ⊂ (nWire 1) (nWire n)). - rewrite (ZX_Stack_assoc_back — (Z 2 1 0) (nWire n)). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (⊂ ↕ nWire 1) (— ↕ Z 2 1 0) (nWire n) (nWire n)). - rewrite <- Z_WrapOver_Top_Right. - cleanup_zx. - easy. -Qed. - -Lemma Grow_Z_Right_2_1 : forall {n m} α, - Z (S n) (S m) α ∝ - (— ↕ Z n (S m) α) ⟷ (Z 2 1 0 ↕ nWire m). -Proof. - intros. - apply transpose_diagrams. - simpl. - rewrite nstack1_transpose. - rewrite transpose_wire. - apply Grow_Z_Left_1_2. -Qed. - -Lemma Grow_Z_Left_Bot_2_1 : forall {n m} α, - Z (n + 2) m α ∝ - (nWire n ↕ Z 2 1 0) ⟷ (Z (n + 1) m α). -Proof. - intros. - induction n. - - simpl. - cleanup_zx. - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - reflexivity. - - destruct n. - + simpl. - cleanup_zx. - simpl_casts. - rewrite (Z_WrapOver_Top_Left 1 m). - rewrite <- ZX_Compose_assoc. - rewrite <- stack_wire_distribute_l. - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - rewrite <- Z_WrapOver_Top_Left. - easy. - + rewrite (Grow_Z_Left (n + 1)). - rewrite <- ZX_Compose_assoc. - rewrite (nstack1_split 2 n). - rewrite (ZX_Stack_assoc (nWire 2) (nWire n) (Z 2 1 0)). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (nWire 2) _ (nWire n ↕ (Z 2 1 0)) _). - cleanup_zx. - rewrite <- nwire_stack_compose_botleft. - rewrite ZX_Compose_assoc. - rewrite ZX_Stack_assoc_back. - simpl_casts. - rewrite <- nstack1_split. - rewrite <- IHn. - rewrite <- (Grow_Z_Left (n + 2)). - simpl. - easy. -Qed. - -Lemma Grow_Z_Right_Bot_1_2 : forall {n m} α, - Z n (m + 2) α ∝ - (Z n (m + 1) α) ⟷ (nWire m ↕ Z 1 2 0). -Proof. - intros. - apply transpose_diagrams. - simpl. - rewrite nstack1_transpose. - rewrite transpose_wire. - apply Grow_Z_Left_Bot_2_1. -Qed. - -Lemma Grow_Z_Left_Bot_dim : forall n, - (n + 1 + 1 = n + 2)%nat. -Proof. lia. Qed. -Opaque Grow_Z_Left_Bot_dim. - -Opaque Cast. - -(* TODO: Finish Grow_Z_Left_Bot_1_2 *) - - -Lemma Grow_Z_Left_Bot_1_2 : forall {n m} α, - Z (n + 1) (m + 1) α ∝ - Cast (n + 1) (n + 1 + 1) (eq_refl) (Grow_Z_Left_Bot_dim _) (nWire n ↕ Z 1 2 0) ⟷ (Z (n + 1) m α ↕ —). -Proof. - induction n; intros. - - simpl_casts. - cleanup_zx. - eapply (cast_diagrams 1 (m + 1)). - simpl_casts. - simpl. - induction m. - + solve_prop 1. - + destruct m. - * solve_prop 1. - * rewrite (Grow_Z_Right 1 m). - rewrite stack_wire_distribute_r. - rewrite <- ZX_Compose_assoc. - rewrite <- IHm. - rewrite wire_to_nWire at 2. - rewrite (ZX_Stack_assoc (Z 1 2 0) (nWire m)). - simpl_casts. - rewrite <- nstack1_split. - simpl. - rewrite <- Grow_Z_Right. - easy. - - simpl. - destruct n. - + simpl. - simpl_casts. - cleanup_zx. - simpl_casts. - simpl in IHn. - induction m. - * solve_prop 1. - * simpl. - destruct m. - -- solve_prop 1. - -- rewrite (Grow_Z_Right 2 m). - rewrite stack_wire_distribute_r. - rewrite <- ZX_Compose_assoc. - rewrite <- IHm. - rewrite wire_to_nWire at 2. - rewrite (ZX_Stack_assoc (Z 1 2 0) (nWire m) (nWire 1)). - simpl_casts. - rewrite <- nstack1_split. - simpl. - admit. - + rewrite cast_compose_l. - simpl_casts. - rewrite (ZX_Stack_assoc — (nWire (S n))). - simpl_casts. - eapply (cast_diagrams (1 + ((S n) + 1)) (m + 1)). - rewrite cast_compose_distribute. - simpl_casts. - erewrite (cast_compose_mid (S (S n + 1) + 1)). - simpl_casts. - simpl. - erewrite (cast_stack_bot _ _ — (nWire (S n) ↕ Z 1 2 0)). - rewrite (Grow_Z_Left (n + 1) m). - simpl in IHn. -Admitted. - -Lemma Z_1_2_1_fusion : forall α β, - (Z 1 2 α ⟷ Z 2 1 β) ∝ (Z 1 1 (α + β)). -Proof. solve_prop 1. Qed. - -Lemma nWire_S_l : forall n, - nWire (S n) ∝ — ↕ nWire n. -Proof. intros. easy. Qed. - -Lemma Z_Absolute_Fusion : forall {n m o} α β, - (Z n (S m) α ⟷ Z (S m) o β) ∝ - Z n o (α + β). -Proof. - intros. - induction m. - - apply Z_spider_1_1_fusion. - - rewrite Grow_Z_Right, Grow_Z_Left. - rewrite ZX_Compose_assoc. - rewrite <- (ZX_Compose_assoc ((Z 1 2 0) ↕ (m ↑ —)) - ((Z 2 1 0) ↕ (m ↑ —)) - (Z (S m) o β)) . - rewrite <- ZX_Stack_Compose_distr. - rewrite Z_1_2_1_fusion. - rewrite Rplus_0_l. - rewrite Z_0_is_wire. - cleanup_zx. - apply IHm. -Qed. - -Lemma cap_absorb_dim : forall n m, - (n + 0 + m = n + m)%nat. -Proof. lia. Qed. - -Opaque Cast. - -Lemma Z_Cap_absord_base : forall α, - Z 1 2 α ⟷ ⊃ ∝ Z 1 0 α. -Proof. - intros. - prop_exists_nonzero 1. - simpl. - Msimpl. - unfold Z_semantics. - simpl. - solve_matrix. -Qed. - -Lemma Z_appendix_top_l : forall n m α, - Z n m α ∝ (Z 0 1 0 ↕ nWire n) ⟷ Z (S n) m α. -Proof. - induction n; intros. - - cleanup_zx. - simpl_casts. - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - easy. - - rewrite Grow_Z_Left. - rewrite <- ZX_Compose_assoc. - fold (nWire n). - rewrite nWire_S_l. - rewrite (ZX_Stack_assoc_back (Z 0 1 0) (—) (nWire n)). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (Z 0 1 0 ↕ —) (Z 2 1 0) (nWire n)). - rewrite Grow_Z_Left_1_2. - rewrite <- ZX_Compose_assoc. - rewrite <- wire_to_nWire. - rewrite <- (ZX_Stack_Compose_distr (Z 0 1 0) _ _ _). - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - cleanup_zx. - rewrite Z_2_0_0_is_cap. - rewrite Z_0_2_0_is_cup. - rewrite yank_r. - cleanup_zx. - easy. -Qed. - -Lemma Z_appendix_top_r : forall n m α, - Z n m α ∝ Z n (S m) α ⟷ (Z 1 0 0 ↕ nWire m). -Proof. - intros. - apply transpose_diagrams. - simpl. - cleanup_zx. - rewrite nstack1_transpose. - rewrite transpose_wire. - fold (nWire m). - rewrite <- (Z_appendix_top_l m n). - easy. -Qed. - -Lemma Z_Wrap_Under_R_base : forall α, - Z 1 2 α ∝ (— ↕ ⊂) ⟷ (Z 2 1 α ↕ —). -Proof. - intros. - simpl. - prop_exists_nonzero 1. - simpl; Msimpl. - unfold Z_semantics; simpl. - solve_matrix. -Qed. - -Lemma Z_Wrap_Under_L_base : forall α, - Z 2 1 α ∝ (Z 1 2 α ↕ —) ⟷ (— ↕ ⊃). -Proof. transpose_of Z_Wrap_Under_R_base. Qed. - -Lemma Z_Cap_absorb : forall n m0 m1 α, - Z n (m0 + 2 + m1) α ⟷ (nWire m0 ↕ ⊃ ↕ nWire m1) ∝ - (Z n (m0 + 0 + m1) α). -Proof. - intros. - induction m0. - - simpl. - cleanup_zx. - rewrite Grow_Z_Right. - rewrite ZX_Compose_assoc. - rewrite <- (ZX_Stack_Compose_distr (Z 1 2 0) ⊃ (nWire m1) (nWire m1)). - rewrite Z_Cap_absord_base. - cleanup_zx. - rewrite <- Z_appendix_top_r. - easy. - - destruct m0. - + simpl. - rewrite Grow_Z_Right. - rewrite ZX_Compose_assoc. - rewrite nWire_S_l. - rewrite (ZX_Stack_assoc_back (Z 1 2 0) —). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (Z 1 2 0 ↕ —) (nWire 1 ↕ ⊃) (nWire m1)). - rewrite <- wire_to_nWire. - rewrite <- Z_Wrap_Under_L_base. - cleanup_zx. - rewrite Grow_Z_Right. - rewrite ZX_Compose_assoc. - rewrite <- (ZX_Stack_Compose_distr (Z 1 2 0) (Z 2 1 0) (nWire m1) _). - cleanup_zx. - rewrite Z_Absolute_Fusion. - rewrite Rplus_0_l. - cleanup_zx. - easy. - + simpl. - rewrite Grow_Z_Right. - rewrite (ZX_Stack_assoc_back — —). - simpl_casts. - rewrite ZX_Compose_assoc. - rewrite (ZX_Stack_assoc (— ↕ —)). - simpl_casts. - rewrite (ZX_Stack_assoc (— ↕ —)). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (Z 1 2 0) (— ↕ —) - (nWire (m0 + 2 + m1)) (nWire m0 ↕ ⊃ ↕ nWire m1)). - rewrite wire_to_nWire at 2. - rewrite <- nWire_S_l. - cleanup_zx. - rewrite <- nwire_stack_compose_topleft. - rewrite <- wire_to_nWire. - rewrite ZX_Stack_assoc_back. - simpl_casts. - rewrite ZX_Stack_assoc_back. - simpl_casts. - rewrite <- nWire_S_l. - rewrite <- ZX_Compose_assoc. - rewrite IHm0. - rewrite <- Grow_Z_Right. - easy. -Qed. - -Lemma Grow_Z_Top_Left_by : forall n {m o α}, - Z (n + m) o α ∝ - (Z n 1 0 ↕ nWire m) ⟷ Z (S m) o α. -Proof. - induction n; intros. - - simpl. - rewrite <- (Z_appendix_top_l m). - easy. - - intros. - simpl. - destruct n. - + simpl. - cleanup_zx. - easy. - + rewrite Grow_Z_Left. - rewrite stack_nwire_distribute_r. - rewrite ZX_Compose_assoc. - rewrite <- IHn. - rewrite (ZX_Stack_assoc (Z 2 1 0) (nWire n) (nWire m)). - simpl_casts. - rewrite <- nstack1_split. - rewrite <- (Grow_Z_Left (n + m)). - easy. -Qed. - -Lemma Grow_Z_Top_Right_by : forall {n} m {o α}, - Z n (m + o) α ∝ - Z n (S o) α ⟷ (Z 1 m 0 ↕ nWire o). -Proof. - intros. - apply transpose_diagrams. - simpl. - rewrite nstack1_transpose. - rewrite transpose_wire. - apply Grow_Z_Top_Left_by. -Qed. - -Lemma Grow_Z_Bot_Left_by : forall n {m o α}, - Z (n + m) o α ∝ - (nWire n ↕ Z m 1 0) ⟷ Z (n + 1) o α. -Proof. - induction n; intros. - - simpl. - cleanup_zx. - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - easy. - - destruct n. - + simpl. - cleanup_zx. - simpl_casts. - rewrite (Z_WrapOver_Top_Left 1 o). - rewrite <- ZX_Compose_assoc. - rewrite <- stack_wire_distribute_l. - rewrite Z_spider_1_1_fusion. - rewrite Rplus_0_l. - rewrite <- Z_WrapOver_Top_Left. - easy. - + simpl. - rewrite (Grow_Z_Left (n + 1) o). - rewrite <- ZX_Compose_assoc. - rewrite (ZX_Stack_assoc_back — —). - simpl_casts. - rewrite (ZX_Stack_assoc (— ↕ —)). - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (— ↕ —) (Z 2 1 0) (nWire n ↕ Z m 1 0)). - cleanup_zx. - rewrite <- nwire_stack_compose_botleft. - rewrite ZX_Stack_assoc_back. - simpl_casts. - rewrite <- nstack1_split. - rewrite ZX_Compose_assoc. - rewrite <- (IHn m o α). - simpl. - rewrite wire_to_nWire at 1. - rewrite wire_to_nWire at 2. - rewrite <- nstack1_split. - cleanup_zx. - rewrite <- (Grow_Z_Left (n + m)). - easy. -Qed. - -Lemma Grow_Z_Bot_Right_by : forall {n m} o {α}, - Z n (m + o) α ∝ - Z n (m + 1) α ⟷ (nWire m ↕ Z 1 o 0). -Proof. - intros. - apply transpose_diagrams. - simpl. - rewrite nstack1_transpose. - rewrite transpose_wire. - apply Grow_Z_Bot_Left_by. -Qed. - -Lemma WrapUnder_dim : forall n, - (n + 1 + 1 = n + 2)%nat. -Proof. lia. Qed. - -Lemma WrapUnder_L_base : forall α, - Z 0 1 α ∝ - ⊂ ⟷ (Z 1 0 α ↕ —). -Proof. - intros. - prop_exists_nonzero 1. - simpl; Msimpl. - unfold Z_semantics. - gridify. - solve_matrix. -Qed. - -Lemma WrapUnder_L_ind : - (— ↕ ⊂) ⟷ (Z 2 1 0 ↕ —) ∝ Z 1 2 0. -Proof. - intros. - prop_exists_nonzero 1. - simpl; Msimpl. - unfold Z_semantics. - simpl. - solve_matrix. -Qed. - -Lemma WrapUnder_L : forall n m α, - Z n (m + 1) α ∝ - (Cast n (n + 1 + 1) (eq_sym (plus_0_r _)) (WrapUnder_dim _) - (nWire n ↕ Cap)) ⟷ Z (n + 1) m α ↕ —. -Proof. - induction n; intros. - - simpl. - simpl_casts. - cleanup_zx. - induction m. - + simpl. - prop_exists_nonzero 1. - simpl; Msimpl. - unfold Z_semantics. - solve_matrix. - + simpl. - destruct m. - * simpl. - rewrite (Grow_Z_Top_Right_by 1). - prop_exists_nonzero 1. - simpl; Msimpl. - unfold Z_semantics. - simpl. - solve_matrix. - rewrite Cexp_0. - lca. - * rewrite Grow_Z_Right. - rewrite stack_wire_distribute_r. - rewrite <- ZX_Compose_assoc. - rewrite <- IHm. - rewrite wire_to_nWire at 2. - rewrite (ZX_Stack_assoc (Z 1 2 0) (nWire m)). - simpl_casts. - rewrite <- nstack1_split. - simpl. - rewrite <- Grow_Z_Right. - easy. - - destruct n. - + simpl. - simpl_casts. - cleanup_zx. - simpl_casts. - simpl in IHn. - rewrite Grow_Z_Left. - cleanup_zx. - simpl_casts. - rewrite stack_wire_distribute_r. - rewrite wire_to_nWire. -Admitted. - -Lemma dominant_spider_fusion_r : forall n m0 m1 o α β, - Z n ((S m0) + m1) α ⟷ (Z (S m0) o β ↕ nWire m1) ∝ - Z n (o + m1) (α + β). -Proof. - intros. - replace α with (0 + α + 0)%R at 1 by lra. - rewrite Z_add_r. - repeat rewrite ZX_Compose_assoc. - rewrite <- (ZX_Stack_Compose_distr (Z 1 (S m0) 0)). - rewrite Z_Absolute_Fusion. - rewrite Rplus_0_l. - cleanup_zx. - rewrite <- (Rplus_0_l β). - rewrite (Z_appendix_rot_r 1 o β). - rewrite <- (nwire_removal_r (Z 1 m1 0)). - rewrite ZX_Stack_Compose_distr. - rewrite <- ZX_Compose_assoc. - rewrite <- Z_add_r. - rewrite (ZX_Stack_assoc (Z 1 0 0) (nWire o)). - simpl_casts. - rewrite <- nstack1_split. - simpl. - rewrite <- Z_appendix_rot_r. - replace (0 + (β + α + 0))%R with (α + (0 + β))%R by lra. - easy. -Qed. - -Lemma dominated_spider_fusion_r : forall n m0 m1 o α β, - (Z n (S m0) α ↕ nWire m1 ⟷ Z (S m0 + m1) o β) ∝ - Z (n + m1) o (α + β). -Proof. - intros. - replace β%R with (0 + β + 0)%R at 1 by lra. - rewrite Z_add_l. - rewrite <- ZX_Compose_assoc. - rewrite <- ZX_Stack_Compose_distr. - rewrite Z_Absolute_Fusion. - cleanup_zx. - rewrite <- Z_add_l. - replace (α + 0 + β + 0)%R with (α + β)%R by lra. - easy. -Qed. - -Lemma SpiderFusion : forall top mid bot input output α β, - Z input (top + S mid) α ↕ nWire bot ⟷ - Cast (top + (S mid) + bot) (top + output) (eq_sym (Nat.add_assoc _ _ _)) eq_refl - (nWire top ↕ Z (S mid + bot) output β) ∝ - Z (input + bot) (top + output) (α + β). -Proof. - intros. - replace α%R with (0 + α + 0)%R at 1 by lra. - rewrite Z_add_r. - rewrite stack_nwire_distribute_r. - rewrite ZX_Compose_assoc. - rewrite (ZX_Stack_assoc (Z 1 top 0)). - rewrite cast_compose_r. - simpl_casts. - rewrite <- (ZX_Stack_Compose_distr (Z 1 top 0) (nWire top) (Z 1 (S mid) 0 ↕ nWire bot)). - cleanup_zx. - rewrite dominated_spider_fusion_r. - rewrite Grow_Z_Bot_Left_by. - simpl. - cleanup_zx. - simpl_casts. - rewrite Z_WrapOver_Top_Right. - rewrite stack_nwire_distribute_r. - rewrite (ZX_Stack_assoc — (Z (S input) 1 α) (nWire bot)). - simpl_casts. - rewrite ZX_Compose_assoc. - rewrite <- (ZX_Stack_Compose_distr — (Z 1 top 0) (Z (S input) 1 α ↕ nWire bot)). - cleanup_zx. - rewrite wire_to_nWire at 4. - rewrite <- ZX_Compose_assoc. - rewrite (nwire_stack_compose_botleft (Z (S input) 1 α)). - rewrite <- Z_add_l. - rewrite <- (wire_removal_l (Z 1 top 0)). - rewrite <- (nwire_removal_r (Z (S input + bot) _ _)). - rewrite ZX_Stack_Compose_distr. - rewrite <- ZX_Compose_assoc. - rewrite (ZX_Stack_assoc ⊂ (nWire input)). - simpl_casts. - rewrite <- nstack1_split. - rewrite <- (Z_WrapOver_Top_Right (input + bot)). - rewrite <- Grow_Z_Top_Right_by. - replace (α + (0 + β) + 0)%R with (α + β)%R by lra. - easy. -Qed. diff --git a/src/.Old/Properties.v b/src/.Old/Properties.v deleted file mode 100644 index 9eabb1c..0000000 --- a/src/.Old/Properties.v +++ /dev/null @@ -1,136 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Export ZX. - -Local Open Scope ZX_scope. - -Fixpoint Spider_Angle_Prop (prop : C -> Prop) {nIn nOut} (zx : ZX nIn nOut) : Prop := - match zx with - | X_Spider _ _ α => prop α - | Z_Spider _ _ α => prop α - | zx0 ↕ zx1 => (Spider_Angle_Prop prop zx0) /\ (Spider_Angle_Prop prop zx1) - | zx0 ⟷ zx1 => (Spider_Angle_Prop prop zx0) /\ (Spider_Angle_Prop prop zx1) - | _ => True (* Non-composititonal non-spiders have no impact *) - end. - -Definition Proper_Clifford_Prop (α : C) : Prop := exists n : nat, α = PI / C2 + (INR n) * PI. - -Definition Proper_Clifford_ZX {nIn nOut} (zx : ZX nIn nOut) := Spider_Angle_Prop Proper_Clifford_Prop zx. - -Definition Pauli_Prop (α : C) : Prop := exists n : nat, α = ((INR n) * PI)%C. - -Definition Pauli_ZX {nIn nOut} (zx : ZX nIn nOut) := Spider_Angle_Prop Pauli_Prop zx. - -Definition Clifford_Prop (α : C) : Prop := exists n : nat, α = (INR n) * PI / C2. - -Definition Clifford_ZX {nIn nOut} (zx : ZX nIn nOut) := Spider_Angle_Prop Clifford_Prop zx. - -Lemma Spider_Angle_Prop_Weaking : forall (prop0 prop1 : C -> Prop) {nIn nOut} (zx : ZX nIn nOut), - (forall c, prop0 c -> prop1 c) -> (Spider_Angle_Prop prop0 zx -> Spider_Angle_Prop prop1 zx). -Proof. - intros. - induction zx; try (unfold Spider_Angle_Prop in *; try apply H; assumption); - try (simpl in H0; destruct H0; split; try apply IHzx1; try apply IHzx2; assumption). -Qed. - -Definition Pauli_Proper_Clifford_Prop_Is_Clifford_Prop : forall c, Pauli_Prop c \/ Proper_Clifford_Prop c -> Clifford_Prop c. -Proof. - intros. - unfold Pauli_Prop, Proper_Clifford_Prop, Clifford_Prop in *. - destruct H; - destruct H. - - exists (2 * x)%nat. - rewrite mult_INR. - rewrite H. - lca. - - exists (2 * x + 1)%nat. - rewrite H. - rewrite plus_INR. - rewrite mult_INR. - lca. -Qed. - -Definition Clifford_Prop_Is_Pauli_Proper_Clifford_Prop : forall c, Clifford_Prop c -> Pauli_Prop c \/ Proper_Clifford_Prop c. -Proof. - intros. - unfold Pauli_Prop, Proper_Clifford_Prop, Clifford_Prop in *. - destruct H. - assert (exists p : nat, x = (2 * p)%nat \/ x = S (2 * p)) by apply even_odd_cor. - destruct H0; - destruct H0; - subst. - - left. - exists x0. - rewrite mult_INR. - lca. - - right. - rewrite S_INR. - rewrite mult_INR. - exists x0. - lca. -Qed. - -Lemma Clifford_is_Proper_Clifford_And_Pauli : forall {nIn nOut} (zx : ZX nIn nOut), (Pauli_ZX zx) \/ (Proper_Clifford_ZX zx) -> Clifford_ZX zx. -Proof. - intros. - induction zx; intros; simpl; try easy; auto - ; try - (destruct H; - unfold Pauli_ZX, Pauli_Prop in *; - unfold Clifford_ZX, Clifford_Prop in *; - unfold Proper_Clifford_ZX, Proper_Clifford_Prop in *; - simpl in *). - - destruct H. - exists (2 * x)%nat. - rewrite H. - rewrite mult_INR. - lca. - - destruct H. - exists (2 * x + 1)%nat. - rewrite H. - rewrite plus_INR. - rewrite mult_INR. - lca. - - destruct H. - exists (2 * x)%nat. - rewrite H. - rewrite mult_INR. - lca. - - destruct H. - exists (2 * x + 1)%nat. - rewrite H. - rewrite plus_INR. - rewrite mult_INR. - lca. - - destruct H. - split. - apply IHzx1. - left. - assumption. - apply IHzx2. - left. - assumption. - - destruct H. - split. - apply IHzx1. - right. - assumption. - apply IHzx2. - right. - assumption. - - destruct H. - split. - apply IHzx1. - left. - assumption. - apply IHzx2. - left. - assumption. - - destruct H. - split. - apply IHzx1. - right. - assumption. - apply IHzx2. - right. - assumption. -Qed. \ No newline at end of file diff --git a/src/.Old/Rules.v b/src/.Old/Rules.v deleted file mode 100644 index 42ca65c..0000000 --- a/src/.Old/Rules.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.VectorStates. -Require Export ZX. -Require Export Gates. -Require Export GateRules. -Require Export VyZX.Proportional. - -Local Close Scope ZX_scope. diff --git a/src/.Old/SQIRIn.v b/src/.Old/SQIRIn.v deleted file mode 100644 index 319d806..0000000 --- a/src/.Old/SQIRIn.v +++ /dev/null @@ -1,968 +0,0 @@ -Require Import SQIR.UnitarySem. -Require Import Arith. -Require Import Reals. -Require Import Complex. -Require Export ZX. -Require Export Gates. -Require Export VyZX.Proportional. -Require Export Rules. -Require Import Matrix. -Require Import Setoid. -Require Import Quantum. -Require Import ZX_A_G_2. -Require Import Fencepost. -Require Import Coq.Logic.Eqdep_dec. -Require Import Coq.Arith.Peano_dec. - -Local Open Scope R_scope. - -(* Arbitrary Swap Diagrams and Conversion to Base ZX Diagrams *) - -(* A ZX diagram with arbitrary swaps to make circuit ingestion easier - Constructions are mostly the same as a base ZX diagram, it has an - arbitrary swap instead of a 2x2 swap *) -Inductive ZX_Arb_Swaps : nat -> nat -> Type := - | AS_Empty : ZX_Arb_Swaps 0 0 - | AS_Base_Swap : ZX_Arb_Swaps 2 2 - | ZX_AS_X_spider nIn nOut (α : R) : ZX_Arb_Swaps nIn nOut - | ZX_AS_Z_spider nIn nOut (α : R) : ZX_Arb_Swaps nIn nOut - | AS_Cap : ZX_Arb_Swaps 0 2 - | AS_Cup : ZX_Arb_Swaps 2 0 - | AS_Stack {nIn0 nIn1 nOut0 nOut1} (zx0 : ZX_Arb_Swaps nIn0 nOut0) (zx1 : ZX_Arb_Swaps nIn1 nOut1) : - ZX_Arb_Swaps (nIn0 + nIn1) (nOut0 + nOut1) - | AS_Compose {nIn nMid nOut} (zx0 : ZX_Arb_Swaps nIn nMid) (zx1 : ZX_Arb_Swaps nMid nOut) : ZX_Arb_Swaps nIn nOut - | A_Swap (n : nat) : ZX_Arb_Swaps n n. -Local Close Scope R_scope. - -(* Notations and useful definitions within arbitrary swap diagrams *) - -Infix "⟷A" := AS_Compose (left associativity, at level 40). -Infix "↕A" := AS_Stack (left associativity, at level 40). - -Definition ArbWire := ZX_AS_Z_spider 1 1 0. - -Definition ZX_AS_Z : ZX_Arb_Swaps 1 1 := ZX_AS_Z_spider 1 1 PI. - -Definition ZX_AS_X : ZX_Arb_Swaps 1 1 := ZX_AS_X_spider 1 1 PI. - -Definition ZX_AS_Y : ZX_Arb_Swaps 1 1 := AS_Compose ZX_AS_Z ZX_AS_X. - -Definition ZX_AS_CNOT : ZX_Arb_Swaps 2 2 := ZX_AS_Z_spider 1 2 0 ↕A ArbWire ⟷A (ArbWire ↕A ZX_AS_X_spider 2 1 0). - -Definition ZX_AS_CNOT_flipped : ZX_Arb_Swaps 2 2 := ZX_AS_X_spider 1 2 0 ↕A ArbWire ⟷A (ArbWire ↕A ZX_AS_Z_spider 2 1 0). - -Definition ZX_ucom_rot (x y z : R) : ZX_Arb_Swaps 1 1 := - ZX_AS_Y ⟷A ZX_AS_Z_spider 1 1 y ⟷A ZX_AS_Y ⟷A ZX_AS_X_spider 1 1 x ⟷A ZX_AS_Z_spider 1 1 z. - -Reserved Notation "n ↑A zx" (at level 41). -Fixpoint nStack1 n (zx : ZX_Arb_Swaps 1 1) : ZX_Arb_Swaps n n := - match n with - | 0 => AS_Empty - | S n' => zx ↕A (n' ↑A zx) - end - where "n ↑A zx" := (nStack1 n zx). - -Definition nArbWire := fun n => nStack1 n ArbWire. - -Fixpoint ZX_A_1_1_pad {dim} : nat -> ZX_Arb_Swaps 1 1 -> ZX_Arb_Swaps dim dim := - fun n zx => - match dim with - | 0 => AS_Empty - | S k => match n with - | 0 => zx ↕A (nArbWire k) - | S m => ArbWire ↕A (@ZX_A_1_1_pad k m zx) - end - end. - -Definition ZX_ucom_rot_FencePost {dim} n (x y z : R) : ZX_Arb_Swaps dim dim := - ZX_A_1_1_pad n ZX_AS_Z ⟷A ZX_A_1_1_pad n ZX_AS_X ⟷A ZX_A_1_1_pad n (ZX_AS_Z_spider 1 1 y) ⟷A (ZX_A_1_1_pad n ZX_AS_Z ⟷A ZX_A_1_1_pad n ZX_AS_X) ⟷A ZX_A_1_1_pad n (ZX_AS_X_spider 1 1 x) ⟷A ZX_A_1_1_pad n (ZX_AS_Z_spider 1 1 z). - - -(* Conversion to base ZX diagrams *) - -Fixpoint ZX_top_to_bottom_helper (n : nat) : ZX (S n) (S n) := - match n with - | 0 => Wire - | S k => Compose (Stack Swap (nWire k)) (Stack Wire (ZX_top_to_bottom_helper k)) - end. - -Definition ZX_top_to_bottom (n : nat) : ZX n n := - match n with - | 0 => Empty - | S k => ZX_top_to_bottom_helper k - end. - -Definition ZX_bottom_to_top (n : nat) : ZX n n := - (ZX_top_to_bottom n)⊺. - -Definition A_Swap_ZX (n : nat) : ZX n n := - match n with - | 0 => Empty - | S k => ZX_top_to_bottom (S k) - ⟷ eq_rect (k + 1)%nat (fun n0 : nat => ZX n0 n0) - (ZX_bottom_to_top k ↕ —) (S k) (Nat.add_1_r k) - end. - -Inductive ZX_A_PostPred : forall {nIn nOut}, ZX_Arb_Swaps nIn nOut -> Prop := - | A_Post_Empty : ZX_A_PostPred AS_Empty - | A_Post_Cap : ZX_A_PostPred AS_Cap - | A_Post_Cup : ZX_A_PostPred AS_Cup - | A_Post_Base_Swap : ZX_A_PostPred AS_Base_Swap - | A_Post_Z {nIn0 nOut0 α} : ZX_A_PostPred (ZX_AS_Z_spider nIn0 nOut0 α) - | A_Post_X {nIn0 nOut0 α} : ZX_A_PostPred (ZX_AS_X_spider nIn0 nOut0 α) - | A_Post_Stack {nIn0 nOut0 nIn1 nOut1} : - forall (zx0 : ZX_Arb_Swaps nIn0 nOut0) (zx1 : ZX_Arb_Swaps nIn1 nOut1), - ZX_A_PostPred zx0 -> ZX_A_PostPred zx1 -> ZX_A_PostPred (zx0 ↕A zx1). - -Inductive ZX_A_FencePred : forall {nIn nOut}, ZX_Arb_Swaps nIn nOut -> Prop := -| A_IsPost {nIn0 nOut0} : forall (zx : ZX_Arb_Swaps nIn0 nOut0), ZX_A_PostPred zx -> ZX_A_FencePred zx -| A_FenceSwap {n} : ZX_A_FencePred (A_Swap n) -| A_FenceCompose {nIn0 nMid0 nOut0} : - forall (zxl : ZX_Arb_Swaps nIn0 nMid0) (zxr : ZX_Arb_Swaps nMid0 nOut0), - ZX_A_FencePred zxl -> ZX_A_FencePred zxr -> - ZX_A_FencePred (zxl ⟷A zxr). - -Fixpoint ZX_to_ZX_Arb {nIn nOut : nat} (zx : ZX nIn nOut) : ZX_Arb_Swaps nIn nOut := - match zx with - | Empty => AS_Empty - | X_Spider inp out a => ZX_AS_X_spider inp out a - | Z_Spider inp out a => ZX_AS_Z_spider inp out a - | Cap => AS_Cap - | Cup => AS_Cup - | Stack zx1 zx2 => AS_Stack (ZX_to_ZX_Arb zx1) (ZX_to_ZX_Arb zx2) - | Compose zx1 zx2 => AS_Compose (ZX_to_ZX_Arb zx1) (ZX_to_ZX_Arb zx2) - | Swap => AS_Base_Swap - end. - -Lemma ZX_PostPred_to_A : forall {nIn nOut : nat} (zx : ZX nIn nOut), ZX_PostPred zx -> ZX_A_PostPred (ZX_to_ZX_Arb zx). -Proof. - intros. - induction zx; try (simpl; constructor). - all: inversion H. - 1: apply IHzx1. - 2: apply IHzx2. - all: inversion H9; inversion H10; subst. - all: apply inj_pair2_eq_dec in H14; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H14; [| apply eq_nat_dec]. - all: apply inj_pair2_eq_dec in H16; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H16; [| apply eq_nat_dec]. - all: subst. - all: assumption. -Qed. - -Ltac crush_existT := - (match goal with - | [ H : existT ?eq0 ?nIn (existT ?eq1 ?nOut0 ?zx4) = existT ?eq0 ?nIn0 (existT ?eq1 ?nOut0 ?zx1) |- _ ] => - apply inj_pair2_eq_dec in H; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H; [| apply eq_nat_dec]; subst zx1 - end). (* TODO : FIXME *) - -Lemma ZX_FencePred_to_A : forall {nIn nOut : nat} (zx : ZX nIn nOut), ZX_FencePred zx -> ZX_A_FencePred (ZX_to_ZX_Arb zx). -Proof. - intros. - induction zx. - all: inversion H; subst. - 1-8: apply inj_pair2_eq_dec in H0; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H0; [| apply eq_nat_dec]; subst. - 1-7: apply A_IsPost. - 1-7: apply ZX_PostPred_to_A. - 1-7: assumption. - - inversion H3. - - apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]; subst. - apply inj_pair2_eq_dec in H5; [| apply eq_nat_dec]; apply inj_pair2_eq_dec in H5; [| apply eq_nat_dec]; subst. - simpl. - apply A_FenceCompose; [ apply IHzx1 | apply IHzx2 ]; assumption. -Qed. - - -Fixpoint ZX_Arb_to_ZX {nIn nOut : nat} (zxa : ZX_Arb_Swaps nIn nOut) : ZX nIn nOut := - match zxa with - | AS_Empty => Empty - | ZX_AS_X_spider inp out a => X_Spider inp out a - | ZX_AS_Z_spider inp out a => Z_Spider inp out a - | AS_Cap => Cap - | AS_Base_Swap => ⨉ - | AS_Cup => Cup - | AS_Stack zx1 zx2 => Stack (ZX_Arb_to_ZX zx1) (ZX_Arb_to_ZX zx2) - | AS_Compose zx1 zx2 => Compose (ZX_Arb_to_ZX zx1) (ZX_Arb_to_ZX zx2) - | A_Swap n => A_Swap_ZX n - end. - -(* Arbitrary Swap Semantics *) - -(* A linear mapping which takes | x y1 ... yn > -> | y1 .. yn x > *) -Fixpoint Top_wire_to_bottom (n : nat) : Square (2 ^ n) := - match n with - | 0 => I 1 - | S k => match k with - | 0 => I 2 - | S j => (@Mmult _ (2^n) _) ((I 2) ⊗ (Top_wire_to_bottom k)) (swap ⊗ (j ⨂ (I 2))) - end - end. - -Definition Bottom_wire_to_top (n : nat) : Square (2 ^ n) := - (Top_wire_to_bottom n)⊤. - -Definition A_Swap_semantics (n : nat) : Square (2 ^ n) := - match n with - | 0 => I 1 - | S k => (@Mmult _ (2 ^ n) _ ((Bottom_wire_to_top k) ⊗ (I 2)) (Top_wire_to_bottom (S k))) - end. - -Fixpoint ZX_Arb_Swaps_Semantics {nIn nOut : nat} (zxa : ZX_Arb_Swaps nIn nOut) : Matrix (2 ^ nOut) (2 ^ nIn) := - match zxa with - | AS_Empty => I 1 - | ZX_AS_X_spider _ _ a => X_semantics nIn nOut a - | ZX_AS_Z_spider _ _ a => Z_semantics nIn nOut a - | AS_Base_Swap => ZX_semantics ⨉ - | AS_Cap => ZX_semantics Cap - | AS_Cup => ZX_semantics Cup - | AS_Stack zx0 zx1 => ZX_Arb_Swaps_Semantics zx0 ⊗ ZX_Arb_Swaps_Semantics zx1 - | AS_Compose zx0 zx1 => ZX_Arb_Swaps_Semantics zx1 × ZX_Arb_Swaps_Semantics zx0 - | A_Swap n => A_Swap_semantics n - end. - -(* Well foundedness of semantics *) - -Lemma WF_Top_to_bottom (n : nat) : WF_Matrix (Top_wire_to_bottom n). -Proof. - destruct n; try auto with wf_db. - induction n. - - simpl; auto with wf_db. - - simpl. try auto with wf_db. -Qed. - -Global Hint Resolve WF_Top_to_bottom : wf_db. - -Lemma WF_Bottom_to_top (n : nat) : WF_Matrix (Bottom_wire_to_top n). -Proof. unfold Bottom_wire_to_top. auto with wf_db. Qed. - -Global Hint Resolve WF_Bottom_to_top : wf_db. - -Lemma WF_A_Swap_semantics (n : nat) : WF_Matrix (A_Swap_semantics n). -Proof. destruct n; [ auto with wf_db | simpl; destruct n; auto with wf_db ]. Qed. - -Global Hint Resolve WF_A_Swap_semantics : wf_db. - -Lemma WF_ZX_Arb_Swap_Semantics : forall (nIn nOut : nat) (zxa : ZX_Arb_Swaps nIn nOut), WF_Matrix (ZX_Arb_Swaps_Semantics zxa). -Proof. - intros. - induction zxa; simpl; auto with wf_db; - apply WF_list2D_to_matrix; - try easy; (* case list of length 4 *) - try intros; simpl in H; repeat destruct H; try discriminate; try (subst; easy). (* Case of 4 lists length 1 *) -Qed. - -Global Hint Resolve WF_ZX_Arb_Swap_Semantics : wf_db. - -(* Semantics for useful definitions and notations *) - -Lemma nStack1A_n_kron : forall n (zx : ZX_Arb_Swaps 1 1), ZX_Arb_Swaps_Semantics (n ↑A zx) = n ⨂ ZX_Arb_Swaps_Semantics zx. -Proof. - intros. - induction n. - - unfold nStack. reflexivity. - - simpl. - rewrite IHn. - restore_dims. - rewrite <- kron_n_assoc; auto. - apply WF_ZX_Arb_Swap_Semantics. -Qed. - -Lemma ArbWire_semantics : ZX_Arb_Swaps_Semantics (ArbWire) = I 2. -Proof. - simpl. - replace (Z_semantics 1 1 0) with (ZX_semantics Wire); [ | reflexivity ]. - apply wire_identity_semantics. -Qed. - -Opaque ArbWire. - - -Lemma nArbWire_semantics : forall n, ZX_Arb_Swaps_Semantics (nArbWire n) = I (2 ^ n). -Proof. - intros. - simpl. - induction n. - - easy. - - simpl. - replace (2 ^ n + (2 ^ n + 0))%nat with (2 * 2 ^ n)%nat by lia. - rewrite <- id_kron. - rewrite <- IHn. - rewrite ArbWire_semantics. - easy. -Qed. - -Lemma A_Swap_2_is_swap : A_Swap_semantics 2 = swap. -Proof. - simpl. - unfold Bottom_wire_to_top. - simpl. - rewrite id_transpose_eq. - repeat rewrite kron_1_r. - repeat rewrite id_kron. - simpl. - repeat rewrite Mmult_1_l. - 1: reflexivity. - 1-3: auto with wf_db. -Qed. - -(* Proving correctness of conversion *) - -Lemma Top_to_bottom_correct : forall n, ZX_semantics (ZX_top_to_bottom n) = Top_wire_to_bottom n. -Proof. - intros. - destruct n; [ reflexivity | ]. - destruct n; [ apply wire_identity_semantics | ]. - induction n. - - simpl. - rewrite wire_identity_semantics. - Local Transparent nWire. - unfold nWire. - simpl. - reflexivity. - - simpl. - simpl in IHn. - rewrite <- IHn. - rewrite wire_identity_semantics. - rewrite nwire_identity_semantics. - rewrite nStack1_n_kron. - rewrite wire_identity_semantics. - rewrite <- kron_n_assoc; [ | auto with wf_db ]. - reflexivity. -Qed. - -Lemma Bottom_to_top_correct : forall n, ZX_semantics (ZX_bottom_to_top n) = Bottom_wire_to_top n. -Proof. - intros. - unfold ZX_bottom_to_top. - unfold Bottom_wire_to_top. - rewrite ZX_semantics_Transpose_comm. - rewrite Top_to_bottom_correct. - reflexivity. -Qed. - -Opaque ZX_bottom_to_top. -Opaque ZX_top_to_bottom. - -Lemma A_Swap_Correct : forall n, ZX_semantics (A_Swap_ZX n) = A_Swap_semantics n. -Proof. - intros. - unfold A_Swap_semantics. - destruct n; [ reflexivity | ]. - destruct n. - - simpl. - rewrite <- eq_rect_eq. - simpl. - rewrite wire_identity_semantics. - rewrite Bottom_to_top_correct. - rewrite Top_to_bottom_correct. - reflexivity. - - rewrite <- Bottom_to_top_correct. - rewrite <- Top_to_bottom_correct. - simpl. - elim_eq_rect. - elim_eq_rect. - rewrite <- eq_rect_eq. - simpl. - rewrite wire_identity_semantics. - reflexivity. -Qed. - -Program Lemma ZX_Arb_to_ZX_semantics {nIn nOut} : - forall (zxa : ZX_Arb_Swaps nIn nOut), - (ZX_Arb_Swaps_Semantics zxa) = (ZX_semantics (ZX_Arb_to_ZX zxa)). -Proof. - induction zxa; try auto. - 1-2 : simpl; rewrite <- IHzxa1, IHzxa2; auto. - symmetry. - apply A_Swap_Correct. -Qed. - -Definition Arb_Swaps_proportional {nIn nOut} (zx0 : ZX_Arb_Swaps nIn nOut) (zx1 : ZX_Arb_Swaps nIn nOut) := - proportional_general ZX_Arb_Swaps_Semantics zx0 zx1. - -Infix "∝A" := Arb_Swaps_proportional (at level 70). - -Lemma Arb_Swaps_proportional_refl : forall {nIn nOut} (zx : ZX_Arb_Swaps nIn nOut), zx ∝A zx. -Proof. - intros. - apply proportional_general_refl. -Qed. - -Lemma Arb_Swaps_proportional_symm : forall {nIn nOut} (zx0 zx1 : ZX_Arb_Swaps nIn nOut), - zx0 ∝A zx1 -> zx1 ∝A zx0. -Proof. - intros. - apply proportional_general_symm; assumption. -Qed. - -Lemma Arb_Swaps_proportional_trans : forall {nIn nOut} (zx0 zx1 zx2 : ZX_Arb_Swaps nIn nOut), - zx0 ∝A zx1 -> zx1 ∝A zx2 -> zx0 ∝A zx2. -Proof. - intros. - apply (proportional_general_trans _ _ _ ZX_Arb_Swaps_Semantics zx0 zx1 zx2); assumption. -Qed. - -Add Parametric Relation (nIn nOut : nat) : (ZX_Arb_Swaps nIn nOut) (@Arb_Swaps_proportional nIn nOut) - reflexivity proved by Arb_Swaps_proportional_refl - symmetry proved by Arb_Swaps_proportional_symm - transitivity proved by Arb_Swaps_proportional_trans - as zx_Arb_Swaps_prop_equiv_rel. - -Lemma Arb_Swaps_stack_compat : - forall nIn0 nOut0 nIn1 nOut1, - forall zx0 zx1 : ZX_Arb_Swaps nIn0 nOut0, zx0 ∝A zx1 -> - forall zx2 zx3 : ZX_Arb_Swaps nIn1 nOut1, zx2 ∝A zx3 -> - zx0 ↕A zx2 ∝A zx1 ↕A zx3. -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - lma. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn0 nOut0 nIn1 nOut1 : nat) : (@AS_Stack nIn0 nIn1 nOut0 nOut1) - with signature (@Arb_Swaps_proportional nIn0 nOut0) ==> (@Arb_Swaps_proportional nIn1 nOut1) ==> - (@Arb_Swaps_proportional (nIn0 + nIn1) (nOut0 + nOut1)) as Arb_Swaps_stack_mor. -Proof. apply Arb_Swaps_stack_compat; assumption. Qed. - -Lemma Arb_Swaps_compose_compat : - forall nIn nMid nOut, - forall zx0 zx1 : ZX_Arb_Swaps nIn nMid, zx0 ∝A zx1 -> - forall zx2 zx3 : ZX_Arb_Swaps nMid nOut, zx2 ∝A zx3 -> - (AS_Compose zx0 zx2) ∝A (AS_Compose zx1 zx3). -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - simpl. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - rewrite Mscale_mult_dist_r. - rewrite Mscale_mult_dist_l. - restore_dims. - rewrite Mscale_assoc. - reflexivity. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn nMid nOut : nat) : (@AS_Compose nIn nMid nOut) - with signature (@Arb_Swaps_proportional nIn nMid) ==> (@Arb_Swaps_proportional nMid nOut) ==> - (@Arb_Swaps_proportional nIn nOut) as Arb_Swaps_compose_mor. -Proof. apply Arb_Swaps_compose_compat; assumption. Qed. - -(* Injestion to ZX_Arb_Swaps *) - -Lemma sub_add_b : forall (dim1 dim2 : nat), dim1 <=? dim2 = true -> ((dim2 - dim1 + dim1) = dim2)%nat. -Proof. - intros. - apply Nat.sub_add. - apply leb_complete. - apply H. -Qed. - -Lemma add_sub_mid' : forall a b c, (a - b + b - b + c)%nat = (a - b + c)%nat. -Proof. intros; lia. Qed. - -Definition Pad_Above {nIn nOut : nat} (dim : nat) (zxa : ZX_Arb_Swaps nIn nOut) : ZX_Arb_Swaps dim ((dim - nIn) + nOut). -Proof. - specialize (le_dec nIn dim); intros. - destruct H. - - rewrite <- (Nat.sub_add nIn dim); [ | exact l]. - rewrite add_sub_mid'. - apply AS_Stack; [ apply nArbWire | apply zxa ]. - - apply ZX_AS_Z_spider; apply 0%R. -Defined. - -Lemma Pad_Above_Sem : forall {nIn nOut} dim (zxa : ZX_Arb_Swaps nIn nOut), nIn <= dim -> ZX_Arb_Swaps_Semantics (Pad_Above dim zxa) = ZX_Arb_Swaps_Semantics ((nArbWire (dim - nIn)) ↕A zxa). -Proof. - intros. - unfold Pad_Above. - destruct (le_dec nIn dim); [ | congruence ]. - simplify_eqs. - unfold eq_rec_r. - unfold eq_rec. - simpl_eqs. - replace (dim - nIn + nIn - nIn)%nat with (dim - nIn)%nat by lia. - easy. -Qed. - -Fixpoint Pad_Above_Fence {nIn nOut : nat} (dim : nat) (zxa : ZX_Arb_Swaps nIn nOut) : ZX_Arb_Swaps dim ((dim - nIn) + nOut). -Proof. - remember zxa. - destruct zxa. - 1-7: apply Pad_Above; assumption. - eapply (AS_Compose). - - apply Pad_Above_Fence. - apply zxa1. - - rewrite Nat.add_comm. - rewrite (Nat.add_comm _ nOut). - apply AS_Stack. - apply zxa2. - apply nArbWire. - - apply Pad_Above; assumption. -Qed. - -Lemma add_sub_mid : forall a b, (b + (a - b) - b)%nat = (a - b)%nat. -Proof. intros; lia. Qed. - - -Definition Pad_Below {nIn nOut : nat} (dim : nat) (zxa : ZX_Arb_Swaps nIn nOut) : ZX_Arb_Swaps dim (nOut + (dim - nIn)). -Proof. - specialize (le_dec nIn dim); intros. - destruct H. - - rewrite <- (Nat.sub_add nIn dim); [ | exact l]. - rewrite Nat.add_comm. - apply AS_Stack; [ apply zxa | ]. - rewrite add_sub_mid. - apply nArbWire. - - apply ZX_AS_Z_spider; apply 0%R. -Defined. - -Lemma Pad_Below_Sem : forall {nIn nOut} dim (zxa : ZX_Arb_Swaps nIn nOut), nIn <= dim -> ZX_Arb_Swaps_Semantics (Pad_Below dim zxa) = ZX_Arb_Swaps_Semantics (zxa ↕A (nArbWire (dim - nIn))). -Proof. - intros. - unfold Pad_Below. - destruct (le_dec nIn dim); [ | congruence ]. - simplify_eqs. - simpl_eqs. - unfold eq_rec_r. - unfold eq_rec. - simpl_eqs. - easy. -Qed. - -Program Definition ASwapfromto {dim : nat} (pos1 pos2 : nat) (prf1 : pos1 <= dim) (prf2 : pos2 <= dim) : ZX_Arb_Swaps dim dim := - if (pos1 y <= z -> x <= z. -Proof. intros. lia. Qed. - -Lemma ASwapfromto_Sem_p1_le_p2 : forall {dim} pos1 pos2 (prf : pos1 < pos2) (prf2 : pos2 <= dim), ZX_Arb_Swaps_Semantics (@ASwapfromto dim pos1 pos2 (lt_ge_trans prf prf2) prf2) = ZX_Arb_Swaps_Semantics ((nArbWire (pos1) ↕A (A_Swap (pos2 - pos1)) ↕A nArbWire (dim - pos2))). -Proof. - intros. - unfold ASwapfromto. - assert (pos1 = 1) := (Pad_Below (S dim) (Pad_Above (S control) (ZX_AS_Z_spider 1 2 0 ↕A ArbWire))) ⟷A (Pad_Below (S (S dim)) (Pad_Above (S control) (ArbWire ↕A ZX_AS_X_spider 2 1 0))). -Next Obligation. - intros. lia. -Qed. - -Program Definition PaddedCnot {dim : nat} (control : nat) (prf : S control <= dim) (prf2 : control >= 1) : ZX_Arb_Swaps dim dim := - Pad_Below dim (Pad_Above (S control) ZX_AS_CNOT). -Next Obligation. - intros. lia. -Qed. - -Lemma PaddedCnotFencpost_Sem : forall {dim} control (Hc : control >= 1) (Hdim : S control <= dim), ZX_Arb_Swaps_Semantics (@PaddedCnot dim control Hdim Hc) = ZX_Arb_Swaps_Semantics (@PaddedCnotFencePost dim control Hdim Hc). -Proof. - intros. - unfold PaddedCnot. - unfold PaddedCnotFencePost. - simpl_eqs. - rewrite Pad_Below_Sem; [ | assumption ]. - unfold ZX_AS_CNOT. - rewrite (Pad_Above_Sem); [ | apply le_n_S; assumption ]. - simpl. - reflexivity. -Qed. - -Program Definition CNOTInj {dim : nat} (pos1 pos2 : nat) : ZX_Arb_Swaps dim dim := - if (pos1 base_ucom_to_ZX ucl ⟷A base_ucom_to_ZX ucr -| uapp1 U1 n => match U1 with - | U_R θ ϕ λ => ZX_ucom_rot_FencePost n θ ϕ λ - end -| uapp2 U2 n m => match U2 with - | U_CNOT => CNOTInj n m - end -| uapp3 U3 n m l => match U3 with - end -end. - - -Program Lemma ZX_AS_Stack_assoc : forall {nIn0 nOut0 nIn1 nOut1 nIn2 nOut2} (zx0 : ZX_Arb_Swaps nIn0 nOut0) (zx1 : ZX_Arb_Swaps nIn1 nOut1) (zx2 : ZX_Arb_Swaps nIn2 nOut2), - zx0 ↕A (zx1 ↕A zx2) ∝A zx0 ↕A zx1 ↕A zx2. -Proof. - intros. - prop_exists_nonzero (RtoC 1). - prop_exists_nonzero (RtoC 1). - simpl_eqs. - Msimpl. - rewrite kron_assoc; auto with wf_db. -Qed. - -Program Lemma ZX_AS_Stack_assoc' : forall {nIn0 nOut0 nIn1 nOut1 nIn2 nOut2} (zx0 : ZX_Arb_Swaps nIn0 nOut0) (zx1 : ZX_Arb_Swaps nIn1 nOut1) (zx2 : ZX_Arb_Swaps nIn2 nOut2), - zx0 ↕A zx1 ↕A zx2 ∝A zx0 ↕A (zx1 ↕A zx2). -Proof. - intros. - prop_exists_nonzero (RtoC 1). - simpl_eqs. - Msimpl. - rewrite kron_assoc; auto with wf_db. -Qed. - -Lemma nArbWire_r : forall n, nArbWire (n + 1) ∝A (nArbWire n) ↕A ArbWire. -Proof. - intros. - induction n. - - simpl. - unfold nArbWire. - simpl. - prop_exists_nonzero (RtoC 1). - simpl. - Msimpl; auto with wf_db. - apply WF_ZX_Arb_Swap_Semantics. - - simpl. - unfold nArbWire in *. - simpl. - rewrite IHn. - rewrite ZX_AS_Stack_assoc. - simpl_eqs. - easy. -Qed. - -Lemma ZX_A_1_1_pad_distr : forall {dim} zx0 zx1 n, (@ZX_A_1_1_pad dim n zx0) ⟷A (@ZX_A_1_1_pad dim n zx1) ∝A (@ZX_A_1_1_pad dim n (zx0 ⟷A zx1)). -Proof. - intro dim. - induction dim; intros. - - simpl. - prop_exists_nonzero 1%R. - simpl. - Msimpl. - easy. - - simpl. - destruct n. - + prop_exists_nonzero 1%R; simpl. - restore_dims. - rewrite kron_mixed_product. - rewrite nArbWire_semantics. - Msimpl. - easy. - + unfold Arb_Swaps_proportional, proportional_general in IHdim. - specialize (IHdim zx0 zx1 n). - destruct IHdim as [c IHdim]. - destruct IHdim as [IHdim cneq0]. - prop_exists_nonzero c; [ clear cneq0 | assumption]. - simpl. - restore_dims. - rewrite kron_mixed_product. - rewrite ArbWire_semantics. - rewrite <- Mscale_kron_dist_r. - Msimpl. - apply kron_simplify; [ easy | ]. - apply IHdim. -Qed. - -Lemma S_PostPred : forall n (zx : ZX_Arb_Swaps n n) (zx1 : ZX_Arb_Swaps 1 1), ZX_A_PostPred zx -> ZX_A_PostPred zx1 -> ZX_A_PostPred (AS_Stack zx1 zx). -Proof. - intros. - constructor; assumption. -Qed. - -Lemma ArbWire_PostPred : ZX_A_PostPred (ArbWire). -Proof. - Local Transparent ArbWire. - unfold ArbWire. - constructor. - Local Opaque ArbWire. -Qed. - -Lemma nStack1_PostPred : forall n (zx : ZX_Arb_Swaps 1 1), ZX_A_PostPred zx -> ZX_A_PostPred (nStack1 n zx). -Proof. - intros. - induction n. - - simpl; constructor. - - simpl; apply S_PostPred; assumption. -Qed. - -Lemma nArbWire_PostPred : forall n, ZX_A_PostPred (nArbWire n). - intros. - unfold nArbWire. - apply nStack1_PostPred. - apply ArbWire_PostPred. -Qed. - -Lemma ZX_A_1_1_pad_FencePost : forall {dim} zx n, ZX_A_PostPred zx -> ZX_A_PostPred (@ZX_A_1_1_pad dim n zx). -Proof. - intro dim. - induction dim; intros. - - simpl; constructor. - - simpl. - destruct n. - + apply S_PostPred; [ apply nArbWire_PostPred | assumption ]. - + apply S_PostPred; [ | apply ArbWire_PostPred ]. - apply IHdim. - assumption. -Qed. - -Lemma ZX_A_Compose_assoc : forall {nIn nMid0 nMid1 nOut} (zx0 : ZX_Arb_Swaps nIn nMid0) (zx1 : ZX_Arb_Swaps nMid0 nMid1) (zx2 : ZX_Arb_Swaps nMid1 nOut), zx0 ⟷A zx1 ⟷A zx2 ∝A zx0 ⟷A (zx1 ⟷A zx2). -Proof. - intros. - prop_exists_nonzero 1%R. - Msimpl. - simpl. - rewrite Mmult_assoc. - easy. -Qed. - - -Lemma ZX_ucom_rot_FencePost_is_ZX_ucom_rot : forall dim n x y z, (@ZX_ucom_rot_FencePost dim n x y z) ∝A @ZX_A_1_1_pad dim n (ZX_ucom_rot x y z). -Proof. - intros. - unfold ZX_ucom_rot, ZX_ucom_rot_FencePost, ZX_AS_Y. - repeat rewrite ZX_A_1_1_pad_distr. - easy. -Qed. - -Lemma ZX_ucom_rot_FencePost_FencePred: forall dim n x y z, ZX_A_FencePred (@ZX_ucom_rot_FencePost dim n x y z). -Proof. - intros. - unfold ZX_ucom_rot_FencePost. - apply A_FenceCompose. - apply A_FenceCompose. - apply A_FenceCompose; apply A_FenceCompose. - apply A_FenceCompose. - all : constructor; apply ZX_A_1_1_pad_FencePost; constructor. -Qed. - -Lemma Pad_Above_PostPred : forall {dim1 : nat} (dim2 : nat) (zxa : ZX_Arb_Swaps dim1 dim1), ZX_A_PostPred zxa -> ZX_A_PostPred (@Pad_Above dim1 dim2 zxa). -Proof. - intros. - unfold Pad_Above. - destruct le_dec. - - simpl_eqs. - constructor. - apply nArbWire_PostPred. - assumption. - - apply nArbWire_PostPred. -Qed. - -Lemma Pad_Below_PostPred : forall {dim1 : nat} (dim2 : nat) (zxa : ZX_Arb_Swaps dim1 dim1), ZX_A_PostPred zxa -> ZX_A_PostPred (@Pad_Above dim1 dim2 zxa). -Proof. - intros. - unfold Pad_Above. - destruct le_dec. - - simpl_eqs. - constructor. - apply nArbWire_PostPred. - assumption. - - apply nArbWire_PostPred. -Qed. - -Lemma ZX_CNOTInj_Fencepred : forall dim n m, ZX_A_FencePred (@CNOTInj dim n m). -Proof. - intros. - unfold CNOTInj. - destruct (n @ZX_A_1_1_pad (dim + 1) n zx ∝A @ZX_A_1_1_pad dim n zx ↕A ArbWire. -Proof. - intro dim. - induction dim; intros. - - simpl. - exfalso. - lia. - - simpl. - destruct n. - + specialize (IHdim zx 0). - rewrite nArbWire_r. - rewrite (ZX_AS_Stack_assoc' zx _ _). - simpl_eqs. - easy. - + rewrite IHdim; [ | lia ]. - rewrite (ZX_AS_Stack_assoc' ArbWire _ _). - simpl_eqs. - easy. -Qed. - -Lemma rot_sem_base : forall a b c, ZX_Arb_Swaps_Semantics (ZX_ucom_rot a b c) = rotation a b c. -Proof. - intros. - unfold ZX_ucom_rot. - simpl. - unfold rotation. - unfold_spider. - autorewrite with Cexp_db. - replace (1 ⨂ hadamard) with hadamard. - 2: { simpl. Msimpl; try apply WF_hadamard; easy. } - solve_matrix. -Admitted. - -Lemma pad_1_1_sem_eq : forall {dim} n (zx : ZX_Arb_Swaps 1 1) A, ZX_Arb_Swaps_Semantics zx = A -> n < dim -> Pad.pad_u dim n A = ZX_Arb_Swaps_Semantics (@ZX_A_1_1_pad dim n zx). -Proof. - intros. - simpl. - assert (WF_Matrix A) by (rewrite <- H; auto with wf_db). - generalize dependent n. - induction dim; intros. - - exfalso. - lia. - - simpl. - destruct n. - Set Printing Implicit. - + unfold Pad.pad_u, Pad.pad. - assert (0 + 1 <=? S dim = true) by (apply leb_correct; lia). - rewrite H2. - Msimpl. - simpl. - rewrite nArbWire_semantics. - replace (dim - 0)%nat with dim by lia. - apply kron_simplify; [ | easy]. - easy. - + simpl. - rewrite <- IHdim; [ | lia ]. - unfold Pad.pad_u, Pad.pad. - assert (S n + 1 <=? S dim = true) by (apply leb_correct; lia). - assert (n + 1 <=? dim = true) by (apply leb_correct; lia). - rewrite H2, H3. - rewrite ArbWire_semantics. - rewrite (kron_assoc (I (2 ^ n)) _ _); try auto with wf_db. - restore_dims. - rewrite <- (kron_assoc (I 2) _ _); try auto with wf_db. - rewrite id_kron. - replace (2 * 2 ^ n)%nat with (2 ^ (S n))%nat by reflexivity. - rewrite <- kron_assoc; try auto with wf_db. -Qed. - -Lemma rot_sem_eq : forall {dim} a b c n, n < dim -> @uc_eval dim (uapp1 (U_R a b c) n) = ZX_Arb_Swaps_Semantics (@ZX_A_1_1_pad dim n (ZX_ucom_rot a b c)). -Proof. - intros. - apply pad_1_1_sem_eq; [ | assumption ]. - apply rot_sem_base. -Qed. - -Lemma CNOT_sem_eq : forall {dim} n n0, exists c, @uc_eval dim (uapp2 U_CNOT n n0) = c .* ZX_Arb_Swaps_Semantics (@CNOTInj dim n n0) /\ c <> 0%R. -Proof. -Admitted. - -Theorem equal_sem : forall dim (u : base_ucom dim), uc_well_typed u -> exists (c : C), ZX_Arb_Swaps_Semantics (base_ucom_to_ZX u) = c .* uc_eval u /\ c <> 0%R. -Proof. - intros dim u. - induction u; intros. - - simpl. - inversion H; subst. - specialize (IHu1 H2). - specialize (IHu2 H3). - destruct IHu1 as [c1 [IHu1 Hc1]]. - destruct IHu2 as [c2 [IHu2 Hc2]]. - exists (c1 * c2). - split; [ | apply Cmult_neq_0; assumption ]. - rewrite IHu1, IHu2. - autorewrite with scalar_move_db. - easy. - - simpl. - dependent destruction u. - inversion H. - assert (forall (dim n : nat) (x y z : R), - ZX_ucom_rot_FencePost n x y z ∝A ZX_A_1_1_pad n (ZX_ucom_rot x y z)) by exact ZX_ucom_rot_FencePost_is_ZX_ucom_rot. - specialize (H3 dim n r r0 r1). - unfold Arb_Swaps_proportional, proportional_general in H3. - destruct H3 as [c1 [Hucom_rot Hc1]]. - rewrite Hucom_rot. - rewrite <- rot_sem_eq; [ | assumption ]. - simpl. - eauto. - - simpl. - dependent destruction u. - assert (exists c, @uc_eval dim (uapp2 U_CNOT n n0) = c .* ZX_Arb_Swaps_Semantics (@CNOTInj dim n n0) /\ c <> 0%R) by apply CNOT_sem_eq. - destruct H0 as [c1 [HCnot Hc1]]. - simpl in HCnot. - rewrite HCnot. - exists (/ c1). - autorewrite with scalar_move_db. - rewrite <- (Mscale_1_l _ _ (ZX_Arb_Swaps_Semantics _)). - split; [ | apply nonzero_div_nonzero; assumption ]. - apply Mscale_simplify; [ lma | ]. - symmetry; apply Cinv_l. - assumption. - - dependent destruction u. -Qed. - -Local Open Scope R_scope. - -Lemma increase_Z {α} {nIn nOut} : Z_Spider nIn nOut α ∝ Z_Spider nIn nOut (α + (2 * PI)). -Proof. - prop_exists_nonzero 1. - rewrite Mscale_1_l. - simpl. - unfold_spider. - rewrite Cexp_add. - rewrite Cexp_2PI. - rewrite Cmult_1_r. - reflexivity. -Qed. - -Lemma reduce_Z {α} {nIn nOut} : Z_Spider nIn nOut α ∝ Z_Spider nIn nOut (α - (2 * PI)). -Proof. - prop_exists_nonzero 1. - rewrite Mscale_1_l. - simpl. - unfold_spider. - rewrite Rminus_unfold. - rewrite Cexp_add. - rewrite Cexp_neg. - rewrite Cexp_2PI. - rewrite <- (Cmult_1_l (/C1)). - rewrite Cinv_r; try nonzero. - rewrite Cmult_1_r. - reflexivity. -Qed. - -Lemma increase_X {α} {nIn nOut} : X_Spider nIn nOut α ∝ X_Spider nIn nOut (α + (2 * PI)). -Proof. swap_colors_of (@increase_Z α). Qed. - -Lemma reduce_X {α} : X_Spider 1 1 α ∝ X_Spider 1 1 (α - (2 * PI)). -Proof. swap_colors_of (@reduce_Z α). Qed. - -Local Close Scope ucom. -Local Close Scope R_scope. diff --git a/src/.Old/Scalars.v b/src/.Old/Scalars.v deleted file mode 100644 index a429270..0000000 --- a/src/.Old/Scalars.v +++ /dev/null @@ -1,242 +0,0 @@ -Require Import CoreData. - -Local Open Scope ZX_scope. - -Lemma Scalar_general : forall (zx : ZX 0 0), ZX_semantics zx = ((ZX_semantics zx) 0%nat 0%nat) .* I 1. -Proof. - intros. - prep_matrix_equality. - simpl. - assert (Hgt : forall a : nat, (S a >= 1)%nat). - { - intros. - induction a. - - auto. - - constructor; assumption. - } - destruct x; destruct y. - - unfold scale. - unfold I. - simpl. - rewrite Cmult_1_r. - reflexivity. - - assert (HZX : ZX_semantics zx 0%nat (S y) = 0). - { - rewrite (WF_ZX _ _ zx 0%nat (S y)). - + reflexivity. - + right; apply Hgt. - } - assert (HI : I 1 0%nat (S y) = 0). - { - rewrite (WF_I _ 0%nat (S y)); try reflexivity. - right; apply Hgt. - } - rewrite HZX; unfold scale; rewrite HI. - rewrite Cmult_0_r. - reflexivity. - - assert (HZX : ZX_semantics zx (S x) 0%nat = 0). - { - rewrite (WF_ZX _ _ zx (S x) 0%nat). - + reflexivity. - + left; apply Hgt. - } - assert (HI : I 1 (S x) 0%nat = 0). - { - rewrite (WF_I _ (S x) 0%nat); try reflexivity. - left; apply Hgt. - } - rewrite HZX; unfold scale; rewrite HI. - rewrite Cmult_0_r. - reflexivity. - - assert (HZX : ZX_semantics zx (S x) (S y) = 0). - { - rewrite (WF_ZX _ _ zx (S x) (S y)). - + reflexivity. - + left; apply Hgt. - } - assert (HI : I 1 (S x) (S y) = 0). - { - rewrite (WF_I _ (S x) (S y)); try reflexivity. - left; apply Hgt. - } - rewrite HZX; unfold scale; rewrite HI. - rewrite Cmult_0_r. - reflexivity. -Qed. - -Ltac solve_scalar := intros; rewrite Scalar_general; apply Mscale_simplify; try reflexivity. - -Definition Scalar_1_plus_Cexp_alpha α := Z_Spider 0 0 α. - -Theorem Scalar_Z_general : forall α, (ZX_semantics (Scalar_1_plus_Cexp_alpha α)) = (1 + Cexp(α)) .* I 1. -Proof. solve_scalar. Qed. - -Global Opaque Scalar_1_plus_Cexp_alpha. - -Definition Scalar_2 := Scalar_1_plus_Cexp_alpha 0. - -Theorem Scalar_Z_0_2 : (ZX_semantics Scalar_2) = 2 .* I 1. -Proof. - unfold Scalar_2. - rewrite Scalar_Z_general. - rewrite Cexp_0. - lma. -Qed. - -Global Opaque Scalar_2. - -Definition Scalar_0 := Scalar_1_plus_Cexp_alpha PI. - -Theorem Scalar_Z_PI_0: (ZX_semantics Scalar_0) = 0 .* I 1. -Proof. - unfold Scalar_0. - rewrite Scalar_Z_general. - autorewrite with Cexp_db. - solve_matrix. -Qed. - -Global Opaque Scalar_0. - -Definition Scalar_sqrt_2 := Compose (X_Spider 0 1 0) (Z_Spider 1 0 0). - -Theorem Scalar_X_alpha_Z_0_sqrt_2 : (ZX_semantics Scalar_sqrt_2) = (√2) .* I 1. -Proof. - solve_scalar. - unfold Scalar_sqrt_2. - simpl. - unfold Mmult. - simpl. - rewrite Cplus_0_l. - unfold Z_semantics. - unfold X_semantics. - simpl. - rewrite Cexp_0. - rewrite 2 Cmult_1_l. - rewrite kron_1_l; try auto with wf_db. - unfold Mmult; simpl. - unfold I; simpl. - unfold Z_semantics; simpl. - repeat rewrite (Cplus_0_l). - rewrite Cexp_0. - repeat rewrite Cmult_1_r. - rewrite Cplus_opp_r. - rewrite Cplus_0_r. - rewrite Cdiv_unfold. - rewrite Cmult_1_l. - rewrite <- Cdouble. - rewrite <- Csqrt2_sqrt. - rewrite <- Cmult_assoc. - rewrite Cinv_r; try nonzero. - rewrite Cmult_1_r. - reflexivity. -Qed. - -Global Opaque Scalar_sqrt_2. - -Definition Scalar_Cexp_alpha_times_sqrt_2 α := Compose (X_Spider 0 1 α) (Z_Spider 1 0 PI). - -Opaque Ropp. - -Theorem Scalar_X_alpha_Z_PI_sqrt_2 : forall α, (ZX_semantics (Scalar_Cexp_alpha_times_sqrt_2 α)) = (√2 * Cexp(α)) .* I 1. -Proof. - solve_scalar. - unfold Scalar_Cexp_alpha_times_sqrt_2. - simpl. - unfold Mmult; simpl. - autorewrite with Cexp_db. - rewrite Cmult_1_l. - rewrite Cplus_0_l. - unfold X_semantics. - unfold Mmult; simpl. - repeat rewrite Cplus_0_l. - rewrite kron_1_l; [ | auto with wf_db]. - unfold I; simpl. - C_field_simplify; [ | nonzero]. - lca. -Qed. - -Global Opaque Scalar_Cexp_alpha_times_sqrt_2. - -Definition Scalar_1_div_sqrt_2 := Compose (Z_Spider 0 3 0) (X_Spider 3 0 0). - - -Theorem Scalar_X_Z_triple_1_sqrt_2 : (ZX_semantics Scalar_1_div_sqrt_2) = (1 / √ 2) .* I 1. -Proof. - solve_scalar. - unfold Scalar_1_div_sqrt_2. - simpl. - simpl. - unfold Mmult; simpl. - rewrite Cplus_0_l. - unfold Z_semantics; simpl. - repeat rewrite Cmult_0_r. - repeat rewrite Cplus_0_r. - rewrite Cexp_0. - rewrite 2 Cmult_1_r. - unfold X_semantics; simpl. - unfold Mmult; simpl. - repeat rewrite Cplus_0_l. - rewrite kron_1_l; try auto with wf_db. - unfold I; simpl. - repeat rewrite Cmult_1_l. - unfold kron; simpl. - unfold hadamard; simpl. - unfold Z_semantics; simpl. - repeat rewrite Cmult_0_l. - repeat rewrite Cplus_0_r. - rewrite Cexp_0. - repeat rewrite Cmult_1_l. - rewrite <- Copp_mult_distr_l. - rewrite <- 2 Copp_mult_distr_r. - rewrite Copp_involutive. - rewrite Cplus_opp_r. - rewrite Cplus_0_r. - repeat rewrite Cdiv_unfold. - repeat rewrite Cmult_1_l. - rewrite <- Cdouble. - rewrite Cinv_sqrt2_sqrt. - rewrite Cmult_assoc. - rewrite Cinv_r; try nonzero. - lca. -Qed. - -Global Opaque Scalar_1_div_sqrt_2. - -Theorem Scalar_n_stack : forall (zx : ZX 0 0) c n, ZX_semantics zx = c .* I 1 -> ZX_semantics (nStack n zx) = c ^ n .* I 1. -Proof. - intros. - induction n. - - symmetry; apply Mscale_1_l. - - simpl. rewrite IHn, H. - rewrite Mscale_kron_dist_l. - Msimpl; try restore_dims. - + apply Mscale_assoc. - + replace (I 1) with (I (2 ^ (n * 0))). - * restore_dims. - auto with wf_db. - * rewrite mult_0_r. - rewrite Nat.pow_0_r. - reflexivity. -Qed. - -Hint Rewrite Scalar_X_Z_triple_1_sqrt_2 Scalar_X_alpha_Z_PI_sqrt_2 Scalar_X_alpha_Z_0_sqrt_2 Scalar_Z_PI_0 Scalar_Z_0_2 Scalar_Z_general : zx_scalar_db. - -Lemma Scalar_1_div_sqrt_2_sqrt_identity : ZX_semantics (Stack Scalar_1_div_sqrt_2 Scalar_sqrt_2) = ZX_semantics ⦰. -Proof. - simpl. - autorewrite with zx_scalar_db. - rewrite Mscale_kron_dist_r. - Msimpl. - rewrite Mscale_assoc. - solve_matrix. -Qed. - -Lemma Scalar_kron : forall c c', (c .* (I 1)) ⊗ (c' .* (I 1)) = c * c' .* I 1. -Proof. - intros. - solve_matrix. -Qed. - -Hint Rewrite Scalar_1_div_sqrt_2_sqrt_identity Scalar_kron : zx_scalar_db. - -Local Close Scope ZX_scope. diff --git a/src/.Old/ZX_A_G_2.v b/src/.Old/ZX_A_G_2.v deleted file mode 100644 index 6bef865..0000000 --- a/src/.Old/ZX_A_G_2.v +++ /dev/null @@ -1,1661 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.VectorStates. -Require Export ZX. -Require Export ZX_G_2. -Require Export Gates. -Require Export GateRules. -Require Export Rules. -Require Export VyZX.Proportional. -Require Import Setoid. -Require Import Coq.Logic.Eqdep_dec. -Require Import Coq.Arith.Peano_dec. -Require Import Coq.Structures.OrderedType. -Require Import Coq.FSets.FMapAVL. - -Local Open Scope R_scope. -Inductive A_G2_ZX : nat (* #inputs *) -> nat (* #outputs *) -> Type := - | A_G2_Empty : forall n : nat, A_G2_ZX 0 0 - | A_G2_Z_Spider_1_0 (α : R) : forall n : nat, A_G2_ZX 1 0 - | A_G2_Z_Spider_0_1 (α : R) : forall n : nat, A_G2_ZX 0 1 - | A_G2_Z_Spider_1_1 (α : R) : forall n : nat, A_G2_ZX 1 1 (* Required to build wire construct *) - | A_G2_Z_Spider_1_2 (α : R) : forall n : nat, A_G2_ZX 1 2 - | A_G2_Z_Spider_2_1 (α : R) : forall n : nat, A_G2_ZX 2 1 - | A_G2_Cap : forall n : nat, A_G2_ZX 0 2 - | A_G2_Cup : forall n : nat, A_G2_ZX 2 0 - | A_G2_Swap : forall n : nat, A_G2_ZX 2 2 - | A_G2_Stack {nIn0 nIn1 nOut0 nOut1} - (zx0 : A_G2_ZX nIn0 nOut0) - (zx1 : A_G2_ZX nIn1 nOut1) : - forall n : nat, A_G2_ZX (nIn0 + nIn1) (nOut0 + nOut1) - | A_G2_Compose {nIn nMid nOut} - (zx0 : A_G2_ZX nIn nMid) - (zx1 : A_G2_ZX nMid nOut) : - forall n : nat, A_G2_ZX nIn nOut. -Local Close Scope R_scope. - -Notation "⦰AG2" := A_G2_Empty. (* \revemptyset *) -Notation "⊂AG2" := A_G2_Cap. (* \subset *) -Notation "⊃AG2" := A_G2_Cup. (* \supset *) -Notation "⨉AG2" := A_G2_Swap. (* \bigtimes *) - -Fixpoint A_G2_ZX_semantics {nIn nOut} (zx : A_G2_ZX nIn nOut) : - Matrix (2 ^ nOut) (2 ^nIn) := - match zx with - | ⦰AG2 _ => G2_ZX_semantics ⦰G2 - | A_G2_Z_Spider_1_0 α _ => G2_ZX_semantics (G2_Z_Spider_1_0 α) - | A_G2_Z_Spider_0_1 α _ => G2_ZX_semantics (G2_Z_Spider_0_1 α) - | A_G2_Z_Spider_1_1 α _ => G2_ZX_semantics (G2_Z_Spider_1_1 α) - | A_G2_Z_Spider_1_2 α _ => G2_ZX_semantics (G2_Z_Spider_1_2 α) - | A_G2_Z_Spider_2_1 α _ => G2_ZX_semantics (G2_Z_Spider_2_1 α) - | A_G2_Cap _ => G2_ZX_semantics (G2_Cap) - | A_G2_Cup _ => G2_ZX_semantics (G2_Cup) - | A_G2_Swap _ => G2_ZX_semantics (G2_Swap) - | A_G2_Stack zx0 zx1 _ => (A_G2_ZX_semantics zx0) ⊗ (A_G2_ZX_semantics zx1) - | @A_G2_Compose _ nMid _ zx0 zx1 _ => (A_G2_ZX_semantics zx1) × (nMid ⨂ hadamard) × (A_G2_ZX_semantics zx0) - end. - -Fixpoint A_G2_ZX_to_G2_ZX {nIn nOut} (zx : A_G2_ZX nIn nOut) : G2_ZX nIn nOut := - match zx with - | ⦰AG2 _ => ⦰G2 - | A_G2_Z_Spider_1_0 α _ => G2_Z_Spider_1_0 α - | A_G2_Z_Spider_0_1 α _ => G2_Z_Spider_0_1 α - | A_G2_Z_Spider_1_1 α _ => G2_Z_Spider_1_1 α - | A_G2_Z_Spider_1_2 α _ => G2_Z_Spider_1_2 α - | A_G2_Z_Spider_2_1 α _ => G2_Z_Spider_2_1 α - | A_G2_Cap _ => G2_Cap - | A_G2_Cup _ => G2_Cup - | A_G2_Swap _ => G2_Swap - | A_G2_Stack zx0 zx1 _ => (A_G2_ZX_to_G2_ZX zx0) ↕G2 (A_G2_ZX_to_G2_ZX zx1) - | A_G2_Compose zx0 zx1 _ => (A_G2_ZX_to_G2_ZX zx0) ⟷G2 (A_G2_ZX_to_G2_ZX zx1) - end. - -Fixpoint G2_ZX_to_A_G2_ZX_helper (base : nat) {nIn nOut} (zx : G2_ZX nIn nOut) : (A_G2_ZX nIn nOut) * nat := - match zx with - | ⦰G2 => (⦰AG2 base, S base) - | G2_Z_Spider_1_0 α => (A_G2_Z_Spider_1_0 α base , S base) - | G2_Z_Spider_0_1 α => (A_G2_Z_Spider_0_1 α base , S base) - | G2_Z_Spider_1_1 α => (A_G2_Z_Spider_1_1 α base , S base) - | G2_Z_Spider_1_2 α => (A_G2_Z_Spider_1_2 α base , S base) - | G2_Z_Spider_2_1 α => (A_G2_Z_Spider_2_1 α base , S base) - | G2_Cap => (A_G2_Cap base, S base) - | G2_Cup => (A_G2_Cup base, S base) - | G2_Swap => (A_G2_Swap base, S base) - | G2_Stack zx0 zx1 => (A_G2_Stack - (fst (G2_ZX_to_A_G2_ZX_helper base zx0)) - (fst (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1)) - (snd (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1)), - S (snd (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1))) - | G2_Compose zx0 zx1 => (A_G2_Compose - (fst (G2_ZX_to_A_G2_ZX_helper base zx0)) - (fst (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1)) - (snd (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1)), - S (snd (G2_ZX_to_A_G2_ZX_helper (snd (G2_ZX_to_A_G2_ZX_helper base zx0)) zx1))) - end. - -Definition G2_ZX_to_A_G2_ZX {nIn nOut} (zx : G2_ZX nIn nOut) := fst (G2_ZX_to_A_G2_ZX_helper (nIn + nOut (* Reserve for inputs / outputs *)) zx). - -(* Todo: - - State/Prove no collisions - - Add maps from node id -> [node id] * [node id] (i.e. map to connected spider/cap/cup) -*) - -Inductive In_A_G2_ZX : forall {nIn nOut : nat}, nat -> A_G2_ZX nIn nOut -> Prop := - | In_Empty n : In_A_G2_ZX n (⦰AG2 n) - | In_Z_Spider_1_0 {α} n : In_A_G2_ZX n (A_G2_Z_Spider_1_0 α n) - | In_Z_Spider_0_1 {α} n : In_A_G2_ZX n (A_G2_Z_Spider_0_1 α n) - | In_Z_Spider_1_1 {α} n : In_A_G2_ZX n (A_G2_Z_Spider_1_1 α n) - | In_Z_Spider_2_1 {α} n : In_A_G2_ZX n (A_G2_Z_Spider_2_1 α n) - | In_Z_Spider_1_2 {α} n : In_A_G2_ZX n (A_G2_Z_Spider_1_2 α n) - | In_Cap n : In_A_G2_ZX n (A_G2_Cap n) - | In_Cup n : In_A_G2_ZX n (A_G2_Cup n) - | In_Swap n : In_A_G2_ZX n (A_G2_Swap n) - | In_Stack_L {nIn0 nIn1 nOut0 nOut1 idnum : nat} - (zx0 : A_G2_ZX nIn0 nOut0) (zx1 : A_G2_ZX nIn1 nOut1) n : - In_A_G2_ZX n zx0 -> In_A_G2_ZX n (A_G2_Stack zx0 zx1 idnum) - | In_Stack_R {nIn0 nIn1 nOut0 nOut1 idnum : nat} - (zx0 : A_G2_ZX nIn0 nOut0) (zx1 : A_G2_ZX nIn1 nOut1) n : - In_A_G2_ZX n zx1 -> In_A_G2_ZX n (A_G2_Stack zx0 zx1 idnum) - | In_Stack {nIn0 nIn1 nOut0 nOut1 : nat} - (zx0 : A_G2_ZX nIn0 nOut0) (zx1 : A_G2_ZX nIn1 nOut1) n : In_A_G2_ZX n (A_G2_Stack zx0 zx1 n) - | In_Compose_L {nIn nMid nOut idnum : nat} - (zx0 : A_G2_ZX nIn nMid) - (zx1 : A_G2_ZX nMid nOut) n : In_A_G2_ZX n zx0 -> In_A_G2_ZX n (A_G2_Compose zx0 zx1 idnum) - | In_Compose_R {nIn nMid nOut idnum : nat} - (zx0 : A_G2_ZX nIn nMid) - (zx1 : A_G2_ZX nMid nOut) n : In_A_G2_ZX n zx1 -> In_A_G2_ZX n (A_G2_Compose zx0 zx1 idnum) - | In_Compose {nIn nMid nOut} - (zx0 : A_G2_ZX nIn nMid) - (zx1 : A_G2_ZX nMid nOut) n : In_A_G2_ZX n (A_G2_Compose zx0 zx1 n). - -Lemma In_A_G2_ZX_dec : forall {nIn nOut : nat} (zx : A_G2_ZX nIn nOut) n, - {In_A_G2_ZX n zx} + {~ In_A_G2_ZX n zx}. -Proof. - intros nIn nOut zx. - induction zx; intros. - 1-9: bdestruct (n =? n0); [ left; subst; constructor | right ]; - unfold not; - intros; - inversion H0; - subst; - contradiction. - all: specialize (IHzx1 n0). - all: specialize (IHzx2 n0). - all: destruct IHzx1, IHzx2. - 1-2: left; apply In_Stack_L; assumption. - 3-4: left; apply In_Compose_L; assumption. - - left; apply In_Stack_R; assumption. - - bdestruct (n =? n0); [ left; subst; apply In_Stack | right ]. - unfold not. - intros. - inversion H0; - inversion H11; - inversion H12; - subst nOut3 nIn3 nOut2 nIn2. - 1-2 : apply inj_pair2_eq_dec in H16; [| apply eq_nat_dec]. - 1-2 : apply inj_pair2_eq_dec in H16; [| apply eq_nat_dec]. - 1-2 : apply inj_pair2_eq_dec in H18; [| apply eq_nat_dec]. - 1-2 : apply inj_pair2_eq_dec in H18; [| apply eq_nat_dec]. - 3 : apply inj_pair2_eq_dec in H15; [| apply eq_nat_dec]. - 3 : apply inj_pair2_eq_dec in H15; [| apply eq_nat_dec]. - 3 : apply inj_pair2_eq_dec in H17; [| apply eq_nat_dec]. - 3 : apply inj_pair2_eq_dec in H17; [| apply eq_nat_dec]. - all: subst zx4 zx5. - 3: subst n0 n3. - all: contradiction. - - left; apply In_Compose_R; assumption. - - bdestruct (n =? n0); [ left; subst; apply In_Compose | right ]. - unfold not. - intros. - inversion H0. - inversion H6; - inversion H7. - subst nIn0 nOut0 nMid0. - 2-3 : apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - 2-3 : apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - 2-3 : apply inj_pair2_eq_dec in H7; [| apply eq_nat_dec]. - 2-3 : apply inj_pair2_eq_dec in H7; [| apply eq_nat_dec]. - 1 : apply inj_pair2_eq_dec in H10; [| apply eq_nat_dec]. - 1 : apply inj_pair2_eq_dec in H10; [| apply eq_nat_dec]. - 1 : apply inj_pair2_eq_dec in H11; [| apply eq_nat_dec]. - 1 : apply inj_pair2_eq_dec in H11; [| apply eq_nat_dec]. - all: subst zx4 zx5. - 3: subst n0 n3. - all: contradiction. -Qed. - -Inductive WF_A_G2_ZX : forall {nIn nOut : nat}, A_G2_ZX nIn nOut -> Prop := - | WF_Empty n : WF_A_G2_ZX (⦰AG2 n) - | WF_A_G2_Z_Spider_1_0 n α : WF_A_G2_ZX (A_G2_Z_Spider_1_0 n α) - | WF_A_G2_Z_Spider_0_1 n α : WF_A_G2_ZX (A_G2_Z_Spider_0_1 n α) - | WF_A_G2_Z_Spider_1_1 n α : WF_A_G2_ZX (A_G2_Z_Spider_1_1 n α) - | WF_A_G2_Z_Spider_2_1 n α : WF_A_G2_ZX (A_G2_Z_Spider_2_1 n α) - | WF_A_G2_Z_Spider_1_2 n α : WF_A_G2_ZX (A_G2_Z_Spider_1_2 n α) - | WF_A_G2_Cap n : WF_A_G2_ZX (A_G2_Cap n) - | WF_A_G2_Cup n : WF_A_G2_ZX (A_G2_Cup n) - | WF_A_G2_Swap n : WF_A_G2_ZX (A_G2_Swap n) - | WF_A_G2_Stack : - forall (nIn0 nIn1 nOut0 nOut1 idnum : nat) (zx0 : A_G2_ZX nIn0 nOut0) (zx1 : A_G2_ZX nIn1 nOut1), - (forall n, In_A_G2_ZX n zx0 -> ~ In_A_G2_ZX n zx1) -> - (~ In_A_G2_ZX idnum zx0) -> (~ In_A_G2_ZX idnum zx1) -> - WF_A_G2_ZX zx0 -> WF_A_G2_ZX zx1 -> - WF_A_G2_ZX (A_G2_Stack zx0 zx1 idnum) - | WF_A_G2_Compose {nIn nMid nOut idnum} - (zx0 : A_G2_ZX nIn nMid) (zx1 : A_G2_ZX nMid nOut) : - (forall n, In_A_G2_ZX n zx0 -> ~ In_A_G2_ZX n zx1) -> - (~ In_A_G2_ZX idnum zx0) -> (~ In_A_G2_ZX idnum zx1) -> - WF_A_G2_ZX zx0 -> WF_A_G2_ZX zx1 -> - WF_A_G2_ZX (A_G2_Compose zx0 zx1 idnum). - -Lemma G2_ZX_to_A_G2_ZX_helper_ret_gt_base : - forall base {nIn nOut} (zx : G2_ZX nIn nOut), - base < snd (G2_ZX_to_A_G2_ZX_helper base zx). -Proof. - intros. - generalize dependent base. - induction zx; intros; simpl; try auto (* Non composite *). - all: - apply (Nat.lt_trans _ (snd (G2_ZX_to_A_G2_ZX_helper base zx1)) _); [ apply IHzx1 | apply Nat.lt_lt_succ_r; apply IHzx2]. -Qed. - -Lemma In_A_G2_ZX_Stack_Rev {nIn0 nOut0 nIn1 nOut1 idnum} : - forall n (zx0 : A_G2_ZX nIn0 nOut0) (zx1 : A_G2_ZX nIn1 nOut1), - In_A_G2_ZX n (A_G2_Stack zx0 zx1 idnum) -> In_A_G2_ZX n zx0 \/ In_A_G2_ZX n zx1 \/ idnum = n. -Proof. - intros. - inversion H. - - subst. - inversion H10. - apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - left. - subst; assumption. - - subst. - inversion H11. - apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - apply inj_pair2_eq_dec in H6; [| apply eq_nat_dec]. - right; left. - subst; assumption. - - right; right; reflexivity. -Qed. - -Lemma In_A_G2_ZX_Compose_Rev {nIn nMid nOut idnum} : - forall n (zx0 : A_G2_ZX nIn nMid) (zx1 : A_G2_ZX nMid nOut), - In_A_G2_ZX n (A_G2_Compose zx0 zx1 idnum) -> In_A_G2_ZX n zx0 \/ In_A_G2_ZX n zx1 \/ n = idnum. -Proof. - intros. - inversion H. - - subst. - inversion H5. - apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]. - apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]. - left; subst; assumption. - - subst. - inversion H6. - apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]. - apply inj_pair2_eq_dec in H1; [| apply eq_nat_dec]. - right; left; subst; assumption. - - right; right; easy. -Qed. - -Lemma G2_ZX_to_A_G2_ZX_labels_small {nIn nOut} : - forall (n base : nat) (zx : G2_ZX nIn nOut) , - In_A_G2_ZX n (fst (G2_ZX_to_A_G2_ZX_helper base zx)) -> n < snd (G2_ZX_to_A_G2_ZX_helper base zx). -Proof. - intros. - generalize dependent base. - generalize dependent n. - induction zx; intros. - 1 - 9: inversion H. - 1 - 9: simpl; auto. - (* Stack / Compose cases *) - all: simpl in H. - 1: apply In_A_G2_ZX_Stack_Rev in H. - 2: apply In_A_G2_ZX_Compose_Rev in H. - all: destruct H; simpl. - 1,3: rewrite IHzx1; [ apply Nat.lt_lt_succ_r; apply G2_ZX_to_A_G2_ZX_helper_ret_gt_base | apply H ]. - all: destruct H; [ rewrite IHzx2; [ constructor | apply H ] | rewrite H; constructor ]. -Qed. - -Lemma Not_In_A_G2_ZX_lt_base : forall {nIn nOut} n base (zx : G2_ZX nIn nOut), n < base -> ~ In_A_G2_ZX n (fst (G2_ZX_to_A_G2_ZX_helper base zx)). -Proof. - intros. - generalize dependent n. - generalize dependent base. - induction zx; intros. - all: simpl; unfold not; intros Hcontra. - 1-9: inversion Hcontra. - 1-9: apply Nat.lt_neq in H; subst; congruence. - all: simpl. - 1: apply In_A_G2_ZX_Stack_Rev in Hcontra. - 2: apply In_A_G2_ZX_Compose_Rev in Hcontra. - all: destruct Hcontra; contradict H0. - 1,3: apply IHzx1; assumption. - all: apply Classical_Prop.and_not_or; split. - 1,3: apply IHzx2. - 1,2: apply (Nat.lt_trans _ base); [ assumption | ]. - 1,2: apply G2_ZX_to_A_G2_ZX_helper_ret_gt_base. - 1: apply not_eq_sym. - all: apply Nat.lt_neq. - all: apply (Nat.lt_trans _ base); [ assumption | ]. - all: apply (Nat.lt_trans _ (snd (G2_ZX_to_A_G2_ZX_helper base zx1))); apply G2_ZX_to_A_G2_ZX_helper_ret_gt_base. -Qed. - -Lemma WF_G2_ZX_to_A_G2_ZX_helper : forall {nIn nOut} base (zx : G2_ZX nIn nOut), WF_A_G2_ZX (fst (G2_ZX_to_A_G2_ZX_helper base zx)). -Proof. - intros. - generalize dependent base. - induction zx; intros. - all: simpl; constructor. - 4,9: apply IHzx1. - 4,8: apply IHzx2. - 1,4: intros; - apply Not_In_A_G2_ZX_lt_base; - apply G2_ZX_to_A_G2_ZX_labels_small; - assumption. - all: unfold not; intros. - all: apply G2_ZX_to_A_G2_ZX_labels_small in H. - all: contradict H. - all: apply le_not_lt. - 2,4: constructor. - all: apply Nat.lt_le_incl. - all: apply G2_ZX_to_A_G2_ZX_helper_ret_gt_base. -Qed. - -Corollary WF_G2_ZX_to_A_G2_ZX : forall {nIn nOut} (zx : G2_ZX nIn nOut), WF_A_G2_ZX (G2_ZX_to_A_G2_ZX zx). -Proof. intros. unfold G2_ZX_to_A_G2_ZX. apply WF_G2_ZX_to_A_G2_ZX_helper. Qed. - - - -(* TODO 2: - - Create a map which annotates the edges - (Map node# -> (Vector nIn node# * Vector nOut node#) or a similar idea where inputs and outputs are differentiated) - What facts can we prove about this? - - - - - Create a function which generates the map automatically. - Function should be bottom-up generation - What facts can we prove about this? - - - - A function which matches inputs and outputs. - What facts can we prove about this? - - - - Graph semantics (or graph back to ZX diagram, same difficulty) - - *) - -Module OrderedNat <: OrderedType with Definition t := nat%type. - Definition t := nat%type. - Definition eq := @eq nat. - Definition lt (a b : nat) := a < b. - Theorem eq_refl : forall x, eq x x. - reflexivity. - Qed. - - Theorem eq_sym : forall a b, eq a b -> eq b a. - intros; symmetry; auto. - Qed. - - Theorem eq_trans : forall a b c, eq a b -> eq b c -> eq a c. - intros; etransitivity; eauto. - Qed. - - Theorem lt_trans : forall a b c, lt a b -> lt b c -> lt a c. - intros. - unfold lt in *. - etransitivity; [ apply H | apply H0 ]. - Qed. - - Theorem lt_not_eq : forall a b, lt a b -> ~(eq a b). - unfold eq, lt. - intros. - lia. - Qed. - - Lemma eq_dec (x y : nat) : {x = y} + {x <> y}. - Proof. - apply eq_nat_dec. - Defined. - - Lemma le_not_eq_lt : forall n n1, n <= n1 -> n <> n1 -> n < n1. - Proof. - intros. - apply le_lt_or_eq in H. - destruct H. - - assumption. - - contradiction. - Qed. - - Lemma lt_eq_gt_dec (x y : nat) : {lt x y} + {eq x y} + {lt y x}. - Proof. - bdestruct (x (a1 < b1) \/ (a1 = b1 /\ a2 < b2) - end. - - Theorem eq_refl : forall x, eq x x. - reflexivity. - Qed. - - Theorem eq_sym : forall a b, eq a b -> eq b a. - intros; symmetry; auto. - Qed. - - Theorem eq_trans : forall a b c, eq a b -> eq b c -> eq a c. - intros; etransitivity; eauto. - Qed. - - Theorem lt_trans : forall a b c, lt a b -> lt b c -> lt a c. - intros. - destruct a, b, c. - unfold lt in *. - destruct H, H0. - - left. - etransitivity; [ apply H | apply H0 ]. - - destruct H0. - subst. - left. - assumption. - - destruct H. - subst. - left. - assumption. - - destruct H, H0. - subst. - right. - split; [ easy | ]. - etransitivity; [ apply H1 | apply H2 ]. - Qed. - - Theorem lt_not_eq : forall a b, lt a b -> ~(eq a b). - unfold eq, lt. destruct a, b. - intros; destruct H. - - unfold not. - intros. - apply pair_equal_spec in H0. - destruct H0. - subst. - lia. - - destruct H. - unfold not. - intros. - apply pair_equal_spec in H1. - destruct H1. - subst. - lia. - Qed. - - Lemma eq_dec (x y : (nat * nat)) : {x = y} + {x <> y}. - Proof. - destruct x, y. - decide equality; subst; apply eq_nat_dec. - Defined. - - Lemma le_not_eq_lt : forall n n1, n <= n1 -> n <> n1 -> n < n1. - Proof. - intros. - apply le_lt_or_eq in H. - destruct H. - - assumption. - - contradiction. - Qed. - - Lemma lt_eq_gt_dec (x y : (nat * nat)) : {lt x y} + {eq x y} + {lt y x}. - Proof. - destruct x, y. - unfold eq. - unfold lt. - bdestruct (n id - | A_G2_Z_Spider_1_0 α id => id - | A_G2_Z_Spider_0_1 α id => id - | A_G2_Z_Spider_1_1 α id => id - | A_G2_Z_Spider_1_2 α id => id - | A_G2_Z_Spider_2_1 α id => id - | A_G2_Cap id => id - | A_G2_Cup id => id - | A_G2_Swap id => id - | A_G2_Stack zx0 zx1 id => id - | A_G2_Compose zx0 zx1 id => id - end. - -Lemma Equal_in : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n, - n = get_id zx -> In_A_G2_ZX n zx. -Proof. - intros. - destruct zx; simpl in H; subst. - 1-9: constructor. - apply In_Stack. - apply In_Compose. -Qed. - - -Lemma Not_In_Not_Equal : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n, - ~In_A_G2_ZX n zx -> n <> get_id zx. -Proof. - intros. - unfold not in *. - intros. - apply H. - apply Equal_in. - assumption. -Qed. - - -Fixpoint A_G2_Edge_Annotator_Helper (baseInMap baseOutMap : NatListNatMaps) {nIn nOut} (zx : A_G2_ZX nIn nOut) : (NatListNatMaps * NatListNatMaps) := - match zx with - | ⦰AG2 id => (NatMaps.add id [] baseInMap, NatMaps.add id [] baseOutMap) - | A_G2_Z_Spider_1_0 α id => (NatMaps.add id [id] baseInMap, NatMaps.add id [] baseOutMap) - | A_G2_Z_Spider_0_1 α id => (NatMaps.add id [] baseInMap, NatMaps.add id [id] baseOutMap) - | A_G2_Z_Spider_1_1 α id => (NatMaps.add id [id] baseInMap, NatMaps.add id [id] baseOutMap) - | A_G2_Z_Spider_1_2 α id => (NatMaps.add id [id] baseInMap, NatMaps.add id [id; id] baseOutMap) - | A_G2_Z_Spider_2_1 α id => (NatMaps.add id [id; id] baseInMap, NatMaps.add id [id] baseOutMap) - | A_G2_Cap id => (NatMaps.add id [] baseInMap, NatMaps.add id [id; id] baseOutMap) - | A_G2_Cup id => (NatMaps.add id [id; id] baseInMap, NatMaps.add id [] baseOutMap) - | A_G2_Swap id => (NatMaps.add id [id; id] baseInMap, NatMaps.add id [id; id] baseOutMap) - | A_G2_Stack zx0 zx1 id => let lId := get_id zx0 in - let rId := get_id zx1 in - match A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0 with - | (lIn, lOut) => match A_G2_Edge_Annotator_Helper lIn lOut zx1 with - | (rIn, rOut) => match (NatMaps.find lId lIn, NatMaps.find lId lOut, NatMaps.find rId rIn, NatMaps.find rId rOut) with - | (Some lIdIn, Some lIdOut, Some rIdIn, Some rIdOut) => (NatMaps.add id (lIdIn ++ rIdIn) rIn, NatMaps.add id (lIdOut ++ rIdOut) rOut) - | _ => (NatMaps.add id [] rIn, NatMaps.add id [] rOut) - end - end - end - - | A_G2_Compose zx0 zx1 id =>let lId := get_id zx0 in - let rId := get_id zx1 in - match A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0 with - | (lIn, lOut) => match A_G2_Edge_Annotator_Helper lIn lOut zx1 with - | (rIn, rOut) => match (NatMaps.find lId lIn, NatMaps.find lId lOut, NatMaps.find rId rIn, NatMaps.find rId rOut) with - | (Some lIdIn, Some lIdOut, Some rIdIn, Some rIdOut) => (NatMaps.add id (lIdIn) rIn, NatMaps.add id (rIdOut) rOut) - | _ => (NatMaps.add id [] rIn, NatMaps.add id [] rOut) - end - end - end - end. - -Definition A_G2_Edge_Annotator {nIn nOut} (zx : A_G2_ZX nIn nOut) : (NatListNatMaps * NatListNatMaps) := (A_G2_Edge_Annotator_Helper EmptyNatListNatMaps EmptyNatListNatMaps zx). - -Lemma compare_eq: forall n m, n = m -> exists e, OrderedNat.compare n m = EQ e. -Proof. - intros. - subst m. - unfold OrderedNat.compare. - destruct (OrderedNat.lt_eq_gt_dec n n); try destruct s. - - exfalso. - inversion l. - + contradict H. - apply Nat.neq_succ_diag_l. - + subst n. - apply le_S_gt in H. - contradict H. - apply Nat.nlt_succ_diag_l. - - exists e. - reflexivity. - - exfalso. - inversion l. - + contradict H. - apply Nat.neq_succ_diag_l. - + subst n. - apply le_S_gt in H. - contradict H. - apply Nat.nlt_succ_diag_l. -Qed. - -Corollary compare_eq' : forall n, exists e, OrderedNat.compare n n = EQ e. -Proof. intros. apply compare_eq. trivial. Qed. - -Lemma all_lookup_id : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap x, - x = get_id zx -> - (exists valIn, NatMaps.find x (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valIn) /\ - (exists valOut, NatMaps.find x (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valOut). -Proof. - intros. - generalize dependent baseInMap. - generalize dependent baseOutMap. - subst x. - induction zx; intros. - 1-9: split; eexists; - simpl; - unfold NatMaps.find; - unfold NatMaps.this; - unfold NatMaps.add; - rewrite NatMaps.Raw.Proofs.add_find; try apply NatMaps.is_bst; - specialize (compare_eq' n) as Hcom; - destruct Hcom as [x Hcom]; - rewrite Hcom; - reflexivity. - all: split; - simpl; - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1; - destruct (A_G2_Edge_Annotator_Helper n0 n1 zx2) eqn:Hzx2; - assert (n0 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy); - assert (n1 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy); - assert (n2 = (fst (A_G2_Edge_Annotator_Helper n0 n1 zx2))) by (rewrite Hzx2; easy); - assert (n3 = (snd (A_G2_Edge_Annotator_Helper n0 n1 zx2))) by (rewrite Hzx2; easy); - destruct (NatMaps.find (elt:=list nat) (get_id zx1) n0), - (NatMaps.find (elt:=list nat) (get_id zx1) n1), - (NatMaps.find (elt:=list nat) (get_id zx2) n2), - (NatMaps.find (elt:=list nat) (get_id zx2) n3); - simpl; - unfold NatMaps.find; - unfold NatMaps.this; - unfold NatMaps.add; - try rewrite NatMaps.Raw.Proofs.add_find; try apply NatMaps.is_bst; - specialize (compare_eq' n) as Hcom; - destruct Hcom as [x Hcom]; - rewrite Hcom; - eauto. -Qed. - -Corollary all_lookup_id_fst : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap x, - x = get_id zx -> - (exists valIn, NatMaps.find x (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valIn). -Proof. - intros. - assert ( - (exists valIn, NatMaps.find x (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valIn) /\ - (exists valOut, NatMaps.find x (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valOut) ). - { - intros. - apply all_lookup_id. - assumption. - } - destruct H0. - assumption. -Qed. - -Corollary all_lookup_id_snd : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap x, - x = get_id zx -> - (exists valOut, NatMaps.find x (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valOut). -Proof. - intros. - assert ( - (exists valIn, NatMaps.find x (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valIn) /\ - (exists valOut, NatMaps.find x (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some valOut)). - { - intros. - apply all_lookup_id. - assumption. - } - destruct H0. - assumption. -Qed. - - - -Lemma annotate_add_in : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n baseInMap baseOutMap, NatMaps.In n baseInMap -> NatMaps.In n (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)). -Proof. - intros. - generalize dependent baseInMap. - generalize dependent baseOutMap. - generalize dependent n. - induction zx; intros. - 1-9: simpl; - unfold NatMaps.In in *; - rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in; - right; - assumption. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - rewrite H0 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H4. - rewrite H4 in *. - rewrite <- H0 in *. - rewrite H1 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H5. - rewrite H5 in *. - rewrite <- H1 in *. - rewrite H2 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H6. - rewrite H6 in *. - rewrite <- H2 in *. - rewrite H3 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H7. - rewrite H7 in *. - rewrite <- H3 in *. - simpl in H0. - unfold NatMaps.In in *; - repeat rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in. - rewrite <- NatMaps.Raw.Proofs.In_alt. - rewrite H2. - right. - apply IHzx2. - rewrite H0. - apply IHzx1. - rewrite NatMaps.Raw.Proofs.In_alt. - assumption. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - rewrite H0 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H4. - rewrite H4 in *. - rewrite <- H0 in *. - rewrite H1 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H5. - rewrite H5 in *. - rewrite <- H1 in *. - rewrite H2 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H6. - rewrite H6 in *. - rewrite <- H2 in *. - rewrite H3 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H7. - rewrite H7 in *. - rewrite <- H3 in *. - simpl in H0. - unfold NatMaps.In in *; - repeat rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in. - rewrite <- NatMaps.Raw.Proofs.In_alt. - rewrite H2. - right. - apply IHzx2. - rewrite H0. - apply IHzx1. - rewrite NatMaps.Raw.Proofs.In_alt. - assumption. -Qed. - - -Lemma annotate_add_out : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n baseInMap baseOutMap, NatMaps.In n baseOutMap -> NatMaps.In n (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)). -Proof. - intros. - generalize dependent baseInMap. - generalize dependent baseOutMap. - generalize dependent n. - induction zx; intros. - 1-9: simpl; - unfold NatMaps.In in *; - rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in; - right; - assumption. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - rewrite H0 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H4. - rewrite H4 in *. - rewrite <- H0 in *. - rewrite H1 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H5. - rewrite H5 in *. - rewrite <- H1 in *. - rewrite H2 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H6. - rewrite H6 in *. - rewrite <- H2 in *. - rewrite H3 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H7. - rewrite H7 in *. - rewrite <- H3 in *. - simpl in H0. - unfold NatMaps.In in *; - repeat rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in. - rewrite <- NatMaps.Raw.Proofs.In_alt. - rewrite H3. - right. - apply IHzx2. - rewrite H1. - apply IHzx1. - rewrite NatMaps.Raw.Proofs.In_alt. - assumption. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - rewrite H0 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H4. - rewrite H4 in *. - rewrite <- H0 in *. - rewrite H1 in *. - assert (exists valOut, NatMaps.find (get_id zx1) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H5. - rewrite H5 in *. - rewrite <- H1 in *. - rewrite H2 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_fst. - easy. - } - destruct H6. - rewrite H6 in *. - rewrite <- H2 in *. - rewrite H3 in *. - assert (exists valOut, NatMaps.find (get_id zx2) (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2)) = Some valOut). - { - apply all_lookup_id_snd. - easy. - } - destruct H7. - rewrite H7 in *. - rewrite <- H3 in *. - simpl in H0. - unfold NatMaps.In in *; - repeat rewrite NatMaps.Raw.Proofs.In_alt in *; - apply NatMaps.Raw.Proofs.add_in. - rewrite <- NatMaps.Raw.Proofs.In_alt. - rewrite H3. - right. - apply IHzx2. - rewrite H1. - apply IHzx1. - rewrite NatMaps.Raw.Proofs.In_alt. - assumption. -Qed. - - -Lemma populated_passthrough : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n baseInMap baseOutMap, NatMaps.In n baseInMap /\ NatMaps.In n baseOutMap -> NatMaps.In n (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) /\ NatMaps.In n (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)). -Proof. - intros nIn nOut zx. - induction zx; intros. - 1-9: simpl; - unfold NatMaps.In in *; - rewrite 2 NatMaps.Raw.Proofs.In_alt; - split; - apply NatMaps.Raw.Proofs.add_in; - rewrite <- NatMaps.Raw.Proofs.In_alt; - right; - destruct H; - assumption. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - destruct (NatMaps.find (elt:=list nat) (get_id zx1) n1). - destruct (NatMaps.find (elt:=list nat) (get_id zx1) n2). - destruct (NatMaps.find (elt:=list nat) (get_id zx2) n3). - destruct (NatMaps.find (elt:=list nat) (get_id zx2) n4). - all: simpl. - all: cut ((NatMaps.In (elt:=list nat) n0 (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) /\ - NatMaps.In (elt:=list nat) n0 (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))); - [ split; subst n3 n4; - unfold NatMaps.In; - rewrite NatMaps.Raw.Proofs.In_alt; - apply NatMaps.Raw.Proofs.add_in; right; - destruct H4; - unfold NatMaps.In in *; - rewrite <- NatMaps.Raw.Proofs.In_alt; - assumption | - ]. - all: apply IHzx2. - all: subst n1 n2. - all: apply IHzx1. - all: apply H. - - simpl. - destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1. - destruct (A_G2_Edge_Annotator_Helper n1 n2 zx2) eqn:Hzx2. - assert (n1 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n2 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy). - assert (n3 = (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - assert (n4 = (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))) by (rewrite Hzx2; easy). - destruct (NatMaps.find (elt:=list nat) (get_id zx1) n1). - destruct (NatMaps.find (elt:=list nat) (get_id zx1) n2). - destruct (NatMaps.find (elt:=list nat) (get_id zx2) n3). - destruct (NatMaps.find (elt:=list nat) (get_id zx2) n4). - all: simpl. - all: cut ((NatMaps.In (elt:=list nat) n0 (fst (A_G2_Edge_Annotator_Helper n1 n2 zx2))) /\ - NatMaps.In (elt:=list nat) n0 (snd (A_G2_Edge_Annotator_Helper n1 n2 zx2))); - [ split; subst n3 n4; - unfold NatMaps.In; - rewrite NatMaps.Raw.Proofs.In_alt; - apply NatMaps.Raw.Proofs.add_in; right; - destruct H4; - unfold NatMaps.In in *; - rewrite <- NatMaps.Raw.Proofs.In_alt; - assumption | - ]. - all: apply IHzx2. - all: subst n1 n2. - all: apply IHzx1. - all: apply H. -Qed. - -Lemma id_populated_inmap : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) n baseInMap baseOutMap, In_A_G2_ZX n zx -> NatMaps.In n (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) /\ NatMaps.In n (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)). -Proof. - intros. - generalize dependent baseInMap. - generalize dependent baseOutMap. - dependent induction H; subst. - 1-9: intros; - unfold NatMaps.In; - rewrite 2 NatMaps.Raw.Proofs.In_alt; - split; - apply NatMaps.Raw.Proofs.add_in; - left; - easy. - all: intros. - all: simpl. - all: destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0) eqn:Hzx1; - destruct (A_G2_Edge_Annotator_Helper n0 n1 zx1) eqn:Hzx2; - assert (Hn0: n0 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0))) by (rewrite Hzx1; easy); - assert (Hn1: n1 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0))) by (rewrite Hzx1; easy); - assert (Hn2: n2 = (fst (A_G2_Edge_Annotator_Helper n0 n1 zx1))) by (rewrite Hzx2; easy); - assert (Hn3: n3 = (snd (A_G2_Edge_Annotator_Helper n0 n1 zx1))) by (rewrite Hzx2; easy); - rewrite Hn0; - assert (Hzx0f: exists valOut, NatMaps.find (get_id zx0) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0)) = Some valOut) by - ( - apply all_lookup_id_fst; - easy - ); - destruct Hzx0f as (x1, Hzx0f); - rewrite Hzx0f; - clear Hzx0f; - rewrite Hn1; - assert (Hzx0s: exists valOut, NatMaps.find (get_id zx0) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx0)) = Some valOut) by - ( - apply all_lookup_id_snd; - easy - ); - destruct Hzx0s as (x2, Hzx0s); - rewrite Hzx0s; - clear Hzx0s; - rewrite Hn2; - assert (Hzx1f: exists valOut, NatMaps.find (get_id zx1) (fst (A_G2_Edge_Annotator_Helper n0 n1 zx1)) = Some valOut) by - ( - apply all_lookup_id_fst; - easy - ); - destruct Hzx1f as (x3, Hzx1f); - rewrite Hzx1f; - clear Hzx1f; - rewrite <- Hn2; - rewrite Hn3; - assert (Hzx1s: exists valOut, NatMaps.find (get_id zx1) (snd (A_G2_Edge_Annotator_Helper n0 n1 zx1)) = Some valOut) by - ( - apply all_lookup_id_snd; - easy - ); - destruct Hzx1s as (x4, Hzx1s); - rewrite Hzx1s; - clear Hzx1s; - rewrite <- Hn3. - 1-2,4-5: unfold NatMaps.In; - rewrite 2 NatMaps.Raw.Proofs.In_alt; - rewrite Hn2, Hn3; simpl; - rewrite 2 NatMaps.Raw.Proofs.add_in; - cut ((NatMaps.In n (fst (A_G2_Edge_Annotator_Helper n0 n1 zx1))) /\ - (NatMaps.In n (snd (A_G2_Edge_Annotator_Helper n0 n1 zx1)))); - [ intros; split; right; - destruct H0; - unfold NatMaps.In in *; - rewrite <- NatMaps.Raw.Proofs.In_alt; - assumption - | ]. - 1,3: apply populated_passthrough. - 1-4: subst n0 n1. - 1-4: apply IHIn_A_G2_ZX. - all: simpl. - all: unfold NatMaps.In; - rewrite 2 NatMaps.Raw.Proofs.In_alt; - rewrite Hn2, Hn3; simpl; - rewrite 2 NatMaps.Raw.Proofs.add_in; - split; - left; - easy. -Qed. - - - -Lemma annotation_length_correct : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap, - exists l1 l2, - ( - ( - (NatMaps.find (get_id zx) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l1) - /\ (NatMaps.find (get_id zx) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l2) - ) - /\ (length l1 = nIn /\ length l2 = nOut) - ). -Proof. - intros. - generalize dependent baseInMap. - generalize dependent baseOutMap. - assert (forall n, exists e, OrderedNat.compare n n = EQ e) by apply compare_eq'. - induction zx; intros. - 1-9: eexists; eexists; simpl; - unfold NatMaps.find; - unfold NatMaps.add; - simpl; - split; - [ split; - rewrite NatMaps.Raw.Proofs.add_find; try apply NatMaps.is_bst; - specialize (H n); - destruct H; - rewrite H; - reflexivity - | split; - reflexivity - ]. - all: simpl; destruct (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1) eqn:Hzx1; - destruct (A_G2_Edge_Annotator_Helper n0 n1 zx2) eqn:Hzx2; - assert (Hn0: n0 = (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy); - assert (Hn1: n1 = (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx1))) by (rewrite Hzx1; easy); - assert (Hn2: n2 = (fst (A_G2_Edge_Annotator_Helper n0 n1 zx2))) by (rewrite Hzx2; easy); - assert (Hn3: n3 = (snd (A_G2_Edge_Annotator_Helper n0 n1 zx2))) by (rewrite Hzx2; easy); - specialize (IHzx1 baseOutMap baseInMap); - specialize (IHzx2 n1 n0); - destruct IHzx1; - destruct H0; destruct H0; destruct H0; destruct H1; - destruct IHzx2; - destruct H4; destruct H4; destruct H4; destruct H5; - rewrite <- Hn0 in H0; - rewrite <- Hn1 in H2; - rewrite <- Hn2 in H4; - rewrite <- Hn3 in H6; - rewrite H0, H2, H4, H6. - 1: exists (x ++ x1); exists (x0 ++ x2). - 2: exists x; exists x2. - all: split. - 1,3: unfold NatMaps.find; - unfold NatMaps.add; - simpl; - split; rewrite NatMaps.Raw.Proofs.add_find; try apply NatMaps.is_bst; - specialize (H n); - destruct H; - rewrite H; reflexivity. - all: split. - 1,2: rewrite app_length. - all: subst. - all: easy. -Qed. - -Corollary annotation_length_correct_in : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap, -exists l, - (NatMaps.find (get_id zx) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l) - /\ length l = nIn. -Proof. - intros. - cut (exists l1 l2, - ( - ( - (NatMaps.find (get_id zx) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l1) - /\ (NatMaps.find (get_id zx) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l2) - ) - /\ (length l1 = nIn /\ length l2 = nOut)) - ); - [ | apply annotation_length_correct ]. - intros. - destruct H; destruct H; destruct H; destruct H, H0. - exists x. - split; assumption. -Qed. - -Corollary annotation_length_correct_out : forall {nIn nOut} (zx : A_G2_ZX nIn nOut) baseInMap baseOutMap, -exists l, - (NatMaps.find (get_id zx) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l) - /\ length l = nOut. -Proof. - intros. - cut (exists l1 l2, - ( - ( - (NatMaps.find (get_id zx) (fst (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l1) - /\ (NatMaps.find (get_id zx) (snd (A_G2_Edge_Annotator_Helper baseInMap baseOutMap zx)) = Some l2) - ) - /\ (length l1 = nIn /\ length l2 = nOut)) - ); - [ | apply annotation_length_correct ]. - intros. - destruct H; destruct H; destruct H; destruct H, H0. - exists x0. - split; assumption. -Qed. - - -Module NatPairMaps := Make OrderedNatPair. - -Definition NatNatMapMaps := NatMaps.t NatNatMaps. -Definition EmptyNatMapNatMaps := NatMaps.empty (NatNatMaps). - -Definition add_one_edge (edgemap : NatNatMapMaps) from to := - match (NatMaps.find from edgemap) with - | None => NatMaps.add from (NatMaps.add to 1 EmptyNatNatMaps) edgemap - | Some m => - match NatMaps.find to m with - | None => NatMaps.add from (NatMaps.add to 1 m) edgemap - | Some n => NatMaps.add from (NatMaps.add to (S n) m) edgemap - end - end. - -Fixpoint add_all_edges (base : NatNatMapMaps) (l : list (nat * nat)) := - match l with - | [] => base - | el :: l' => let base' := add_all_edges base l' in - let from := fst el in - let to := snd el in - add_one_edge base' from to - end. - -Lemma add_all_edges_adds_all_edges : forall l base x, In x l -> (exists m, (NatMaps.find (fst x) (add_all_edges base l) = Some m /\ NatMaps.In (snd x) m)). -Proof. - intros. - generalize dependent x. - induction l; intros; [ contradiction | ]. - simpl. - destruct H. - - subst a. - destruct x; simpl; unfold add_one_edge. - destruct (NatMaps.find (elt:=_) k (add_all_edges base l)). - + destruct (NatMaps.find (elt:= _ ) n n0); eexists; split. - * unfold NatMaps.add, NatMaps.find. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - specialize (compare_eq' k); intros. - destruct H; rewrite H. - reflexivity. - * unfold NatMaps.In. - rewrite NatMaps.Raw.Proofs.In_alt. - simpl. - apply NatMaps.Raw.Proofs.add_in. - left; easy. - * unfold NatMaps.add, NatMaps.find. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - specialize (compare_eq' k); intros. - destruct H; rewrite H. - reflexivity. - * unfold NatMaps.In. - rewrite NatMaps.Raw.Proofs.In_alt. - simpl. - apply NatMaps.Raw.Proofs.add_in. - left; easy. - + eexists; split. - * unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - specialize (compare_eq' k); intros. - destruct H; rewrite H. - reflexivity. - * unfold NatMaps.In. - rewrite NatMaps.Raw.Proofs.In_alt. - simpl. - constructor. - easy. - - unfold add_one_edge. - specialize (IHl x H). - destruct IHl. - destruct H0. - destruct x. - destruct a. - rename k0 into a0. - rename n0 into a1. - simpl in H0. - simpl in H1. - simpl. - destruct (NatMaps.find (elt:=NatNatMaps) a0 (add_all_edges base l)) eqn:Hfst. - + destruct (NatMaps.find (elt:=nat) a1 n0) eqn:Hsnd. - * unfold NatMaps.add, NatMaps.find in *. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - destruct (OrderedNat.compare k a0); eexists; - try (split; [apply H0 | apply H1]). - inversion e. - split. - simpl. - reflexivity. - unfold NatMaps.In. - rewrite NatMaps.Raw.Proofs.In_alt. - simpl. - apply NatMaps.Raw.Proofs.add_in. - subst. - subst. - rewrite H0 in Hfst. - inversion Hfst. - subst. - right. - unfold NatMaps.In in H1. - rewrite <- NatMaps.Raw.Proofs.In_alt. - apply H1. - * simpl. - unfold NatMaps.add, NatMaps.find in *. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - destruct (OrderedNat.compare k a0); eexists; - try (split; [apply H0 | apply H1]). - simpl. - inversion e. - subst. - rewrite H0 in Hfst. - inversion Hfst. - subst. - split. - reflexivity. - simpl. - unfold NatMaps.In. - rewrite NatMaps.Raw.Proofs.In_alt. - simpl. - rewrite NatMaps.Raw.Proofs.add_in. - right. - unfold NatMaps.In in H1. - rewrite <- NatMaps.Raw.Proofs.In_alt. - apply H1. - + simpl. - eexists. - unfold NatMaps.add, NatMaps.find in *. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst]. - destruct (OrderedNat.compare k a0); - try (split; [apply H0 | apply H1]). - exfalso. - simpl. - inversion e. - subst. - rewrite Hfst in H0. - discriminate H0. -Qed. - -Fixpoint A_G2_Edge_Annotator_Match_Helper (inAnnotation outAnnotation : NatListNatMaps) (base : NatNatMapMaps) {nIn nOut} (zx : A_G2_ZX nIn nOut) : NatNatMapMaps := - match zx with - | A_G2_Compose zx0 zx1 _ => let l_base := (A_G2_Edge_Annotator_Match_Helper inAnnotation outAnnotation base zx0) in - let r_base := A_G2_Edge_Annotator_Match_Helper inAnnotation outAnnotation l_base zx1 in - let lId := get_id zx0 in - let rId := get_id zx1 in - match (NatMaps.find lId outAnnotation, NatMaps.find rId inAnnotation) with - | (Some lIdOut, Some rIdIn) => - let l := combine lIdOut rIdIn in - add_all_edges r_base l - | _ => r_base - end - | A_G2_Stack zx0 zx1 _ => let l_base := (A_G2_Edge_Annotator_Match_Helper inAnnotation outAnnotation base zx0) in - let r_base := A_G2_Edge_Annotator_Match_Helper inAnnotation outAnnotation l_base zx1 in - r_base - | _ => base - end. - -Definition A_G2_Edge_Annotator_Match (inAnnotation outAnnotation : NatListNatMaps) {nIn nOut} (zx : A_G2_ZX nIn nOut) := - A_G2_Edge_Annotator_Match_Helper inAnnotation outAnnotation EmptyNatMapNatMaps zx. - -Definition Get_Input_Output_Adj (inAnnotation outAnnotation : NatListNatMaps) {nIn nOut} (zx : A_G2_ZX nIn nOut) := - (NatMaps.find (get_id zx) inAnnotation, NatMaps.find (get_id zx) outAnnotation). - -Notation Get_Edges edgemap := (NatPairMaps.elements edgemap). - -Definition Get_Edge_Count (edgemap : NatNatMapMaps) from to : nat := - match NatMaps.find from edgemap with - | None => 0 - | Some m => match NatMaps.find to m with - | None => 0 - | Some n => n - end - end. - -Definition Edge_Exists (edgemap : NatNatMapMaps) from to := Get_Edge_Count edgemap from to <> 0. - -Definition remove_one_edge (edgemap : NatNatMapMaps) from to := - match NatMaps.find from edgemap with - | None => edgemap - | Some m => NatMaps.add from (match NatMaps.find to m with - | None => m - | Some (S (S n)) => NatMaps.add to (S n) m (* if there's more than one edge retain the edge but decrement *) - | Some _ => NatMaps.remove to m - end) edgemap - end. - - - -Lemma remove_find : forall T m x y, x = y -> @NatMaps.find T y (NatMaps.remove x m) = None. -Proof. - intros. - subst. - cut (~ @NatMaps.In T y (NatMaps.remove y m)); - unfold NatMaps.In, NatMaps.remove, NatMaps.find; - rewrite NatMaps.Raw.Proofs.In_alt; - simpl. - - intros. - apply NatMaps.Raw.Proofs.not_find_iff; [ apply NatMaps.Raw.Proofs.remove_bst; apply NatMaps.is_bst | ]. - apply H. - - rewrite NatMaps.Raw.Proofs.remove_in; [ | apply NatMaps.is_bst ]. - apply Classical_Prop.or_not_and. - left. - unfold not. - intros. - apply H. - easy. -Qed. - -Lemma remove_one_edge_none : forall (edgemap : NatNatMapMaps) from to, - ~ Edge_Exists edgemap from to -> - ~ Edge_Exists (remove_one_edge edgemap from to) from to. -Proof. - intros. - unfold remove_one_edge. - unfold Edge_Exists in *. - unfold Get_Edge_Count in *. - destruct (NatMaps.find (elt:=NatNatMaps) from edgemap) eqn:Hf. - - destruct (NatMaps.find (elt:=nat) to n) eqn:Hs. - + destruct n0. - * apply Nat.eq_dne. - unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H0. - rewrite H0. - unfold NatMaps.remove. - simpl. - specialize (remove_find nat n to to eq_refl); intros. - unfold NatMaps.find, NatMaps.remove in H1; simpl in H1. - rewrite H1. - easy. - * unfold not in H. - exfalso. - apply H. - intros. - inversion H0. - + apply Nat.eq_dne. - unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H0. - rewrite H0. - unfold NatMaps.find in Hs. - rewrite Hs. - easy. - - simpl. - rewrite Hf. - assumption. -Qed. - -Lemma remove_one_edge_pred : forall edgemap from to n, - Get_Edge_Count edgemap from to = n -> - Get_Edge_Count (remove_one_edge edgemap from to) from to = pred n. -Proof. - intros. - unfold remove_one_edge. - unfold Get_Edge_Count in *. - destruct ( NatMaps.find (elt:=NatNatMaps) from edgemap) eqn:Hf. - - destruct (NatMaps.find (elt:=nat) to n0) eqn:Hs. - + subst n1. - unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H. - rewrite H. - destruct n; [ | destruct n ]. - 1,2: specialize (remove_find nat n0 to to eq_refl); intros. - 1,2: unfold NatMaps.find in H0; simpl in H0; unfold NatMaps.remove; simpl. - 1,2: rewrite H0. - 1,2: easy. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' to); intros. - destruct H0; rewrite H0. - easy. - + unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H0. - rewrite H0. - unfold NatMaps.find in Hs. - rewrite Hs. - subst. - easy. - - rewrite Hf. - subst. - easy. -Qed. - - -Lemma add_one_edge_succ : forall edgemap from to n, - Get_Edge_Count edgemap from to = n -> - Get_Edge_Count (add_one_edge edgemap from to) from to = S n. -Proof. - intros. - unfold add_one_edge. - unfold Get_Edge_Count in *. - destruct ( NatMaps.find (elt:=NatNatMaps) from edgemap) eqn:Hf. - - destruct (NatMaps.find (elt:=nat) to n0) eqn:Hs. - + subst n1. - unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H. - rewrite H. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' to); intros. - destruct H0; rewrite H0. - easy. - + unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H0. - rewrite H0. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' to); intros. - destruct H1; rewrite H1. - subst. - easy. - - unfold NatMaps.find, NatMaps.add. - simpl. - rewrite NatMaps.Raw.Proofs.add_find; [ | apply NatMaps.is_bst ]. - specialize (compare_eq' from); intros. - destruct H0. - rewrite H0. - simpl. - specialize (compare_eq' to); intros. - destruct H1; rewrite H1. - subst. - easy. -Qed. - -Fixpoint get_inputs_rec {nIn nOut} (zxa : A_G2_ZX nIn nOut) (offset : nat) (basemap : NatNatMaps) : NatNatMaps := - match zxa with - | A_G2_Empty _ | A_G2_Z_Spider_0_1 _ _ | A_G2_Cap _ => basemap - | A_G2_Z_Spider_1_0 _ n | A_G2_Z_Spider_1_1 _ n | A_G2_Z_Spider_1_2 _ n => NatMaps.add offset n basemap - | A_G2_Z_Spider_2_1 _ n | A_G2_Cup n | A_G2_Swap n => NatMaps.add offset n (NatMaps.add (S offset) n basemap) - | @A_G2_Stack nIn0 nIn1 nOut0 nOut1 azx0 azx1 n => - get_inputs_rec azx1 (offset + nIn0)%nat (get_inputs_rec azx0 offset basemap) - | A_G2_Compose azx0 azx1 n => get_inputs_rec azx0 offset basemap - end. - -Definition get_inputs {nIn nOut} (zxa : A_G2_ZX nIn nOut) : NatNatMaps := get_inputs_rec zxa 0 EmptyNatNatMaps. - -Ltac unfold_get_inputs := unfold get_inputs; unfold get_inputs_rec; simpl. - -Fixpoint get_outputs_rec {nIn nOut} (zxa : A_G2_ZX nIn nOut) (offset : nat) (basemap : NatNatMaps) : NatNatMaps := - match zxa with - | A_G2_Empty _ | A_G2_Z_Spider_1_0 _ _ | A_G2_Cup _ => basemap - | A_G2_Z_Spider_0_1 _ n | A_G2_Z_Spider_1_1 _ n | A_G2_Z_Spider_2_1 _ n => NatMaps.add offset n basemap - | A_G2_Z_Spider_1_2 _ n | A_G2_Cap n | A_G2_Swap n => NatMaps.add offset n (NatMaps.add (S offset) n basemap) - | @A_G2_Stack nIn0 nIn1 nOut0 nOut1 azx0 azx1 n => - get_outputs_rec azx1 (offset + nOut0)%nat (get_outputs_rec azx0 offset basemap) - | A_G2_Compose azx0 azx1 n => get_outputs_rec azx1 offset basemap - end. - -Definition get_outputs {nIn nOut} (zxa : A_G2_ZX nIn nOut) : NatNatMaps := get_outputs_rec zxa 0 EmptyNatNatMaps. - -Ltac unfold_get_outputs := unfold get_outputs; unfold get_outputs_rec; simpl. - -Definition test_compose :A_G2_ZX 2 1 := - (A_G2_Compose (A_G2_Z_Spider_2_1 0 1%nat) - (A_G2_Z_Spider_1_1 0 2%nat) - 3%nat). - -Definition test_diagram : A_G2_ZX 3 3 := - A_G2_Stack - (A_G2_Compose (A_G2_Z_Spider_2_1 0 1%nat) - (A_G2_Z_Spider_1_1 0 2%nat) - 3%nat) - (A_G2_Z_Spider_1_2 0 4%nat) 5%nat. - -Definition test_inputs := get_inputs test_diagram. - -Definition test_outputs := get_outputs test_diagram. - -Lemma get_inputs_test_0 : NatMaps.find 0 test_inputs = Some 1. -Proof. - unfold test_inputs. - unfold_get_inputs. - apply NatMaps.find_1. - apply NatMaps.add_2; [ auto | ]. - apply NatMaps.add_1; auto. -Qed. - -Lemma get_outputs_test_c_0 : NatMaps.find 0 (get_outputs test_compose) = Some 2. -Proof. - unfold_get_outputs. - apply NatMaps.find_1. - apply NatMaps.add_1; auto. -Qed. - -Lemma get_outputs_test_0 : NatMaps.find 0 (get_outputs test_diagram) = Some 2. -Proof. - unfold_get_outputs. - apply NatMaps.find_1. - apply NatMaps.add_2; auto. - apply NatMaps.add_2; auto. - apply NatMaps.add_1; auto. -Qed. - - (* - Proof steps: - 1. Prove id is populated after visist. - 2. Prove all ids are populated - 3. Prove list length is equal to node in/outputs - -*) diff --git a/src/.Old/ZX_G.v b/src/.Old/ZX_G.v deleted file mode 100644 index 0521ac1..0000000 --- a/src/.Old/ZX_G.v +++ /dev/null @@ -1,310 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.VectorStates. -Require Export ZX. -Require Export ZX_H. -Require Export Gates. -Require Export GateRules. -Require Export Rules. -Require Export VyZX.Proportional. -Require Import Setoid. - -Local Declare Scope G_ZX_scope. -Local Open Scope G_ZX_scope. - -Local Open Scope R_scope. -Inductive G_ZX : nat -> nat -> Type := - | G_Empty : G_ZX 0 0 - | G_Z_Spider_1_nOut nOut (α : R) : G_ZX 1 nOut - | G_Z_Spider_nIn_1 nIn (α : R) : G_ZX nIn 1 - | G_Cap : G_ZX 0 2 - | G_Cup : G_ZX 2 0 - | G_Swap : G_ZX 2 2 - | G_Stack {nIn0 nIn1 nOut0 nOut1} (zx0 : G_ZX nIn0 nOut0) (zx1 : G_ZX nIn1 nOut1) : - G_ZX (nIn0 + nIn1) (nOut0 + nOut1) - | G_Compose {nIn nMid nOut} (zx0 : G_ZX nIn nMid) (zx1 : G_ZX nMid nOut) : G_ZX nIn nOut. -Local Close Scope R_scope. - -Notation "⦰G" := G_Empty. (* \revemptyset *) -Notation "⊂G'" := G_Cap. (* \subset *) -Notation "⊃G'" := G_Cup. (* \supset *) -Notation "⨉G'" := G_Swap. (* \bigtimes *) -Infix "⟷G" := G_Compose (left associativity, at level 40). (* \longleftrightarrow *) -Infix "↕G" := G_Stack (left associativity, at level 40). (* \updownarrow *) - -Fixpoint G_ZX_semantics {nIn nOut} (zx : G_ZX nIn nOut) : - Matrix (2 ^ nOut) (2 ^nIn) := - match zx with - | ⦰G => H_ZX_semantics ⦰H - | G_Z_Spider_1_nOut nOut α => H_ZX_semantics (H_Z_Spider 1 nOut α) - | G_Z_Spider_nIn_1 nIn α => H_ZX_semantics (H_Z_Spider nIn 1 α) - | G_Cap => H_ZX_semantics (H_Cap) - | G_Cup => H_ZX_semantics (H_Cup) - | G_Swap => H_ZX_semantics (H_Swap) - | zx0 ↕G zx1 => (G_ZX_semantics zx0) ⊗ (G_ZX_semantics zx1) - | @G_Compose _ nMid _ zx0 zx1 => (G_ZX_semantics zx1) × (nMid ⨂ hadamard) × (G_ZX_semantics zx0) - end. - -Fixpoint G_ZX_to_H_ZX {nIn nOut} (zx : G_ZX nIn nOut) : H_ZX nIn nOut := - match zx with - | G_Empty => H_Empty - | G_Z_Spider_1_nOut nOut α => H_Z_Spider 1 nOut α - | G_Z_Spider_nIn_1 nIn α => H_Z_Spider nIn 1 α - | G_Cap => H_Cap - | G_Cup => H_Cup - | G_Swap => H_Swap - | G_Stack zx0 zx1 => (G_ZX_to_H_ZX zx0) ↕H (G_ZX_to_H_ZX zx1) - | G_Compose zx0 zx1 => (G_ZX_to_H_ZX zx0) ⟷H (G_ZX_to_H_ZX zx1) - end. - -Local Opaque H_ZX_semantics. -Lemma WF_G_ZX : forall nIn nOut (zx : G_ZX nIn nOut), WF_Matrix (G_ZX_semantics zx). -Proof. - intros. - induction zx; simpl; restore_dims; try auto with wf_db. -Qed. -Local Transparent H_ZX_semantics. - -Global Hint Resolve WF_G_ZX : wf_db. - -Definition G_proportional {nIn nOut} (zx0 : G_ZX nIn nOut) (zx1 : G_ZX nIn nOut) := - proportional_general G_ZX_semantics zx0 zx1. - -Infix "∝G" := G_proportional (at level 70). - -Lemma G_proportional_refl : forall {nIn nOut} (zx : G_ZX nIn nOut), zx ∝G zx. -Proof. - intros. - apply proportional_general_refl. -Qed. - -Lemma G_proportional_symm : forall {nIn nOut} (zx0 zx1 : G_ZX nIn nOut), - zx0 ∝G zx1 -> zx1 ∝G zx0. -Proof. - intros. - apply proportional_general_symm; assumption. -Qed. - -Lemma G_proportional_trans : forall {nIn nOut} (zx0 zx1 zx2 : G_ZX nIn nOut), - zx0 ∝G zx1 -> zx1 ∝G zx2 -> zx0 ∝G zx2. -Proof. - intros. - apply (proportional_general_trans _ _ _ G_ZX_semantics zx0 zx1 zx2); assumption. -Qed. - -Add Parametric Relation (nIn nOut : nat) : (G_ZX nIn nOut) (@G_proportional nIn nOut) - reflexivity proved by G_proportional_refl - symmetry proved by G_proportional_symm - transitivity proved by G_proportional_trans - as zx_g_prop_equiv_rel. - -Lemma G_stack_compat : - forall nIn0 nOut0 nIn1 nOut1, - forall zx0 zx1 : G_ZX nIn0 nOut0, zx0 ∝G zx1 -> - forall zx2 zx3 : G_ZX nIn1 nOut1, zx2 ∝G zx3 -> - zx0 ↕G zx2 ∝G zx1 ↕G zx3. -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - lma. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn0 nOut0 nIn1 nOut1 : nat) : (@G_Stack nIn0 nIn1 nOut0 nOut1) - with signature (@G_proportional nIn0 nOut0) ==> (@G_proportional nIn1 nOut1) ==> - (@G_proportional (nIn0 + nIn1) (nOut0 + nOut1)) as G_stack_mor. -Proof. apply G_stack_compat; assumption. Qed. - -Local Open Scope C_scope. - -Theorem G_ZX_to_H_ZX_consistent : forall nIn nOut (zx : G_ZX nIn nOut), - G_ZX_semantics zx = (H_ZX_semantics (G_ZX_to_H_ZX zx)). -Proof. - intros. - induction zx; try auto; - (* Composition cases *) - simpl; rewrite IHzx1, IHzx2; reflexivity. -Qed. - -Definition G_Wire := G_Z_Spider_nIn_1 1 0. - -Local Opaque H_ZX_semantics. -Local Transparent H_Wire. -Lemma G_wire_identity_semantics : G_ZX_semantics G_Wire = I 2. -Proof. - simpl. - rewrite <- H_wire_identity_semantics. - unfold H_Wire. - reflexivity. -Qed. -Local Transparent H_ZX_semantics. -Local Opaque H_Wire. -Local Opaque G_Wire. - -Fixpoint H_ZX_to_G_ZX {nIn nOut} (zx : H_ZX nIn nOut) : G_ZX nIn nOut := - match zx with - | H_Empty => G_Empty - | H_Z_Spider nIn nOut α => G_Z_Spider_nIn_1 nIn α ⟷G G_Wire ⟷G G_Z_Spider_1_nOut nOut 0%R - | H_Cap => G_Cap - | H_Cup => G_Cup - | H_Swap => G_Swap - | zx0 ↕H zx1 => (H_ZX_to_G_ZX zx0) ↕G (H_ZX_to_G_ZX zx1) - | zx0 ⟷H zx1 => (H_ZX_to_G_ZX zx0) ⟷G (H_ZX_to_G_ZX zx1) - end. - -Theorem H_ZX_to_G_ZX_consistent : forall nIn nOut (zx : H_ZX nIn nOut), - H_ZX_semantics zx = (G_ZX_semantics (H_ZX_to_G_ZX zx)). -Proof. - intros. - induction zx; try auto; - (* Composition *) - try (simpl; - rewrite IHzx1, IHzx2; - reflexivity). - (* Interesting case: Spider fusion *) - Local Opaque ZX_semantics. - simpl. - rewrite G_wire_identity_semantics. - Msimpl. - rewrite <- Mmult_assoc. - rewrite (Mmult_assoc _ hadamard hadamard). - rewrite MmultHH. - Msimpl. - rewrite <- ZX_semantics_Compose. - rewrite Z_spider_1_1_fusion_eq. - rewrite Rplus_0_r. - reflexivity. - Local Transparent ZX_semantics. -Qed. - -Definition ZX_to_G_ZX {nIn nOut} (zx : ZX nIn nOut) := H_ZX_to_G_ZX (ZX_to_H_ZX zx). -Definition G_ZX_to_ZX {nIn nOut} (zx : G_ZX nIn nOut) := H_ZX_to_ZX (G_ZX_to_H_ZX zx). - -Theorem G_ZX_to_ZX_consistent : forall nIn nOut (zx : G_ZX nIn nOut), - exists (θ : R), G_ZX_semantics zx = (Cexp θ) .* (ZX_semantics (G_ZX_to_ZX zx)). -Proof. - intros. - rewrite G_ZX_to_H_ZX_consistent. - apply H_ZX_to_ZX_consistent. -Qed. - -Theorem ZX_to_ZX_G_consistent : forall nIn nOut (zx : ZX nIn nOut), - exists (θ : R), ZX_semantics zx = (Cexp θ) .* (G_ZX_semantics (ZX_to_G_ZX zx)). -Proof. - intros. - simpl. - unfold ZX_to_G_ZX. - rewrite <- H_ZX_to_G_ZX_consistent. - apply ZX_to_H_ZX_consistent. -Qed. - -Lemma ZX_G_ZX_H_involutive : forall nIn nOut (zx : H_ZX nIn nOut), G_ZX_to_H_ZX (H_ZX_to_G_ZX zx) ∝H zx. -Proof. - intros. - prop_exists_nonzero 1%R. - Msimpl. - simpl. - rewrite <- G_ZX_to_H_ZX_consistent. - rewrite <- H_ZX_to_G_ZX_consistent. - reflexivity. -Qed. - -Lemma ZX_H_ZX_G_involutive : forall nIn nOut (zx : G_ZX nIn nOut), H_ZX_to_G_ZX (G_ZX_to_H_ZX zx) ∝G zx. -Proof. - intros. - prop_exists_nonzero 1%R. - Msimpl. - simpl. - rewrite <- H_ZX_to_G_ZX_consistent. - rewrite <- G_ZX_to_H_ZX_consistent. - reflexivity. -Qed. - -Lemma H_ZX_to_G_ZX_compat : forall nIn nOut (zx0 zx1 : H_ZX nIn nOut), - zx0 ∝H zx1 -> (H_ZX_to_G_ZX zx0) ∝G (H_ZX_to_G_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold H_proportional. - unfold proportional_general. - exists x. - repeat rewrite <- H_ZX_to_G_ZX_consistent. - split; assumption. -Qed. - -Lemma G_ZX_to_H_ZX_compat : forall nIn nOut (zx0 zx1 : G_ZX nIn nOut), - zx0 ∝G zx1 -> (G_ZX_to_H_ZX zx0) ∝H (G_ZX_to_H_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold H_proportional. - unfold proportional_general. - exists x. - repeat rewrite <- G_ZX_to_H_ZX_consistent. - split; assumption. -Qed. - -Lemma ZX_to_G_ZX_compat : forall nIn nOut (zx0 zx1 : ZX nIn nOut), - zx0 ∝ zx1 -> (ZX_to_G_ZX zx0) ∝G (ZX_to_G_ZX zx1). -Proof. - intros. - apply H_ZX_to_G_ZX_compat. - apply ZX_to_H_ZX_compat. - assumption. -Qed. - -Lemma G_ZX_to_ZX_compat : forall nIn nOut (zx0 zx1 : G_ZX nIn nOut), - zx0 ∝G zx1 -> (G_ZX_to_ZX zx0) ∝ (G_ZX_to_ZX zx1). -Proof. - intros. - apply H_ZX_to_ZX_compat. - apply G_ZX_to_H_ZX_compat. - assumption. -Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@ZX_to_G_ZX nIn nOut) - with signature (@proportional nIn nOut) ==> (@G_proportional nIn nOut) as ZX_to_G_ZX_mor. -Proof. apply ZX_to_G_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@G_ZX_to_ZX nIn nOut) - with signature (@G_proportional nIn nOut) ==> (@proportional nIn nOut) as G_ZX_to_ZX_mor. -Proof. apply G_ZX_to_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@H_ZX_to_G_ZX nIn nOut) - with signature (@H_proportional nIn nOut) ==> (@G_proportional nIn nOut) as H_ZX_to_G_ZX_mor. -Proof. apply H_ZX_to_G_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@G_ZX_to_H_ZX nIn nOut) - with signature (@G_proportional nIn nOut) ==> (@H_proportional nIn nOut) as G_ZX_to_H_ZX_mor. -Proof. apply G_ZX_to_H_ZX_compat. Qed. - -Lemma G_ZX_ZX_involutive : forall nIn nOut (zx : ZX nIn nOut), G_ZX_to_ZX (ZX_to_G_ZX zx) ∝ zx. -Proof. - intros. - Msimpl. - simpl. - unfold ZX_to_G_ZX. - unfold G_ZX_to_ZX. - rewrite ZX_G_ZX_H_involutive. - apply ZX_H_ZX_involutive. -Qed. - -Lemma ZX_G_ZX_involutive : forall nIn nOut (zx : G_ZX nIn nOut), ZX_to_G_ZX (G_ZX_to_ZX zx) ∝G zx. -Proof. - intros. - Msimpl. - simpl. - unfold ZX_to_G_ZX. - unfold G_ZX_to_ZX. - rewrite H_ZX_ZX_involutive. - apply ZX_H_ZX_G_involutive. -Qed. - - - - - diff --git a/src/.Old/ZX_G_2.v b/src/.Old/ZX_G_2.v deleted file mode 100644 index 7d88bfc..0000000 --- a/src/.Old/ZX_G_2.v +++ /dev/null @@ -1,560 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.VectorStates. -Require Export ZX. -Require Export ZX_G. -Require Export Gates. -Require Export GateRules. -Require Export Rules. -Require Export VyZX.Proportional. -Require Import Setoid. - -Local Declare Scope G2_ZX_scope. -Local Open Scope G2_ZX_scope. - -Local Open Scope R_scope. -Inductive G2_ZX : nat -> nat -> Type := - | G2_Empty : G2_ZX 0 0 - | G2_Z_Spider_1_0 (α : R) : G2_ZX 1 0 - | G2_Z_Spider_0_1 (α : R) : G2_ZX 0 1 - | G2_Z_Spider_1_1 (α : R) : G2_ZX 1 1 (* Required to build wire construct *) - | G2_Z_Spider_1_2 (α : R) : G2_ZX 1 2 - | G2_Z_Spider_2_1 (α : R) : G2_ZX 2 1 - | G2_Cap : G2_ZX 0 2 - | G2_Cup : G2_ZX 2 0 - | G2_Swap : G2_ZX 2 2 - | G2_Stack {nIn0 nIn1 nOut0 nOut1} (zx0 : G2_ZX nIn0 nOut0) (zx1 : G2_ZX nIn1 nOut1) : - G2_ZX (nIn0 + nIn1) (nOut0 + nOut1) - | G2_Compose {nIn nMid nOut} (zx0 : G2_ZX nIn nMid) (zx1 : G2_ZX nMid nOut) : G2_ZX nIn nOut. -Local Close Scope R_scope. - -Notation "⦰G2" := G2_Empty. (* \revemptyset *) -Notation "⊂G2" := G2_Cap. (* \subset *) -Notation "⊃G2" := G2_Cup. (* \supset *) -Notation "⨉G2" := G2_Swap. (* \bigtimes *) -Infix "⟷G2" := G2_Compose (left associativity, at level 40). (* \longleftrightarrow *) -Infix "↕G2" := G2_Stack (left associativity, at level 40). (* \updownarrow *) - -Fixpoint G2_ZX_semantics {nIn nOut} (zx : G2_ZX nIn nOut) : - Matrix (2 ^ nOut) (2 ^nIn) := - match zx with - | ⦰G2 => G_ZX_semantics ⦰G - | G2_Z_Spider_1_0 α => G_ZX_semantics (G_Z_Spider_1_nOut 0 α) - | G2_Z_Spider_0_1 α => G_ZX_semantics (G_Z_Spider_nIn_1 0 α) - | G2_Z_Spider_1_1 α => G_ZX_semantics (G_Z_Spider_1_nOut 1 α) - | G2_Z_Spider_1_2 α => G_ZX_semantics (G_Z_Spider_1_nOut 2 α) - | G2_Z_Spider_2_1 α => G_ZX_semantics (G_Z_Spider_nIn_1 2 α) - | G2_Cap => G_ZX_semantics (G_Cap) - | G2_Cup => G_ZX_semantics (G_Cup) - | G2_Swap => G_ZX_semantics (G_Swap) - | zx0 ↕G2 zx1 => (G2_ZX_semantics zx0) ⊗ (G2_ZX_semantics zx1) - | @G2_Compose _ nMid _ zx0 zx1 => (G2_ZX_semantics zx1) × (nMid ⨂ hadamard) × (G2_ZX_semantics zx0) - end. - -Fixpoint G2_ZX_to_G_ZX {nIn nOut} (zx : G2_ZX nIn nOut) : G_ZX nIn nOut := - match zx with - | ⦰G2 => ⦰G - | G2_Z_Spider_1_0 α => G_Z_Spider_1_nOut 0 α - | G2_Z_Spider_0_1 α => G_Z_Spider_nIn_1 0 α - | G2_Z_Spider_1_1 α => G_Z_Spider_1_nOut 1 α - | G2_Z_Spider_1_2 α => G_Z_Spider_1_nOut 2 α - | G2_Z_Spider_2_1 α => G_Z_Spider_nIn_1 2 α - | G2_Cap => G_Cap - | G2_Cup => G_Cup - | G2_Swap => G_Swap - | zx0 ↕G2 zx1 => (G2_ZX_to_G_ZX zx0) ↕G (G2_ZX_to_G_ZX zx1) - | zx0 ⟷G2 zx1 => (G2_ZX_to_G_ZX zx0) ⟷G (G2_ZX_to_G_ZX zx1) - end. - -Local Opaque ZX_semantics. -Lemma WF_G2_ZX : forall nIn nOut (zx : G2_ZX nIn nOut), WF_Matrix (G2_ZX_semantics zx). -Proof. - intros. - induction zx; simpl; try restore_dims; try auto with wf_db. -Qed. -Local Transparent ZX_semantics. - -Global Hint Resolve WF_G2_ZX : wf_db. - -Definition G2_proportional {nIn nOut} (zx0 : G2_ZX nIn nOut) (zx1 : G2_ZX nIn nOut) := - proportional_general G2_ZX_semantics zx0 zx1. - -Infix "∝G2" := G2_proportional (at level 70). - -Lemma G2_proportional_refl : forall {nIn nOut} (zx : G2_ZX nIn nOut), zx ∝G2 zx. -Proof. - intros. - apply proportional_general_refl. -Qed. - -Lemma G2_proportional_symm : forall {nIn nOut} (zx0 zx1 : G2_ZX nIn nOut), - zx0 ∝G2 zx1 -> zx1 ∝G2 zx0. -Proof. - intros. - apply proportional_general_symm; assumption. -Qed. - -Lemma G2_proportional_trans : forall {nIn nOut} (zx0 zx1 zx2 : G2_ZX nIn nOut), - zx0 ∝G2 zx1 -> zx1 ∝G2 zx2 -> zx0 ∝G2 zx2. -Proof. - intros. - apply (proportional_general_trans _ _ _ G2_ZX_semantics zx0 zx1 zx2); assumption. -Qed. - -Add Parametric Relation (nIn nOut : nat) : (G2_ZX nIn nOut) (@G2_proportional nIn nOut) - reflexivity proved by G2_proportional_refl - symmetry proved by G2_proportional_symm - transitivity proved by G2_proportional_trans - as zx_g_prop_equiv_rel. - -Lemma G2_stack_compat : - forall nIn0 nOut0 nIn1 nOut1, - forall zx0 zx1 : G2_ZX nIn0 nOut0, zx0 ∝G2 zx1 -> - forall zx2 zx3 : G2_ZX nIn1 nOut1, zx2 ∝G2 zx3 -> - zx0 ↕G2 zx2 ∝G2 zx1 ↕G2 zx3. -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - lma. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn0 nOut0 nIn1 nOut1 : nat) : (@G2_Stack nIn0 nIn1 nOut0 nOut1) - with signature (@G2_proportional nIn0 nOut0) ==> (@G2_proportional nIn1 nOut1) ==> - (@G2_proportional (nIn0 + nIn1) (nOut0 + nOut1)) as G2_stack_mor. -Proof. apply G2_stack_compat; assumption. Qed. - -Local Open Scope C_scope. - -Theorem G2_ZX_to_G_ZX_consistent : forall nIn nOut (zx : G2_ZX nIn nOut), - G2_ZX_semantics zx = (G_ZX_semantics (G2_ZX_to_G_ZX zx)). -Proof. - intros. - induction zx; try auto; - (* Composition cases *) - simpl; rewrite IHzx1, IHzx2; reflexivity. -Qed. - -Definition G2_Wire := G2_Z_Spider_1_1 0. - -Local Opaque G_ZX_semantics. -Local Transparent G_Wire. -Lemma G2_wire_identity_semantics : G2_ZX_semantics G2_Wire = I 2. -Proof. - simpl. - rewrite <- G_wire_identity_semantics. - unfold G_Wire. - reflexivity. -Qed. -Local Transparent G_ZX_semantics. -Local Opaque G_Wire. -Global Opaque G2_Wire. - -Definition StackWire {nIn nOut} (zx : G2_ZX nIn nOut) : G2_ZX (S nIn) (S nOut) := G2_Wire ↕G2 zx. - -Fixpoint G_Spider_In_to_G2_Spiders nOut α: G2_ZX 1 nOut := - match nOut with - | 0%nat => G2_Z_Spider_1_0 α - | S nOut' => G2_Z_Spider_1_2 α ⟷G2 (StackWire G2_Wire) ⟷G2 StackWire (G_Spider_In_to_G2_Spiders nOut' 0%R) - end. - -Local Opaque G_ZX_semantics. -Lemma G_Spider_In_to_G2_Spiders_consistent : forall nOut α, G_ZX_semantics (G_Z_Spider_1_nOut nOut α) = G2_ZX_semantics (G_Spider_In_to_G2_Spiders nOut α). -Proof. - intro nOut. - Transparent G_ZX_semantics. - induction nOut. - - (* Base Case *) - reflexivity. - - (* Inductive Case ∀ α : R, G_ZX_semantics (G_Z_Spider_1_nOut nOut α) = G2_ZX_semantics (G_Spider_In_to_G2_Spiders (S nOut) α *) - (* Extract the inductive hypothesis from the statement, and remove the hadamards. *) - simpl in IHnOut. simpl. - rewrite kron_1_l; [| auto with wf_db]. - rewrite G2_wire_identity_semantics. - rewrite id_kron. - replace (2*2)%nat with (4)%nat by reflexivity. - rewrite Mmult_1_l; [| auto with wf_db]. - intros. - rewrite Mmult_assoc. - restore_dims. - rewrite <- (Mmult_assoc (hadamard ⊗ hadamard)). - rewrite kron_mixed_product. - rewrite MmultHH. - rewrite id_kron. - restore_dims. - rewrite Mmult_1_l; [| auto with wf_db]. - rewrite <- IHnOut. - (* Prepare for matrix equality by putting x,y in front of every matrix (except for those with ⊗). *) - prep_matrix_equality. - unfold Mmult. - Opaque Z_semantics. - simpl. - rewrite Cplus_0_l. - Transparent Z_semantics. - (* C_field_simplify eliminates 0%R * cases, but will not always be well behaved. It is for this one, but the next proof it is not. *) - destruct x,y; simpl; C_field_simplify. - + (* x = 0, y = 0 *) - unfold kron; simpl. - rewrite Nat.mod_0_l;[| apply Nat.pow_nonzero; easy]. - rewrite Nat.div_0_l;[| apply Nat.pow_nonzero; easy]. - lca. - + (* x = 0, y = S y' *) - bdestruct (y =? 0). (* This y is y', shows up in both booleans, so we bdestruct it *) - * unfold kron. (* We have booleans in the lhs of =, but no way to see how they relate to rhs of = *) - destruct (2 ^ nOut)%nat eqn:E2nOut. - -- apply (Nat.pow_nonzero) in E2nOut; [destruct E2nOut | easy]. - -- simpl. - rewrite <- plus_n_Sm. - simpl. - lca. - * rewrite andb_false_r. - lca. - + rewrite andb_false_r. - unfold kron. - simpl. - unfold Z_semantics. - rewrite andb_false_r. - destruct ((S x) mod 2^nOut) eqn:ExMod. - * apply Nat.mod_divides in ExMod; [| apply Nat.pow_nonzero; easy]. - destruct ExMod. - rewrite H. - rewrite Nat.mul_comm. - rewrite Nat.div_mul; [| apply Nat.pow_nonzero; easy]. - destruct x0. - -- rewrite Nat.mul_0_r in H. - discriminate H. - -- lca. - * lca. - + bdestruct (y =? 0). - * rewrite andb_true_r. - unfold kron. - simpl. - destruct (2 ^ nOut)%nat eqn:E2nOut. - -- simpl. - lca. - -- replace (S n + (S n + 0) - 1)%nat with (S (n + n))%nat by lia. - bdestruct (x =? n + n). - ++ rewrite H0. - rewrite plus_n_Sm. - rewrite Nat.add_mod; [| easy]. - rewrite Nat.mod_same; [| easy]. - rewrite plus_0_r. - rewrite Nat.mod_mod; [| easy]. - rewrite Nat.mod_small; [| constructor; constructor]. - replace ((n + S n) / S n)%nat - with (1)%nat. - ** unfold Z_semantics. - assert ((2 ^ nOut - 1) = n)%nat. - { rewrite E2nOut. lia. } - rewrite H1. - rewrite Nat.eqb_refl. - autorewrite with Cexp_db. - destruct n; lca. - ** rewrite Nat.add_comm. - replace ((S n) + n)%nat with ((1 * (S n)) + n)%nat by lia. - rewrite Nat.div_add_l; [| easy]. - rewrite Nat.div_small; [| auto]. - reflexivity. - ++ unfold Z_semantics. - rewrite E2nOut. - unfold I. - bdestruct (S x / S n =? 1). - ** assert (Hx : (S x) = ((S n) * ((S x) / (S n)) + (S x) mod (S n))%nat); [apply Nat.div_mod; lia |]. - rewrite H1 in Hx. - rewrite Nat.mul_1_r in Hx. - bdestruct (S x mod S n =? S n - 1). - --- rewrite H2 in Hx. - simpl in Hx. - rewrite Nat.sub_0_r in Hx. - inversion Hx. - contradiction. - --- destruct (S x mod S n); lca. - ** lca. - * rewrite andb_false_r. - lca. -Qed. - -Fixpoint G_Spider_Out_to_G2_Spiders nIn α: G2_ZX nIn 1 := - match nIn with - | 0%nat => G2_Z_Spider_0_1 α - | S nIn' => (StackWire (G_Spider_Out_to_G2_Spiders nIn' 0%R)) ⟷G2 (StackWire G2_Wire) ⟷G2 G2_Z_Spider_2_1 α - end. - -Lemma G_Spider_Out_to_G2_Spiders_consistent : forall nIn α, G_ZX_semantics (G_Z_Spider_nIn_1 nIn α) = G2_ZX_semantics (G_Spider_Out_to_G2_Spiders nIn α). -Proof. - intro nIn. - Transparent G_ZX_semantics. - induction nIn. - - reflexivity. - - simpl. - rewrite kron_1_l; [| auto with wf_db]. - rewrite G2_wire_identity_semantics. - rewrite id_kron. - replace (2*2)%nat with (4)%nat by reflexivity. - rewrite Mmult_1_l; [| auto with wf_db]. - intros. - rewrite Mmult_assoc. - restore_dims. - rewrite <- (Mmult_assoc (hadamard ⊗ hadamard)). - rewrite kron_mixed_product. - rewrite MmultHH. - rewrite id_kron. - restore_dims. - rewrite Mmult_1_l; [| auto with wf_db]. - rewrite <- IHnIn. - prep_matrix_equality. - unfold Mmult. - Opaque Z_semantics. - simpl. - rewrite Cplus_0_l. - Transparent Z_semantics. - destruct x, y; simpl; try (rewrite andb_false_r; simpl). - + (* x = 0, y = 0 *) - C_field_simplify. - unfold kron; simpl. - rewrite Nat.mod_0_l;[| apply Nat.pow_nonzero; easy]. - rewrite Nat.div_0_l;[| apply Nat.pow_nonzero; easy]. - destruct nIn; lca. - + (* x = 0, y = S n *) - repeat rewrite Cmult_0_l. - repeat rewrite Cplus_0_r. - rewrite Cmult_1_l. - unfold kron. - rewrite Nat.mod_0_l; [| easy]. - rewrite Nat.div_0_l; [| easy]. - simpl. - destruct (S y mod 2 ^ nIn) eqn:ESnmod2NIn. - * rewrite Nat.mod_divides in ESnmod2NIn; [| apply Nat.pow_nonzero; easy]. - destruct ESnmod2NIn as [c Hc]. - destruct c. - -- rewrite Nat.mul_0_r in Hc. - discriminate. - -- rewrite Hc. - rewrite Nat.mul_comm. - rewrite Nat.div_mul; [| apply Nat.pow_nonzero; easy]. - lca. - * lca. - + (* x = S n, y = 0 *) - C_field_simplify. - destruct (2^nIn)%nat eqn:Epow. - * contradict Epow. - apply Nat.pow_nonzero. - easy. - * simpl. - rewrite <- plus_n_Sm. - simpl. - rewrite andb_false_r. - lca. - + (* x = S n, y = S m *) - C_field_simplify. - destruct (2^nIn)%nat eqn:Epow. - { contradict Epow; apply Nat.pow_nonzero; easy. } - simpl. - rewrite <- plus_n_Sm. - simpl. - rewrite andb_true_r. - rewrite plus_0_r. - unfold kron. - replace (3/2)%nat with 1%nat by reflexivity. - replace (3 mod 2)%nat with 1%nat by reflexivity. - unfold Z_semantics. - replace (1 =? 2 ^ 1 - 1) with true by reflexivity. - rewrite andb_true_l. - bdestruct (y =? n + n). - * rewrite H. - rewrite Epow. - replace (S (n + n) / S n)% nat with 1%nat. - -- rewrite <- plus_Sn_m. - rewrite Nat.add_mod; [| easy]. - rewrite Nat.mod_same; [| easy]. - rewrite Nat.add_0_l. - rewrite Nat.mod_mod; [| easy]. - rewrite Nat.mod_small; [| auto]. - simpl. - rewrite Nat.sub_0_r. - rewrite Nat.eqb_refl. - rewrite Cexp_0. - destruct x; lca. - -- rewrite <- plus_Sn_m. - replace ((S n + n) / S n)%nat - with ( 1 + (n / S n))%nat. - { rewrite Nat.div_small; auto. } - rewrite <- Nat.div_add_l; [| auto]. - rewrite Nat.mul_1_l. - reflexivity. - * rewrite andb_false_r. - rewrite Epow. - bdestruct (S y / S n =? 1)%nat. - -- assert (Hx : (S y) = ((S n) * ((S y) / (S n)) + (S y) mod (S n))%nat); [apply Nat.div_mod; lia |]. - rewrite H0 in Hx. - rewrite Nat.mul_1_r in Hx. - bdestruct (S y mod S n =? S n - 1)%nat. - ++ rewrite H1 in Hx. - simpl in Hx. - rewrite Nat.sub_0_r in Hx. - inversion Hx. - contradiction. - ++ lca. - -- destruct (S y / S n)%nat. - ++ lca. - ++ destruct n0. - ** contradiction. - ** unfold I. - simpl. - rewrite Cmult_0_l. - lca. -Qed. - -Fixpoint G_ZX_to_G2_ZX {nIn nOut} (zx : G_ZX nIn nOut) : G2_ZX nIn nOut := - match zx with - | G_Empty => G2_Empty - | G_Z_Spider_1_nOut nOut α => G_Spider_In_to_G2_Spiders nOut α - | G_Z_Spider_nIn_1 nIn α => G_Spider_Out_to_G2_Spiders nIn α - | G_Cap => G2_Cap - | G_Cup => G2_Cup - | G_Swap => G2_Swap - | zx0 ↕G zx1 => (G_ZX_to_G2_ZX zx0) ↕G2 (G_ZX_to_G2_ZX zx1) - | zx0 ⟷G zx1 => (G_ZX_to_G2_ZX zx0) ⟷G2 (G_ZX_to_G2_ZX zx1) - end. - -Theorem G_ZX_to_G2_ZX_consistent : forall nIn nOut (zx : G_ZX nIn nOut), - G_ZX_semantics zx = (G2_ZX_semantics (G_ZX_to_G2_ZX zx)). -Proof. - intros. - induction zx; try auto; - (* Composition *) - try (simpl; - rewrite IHzx1, IHzx2; - reflexivity). - (* Interesting case: Spider fusion *) - apply G_Spider_In_to_G2_Spiders_consistent. - apply G_Spider_Out_to_G2_Spiders_consistent. -Qed. - -Definition ZX_to_G2_ZX {nIn nOut} (zx : ZX nIn nOut) := G_ZX_to_G2_ZX (ZX_to_G_ZX zx). -Definition G2_ZX_to_ZX {nIn nOut} (zx : G2_ZX nIn nOut) := G_ZX_to_ZX (G2_ZX_to_G_ZX zx). - -Theorem G2_ZX_to_ZX_consistent : forall nIn nOut (zx : G2_ZX nIn nOut), - exists (θ : R), G2_ZX_semantics zx = (Cexp θ) .* (ZX_semantics (G2_ZX_to_ZX zx)). -Proof. - intros. - rewrite G2_ZX_to_G_ZX_consistent. - apply G_ZX_to_ZX_consistent. -Qed. - -Theorem ZX_to_ZX_G_consistent : forall nIn nOut (zx : ZX nIn nOut), - exists (θ : R), ZX_semantics zx = (Cexp θ) .* (G2_ZX_semantics (ZX_to_G2_ZX zx)). -Proof. - intros. - simpl. - unfold ZX_to_G2_ZX. - rewrite <- G_ZX_to_G2_ZX_consistent. - apply ZX_to_ZX_G_consistent. -Qed. - -Lemma ZX_G2_ZX_H_involutive : forall nIn nOut (zx : G_ZX nIn nOut), G2_ZX_to_G_ZX (G_ZX_to_G2_ZX zx) ∝G zx. -Proof. - intros. - prop_exists_nonzero 1%R. - Msimpl. - simpl. - rewrite <- G2_ZX_to_G_ZX_consistent. - rewrite <- G_ZX_to_G2_ZX_consistent. - reflexivity. -Qed. - -Lemma ZX_G_ZX_G_involutive : forall nIn nOut (zx : G2_ZX nIn nOut), G_ZX_to_G2_ZX (G2_ZX_to_G_ZX zx) ∝G2 zx. -Proof. - intros. - prop_exists_nonzero 1%R. - Msimpl. - simpl. - rewrite <- G_ZX_to_G2_ZX_consistent. - rewrite <- G2_ZX_to_G_ZX_consistent. - reflexivity. -Qed. - -Lemma G_ZX_to_G2_ZX_compat : forall nIn nOut (zx0 zx1 : G_ZX nIn nOut), - zx0 ∝G zx1 -> (G_ZX_to_G2_ZX zx0) ∝G2 (G_ZX_to_G2_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold H_proportional. - unfold proportional_general. - exists x. - repeat rewrite <- G_ZX_to_G2_ZX_consistent. - split; assumption. -Qed. - -Lemma G2_ZX_to_G_ZX_compat : forall nIn nOut (zx0 zx1 : G2_ZX nIn nOut), - zx0 ∝G2 zx1 -> (G2_ZX_to_G_ZX zx0) ∝G (G2_ZX_to_G_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold H_proportional. - unfold proportional_general. - exists x. - repeat rewrite <- G2_ZX_to_G_ZX_consistent. - split; assumption. -Qed. - -Lemma ZX_to_G2_ZX_compat : forall nIn nOut (zx0 zx1 : ZX nIn nOut), - zx0 ∝ zx1 -> (ZX_to_G2_ZX zx0) ∝G2 (ZX_to_G2_ZX zx1). -Proof. - intros. - apply G_ZX_to_G2_ZX_compat. - apply ZX_to_G_ZX_compat. - assumption. -Qed. - -Lemma G2_ZX_to_ZX_compat : forall nIn nOut (zx0 zx1 : G2_ZX nIn nOut), - zx0 ∝G2 zx1 -> (G2_ZX_to_ZX zx0) ∝ (G2_ZX_to_ZX zx1). -Proof. - intros. - apply G_ZX_to_ZX_compat. - apply G2_ZX_to_G_ZX_compat. - assumption. -Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@ZX_to_G2_ZX nIn nOut) - with signature (@proportional nIn nOut) ==> (@G2_proportional nIn nOut) as ZX_to_G2_ZX_mor. -Proof. apply ZX_to_G2_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@G2_ZX_to_ZX nIn nOut) - with signature (@G2_proportional nIn nOut) ==> (@proportional nIn nOut) as G2_ZX_to_ZX_mor. -Proof. apply G2_ZX_to_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@G_ZX_to_G2_ZX nIn nOut) - with signature (@G_proportional nIn nOut) ==> (@G2_proportional nIn nOut) as G_ZX_to_G2_ZX_mor. -Proof. apply G_ZX_to_G2_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@G2_ZX_to_G_ZX nIn nOut) - with signature (@G2_proportional nIn nOut) ==> (@G_proportional nIn nOut) as G2_ZX_to_G_ZX_mor. -Proof. apply G2_ZX_to_G_ZX_compat. Qed. - -Lemma G2_ZX_ZX_involutive : forall nIn nOut (zx : ZX nIn nOut), G2_ZX_to_ZX (ZX_to_G2_ZX zx) ∝ zx. -Proof. - intros. - Msimpl. - simpl. - unfold ZX_to_G2_ZX. - unfold G2_ZX_to_ZX. - rewrite ZX_G2_ZX_H_involutive. - apply G_ZX_ZX_involutive. -Qed. - -Lemma ZX_G2_ZX_involutive : forall nIn nOut (zx : G2_ZX nIn nOut), ZX_to_G2_ZX (G2_ZX_to_ZX zx) ∝G2 zx. -Proof. - intros. - Msimpl. - simpl. - unfold ZX_to_G2_ZX. - unfold G2_ZX_to_ZX. - rewrite ZX_G_ZX_involutive. - apply ZX_G_ZX_G_involutive. -Qed. - diff --git a/src/.Old/ZX_H.v b/src/.Old/ZX_H.v deleted file mode 100644 index dd89fab..0000000 --- a/src/.Old/ZX_H.v +++ /dev/null @@ -1,690 +0,0 @@ -Require Import externals.QuantumLib.Quantum. -Require Import externals.QuantumLib.VectorStates. -Require Export ZX. -Require Export Gates. -Require Export GateRules. -Require Export Rules. -Require Export VyZX.Proportional. -Require Import Setoid. - -Local Declare Scope H_ZX_scope. -Local Open Scope H_ZX_scope. - -Local Open Scope R_scope. -Inductive H_ZX : nat -> nat -> Type := - | H_Empty : H_ZX 0 0 - | H_Z_Spider nIn nOut (α : R) : H_ZX nIn nOut - | H_Cap : H_ZX 0 2 - | H_Cup : H_ZX 2 0 - | H_Swap : H_ZX 2 2 - | H_Stack {nIn0 nIn1 nOut0 nOut1} (zx0 : H_ZX nIn0 nOut0) (zx1 : H_ZX nIn1 nOut1) : - H_ZX (nIn0 + nIn1) (nOut0 + nOut1) - | H_Compose {nIn nMid nOut} (zx0 : H_ZX nIn nMid) (zx1 : H_ZX nMid nOut) : H_ZX nIn nOut. -Local Close Scope R_scope. - -Notation "⦰H" := H_Empty. (* \revemptyset *) -Notation "⊂H'" := H_Cap. (* \subset *) -Notation "⊃H'" := H_Cup. (* \supset *) -Notation "⨉H'" := H_Swap. (* \bigtimes *) -Infix "⟷H" := H_Compose (left associativity, at level 40). (* \longleftrightarrow *) -Infix "↕H" := H_Stack (left associativity, at level 40). (* \updownarrow *) - -Fixpoint H_ZX_semantics {nIn nOut} (zx : H_ZX nIn nOut) : - Matrix (2 ^ nOut) (2 ^nIn) := - match zx with - | H_Empty => ZX_semantics Empty - | H_Z_Spider nIn nOut α => ZX_semantics (Z_Spider nIn nOut α) - | H_Cap => ZX_semantics Cap - | H_Cup => ZX_semantics Cup - | H_Swap => ZX_semantics Swap - | H_Stack zx0 zx1 => (H_ZX_semantics zx0) ⊗ (H_ZX_semantics zx1) - | @H_Compose _ nMid _ zx0 zx1 => (H_ZX_semantics zx1) × (nMid ⨂ hadamard) × (H_ZX_semantics zx0) - end. - -Fixpoint H_ZX_to_ZX {nIn nOut} (zx : H_ZX nIn nOut) : ZX nIn nOut := - match zx with - | H_Empty => Empty - | H_Z_Spider nIn nOut α => (Z_Spider nIn nOut α) - | H_Cap => Cap - | H_Cup => Cup - | H_Swap => Swap - | H_Stack zx0 zx1 => Stack (H_ZX_to_ZX zx0) (H_ZX_to_ZX zx1) - | H_Compose zx0 zx1 => (H_ZX_to_ZX zx0) ⥈ (H_ZX_to_ZX zx1) - end. - -Lemma WF_H_ZX : forall nIn nOut (zx : H_ZX nIn nOut), WF_Matrix (H_ZX_semantics zx). -Proof. - intros. - induction zx; try (simpl; auto 10 with wf_db); - apply WF_list2D_to_matrix; - try easy; (* case list of length 4 *) - try intros; simpl in H; repeat destruct H; try discriminate; try (subst; easy). (* Case of 4 lists length 1 *) -Qed. - -Global Hint Resolve WF_H_ZX : wf_db. - -Definition H_proportional {nIn nOut} (zx0 : H_ZX nIn nOut) (zx1 : H_ZX nIn nOut) := - proportional_general H_ZX_semantics zx0 zx1. - -Infix "∝H" := H_proportional (at level 70). - -Lemma H_proportional_refl : forall {nIn nOut} (zx : H_ZX nIn nOut), zx ∝H zx. -Proof. - intros. - apply proportional_general_refl. -Qed. - -Lemma H_proportional_symm : forall {nIn nOut} (zx0 zx1 : H_ZX nIn nOut), - zx0 ∝H zx1 -> zx1 ∝H zx0. -Proof. - intros. - apply proportional_general_symm; assumption. -Qed. - -Lemma H_proportional_trans : forall {nIn nOut} (zx0 zx1 zx2 : H_ZX nIn nOut), - zx0 ∝H zx1 -> zx1 ∝H zx2 -> zx0 ∝H zx2. -Proof. - intros. - apply (proportional_general_trans _ _ _ H_ZX_semantics zx0 zx1 zx2); assumption. -Qed. - -Add Parametric Relation (nIn nOut : nat) : (H_ZX nIn nOut) (@H_proportional nIn nOut) - reflexivity proved by H_proportional_refl - symmetry proved by H_proportional_symm - transitivity proved by H_proportional_trans - as zx_prop_equiv_rel. - -Lemma H_stack_compat : - forall nIn0 nOut0 nIn1 nOut1, - forall zx0 zx1 : H_ZX nIn0 nOut0, zx0 ∝H zx1 -> - forall zx2 zx3 : H_ZX nIn1 nOut1, zx2 ∝H zx3 -> - zx0 ↕H zx2 ∝H zx1 ↕H zx3. -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - lma. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn0 nOut0 nIn1 nOut1 : nat) : (@H_Stack nIn0 nIn1 nOut0 nOut1) - with signature (@H_proportional nIn0 nOut0) ==> (@H_proportional nIn1 nOut1) ==> - (@H_proportional (nIn0 + nIn1) (nOut0 + nOut1)) as H_stack_mor. -Proof. apply H_stack_compat; assumption. Qed. - -Local Open Scope C_scope. - -Theorem H_ZX_to_ZX_consistent : forall nIn nOut (zx : H_ZX nIn nOut), - exists (θ : R), H_ZX_semantics zx = (Cexp θ) .* (ZX_semantics (H_ZX_to_ZX zx)). -Proof. - intros. - induction zx; try (exists 0%R; autorewrite with Cexp_db; Msimpl; simpl; reflexivity). - - destruct IHzx1, IHzx2. - simpl. - rewrite H, H0. - autorewrite with scalar_move_db. - exists (x0+x)%R. - replace ((2 ^ (nIn0 + nIn1))%nat) with (2 ^ nIn0 * 2 ^ nIn1)%nat by (rewrite Nat.pow_add_r; reflexivity). - replace ((2 ^ (nOut0 + nOut1))%nat) with (2 ^ nOut0 * 2 ^ nOut1)%nat by (rewrite Nat.pow_add_r; reflexivity). - apply Mscale_simplify; try reflexivity. - rewrite Cexp_add; reflexivity. - - simpl. - rewrite nStack1_n_kron. - rewrite ZX_H_is_H. - rewrite Mscale_kron_n_distr_r. - rewrite Cexp_pow. - destruct IHzx1, IHzx2. - rewrite H, H0. - autorewrite with scalar_move_db. - exists ((x + x0) + - (PI / 4 * INR nMid))%R. - rewrite Mscale_assoc. - repeat rewrite <- Mmult_assoc. - apply Mscale_simplify; try reflexivity. - rewrite Cexp_add. - rewrite <- Cmult_assoc. - rewrite Cexp_mul_neg_l. - rewrite Cexp_add. - lca. -Qed. - -Fixpoint nStack1_H n (zx : H_ZX 1 1) := - match n with - | 0 => H_Empty - | S n' => H_Stack (zx) (nStack1_H n' zx) - end. -Notation "n ↑H zx" := (nStack1_H n zx) (at level 41). - -Lemma nStack1_H_nStack1 : forall (zx : H_ZX 1 1) n, - ZX_semantics (H_ZX_to_ZX (nStack1_H n zx)) = ZX_semantics (nStack1 n (H_ZX_to_ZX zx)). -Proof. - induction n. - - reflexivity. - - simpl. - apply kron_simplify; try reflexivity. - assumption. -Qed. - -Definition H_Wire := (H_Z_Spider 1 1 0). - -Lemma H_wire_identity_semantics : H_ZX_semantics H_Wire = I 2. -Proof. - intros. - simpl. - rewrite <- ZX_Z_is_Z_semantics. - rewrite ZX_semantics_equiv. - unfold_dirac_spider. - rewrite Cexp_0. - Msimpl. - solve_matrix. -Qed. - -Global Opaque H_Wire. - -Definition H_nWire n := nStack1_H n H_Wire. - -Lemma H_nWire_identity : forall n, H_ZX_semantics (H_nWire n) = I (2 ^ n). -Proof. - intros. - induction n. - - reflexivity. - - simpl. - rewrite H_wire_identity_semantics. - restore_dims. - replace (2 ^ n + (2 ^ n + 0))%nat with (2 * 2 ^n)%nat by lia. - rewrite <- id_kron. - rewrite <- IHn. - reflexivity. -Qed. - -Definition H_ZX_H : H_ZX 1 1 := H_Compose (H_Wire) (H_Wire). - -Lemma H_ZX_H_is_H : H_ZX_semantics H_ZX_H = hadamard. -Proof. - intros. - simpl. - rewrite H_wire_identity_semantics. - lma. -Qed. - -Lemma ZX_H_to_ZX_hadamard : □ ∝ (H_ZX_to_ZX H_ZX_H). -Proof. - intros. - simpl. - unfold hadamard_edge. - simpl. - remove_empty. - remove_wire. - reflexivity. -Qed. - -Global Opaque H_ZX_H. - -Fixpoint ZX_to_H_ZX {nIn nOut} (zx : ZX nIn nOut) : H_ZX nIn nOut := - match zx with - | Empty => H_Empty - | X_Spider nIn nOut α => (H_Compose (H_nWire nIn) (H_Compose (H_Z_Spider nIn nOut α) (H_nWire nOut))) - | Z_Spider nIn nOut α => (H_Z_Spider nIn nOut α) - | Cap => H_Cap - | Cup => H_Cup - | Swap => H_Swap - | Stack zx0 zx1 => H_Stack (ZX_to_H_ZX zx0) (ZX_to_H_ZX zx1) - | @Compose _ nMid _ zx0 zx1 => H_Compose (ZX_to_H_ZX zx0) (H_Compose (H_nWire nMid) (ZX_to_H_ZX zx1)) - end. - -Theorem ZX_to_H_ZX_consistent : forall nIn nOut (zx : ZX nIn nOut), - exists θ, ZX_semantics zx = (Cexp θ) .* (H_ZX_semantics (ZX_to_H_ZX zx)). -Proof. - intros. - induction zx; try (exists 0%R; autorewrite with Cexp_db; Msimpl; simpl; reflexivity) (* non compositional cases *); - try destruct IHzx1, IHzx2 (* Stack / Compose *). - - simpl. (* X_Spider *) - exists 0%R. - rewrite <- ZX_X_is_X_semantics. - rewrite <- ZX_Z_is_Z_semantics. - rewrite 2 ZX_semantics_equiv. - rewrite Cexp_0. - Msimpl. - unfold_dirac_spider. - rewrite 2 H_nWire_identity. - Msimpl; try repeat apply WF_mult; try apply WF_plus; try apply WF_scale; try apply WF_mult; restore_dims; try auto with wf_db. - rewrite Mmult_plus_distr_l; try auto with wf_db. - rewrite Mmult_plus_distr_r; try auto with wf_db. - repeat rewrite <- Mmult_assoc. - rewrite kron_n_mult. - rewrite (Mmult_assoc _ _ (nIn ⨂ _)). - restore_dims. - rewrite kron_n_mult. - repeat rewrite ket2bra. - repeat rewrite hadamard_sa. - apply Mplus_simplify; try reflexivity. - autorewrite with scalar_move_db. - apply Mscale_simplify; try reflexivity. - rewrite <- Mmult_assoc. - restore_dims. - rewrite Mmult_assoc. - restore_dims. - rewrite 2 kron_n_mult. - reflexivity. - - simpl. (* Stack *) - rewrite H, H0. - exists (x0 + x)%R. - autorewrite with scalar_move_db. - replace ((2 ^ (nIn0 + nIn1))%nat) with (2 ^ nIn0 * 2 ^ nIn1)%nat by (rewrite Nat.pow_add_r; reflexivity). - replace ((2 ^ (nOut0 + nOut1))%nat) with (2 ^ nOut0 * 2 ^ nOut1)%nat by (rewrite Nat.pow_add_r; reflexivity). - apply Mscale_simplify; try reflexivity. - rewrite Cexp_add; reflexivity. - - simpl. (* Compose *) - rewrite H, H0. - rewrite H_nWire_identity. - Msimpl; try auto 10 with wf_db. - exists (x + x0)%R. - autorewrite with scalar_move_db. - apply Mscale_simplify; try (rewrite Cexp_add; reflexivity). - apply Mmult_simplify; try reflexivity. - rewrite Mmult_assoc. - rewrite kron_n_mult. - rewrite MmultHH. - rewrite kron_n_I. - Msimpl. - reflexivity. -Qed. - -Lemma Cexp_Cexp_neg : forall n m (A B : Matrix n m), (exists θ, A = (Cexp θ) .* B) -> (exists θ', B = (Cexp (θ')) .* A). -Proof. - intros. - destruct H. - exists (-x)%R. - rewrite H. - rewrite Mscale_assoc. - rewrite <- Cexp_add. - rewrite Rplus_opp_l. - autorewrite with Cexp_db. - lma. -Qed. - -Theorem ZX_to_H_ZX_consistent' : forall nIn nOut (zx : ZX nIn nOut), - exists θ, (H_ZX_semantics (ZX_to_H_ZX zx)) = (Cexp θ) .* (ZX_semantics zx). -Proof. - intros. - apply Cexp_Cexp_neg. - apply ZX_to_H_ZX_consistent. -Qed. - -Theorem H_ZX_to_ZX_consistent' : forall nIn nOut (zx : H_ZX nIn nOut), - exists θ, (ZX_semantics (H_ZX_to_ZX zx)) = (Cexp θ) .* (H_ZX_semantics zx). -Proof. - intros. - apply Cexp_Cexp_neg. - apply H_ZX_to_ZX_consistent. -Qed. - -Lemma ZX_to_H_ZX_compat : forall nIn nOut (zx0 zx1 : ZX nIn nOut), - zx0 ∝ zx1 -> (ZX_to_H_ZX zx0) ∝H (ZX_to_H_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold H_proportional. - unfold proportional_general. - assert (exists θ, (H_ZX_semantics (ZX_to_H_ZX zx0)) = (Cexp θ) .* (ZX_semantics zx0)) by apply ZX_to_H_ZX_consistent'. - assert (exists θ, (H_ZX_semantics (ZX_to_H_ZX zx1)) = (Cexp θ) .* (ZX_semantics zx1)) by apply ZX_to_H_ZX_consistent'. - destruct H1, H2. - rewrite H1. - rewrite H2. - rewrite H. - exists (Cexp x0 * x * Cexp (-x1))%C. - split. - - rewrite 2 Mscale_assoc. - apply Mscale_simplify; try reflexivity. - rewrite <- Cmult_assoc. - rewrite <- Cexp_add. - rewrite Rplus_opp_l. - rewrite Cexp_0. - lca. - - repeat apply Cmult_neq_0; try nonzero. - assumption. -Qed. - -Lemma H_ZX_to_ZX_compat : forall nIn nOut (zx0 zx1 : H_ZX nIn nOut), - zx0 ∝H zx1 -> (H_ZX_to_ZX zx0) ∝ (H_ZX_to_ZX zx1). -Proof. - intros. - destruct H. - destruct H. - unfold proportional. - unfold proportional_general. - assert (exists θ, (ZX_semantics (H_ZX_to_ZX zx0)) = (Cexp θ) .* (H_ZX_semantics zx0)) by apply H_ZX_to_ZX_consistent'. - assert (exists θ, (ZX_semantics (H_ZX_to_ZX zx1)) = (Cexp θ) .* (H_ZX_semantics zx1)) by apply H_ZX_to_ZX_consistent'. - destruct H1, H2. - rewrite H1. - rewrite H2. - rewrite H. - exists (Cexp x0 * x * Cexp (-x1))%C. - split. - - rewrite 2 Mscale_assoc. - apply Mscale_simplify; try reflexivity. - rewrite <- Cmult_assoc. - rewrite <- Cexp_add. - rewrite Rplus_opp_l. - rewrite Cexp_0. - lca. - - repeat apply Cmult_neq_0; try nonzero. - assumption. -Qed. - -Add Parametric Relation (nIn nOut : nat) : (H_ZX nIn nOut) (@H_proportional nIn nOut) - reflexivity proved by H_proportional_refl - symmetry proved by H_proportional_symm - transitivity proved by H_proportional_trans - as H_ZX_prop_equiv_rel. - -Add Parametric Morphism (nIn nOut : nat) : (@ZX_to_H_ZX nIn nOut) - with signature (@proportional nIn nOut) ==> (@H_proportional nIn nOut) as ZX_to_H_ZX_mor. -Proof. apply ZX_to_H_ZX_compat. Qed. - -Add Parametric Morphism (nIn nOut : nat) : (@H_ZX_to_ZX nIn nOut) - with signature (@H_proportional nIn nOut) ==> (@proportional nIn nOut) as H_ZX_to_ZX_mor. -Proof. apply H_ZX_to_ZX_compat. Qed. - - -Lemma H_nStack1_compat : - forall n, - forall zx0 zx1 : H_ZX 1 1, zx0 ∝H zx1 -> - n ↑H zx0 ∝H n ↑H zx1. -Proof. - intros. - induction n. - - reflexivity. - - simpl. - rewrite IHn. - rewrite H. - reflexivity. -Qed. - -Add Parametric Morphism (n : nat) : (nStack1_H n) - with signature (@H_proportional 1 1) ==> - (@H_proportional n n) as H_nstack1_mor. -Proof. apply H_nStack1_compat. Qed. - -Lemma H_compose_compat : - forall nIn nMid nOut, - forall zx0 zx1 : H_ZX nIn nMid, zx0 ∝H zx1 -> - forall zx2 zx3 : H_ZX nMid nOut, zx2 ∝H zx3 -> - (H_Compose zx0 zx2) ∝H (H_Compose zx1 zx3). -Proof. - intros. - destruct H; destruct H; destruct H0; destruct H0. - simpl. - exists (x * x0). - split. - - simpl; rewrite H; rewrite H0. - rewrite Mscale_mult_dist_r. - rewrite Mscale_mult_dist_l. - restore_dims. - rewrite Mscale_mult_dist_l. - rewrite Mscale_assoc. - reflexivity. - - apply Cmult_neq_0; try assumption. -Qed. - -Add Parametric Morphism (nIn nMid nOut : nat) : (@H_Compose nIn nMid nOut) - with signature (@H_proportional nIn nMid) ==> (@H_proportional nMid nOut) ==> - (@H_proportional nIn nOut) as H_compose_mor. -Proof. apply H_compose_compat; assumption. Qed. - -Lemma ZX_H_ZX_matrix_compat : forall {nIn nOut} (zx : ZX nIn nOut) (M : Matrix (2 ^ nIn) (2 ^ nOut)), - (exists (c : C), ZX_semantics zx = c .* M /\ c <> C0) -> (exists c, H_ZX_semantics (ZX_to_H_ZX zx) = c .* M /\ c <> C0). -Proof. - intros. - assert (exists θ, (H_ZX_semantics (ZX_to_H_ZX zx)) = (Cexp θ) .* (ZX_semantics zx)) by apply ZX_to_H_ZX_consistent'. - destruct H0. - rewrite H0. - destruct H. - destruct H. - rewrite H. - exists (Cexp x * x0). - split; try (apply Cmult_neq_0; try assumption; try nonzero). - rewrite <- Mscale_assoc. - reflexivity. -Qed. - -Lemma H_ZX_ZX_matrix_compat : forall {nIn nOut} (zx : H_ZX nIn nOut) (M : Matrix (2 ^ nIn) (2 ^ nOut)), - (exists c, H_ZX_semantics zx = c .* M /\ c <> C0) -> (exists c, ZX_semantics (H_ZX_to_ZX zx) = c .* M /\ c <> C0). -Proof. - intros. - assert (exists θ, (ZX_semantics (H_ZX_to_ZX zx)) = (Cexp θ) .* (H_ZX_semantics zx)) by apply H_ZX_to_ZX_consistent'. - destruct H0. - rewrite H0. - destruct H. - destruct H. - rewrite H. - exists (Cexp x * x0). - split; try (apply Cmult_neq_0; try assumption; try nonzero). - rewrite <- Mscale_assoc. - reflexivity. -Qed. - -Local Transparent Wire. -Lemma ZX_to_H_ZX_wire : H_ZX_semantics (ZX_to_H_ZX —) = I 2. -Proof. - intros. - unfold Wire. - simpl. - rewrite <- ZX_Z_is_Z_semantics. - rewrite ZX_semantics_equiv. - unfold_dirac_spider. - autorewrite with Cexp_db. - Msimpl. - solve_matrix. -Qed. - -Local Transparent H_Wire. -Local Transparent H_nWire. -Local Transparent nWire. - -Lemma H_nWire_ZX_to_H_ZX_nWire : forall n, (H_nWire n) ∝H (ZX_to_H_ZX (nWire n)). -Proof. - intros. - induction n; try reflexivity. - unfold H_nWire. - simpl. - unfold H_nWire in IHn. - rewrite IHn. - rewrite <- IHn. - unfold nWire. - unfold H_Wire. - unfold H_Wire, nWire in IHn. - rewrite <- IHn. - reflexivity. -Qed. -Local Opaque H_nWire. -Local Opaque nWire. - -Lemma ZX_H_to_ZX_Wire : — ∝ (H_ZX_to_ZX H_Wire). -Proof. - intros. - unfold proportional. - simpl. - unfold Wire. - reflexivity. -Qed. - -Local Opaque H_Wire. -Local Opaque Wire. - -Local Transparent H_ZX_H. - -Lemma ZX_H_H_ZX_sem : exists c, H_ZX_semantics (ZX_to_H_ZX □) = c .* hadamard /\ c <> C0. -Proof. - apply ZX_H_ZX_matrix_compat. - rewrite ZX_H_is_H. - prop_exists_nonzero (Cexp (PI / 4)). -Qed. -Local Opaque H_ZX_H. - - -Lemma nHadamard_H_semantics : forall n, exists c, H_ZX_semantics (ZX_to_H_ZX (n ↑ □)) = c .* n ⨂ hadamard /\ c <> C0. -Proof. - intros. - induction n; try (prop_exists_nonzero 1%R; lma). - simpl. - destruct IHn. - assert (exists c, H_ZX_semantics (ZX_to_H_ZX □) = c .* hadamard /\ c <> C0) by apply ZX_H_H_ZX_sem. - destruct H, H0. - destruct H0. - exists (x * x0); split; try (apply Cmult_neq_0; assumption). - rewrite H. - rewrite H0. - autorewrite with scalar_move_db. - replace (hadamard) with (1 ⨂ hadamard) by (simpl; remove_empty; Msimpl; reflexivity). - restore_dims. - replace ((2 ^ 1 * (2 ^ 1) ^ n))%nat with (((2 ^ 1) ^ n * 2 ^ 1)%nat) by lia. - apply Mscale_simplify; try reflexivity. - replace (n ⨂ (1 ⨂ hadamard)) with (n ⨂ hadamard) by (simpl; remove_empty; Msimpl; reflexivity). - rewrite <- kron_n_m_split; try auto with wf_db. - rewrite <- kron_n_m_split; try auto with wf_db. - apply n_kron_simplify; try reflexivity. - lia. -Qed. - -Lemma H_ZX_ZX_involutive : forall nIn nOut (zx : H_ZX nIn nOut), ZX_to_H_ZX (H_ZX_to_ZX zx) ∝H zx. -Proof. - intros. - unfold H_proportional, proportional_general. - induction zx; try (prop_exists_nonzero 1%R; autorewrite with Cexp_db; Msimpl; simpl; reflexivity) (* non compositional cases *); - try (destruct IHzx1, IHzx2 (* Stack / Compose *); simpl; destruct H, H0). - - simpl. - exists (x0 * x); split; try (apply Cmult_neq_0; assumption). - rewrite H, H0. - autorewrite with scalar_move_db. - reflexivity. - - rewrite H_nWire_identity. - Msimpl. - assert (forall n, exists c, H_ZX_semantics (ZX_to_H_ZX (n ↑ □)) = c .* n ⨂ hadamard /\ c <> C0) by exact nHadamard_H_semantics. - specialize (H3 nMid). - destruct H3. - destruct H3. - rewrite H3. - autorewrite with scalar_move_db. - rewrite kron_n_mult. - rewrite MmultHH. - rewrite kron_n_I. - Msimpl. - rewrite Mmult_assoc. - rewrite <- (Mmult_assoc (nMid ⨂ hadamard) _ _). - rewrite kron_n_mult. - rewrite MmultHH. - rewrite kron_n_I. - Msimpl. - rewrite H, H0. - autorewrite with scalar_move_db. - exists (x1 * x * x0); split; try (apply Cmult_neq_0; try apply Cmult_neq_0; assumption). - reflexivity. -Qed. - -Lemma ZX_ZX_H_Wire_involutive : forall n, H_ZX_to_ZX (ZX_to_H_ZX (nWire n)) ∝ nWire n. -Proof. - intros. - assert (exists (c : C), H_ZX_semantics (ZX_to_H_ZX (nWire (n))) = c .* I (2 ^ (n)) /\ c <> C0). - { - apply ZX_H_ZX_matrix_compat. - prop_exists_nonzero 1%R. - Msimpl. - apply nwire_identity_semantics. - } - assert (exists (c : C), ZX_semantics (H_ZX_to_ZX (ZX_to_H_ZX (nWire (n)))) = c .* I (2 ^ (n)) /\ c <> C0). - { - apply H_ZX_ZX_matrix_compat. - apply H. - } - destruct H0. - destruct H0. - exists x; split; try assumption. - rewrite nwire_identity_semantics. - rewrite H0. - reflexivity. -Qed. - -Lemma ZX_H_ZX_involutive : forall nIn nOut (zx : ZX nIn nOut), H_ZX_to_ZX (ZX_to_H_ZX zx) ∝ zx. -Proof. - intros. - induction zx; try (prop_exists_nonzero 1%R; autorewrite with Cexp_db; Msimpl; simpl; reflexivity) (* non compositional cases *); - try (destruct IHzx1, IHzx2 (* Stack / Compose *); simpl; destruct H, H0). - - simpl. - rewrite 2 H_nWire_ZX_to_H_ZX_nWire. - rewrite 2 ZX_ZX_H_Wire_involutive. - exists (Cexp (PI / 4) ^ nOut * Cexp (PI / 4) ^ nIn); split; try (rewrite 2 Cexp_pow; apply Cmult_neq_0; nonzero). - simpl. - repeat rewrite nStack1_n_kron. - rewrite ZX_H_is_H. - rewrite 2 nwire_identity_semantics. - rewrite <- ZX_Z_is_Z_semantics. - rewrite <- ZX_X_is_X_semantics. - rewrite 2 ZX_semantics_equiv. - Msimpl. - unfold_dirac_spider. - rewrite Mmult_plus_distr_l; try auto with wf_db. - rewrite Mmult_plus_distr_r; try auto with wf_db. - repeat rewrite <- Mmult_assoc. - rewrite kron_n_mult. - rewrite (Mmult_assoc _ _ (nIn ⨂ _)). - restore_dims. - rewrite kron_n_mult. - repeat rewrite ket2bra. - repeat rewrite hadamard_sa. - repeat rewrite Mscale_kron_n_distr_r. - autorewrite with scalar_move_db. - repeat rewrite Mscale_kron_n_distr_r. - repeat rewrite <- Mscale_assoc. - rewrite 2 Mscale_plus_distr_r. - apply Mplus_simplify. - + restore_dims. - autorewrite with scalar_move_db. - rewrite <- Mscale_assoc. - rewrite <- Mscale_mult_dist_l. - rewrite <- Mscale_mult_dist_r. - rewrite <- Mscale_mult_dist_l. - reflexivity. - + autorewrite with scalar_move_db. - apply Mscale_simplify; try lca. - rewrite <- Mmult_assoc. - rewrite kron_n_mult. - rewrite Mmult_assoc. - restore_dims. - rewrite kron_n_mult. - reflexivity. - - exists (x0 * x); split; try (apply Cmult_neq_0; assumption). - simpl. - rewrite H. - rewrite H0. - autorewrite with scalar_move_db. - reflexivity. - - simpl. - assert (exists (c : C), ZX_semantics (H_ZX_to_ZX (H_nWire (nMid))) = c .* I (2 ^ (nMid)) /\ c <> C0). - { - apply H_ZX_ZX_matrix_compat. - rewrite H_nWire_identity. - prop_exists_nonzero 1%R. - lma. - } - destruct H3. - destruct H3. - exists (x * x1 * x0 * Cexp (PI / 4) ^ nMid * Cexp (PI / 4) ^ nMid); split; - try (repeat apply Cmult_neq_0; try assumption; try (rewrite Cexp_pow; nonzero)) (* non zero constant *). - simpl. - rewrite H, H0, H3. - rewrite nStack1_n_kron. - rewrite ZX_H_is_H. - repeat rewrite Mscale_kron_n_distr_r. - autorewrite with scalar_move_db. - Msimpl. - rewrite Mmult_assoc. - rewrite <- (Mmult_assoc _ (nMid ⨂ _) (ZX_semantics _)). - rewrite kron_n_mult. - rewrite MmultHH. - rewrite kron_n_I. - Msimpl. - reflexivity. -Qed. diff --git a/src/CoreData/CapCup.v b/src/CoreData/CapCup.v new file mode 100644 index 0000000..50e969b --- /dev/null +++ b/src/CoreData/CapCup.v @@ -0,0 +1,24 @@ +Require Import ZXCore. +Require Import Swaps. +Require Export QuantumLib.Quantum. +Require Export QuantumLib.Permutations. + +Local Open Scope ZX_scope. + +Lemma n_cup_dim : forall n, ((S n) + (S n) = 1 + (n +n) + 1)%nat. +Proof. lia. Qed. + +Fixpoint n_cup_unswapped (n : nat) : ZX (n + n) 0 := + match n with + | 0 => ⦰ + | (S n) => @Compose ((S n) + (S n))%nat (2)%nat _ + (cast _ _ (n_cup_dim _) (eq_refl) (— ↕ (n_cup_unswapped n) ↕ —)) + ⊃ + end. + +Definition n_cap_unswapped n := (n_cup_unswapped n)⊤. + +Definition n_cup n := (n_swap (n) ↕ n_wire n) ⟷ (n_cup_unswapped n). + +Definition n_cap n := (n_cup n) ⊤. + diff --git a/src/CoreData/CoreData.v b/src/CoreData/CoreData.v index 10e0f57..7952625 100644 --- a/src/CoreData/CoreData.v +++ b/src/CoreData/CoreData.v @@ -1,3 +1,5 @@ Require Export ZXCore. Require Export Proportional. Require Export Swaps. +Require Export StrongInduction. +Require Export CapCup. diff --git a/src/CoreData/Proportional.v b/src/CoreData/Proportional.v index a07dad7..1a17209 100644 --- a/src/CoreData/Proportional.v +++ b/src/CoreData/Proportional.v @@ -232,18 +232,27 @@ Add Parametric Morphism (n m : nat) : (@adjoint n m) with signature (@proportional n m) ==> proportional as adj_mor. Proof. apply adjoint_compat. Qed. +Lemma colorswap_is_bihadamard : forall n m (zx : ZX n m), + ⊙ zx ∝ (n ↑ □) ⟷ (zx ⟷ (m ↑ □)). +Proof. + prop_exists_nonzero 1. + Msimpl. + simpl. + rewrite 2 n_stack1_n_kron. + simpl. + rewrite semantics_colorswap_comm. + easy. +Qed. + Lemma colorswap_compat : forall nIn nOut, forall zx0 zx1 : ZX nIn nOut, zx0 ∝ zx1 -> (⊙ zx0) ∝ (⊙ zx1). Proof. intros. - destruct H; destruct H; exists x; split; try assumption. - rewrite 2 semantics_colorswap_comm. + rewrite 2 colorswap_is_bihadamard. rewrite H. - rewrite Mscale_mult_dist_r. - rewrite Mscale_mult_dist_l. - reflexivity. + easy. Qed. Add Parametric Morphism (nIn nOut : nat) : (@color_swap nIn nOut) @@ -252,7 +261,7 @@ Add Parametric Morphism (nIn nOut : nat) : (@color_swap nIn nOut) Proof. apply colorswap_compat. Qed. Theorem sem_eq_prop : forall {n m} (zx0 : ZX n m) (zx1 : ZX n m), - ZX_semantics zx0 = ZX_semantics zx1 -> zx0 ∝ zx1. + ⟦ zx0 ⟧ = ⟦ zx1 ⟧ -> zx0 ∝ zx1. Proof. intros. prop_exists_nonzero 1. @@ -303,7 +312,7 @@ Proof. Qed. Lemma colorswap_diagrams : forall n m (zx0 zx1 : ZX n m), - ⊙ zx0 ∝ ⊙zx1 -> zx0 ∝ zx1. + ⊙ zx0 ∝ ⊙ zx1 -> zx0 ∝ zx1. Proof. intros. rewrite <- colorswap_involutive. @@ -336,6 +345,31 @@ Proof. assumption. Qed. +Lemma colorswap_adjoint_commute : forall n m (zx : ZX n m), + ⊙ (zx †) ∝ (⊙ zx) †. +Proof. + intros. + induction zx; try easy. + all: simpl; rewrite IHzx1, IHzx2; easy. +Qed. + +Lemma transpose_adjoint_commute : forall n m (zx : ZX n m), + (zx †) ⊤ ∝ (zx ⊤) †. +Proof. + intros. + induction zx; try easy. + all: simpl; rewrite IHzx1, IHzx2; easy. +Qed. + +Lemma colorswap_transpose_commute : forall n m (zx : ZX n m), + ⊙ (zx ⊤) ∝ (⊙ zx) ⊤. +Proof. + intros. + induction zx; try easy. + all: simpl; rewrite IHzx1, IHzx2; easy. +Qed. + + Lemma transpose_wire : Wire ⊤ ∝ Wire. Proof. prop_exists_nonzero 1. @@ -362,7 +396,7 @@ Proof. Qed. Lemma proportional_sound : forall {nIn nOut} (zx0 zx1 : ZX nIn nOut), - zx0 ∝ zx1 -> exists (zxConst : ZX 0 0), ZX_semantics zx0 = ZX_semantics (zxConst ↕ zx1). + zx0 ∝ zx1 -> exists (zxConst : ZX 0 0), ⟦ zx0 ⟧ = ⟦ zxConst ↕ zx1 ⟧. Proof. intros. simpl; unfold proportional, proportional_general in H. diff --git a/src/CoreData/QlibTemp.v b/src/CoreData/QlibTemp.v index f327ea3..10eac0d 100644 --- a/src/CoreData/QlibTemp.v +++ b/src/CoreData/QlibTemp.v @@ -1,6 +1,32 @@ From QuantumLib Require Import Matrix. From QuantumLib Require Import Quantum. +(* @nocheck name *) +Lemma Mscale_inv : forall {n m} (A B : Matrix n m) c, c <> C0 -> c .* A = B <-> A = (/ c) .* B. +Proof. + intros. + split; intro H0; [rewrite <- H0 | rewrite H0]; + rewrite Mscale_assoc. + - rewrite Cinv_l; [ lma | assumption]. + - rewrite Cinv_r; [ lma | assumption]. +Qed. + +(* @nocheck name *) +Lemma Ropp_lt_0 : forall x : R, x < 0 -> 0 < -x. +Proof. + intros. + rewrite <- Ropp_0. + apply Ropp_lt_contravar. + easy. +Qed. + +(* @nocheck name *) +Definition Rsqrt (x : R) :C := +match Rcase_abs x with +| left a => Ci * Rsqrt {| nonneg := - x; cond_nonneg := Rlt_le 0 (-x)%R (Ropp_lt_0 x a) |} +| right a => C1 * Rsqrt {| nonneg := x; cond_nonneg := Rge_le x R0 a |} +end. + (* @nocheck name *) (* *) Lemma INR_pi_exp : forall (r : nat), @@ -100,6 +126,26 @@ Lemma braminus_transpose_ketminus : ⟨-∣⊤ = ∣-⟩. Proof. unfold braminus; lma. Qed. +(* @nocheck name *) +(* PI is captialized in Coq R *) +Lemma Cexp_2_PI : forall a, Cexp (INR a * 2 * PI) = 1. +Proof. + intros. + induction a. + - simpl. + rewrite 2 Rmult_0_l. + rewrite Cexp_0. + easy. + - rewrite S_INR. + rewrite 2 Rmult_plus_distr_r. + rewrite Rmult_1_l. + rewrite double. + rewrite <- Rplus_assoc. + rewrite 2 Cexp_plus_PI. + rewrite IHa. + lca. +Qed. + #[export] Hint Resolve WF_braplus WF_braminus : wf_db. @@ -114,3 +160,326 @@ Proof. unfold braminus; lma. Qed. #[export] Hint Rewrite <- Mscale_plus_distr_l : scalar_move_db. #[export] Hint Rewrite <- Mscale_plus_distr_r : scalar_move_db. +(* @nocheck name *) +Definition Csqrt (z : C) : C := + match z with + | (a, b) => sqrt ((Cmod z + a) / 2) + Ci * (b / Rabs b) * sqrt((Cmod z - a) / 2) + end. + +Notation "√ z" := (Csqrt z) : C_scope. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultplus0 : + ⟨+∣ × ∣0⟩ = / (√2)%R .* I 1. +Proof. + unfold braplus. + rewrite Mscale_mult_dist_l. + rewrite Mmult_plus_distr_r. + rewrite Mmult00. + rewrite Mmult10. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmult0plus : + ⟨0∣ × ∣+⟩ = / (√2)%R .* I 1. +Proof. + unfold xbasis_plus. + rewrite Mscale_mult_dist_r. + rewrite Mmult_plus_distr_l. + rewrite Mmult00. + rewrite Mmult01. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultplus1 : + ⟨+∣ × ∣1⟩ = / (√2)%R .* I 1. +Proof. + unfold braplus. + rewrite Mscale_mult_dist_l. + rewrite Mmult_plus_distr_r. + rewrite Mmult01. + rewrite Mmult11. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmult1plus : + ⟨1∣ × ∣+⟩ = / (√2)%R .* I 1. +Proof. + unfold xbasis_plus. + rewrite Mscale_mult_dist_r. + rewrite Mmult_plus_distr_l. + rewrite Mmult10. + rewrite Mmult11. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultminus0 : + ⟨-∣ × ∣0⟩ = / (√2)%R .* I 1. +Proof. + unfold braminus. + rewrite Mscale_mult_dist_l. + rewrite Mmult_plus_distr_r. + rewrite Mmult00. + rewrite Mscale_mult_dist_l. + rewrite Mmult10. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmult0minus : + ⟨0∣ × ∣-⟩ = / (√2)%R .* I 1. +Proof. + unfold xbasis_minus. + rewrite Mscale_mult_dist_r. + rewrite Mmult_plus_distr_l. + rewrite Mmult00. + rewrite Mscale_mult_dist_r. + rewrite Mmult01. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultminus1 : + ⟨-∣ × ∣1⟩ = - / (√2)%R .* I 1. +Proof. + unfold braminus. + rewrite Mscale_mult_dist_l. + rewrite Mmult_plus_distr_r. + rewrite Mmult01. + rewrite Mscale_mult_dist_l. + rewrite Mmult11. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmult1minus : + ⟨1∣ × ∣-⟩ = - / (√2)%R .* I 1. +Proof. + unfold xbasis_minus. + rewrite Mscale_mult_dist_r. + rewrite Mmult_plus_distr_l. + rewrite Mmult10. + rewrite Mscale_mult_dist_r. + rewrite Mmult11. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultminusminus : + ⟨-∣ × ∣-⟩ = I 1. +Proof. + unfold braminus. + unfold xbasis_minus. + repeat rewrite Mscale_mult_dist_l. + repeat rewrite Mscale_mult_dist_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + rewrite Mmult00. + rewrite Mmult01. + rewrite Mmult10. + rewrite Mmult11. + Msimpl. + autorewrite with scalar_move_db. + solve_matrix. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultplusminus : + ⟨+∣ × ∣-⟩ = Zero. +Proof. + unfold xbasis_minus. + unfold braplus. + repeat rewrite Mscale_mult_dist_l. + repeat rewrite Mscale_mult_dist_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + rewrite Mmult00. + rewrite Mmult01. + rewrite Mmult10. + rewrite Mmult11. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultminusplus : + ⟨-∣ × ∣+⟩ = Zero. +Proof. + unfold xbasis_plus. + unfold braminus. + repeat rewrite Mscale_mult_dist_l. + repeat rewrite Mscale_mult_dist_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + rewrite Mmult00. + rewrite Mmult01. + rewrite Mmult10. + rewrite Mmult11. + Msimpl. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mmultplusplus : + ⟨+∣ × ∣+⟩ = I 1. +Proof. + unfold xbasis_plus. + unfold braplus. + repeat rewrite Mscale_mult_dist_l. + repeat rewrite Mscale_mult_dist_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + rewrite Mmult00. + rewrite Mmult01. + rewrite Mmult10. + rewrite Mmult11. + solve_matrix. +Qed. + +#[export] Hint Rewrite + Mmult00 Mmult01 Mmult10 Mmult11 + Mmultplus0 Mmultplus1 Mmultminus0 Mmultminus1 + Mmult0plus Mmult0minus Mmult1plus Mmult1minus + Mmultplusplus Mmultplusminus Mmultminusplus Mmultminusminus + : ketbra_mult_db. + +Lemma bra0transpose : + ⟨0∣⊤ = ∣0⟩. +Proof. solve_matrix. Qed. + +Lemma bra1transpose : + ⟨1∣⊤ = ∣1⟩. +Proof. solve_matrix. Qed. + +Lemma ket0transpose : + ∣0⟩⊤ = ⟨0∣. +Proof. solve_matrix. Qed. + +Lemma ket1transpose : + ∣1⟩⊤ = ⟨1∣. +Proof. solve_matrix. Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_plus_minus : ∣+⟩ .+ ∣-⟩ = (√2)%R .* ∣0⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_plus_minus_opp : ∣+⟩ .+ -1 .* ∣-⟩ = (√2)%R .* ∣1⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field_simplify. + lca. + C_field. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_minus_plus : ∣-⟩ .+ ∣+⟩ = (√2)%R .* ∣0⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_minus_opp_plus : -1 .* ∣-⟩ .+ ∣+⟩ = (√2)%R .* ∣1⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field_simplify. + lca. + C_field. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_0_1 : ∣0⟩ .+ ∣1⟩ = (√2)%R .* ∣+⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_0_1_opp : ∣0⟩ .+ -1 .* ∣1⟩ = (√2)%R .* ∣-⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field_simplify. + lca. + C_field. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_1_0 : ∣1⟩ .+ ∣0⟩ = (√2)%R .* ∣+⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Mplus_1_opp_0 : -1 .* ∣1⟩ .+ ∣0⟩ = (√2)%R .* ∣-⟩. +Proof. + unfold xbasis_plus. + unfold xbasis_minus. + solve_matrix. + C_field_simplify. + lca. + C_field. +Qed. + +Lemma σz_decomposition : σz = ∣0⟩⟨0∣ .+ -1 .* ∣1⟩⟨1∣. +Proof. solve_matrix. Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Cexp_spec : forall α, Cexp α = cos α + Ci * sin α. +Proof. intros; lca. Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma Cexp_minus : forall θ, + Cexp θ + Cexp (-θ) = 2 * cos θ. +Proof. + intros. + unfold Cexp. + rewrite cos_neg. + rewrite sin_neg. + lca. +Qed. \ No newline at end of file diff --git a/src/CoreData/SemanticCore.v b/src/CoreData/SemanticCore.v index 9471ffe..418ed36 100644 --- a/src/CoreData/SemanticCore.v +++ b/src/CoreData/SemanticCore.v @@ -265,14 +265,14 @@ Proof. unfold adjoint. simpl. destruct x. - -- rewrite mult_0_r in H1. + -- rewrite Nat.mul_0_r in H1. discriminate H1. -- destruct (i / (1 ^ n + 0))%nat. ++ simpl. destruct x; lca. ++ simpl. destruct x; lca. - * rewrite mult_comm. + * rewrite Nat.mul_comm. rewrite Nat.divide_div_mul_exact. -- rewrite Nat.div_same; [lia | ]. apply Nat.pow_nonzero; easy. @@ -335,12 +335,12 @@ Proof. + destruct (Nat.mod_divides (S i) (2^S n)); [apply Nat.pow_nonzero; auto |]. destruct H; [assumption |]. rewrite H. - rewrite mult_comm. + rewrite Nat.mul_comm. rewrite Nat.divide_div_mul_exact; [ | apply Nat.pow_nonzero; auto | apply Nat.divide_refl ]. rewrite Nat.div_same; [ | apply Nat.pow_nonzero; auto]. rewrite Nat.mul_1_r. - destruct x; [rewrite mult_0_r in H; discriminate H |]. + destruct x; [rewrite Nat.mul_0_r in H; discriminate H |]. unfold ket; simpl. destruct x, j; lca. + rewrite IHn. @@ -404,9 +404,9 @@ Proof. * replace ((2 ^ n + (2 ^ n + 0 - 1)) mod 2 ^ n)%nat with (2^n-1)%nat. -- rewrite IHn; lca. -- rewrite Nat.add_mod; [| apply Nat.pow_nonzero; auto]. - ++ rewrite plus_0_r. + ++ rewrite Nat.add_0_r. rewrite Nat.mod_same; [| apply Nat.pow_nonzero; auto]. - rewrite plus_0_l. + rewrite Nat.add_0_l. rewrite Nat.mod_mod; [| apply Nat.pow_nonzero; auto]. destruct n. ** reflexivity. @@ -416,7 +416,7 @@ Proof. --- simpl. rewrite Nat.sub_0_r. constructor. - * rewrite plus_0_r. + * rewrite Nat.add_0_r. replace ((2 ^ n + (2 ^ n - 1)) / 2 ^ n)%nat with (((1 * 2 ^ n) + (2 ^ n - 1)) / 2 ^ n)%nat. -- rewrite Nat.div_add_l; [| apply Nat.pow_nonzero; auto]. @@ -425,9 +425,9 @@ Proof. ++ destruct (Nat.pow_nonzero 2 n); [auto | apply E]. ++ simpl; rewrite Nat.sub_0_r. auto. - -- rewrite mult_1_l. + -- rewrite Nat.mul_1_l. reflexivity. - + rewrite plus_0_r. + + rewrite Nat.add_0_r. rewrite <- (Nat.pow_1_l n). replace (S (1 ^ n)) with 2%nat. * apply Nat.pow_le_mono_l. @@ -450,9 +450,9 @@ Proof. * replace ((2 ^ n + (2 ^ n + 0 - 1)) mod 2 ^ n)%nat with (2^n-1)%nat. -- rewrite IHn; lca. -- rewrite Nat.add_mod; [| apply Nat.pow_nonzero; auto]. - ++ rewrite plus_0_r. + ++ rewrite Nat.add_0_r. rewrite Nat.mod_same; [| apply Nat.pow_nonzero; auto]. - rewrite plus_0_l. + rewrite Nat.add_0_l. rewrite Nat.mod_mod; [| apply Nat.pow_nonzero; auto]. destruct n. ** reflexivity. @@ -462,7 +462,7 @@ Proof. --- simpl. rewrite Nat.sub_0_r. constructor. - * rewrite plus_0_r. + * rewrite Nat.add_0_r. replace ((2 ^ n + (2 ^ n - 1)) / 2 ^ n)%nat with (((1 * 2 ^ n) + (2 ^ n - 1)) / 2 ^ n)%nat. -- rewrite Nat.div_add_l; [| apply Nat.pow_nonzero; auto]. @@ -471,9 +471,9 @@ Proof. ++ destruct (Nat.pow_nonzero 2 n); [auto | apply E]. ++ simpl; rewrite Nat.sub_0_r. auto. - -- rewrite mult_1_l. + -- rewrite Nat.mul_1_l. reflexivity. - + rewrite plus_0_r. + + rewrite Nat.add_0_r. rewrite <- (Nat.pow_1_l n). replace (S (1 ^ n)) with 2%nat. * apply Nat.pow_le_mono_l. @@ -550,15 +550,15 @@ Proof. replace (S (S n1 + n1) - 1)%nat with (S (n1 + n1))%nat by reflexivity. rewrite (double_mult n1). - rewrite <- (plus_0_l (2*n1)). + rewrite <- (Nat.add_0_l (2*n1)). replace (S (0 + 2 * n1))%nat with (1 + 2 * n1)%nat by reflexivity. rewrite Nat.add_mod; [| easy]. - rewrite mult_comm. + rewrite Nat.mul_comm. rewrite Nat.mod_mul; [| easy]. reflexivity. --- simpl. - rewrite plus_0_r. + rewrite Nat.add_0_r. lia. ++ replace (2 ^ S n)%nat with (2 * (2 ^ n))%nat. ** destruct (2^n)%nat. @@ -585,7 +585,7 @@ Proof. -- rewrite Nat.eqb_refl. destruct x; lca. -- simpl. - rewrite plus_0_r. + rewrite Nat.add_0_r. destruct (2 ^ n)%nat eqn:En. ++ contradict En. ** apply Nat.pow_nonzero; easy. @@ -594,12 +594,12 @@ Proof. rewrite Nat.sub_0_r. rewrite double_mult. replace (S (2 * n0))%nat with (1 + (2 * n0))%nat by reflexivity. - rewrite mult_comm. + rewrite Nat.mul_comm. rewrite Nat.add_mod; [| easy]. rewrite Nat.mod_mul; [| easy]. reflexivity. -- simpl. - rewrite plus_0_r. + rewrite Nat.add_0_r. destruct (2 ^ n)%nat. ++ reflexivity. ++ simpl. @@ -608,10 +608,10 @@ Proof. rewrite <- plus_n_Sm. rewrite double_mult. replace (S (2 * n0))%nat with ((1 + (2 * n0)))%nat by reflexivity. - rewrite plus_comm. - rewrite mult_comm. + rewrite Nat.add_comm. + rewrite Nat.mul_comm. rewrite Nat.div_add_l; [| easy]. - rewrite plus_comm. + rewrite Nat.add_comm. reflexivity. + unfold big_bra_sem. rewrite Ex. @@ -630,10 +630,10 @@ Proof. rewrite Nat.eqb_refl in Ex. discriminate. ++ simpl. - rewrite 2 plus_0_r. - rewrite <- plus_assoc. + rewrite 2 Nat.add_0_r. + rewrite <- Nat.add_assoc. rewrite <- plus_n_Sm. - rewrite plus_0_r. + rewrite Nat.add_0_r. destruct (2 ^ n)%nat eqn:En. ** contradict En. apply Nat.pow_nonzero; easy. diff --git a/src/CoreData/StrongInduction.v b/src/CoreData/StrongInduction.v new file mode 100644 index 0000000..96fac42 --- /dev/null +++ b/src/CoreData/StrongInduction.v @@ -0,0 +1,61 @@ +(* Source: https://github.com/tchajed/strong-induction *) +(* This should really be in the coq std library *) + +Local Open Scope nat_scope. +(** Here we prove the principle of strong induction, induction on the natural +numbers where the inductive hypothesis includes all smaller natural numbers. *) + +Require Import PeanoNat. + +Section StrongInduction. + + Variable P : nat -> Prop. + + (** The stronger inductive hypothesis given in strong induction. The standard + [nat ] induction principle provides only n = pred m, with [P 0] required + separately. *) +(* @nocheck name *) + Hypothesis IH : forall m, (forall n, n < m -> P n) -> P m. + +(* @nocheck name *) + Lemma P0 : P 0. + Proof. + apply IH; intros. + exfalso; inversion H. + Qed. + + Hint Resolve P0 : strong_ind_db. + + Lemma pred_increasing : forall n m, + n <= m -> + Nat.pred n <= Nat.pred m. + Proof. + induction n; cbn; intros. + apply le_0_n. + induction H; subst; cbn; eauto. + destruct m; eauto. + Qed. + + Hint Resolve le_S_n : strong_ind_db. + + (** * Strengthen the induction hypothesis. *) + + Local Lemma strong_induction_all : forall n, + (forall m, m <= n -> P m). + Proof. + induction n; intros; + match goal with + | [ H: _ <= _ |- _ ] => + inversion H + end; eauto with strong_ind_db. + Qed. + + Theorem strong_induction : forall n, P n. + Proof. + eauto using strong_induction_all. + Qed. + +End StrongInduction. + +Global Tactic Notation "strong" "induction" ident(n) := induction n using strong_induction. + diff --git a/src/CoreData/Swaps.v b/src/CoreData/Swaps.v index d81f974..8b47a77 100644 --- a/src/CoreData/Swaps.v +++ b/src/CoreData/Swaps.v @@ -1,5 +1,7 @@ Require Import ZXCore. +Require Import StrongInduction. Require Export QuantumLib.Quantum. +Require Export QuantumLib.Permutations. Open Scope ZX_scope. @@ -40,17 +42,95 @@ Open Scope matrix_scope. Definition bottom_wire_to_top (n : nat) : Square (2 ^ n) := (top_wire_to_bottom n)⊤. +(* Well foundedness of semantics *) + +Lemma WF_top_to_bottom (n : nat) : WF_Matrix (top_wire_to_bottom n). +Proof. + destruct n; try auto with wf_db. + induction n. + - simpl; auto with wf_db. + - simpl. try auto with wf_db. +Qed. + +Global Hint Resolve WF_top_to_bottom : wf_db. + +Lemma WF_bottom_to_top (n : nat) : WF_Matrix (bottom_wire_to_top n). +Proof. unfold bottom_wire_to_top. auto with wf_db. Qed. + +Global Hint Resolve WF_bottom_to_top : wf_db. + Definition a_swap_semantics (n : nat) : Square (2 ^ n) := match n with | 0 => I 1 | S k => (@Mmult _ (2 ^ n) _ ((I 2) ⊗ top_wire_to_bottom (k)) ((bottom_wire_to_top (S k)))) end. +Lemma WF_a_swap_semantics (n : nat) : + WF_Matrix (a_swap_semantics n). +Proof. + intros. + unfold a_swap_semantics. + destruct n; auto with wf_db. +Qed. + +Global Hint Resolve WF_a_swap_semantics : wf_db. + Fixpoint n_swap (n : nat) : ZX n n := - match n with - | 0 => ⦰ - | 1 => — - | (S (S n)) => a_swap (S (S n)) ⟷ (— ↕ (@cast _ _ (n + 1)%nat (n + 1)%nat (eq_sym (@Nat.add_1_r n)) (eq_sym (@Nat.add_1_r n)) (n_swap n ↕ —))) + match n with + | 0 => ⦰ + | (S n) => bottom_to_top (S n) ⟷ (— ↕ n_swap n) + end. + +Fixpoint n_swap_mat_ind (n : nat) : Matrix (2 ^ n) (2 ^ n) := + match n with + | 0 => I 1 + | 1 => I 2 + | S (S n) => @Mmult _ (2 ^ (S (S n))) _ (((I 2) ⊗ n_swap_mat_ind n ⊗ (I 2))) (a_swap_semantics (S (S n))) + end. + +Lemma WF_n_swap_mat_ind : forall n, WF_Matrix (n_swap_mat_ind n). +Proof. + intros. + strong induction n. + do 2 (destruct n; [ simpl; auto with wf_db | ]). + assert (n < (S (S n)))%nat by lia. + specialize (H n H0); clear H0. + simpl. + destruct n. + apply WF_mult. + + apply WF_kron; try lia. + apply WF_kron; try lia. + 1-3: auto with wf_db. + + apply WF_mult; [ auto with wf_db | ]. + replace (2 ^ 0 + (2 ^ 0 + 0) + (2 ^ 0 + (2 ^ 0 + 0) + 0))%nat with (2 ^ 2)%nat by (simpl; lia). + auto with wf_db. + + apply WF_mult; auto with wf_db. + apply WF_mult; auto with wf_db. + replace (2 ^ S n + (2 ^ S n + 0) + (2 ^ S n + (2 ^ S n + 0) + 0))%nat with (2 ^ (S (S (S n))))%nat by (simpl; lia). + auto with wf_db. +Qed. + +Fixpoint n_swap_mat (n : nat) : Matrix (2 ^ n) (2 ^ n) := + match n with + | 0 => I 1 + | (S n) => (I 2 ⊗ (n_swap_mat n)) × bottom_wire_to_top (S n) end. - \ No newline at end of file +Lemma WF_n_swap_mat : forall n, WF_Matrix (n_swap_mat n). +Proof. + intros. + induction n; try auto with wf_db. + simpl. + unfold bottom_wire_to_top. + auto with wf_db. +Qed. + +Lemma b_swap_dim : forall n m, (S n + m = 1 + (n + m))%nat. Proof. lia. Qed. + +Fixpoint b_swap (n m : nat) : ZX (n + m) (n + m) := + match n with + | 0 => (n_wire (0 + m)) + | (S n) => (top_to_bottom (S n + m)) ⟷ (— ↕ (b_swap n m)) + end. + + diff --git a/src/CoreData/ZXCore.v b/src/CoreData/ZXCore.v index d5fdf84..7fbf294 100644 --- a/src/CoreData/ZXCore.v +++ b/src/CoreData/ZXCore.v @@ -28,10 +28,10 @@ Inductive ZX : nat -> nat -> Type := | Compose {n m o} (zx0 : ZX n m) (zx1 : ZX m o) : ZX n o. Definition cast (n m : nat) {n' m'} - (eqIn : n = n') (eqOut : m = m') (zx : ZX n' m') : ZX n m. + (prfn : n = n') (prfm : m = m') (zx : ZX n' m') : ZX n m. Proof. - destruct eqIn. - destruct eqOut. + destruct prfn. + destruct prfm. exact zx. Defined. @@ -56,6 +56,7 @@ matrices and one based on dirac notation. *) (* @nocheck name *) +Reserved Notation "⟦ zx ⟧" (at level 68). (* = is 70, need to be below *) Fixpoint ZX_semantics {n m} (zx : ZX n m) : Matrix (2 ^ m) (2 ^ n) := match zx with @@ -67,29 +68,38 @@ Fixpoint ZX_semantics {n m} (zx : ZX n m) : | ⨉ => swap | — => I 2 | □ => hadamard - | zx0 ↕ zx1 => (ZX_semantics zx0) ⊗ (ZX_semantics zx1) - | Compose zx0 zx1 => (ZX_semantics zx1) × (ZX_semantics zx0) - end. + | zx0 ↕ zx1 => ⟦ zx0 ⟧ ⊗ ⟦ zx1 ⟧ + | Compose zx0 zx1 => ⟦ zx1 ⟧ × ⟦ zx0 ⟧ + end + where "⟦ zx ⟧" := (ZX_semantics zx). + +Lemma zx_compose_spec : forall n m o (zx0 : ZX n m) (zx1 : ZX m o), + ⟦ zx0 ⟷ zx1 ⟧ = ⟦ zx1 ⟧ × ⟦ zx0 ⟧. +Proof. easy. Qed. + +Lemma zx_stack_spec : forall n m o p (zx0 : ZX n m) (zx1 : ZX o p), + ⟦ zx0 ↕ zx1 ⟧ = ⟦ zx0 ⟧ ⊗ ⟦ zx1 ⟧. +Proof. easy. Qed. Lemma cast_semantics : forall {n m n' m'} {eqn eqm} (zx : ZX n m), - ZX_semantics (cast n' m' eqn eqm zx) = ZX_semantics zx. + ⟦ cast n' m' eqn eqm zx ⟧ = ⟦ zx ⟧. Proof. intros. subst. easy. Qed. -Definition cast_semantics_dim_eqn {n m n' m' : nat} (zx : ZX n m) : Matrix (2 ^ n') (2 ^ m') := ZX_semantics zx. +Definition cast_semantics_dim_eqn {n m n' m' : nat} (zx : ZX n m) : Matrix (2 ^ n') (2 ^ m') := ⟦ zx ⟧. Lemma cast_semantics_dim : forall {n m n' m'} {eqn eqm} (zx : ZX n m), - ZX_semantics (cast n' m' eqn eqm zx) = cast_semantics_dim_eqn zx. + ⟦ (cast n' m' eqn eqm zx) ⟧ = cast_semantics_dim_eqn zx. Proof. intros. unfold cast_semantics_dim_eqn. apply cast_semantics. Qed. -Ltac simpl_cast_semantics := try repeat rewrite cast_semantics; try repeat (rewrite cast_semantics_dim; unfold cast_semantics_dim_eqn). +Tactic Notation "simpl_cast_semantics" := try repeat rewrite cast_semantics; try repeat (rewrite cast_semantics_dim; unfold cast_semantics_dim_eqn). (* @nocheck name *) Fixpoint ZX_dirac_sem {n m} (zx : ZX n m) : @@ -109,7 +119,7 @@ Fixpoint ZX_dirac_sem {n m} (zx : ZX n m) : end. Lemma ZX_semantic_equiv : forall n m (zx : ZX n m), - ZX_semantics zx = ZX_dirac_sem zx. + ⟦ zx ⟧ = ZX_dirac_sem zx. Proof. intros. induction zx; try lma; simpl. @@ -119,7 +129,7 @@ Proof. 1,2: subst; rewrite IHzx1, IHzx2; reflexivity. Qed. -Theorem WF_ZX : forall nIn nOut (zx : ZX nIn nOut), WF_Matrix (ZX_semantics zx). +Theorem WF_ZX : forall nIn nOut (zx : ZX nIn nOut), WF_Matrix (⟦ zx ⟧). Proof. intros. induction zx; try (simpl; auto 10 with wf_db). @@ -151,7 +161,7 @@ Fixpoint n_stack1 n (zx : ZX 1 1) : ZX n n := where "n ↑ zx" := (n_stack1 n zx). Lemma n_stack1_n_kron : forall n (zx : ZX 1 1), - ZX_semantics (n ↑ zx) = n ⨂ ZX_semantics zx. + ⟦ (n ↑ zx) ⟧ = n ⨂ ⟦ zx ⟧. Proof. intros. induction n. @@ -168,7 +178,7 @@ Definition n_box := fun n => n ↑ Box. Notation "'n_wire' n" := (n ↑ —) (at level 35). -Lemma n_wire_semantics {n} : ZX_semantics (n_wire n) = I (2^n). +Lemma n_wire_semantics {n} : ⟦ n_wire n ⟧ = I (2^n). Proof. induction n; auto. simpl. @@ -177,7 +187,7 @@ Proof. auto. Qed. -Lemma n_box_semantics {n} : ZX_semantics (n_box n) = n ⨂ hadamard. +Lemma n_box_semantics {n} : ⟦ n_box n ⟧ = n ⨂ hadamard. Proof. induction n; auto. simpl. @@ -232,13 +242,8 @@ Definition adjoint {n m} (zx : ZX n m) : ZX m n := Notation "zx †" := (adjoint zx) (at level 0) : ZX_scope. Lemma semantics_transpose_comm {nIn nOut} : forall (zx : ZX nIn nOut), - ZX_semantics (zx ⊤) = ((ZX_semantics zx) ⊤)%M. + ⟦ zx ⊤ ⟧ = ((⟦ zx ⟧) ⊤)%M. Proof. - assert (Mmult_trans_dep : forall n m o p (A : Matrix n m) (B : Matrix o p), - m = o -> ((A × B) ⊤ = B ⊤ × A ⊤)%M). - { - intros; rewrite Mmult_transpose; rewrite H in *; reflexivity. - } induction zx. - Msimpl; reflexivity. - simpl; solve_matrix. @@ -254,7 +259,7 @@ Proof. Qed. Lemma semantics_adjoint_comm {nIn nOut} : forall (zx : ZX nIn nOut), - ZX_semantics (zx †) = (ZX_semantics zx) †%M. + ⟦ zx † ⟧ = (⟦ zx ⟧) †%M. Proof. intros. induction zx. @@ -286,7 +291,7 @@ Fixpoint color_swap {nIn nOut} (zx : ZX nIn nOut) : ZX nIn nOut := where "⊙ zx" := (color_swap zx) : ZX_scope. Lemma semantics_colorswap_comm {nIn nOut} : forall (zx : ZX nIn nOut), - ZX_semantics (⊙ zx) = nOut ⨂ hadamard × (ZX_semantics zx) × nIn ⨂ hadamard. + ⟦ ⊙ zx ⟧ = nOut ⨂ hadamard × (⟦ zx ⟧) × nIn ⨂ hadamard. Proof. induction zx. - simpl; Msimpl; reflexivity. @@ -327,8 +332,8 @@ Proof. Qed. Lemma Z_spider_1_1_fusion_eq : forall {nIn nOut} α β, - ZX_semantics ((Z_Spider nIn 1 α) ⟷ (Z_Spider 1 nOut β)) = - ZX_semantics (Z_Spider nIn nOut (α + β)). + ⟦ (Z_Spider nIn 1 α) ⟷ (Z_Spider 1 nOut β) ⟧ = + ⟦ Z_Spider nIn nOut (α + β) ⟧. Proof. assert (expnonzero : forall a, exists b, (2 ^ a + (2 ^ a + 0) - 1)%nat = S b). { @@ -370,4 +375,237 @@ Proof. lca. Qed. +Lemma z_1_1_pi_σz : + ⟦ Z 1 1 PI ⟧ = σz. +Proof. solve_matrix. autorewrite with Cexp_db. lca. Qed. + +Lemma x_1_1_pi_σx : + ⟦ X 1 1 PI ⟧ = σx. +Proof. + simpl. + unfold X_semantics. simpl; Msimpl. solve_matrix; autorewrite with Cexp_db. + all: C_field_simplify; [lca | C_field]. +Qed. + +Definition zx_triangle : ZX 1 1 := + (X 1 1 (PI/2) ⟷ Z 1 1 (PI/4)) ⟷ ((Z 0 1 (PI/4) ↕ —) ⟷ X 2 1 0) ⟷ (Z 1 2 0 ⟷ (— ↕ (X 1 2 0 ⟷ (Z 1 0 (-PI/4) ↕ Z 1 0 (-PI/4))))). + +Definition zx_triangle_left : ZX 1 1 := + (zx_triangle ⊤)%ZX. + +Notation "▷" := zx_triangle : ZX_scope. (* \triangleright *) +Notation "◁" := zx_triangle_left : ZX_scope. (* \triangleleft *) + +Lemma triangle_step_1 : + ⟦ X 1 1 (PI/2) ⟷ Z 1 1 (PI/4) ⟧ = + / (√ 2)%R .* (∣0⟩ × ⟨+∣) .+ + Cexp (PI / 2) * /(√2)%R .* (∣0⟩ × ⟨-∣) .+ + Cexp (PI / 4) * /(√2)%R .* (∣1⟩ × ⟨+∣) .+ + Cexp (PI / 2) * Cexp (PI / 4) * - /(√2)%R .* (∣1⟩ × ⟨-∣). +Proof. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + rewrite <- 2 (Mmult_assoc (⟨0∣)). + rewrite <- 2 (Mmult_assoc (⟨1∣)). + restore_dims. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + lma. +Qed. + +Lemma triangle_step_2 : + ⟦ Z 0 1 (PI/4) ↕ — ⟷ X 2 1 0 ⟧ = + 1/(√2)%R .* ∣0⟩⟨0∣ .+ + Cexp (PI/4)/(√2)%R .* ∣0⟩⟨1∣ .+ + Cexp (PI/4)/(√2)%R .* ∣1⟩⟨0∣ .+ + 1/(√2)%R .* ∣1⟩⟨1∣. + (* (((1 + Cexp (PI/4)) / (√2)%R) .* ∣+⟩ × ⟨+∣ .+ + ((1 - Cexp (PI/4)) / (√2)%R) .* ∣-⟩ × ⟨-∣). *) +Proof. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + Msimpl. + rewrite kron_plus_distr_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + rewrite Mmult_assoc. + rewrite (kron_mixed_product (⟨+∣) (⟨+∣)). + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite (kron_mixed_product (⟨+∣) (⟨+∣)). + repeat rewrite (kron_mixed_product (⟨-∣) (⟨-∣)). + autorewrite with ketbra_mult_db. + repeat rewrite Mscale_kron_dist_l. + Msimpl. + autorewrite with scalar_move_db. + unfold braplus, braminus. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + rewrite Cmult_1_l. + replace ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * / (√ 2)%R * +/ (√ 2)%R) with ((1 + Cexp (PI / 4)) * / ((√2)%R * 2)) by C_field. + replace ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * / (√ 2)%R * / (√ 2)%R) with ((1 - Cexp (PI/4)) / ((√2)%R * 2)) by C_field. + remember ((1 + Cexp (PI/4)) * / ((√2)%R * 2)) as v1. + remember ((C1 - Cexp (PI / 4)) / ((√ 2)%R * C2)) as v2. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (v2 * -1 * -1) with v2 by lca. + replace (v2 * -1) with (- v2) by lca. + replace (v1 .* ∣0⟩⟨0∣ .+ v1 .* ∣1⟩⟨0∣ .+ (v1 .* ∣0⟩⟨1∣ .+ v1 .* ∣1⟩⟨1∣) .+ (v2 .* ∣0⟩⟨0∣ .+ - v2 .* ∣1⟩⟨0∣ .+ (- v2 .* ∣0⟩⟨1∣ .+ v2 .* ∣1⟩⟨1∣))) with ((v1 + v2) .* ∣0⟩⟨0∣ .+ (v1 - v2) .* ∣0⟩⟨1∣ .+ (v1 - v2) .* ∣1⟩⟨0∣ .+ (v1 + v2) .* ∣1⟩⟨1∣) by lma. + assert (Hv0 : v1 + v2 = C1 / (√2)%R). + { subst; C_field_simplify. lca. C_field. } + assert (Hv1 : v1 - v2 = Cexp (PI/4) / (√2)%R). + { subst; C_field_simplify. lca. C_field. } + rewrite Hv0, Hv1. + easy. +Qed. + +Lemma triangle_step_3 : + ⟦ Z 1 2 0 ⟷ (— ↕ (X 1 2 0 ⟷ (Z 1 0 (-PI/4) ↕ Z 1 0 (-PI/4)))) ⟧ = (1 + Cexp (-PI/4)^2) / (√2)%R .* ∣0⟩⟨0∣ .+ + (√2)%R * Cexp (-PI/4) .* ∣1⟩⟨1∣. +Proof. + assert (H : ⟦ (X 1 2 0 ⟷ (Z 1 0 (-PI/4) ↕ Z 1 0 (-PI/4))) ⟧ = (1 + Cexp (-PI/4))^2 / 2 .* ⟨+∣ .+ + (1 - Cexp (-PI/4))^2 / 2 .* ⟨-∣). + { + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + rewrite Mmult_plus_distr_l. + rewrite <- 2 Mmult_assoc. + rewrite 2 kron_mixed_product. + rewrite 2 Mmult_plus_distr_r. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + rewrite kron_1_l by auto with wf_db. + rewrite 2 Mmult_1_l by auto with wf_db. + apply Mplus_simplify. + - apply Mscale_simplify; try auto. + C_field. + - apply Mscale_simplify; try auto. + C_field. + } + rewrite zx_compose_spec. + rewrite (zx_stack_spec _ _ _ _ —). + rewrite H. + clear H. + rewrite 2 ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + rewrite <- 2 Mmult_assoc. + rewrite 2 kron_mixed_product. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + apply Mplus_simplify. + - apply Mscale_simplify; try auto. + lca. + - apply Mscale_simplify; try auto. + C_field_simplify. + rewrite Rplus_0_l. + repeat rewrite Rmult_0_l. + repeat rewrite Rmult_0_r. + lca. + C_field. +Qed. + +Lemma zx_triangle_semantics : + ⟦ ▷ ⟧ = ∣0⟩⟨0∣ .+ ∣1⟩⟨0∣ .+ ∣1⟩⟨1∣. +Proof. + unfold zx_triangle. + remember (X 1 1 (PI / 2) ⟷ Z 1 1 (PI / 4)) as t_1. + remember (Z 0 1 (PI / 4) ↕ — ⟷ X 2 1 0) as t_2. + remember (Z 1 2 0 ⟷ (— ↕ (X 1 2 0 ⟷ (Z 1 0 (- PI / 4) ↕ Z 1 0 (- PI / 4))))) as t_3. + simpl. + rewrite Heqt_1. + rewrite triangle_step_1. + rewrite Heqt_2. + rewrite zx_compose_spec. + rewrite <- zx_compose_spec. + rewrite triangle_step_2. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite <- (Mmult_plus_distr_l _ _ _ (⟦ t_3 ⟧)). + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite <- (Mmult_assoc _ (∣0⟩)). + repeat rewrite <- (Mmult_assoc _ (∣1⟩)). + autorewrite with ketbra_mult_db. + Msimpl. + repeat rewrite Mscale_plus_distr_l. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (/(√2)%R * (C1/(√2)%R)) with (/2) by C_field. + replace (/ (√ 2)%R * (Cexp (PI / 4) / (√ 2)%R)) with (Cexp (PI/4)/2) by C_field. + replace (Cexp (PI / 2) * / (√ 2)%R * (C1 / (√ 2)%R)) with (Cexp (PI/2)/2) by C_field. + replace (Cexp (PI / 2) * / (√ 2)%R * (Cexp (PI / 4) / (√ 2)%R)) with (Cexp ((3 * PI) / 4)/2) by (autorewrite with Cexp_db; C_field_simplify; [lca | C_field ]). + replace (Cexp (PI / 4) * / (√ 2)%R * (Cexp (PI / 4) / (√ 2)%R)) with (Cexp (PI/2) / 2) by (autorewrite with Cexp_db; C_field_simplify; [lca | C_field ]). + replace (Cexp (PI / 4) * / (√ 2)%R * (C1 / (√ 2)%R)) with (Cexp (PI/4)/2) by C_field. + replace (Cexp (PI / 2) * Cexp (PI / 4) * - / (√ 2)%R * +(Cexp (PI / 4) / (√ 2)%R)) with (/ 2) by (autorewrite with Cexp_db; C_field_simplify; [lca | C_field ]). + replace (Cexp (PI / 2) * Cexp (PI / 4) * - / (√ 2)%R * (C1 / (√ 2)%R)) with (-(Cexp ((3 * PI)/4)/2)) by (autorewrite with Cexp_db; C_field_simplify; [lca | C_field ]). + remember (/ 2) as v1. + remember (Cexp (PI/4)/2) as v2. + remember (Cexp(PI/2)/2) as v3. + remember (Cexp (3 * PI/4)/2) as v4. + replace (v1 .* (∣0⟩ × ⟨+∣) .+ v2 .* (∣1⟩ × ⟨+∣) .+ (v3 .* (∣0⟩ × ⟨-∣) .+ v4 .* (∣1⟩ × ⟨-∣)) .+ (v3 .* (∣0⟩ × ⟨+∣) .+ v2 .* (∣1⟩ × ⟨+∣)) .+ (v1 .* (∣0⟩ × ⟨-∣) .+ - v4 .* (∣1⟩ × ⟨-∣))) with ((v1 + v3) .* (∣0⟩ × ⟨+∣) .+ 2 * v2 .* (∣1⟩ × ⟨+∣) .+ ((v1 + v3) .* (∣0⟩ × ⟨-∣))) by lma. + rewrite Heqt_3. + rewrite triangle_step_3. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite <- (Mmult_assoc _ (∣0⟩)). + repeat rewrite <- (Mmult_assoc _ (∣1⟩)). + autorewrite with ketbra_mult_db. + Msimpl. + repeat rewrite Mscale_assoc. + rewrite Heqv2. + replace (C2 * (Cexp (PI / 4) / C2) * ((√ 2)%R * Cexp (- PI / 4))) with (1 * (√2)%R) by (autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + rewrite Cmult_1_l. + replace ((v1 + v3) * ((1 + Cexp (-PI/4)^2)/(√2)%R)) with (/(√2)%R) by (rewrite Heqv1, Heqv3; autorewrite with Cexp_db; C_field_simplify; [ | C_field]; simpl; C_field_simplify; [lca | C_field]). + unfold braplus, braminus. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + rewrite Mscale_assoc. + replace (/ (√2)%R * / (√2)%R) with (/2) by C_field. + replace ((√2)%R * / (√2)%R) with (C1) by C_field. + lma. +Qed. + +Global Opaque zx_triangle. + +Lemma zx_triangle_left_semantics : + ⟦ ◁ ⟧ = ∣0⟩⟨0∣ .+ ∣0⟩⟨1∣ .+ ∣1⟩⟨1∣. +Proof. + unfold zx_triangle_left. + rewrite semantics_transpose_comm. + rewrite zx_triangle_semantics. + repeat rewrite Mplus_transpose. + repeat rewrite Mmult_transpose. + rewrite bra0transpose, bra1transpose, ket0transpose, ket1transpose. + easy. +Qed. + +Global Opaque zx_triangle_left. + Local Close Scope ZX_scope. diff --git a/src/CoreRules/CapCupRules.v b/src/CoreRules/CapCupRules.v index 3c4e2e1..e18863a 100644 --- a/src/CoreRules/CapCupRules.v +++ b/src/CoreRules/CapCupRules.v @@ -1,4 +1,9 @@ Require Import CoreData.CoreData. +Require Import ComposeRules. +Require Import CastRules. +Require Import WireRules. +Require Import StackRules. +Require Import SwapRules. Require Import CoreAutomation. Lemma cup_Z : ⊃ ∝ Z 2 0 0. @@ -21,4 +26,185 @@ Lemma cup_X : ⊃ ∝ X 2 0 0. Proof. colorswap_of cup_Z. Qed. Lemma cap_X : ⊂ ∝ X 0 2 0. -Proof. colorswap_of cap_Z. Qed. \ No newline at end of file +Proof. colorswap_of cap_Z. Qed. + +Lemma n_cup_0_empty : n_cup 0 ∝ ⦰. +Proof. + unfold n_cup. + repeat (simpl; + cleanup_zx; + simpl_casts). + easy. +Qed. + +Lemma n_cup_1_cup : n_cup 1 ∝ ⊃. +Proof. + unfold n_cup. + simpl. + simpl_casts. + simpl. + cleanup_zx. + simpl_casts. + bundle_wires. + cleanup_zx. + easy. +Qed. + +Opaque n_cup. + +Lemma n_cap_0_empty : n_cap 0 ∝ ⦰. +Proof. + apply transpose_diagrams. + simpl. + rewrite n_cup_0_empty. + easy. +Qed. + +Lemma n_cap_1_cap : n_cap 1 ∝ ⊂. +Proof. + apply transpose_diagrams. + simpl. + rewrite <- n_cup_1_cup. + unfold n_cap. + rewrite Proportional.transpose_involutive. + easy. +Qed. + +Global Open Scope ZX_scope. + +Lemma n_cup_unswapped_grow_l : forall n prfn prfm, + n_cup_unswapped (S n) ∝ cast _ _ prfn prfm (n_wire n ↕ ⊃ ↕ n_wire n) ⟷ n_cup_unswapped n. +Proof. + intros. + induction n. + - simpl. + simpl_casts. + cleanup_zx. + simpl_casts. + bundle_wires. + cleanup_zx. + easy. + - simpl. + simpl in IHn. + rewrite IHn at 1. + simpl_casts. + rewrite stack_wire_distribute_l. + rewrite stack_wire_distribute_r. + bundle_wires. + erewrite <- (@cast_n_wire (n + 1) (1 + n)). + rewrite <- ComposeRules.compose_assoc. + apply compose_simplify; [ | easy]. + erewrite (cast_compose_mid (S (n + S n))). + rewrite cast_compose_distribute. + repeat rewrite cast_contract. + apply compose_simplify; [ | apply cast_simplify; easy]. + simpl_casts. + rewrite 2 stack_assoc. + simpl_casts. + rewrite 3 stack_assoc_back. + simpl_casts. + erewrite <- (@cast_n_wire (n + 1) (1 + n)) at 2. + rewrite cast_stack_r. + simpl. + rewrite (stack_assoc (— ↕ n_wire n ↕ ⊃) (n_wire n) —). + bundle_wires. + simpl_casts. + easy. +Unshelve. + all: lia. +Qed. + +Lemma n_cup_inv_n_swap_n_wire : forall n, n_cup n ∝ n_wire n ↕ n_swap n ⟷ n_cup_unswapped n. +Proof. + intros. + strong induction n. + destruct n; [ | destruct n]. + - simpl. rewrite n_cup_0_empty. cleanup_zx. simpl_casts. easy. + - simpl. rewrite n_cup_1_cup. cleanup_zx. simpl_casts. bundle_wires. cleanup_zx. easy. +Admitted. (*TODO*) + +Lemma n_cup_unswapped_colorswap : forall n, ⊙ (n_cup_unswapped n) ∝ n_cup_unswapped n. +Proof. + intros. + induction n; [ easy | ]. + simpl. + apply compose_simplify; [ | easy ]. + rewrite cast_colorswap. + simpl. + rewrite IHn. + easy. +Qed. + +Lemma n_cup_colorswap : forall n, ⊙ (n_cup n) ∝ n_cup n. +Proof. + intros. +Local Transparent n_cup. + unfold n_cup. + simpl. + rewrite n_wire_colorswap. + rewrite n_swap_colorswap. + rewrite n_cup_unswapped_colorswap. + easy. +Qed. + +Lemma n_cap_unswapped_colorswap : forall n, ⊙ (n_cap_unswapped n) ∝ n_cap_unswapped n. +Proof. + intros. + unfold n_cap_unswapped. + rewrite colorswap_transpose_commute. + rewrite n_cup_unswapped_colorswap. + easy. +Qed. + +Lemma n_cap_colorswap : forall n, ⊙ (n_cap n) ∝ n_cap n. +Proof. + intros. + unfold n_cap. + rewrite colorswap_transpose_commute. + rewrite n_cup_colorswap. + easy. +Qed. + +#[export] Hint Rewrite + (fun n => @n_cup_colorswap n) + (fun n => @n_cap_colorswap n) + (fun n => @n_cup_unswapped_colorswap n) + (fun n => @n_cap_unswapped_colorswap n) + : colorswap_db. + +Lemma n_cup_unswapped_transpose : forall n, (n_cup_unswapped n)⊤ ∝ n_cap_unswapped n. +Proof. + intros. + unfold n_cap_unswapped. + easy. +Qed. + +Lemma n_cap_unswapped_transpose : forall n, (n_cap_unswapped n)⊤ ∝ n_cup_unswapped n. +Proof. + intros. + unfold n_cap_unswapped. + rewrite Proportional.transpose_involutive. + easy. +Qed. + +Lemma n_cup_transpose : forall n, (n_cup n)⊤ ∝ n_cap n. +Proof. + intros. + unfold n_cap. + easy. +Qed. + +Lemma n_cap_transpose : forall n, (n_cap n)⊤ ∝ n_cup n. +Proof. + intros. + unfold n_cap. + rewrite Proportional.transpose_involutive. + easy. +Qed. + +#[export] Hint Rewrite + (fun n => @n_cup_unswapped_transpose n) + (fun n => @n_cap_unswapped_transpose n) + (fun n => @n_cup_transpose n) + (fun n => @n_cap_transpose n) + : transpose_db. \ No newline at end of file diff --git a/src/CoreRules/CastRules.v b/src/CoreRules/CastRules.v index 4fddc00..5b9fe62 100644 --- a/src/CoreRules/CastRules.v +++ b/src/CoreRules/CastRules.v @@ -14,17 +14,32 @@ Proof. simpl; lma. Qed. +Lemma cast_simplify : + forall {n n' m m'} prfn0 prfm0 prfn1 prfm1 (zx0 zx1 : ZX n m), + zx0 ∝ zx1 -> + cast n' m' prfn0 prfm0 zx0 ∝ cast n' m' prfn1 prfm1 zx1. +Proof. + intros. + destruct H; destruct H. + prop_exists_nonzero x; + simpl_cast_semantics; + congruence. +Qed. + +Tactic Notation "cast_irrelevance" := + apply cast_simplify; try easy. + +Tactic Notation "auto_cast_eqn" tactic3(tac) := unshelve tac; try lia; shelve_unifiable. + #[export] Hint Rewrite @cast_id : cast_simpl_db. -Ltac simpl_casts := (autorewrite with cast_simpl_db). +Tactic Notation "simpl_casts" := auto_cast_eqn (autorewrite with cast_simpl_db); repeat cast_irrelevance. +Tactic Notation "simpl_casts_in" hyp(H) := auto_cast_eqn (autorewrite with cast_simpl_db in H); repeat (apply cast_simplify in H). -Lemma cast_stack_l : forall {nTop nTop' mTop mTop' nBot mBot} prfnTop prfmTop +Lemma cast_stack_l : forall {nTop nTop' mTop mTop' nBot mBot} prfnTop prfmTop prfn prfm (zxTop : ZX nTop mTop) (zxBot : ZX nBot mBot), (cast nTop' mTop' prfnTop prfmTop zxTop) ↕ zxBot ∝ - cast (nTop' + nBot) (mTop' + mBot) - (f_equal2_plus _ _ _ _ (prfnTop) eq_refl) - (f_equal2_plus _ _ _ _ (prfmTop) eq_refl) - (zxTop ↕ zxBot). + cast (nTop' + nBot) (mTop' + mBot) prfn prfm (zxTop ↕ zxBot). Proof. intros. subst. @@ -32,13 +47,10 @@ Proof. reflexivity. Qed. -Lemma cast_stack_r : forall {nTop mTop nBot nBot' mBot mBot'} prfnBot prfmBot +Lemma cast_stack_r : forall {nTop mTop nBot nBot' mBot mBot'} prfnBot prfmBot prfn prfm (zxTop : ZX nTop mTop) (zxBot : ZX nBot mBot), zxTop ↕ (cast nBot' mBot' prfnBot prfmBot zxBot) ∝ - cast (nTop + nBot') (mTop + mBot') - (f_equal2_plus _ _ _ _ eq_refl prfnBot) - (f_equal2_plus _ _ _ _ eq_refl prfmBot) - (zxTop ↕ zxBot). + cast (nTop + nBot') (mTop + mBot') prfn prfm (zxTop ↕ zxBot). Proof. intros. subst. @@ -63,16 +75,17 @@ Qed. Lemma cast_contract : - forall {n0 m0 n1 m1 n2 m2} prfn01 prfm01 prfn12 prfm12 (zx : ZX n0 m0), + forall {n0 m0 n1 m1 n2 m2} prfn01 prfm01 prfn12 prfm12 prfn prfm (zx : ZX n0 m0), cast n2 m2 prfn12 prfm12 (cast n1 m1 prfn01 prfm01 zx) ∝ - cast n2 m2 (eq_trans prfn12 prfn01) (eq_trans prfm12 prfm01) - zx. + cast n2 m2 prfn prfm zx. Proof. intros; subst. prop_exists_nonzero 1. - simpl; lma. + simpl. + simpl_cast_semantics. + lma. Qed. @@ -96,69 +109,40 @@ Proof. Qed. -Lemma cast_contract_l : forall {n m n0 m0 n1 m1} prfn0 prfm0 prfn1 prfm1 +Lemma cast_contract_l : forall {n m n0 m0 n1 m1} prfn0 prfm0 prfn1 prfm1 prfn prfm (zx0 : ZX n0 m0) (zx1 : ZX n1 m1), cast n m prfn0 prfm0 zx0 ∝ cast n m prfn1 prfm1 zx1 <-> - cast n1 m1 (eq_trans (eq_sym prfn1) prfn0) (eq_trans (eq_sym prfm1) prfm0) zx0 + cast n1 m1 prfn prfm zx0 ∝ zx1. Proof. intros; split; intros. - - rewrite <- cast_symm in H. - rewrite cast_contract in H. - exact H. - - rewrite <- cast_symm. + - auto_cast_eqn (rewrite <- cast_symm in H). + simpl_casts_in H. + rewrite <- H. + cast_irrelevance. + - auto_cast_eqn (rewrite <- cast_symm). simpl_casts. - exact H. + rewrite <- H. + cast_irrelevance. Qed. #[export] Hint Rewrite @cast_contract_l : cast_simpl_db. -Lemma cast_contract_r : forall {n m n0 m0 n1 m1} prfn0 prfm0 prfn1 prfm1 +Lemma cast_contract_r : forall {n m n0 m0 n1 m1} prfn0 prfm0 prfn1 prfm1 prfn prfm (zx0 : ZX n0 m0) (zx1 : ZX n1 m1), cast n m prfn0 prfm0 zx0 ∝ cast n m prfn1 prfm1 zx1 <-> - zx0 ∝ cast n0 m0 (eq_trans (eq_sym prfn0) prfn1) - (eq_trans (eq_sym prfm0) prfm1) zx1. + zx0 ∝ cast n0 m0 prfn prfm zx1. Proof. intros; split; intros. - - rewrite cast_symm in H. - rewrite cast_contract in H. - exact H. + - simpl_casts_in H. + rewrite <- H. + simpl_casts. + easy. - simpl_casts. - rewrite cast_symm. - exact H. -Qed. - -(* Reverse lemmas so you don't need complex proof structure within the stacks *) - -Lemma add_same_l : forall (n n' m : nat) (prfn : (n + m = n' + m)%nat), - (n = n')%nat. -Proof. intros. lia. Qed. - -Lemma cast_stack_top : forall {n0 n0' n1 m0 m0' m1} prfn prfm - (zx0 : ZX n0 m0) (zx1 : ZX n1 m1), - cast (n0' + n1) (m0' + m1) prfn prfm (zx0 ↕ zx1) ∝ - ((cast n0' m0' (add_same_l n0' n0 n1 prfn) (add_same_l m0' m0 m1 prfm)) zx0 - ↕ zx1). -Proof. - intros. - simpl_casts. - easy. -Qed. - -Lemma add_same_r : forall (n m m' : nat) (prfn : (n + m = n + m')%nat), - (m = m')%nat. -Proof. intros. lia. Qed. - -Lemma cast_stack_bot : forall {n0 n1 n1' m0 m1 m1'} prfn prfm - (zx0 : ZX n0 m0) (zx1 : ZX n1 m1), - cast (n0 + n1') (m0 + m1') prfn prfm (zx0 ↕ zx1) ∝ - (zx0 ↕ - (cast n1' m1' (add_same_r n0 n1' n1 prfn) (add_same_r m0 m1' m1 prfm)) zx1). -Proof. - intros. - simpl_casts. - easy. + auto_cast_eqn (rewrite cast_symm). + rewrite H. + cast_irrelevance. Qed. Lemma cast_compose_distribute : @@ -192,8 +176,8 @@ Proof. Qed. Lemma cast_compose_mid : - forall {n m o} m' prfm (zx0 : ZX n m) (zx1 : ZX m o), - zx0 ⟷ zx1 ∝ cast n m' eq_refl prfm zx0 ⟷ cast m' o prfm eq_refl zx1. + forall {n m o} m' prfm prfm' (zx0 : ZX n m) (zx1 : ZX m o), + zx0 ⟷ zx1 ∝ cast n m' eq_refl prfm zx0 ⟷ cast m' o prfm' eq_refl zx1. Proof. intros. subst. @@ -201,16 +185,45 @@ Proof. reflexivity. Qed. -Lemma cast_simplify : - forall {n n' m m'} prfn0 prfm0 prfn1 prfm1 (zx0 zx1 : ZX n m), - zx0 ∝ zx1 -> - cast n' m' prfn0 prfm0 zx0 ∝ cast n' m' prfn1 prfm1 zx1. +Lemma cast_compose_mid_contract : + forall {n m o} n' m' o' prfn prfn' prfm prfm' prfo prfo' (zx0 : ZX n m) (zx1 : ZX m o), + cast n' o' prfn prfo (zx0 ⟷ zx1) ∝ cast n' m' prfn' prfm zx0 ⟷ cast m' o' prfm' prfo' zx1. +Proof. + intros. + subst. + simpl_casts. + reflexivity. +Qed. + +Lemma cast_compose_partial_contract_r : forall {n m o} n' m' o' o'' prfn prfm prfo prfo' prfo'' prfo''' (zx0 : ZX n m') (zx1 : ZX m o), + cast n' o' prfn prfo (zx0 ⟷ cast m' o' prfm prfo' zx1) ∝ cast n' o' prfn prfo'' (zx0 ⟷ cast m' o'' prfm prfo''' zx1). Proof. intros. + subst. simpl_casts. easy. Qed. +Lemma cast_compose_partial_contract_l : forall {n m o} n' n'' m' o' prfn prfn' prfn'' prfn''' prfm prfo (zx0 : ZX n m) (zx1 : ZX m' o), + cast n' o' prfn prfo (cast n' m' prfn' prfm zx0 ⟷ zx1) ∝ cast n' o' prfn'' prfo (cast n'' m' prfn''' prfm zx0 ⟷ zx1). +Proof. + intros. + subst. + simpl_casts. + easy. +Qed. + +Lemma change_cast : + forall {n m} n' m' n'' m'' {prfn prfm prfn' prfm' prfn'' prfm''} (zx : ZX n m), + cast n' m' prfn prfm zx ∝ + cast n' m' prfn' prfm' (cast n'' m'' prfn'' prfm'' zx). +Proof. + intros. + subst. + repeat rewrite cast_id. + easy. +Qed. + Lemma cast_backwards : forall {n0 m0 n1 m1} prfn prfm prfn' prfm' (zx0 : ZX n0 m0) (zx1 : ZX n1 m1), cast n1 m1 prfn prfm zx0 ∝ zx1 <-> @@ -284,7 +297,7 @@ Proof. easy. Qed. -Lemma cast_fn_eq_dim : forall {n n'} prfn (f : forall n : nat, ZX n n), cast n' n' prfn prfn (f n) ∝ f n'. +Lemma cast_fn_eq_dim : forall {n n'} prfn prfn' (f : forall n : nat, ZX n n), cast n' n' prfn prfn' (f n) ∝ f n'. Proof. intros. destruct prfn. @@ -312,23 +325,23 @@ Qed. #[export] Hint Rewrite @cast_Z @cast_X: cast_simpl_db. -Lemma cast_n_stack1 : forall {n n'} prfn (zx : ZX 1 1), - cast n' n' prfn prfn (n ↑ zx) ∝ n' ↑ zx. +Lemma cast_n_stack1 : forall {n n'} prfn prfm (zx : ZX 1 1), + cast n' n' prfn prfm (n ↑ zx) ∝ n' ↑ zx. Proof. intros. - rewrite (cast_fn_eq_dim prfn (fun n => n_stack1 n zx)). + rewrite (cast_fn_eq_dim prfn prfm (fun n => n_stack1 n zx)). easy. Qed. -Lemma cast_n_wire : forall {n n'} prfn, - cast n' n' prfn prfn (n_wire n) ∝ n_wire n'. +Lemma cast_n_wire : forall {n n'} prfn prfm, + cast n' n' prfn prfm (n_wire n) ∝ n_wire n'. Proof. intros. apply cast_n_stack1. Qed. -Lemma cast_n_box : forall {n n'} prfn, - cast n' n' prfn prfn (n_wire n) ∝ n_wire n'. +Lemma cast_n_box : forall {n n'} prfn prfm, + cast n' n' prfn prfm (n_box n) ∝ n_box n'. Proof. intros. apply cast_n_stack1. diff --git a/src/CoreRules/CoreAutomation.v b/src/CoreRules/CoreAutomation.v index 9ea0d6a..f9483c9 100644 --- a/src/CoreRules/CoreAutomation.v +++ b/src/CoreRules/CoreAutomation.v @@ -4,6 +4,26 @@ Require Import StackRules. Require Import WireRules. Require Import StackComposeRules. +Ltac wire_to_n_wire_safe_aux zx := + match zx with + | ?n ↑ — => idtac (* Guards from recursively unfolding n_wire into (n ↑ (n_wire 1)) *) + | ?n ↑ ?zx => wire_to_n_wire_safe_aux zx + | ?zx1 ↕ ?zx2 => wire_to_n_wire_safe_aux zx1; wire_to_n_wire_safe_aux zx2 + | ?zx1 ⟷ ?zx2 => wire_to_n_wire_safe_aux zx1; wire_to_n_wire_safe_aux zx2 + | — => rewrite wire_to_n_wire + | cast _ _ _ _ ?zx => wire_to_n_wire_safe_aux zx + | _ => idtac + end. + +Ltac wire_to_n_wire_safe := +match goal with + | [ |- ?zx1 ∝ ?zx2] => try (wire_to_n_wire_safe_aux zx1); try (wire_to_n_wire_safe_aux zx2); repeat rewrite n_stack_n_wire_1_n_wire +end. + +Tactic Notation "bundle_wires" := wire_to_n_wire_safe; (* change wires to n_wires *) + repeat rewrite n_wire_stack; (* stack n_wire *) + repeat rewrite <- wire_to_n_wire. (* restore *) + #[export] Hint Rewrite (fun n => @compose_empty_l n) (fun n => @compose_empty_r n) @@ -15,10 +35,11 @@ Require Import StackComposeRules. @wire_removal_r X_0_is_wire Z_0_is_wire + box_compose (fun n m o p => @nwire_stack_compose_topleft n m o p) (fun n m o p => @nwire_stack_compose_botleft n m o p) : cleanup_zx_db. -Ltac cleanup_zx := autorewrite with cleanup_zx_db. +Tactic Notation "cleanup_zx" := auto_cast_eqn (autorewrite with cleanup_zx_db). #[export] Hint Rewrite (fun n m o p => @cast_colorswap n m o p) diff --git a/src/CoreRules/StackComposeRules.v b/src/CoreRules/StackComposeRules.v index 6c6f39b..d1bbb4c 100644 --- a/src/CoreRules/StackComposeRules.v +++ b/src/CoreRules/StackComposeRules.v @@ -32,7 +32,8 @@ Proof. easy. Qed. -Lemma push_out_top : forall {nIn nOut nOutAppendix} (appendix : ZX 0 nOutAppendix) (zx : ZX nIn nOut), appendix ↕ zx ∝ zx ⟷ (appendix ↕ (n_wire nOut)). +Lemma push_out_top : forall {nIn nOut nOutAppendix} (appendix : ZX 0 nOutAppendix) (zx : ZX nIn nOut), + appendix ↕ zx ∝ zx ⟷ (appendix ↕ (n_wire nOut)). Proof. intros. rewrite <- (stack_empty_l zx) at 2. @@ -41,10 +42,11 @@ Proof. easy. Qed. -Lemma push_out_bot : forall {nIn nOut nOutAppendix} (appendix : ZX 0 nOutAppendix) (zx : ZX nIn nOut), zx ↕ appendix ∝ (cast _ _ (Nat.add_0_r _) (Nat.add_0_r _) zx) ⟷ ((n_wire nOut) ↕ appendix). +Lemma push_out_bot : forall {nIn nOut nOutAppendix} (appendix : ZX 0 nOutAppendix) (zx : ZX nIn nOut) prfn prfm, + zx ↕ appendix ∝ (cast _ _ prfn prfm zx) ⟷ ((n_wire nOut) ↕ appendix). Proof. intros. - rewrite (stack_empty_r_rev ($ _, _ ::: zx $)). + auto_cast_eqn (rewrite (stack_empty_r_rev ($ _, _ ::: zx $))). replace ⦰ with (n_wire 0) by easy. prop_exists_nonzero 1. simpl. @@ -58,7 +60,8 @@ Proof. easy. Qed. -Lemma pull_out_top : forall {nIn nOut nInAppendix} (appendix : ZX nInAppendix 0) (zx : ZX nIn nOut), appendix ↕ zx ∝ (appendix ↕ (n_wire nIn)) ⟷ zx. +Lemma pull_out_top : forall {nIn nOut nInAppendix} (appendix : ZX nInAppendix 0) (zx : ZX nIn nOut), + appendix ↕ zx ∝ (appendix ↕ (n_wire nIn)) ⟷ zx. Proof. intros. rewrite <- (stack_empty_l zx) at 2. @@ -67,10 +70,11 @@ Proof. easy. Qed. -Lemma pull_out_bot : forall {nIn nOut nInAppendix} (appendix : ZX nInAppendix 0) (zx : ZX nIn nOut), zx ↕ appendix ∝ ((n_wire nIn) ↕ appendix) ⟷ (cast _ _ (Nat.add_0_r _) (Nat.add_0_r _) zx). +Lemma pull_out_bot : forall {nIn nOut nInAppendix} (appendix : ZX nInAppendix 0) (zx : ZX nIn nOut) prfn prfm, + zx ↕ appendix ∝ ((n_wire nIn) ↕ appendix) ⟷ (cast _ _ prfn prfm zx). Proof. intros. - rewrite (stack_empty_r_rev ($ _, _ ::: zx $)). + auto_cast_eqn (rewrite (stack_empty_r_rev ($ _, _ ::: zx $))). replace ⦰ with (n_wire 0) by easy. prop_exists_nonzero 1. simpl. @@ -84,27 +88,29 @@ Proof. easy. Qed. -Lemma disconnected_stack_compose_l : forall {n m} (zxIn : ZX n 0) (zxOut : ZX 0 m), zxIn ↕ zxOut ∝ cast _ _ (@Nat.add_0_r _) (eq_refl) (zxIn ⟷ zxOut). +Lemma disconnected_stack_compose_l : forall {n m} (zxIn : ZX n 0) (zxOut : ZX 0 m) prfn prfm, + zxIn ↕ zxOut ∝ cast _ _ prfn prfm (zxIn ⟷ zxOut). Proof. intros. rewrite <- (compose_empty_l zxOut) at 1. rewrite <- (compose_empty_r zxIn) at 1. rewrite stack_compose_distr. rewrite stack_empty_l. - rewrite stack_empty_r. - rewrite cast_compose_l. + auto_cast_eqn (rewrite stack_empty_r). + rewrite cast_compose_l. simpl_casts. easy. Qed. -Lemma disconnected_stack_compose_r : forall {n m} (zxIn : ZX n 0) (zxOut : ZX 0 m), zxOut ↕ zxIn ∝ cast _ _ (eq_refl) (@Nat.add_0_r _) (zxIn ⟷ zxOut). +Lemma disconnected_stack_compose_r : forall {n m} (zxIn : ZX n 0) (zxOut : ZX 0 m) prfn prfm, + zxOut ↕ zxIn ∝ cast _ _ prfn prfm (zxIn ⟷ zxOut). Proof. intros. rewrite <- (compose_empty_l zxOut) at 1. rewrite <- (compose_empty_r zxIn) at 1. rewrite stack_compose_distr. rewrite stack_empty_l. - rewrite stack_empty_r. + auto_cast_eqn (rewrite stack_empty_r). rewrite cast_compose_r. simpl_casts. easy. diff --git a/src/CoreRules/StackRules.v b/src/CoreRules/StackRules.v index b9fdb47..8cc8e57 100644 --- a/src/CoreRules/StackRules.v +++ b/src/CoreRules/StackRules.v @@ -4,14 +4,20 @@ Require Import SpiderInduction. Local Open Scope ZX_scope. +Lemma stack_semantics {n m o p} : forall (zx0 : ZX n m) (zx1 : ZX o p), + ⟦ zx0 ↕ zx1 ⟧ = ⟦ zx0 ⟧ ⊗ ⟦ zx1 ⟧. +Proof. easy. Qed. + +Lemma compose_semantics {n m o} : forall (zx0 : ZX n m) (zx1 : ZX m o), +⟦ zx0 ⟷ zx1 ⟧ = @Mmult (2 ^ n) (2 ^ m) (2 ^ o) (⟦ zx1 ⟧) (⟦ zx0 ⟧). +Proof. easy. Qed. + Lemma stack_assoc : -forall {n0 n1 n2 m0 m1 m2} - (zx0 : ZX n0 m0) (zx1 : ZX n1 m1) (zx2 : ZX n2 m2), +forall {n0 n1 n2 m0 m1 m2} + (zx0 : ZX n0 m0) (zx1 : ZX n1 m1) (zx2 : ZX n2 m2) prfn prfm, (zx0 ↕ zx1) ↕ zx2 ∝ - cast ((n0 + n1) + n2) ((m0 + m1) + m2) - (eq_sym(Nat.add_assoc _ _ _)) (eq_sym(Nat.add_assoc _ _ _)) - (zx0 ↕ (zx1 ↕ zx2)). -Proof. + cast _ _ prfn prfm (zx0 ↕ (zx1 ↕ zx2)). +Proof. intros. prop_exists_nonzero 1. simpl. @@ -22,19 +28,17 @@ Qed. Lemma stack_assoc_back : forall {n0 n1 n2 m0 m1 m2} - (zx0 : ZX n0 m0) (zx1 : ZX n1 m1) (zx2 : ZX n2 m2), + (zx0 : ZX n0 m0) (zx1 : ZX n1 m1) (zx2 : ZX n2 m2) prfn prfm, zx0 ↕ (zx1 ↕ zx2) ∝ - cast (n0 + (n1 + n2)) (m0 + (m1 + m2)) - (Nat.add_assoc _ _ _) (Nat.add_assoc _ _ _) - ((zx0 ↕ zx1) ↕ zx2). + cast (n0 + (n1 + n2)) (m0 + (m1 + m2)) prfn prfm + ((zx0 ↕ zx1) ↕ zx2). Proof. intros. - prop_exists_nonzero 1. - simpl. - Msimpl. - rewrite (@cast_semantics ((n0 + n1) + n2) _ (n0 + (n1 + n2))%nat). - simpl; restore_dims. - rewrite kron_assoc; auto with wf_db. + rewrite <- cast_symm. + rewrite <- stack_assoc. + easy. +Unshelve. +all: lia. Qed. Lemma stack_empty_l : forall {nIn nOut} (zx : ZX nIn nOut), @@ -47,9 +51,9 @@ Proof. lma. Qed. -Lemma stack_empty_r : forall {n m : nat} (zx : ZX n m), +Lemma stack_empty_r : forall {n m : nat} (zx : ZX n m) prfn prfm, zx ↕ ⦰ ∝ - cast (n + 0) (m + 0) (Nat.add_0_r _) (Nat.add_0_r _) zx. + cast (n + 0) (m + 0) prfn prfm zx. Proof. intros. prop_exists_nonzero 1. @@ -59,9 +63,9 @@ Proof. reflexivity. Qed. -Lemma stack_empty_r_rev : forall {n m : nat} (zx : ZX n m), +Lemma stack_empty_r_rev : forall {n m : nat} (zx : ZX n m) prfn prfm, zx ∝ - cast _ _ (eq_sym (Nat.add_0_r _)) (eq_sym (Nat.add_0_r _)) (zx ↕ ⦰). + cast _ _ prfn prfm (zx ↕ ⦰). Proof. intros. prop_exists_nonzero 1. @@ -134,9 +138,9 @@ Lemma n_stack1_l : forall n (zx : ZX 1 1), (S n) ↑ zx ∝ zx ↕ (n ↑ zx). Proof. easy. Qed. -Lemma n_stack1_r : forall n (zx : ZX 1 1), +Lemma n_stack1_r : forall n (zx : ZX 1 1) prfn prfm, (S n) ↑ zx ∝ - cast (S n) (S n) (eq_sym (Nat.add_1_r _)) (eq_sym (Nat.add_1_r _)) ((n ↑ zx) ↕ zx). + cast (S n) (S n) prfn prfm ((n ↑ zx) ↕ zx). Proof. induction n. - intros. @@ -154,6 +158,8 @@ induction n. rewrite stack_assoc_back. simpl_casts. easy. +Unshelve. +all: lia. Qed. Lemma stack_wire_distribute_l : forall {n m o} (zx0 : ZX n m) (zx1 : ZX m o), @@ -187,6 +193,8 @@ Proof. rewrite stack_assoc_back. simpl_casts. easy. +Unshelve. +all: lia. Qed. (* Lemma n_wire_collapse_r : forall {n0 n1 m1} (zx0 : ZX n0 0) (zx1 : ZX n1 m1), @@ -204,12 +212,13 @@ Proof. rewrite (stack_assoc zx). simpl_casts. reflexivity. +Unshelve. +all: lia. Qed. -Lemma nstack_split : forall n m {nIn mOut} (zx : ZX nIn mOut), +Lemma nstack_split : forall n m {nIn mOut} (zx : ZX nIn mOut) prfn prfm, (n + m) ⇑ zx ∝ - cast _ _ (Nat.mul_add_distr_r _ _ _) (Nat.mul_add_distr_r _ _ _) - ((n ⇑ zx) ↕ (m ⇑ zx)). + cast _ _ prfn prfm ((n ⇑ zx) ↕ (m ⇑ zx)). Proof. intros. dependent induction n. @@ -222,4 +231,20 @@ Proof. rewrite stack_assoc. simpl_casts. reflexivity. +Unshelve. +all: lia. Qed. + +Lemma nstack1_1 : forall zx, 1 ↑ zx ∝ zx. +Proof. + intros. + simpl. + rewrite stack_empty_r. + simpl_casts. + easy. +Unshelve. +all: lia. +Qed. + +Lemma nstack1_0 : forall zx, 0 ↑ zx ∝ ⦰. +Proof. easy. Qed. \ No newline at end of file diff --git a/src/CoreRules/SwapRules.v b/src/CoreRules/SwapRules.v index 6f5f2aa..ffb85fe 100644 --- a/src/CoreRules/SwapRules.v +++ b/src/CoreRules/SwapRules.v @@ -9,6 +9,8 @@ Lemma swap_compose : ⨉ ⟷ ⨉ ∝ n_wire 2. Proof. solve_prop 1. Qed. +Global Hint Rewrite swap_compose : cleanup_zx_db. + Lemma top_wire_to_bottom_ind : forall n, top_wire_to_bottom (S (S n)) = @Mmult _ (2 ^ (S (S n))) _ ((I 2) ⊗ top_wire_to_bottom (S n)) (swap ⊗ (I (2 ^ n))). Proof. intros. @@ -28,36 +30,11 @@ Proof. easy. Qed. -(* Well foundedness of semantics *) - -Lemma WF_top_to_bottom (n : nat) : WF_Matrix (top_wire_to_bottom n). -Proof. - destruct n; try auto with wf_db. - induction n. - - simpl; auto with wf_db. - - simpl. try auto with wf_db. -Qed. - -Global Hint Resolve WF_top_to_bottom : wf_db. - -Lemma WF_bottom_to_top (n : nat) : WF_Matrix (bottom_wire_to_top n). -Proof. unfold bottom_wire_to_top. auto with wf_db. Qed. -Global Hint Resolve WF_bottom_to_top : wf_db. - -Lemma WF_a_swap_semantics (n : nat) : - WF_Matrix (a_swap_semantics n). -Proof. - intros. - unfold a_swap_semantics. - destruct n; auto with wf_db. -Qed. - -Global Hint Resolve WF_a_swap_semantics : wf_db. (* Proving correctness of conversion *) -Lemma top_to_bottom_correct : forall n, ZX_semantics (top_to_bottom n) = top_wire_to_bottom n. +Lemma top_to_bottom_correct : forall n, ⟦ top_to_bottom n ⟧ = top_wire_to_bottom n. Proof. intros. destruct n; [ reflexivity | ]. @@ -74,7 +51,7 @@ Proof. easy. Qed. -Lemma bottom_to_top_correct : forall n, ZX_semantics (bottom_to_top n) = bottom_wire_to_top n. +Lemma bottom_to_top_correct : forall n, ⟦ bottom_to_top n ⟧ = bottom_wire_to_top n. Proof. intros. unfold bottom_to_top. @@ -84,7 +61,7 @@ Proof. easy. Qed. -Lemma a_swap_correct : forall n, ZX_semantics (a_swap n) = a_swap_semantics n. +Lemma a_swap_correct : forall n, ⟦ a_swap n ⟧ = a_swap_semantics n. Proof. intros. unfold a_swap_semantics. @@ -105,15 +82,83 @@ Lemma top_to_bottom_grow_l : forall n, top_to_bottom (S (S n)) ∝ (⨉ ↕ n_wire n) ⟷ (— ↕ top_to_bottom (S n)). Proof. easy. Qed. +Lemma top_to_bottom_grow_r : forall n prf prf', + top_to_bottom (S (S n)) ∝ cast _ _ prf' prf' (top_to_bottom (S n) ↕ —) ⟷ (cast _ _ prf prf (n_wire n ↕ ⨉)). +Proof. + intros. + induction n. + + simpl; cleanup_zx; simpl_casts. + bundle_wires. + cleanup_zx. + easy. + + simpl. + simpl in IHn. + rewrite IHn at 1. + simpl_casts. + rewrite (stack_assoc — (n_wire n) ⨉). + simpl_casts. + erewrite (@cast_stack_distribute + _ 1 _ 1 _ _ _ _ + _ _ _ _ _ _ — (n_wire n ↕ ⨉)). + rewrite (cast_id _ _ —). + erewrite (cast_compose_mid (S (S n)) _ _ (⨉ ↕ n_wire n)). + erewrite (@cast_stack_distribute + _ 1 _ 1 _ _ _ _ + _ _ _ _ _ _ — (top_to_bottom_helper n)). + rewrite cast_id. + rewrite stack_wire_distribute_r. + rewrite cast_compose_distribute. + rewrite stack_wire_distribute_l. + rewrite <- compose_assoc. + apply compose_simplify; [ | easy ]. + bundle_wires. + repeat rewrite cast_id. + symmetry. + erewrite (cast_compose_mid (S (S (S n)))). + simpl_casts. + apply compose_simplify; [ | rewrite (stack_assoc_back — (top_to_bottom_helper n) —); simpl_casts; easy ]. + eapply (cast_diagrams (2 + (1 + n)) (2 + (1 + n))). + rewrite cast_contract. + rewrite (stack_assoc ⨉ (n_wire n) —). + rewrite cast_contract. + rewrite cast_stack_distribute. + bundle_wires. + rewrite cast_n_wire. + simpl_casts. + easy. +Unshelve. + all: lia. +Qed. + Lemma offset_swaps_comm_top_left : ⨉ ↕ — ⟷ (— ↕ ⨉) ∝ — ↕ ⨉ ⟷ (⨉ ↕ —) ⟷ (— ↕ ⨉) ⟷ (⨉ ↕ —). -Proof. solve_prop 1. Qed. +Proof. (* solve_prop 1. Qed. *) Admitted. Lemma offset_swaps_comm_bot_right : — ↕ ⨉ ⟷ (⨉ ↕ —) ∝ ⨉ ↕ — ⟷ (— ↕ ⨉) ⟷ (⨉ ↕ —) ⟷ (— ↕ ⨉). -Proof. solve_prop 1. Qed. +Proof. (* solve_prop 1. Qed. *) Admitted. + +Lemma bottom_wire_to_top_ind : forall n, bottom_wire_to_top (S (S n)) = @Mmult _ (2 ^ (S (S n))) _ (swap ⊗ (I (2 ^ n))) ((I 2) ⊗ bottom_wire_to_top (S n)). +Proof. + intros. + apply transpose_matrices. + unfold bottom_wire_to_top. + rewrite Mmult_transpose. + restore_dims. + rewrite Matrix.transpose_involutive. + restore_dims. + rewrite (kron_transpose 2 2 (2 ^ (S n)) (2 ^ S n)). + replace (Nat.pow 2 (S (S n)))%nat with ((2 * 2) * (2 ^ n))%nat by (simpl; lia). + rewrite (kron_transpose (2 * 2) (2 * 2) (2 ^ n) (2 ^ n) swap (I (2 ^ n))). + rewrite 2 id_transpose_eq. + rewrite swap_transpose. + rewrite Matrix.transpose_involutive. + restore_dims. + rewrite (top_wire_to_bottom_ind n). + easy. +Qed. Lemma bottom_to_top_grow_r : forall n, bottom_to_top (S (S n)) ∝ (— ↕ bottom_to_top (S n)) ⟷ (⨉ ↕ n_wire n). @@ -125,6 +170,47 @@ Proof. easy. Qed. + +Lemma bottom_to_top_grow_l : forall n prf prf', + bottom_to_top (S (S n)) ∝ cast _ _ prf' prf'((cast _ _ prf prf (n_wire n ↕ ⨉)) ⟷ (bottom_to_top (S n) ↕ —)). +Proof. + intros. + apply transpose_diagrams. +Opaque top_to_bottom. + simpl. + unfold bottom_to_top. + rewrite cast_transpose. + simpl. + repeat rewrite cast_transpose. + simpl. + rewrite n_wire_transpose. + repeat rewrite Proportional.transpose_involutive. + rewrite top_to_bottom_grow_r. + rewrite cast_compose_distribute. + simpl_casts. + erewrite (cast_compose_mid (S (n + 1))). + simpl_casts. + apply compose_simplify; cast_irrelevance. +Unshelve. +all: lia. +Qed. +Transparent top_to_bottom. + +Lemma top_to_bottom_transpose : forall n, (top_to_bottom n)⊤ ∝ bottom_to_top n. +Proof. + intros. + unfold bottom_to_top. + easy. +Qed. + +Lemma bottom_to_top_transpose : forall n, (bottom_to_top n)⊤ ∝ top_to_bottom n. +Proof. + intros. + unfold bottom_to_top. + rewrite Proportional.transpose_involutive. + easy. +Qed. + Lemma a_swap_grow : forall n, a_swap (S (S (S n))) ∝ (⨉ ↕ n_wire (S n)) ⟷ (— ↕ a_swap (S (S n))) ⟷ (⨉ ↕ n_wire (S n)). Proof. intros. @@ -156,8 +242,7 @@ Proof. rewrite (stack_assoc ⨉ — (n_wire n)). rewrite 2 (stack_assoc_back — —). simpl_casts. - rewrite wire_to_n_wire at 1 2 3 7 9 10. - repeat rewrite n_wire_stack. + bundle_wires. repeat rewrite <- compose_assoc. rewrite (nwire_stack_compose_topleft (bottom_to_top (S n)) ⨉). rewrite <- nwire_stack_compose_botleft. @@ -178,27 +263,289 @@ Proof. rewrite <- 2 stack_wire_distribute_l. apply stack_simplify; [ easy | ]. rewrite <- bottom_to_top_grow_r. - easy. + easy. +Unshelve. +all: lia. Qed. Lemma a_swap_2_is_swap : a_swap 2 ∝ ⨉. Proof. - solve_prop 1. + unfold a_swap. + unfold bottom_to_top. + simpl. + cleanup_zx. + simpl_casts. + bundle_wires. + cleanup_zx. + easy. +Qed. + + +Lemma a_swap_3_order_indep : + I 2 ⊗ swap × (swap ⊗ I 2) × (I 2 ⊗ swap) = (swap ⊗ I 2) × (I 2 ⊗ swap) × (swap ⊗ I 2). +Proof. + (* solve_matrix *) (* Commented out for performance*) +Admitted. + +Lemma a_swap_semantics_ind : forall n, a_swap_semantics (S (S (S n))) = swap ⊗ (I (2 ^ (S n))) × (I 2 ⊗ a_swap_semantics (S (S n))) × (swap ⊗ (I (2 ^ (S n)))). +Proof. + intros. + rewrite <- 2 a_swap_correct. + simpl. + repeat rewrite kron_id_dist_l by shelve. + restore_dims. + rewrite <- 2 (kron_assoc (I 2) (I 2) (_)) by shelve. + repeat rewrite id_kron. + replace ((2 ^ n + (2 ^ n + 0)))%nat with (2 ^ (S n))%nat by (simpl; lia). + restore_dims. + repeat rewrite <- Mmult_assoc. + restore_dims. + rewrite (kron_mixed_product swap (I _) (I (2 * 2)) (_)). + Msimpl. + repeat rewrite Mmult_assoc. + restore_dims. + repeat rewrite Mmult_assoc. + remember (⟦ (top_to_bottom_helper n) ⊤%ZX ⟧) as ZX_tb_t. + remember (⟦ top_to_bottom_helper n ⟧) as ZX_tb. + restore_dims. + rewrite (kron_mixed_product (I (2 * 2)) ZX_tb_t swap (I (2 ^ (S n)))) . + Msimpl; [ | shelve]. + rewrite <- (Mmult_1_r _ _ (swap ⊗ ZX_tb)) by shelve. + rewrite n_wire_transpose. + rewrite n_wire_semantics. + rewrite <- 2 kron_assoc by shelve. + restore_dims. + repeat rewrite <- Mmult_assoc by shelve. + rewrite <- 2 kron_id_dist_r by shelve. + rewrite a_swap_3_order_indep. + rewrite 2 kron_id_dist_r by shelve. + repeat rewrite <- Mmult_assoc by shelve. + restore_dims. + rewrite (kron_assoc _ (I 2) (I (2 ^ n))) by shelve. + rewrite id_kron. + replace (2 * (2 ^ n))%nat with (2 ^ (S n))%nat by (simpl; lia). + restore_dims. + repeat rewrite <- Mmult_assoc by shelve. + rewrite kron_mixed_product. + Msimpl. + 2,3: shelve. + restore_dims. + repeat rewrite Mmult_assoc by shelve. + restore_dims. + rewrite kron_mixed_product. + Msimpl; [ | shelve]. + easy. +Unshelve. +all: subst; auto with wf_db. +all: try (apply WF_kron; try lia; replace (2 ^ n + (2 ^ n + 0))%nat with (2 ^ (S n))%nat by (simpl; lia); auto with wf_db). + apply WF_mult. + auto with wf_db. + apply WF_kron; try lia; replace (2 ^ n + (2 ^ n + 0))%nat with (2 ^ (S n))%nat by (simpl; lia); auto with wf_db. +Qed. + +Lemma a_swap_transpose : forall n, + (a_swap n) ⊤ ∝ a_swap n. +Proof. + intros. + strong induction n. + destruct n; [ easy | ]. + destruct n; [ simpl; cleanup_zx; simpl_casts; easy | ]. + destruct n; [ rewrite a_swap_2_is_swap; easy | ]. + rewrite a_swap_grow. +Local Opaque a_swap. + simpl. + repeat rewrite n_wire_transpose. + rewrite compose_assoc. + rewrite H by lia. + easy. Qed. (* n_swap proofs *) -Opaque a_swap. (* For n_swap proofs we don't want a_swap to unfold, instead we use lemmata from above*) +Opaque a_swap a_swap_semantics. (* For n_swap proofs we don't want a_swap to unfold, instead we use lemmata from above*) Lemma n_swap_2_is_swap : n_swap 2 ∝ ⨉. Proof. intros. simpl. + unfold bottom_to_top. + simpl. + cleanup_zx. simpl_casts. + bundle_wires. cleanup_zx. - rewrite wire_to_n_wire. - rewrite n_wire_stack. + easy. +Qed. + +Lemma n_swap_1_is_wire : n_swap 1 ∝ —. +Proof. + simpl. cleanup_zx. - apply a_swap_2_is_swap. + simpl_casts. + easy. +Qed. + +Lemma n_swap_grow_l : forall n, + n_swap (S n) ∝ bottom_to_top (S n) ⟷ (— ↕ n_swap n). +Proof. + induction n. + - simpl. + cleanup_zx. + easy. + - simpl. + easy. +Qed. + +Lemma n_swap_grow_r : forall n, + n_swap (S n) ∝ (— ↕ n_swap n) ⟷ top_to_bottom (S n). +Proof. + induction n. + - simpl. + cleanup_zx. + easy. + - simpl. + fold (top_to_bottom (S n)). + rewrite <- (n_swap_grow_l n). + rewrite IHn at 1. + rewrite bottom_to_top_grow_r. + rewrite stack_wire_distribute_l. + rewrite (stack_assoc_back — —). + simpl_casts. + bundle_wires. + repeat rewrite compose_assoc. + rewrite <- (compose_assoc (⨉ ↕ n_wire n)). + rewrite (nwire_stack_compose_botleft ⨉ (n_swap n)). + rewrite <- (nwire_stack_compose_topleft (n_swap n) ⨉). + repeat rewrite <- compose_assoc. + simpl. + cleanup_zx. + simpl_casts. + rewrite stack_wire_distribute_l. + repeat rewrite compose_assoc. + rewrite (stack_assoc_back — — (n_swap _)). + cleanup_zx. + simpl_casts. + easy. +Unshelve. +all: lia. +Qed. + +Lemma n_swap_transpose : forall n, + (n_swap n) ⊤ ∝ n_swap n. +Proof. + induction n; try easy. + - simpl. + rewrite IHn. + unfold bottom_to_top at 1. + rewrite Proportional.transpose_involutive. + rewrite <- n_swap_grow_l. + rewrite <- n_swap_grow_r. + easy. Qed. +#[export] Hint Rewrite + (fun n => @bottom_to_top_transpose n) + (fun n => @top_to_bottom_transpose n) + (fun n => @n_swap_transpose n) + (fun n => @a_swap_transpose n) + : transpose_db. + +Lemma top_to_bottom_colorswap : forall n, + ⊙ (top_to_bottom n) ∝ top_to_bottom n. +Proof. + destruct n; [ easy | ]. + induction n. + - easy. + - simpl. + fold (top_to_bottom (S n)). + rewrite IHn. + rewrite n_wire_colorswap. + easy. +Qed. + +Lemma bottom_to_top_colorswap : forall n, + ⊙ (bottom_to_top n) ∝ bottom_to_top n. +Proof. + destruct n; [easy | ]. + induction n. + - easy. + - unfold bottom_to_top. + rewrite top_to_bottom_grow_l. + simpl. + fold (top_to_bottom (S n)). + fold (bottom_to_top (S n)). + rewrite IHn. + rewrite n_wire_transpose. + rewrite n_wire_colorswap. + easy. +Qed. + +Lemma a_swap_colorswap : forall n, + ⊙ (a_swap n) ∝ a_swap n. +Proof. + induction n. + - easy. + - Local Transparent a_swap. + simpl. + rewrite bottom_to_top_colorswap. + rewrite top_to_bottom_colorswap. + easy. +Qed. + +Lemma n_swap_colorswap : forall n, + ⊙ (n_swap n) ∝ n_swap n. +Proof. + induction n. + - easy. + - simpl. + rewrite IHn. + rewrite bottom_to_top_colorswap. + easy. +Qed. + +#[export] Hint Rewrite + (fun n => @bottom_to_top_colorswap n) + (fun n => @top_to_bottom_colorswap n) + (fun n => @a_swap_colorswap n) + (fun n => @n_swap_colorswap n) + : colorswap_db. + +Lemma swap_pullthrough_top_right_Z_1_1 : forall α, (Z 1 1 α) ↕ — ⟷ ⨉ ∝ ⨉ ⟷ (— ↕ (Z 1 1 α)). +Proof. intros. solve_prop 1. Qed. + + +Lemma swap_pullthrough_top_right_Z : forall n α prfn prfm, ((Z (S n) 1 α) ↕ —) ⟷ ⨉ ∝ cast _ _ prfn prfm (n_swap _ ⟷ (— ↕ (Z (S n) 1 α))). +Proof. + intro n. + induction n; intros. + - simpl_casts. + cleanup_zx. + rewrite n_swap_2_is_swap. + rewrite swap_pullthrough_top_right_Z_1_1. + easy. + - rewrite SpiderInduction.grow_Z_left_2_1 at 1. + rewrite stack_wire_distribute_r. + rewrite compose_assoc. + rewrite IHn. + simpl_casts. + rewrite n_swap_grow_l. + rewrite compose_assoc. + rewrite (cast_compose_mid_contract _ (S (S n))). + simpl_casts. + rewrite (stack_assoc (Z 2 1 _) (n_wire n) —). + bundle_wires. + rewrite bottom_to_top_grow_r. + simpl_casts. + rewrite (cast_compose_mid (S (S n))). + erewrite <- (@cast_n_wire (S n)). + rewrite cast_stack_r. + rewrite cast_contract. + simpl_casts. + erewrite (cast_compose_mid_contract _ (S (S n)) _ _ _ _ _ _ _ (— ↕ bottom_to_top (S n)) (⨉ ↕ n_wire n)). + simpl_casts. +Abort. + + +Lemma swap_pullthrough_top_right_X_1_1 : forall α, (X 1 1 α) ↕ — ⟷ ⨉ ∝ ⨉ ⟷ (— ↕ (X 1 1 α)). +Proof. intros. colorswap_of swap_pullthrough_top_right_Z_1_1. Qed. + diff --git a/src/CoreRules/WireRules.v b/src/CoreRules/WireRules.v index 91aba47..1ae874b 100644 --- a/src/CoreRules/WireRules.v +++ b/src/CoreRules/WireRules.v @@ -86,7 +86,7 @@ Proof. rewrite cast_id. rewrite cast_compose_distribute. simpl_casts. - erewrite (cast_compose_mid m _ ($ n, m + 0 ::: zx0 $)). + erewrite (cast_compose_mid m _ _ ($ n, m + 0 ::: zx0 $)). simpl_casts. easy. Unshelve. @@ -98,7 +98,7 @@ Proof. rewrite cast_id. rewrite cast_compose_distribute. simpl_casts. - erewrite (cast_compose_mid (m + (p + 1)) _ + erewrite (cast_compose_mid (m + (p + 1)) _ _ ($ n + (p + 1), m + (S p) ::: zx0 ↕ (n_wire p ↕ —)$)). simpl_casts. rewrite 3 stack_assoc_back. @@ -107,7 +107,7 @@ Proof. rewrite cast_id. rewrite cast_compose_distribute. rewrite 2 cast_contract. - erewrite (cast_compose_mid (m + p + 1) _ + erewrite (cast_compose_mid (m + p + 1) _ _ ($ n + p + 1, m + (p + 1) ::: zx0 ↕ n_wire p ↕ — $)). simpl_casts. rewrite <- stack_wire_distribute_r. @@ -121,7 +121,7 @@ Lemma wire_to_n_wire : — ∝ n_wire 1. Proof. simpl. - rewrite stack_empty_r. + auto_cast_eqn (rewrite stack_empty_r). simpl_casts. easy. Qed. @@ -154,4 +154,27 @@ Proof. prop_exists_nonzero 1. Msimpl; simpl. solve_matrix. +Qed. + +Lemma n_stack_n_wire_1_n_wire : forall n, n ↑ (n_wire 1) ∝ n_wire n. +Proof. + intros. rewrite <- wire_to_n_wire. easy. +Qed. + +Lemma n_wire_grow_r : forall n prfn prfm, n_wire (S n) ∝ cast _ _ prfn prfm (n_wire n ↕ —). +Proof. + intros. + rewrite wire_to_n_wire at 3. + rewrite n_wire_stack. + rewrite (@cast_n_wire (n + 1) (S n) prfn prfm). + easy. +Qed. + +Lemma box_compose : □ ⟷ □ ∝ —. +Proof. + prop_exists_nonzero 1. + Msimpl. + simpl. + rewrite MmultHH. + easy. Qed. \ No newline at end of file diff --git a/src/CoreRules/XRules.v b/src/CoreRules/XRules.v index b1a0908..4ec88f4 100644 --- a/src/CoreRules/XRules.v +++ b/src/CoreRules/XRules.v @@ -1,6 +1,8 @@ Require Import CoreData.CoreData. Require Import WireRules. +Require Import CapCupRules. Require Import CoreAutomation. +Require Import SwapRules. Require Import ZRules. Lemma grow_X_top_left : forall (nIn nOut : nat) α, @@ -13,6 +15,17 @@ Lemma grow_X_top_right : forall (nIn nOut : nat) α, (X nIn (S nOut) α) ⟷ ((X_Spider 1 2 0) ↕ (n_wire nOut)). Proof. intros. colorswap_of grow_Z_top_right. Qed. +Lemma grow_X_bot_left : forall n {m o α}, + X (n + m) o α ∝ + (n_wire n ↕ X m 1 0) ⟷ X (n + 1) o α. +Proof. intros. colorswap_of (@grow_Z_bot_left n m o α). Qed. + +Lemma grow_X_bot_right : forall {n m} o {α}, + X n (m + o) α ∝ + X n (m + 1) α ⟷ (n_wire m ↕ X 1 o 0). +Proof. intros. colorswap_of (@grow_Z_bot_right n m o α). Qed. + + Lemma X_rot_l : forall n m α β, X (S n) m (α + β) ∝ X 1 1 α ↕ n_wire n ⟷ X (S n) m β. Proof. intros. colorswap_of Z_rot_l. Qed. @@ -80,16 +93,16 @@ Lemma dominated_X_spider_fusion_bot_left : forall m n0 n1 i α β, X i (n1 + m) (α + β). Proof. intros. colorswap_of dominated_Z_spider_fusion_bot_left. Qed. -Lemma X_spider_fusion_top_left_bot_right : forall top mid bot input output α β, +Lemma X_spider_fusion_top_left_bot_right : forall top mid bot input output α β prfn prfm, X input (top + S mid) α ↕ n_wire bot ⟷ - cast (top + (S mid) + bot) (top + output) (eq_sym (Nat.add_assoc _ _ _)) eq_refl + cast (top + (S mid) + bot) (top + output) prfn prfm (n_wire top ↕ X (S mid + bot) output β) ∝ X (input + bot) (top + output) (α + β). Proof. intros. colorswap_of Z_spider_fusion_top_left_bot_right. Qed. -Lemma X_spider_fusion_bot_left_top_right : forall top mid bot input output α β, +Lemma X_spider_fusion_bot_left_top_right : forall top mid bot input output α β prfn prfm, ((n_wire top ↕ X input (S mid + bot) α) ⟷ - cast (top + ((S mid) + bot)) _ ((Nat.add_assoc _ _ _)) eq_refl + cast (top + ((S mid) + bot)) _ prfn prfm (X (top + (S mid)) output β ↕ n_wire bot)) ∝ X (top + input) (output + bot) (β + α). Proof. intros. colorswap_of Z_spider_fusion_bot_left_top_right. Qed. @@ -130,19 +143,60 @@ Proof. intros. colorswap_of (@Z_self_swap_absorbtion_left_top n m α). Qed. Lemma X_self_swap_absorbtion_left : forall {n n' m α}, ((n_wire n' ↕ (⨉ ↕ n_wire n)) ⟷ X (n' + S (S n)) m α) ∝ X (n' + S (S n)) m α. Proof. intros. colorswap_of (@Z_self_swap_absorbtion_left n n' m α). Qed. -Lemma X_wrap_under_bot_left : forall n m α, +Lemma X_wrap_under_bot_left : forall n m α prfn prfm, X n (m + 1) α ∝ (cast n (n + 1 + 1) - (eq_sym (Nat.add_0_r _)) (wrap_under_dimension _) + prfn prfm (n_wire n ↕ ⊂)) ⟷ (X (n + 1) m α ↕ Wire). Proof. colorswap_of Z_wrap_under_bot_left. Qed. -Lemma X_wrap_under_bot_right : forall n m α, +Lemma X_wrap_under_bot_right : forall n m α prfn prfm, X (n + 1) m α ∝ (X n (m + 1) α ↕ —) ⟷ (cast (m + 1 + 1) m - (wrap_under_dimension _) - (eq_sym (Nat.add_0_r _)) + prfn + prfm (n_wire m ↕ ⊃)). -Proof. colorswap_of Z_wrap_under_bot_right. Qed. \ No newline at end of file +Proof. colorswap_of Z_wrap_under_bot_right. Qed. + +Lemma X_self_top_to_bottom_absorbtion_right_base : forall n m α, X n m α ⟷ top_to_bottom m ∝ X n m α. +Proof. colorswap_of Z_self_top_to_bottom_absorbtion_right_base. Qed. + +Lemma X_self_bottom_to_top_absorbtion_right_base : forall n m α, X n m α ⟷ bottom_to_top m ∝ X n m α. +Proof. colorswap_of Z_self_bottom_to_top_absorbtion_right_base. Qed. + +Lemma X_a_swap_absorbtion_right_base : forall n m α, X n m α ⟷ a_swap m ∝ X n m α. +Proof. colorswap_of Z_a_swap_absorbtion_right_base. Qed. + +Lemma X_n_swap_absorbtion_right_base : forall n m α, X n m α ⟷ n_swap m ∝ X n m α. +Proof. colorswap_of Z_n_swap_absorbtion_right_base. Qed. + +Lemma X_n_wrap_under_r_base_unswapped : forall n m α, X (n + m) 0 α ∝ (X n m α ↕ n_wire m) ⟷ n_cup_unswapped m. +Proof. colorswap_of Z_n_wrap_under_r_base_unswapped. Qed. + +Lemma X_n_wrap_under_r_base : forall n m α, X (n + m) 0 α ∝ (X n m α ↕ n_wire m) ⟷ n_cup m. +Proof. colorswap_of Z_n_wrap_under_r_base. Qed. + +Lemma X_n_wrap_over_r_base_unswapped : forall n m α, X (m + n) 0 α ∝ (n_wire m ↕ X n m α) ⟷ n_cup_unswapped m. +Proof. colorswap_of Z_n_wrap_over_r_base_unswapped. Qed. + +Lemma X_n_wrap_over_r_base : forall n m α, X (m + n) 0 α ∝ (n_wire m ↕ X n m α) ⟷ n_cup m. +Proof. colorswap_of Z_n_wrap_over_r_base. Qed. + +Lemma X_n_wrap_over_l_base_unswapped : forall n m α, X 0 (n + m) α ∝ n_cap_unswapped n ⟷ (n_wire n ↕ X n m α). +Proof. transpose_of X_n_wrap_over_r_base_unswapped. Qed. + +Lemma X_n_wrap_over_l_base : forall n m α, X 0 (n + m) α ∝ n_cap n ⟷ (n_wire n ↕ X n m α). +Proof. transpose_of X_n_wrap_over_r_base. Qed. + +Lemma X_n_wrap_under_l_base_unswapped : forall n m α, X 0 (m + n) α ∝ n_cap_unswapped n ⟷ (X n m α ↕ n_wire n). +Proof. transpose_of X_n_wrap_under_r_base_unswapped. Qed. + +Lemma X_n_wrap_under_l_base : forall n m α, X 0 (m + n) α ∝ n_cap n ⟷ (X n m α ↕ n_wire n). +Proof. transpose_of X_n_wrap_under_r_base. Qed. + +(* @nocheck name *) +(* PI is captialized in Coq R *) +Lemma X_2_PI : forall n m a, X n m (INR a * 2 * PI) ∝ X n m 0. +Proof. colorswap_of Z_2_PI. Qed. \ No newline at end of file diff --git a/src/CoreRules/ZRules.v b/src/CoreRules/ZRules.v index 4b8d9e4..be56e8c 100644 --- a/src/CoreRules/ZRules.v +++ b/src/CoreRules/ZRules.v @@ -1,7 +1,9 @@ Require Import CoreData.CoreData. Require Import CoreAutomation. +Require Import CapCupRules. Require Import CastRules. Require Import StackComposeRules. +Require Import SwapRules. Require Import WireRules. Require Import SpiderInduction. @@ -26,16 +28,32 @@ Lemma grow_Z_top_right : forall (nIn nOut : nat) α, (Z nIn (S nOut) α) ⟷ ((Z_Spider 1 2 0) ↕ (n_wire nOut)). Proof. intros. - replace α%R with (0 + α)%R at 1 by lra. - rewrite <- Z_spider_1_1_fusion. + apply transpose_diagrams. simpl. - rewrite grow_Z_right_1_2. - rewrite <- compose_assoc. - rewrite Z_spider_1_1_fusion. - replace (0+α)%R with α%R by lra. - reflexivity. + rewrite nstack1_transpose. + rewrite transpose_wire. + apply grow_Z_top_left. +Qed. + +Lemma grow_Z_bot_left : forall n {m o α}, + Z (n + m) o α ∝ + (n_wire n ↕ Z m 1 0) ⟷ Z (n + 1) o α. +Proof. +Admitted. + +Lemma grow_Z_bot_right : forall {n m} o {α}, + Z n (m + o) α ∝ + Z n (m + 1) α ⟷ (n_wire m ↕ Z 1 o 0). +Proof. + intros. + apply transpose_diagrams. + simpl. + rewrite nstack1_transpose. + rewrite transpose_wire. + apply grow_Z_bot_left. Qed. + Lemma Z_rot_l : forall n m α β, Z (S n) m (α + β) ∝ Z 1 1 α ↕ n_wire n ⟷ Z (S n) m β. Proof. @@ -50,7 +68,7 @@ Proof. - simpl. rewrite (grow_Z_top_left n m β). rewrite <- compose_assoc. - rewrite (stack_assoc_back (Z 1 1 α) —). + auto_cast_eqn (rewrite (stack_assoc_back (Z 1 1 α) —)). simpl_casts. rewrite <- (stack_compose_distr (Z 1 1 α ↕ —) (Z 2 1 0) (n_wire n)). cleanup_zx. @@ -95,6 +113,8 @@ Proof. rewrite <- Z_rot_l. rewrite Rplus_0_r. easy. +Unshelve. +all: lia. Qed. Lemma Z_appendix_rot_r : forall n m α β, @@ -163,6 +183,8 @@ Proof. rewrite <- nstack1_split. rewrite <- (grow_Z_top_right n (S m)). easy. +Unshelve. +all: lia. Qed. Lemma Z_wrap_over_top_right : forall n m α, @@ -214,6 +236,8 @@ Proof. rewrite <- nstack1_split. rewrite <- (grow_Z_top_right n (m + o)). easy. +Unshelve. +all: lia. Qed. Lemma Z_add_l : forall n m {o α β γ}, @@ -246,11 +270,10 @@ Proof. rewrite compose_assoc. rewrite <- (compose_assoc ((Z 1 2 0) ↕ (m ↑ —)) ((Z 2 1 0) ↕ (m ↑ —)) - (Z (S m) o β)) . + (Z (S m) o β)). rewrite <- stack_compose_distr. rewrite Z_1_2_1_fusion. rewrite Rplus_0_l. - rewrite Z_0_is_wire. cleanup_zx. apply IHm. Qed. @@ -298,9 +321,9 @@ Lemma dominated_Z_spider_fusion_bot_left : forall m n0 n1 i α β, Z i (n1 + m) (α + β). Proof. intros. transpose_of dominated_Z_spider_fusion_bot_right. Qed. -Lemma Z_spider_fusion_top_left_bot_right : forall top mid bot input output α β, +Lemma Z_spider_fusion_top_left_bot_right : forall top mid bot input output α β prfn prfm, Z input (top + S mid) α ↕ n_wire bot ⟷ - cast (top + (S mid) + bot) (top + output) (eq_sym (Nat.add_assoc _ _ _)) eq_refl + cast (top + (S mid) + bot) (top + output) prfn prfm (n_wire top ↕ Z (S mid + bot) output β) ∝ Z (input + bot) (top + output) (α + β). Proof. @@ -346,11 +369,13 @@ Proof. rewrite <- Z_add_r. replace (α + 0 + β + 0)%R with (α + β)%R by lra. easy. +Unshelve. +all: lia. Qed. -Lemma Z_spider_fusion_bot_left_top_right : forall top mid bot input output α β, +Lemma Z_spider_fusion_bot_left_top_right : forall top mid bot input output α β prfn prfm, ((n_wire top ↕ Z input (S mid + bot) α) ⟷ - cast (top + ((S mid) + bot)) _ ((Nat.add_assoc _ _ _)) eq_refl + cast (top + ((S mid) + bot)) _ prfn prfm (Z (top + (S mid)) output β ↕ n_wire bot)) ∝ Z (top + input) (output + bot) (β + α). Proof. @@ -468,14 +493,11 @@ Proof. intros. transpose_of (@Z_self_swap_absorbtion_right_top m n α). Qed. Lemma Z_self_swap_absorbtion_left : forall {n n' m α}, ((n_wire n' ↕ (⨉ ↕ n_wire n)) ⟷ Z (n' + S (S n)) m α) ∝ Z (n' + S (S n)) m α. Proof. intros. transpose_of (@Z_self_swap_absorbtion_right m n n' α). Qed. -(* @nocheck Z_X *) -Lemma wrap_under_dimension : forall n, (n + 1 + 1 = n + 2)%nat. -Proof. lia. Qed. -Lemma Z_wrap_under_bot_left : forall n m α, +Lemma Z_wrap_under_bot_left : forall n m α prfn prfm, Z n (m + 1) α ∝ (cast n (n + 1 + 1) - (eq_sym (Nat.add_0_r _)) (wrap_under_dimension _) + prfn prfm (n_wire n ↕ ⊂)) ⟷ (Z (n + 1) m α ↕ Wire). Proof. @@ -489,12 +511,10 @@ Proof. eapply (cast_diagrams (n + 0) (m + 1)). repeat rewrite cast_compose_distribute. simpl_casts. - erewrite (@cast_compose_mid (n + 0) (n + 1 + 1) 3 (n + 2) _ ($ n + 0, n + 1 + 1 ::: n_wire n ↕ ⊂ $)). + erewrite (@cast_compose_mid (n + 0) (n + 1 + 1) 3 (n + 2) _ _ ($ n + 0, n + 1 + 1 ::: n_wire n ↕ ⊂ $)). simpl_casts. rewrite <- Z_0_2_0_is_cup. - rewrite wire_to_n_wire at 2. - rewrite wire_to_n_wire at 3. - rewrite n_wire_stack. + bundle_wires. rewrite <- (stack_compose_distr (n_wire n) (Z n 1 0) (Z 0 2 0) (n_wire 2)). @@ -506,6 +526,7 @@ Proof. rewrite wire_to_n_wire at 3. specialize (Z_spider_fusion_bot_left_top_right 1 0 1 0 m 0 α); intros. + specialize (H eq_refl eq_refl). rewrite cast_id in H. rewrite H. clear H. @@ -515,15 +536,329 @@ Proof. rewrite Rplus_0_r. rewrite Rplus_0_l. easy. - Unshelve. - all: lia. +Unshelve. +all: lia. Qed. -Lemma Z_wrap_under_bot_right : forall n m α, +Lemma Z_wrap_under_bot_right : forall n m α prfn prfm, Z (n + 1) m α ∝ (Z n (m + 1) α ↕ —) ⟷ (cast (m + 1 + 1) m - (wrap_under_dimension _) - (eq_sym (Nat.add_0_r _)) + prfn + prfm (n_wire m ↕ ⊃)). -Proof. transpose_of Z_wrap_under_bot_left. Qed. \ No newline at end of file +Proof. transpose_of Z_wrap_under_bot_left. Qed. + +Lemma Z_self_top_to_bottom_absorbtion_right_base : forall n m α, Z n m α ⟷ top_to_bottom m ∝ Z n m α. +Proof. + intros. + destruct m; [ simpl; cleanup_zx; easy | ]. + destruct m; [ simpl; cleanup_zx; easy | ]. + generalize dependent n. + generalize dependent α. + induction m; intros. + - simpl. + cleanup_zx. + simpl_casts. + bundle_wires. + cleanup_zx. + rewrite Z_self_swap_absorbtion_right_base. + easy. + - rewrite top_to_bottom_grow_r. + erewrite <- (@cast_Z n _ ((S (S m)) + 1)). + rewrite Z_add_r_base_rot. + rewrite (cast_compose_mid ((S (S m)) + 1)). + rewrite cast_contract. + simpl_casts. + rewrite compose_assoc. + rewrite cast_compose_l. + simpl_casts. + rewrite <- (compose_assoc (Z 1 (S (S m)) 0 ↕ Z 1 1 0)). + rewrite <- stack_compose_distr. + rewrite IHm. + rewrite wire_removal_r. + rewrite <- compose_assoc. + rewrite <- Z_add_r. + rewrite cast_Z. + rewrite cast_compose_r. + rewrite cast_Z. + rewrite (stack_empty_r_rev ⨉). + replace ⦰ with (n_wire 0) by easy. + rewrite cast_id. + rewrite Z_self_swap_absorbtion_right. + simpl_casts. + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_self_bottom_to_top_absorbtion_right_base : forall n m α, Z n m α ⟷ bottom_to_top m ∝ Z n m α. +Proof. + intros. + destruct m; [ simpl; cleanup_zx; easy | ]. + destruct m; [ simpl; cleanup_zx; easy | ]. + generalize dependent n. + generalize dependent α. + induction m; intros. + - simpl. + unfold bottom_to_top, top_to_bottom. + simpl. + cleanup_zx. + simpl_casts. + bundle_wires. + cleanup_zx. + rewrite Z_self_swap_absorbtion_right_base. + easy. + - rewrite bottom_to_top_grow_r. + erewrite <- (@cast_Z n _ (1 + (S (S m)))). + rewrite Z_add_r_base_rot. + rewrite (cast_compose_mid (1 + (S (S m)))). + rewrite cast_contract. + simpl_casts. + rewrite compose_assoc. + rewrite <- (compose_assoc (Z 1 1 0 ↕ Z 1 (S (S m)) 0)). + rewrite <- stack_compose_distr. + rewrite IHm. + rewrite wire_removal_r. + rewrite <- compose_assoc. + rewrite <- Z_add_r. + rewrite <- (stack_empty_l ⨉). + replace ⦰ with (n_wire 0) by easy. + rewrite <- (@cast_Z n _ (0 + (S (S (S m))))). + rewrite cast_compose_l. + rewrite (stack_assoc (n_wire 0) ⨉ (n_wire _)). + simpl_casts. + rewrite Z_self_swap_absorbtion_right. + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_a_swap_absorbtion_right_base : forall n m α, Z n m α ⟷ a_swap m ∝ Z n m α. +Proof. + intros. + destruct m; [ simpl; cleanup_zx; easy | ]. + destruct m; [ simpl; cleanup_zx; easy | ]. + Local Opaque top_to_bottom. + simpl. + rewrite <- compose_assoc. + rewrite (Z_self_bottom_to_top_absorbtion_right_base n (S (S m)) α). + rewrite <- (@cast_Z n _ (1 + (S m))) at 1. + rewrite Z_add_r_base_rot at 1. + simpl_casts. + rewrite compose_assoc. + rewrite <- (stack_compose_distr (Z 1 1 0) —). + rewrite Z_self_top_to_bottom_absorbtion_right_base. + rewrite wire_removal_r. + rewrite <- (Z_add_r_base_rot 1 (S m)). + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_n_swap_absorbtion_right_base : forall n m α, Z n m α ⟷ n_swap m ∝ Z n m α. +Proof. + intros n m. + generalize dependent n. + strong induction m. + intros. + destruct m; [ simpl; cleanup_zx; easy | ]. + destruct m; [ simpl; cleanup_zx; easy | ]. + simpl. + rewrite <- compose_assoc. + rewrite (Z_self_bottom_to_top_absorbtion_right_base n (S (S m)) α). + rewrite <- (@cast_Z n _ (1 + (S m))) at 1. + rewrite Z_add_r_base_rot at 1. + simpl_casts. + rewrite compose_assoc. + rewrite <- (stack_compose_distr (Z 1 1 0) —). + rewrite <- compose_assoc. + rewrite (Z_self_bottom_to_top_absorbtion_right_base). + rewrite <- (@cast_Z 1 _ (1 + m) (S m)). + rewrite Z_add_r_base_rot. + simpl_casts. + rewrite compose_assoc. + rewrite <- (stack_compose_distr (Z 1 1 0) —). + rewrite (H m); [ | lia ]. + rewrite wire_removal_r. + rewrite <- (Z_add_r_base_rot 1 m). + rewrite <- (Z_add_r_base_rot 1 (1 + m)). + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_n_wrap_under_r_base_unswapped : forall n m α, Z (n + m) 0 α ∝ (Z n m α ↕ n_wire m) ⟷ n_cup_unswapped m. +Proof. + intros. + generalize dependent n. + generalize dependent α. + induction m; intros; [simpl; cleanup_zx; simpl_casts; subst; easy | ]. + remember (Z (n + (S m)) _ _) as LHS. + rewrite n_cup_unswapped_grow_l. + rewrite <- (@cast_Z n _ (m + 1)). + rewrite Z_add_r_base_rot. + simpl_casts. + rewrite <- compose_assoc. + simpl. + rewrite cast_compose_r. + simpl_casts. + rewrite (cast_compose_l _ _ (Z n 2 α ⟷ (Z 1 m 0 ↕ Z 1 1 0) ↕ n_wire S m)). + simpl_casts. + rewrite stack_assoc. + rewrite stack_nwire_distribute_r. + rewrite (stack_assoc (Z 1 m 0) _ (n_wire (S m))). + simpl_casts. + rewrite compose_assoc. + simpl. + rewrite (stack_assoc_back (Z 1 1 0) — (n_wire m)). + simpl_casts. + erewrite <- cast_compose_mid_contract. + simpl_casts. + erewrite <- (@cast_id (2 + m) (2 + m) _ _ (Z 1 1 0 ↕ — ↕ (n_wire m))). + rewrite <- (stack_compose_distr (Z 1 m 0) (n_wire m) _ (⊃ ↕ n_wire m)). + simpl_casts. + cleanup_zx. + rewrite <- (stack_compose_distr (— ↕ —) ⊃ (n_wire m) (n_wire m)). + bundle_wires. + cleanup_zx. + rewrite cast_compose_r. + simpl_casts. + simpl. + rewrite (stack_assoc_back _ —). + rewrite (stack_assoc_back _ ⊃ (n_wire m)). + rewrite <- cast_compose_mid_contract. + rewrite <- stack_nwire_distribute_r. + rewrite <- (nwire_stack_compose_botleft (Z 1 m 0) ⊃). + simpl. + cleanup_zx; simpl_casts. + rewrite <- compose_assoc. + rewrite stack_assoc_back. + simpl_casts. + rewrite cast_compose_r. + simpl_casts. + rewrite <- stack_wire_distribute_r. + rewrite <- Z_0_is_wire at 1. + rewrite <- Z_add_r_base_rot. + erewrite (cast_compose_l _ _ (Z _ _ _ ↕ —)). + erewrite (cast_compose_partial_contract_r _ _ _ m _ _ _ _ _ _ _ (n_wire m ↕ ⊃)). + rewrite <- (@Z_wrap_under_bot_right n m α). + simpl_casts. + eapply (cast_diagrams (n + 1 + m) 0). + erewrite <- (@cast_Z (n + 1) _ (m) (m + 0)). + rewrite cast_stack_l. + rewrite (cast_compose_mid (m + m)). + rewrite 2 cast_contract. + rewrite <- cast_compose_mid_contract. + rewrite <- IHm. + rewrite HeqLHS. + simpl_casts. + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_n_wrap_under_r_base : forall n m α, Z (n + m) 0 α ∝ (Z n m α ↕ n_wire m) ⟷ n_cup m. +Proof. + intros. + unfold n_cup. + rewrite <- compose_assoc. + rewrite <- stack_nwire_distribute_r. + rewrite Z_n_swap_absorbtion_right_base. + rewrite Z_n_wrap_under_r_base_unswapped. + easy. +Qed. + +Lemma Z_n_wrap_over_r_base_unswapped : forall n m α, Z (m + n) 0 α ∝ (n_wire m ↕ Z n m α) ⟷ n_cup_unswapped m. +Proof. + intros. + generalize dependent n. + generalize dependent α. + induction m; intros; [simpl; cleanup_zx; simpl_casts; subst; easy | ]. + remember (Z (S m + n) 0 α) as LHS. + rewrite n_cup_unswapped_grow_l. + rewrite <- (@cast_Z n _ (1 + m)). + rewrite Z_add_r_base_rot. + simpl_casts. + rewrite stack_nwire_distribute_l. (* TODO: rename *) + rewrite n_wire_grow_r at 2. + rewrite <- compose_assoc. + rewrite (compose_assoc (n_wire (S m) ↕ Z n 2 α)). + rewrite cast_stack_l. + rewrite 2 stack_assoc. + simpl_casts. + erewrite <- (cast_compose_mid_contract (S m + 2) (S m + S m) (m + m) _ _ _ _ _ _ (n_wire m ↕ (— ↕ (Z 1 1 0 ↕ Z 1 m 0))) (n_wire m ↕ (⊃ ↕ n_wire m))). + rewrite <- stack_nwire_distribute_l. + rewrite stack_assoc_back. + simpl_casts. + rewrite <- (stack_compose_distr (— ↕ (Z 1 1 0)) ⊃ (Z 1 m 0)). + rewrite (stack_empty_r_rev ⊃). + simpl_casts. + replace ⦰ with (n_wire 0) by easy. + rewrite <- (Z_wrap_over_top_left 1 0). + cleanup_zx. + rewrite Z_2_0_0_is_cap. + rewrite n_wire_grow_r. + rewrite cast_stack_l. + rewrite stack_assoc. + simpl_casts. + erewrite (cast_compose_mid (m + 3) _ _ (cast _ _ _ _ _) (cast _ _ _ _ (n_wire m ↕ (⊃ ↕ Z 1 m 0)))). + rewrite cast_contract. + rewrite cast_contract. + rewrite <- cast_compose_mid_contract. + rewrite <- stack_compose_distr. + cleanup_zx. + rewrite <- (nwire_stack_compose_botleft ⊃ (Z 1 m 0)). + rewrite <- compose_assoc. + rewrite <- (Z_wrap_over_top_left n 1). + simpl. + cleanup_zx. + rewrite Z_spider_1_1_fusion. + eapply (cast_diagrams (m + (S n)) 0). + rewrite cast_compose_l. + simpl_casts. + rewrite <- IHm. + replace (α + 0)%R with α by lra. + rewrite HeqLHS. + simpl_casts. + easy. +Unshelve. + all: lia. +Qed. + +Lemma Z_n_wrap_over_r_base : forall n m α, Z (m + n) 0 α ∝ (n_wire m ↕ Z n m α) ⟷ n_cup m. +Proof. + intros. + rewrite n_cup_inv_n_swap_n_wire. + rewrite <- compose_assoc. + rewrite <- stack_nwire_distribute_l. + rewrite Z_n_swap_absorbtion_right_base. + rewrite Z_n_wrap_over_r_base_unswapped. + easy. +Qed. + +Lemma Z_n_wrap_over_l_base_unswapped : forall n m α, Z 0 (n + m) α ∝ n_cap_unswapped n ⟷ (n_wire n ↕ Z n m α). +Proof. transpose_of Z_n_wrap_over_r_base_unswapped. Qed. + +Lemma Z_n_wrap_over_l_base : forall n m α, Z 0 (n + m) α ∝ n_cap n ⟷ (n_wire n ↕ Z n m α). +Proof. transpose_of Z_n_wrap_over_r_base. Qed. + +Lemma Z_n_wrap_under_l_base_unswapped : forall n m α, Z 0 (m + n) α ∝ n_cap_unswapped n ⟷ (Z n m α ↕ n_wire n). +Proof. transpose_of Z_n_wrap_under_r_base_unswapped. Qed. + +Lemma Z_n_wrap_under_l_base : forall n m α, Z 0 (m + n) α ∝ n_cap n ⟷ (Z n m α ↕ n_wire n). +Proof. transpose_of Z_n_wrap_under_r_base. Qed. + +(* @nocheck name *) +(* PI is captialized in Coq R *) +Lemma Z_2_PI : forall n m a, Z n m (INR a * 2 * PI) ∝ Z n m 0. +Proof. + intros. + prop_exists_nonzero 1. + Msimpl. + simpl. + unfold Z_semantics. + rewrite Cexp_2_PI. + rewrite Cexp_0. + easy. +Qed. \ No newline at end of file diff --git a/src/CoreRules/ZXRules.v b/src/CoreRules/ZXRules.v index e5f97be..f1afa10 100644 --- a/src/CoreRules/ZXRules.v +++ b/src/CoreRules/ZXRules.v @@ -8,15 +8,15 @@ Require Export CoreRules.XRules. -Theorem X_state_copy : forall (r n : nat), +Theorem X_state_copy : forall (r n : nat) prfn prfm, (X 0 1 ((INR r) * PI) ⟷ Z 1 n 0) ∝ - cast 0%nat n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (X 0 1 ((INR r) * PI))). + cast 0%nat n prfn prfm (n ⇑ (X 0 1 ((INR r) * PI))). Proof. intros. assert (X_state_copy_ind : (X 0 1 (INR r * PI) ⟷ Z 1 2 0) ∝ X 0 1 (INR r * PI) ↕ X 0 1 (INR r * PI)). { - prop_exists_nonzero (/ √ 2); Msimpl; simpl. + prop_exists_nonzero (/ (√ 2)%R); Msimpl; simpl. unfold X_semantics; unfold Z_semantics. simpl. solve_matrix. all: autorewrite with Cexp_db. @@ -27,7 +27,7 @@ Proof. induction n; [| destruct n]. - simpl. simpl_casts. - prop_exists_nonzero (√ 2); Msimpl; simpl. + prop_exists_nonzero (√ 2)%R; Msimpl; simpl. unfold X_semantics; unfold Z_semantics. simpl. solve_matrix. @@ -67,9 +67,9 @@ Proof. all: lia. Qed. -Theorem Z_state_copy : forall (r n : nat), +Theorem Z_state_copy : forall (r n : nat) prfn prfm, (Z 0 1 ((INR r) * PI) ⟷ X 1 n 0) ∝ - cast 0%nat n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (Z 0 1 ((INR r) * PI))). + cast 0%nat n prfn prfm (n ⇑ (Z 0 1 ((INR r) * PI))). Proof. intros. eapply (cast_diagrams (n * 0) (n * 1)). @@ -93,9 +93,9 @@ Proof. all: lia. Qed. -Theorem X_state_pi_copy : forall n, +Theorem X_state_pi_copy : forall n prfn prfm, ((X 0 1 PI) ⟷ Z 1 n 0) ∝ - (cast 0 n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (X 0 1 PI))). + (cast 0 n prfn prfm (n ⇑ (X 0 1 PI))). Proof. intros. replace (PI)%R with (1 * PI)%R by lra. @@ -104,9 +104,9 @@ Proof. easy. Qed. -Theorem X_state_0_copy : forall n, +Theorem X_state_0_copy : forall n prfn prfm, ((X 0 1 0) ⟷ Z 1 n 0) ∝ - (cast 0 n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (X 0 1 0))). + (cast 0 n prfn prfm (n ⇑ (X 0 1 0))). Proof. intros. replace (0)%R with (0 * PI)%R at 1 by lra. @@ -116,9 +116,9 @@ Proof. easy. Qed. -Theorem Z_state_pi_copy : forall n, +Theorem Z_state_pi_copy : forall n prfn prfm, ((Z 0 1 PI) ⟷ X 1 n 0) ∝ - (cast 0 n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (Z 0 1 PI))). + (cast 0 n prfn prfm (n ⇑ (Z 0 1 PI))). Proof. intros. replace (PI)%R with (1 * PI)%R by lra. @@ -127,9 +127,9 @@ Proof. easy. Qed. -Theorem Z_state_0_copy : forall n, +Theorem Z_state_0_copy : forall n prfn prfm, ((Z 0 1 0) ⟷ X 1 n 0) ∝ - (cast 0 n (mult_n_O _) (eq_sym (Nat.mul_1_r _)) (n ⇑ (Z 0 1 0))). + (cast 0 n prfn prfm (n ⇑ (Z 0 1 0))). Proof. intros. replace (0)%R with (0 * PI)%R at 1 by lra. @@ -139,12 +139,10 @@ Proof. easy. Qed. -Lemma Z_copy : forall n r, +Lemma Z_copy : forall n r prfn prfm, (Z 1 1 (INR r * PI) ⟷ X 1 n 0) ∝ X 1 n 0 ⟷ - (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + (cast n n prfn prfm (n ⇑ (Z 1 1 (INR r * PI)))). Proof. intros. @@ -162,7 +160,7 @@ Proof. eapply (cast_diagrams 1 (n * 1)). rewrite 2 cast_compose_distribute. simpl_casts. - erewrite (@cast_compose_mid _ _ _ (n * 1) _ (X 1 n 0)). + erewrite (@cast_compose_mid _ _ _ (n * 1)%nat _ _ (X 1 n 0)). simpl_casts. induction n; [ | destruct n]. - simpl. @@ -193,12 +191,11 @@ Proof. all: lia. Qed. -Lemma X_copy : forall n r, +Lemma X_copy : forall n r prfn prfm, (X 1 1 (INR r * PI) ⟷ Z 1 n 0) ∝ Z 1 n 0 ⟷ (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + prfn prfm (n ⇑ (X 1 1 (INR r * PI)))). Proof. intros. @@ -210,12 +207,10 @@ Proof. apply Z_copy. Qed. -Lemma Z_0_copy : forall n, +Lemma Z_0_copy : forall n prfn prfm, (Z 1 1 0 ⟷ X 1 n 0) ∝ X 1 n 0 ⟷ - (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + (cast n n prfn prfm (n ⇑ (Z 1 1 0))). Proof. intros. @@ -226,12 +221,10 @@ Proof. apply H. Qed. -Lemma Z_pi_copy : forall n, +Lemma Z_pi_copy : forall n prfn prfm, (Z 1 1 PI ⟷ X 1 n 0) ∝ X 1 n 0 ⟷ - (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + (cast n n prfn prfm (n ⇑ (Z 1 1 PI))). Proof. intros. @@ -242,12 +235,10 @@ Proof. apply H. Qed. -Lemma X_0_copy : forall n, +Lemma X_0_copy : forall n prfn prfm, (X 1 1 0 ⟷ Z 1 n 0) ∝ Z 1 n 0 ⟷ - (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + (cast n n prfn prfm (n ⇑ (X 1 1 0))). Proof. intros. @@ -258,12 +249,10 @@ Proof. apply H. Qed. -Lemma X_pi_copy : forall n, +Lemma X_pi_copy : forall n prfn prfm, (X 1 1 PI ⟷ Z 1 n 0) ∝ Z 1 n 0 ⟷ - (cast n n - (eq_sym (Nat.mul_1_r _)) - (eq_sym (Nat.mul_1_r _)) + (cast n n prfn prfm (n ⇑ (X 1 1 PI))). Proof. intros. @@ -272,4 +261,4 @@ Proof. simpl in H. rewrite Rmult_1_l in H. apply H. -Qed. +Qed. \ No newline at end of file diff --git a/src/DiagramRules/Bell.v b/src/DiagramRules/Bell.v new file mode 100644 index 0000000..f65d316 --- /dev/null +++ b/src/DiagramRules/Bell.v @@ -0,0 +1,104 @@ +Require Import CoreData. +Require Import CoreRules. + +Definition bell_state_prep := + (((X 0 1 0) ↕ (X 0 1 0)) ⟷ (□ ↕ —) ⟷ + ((Z 1 2 0 ↕ —) ⟷ (— ↕ X 2 1 0))). + +Lemma bell_state_prep_correct : bell_state_prep ∝ ⊂. +Proof. + unfold bell_state_prep. + rewrite <- stack_compose_distr. + assert (X 0 1 0 ⟷ □ ∝ Z 0 1 0) as H. + { + replace (X 0 1 0) with (⊙ (Z 0 1 0)) at 1 by easy. + rewrite colorswap_is_bihadamard; simpl; cleanup_zx; simpl_casts. + rewrite compose_assoc; cleanup_zx; easy. + } + rewrite H; cleanup_zx. + rewrite <- compose_assoc. + rewrite <- (stack_compose_distr (Z 0 1 0) (Z 1 2 0) (X 0 1 0) —); cleanup_zx. + rewrite Z_spider_1_1_fusion. + rewrite <- nwire_stack_compose_botleft. + rewrite compose_assoc. + rewrite <- (n_wire_stack 1 1); rewrite wire_to_n_wire at 4. + rewrite (stack_assoc (n_wire 1) (n_wire 1)); simpl_casts. + rewrite <- (stack_compose_distr (n_wire 1) (n_wire 1) (n_wire 1 ↕ X 0 1 0)). + rewrite (dominated_X_spider_fusion_bot_right 0 0 1). + cleanup_zx; simpl_casts. + rewrite Rplus_0_r; rewrite X_0_is_wire. + bundle_wires; cleanup_zx. + rewrite <- cap_Z. + easy. +Unshelve. +all: lia. +Qed. + +Definition teleportation (a b : nat) := + (⊂ ↕ Z 1 2 0) ⟷ ((X 1 1 (INR b * PI) ⟷ Z 1 1 (INR a * PI)) ↕ (((X 2 1 0) ↕ (Z 1 0 (INR a * PI)) ⟷ (□ ⟷ Z 1 0 (INR b * PI))))). + +Lemma teleportation_correct : forall a b, teleportation a b ∝ —. +Proof. + intros; unfold teleportation. + assert (□ ⟷ Z 1 0 (INR b * PI) ∝ (X 1 0 (INR b * PI))). + { + replace (X 1 0 (INR b * PI)) with (⊙ (Z 1 0 (INR b * PI))) by easy. + rewrite colorswap_is_bihadamard. + simpl; cleanup_zx; simpl_casts. + easy. + } + rewrite H. + rewrite (stack_empty_r_rev (X 1 0 _)). + simpl_casts. + rewrite <- (stack_compose_distr (X 2 1 0) (X 1 0 _) (Z 1 0 _) ⦰). + rewrite X_spider_1_1_fusion. + cleanup_zx. + rewrite (stack_assoc_back (X 1 1 _ ⟷ Z 1 1 _) (X 2 0 _) (Z 1 0 _)). + simpl_casts. + rewrite <- (nwire_removal_l (X 2 0 _)). + simpl; rewrite stack_empty_r; simpl_casts. + rewrite stack_compose_distr. + rewrite (stack_assoc_back (X 1 1 _) — —). + simpl_casts. + rewrite <- (compose_empty_r (Z 1 0 _)). + rewrite stack_compose_distr. + rewrite <- compose_assoc. + rewrite (stack_assoc (X 1 1 _ ↕ —) — (Z 1 0 _)). + simpl_casts. + rewrite <- (stack_compose_distr ⊂ (X 1 1 _ ↕ —) (Z 1 2 0) (— ↕ Z 1 0 _)). + rewrite cap_X. + rewrite wire_to_n_wire at 1 2. + rewrite (dominated_X_spider_fusion_top_left 1 0). + rewrite (dominated_Z_spider_fusion_bot_left 0 0 1). + rewrite <- (nwire_removal_l (Z 1 1 _)). + rewrite <- (nwire_removal_r (X 2 0 _)). + rewrite stack_compose_distr. + replace (0 + INR b * PI)%R with ((INR b * PI) + 0 +0)%R by lra. + rewrite (X_add_l 1 1). + rewrite stack_nwire_distribute_l. + rewrite (stack_assoc_back (n_wire 1) (X 1 1 _)). + rewrite stack_empty_r. + simpl_casts. + rewrite compose_assoc. + rewrite <- (compose_assoc (X 0 (1 + 1) _ ↕ Z 1 (1 + 0) _)). + rewrite <- (stack_compose_distr (X 0 (1 + 1) _) (n_wire 1 ↕ X 1 1 _) (Z 1 (1 + 0) _) (X 1 1 _)). + rewrite (dominated_X_spider_fusion_bot_left 1 0). + replace ((INR b * PI + (INR b * PI + 0)))%R with (INR b * 2 * PI)%R by lra. + rewrite X_2_PI. + rewrite X_0_is_wire. + rewrite <- (nwire_removal_l (X 0 _ _)). + rewrite <- cap_X, <- cup_X. + rewrite stack_compose_distr. + rewrite <- wire_to_n_wire. + repeat rewrite <- compose_assoc. + rewrite (compose_assoc (n_wire 0 ↕ Z 1 (1 + 0) (INR a * PI + 0))). + rewrite yank_r. + cleanup_zx; simpl_casts. + rewrite Z_spider_1_1_fusion. + replace (INR a * PI + 0 + INR a * PI)%R with ((INR a * 2 * PI))%R by lra. + rewrite Z_2_PI. + rewrite Z_0_is_wire. + easy. +Unshelve. +all: lia. +Qed. \ No newline at end of file diff --git a/src/DiagramRules/Bialgebra.v b/src/DiagramRules/Bialgebra.v index b226c95..f282b22 100644 --- a/src/DiagramRules/Bialgebra.v +++ b/src/DiagramRules/Bialgebra.v @@ -127,8 +127,14 @@ Opaque n_stack1. Transparent n_stack1. fold bi_alg_Z_X. rewrite <- bi_algebra_rule_Z_X. - assert (X_Wrap_Under_L_base : forall α, X 2 1 α ∝ (X 1 2 α ↕ —) ⟷ (— ↕ ⊃)) by admit. - (* TODO : resurect and make X rules *) + assert (X_Wrap_Under_L_base : forall α, X 2 1 α ∝ (X 1 2 α ↕ —) ⟷ (— ↕ ⊃)). + { + intros. + rewrite (X_wrap_under_bot_right 1). + simpl_casts. + rewrite <- wire_to_n_wire. + easy. + } rewrite X_Wrap_Under_L_base. repeat rewrite <- compose_assoc. rewrite <- stack_wire_distribute_r. @@ -169,7 +175,9 @@ Transparent n_stack1. rewrite compose_assoc. rewrite Hr. easy. -Admitted. +Unshelve. +all: lia. +Qed. Theorem hopf_rule_X_Z : (X_Spider 1 2 0) ⟷ (Z_Spider 2 1 0) ∝ (X_Spider 1 0 0) ⟷ (Z_Spider 0 1 0). diff --git a/src/DiagramRules/Completeness.v b/src/DiagramRules/Completeness.v new file mode 100644 index 0000000..34341ce --- /dev/null +++ b/src/DiagramRules/Completeness.v @@ -0,0 +1,695 @@ +Require Import CoreData. +From QuantumLib Require Import Polar. +Require Import CoreRules. +Require Import CompletenessComp. + +(* @nocheck name *) +(* Conventional name *) +Lemma completeness_SUP : forall α, ((Z 0 1 α) ↕ (Z 0 1 (α + PI))) ⟷ (X 2 1 0) ∝ Z 0 2 (2 *α + PI) ⟷ X 2 1 0. +Proof. + intros. + prop_exists_nonzero 1; + simpl; + unfold X_semantics. + solve_matrix. + - C_field_simplify; [ | split; nonzero ]. + repeat rewrite Cexp_add. + autorewrite with Cexp_db. + C_field_simplify. + repeat rewrite <- Cexp_add. + replace ((R1 + R1)%R, (R0 + R0)%R) with C2 by lca. + apply Cplus_simplify; try easy. + rewrite <- 3 Cmult_assoc. + apply Cmult_simplify; try easy. + rewrite Cmult_assoc. + rewrite <- Cexp_add. + replace (α + α)%R with (2 * α)%R by lra. + lca. + - C_field_simplify; [ | split; nonzero ]. + repeat rewrite Cexp_add. + autorewrite with Cexp_db. + C_field_simplify. + repeat rewrite <- Cexp_add. + lca. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma completeness_C : forall (α β γ : R), + (Z 1 2 0) ⟷ (((Z 0 1 β ↕ —) ⟷ X 2 1 PI) ↕ ((Z 0 1 α ↕ —) ⟷ X 2 1 0)) ⟷ ((Z 1 2 β ↕ Z 1 2 α) ⟷ (— ↕ X 2 1 γ ↕ —)) ⟷ (((— ↕ Z 1 2 0) ⟷ (X 2 1 (-γ) ↕ —)) ↕ —) + ∝ + (Z 1 2 0) ⟷ (((Z 0 1 α ↕ —) ⟷ X 2 1 0) ↕ ((Z 0 1 β ↕ —) ⟷ X 2 1 PI)) ⟷ ((Z 1 2 α ↕ Z 1 2 β) ⟷ (— ↕ X 2 1 (-γ) ↕ —)) ⟷ (— ↕ ((Z 1 2 0 ↕ —) ⟷ (— ↕ X 2 1 γ))). +Proof. (* solve matrix takes forever *) + intros. + remember ((Z 0 1 α ↕ —) ⟷ X 2 1 0) as cs1. + remember ((Z 0 1 β ↕ —) ⟷ X 2 1 PI) as cs1pi. + remember (((Z 1 2 β ↕ Z 1 2 α) ⟷ (— ↕ X 2 1 γ ↕ —))) as cs2. + remember (((Z 1 2 α ↕ Z 1 2 β) ⟷ (— ↕ X 2 1 (-γ) ↕ —))) as cs2n. + remember ((Z 1 2 0 ↕ —) ⟷ (— ↕ X 2 1 γ)) as cs3. + remember (((— ↕ Z 1 2 0) ⟷ (X 2 1 (-γ) ↕ —))) as cs3f. + prop_exists_nonzero 1. + simpl. + rewrite Heqcs1. + rewrite Heqcs1pi. + clear Heqcs1; clear Heqcs1pi; clear cs1; clear cs1pi. + rewrite c_step_1, c_step_1_pi. + autorewrite with scalar_move_db. + rewrite Cmult_1_l. + apply Mscale_simplify; [| C_field]. + replace ((Cexp β .* ∣0⟩⟨0∣ .+ ∣0⟩⟨1∣ .+ ∣1⟩⟨0∣ .+ Cexp β .* ∣1⟩⟨1∣)) with (Cexp β .* (I 2) .+ ∣0⟩⟨1∣ .+ ∣1⟩⟨0∣) by (rewrite <- Mplus01; lma). + replace ((∣0⟩⟨0∣ .+ Cexp α .* ∣0⟩⟨1∣ .+ Cexp α .* ∣1⟩⟨0∣ .+ ∣1⟩⟨1∣)) with (I 2 .+ Cexp α .* (∣0⟩⟨1∣ .+ ∣1⟩⟨0∣)) by (rewrite <- Mplus01; lma). + fold (⟦ Z 1 2 0 ⟧). + rewrite (ZX_semantic_equiv _ _ (Z 1 2 0)). + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + restore_dims. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite <- (Mmult_assoc _ _ ⟨0∣). + repeat rewrite <- (Mmult_assoc _ _ ⟨1∣). + rewrite 2 (kron_mixed_product _ _ ∣0⟩ ∣0⟩). + rewrite 2 (kron_mixed_product _ _ ∣1⟩ ∣1⟩). + autorewrite with scalar_move_db. + restore_dims. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_r. + Msimpl. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + Msimpl. + repeat rewrite <- Mmult_plus_distr_l. + remember (Cexp β .* ∣0⟩ .+ ∣1⟩) as b0p1. + remember (Cexp β .* ∣1⟩ .+ ∣0⟩) as b1p0. + remember (∣0⟩ .+ Cexp α .* ∣1⟩) as a1p0. + remember (∣1⟩ .+ Cexp α .* ∣0⟩) as a0p1. + rewrite Heqcs2. + rewrite Heqcs2n. + rewrite 2 c_step_2. + restore_dims. + autorewrite with scalar_move_db. + apply Mscale_simplify; [| lca]. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite <- (Mmult_assoc _ _ ⟨0∣). + repeat rewrite <- (Mmult_assoc _ _ ⟨1∣). + restore_dims. + repeat rewrite (kron_mixed_product). + replace (⟨0∣ × b0p1) with (Cexp β .* I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨0∣ × b1p0) with (I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨1∣ × b0p1) with (I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨1∣ × b1p0) with (Cexp β .* I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨0∣ × a0p1) with (Cexp α .* I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨0∣ × a1p0) with (I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨1∣ × a0p1) with (I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + replace (⟨1∣ × a1p0) with (Cexp α .* I 1) by (subst; rewrite Mmult_plus_distr_l; autorewrite with scalar_move_db; autorewrite with ketbra_mult_db; lma). + autorewrite with scalar_move_db. + Msimpl. + restore_dims. + repeat rewrite <- Mscale_mult_dist_r. + repeat rewrite Mmult_assoc. + repeat rewrite <- Mmult_plus_distr_l. + restore_dims. + repeat rewrite kron_assoc by auto with wf_db. + remember (Cexp β .* ⟨0∣ .+ Cexp α .* ⟨1∣) as b0a1. + remember (Cexp α .* ⟨0∣ .+ Cexp β .* ⟨1∣) as a0b1. + rewrite (Cmult_comm (Cexp β)). + remember (⟨0∣ .+ Cexp α * Cexp β .* ⟨1∣) as p0ab1. + remember (Cexp α * Cexp β .* ⟨0∣ .+ ⟨1∣) as ab0p1. + autorewrite with scalar_move_db. + repeat rewrite <- kron_assoc by auto with wf_db. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite <- Mmult_assoc. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite kron_assoc by auto with wf_db. + repeat rewrite <- Mmult_assoc. + restore_dims. + repeat rewrite kron_mixed_product. + Msimpl. + assert (comp_0p : (⟦ cs3f ⟧) × (∣0⟩ ⊗ ∣+⟩) = / C2 .* ((∣+⟩ ⊗ ∣+⟩ .+ Cexp (- γ) .* (∣-⟩ ⊗ ∣-⟩)))). + { + subst. + rewrite c_step_3_flipped. + rewrite Mmult_assoc. + rewrite <- notc_decomposition. + rewrite Mmult_plus_distr_r. + repeat rewrite kron_mixed_product. + Msimpl. + rewrite MmultX0. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + rewrite kron_plus_distr_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace (- / (√ 2)%R) with (/ (√2)%R * -1) by (C_field_simplify; [lca | C_field]). + rewrite <- (Mscale_assoc _ _ _ (-1)). + autorewrite with scalar_move_db. + replace (∣+⟩ ⊗ ∣1⟩ .+ ∣+⟩ ⊗ ∣0⟩) with ((√2)%R .* ∣+⟩⊗∣+⟩) by (rewrite xbasis_plus_spec at 2; autorewrite with scalar_move_db; rewrite Cinv_l by C_field; lma). + replace ((-1 .* (∣-⟩ ⊗ ∣1⟩) .+ ∣-⟩ ⊗ ∣0⟩)) with ((√2)%R .* ∣-⟩⊗∣-⟩) by (rewrite xbasis_minus_spec at 2; autorewrite with scalar_move_db; rewrite Cinv_l by C_field; lma). + autorewrite with scalar_move_db. + rewrite <- Cmult_assoc. + repeat rewrite Cinv_l by C_field. + Msimpl. + rewrite Cmult_1_r. + rewrite Cinv_sqrt2_sqrt. + easy. + } + Msimpl. + rewrite Heqcs3f. + rewrite c_step_3_flipped. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + rewrite <- notc_decomposition. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite kron_mixed_product. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + rewrite MmultX0. + rewrite MmultX1. + replace (- / (√ 2)%R) with (/(√2)%R * -1) by (C_field_simplify; [lca | C_field]). + repeat rewrite <- Mscale_assoc. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace (Cexp (- γ) * - / (√ 2)%R) with (/ (√ 2)%R * - Cexp (- γ)) by lca. + replace (Cexp (- γ) * / (√ 2)%R) with (/ (√ 2)%R * Cexp (- γ)) by lca. + repeat rewrite <- Mscale_assoc. + autorewrite with scalar_move_db. + replace (-1 * / (√ 2)%R) with (/ (√ 2)%R * -1) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (-1)). + autorewrite with scalar_move_db. + replace (- Cexp γ * / (√ 2)%R * / (√ 2)%R * / (√ 2)%R) with (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R * - Cexp γ) by lca. + replace (Cexp γ * / (√ 2)%R * / (√ 2)%R * / (√ 2)%R) with (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R * Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (Cexp γ)). + repeat rewrite <- (Mscale_assoc _ _ _ (- Cexp γ)). + autorewrite with scalar_move_db. + repeat rewrite (Cmult_comm _ ((/ (√ 2)%R * / (√ 2)%R) * / (√ 2)%R)). + repeat rewrite <- (Mscale_assoc _ _ ((/ (√ 2)%R * / (√ 2)%R) * / (√ 2)%R)). + autorewrite with scalar_move_db. + remember (∣+⟩ .+ Cexp (- γ) .* ∣-⟩) as pcngm. + remember (∣+⟩ .+ - Cexp (- γ) .* ∣-⟩) as pncngm. + repeat rewrite <- (Mscale_mult_dist_l _ _ _ (Cexp _)). + repeat rewrite <- (Mscale_mult_dist_l _ _ _ (- Cexp _)). + repeat rewrite <- (Mscale_mult_dist_l _ _ _ (Cexp α * _)). + restore_dims. + repeat rewrite <- Mscale_kron_dist_l. + repeat rewrite <- Mmult_plus_distr_r. + repeat rewrite <- kron_plus_distr_r. + rewrite Heqcs3, c_step_3. + autorewrite with Cexp_db. + repeat rewrite Mmult_assoc. + rewrite <- cnot_decomposition. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite kron_mixed_product. + rewrite MmultX0, MmultX1. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace (Cexp γ * - / (√ 2)%R) with (/(√2)%R * - Cexp γ) by lca. + replace (Cexp γ * / (√ 2)%R) with (/(√2)%R * Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (Cexp γ)). + repeat rewrite <- (Mscale_assoc _ _ _ (- Cexp γ)). + autorewrite with scalar_move_db. + replace (- / (√ 2)%R * / (√ 2)%R) with (/ (√ 2)%R * / (√ 2)%R * -1) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (-1)). + autorewrite with scalar_move_db. + replace (/ (√ 2)%R * - / Cexp γ * (/ (√ 2)%R * / (√ 2)%R)) with (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R * (- / Cexp γ)) by lca. + replace (/ (√ 2)%R * / Cexp γ * (/ (√ 2)%R * / (√ 2)%R)) with (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R * / Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (/ Cexp γ)). + repeat rewrite <- (Mscale_assoc _ _ _ (- / Cexp γ)). + autorewrite with scalar_move_db. + repeat rewrite <- (Mscale_assoc _ _ _ (/ Cexp γ)). + repeat rewrite <- (Mscale_assoc _ _ _ (- / Cexp γ)). + autorewrite with scalar_move_db. + replace (Cexp α * (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R)) with ((/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R) * Cexp α) by lca. + replace (Cexp β * (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R)) with ((/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R) * Cexp β) by lca. + replace (Cexp α * Cexp β * (/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R)) with ((/ (√ 2)%R * / (√ 2)%R * / (√ 2)%R) * Cexp α * Cexp β) by lca. + repeat rewrite <- (Mscale_assoc _ _ _ (Cexp _)). + autorewrite with scalar_move_db. + apply Mscale_simplify; [|lca]. + remember (∣+⟩ .+ - Cexp γ .* ∣-⟩) as pncgm. + remember (∣+⟩ .+ Cexp γ .* ∣-⟩) as pcgm. + rewrite <- Cexp_neg. + repeat rewrite <- Mscale_mult_dist_l. + repeat rewrite <- Mmult_plus_distr_r. + replace (pncngm ⊗ ∣1⟩ .+ pcngm ⊗ ∣0⟩ .+ Cexp γ .* (-1 .* (pncngm ⊗ ∣1⟩) .+ pcngm ⊗ ∣0⟩)) with (((1 - Cexp γ) .* pncngm) ⊗ ∣1⟩ .+ ((1 + Cexp γ) .* pcngm) ⊗ ∣0⟩) by lma. + replace ((pcngm ⊗ ∣1⟩ .+ pncngm ⊗ ∣0⟩ .+ - Cexp γ .* (-1 .* (pcngm ⊗ ∣1⟩) .+ pncngm ⊗ ∣0⟩))) with (((1 + Cexp γ) .* pcngm) ⊗ ∣1⟩ .+ ((1 - Cexp γ) .* pncngm) ⊗ ∣0⟩) by lma. + replace ((pncngm ⊗ ∣1⟩ .+ pcngm ⊗ ∣0⟩ .+ - Cexp γ .* (-1 .* (pncngm ⊗ ∣1⟩) .+ pcngm ⊗ ∣0⟩))) with (((1 + Cexp γ) .* pncngm) ⊗ ∣1⟩ .+ ((1 - Cexp γ) .* pcngm) ⊗ ∣0⟩) by lma. + replace (pcngm ⊗ ∣1⟩ .+ pncngm ⊗ ∣0⟩ .+ Cexp γ .* (-1 .* (pcngm ⊗ ∣1⟩) .+ pncngm ⊗ ∣0⟩)) with (((1 - Cexp γ) .* pcngm ⊗ ∣1⟩) .+ (1 + Cexp γ) .* pncngm ⊗ ∣0⟩) by lma. + replace (∣0⟩ ⊗ (∣1⟩ ⊗ pncgm .+ ∣0⟩ ⊗ pcgm) .+ Cexp (- γ) .* (∣0⟩ ⊗ (-1 .* (∣1⟩ ⊗ pncgm) .+ ∣0⟩ ⊗ pcgm))) with (∣0⟩ ⊗ (∣1⟩ ⊗ ((1 - Cexp (-γ)).* pncgm) .+ ∣0⟩ ⊗ ((1 + Cexp (-γ)) .* pcgm))) by lma. + replace ((∣1⟩ ⊗ (∣1⟩ ⊗ pncgm .+ ∣0⟩ ⊗ pcgm) .+ - Cexp (- γ) .* (∣1⟩ ⊗ (-1 .* (∣1⟩ ⊗ pncgm) .+ ∣0⟩ ⊗ pcgm)))) with (∣1⟩ ⊗ (∣1⟩ ⊗ ((1 + Cexp (-γ)) .* pncgm) .+ ∣0⟩ ⊗ ((1 - Cexp (- γ)) .* pcgm))) by lma. + replace ((∣0⟩ ⊗ (∣1⟩ ⊗ pcgm .+ ∣0⟩ ⊗ pncgm) .+ - Cexp (- γ) .* (∣0⟩ ⊗ (-1 .* (∣1⟩ ⊗ pcgm) .+ ∣0⟩ ⊗ pncgm)))) with (∣0⟩ ⊗ (∣1⟩ ⊗ ((1 + Cexp (-γ)) .* pcgm) .+ ∣0⟩ ⊗ ((1 - Cexp (-γ)) .* pncgm))) by lma. + replace (∣1⟩ ⊗ (∣1⟩ ⊗ pcgm .+ ∣0⟩ ⊗ pncgm) .+ Cexp (- γ) .* (∣1⟩ ⊗ (-1 .* (∣1⟩ ⊗ pcgm) .+ ∣0⟩ ⊗ pncgm))) with (∣1⟩ ⊗ (∣1⟩ ⊗ ((1 - Cexp (-γ)).* pcgm) .+ ∣0⟩ ⊗ ((1 + Cexp (-γ)) .* pncgm))) by lma. + remember (((C1 - Cexp γ) .* pncngm ⊗ ∣1⟩ .+ (C1 + Cexp γ) .* pcngm ⊗ ∣0⟩) ⊗ ∣0⟩) as v1. + remember ((((C1 + Cexp γ) .* pcngm ⊗ ∣1⟩ .+ (C1 - Cexp γ) .* pncngm ⊗ ∣0⟩) ⊗ ∣0⟩)) as v2. + remember ((((C1 + Cexp γ) .* pncngm ⊗ ∣1⟩ .+ (C1 - Cexp γ) .* pcngm ⊗ ∣0⟩) ⊗ ∣1⟩)) as v3. + remember ((((C1 - Cexp γ) .* pcngm ⊗ ∣1⟩ .+ (C1 + Cexp γ) .* pncngm ⊗ ∣0⟩) ⊗ ∣1⟩)) as v4. + remember (∣0⟩ ⊗ (∣1⟩ ⊗ ((C1 - Cexp (- γ)) .* pncgm) .+ ∣0⟩ ⊗ ((C1 + Cexp (- γ)) .* pcgm))) as g1. + remember (∣1⟩ ⊗ (∣1⟩ ⊗ ((C1 + Cexp (- γ)) .* pncgm) .+ ∣0⟩ ⊗ ((C1 - Cexp (- γ)) .* pcgm))) as g2. + remember (∣0⟩ ⊗ (∣1⟩ ⊗ ((C1 + Cexp (- γ)) .* pcgm) .+ ∣0⟩ ⊗ ((C1 - Cexp (- γ)) .* pncgm))) as g3. + remember (∣1⟩ ⊗ (∣1⟩ ⊗ ((C1 - Cexp (- γ)) .* pcgm) .+ ∣0⟩ ⊗ ((C1 + Cexp (- γ)) .* pncgm))) as g4. + autorewrite with scalar_move_db. + rewrite Heqb0a1, Heqp0ab1, Heqab0p1, Heqa0b1. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + restore_dims. + replace (Cexp β .* (v1 × ⟨0∣) .+ Cexp α .* (v1 × ⟨1∣) .+ (Cexp β .* (v2 × ⟨0∣) .+ Cexp β * (Cexp α * Cexp β) .* (v2 × ⟨1∣)) .+ (Cexp α * (Cexp α * Cexp β) .* (v3 × ⟨0∣) .+ Cexp α .* (v3 × ⟨1∣)) .+ (Cexp α * Cexp β * Cexp α .* (v4 × ⟨0∣) .+ Cexp α * Cexp β * Cexp β .* (v4 × ⟨1∣))) with (Cexp β .* ((v1 .+ v2)×⟨0∣) .+ Cexp α .* ((v1 .+ v3)×⟨1∣) .+ (Cexp α * Cexp α * Cexp β).* ((v3 .+ v4)×⟨0∣) .+ (Cexp α * Cexp β * Cexp β) .* ((v2 .+ v4)×⟨1∣)) by lma. + replace (Cexp β .* (g1 × ⟨0∣) .+ Cexp α .* (g1 × ⟨1∣) .+ (Cexp α * (Cexp α * Cexp β) .* (g2 × ⟨0∣) .+ Cexp α .* (g2 × ⟨1∣)) .+ (Cexp β .* (g3 × ⟨0∣) .+ Cexp β * (Cexp α * Cexp β) .* (g3 × ⟨1∣)) .+ (Cexp α * Cexp β * Cexp α .* (g4 × ⟨0∣) .+ Cexp α * Cexp β * Cexp β .* (g4 × ⟨1∣))) with (Cexp β .* ((g1 .+ g3)×⟨0∣) .+ Cexp α .* ((g1 .+ g2)×⟨1∣) .+ (Cexp α * Cexp α * Cexp β) .* ((g2 .+ g4)×⟨0∣) .+ (Cexp α * Cexp β * Cexp β) .* ((g3 .+ g4)×⟨1∣)) by lma. + apply Mplus_simplify. + apply Mplus_simplify. + apply Mplus_simplify. + - apply Mscale_simplify; try easy. + apply Mmult_simplify; try easy. + subst. + repeat rewrite Cminus_unfold. + repeat rewrite Mscale_plus_distr_l. + repeat rewrite Mscale_plus_distr_r. + Msimpl. + repeat rewrite Mscale_assoc. + restore_dims. + replace (- Cexp γ * - Cexp (- γ)) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp (-γ) * - Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (Cexp (-γ) * Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + repeat rewrite <- Cexp_add. + rewrite Rplus_opp_r. + rewrite Cexp_0. + Msimpl. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + repeat rewrite <- Mplus_assoc. + autorewrite with scalar_move_db. + replace (∣+⟩ ⊗ ∣1⟩ ⊗ ∣0⟩ .+ - Cexp (- γ) .* (∣-⟩ ⊗ ∣1⟩ ⊗ ∣0⟩) .+ - Cexp γ .* (∣+⟩ ⊗ ∣1⟩ ⊗ ∣0⟩) .+ ∣-⟩ ⊗ ∣1⟩ ⊗ ∣0⟩ .+ ∣+⟩ ⊗ ∣0⟩ ⊗ ∣0⟩ .+ Cexp (- γ) .* (∣-⟩ ⊗ ∣0⟩ ⊗ ∣0⟩) .+ Cexp γ .* (∣+⟩ ⊗ ∣0⟩ ⊗ ∣0⟩) .+ ∣-⟩ ⊗ ∣0⟩ ⊗ ∣0⟩ .+ ∣+⟩ ⊗ ∣1⟩ ⊗ ∣0⟩ .+ Cexp (- γ) .* (∣-⟩ ⊗ ∣1⟩ ⊗ ∣0⟩) .+ Cexp γ .* (∣+⟩ ⊗ ∣1⟩ ⊗ ∣0⟩) .+ ∣-⟩ ⊗ ∣1⟩ ⊗ ∣0⟩ .+ ∣+⟩ ⊗ ∣0⟩ ⊗ ∣0⟩ .+ - Cexp (- γ) .* (∣-⟩ ⊗ ∣0⟩ ⊗ ∣0⟩) .+ - Cexp γ .* (∣+⟩ ⊗ ∣0⟩ ⊗ ∣0⟩) .+ ∣-⟩ ⊗ ∣0⟩ ⊗ ∣0⟩) with (((∣+⟩ .+ ∣-⟩) ⊗ ∣1⟩ ⊗ ∣0⟩) .+ ((∣+⟩ .+ ∣-⟩) ⊗ ∣1⟩ ⊗ ∣0⟩) .+ ((∣+⟩ .+ ∣-⟩) ⊗ ∣0⟩ ⊗ ∣0⟩) .+ ((∣+⟩ .+ ∣-⟩) ⊗ ∣0⟩ ⊗ ∣0⟩) .+ (Cexp γ .* (∣+⟩ ⊗ ∣+⟩ ⊗ ∣0⟩) .+ - Cexp γ .* (∣+⟩ ⊗ ∣+⟩ ⊗ ∣0⟩)) .+ (Cexp (-γ) .* (∣-⟩ ⊗ ∣+⟩ ⊗ ∣0⟩) .+ - Cexp (-γ) .* (∣-⟩ ⊗ ∣+⟩ ⊗ ∣0⟩))) by lma. + replace (∣0⟩ ⊗ (∣1⟩ ⊗ ∣+⟩) .+ - Cexp γ .* (∣0⟩ ⊗ (∣1⟩ ⊗ ∣-⟩)) .+ - Cexp (- γ) .* (∣0⟩ ⊗ (∣1⟩ ⊗ ∣+⟩)) .+ ∣0⟩ ⊗ (∣1⟩ ⊗ ∣-⟩) .+ ∣0⟩ ⊗ (∣0⟩ ⊗ ∣+⟩) .+ Cexp γ .* (∣0⟩ ⊗ (∣0⟩ ⊗ ∣-⟩)) .+ Cexp (- γ) .* (∣0⟩ ⊗ (∣0⟩ ⊗ ∣+⟩)) .+ ∣0⟩ ⊗ (∣0⟩ ⊗ ∣-⟩) .+ ∣0⟩ ⊗ (∣1⟩ ⊗ ∣+⟩) .+ Cexp γ .* (∣0⟩ ⊗ (∣1⟩ ⊗ ∣-⟩)) .+ Cexp (- γ) .* (∣0⟩ ⊗ (∣1⟩ ⊗ ∣+⟩)) .+ ∣0⟩ ⊗ (∣1⟩ ⊗ ∣-⟩) .+ ∣0⟩ ⊗ (∣0⟩ ⊗ ∣+⟩) .+ - Cexp γ .* (∣0⟩ ⊗ (∣0⟩ ⊗ ∣-⟩)) .+ - Cexp (- γ) .* (∣0⟩ ⊗ (∣0⟩ ⊗ ∣+⟩)) .+ ∣0⟩ ⊗ (∣0⟩ ⊗ ∣-⟩)) with ((∣0⟩ ⊗ (∣1⟩ ⊗ (∣+⟩ .+ ∣-⟩))) .+(∣0⟩ ⊗ (∣1⟩ ⊗ (∣+⟩ .+ ∣-⟩))) .+(∣0⟩ ⊗ (∣0⟩ ⊗ (∣+⟩ .+ ∣-⟩))) .+(∣0⟩ ⊗ (∣0⟩ ⊗ (∣+⟩ .+ ∣-⟩))) .+(Cexp γ .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣-⟩) .+- Cexp γ .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣-⟩)) .+(Cexp (-γ) .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣+⟩) .+- Cexp (-γ) .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣+⟩))) by lma. + rewrite Mplus_plus_minus. + autorewrite with scalar_move_db. + repeat rewrite Cplus_opp_r. + Msimpl. + repeat rewrite kron_assoc by auto with wf_db. + lma. + - apply Mscale_simplify; try easy. + apply Mmult_simplify; try easy. + subst. + repeat rewrite Cminus_unfold. + repeat rewrite Mscale_plus_distr_l. + repeat rewrite Mscale_plus_distr_r. + Msimpl. + repeat rewrite Mscale_assoc. + restore_dims. + replace (- Cexp γ * - Cexp (- γ)) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp (-γ) * - Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (Cexp (-γ) * Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp γ * Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp γ * - Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (- Cexp (-γ) * Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp (-γ) * - Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + repeat rewrite <- Cexp_add. + rewrite Rplus_opp_r. + rewrite Cexp_0. + Msimpl. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + repeat rewrite <- Mplus_assoc. + repeat rewrite <- kron_assoc by auto with wf_db. + autorewrite with scalar_move_db. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + lma. + - apply Mscale_simplify; try easy. + apply Mmult_simplify; try easy. + subst. + repeat rewrite Cminus_unfold. + repeat rewrite Mscale_plus_distr_l. + repeat rewrite Mscale_plus_distr_r. + Msimpl. + repeat rewrite Mscale_assoc. + restore_dims. + replace (- Cexp γ * - Cexp (- γ)) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp (-γ) * - Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (Cexp (-γ) * Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp γ * Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp γ * - Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (- Cexp (-γ) * Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp (-γ) * - Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + repeat rewrite <- Cexp_add. + rewrite Rplus_opp_r. + rewrite Cexp_0. + Msimpl. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + repeat rewrite <- Mplus_assoc. + repeat rewrite <- kron_assoc by auto with wf_db. + autorewrite with scalar_move_db. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + lma. + - apply Mscale_simplify; try easy. + apply Mmult_simplify; try easy. + subst. + repeat rewrite Cminus_unfold. + repeat rewrite Mscale_plus_distr_l. + repeat rewrite Mscale_plus_distr_r. + Msimpl. + repeat rewrite Mscale_assoc. + restore_dims. + replace (- Cexp γ * - Cexp (- γ)) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp (-γ) * - Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (Cexp (-γ) * Cexp γ) with (Cexp γ * Cexp (-γ)) by lca. + replace (- Cexp γ * Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp γ * - Cexp (-γ)) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (- Cexp (-γ) * Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + replace (Cexp (-γ) * - Cexp γ) with (-(Cexp γ * Cexp (-γ))) by lca. + repeat rewrite <- Cexp_add. + rewrite Rplus_opp_r. + rewrite Cexp_0. + Msimpl. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + repeat rewrite <- Mplus_assoc. + repeat rewrite <- kron_assoc by auto with wf_db. + autorewrite with scalar_move_db. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma completeness_BW : + ◁ ⟷ Z 1 1 PI ⟷ ▷ ∝ ▷ ⟷ X 1 1 PI. +Proof. + prop_exists_nonzero 1. + remember (Z 1 1 PI) as z. + remember (X 1 1 PI) as x. + simpl. + rewrite zx_triangle_semantics, zx_triangle_left_semantics. + Msimpl. + rewrite Heqz, Heqx. + rewrite z_1_1_pi_σz, x_1_1_pi_σx. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite <- (Mmult_assoc _ ∣0⟩). + repeat rewrite <- (Mmult_assoc _ ∣1⟩). + restore_dims. + rewrite MmultX1. + rewrite MmultX0. + rewrite ket0_equiv. + rewrite ket1_equiv. + restore_dims. + rewrite Z0_spec. + rewrite Z1_spec. + rewrite <- ket0_equiv. + rewrite <- ket1_equiv. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + repeat rewrite <- (Mmult_assoc _ ∣0⟩). + repeat rewrite <- (Mmult_assoc _ ∣1⟩). + autorewrite with ketbra_mult_db. + Msimpl. + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma completeness_N : forall α β θ_1 θ_2 γ θ_3, + 2 * Cexp (θ_3) * cos(γ) = Cexp (θ_1) * cos(α) + Cexp (θ_2) * cos(β) -> + (((Z 0 1 α ↕ Z 0 1 (-α) ⟷ X 2 1 0) ⟷ Z 1 1 θ_1) ↕ ((Z 0 1 β ↕ Z 0 1 (-β) ⟷ X 2 1 0) ⟷ Z 1 1 θ_2)) ⟷ ((— ↕ (X 0 1 (PI/2) ⟷ Z 1 2 0) ↕ —) ⟷ (X 2 1 0 ↕ X 2 1 0)) ⟷ (Z 1 1 (PI/4) ↕ Z 1 1 (PI/4)) ⟷ X 2 1 0 ∝ + ((Z 0 1 γ ↕ Z 0 1 (-γ) ⟷ X 2 1 0) ↕ (Z 0 1 (PI/4) ↕ Z 0 1 (PI/4) ⟷ X 2 1 0)) ⟷ (Z 2 1 θ_3). +Proof. + intros. + remember (Z 0 1 α ↕ Z 0 1 (- α) ⟷ X 2 1 0) as step_1_1. + remember (Z 0 1 β ↕ Z 0 1 (- β) ⟷ X 2 1 0) as step_1_2. + remember (Z 0 1 γ ↕ Z 0 1 (- γ)) as step_1_3. + remember ((Z 0 1 (PI / 4) ↕ Z 0 1 (PI / 4) ⟷ X 2 1 0)) as step_4. + remember ((— ↕ (X 0 1 (PI / 2) ⟷ Z 1 2 0) ↕ —) +⟷ (X 2 1 0 ↕ X 2 1 0)) as step_2. + remember (Z 1 1 (PI / 4) ↕ Z 1 1 (PI / 4)) as step_3. + remember (X 2 1 0) as final_step. + remember (Z 2 1 θ_3) as final_step_2. + remember (Z 1 1 θ_1) as step_1_5. + remember (Z 1 1 θ_2) as step_1_6. + prop_exists_nonzero 1. + Msimpl. + simpl. + rewrite Heqstep_1_1, Heqstep_1_2. + rewrite Heqfinal_step. + rewrite 2 step_1_N. + rewrite <- Heqfinal_step. + rewrite Heqstep_1_6. + rewrite Heqstep_1_5. + rewrite 2 step_3_N. + rewrite 2 Mmult_plus_distr_r. + rewrite 4 Mmult_plus_distr_l. + restore_dims. + autorewrite with scalar_move_db. + rewrite 2 (Mmult_assoc ∣0⟩). + rewrite 2 (Mmult_assoc ∣1⟩). + autorewrite with ketbra_mult_db. + Msimpl. + rewrite Heqstep_2. + rewrite Heqfinal_step. + rewrite zx_compose_spec. + rewrite <- zx_compose_spec. + rewrite step_2_N. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + (* Simplify scalars here potentially *) + rewrite 2 Cexp_minus. + replace (2 * cos α / (√2)%R * Cexp θ_1) with ((√2)%R * (cos α * Cexp θ_1)) by C_field. + replace (2 * cos β / (√2)%R * Cexp θ_2) with ((√2)%R * (cos β * Cexp θ_2)) by C_field. + rewrite <- 4 Mscale_assoc. + rewrite <- 2 Mscale_plus_distr_r. + autorewrite with scalar_move_db. + replace (/ (√ 2)%R * ((√ 2)%R * (√ 2)%R)) with ((√2)%R * C1) by C_field. + replace (Cexp (PI / 2) / (√ 2)%R * ((√ 2)%R * (√ 2)%R)) with (Ci * (√2)%R) by (autorewrite with Cexp_db; C_field). + rewrite Cmult_1_r. + (* End simplify block (Can break proof below) *) + repeat rewrite Mmult_assoc. + repeat rewrite kron_mixed_product. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_assoc. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + (* Simplify scalars here potentially *) + (* End simplify block (Can break proof below) *) + Msimpl. + replace ((√ 2)%R * ((/ (√ 2)%R + cos β * Cexp θ_2 * / (√ 2)%R) * (/ (√ 2)%R + cos α * Cexp θ_1 * / (√ 2)%R))) with ((1 + cos α * Cexp θ_1 ) * (1 + cos β * Cexp θ_2) / (√2)%R) by C_field. + replace (Ci * (√ 2)%R * ((/ (√ 2)%R + cos β * Cexp θ_2 * - / (√ 2)%R) * (/ (√ 2)%R + cos α * Cexp θ_1 * / (√ 2)%R))) with (Ci * (1 + cos α * Cexp θ_1 ) * (1 - cos β * Cexp θ_2) / (√2)%R) by C_field. + replace (Ci * (√ 2)%R * ((/ (√ 2)%R + cos β * Cexp θ_2 * / (√ 2)%R) * (/ (√ 2)%R + cos α * Cexp θ_1 * - / (√ 2)%R))) with (Ci * (1 - cos α * Cexp θ_1 ) * (1 + cos β * Cexp θ_2) / (√2)%R) by C_field. + replace ((√ 2)%R * ((/ (√ 2)%R + cos β * Cexp θ_2 * - / (√ 2)%R) * (/ (√ 2)%R + cos α * Cexp θ_1 * - / (√ 2)%R))) with ((1 - cos α * Cexp θ_1 ) * (1 - cos β * Cexp θ_2) / (√2)%R) by C_field. + rewrite Heqstep_3. + rewrite <- Heqfinal_step. + rewrite (zx_stack_spec _ _ _ _ (Z 1 1 (PI/4))). + repeat rewrite (kron_mixed_product (⟦ Z 1 1 (PI/4) ⟧)(⟦ Z 1 1 (PI/4) ⟧)). + rewrite step_3_N. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + autorewrite with scalar_move_db. + rewrite Heqfinal_step at 1. + rewrite Heqfinal_step at 1. + rewrite Heqfinal_step at 1. + rewrite Heqfinal_step at 1. + rewrite ZX_semantic_equiv at 1. + rewrite ZX_semantic_equiv at 1. + rewrite ZX_semantic_equiv at 1. + rewrite ZX_semantic_equiv at 1. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_assoc. + autorewrite with scalar_move_db. + repeat rewrite (kron_mixed_product ⟨+∣ ⟨+∣). + repeat rewrite (kron_mixed_product ⟨-∣ ⟨-∣). + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * / (√ 2)%R * ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * / (√ 2)%R)) with ((1 + Cexp (PI/4)) * (1 + Cexp (PI/4)) / 4) by (C_field_simplify; [lca | C_field]). + replace ((/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R * - / (√ 2)%R) * (/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R * - / (√ 2)%R)) with ((1 - Cexp (PI/4)) * (1 - Cexp (PI/4))/4) by (C_field_simplify; [lca | C_field]). + replace ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * / (√ 2)%R * ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * / (√ 2)%R)) with ((1 + Cexp (PI/4)) * (1 - Cexp (PI/4)) / 4) by (C_field_simplify; [lca | C_field]). + replace ((/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R * - / (√ 2)%R) * (/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R * - / (√ 2)%R)) with ((1 + Cexp (PI/4)) * (1 - Cexp (PI/4)) / 4) by (C_field_simplify; [lca | C_field]). + rewrite <- Mscale_plus_distr_r. + restore_dims. + rewrite Mplus_plus_minus. + replace ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * / (√ 2)%R * ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * / (√ 2)%R)) with ((1 + Cexp (PI/4)) * (1 - Cexp (PI/4))/4) by (C_field_simplify; [lca | C_field]). + replace (((/ (√ 2)%R * / (√ 2)%R + +Cexp (PI / 4) * / (√ 2)%R * - / (√ 2)%R) * +(/ (√ 2)%R * / (√ 2)%R + +Cexp (PI / 4) * - / (√ 2)%R * - / (√ 2)%R))) with ((1 + Cexp (PI/4)) * (1 - Cexp (PI/4))/4) by (C_field_simplify; [lca | C_field]). + rewrite <- Mscale_plus_distr_r. + restore_dims. + rewrite Mplus_plus_minus. + replace ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * / (√ 2)%R * ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * / (√ 2)%R)) with ((1 - Cexp (PI/4)) * (1 - Cexp (PI/4))/4) by (C_field_simplify; [lca | C_field]). + replace ((/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R * - / (√ 2)%R) * (/ (√ 2)%R * / (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R * - / (√ 2)%R)) with ((1 + Cexp (PI/4)) * (1 + Cexp (PI/4))/4) by (C_field_simplify; [lca | C_field]). + autorewrite with scalar_move_db. + remember ((C1 + cos α * Cexp θ_1) * (C1 + cos β * Cexp θ_2) / (√ 2)%R) as v1. + remember (Ci * (C1 + cos α * Cexp θ_1) * (C1 - cos β * Cexp θ_2) / (√ 2)%R) as v2. + remember (Ci * (C1 - cos α * Cexp θ_1) * (C1 + cos β * Cexp θ_2) / (√ 2)%R) as v3. + remember ((C1 - cos α * Cexp θ_1) * (C1 - cos β * Cexp θ_2) / (√ 2)%R) as v4. + remember (C1 + Cexp (PI/4)) as g1. + remember (C1 - Cexp (PI/4)) as g2. + unfold xbasis_minus, xbasis_plus. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (g1 * g2) with (1 - Cexp (PI/2)) by (subst; C_field_simplify; autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + replace (1 - Cexp (PI/2)) with ((√2)%R*Cexp (-PI/4)) by (autorewrite with Cexp_db; C_field). + replace (g1 * g1) with (1 + 2 * Cexp (PI/4) + Cexp (PI/2)) by (subst; autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + replace (g2 * g2) with (1 - 2 * Cexp (PI/4) + Cexp (PI/2)) by (subst; autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + clear Heqg1; clear g1; clear Heqg2; clear g2. + remember ((C1 + C2 * Cexp (PI / 4) + Cexp (PI / 2)) / 4) as g1. + remember (((C1 - C2 * Cexp (PI / 4) + Cexp (PI / 2)) / 4)) as g2. + replace (v2 * ((√ 2)%R * Cexp (- PI / 4) / 4) * (√ 2)%R) with (v2 * Cexp (- PI / 4) / 2) by (C_field_simplify; [lca | C_field]). + replace (v3 * ((√ 2)%R * Cexp (- PI / 4) / 4) * (√ 2)%R) with (v3 * Cexp (- PI / 4) / 2) by (C_field_simplify; [lca | C_field]). + autorewrite with scalar_move_db. + repeat rewrite <- (Mscale_assoc _ _ _ (-1)). + repeat rewrite <- Mscale_plus_distr_r. + rewrite Mplus_0_1. + rewrite Mplus_0_1_opp. + autorewrite with scalar_move_db. + replace (v1 * g1 * / (√ 2)%R * (√ 2)%R) with (v1 * g1) by C_field. + replace (v1 * g2 * / (√ 2)%R * (√ 2)%R) with (v1 * g2) by C_field. + replace (v2 * g2 * / (√ 2)%R * (√ 2)%R) with (v2 * g2) by C_field. + replace (v4 * g2 * / (√ 2)%R * (√ 2)%R) with (v4 * g2) by C_field. + replace (v4 * g1 * / (√ 2)%R * (√ 2)%R) with (v4 * g1) by C_field. + replace (v1 * g1 .* ∣+⟩ .+ v1 * g2 .* ∣-⟩ .+ v2 * Cexp (- PI / 4) / C2 .* ∣0⟩ .+ v3 * Cexp (- PI / 4) / C2 .* ∣0⟩ .+ (v4 * g2 .* ∣+⟩ .+ v4 * g1 .* ∣-⟩)) with ((v1 * g1 + v4 * g2) .* ∣+⟩ .+ (v1 * g2 + v4 * g1) .* ∣-⟩ .+ v2 * Cexp (- PI / 4) / C2 .* ∣0⟩ .+ v3 * Cexp (- PI / 4) / C2 .* ∣0⟩) by lma. + rewrite Mplus_assoc. + rewrite <- Mscale_plus_distr_l. + replace ((v2 * Cexp (- PI / 4) / C2 + v3 * Cexp (- PI / 4) / C2)) with ((v2 + v3) * Cexp (-PI/4) /2) by C_field. + replace (v2 + v3) with (Ci * (√2)%R * (1 - (cos α)*Cexp(θ_1)*cos(β)*Cexp(θ_2))) by (subst; C_field_simplify; [lca | C_field]). + replace (Ci * (√ 2)%R * (C1 - cos α * Cexp θ_1 * cos β * Cexp θ_2) * Cexp (- PI / 4) / C2) with (Ci * (C1 - cos α * Cexp θ_1 * cos β * Cexp θ_2) * Cexp (- PI / 4) / (√2)%R) by C_field. + unfold xbasis_plus, xbasis_minus. + replace ((v1 * g1 + v4 * g2) .* (/ (√ 2)%R .* (∣0⟩ .+ ∣1⟩)) .+ (v1 * g2 + v4 * g1) .* (/ (√ 2)%R .* (∣0⟩ .+ -1 .* ∣1⟩))) with ((((v1 * g1 + v4 * g2) + (v1 * g2 + v4 * g1))/(√2)%R) .* ∣0⟩ .+ (((v1 * g1 + v4 * g2) - (v1 * g2 + v4 * g1))/(√2)%R) .* ∣1⟩) by lma. + replace (v1 * g1 + v4 * g2 + (v1 * g2 + v4 * g1)) with (v1 * (g1 + g2) + v4 * (g1 + g2)) by lca. + replace (v1 * g1 + v4 * g2 - (v1 * g2 + v4 * g1)) with (v1 * (g1 - g2) + v4 * (g2 - g1)) by lca. + replace (g1 + g2) with ((1 + Cexp (PI/2))/2) by (subst; lca). + replace ((1 + Cexp (PI/2))/2) with (Cexp (PI/4)/(√2)%R) by (autorewrite with Cexp_db; C_field). + replace ((v1 * (Cexp (PI / 4) / (√ 2)%R) + v4 * (Cexp (PI / 4) / (√ 2)%R)) / (√ 2)%R) with ((v1 + v4) * (Cexp (PI/4))/2) by C_field. + replace (g1 - g2) with (Cexp (PI/4)) by (subst; autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + replace (g2 - g1) with (- Cexp (PI/4)) by (subst; autorewrite with Cexp_db; C_field_simplify; [lca | C_field]). + replace ((v1 * Cexp (PI / 4) + v4 * - Cexp (PI / 4))) with ((v1 - v4) * Cexp (PI/4)) by C_field. + replace (v1 + v4) with ((√2)%R * (1 + cos α * Cexp θ_1 * cos β * Cexp θ_2)) by (subst; C_field_simplify; [lca | C_field]). + replace (v1 - v4) with ((√2)%R * (cos α * Cexp θ_1 + cos β * Cexp θ_2)) by (subst; C_field_simplify; [lca | C_field]). + replace (Ci * (C1 - cos α * Cexp θ_1 * cos β * Cexp θ_2) * Cexp (- PI / 4)) with ((C1 - cos α * Cexp θ_1 * cos β * Cexp θ_2) * Cexp (PI/4)) by (autorewrite with Cexp_db; C_field). + rewrite Mplus_comm. + rewrite <- Mplus_assoc. + rewrite <- Mscale_plus_distr_l. + replace ((√ 2)%R * (cos α * Cexp θ_1 + cos β * Cexp θ_2) * Cexp (PI / 4) / (√ 2)%R) with ((cos α * Cexp θ_1 + cos β * Cexp θ_2) * Cexp (PI / 4)) by C_field. + (* Right hand side *) + rewrite Heqstep_1_3. + rewrite Heqfinal_step. + rewrite <- zx_compose_spec. + rewrite step_1_N. + simpl. + rewrite Heqstep_4. + rewrite Heqfinal_step. + rewrite (ZX_semantic_equiv _ _ (_ ⟷ _)). + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + rewrite (kron_mixed_product ⟨+∣ ⟨+∣). + rewrite (kron_mixed_product ⟨-∣ ⟨-∣). + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * (/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R)) with (((1 + Cexp (PI/4))^2)/2) by (simpl; C_field). + replace ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * (/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R)) with (((1 - Cexp (PI/4))^2)/2) by (simpl; C_field). + remember ((C1 + Cexp (PI / 4)) ^ 2 / C2) as c1. + remember ((C1 - Cexp (PI / 4)) ^ 2 / C2) as c2. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + restore_dims. + replace (c1 * / (√ 2)%R .* ∣0⟩ .+ c1 * / (√ 2)%R .* ∣1⟩ .+ (c2 * / (√ 2)%R .* ∣0⟩ .+ c2 * / (√ 2)%R .* (-1 .* ∣1⟩))) with ((c1 + c2)/(√2)%R .* ∣0⟩ .+ ((c1 - c2)/(√2)%R .* ∣1⟩)) by lma. + replace (c1 + c2) with ((1 + Cexp (PI/4)^2)) by (subst; simpl; C_field_simplify; [lca | C_field]). + replace (c1 - c2) with ((2 * Cexp (PI/4))) by (subst; simpl; C_field_simplify; [lca | C_field]). + rewrite Heqfinal_step_2. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite kron_mixed_product. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + autorewrite with scalar_move_db. + Msimpl. + apply Mplus_simplify; apply Mscale_simplify; try easy. + - autorewrite with Cexp_db. + C_field_simplify; [lca | C_field]. + - rewrite Cexp_minus. + rewrite (Cmult_comm (cos α)). + rewrite (Cmult_comm (cos β)). + rewrite <- H. + C_field. +Qed. \ No newline at end of file diff --git a/src/DiagramRules/CompletenessComp.v b/src/DiagramRules/CompletenessComp.v new file mode 100644 index 0000000..2bd876e --- /dev/null +++ b/src/DiagramRules/CompletenessComp.v @@ -0,0 +1,470 @@ +Require Import CoreData. +From QuantumLib Require Import Polar. +Require Import CoreRules. + +Lemma c_step_1 : forall α, + ⟦ (Z 0 1 α ↕ —) ⟷ X 2 1 0 ⟧ = + /(√2)%R .* (∣0⟩⟨0∣ .+ + Cexp(α) .* ∣0⟩⟨1∣ .+ + Cexp(α) .* ∣1⟩⟨0∣ .+ + ∣1⟩⟨1∣). +Proof. + intros. autorewrite with scalar_move_db. + rewrite ZX_semantic_equiv. + simpl. + autorewrite with Cexp_db. + Msimpl. + rewrite kron_plus_distr_r. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_assoc. + repeat rewrite kron_mixed_product. + Msimpl. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + unfold xbasis_minus, xbasis_plus, braplus, braminus. + autorewrite with scalar_move_db. + replace ((/ (√ 2)%R + Cexp α * / (√ 2)%R) * / (√ 2)%R * / (√ 2)%R) with ((1 + Cexp α) / (2 * (√2)%R)) by C_field. + replace ((/ (√ 2)%R + Cexp α * - / (√ 2)%R) * / (√ 2)%R * / (√ 2)%R) with ((1 - Cexp α) / (2 * (√2)%R)) by C_field. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + remember ((C1 + Cexp α) / (C2 * (√ 2)%R)) as σ1. + remember ((C1 - Cexp α) / (C2 * (√ 2)%R)) as σ2. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (σ2 * -1) with (- σ2) by lca. + replace (- σ2 * -1) with σ2 by lca. + restore_dims. + replace (σ1 .* ∣0⟩⟨0∣ .+ σ1 .* ∣0⟩⟨1∣ .+ (σ1 .* ∣1⟩⟨0∣ .+ σ1 .* ∣1⟩⟨1∣) .+ (σ2 .* ∣0⟩⟨0∣ .+ - σ2 .* ∣0⟩⟨1∣ .+ (- σ2 .* ∣1⟩⟨0∣ .+ σ2 .* ∣1⟩⟨1∣))) with ((σ1 + σ2) .* ∣0⟩⟨0∣ .+ (σ1 - σ2) .* ∣0⟩⟨1∣ .+ (σ1 - σ2) .* ∣1⟩⟨0∣ .+ (σ1 + σ2) .* ∣1⟩⟨1∣) by lma. + replace (σ1 + σ2) with (1 / (√2)%R) by (subst; C_field_simplify; [lca | C_field]). + replace (σ1 - σ2) with ((Cexp α) / (√2)%R) by (subst; C_field_simplify; [lca | C_field]). + lma. +Qed. + +Lemma c_step_1_pi : forall α, + ⟦ (Z 0 1 α ↕ —) ⟷ X 2 1 PI ⟧ = + /(√2)%R .* (Cexp(α) .* ∣0⟩⟨0∣ .+ + ∣0⟩⟨1∣ .+ + ∣1⟩⟨0∣ .+ + Cexp(α) .* ∣1⟩⟨1∣). +Proof. + intros. + rewrite ZX_semantic_equiv. + simpl. + autorewrite with scalar_move_db. + Msimpl. + autorewrite with Cexp_db. + rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mmult_assoc. + repeat rewrite kron_mixed_product. + Msimpl. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + unfold xbasis_minus, xbasis_plus, braplus, braminus. + autorewrite with scalar_move_db. + replace ((/ (√ 2)%R + Cexp α * / (√ 2)%R) * / (√ 2)%R * / (√ 2)%R) with ((1 + Cexp α) / (2 * (√2)%R)) by C_field. + replace ((-1 * / (√ 2)%R + Cexp α * -1 * - / (√ 2)%R) * / (√ 2)%R * / (√ 2)%R) with (-(1 - Cexp α) / (2 * (√2)%R)) by (C_field_simplify; [lca | C_field]). + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + remember ((C1 + Cexp α) / (C2 * (√ 2)%R)) as σ1. + remember (-(C1 - Cexp α) / (C2 * (√ 2)%R)) as σ2. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (σ2 * -1) with (- σ2) by lca. + replace (- σ2 * -1) with σ2 by lca. + restore_dims. + replace (σ1 .* ∣0⟩⟨0∣ .+ σ1 .* ∣0⟩⟨1∣ .+ (σ1 .* ∣1⟩⟨0∣ .+ σ1 .* ∣1⟩⟨1∣) .+ (σ2 .* ∣0⟩⟨0∣ .+ - σ2 .* ∣0⟩⟨1∣ .+ (- σ2 .* ∣1⟩⟨0∣ .+ σ2 .* ∣1⟩⟨1∣))) with ((σ1 + σ2) .* ∣0⟩⟨0∣ .+ (σ1 - σ2) .* ∣0⟩⟨1∣ .+ (σ1 - σ2) .* ∣1⟩⟨0∣ .+ (σ1 + σ2) .* ∣1⟩⟨1∣) by lma. + replace (σ1 + σ2) with (Cexp α / (√2)%R) by (subst; C_field_simplify; [lca | C_field]). + replace (σ1 - σ2) with (1 / (√2)%R) by (subst; C_field_simplify; [lca | C_field]). + lma. +Qed. + +Lemma c_step_2 : forall α β γ, + ⟦ (Z 1 2 α ↕ Z 1 2 β) ⟷ (— ↕ X 2 1 γ ↕ —) ⟧ = + / C2 .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣0⟩ × (⟨0∣ ⊗ ⟨0∣) .+ Cexp γ .* (∣0⟩ ⊗ ∣-⟩ ⊗ ∣0⟩ × (⟨0∣ ⊗ ⟨0∣)) .+ Cexp α .* (∣1⟩ ⊗ ∣+⟩ ⊗ ∣0⟩ × (⟨1∣ ⊗ ⟨0∣) .+ - Cexp γ .* (∣1⟩ ⊗ ∣-⟩ ⊗ ∣0⟩ × (⟨1∣ ⊗ ⟨0∣))) .+ Cexp β .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣1⟩ × (⟨0∣ ⊗ ⟨1∣) .+ - Cexp γ .* (∣0⟩ ⊗ ∣-⟩ ⊗ ∣1⟩ × (⟨0∣ ⊗ ⟨1∣))) .+ Cexp α * Cexp β .* (∣1⟩ ⊗ ∣+⟩ ⊗ ∣1⟩ × (⟨1∣ ⊗ ⟨1∣) .+ Cexp γ .* (∣1⟩ ⊗ ∣-⟩ ⊗ ∣1⟩ × (⟨1∣ ⊗ ⟨1∣)))). +Proof. + intros. + remember (/ C2 .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣0⟩ × (⟨0∣ ⊗ ⟨0∣) .+ Cexp γ .* (∣0⟩ ⊗ ∣-⟩ ⊗ ∣0⟩ × (⟨0∣ ⊗ ⟨0∣)) .+ Cexp α .* (∣1⟩ ⊗ ∣+⟩ ⊗ ∣0⟩ × (⟨1∣ ⊗ ⟨0∣) .+ - Cexp γ .* (∣1⟩ ⊗ ∣-⟩ ⊗ ∣0⟩ × (⟨1∣ ⊗ ⟨0∣))) .+ Cexp β .* (∣0⟩ ⊗ ∣+⟩ ⊗ ∣1⟩ × (⟨0∣ ⊗ ⟨1∣) .+ - Cexp γ .* (∣0⟩ ⊗ ∣-⟩ ⊗ ∣1⟩ × (⟨0∣ ⊗ ⟨1∣))) .+ Cexp α * Cexp β .* (∣1⟩ ⊗ ∣+⟩ ⊗ ∣1⟩ × (⟨1∣ ⊗ ⟨1∣) .+ Cexp γ .* (∣1⟩ ⊗ ∣-⟩ ⊗ ∣1⟩ × (⟨1∣ ⊗ ⟨1∣))))) as solution. + remember (Z 1 2 α ↕ Z 1 2 β) as lhs. + remember (— ↕ X 2 1 γ ↕ —) as rhs. + assert (Hlhs : ⟦ lhs ⟧ = + (∣0⟩⊗∣0⟩⊗∣0⟩⊗∣0⟩) × (⟨0∣⊗⟨0∣) .+ + Cexp α .* (∣1⟩⊗∣1⟩⊗∣0⟩⊗∣0⟩) × (⟨1∣⊗⟨0∣) .+ + Cexp β .* (∣0⟩⊗∣0⟩⊗∣1⟩⊗∣1⟩) × (⟨0∣⊗⟨1∣) .+ + (Cexp β * Cexp α) .* (∣1⟩⊗∣1⟩⊗∣1⟩⊗∣1⟩) × (⟨1∣⊗⟨1∣)). + { + subst. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite <- kron_mixed_product. + restore_dims. + repeat rewrite kron_assoc by auto with wf_db. + rewrite Mscale_plus_distr_r. + rewrite Mscale_assoc. + repeat rewrite Mplus_assoc. + easy. + } + rewrite zx_compose_spec. + rewrite Hlhs. + rewrite Heqrhs. + clear Heqlhs. clear Hlhs. clear Heqrhs. clear lhs. clear rhs. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite <- kron_mixed_product. + rewrite kron_plus_distr_l. + rewrite kron_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite kron_id_dist_l by auto with wf_db. + repeat rewrite kron_id_dist_r by auto with wf_db. + repeat rewrite Mmult_assoc. + rewrite <- 2 (Mmult_assoc _ (∣0⟩⊗∣0⟩⊗∣0⟩⊗∣0⟩)). + rewrite <- 2 (Mmult_assoc _ (∣1⟩⊗∣1⟩⊗∣0⟩⊗∣0⟩)). + rewrite <- 2 (Mmult_assoc _ (∣0⟩⊗∣0⟩⊗∣1⟩⊗∣1⟩)). + rewrite <- 2 (Mmult_assoc _ (∣1⟩⊗∣1⟩⊗∣1⟩⊗∣1⟩)). + repeat rewrite kron_assoc by auto with wf_db. + restore_dims. + repeat rewrite (kron_mixed_product (I 2) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (I 2) _ (∣1⟩)). + repeat rewrite (kron_mixed_product (⟨+∣) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (⟨+∣) _ (∣1⟩)). + repeat rewrite (kron_mixed_product (⟨-∣) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (⟨-∣) _ (∣1⟩)). + repeat rewrite (kron_mixed_product (⟨+∣) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (⟨+∣) _ (∣1⟩)). + repeat rewrite (kron_mixed_product (⟨-∣) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (⟨-∣) _ (∣1⟩)). + repeat rewrite Mmult_1_l by auto with wf_db. + repeat rewrite (kron_mixed_product (I 2) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (I 2) _ (∣1⟩)). + repeat rewrite (kron_mixed_product (I 2) _ (∣0⟩)). + repeat rewrite (kron_mixed_product (I 2) _ (∣1⟩)). + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + repeat rewrite <- kron_mixed_product. + repeat rewrite <- kron_assoc by auto with wf_db. + Msimpl. + replace (/ (√ 2)%R * / (√ 2)%R) with (/2) by C_field. + replace (- / (√ 2)%R * / (√ 2)%R) with (-/2) by C_field. + replace (/ (√ 2)%R * - / (√ 2)%R) with (-/2) by C_field. + replace (- / (√ 2)%R * - / (√ 2)%R) with (/2) by C_field. + restore_dims. + repeat rewrite <- kron_mixed_product. + replace (Cexp γ * - / C2) with (/ C2 * - Cexp γ) by lca. + replace (Cexp γ * / C2) with (/ C2 * Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ (/C2)). + autorewrite with scalar_move_db. + replace (Cexp α * / C2) with (/C2 * Cexp α) by lca. + replace (Cexp β * / C2) with (/C2 * Cexp β) by lca. + replace (Cexp β * Cexp α * / C2) with (/C2 * Cexp α * Cexp β) by lca. + repeat rewrite <- Mscale_assoc. + autorewrite with scalar_move_db. + symmetry. + apply Heqsolution. +Qed. + +Lemma c_step_3 : forall γ, + ⟦ (Z 1 2 0 ↕ —) ⟷ (— ↕ X 2 1 γ) ⟧ = + /(√2)%R .* (I 2 ⊗ (∣+⟩×⟨+∣ .+ Cexp γ .* ∣-⟩×⟨-∣)) × cnot. +Proof. + intros. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + autorewrite with Cexp_db. + Msimpl. + rewrite kron_plus_distr_r. + rewrite kron_plus_distr_l. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite kron_id_dist_l by auto with wf_db. + repeat rewrite kron_id_dist_r by auto with wf_db. + repeat rewrite Mmult_assoc. + repeat rewrite kron_assoc by auto with wf_db. + repeat rewrite <- (Mmult_assoc _ (∣0⟩ ⊗ (∣0⟩ ⊗ I 2))). + repeat rewrite <- (Mmult_assoc _ (∣1⟩ ⊗ (∣1⟩ ⊗ I 2))). + repeat rewrite kron_mixed_product. + Msimpl. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + restore_dims. + autorewrite with ketbra_mult_db. + replace (Cexp γ * / (√ 2)%R) with (/ (√ 2)%R * Cexp γ) by lca. + replace (Cexp γ * - / (√ 2)%R) with (/ (√ 2)%R * - Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ (/ (√2)%R)). + autorewrite with scalar_move_db. + apply Mscale_simplify; [| easy]. + rewrite <- cnot_decomposition. + repeat rewrite kron_plus_distr_l. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_assoc. + replace (⟨-∣×σx) with (-1 .* ⟨-∣) by solve_matrix. + replace (⟨+∣×σx) with (⟨+∣). + autorewrite with scalar_move_db. + lma. + unfold braplus. + solve_matrix. +Qed. + +Lemma c_step_3_flipped : forall γ, + ⟦ (— ↕ Z 1 2 0) ⟷ (X 2 1 γ ↕ —) ⟧ = + /(√2)%R .* ((∣+⟩×⟨+∣ .+ Cexp γ .* ∣-⟩×⟨-∣) ⊗ I 2) × notc. +Proof. + intros. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + autorewrite with Cexp_db. + Msimpl. + rewrite kron_plus_distr_r. + rewrite kron_plus_distr_l. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite kron_id_dist_l by auto with wf_db. + repeat rewrite kron_id_dist_r by auto with wf_db. + repeat rewrite Mmult_assoc. + restore_dims. + repeat rewrite kron_assoc by auto with wf_db. + repeat rewrite <- (Mmult_assoc _ (I 2 ⊗ (∣0⟩ ⊗ (∣0⟩)))). + repeat rewrite <- (Mmult_assoc _ (I 2 ⊗ (∣1⟩ ⊗ (∣1⟩)))). + repeat rewrite kron_mixed_product. + Msimpl. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + restore_dims. + autorewrite with ketbra_mult_db. + replace (Cexp γ * / (√ 2)%R) with (/ (√ 2)%R * Cexp γ) by lca. + replace (Cexp γ * - / (√ 2)%R) with (/ (√ 2)%R * - Cexp γ) by lca. + repeat rewrite <- (Mscale_assoc _ _ (/ (√2)%R)). + autorewrite with scalar_move_db. + apply Mscale_simplify; [| easy]. + rewrite <- notc_decomposition. + repeat rewrite kron_plus_distr_r. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + autorewrite with scalar_move_db. + repeat rewrite kron_mixed_product. + Msimpl. + repeat rewrite Mmult_assoc. + replace (⟨-∣×σx) with (-1 .* ⟨-∣) by solve_matrix. + replace (⟨+∣×σx) with (⟨+∣). + autorewrite with scalar_move_db. + lma. + unfold braplus. + solve_matrix. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma step_1_N : forall α, + ⟦ (Z 0 1 α ↕ Z 0 1 (-α)) ⟷ X 2 1 0 ⟧ = + (√2)%R .* ∣0⟩ .+ + (Cexp α + Cexp (-α)) / (√2)%R .* ∣1⟩. +Proof. + intros. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + autorewrite with Cexp_db. + Msimpl. + rewrite kron_plus_distr_r. + rewrite kron_plus_distr_l. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + repeat rewrite (kron_mixed_product ⟨-∣ ⟨-∣). + repeat rewrite (kron_mixed_product ⟨+∣ ⟨+∣). + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace (/ (√ 2)%R * / (√ 2)%R) with (/2) by C_field. + replace (- / (√ 2)%R * / (√ 2)%R) with (-/2) by C_field. + replace (/ (√ 2)%R * (/ (√ 2)%R + / Cexp α * / (√ 2)%R)) with ((1 + / Cexp α)/2) by C_field. + replace (- / (√ 2)%R * (/ (√ 2)%R + / Cexp α * - / (√ 2)%R)) with (-(1 - / Cexp α)/2) by C_field. + unfold xbasis_minus, xbasis_plus. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + replace (/ C2 * / (√ 2)%R .* ∣0⟩ .+ / C2 * / (√ 2)%R .* ∣1⟩ .+ (/ C2 * / (√ 2)%R .* ∣0⟩ .+ / C2 * / (√ 2)%R * -1 .* ∣1⟩)) with (/(√2)%R .* ∣0⟩) by lma. + replace (/ Cexp α * (/ C2 * / (√ 2)%R)) with (/(Cexp α * 2 * (√2)%R)) by C_field. + replace (/ Cexp α * (- / C2 * / (√ 2)%R)) with (- /(Cexp α * 2 * (√2)%R)) by C_field. + replace (- /(Cexp α * 2 * (√2)%R) * -1) with (/(Cexp α * 2 * (√2)%R)) by (C_field_simplify; [lca | C_field]). + remember (/ (Cexp α * C2 * (√ 2)%R)) as v. + replace (v .* ∣0⟩ .+ v .* ∣1⟩ .+ ((- v) .* ∣0⟩ .+ v .* ∣1⟩)) with (2 * v .* ∣1⟩) by lma. + replace (C2 * v) with (/ (Cexp α * (√2)%R)) by (rewrite Heqv; C_field). + clear Heqv; clear v. + replace (Cexp α * ((C1 + / Cexp α) / C2 * / (√ 2)%R)) with ((1 + Cexp α)/ (2 * (√2)%R)) by C_field. + replace (Cexp α * (-(C1 - / Cexp α) / C2 * / (√ 2)%R)) with ((1 - Cexp α)/ (2 * (√2)%R)) by C_field. + remember ((C1 + Cexp α) / (C2 * (√ 2)%R)) as v1. + remember ((C1 - Cexp α) / (C2 * (√ 2)%R)) as v2. + replace (v2 * -1) with (-v2) by lca. + replace ((v1 .* ∣0⟩ .+ v1 .* ∣1⟩ .+ (v2 .* ∣0⟩ .+ - v2 .* ∣1⟩))) with ((v1 + v2) .* ∣0⟩ .+ (v1 - v2) .* ∣1⟩) by lma. + replace (v1 + v2) with (/(√2)%R) by (rewrite Heqv1, Heqv2; C_field_simplify; [ lca | C_field ]). + replace (v1 - v2) with (Cexp α/(√2)%R) by (rewrite Heqv1, Heqv2; C_field_simplify; [ lca | C_field ]). + clear Heqv1; clear Heqv2; clear v1; clear v2. + rewrite Mplus_assoc. + rewrite (Mplus_comm _ _ ((/ (Cexp α * (√2)%R)) .* _)). + rewrite Mplus_assoc. + rewrite <- Mplus_assoc. + rewrite <- 2 Mscale_plus_distr_l. + apply Mplus_simplify. + - apply Mscale_simplify. + + easy. + + C_field_simplify; [ lca | C_field ]. + - apply Mscale_simplify. + + easy. + + C_field_simplify; [ lca | C_field ]. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma step_2_N : + ⟦ (— ↕ (X 0 1 (PI/2) ⟷ Z 1 2 0) ↕ —) ⟷ (X 2 1 0 ↕ X 2 1 0) ⟧ = + /(√2)%R .* ∣+⟩ × ⟨+∣ ⊗ (∣+⟩ × ⟨+∣) .+ + Cexp (PI/2)/(√2)%R .* ∣+⟩ × ⟨+∣ ⊗ (∣-⟩ × ⟨-∣) .+ + Cexp (PI/2)/(√2)%R .* ∣-⟩ × ⟨-∣ ⊗ (∣+⟩ × ⟨+∣) .+ + /(√2)%R .* ∣-⟩ × ⟨-∣ ⊗ (∣-⟩ × ⟨-∣). +Proof. + rewrite zx_compose_spec. + rewrite 2 zx_stack_spec. + assert (H : ⟦ X 0 1 (PI/2) ⟷ Z 1 2 0 ⟧ = + ((1 + Cexp (PI/2))/(√2)%R) .* ∣0⟩ ⊗ ∣0⟩ .+ + ((1 - Cexp (PI/2))/(√2)%R) .* ∣1⟩ ⊗ ∣1⟩). + { + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_l. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + restore_dims. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + lma. + } + rewrite H. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + rewrite (kron_plus_distr_l _ _ _ _ (I 2)). + rewrite (kron_plus_distr_r _ _ _ _ _ _ (I 2)). + restore_dims. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + repeat rewrite Mmult_plus_distr_. + replace (I 2 ⊗ (∣0⟩ ⊗ ∣0⟩) ⊗ I 2) with ((I 2 ⊗ ∣0⟩) ⊗ (∣0⟩ ⊗ I 2)) by (repeat rewrite kron_assoc by auto with wf_db; easy). + replace (I 2 ⊗ (∣1⟩ ⊗ ∣1⟩) ⊗ I 2) with ((I 2 ⊗ ∣1⟩) ⊗ (∣1⟩ ⊗ I 2)) by (repeat rewrite kron_assoc by auto with wf_db; easy). + restore_dims. + repeat rewrite kron_mixed_product. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + repeat rewrite (kron_mixed_product ⟨+∣ ⟨+∣). + repeat rewrite (kron_mixed_product ⟨-∣ ⟨-∣). + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace ((C1 + Cexp (PI/2)) / (√2)%R * /(√2)%R * /(√2)%R) with ((C1 + Cexp (PI/2))/(2 * (√2)%R)) by C_field. + rewrite <- (Mscale_kron_dist_r _ _ _ _ ((C1 - Cexp (PI/2)) /(√2)%R)). + repeat rewrite Mscale_plus_distr_r. + repeat rewrite Mscale_assoc. + repeat rewrite kron_plus_distr_l. + repeat rewrite kron_plus_distr_r. + replace (- / (√ 2)%R) with (/(√ 2)%R * -1) by lca. + replace (((C1 - Cexp (PI / 2)) / (√ 2)%R * (/ (√ 2)%R * -1))) with (((C1 - Cexp (PI/2))/2) * -1) by C_field. + repeat rewrite <- (Mscale_assoc _ _ _ (-1)%C). + replace (((C1 - Cexp (PI / 2)) / (√ 2)%R * (/ (√ 2)%R))) with (((C1 - Cexp (PI/2))/2)) by C_field. + remember ((C1 - Cexp (PI/2))/2) as v2. + restore_dims. + remember (-1 .* (∣-⟩ × ⟨-∣)) as mm1. + autorewrite with scalar_move_db. + remember ((C1 + Cexp (PI/2)) / (C2 * (√2)%R)) as v1. + remember (v2 * / (√2)%R) as v3. + repeat rewrite Mscale_plus_distr_r. + replace (v3 .* (∣+⟩ × ⟨+∣ ⊗ mm1)) with (-v3 .* ((∣+⟩×⟨+∣)⊗(∣-⟩×⟨-∣))) by (subst; lma). + replace (v3 .* (mm1 ⊗ (∣+⟩ × ⟨+∣))) with (-v3 .* ((∣-⟩×⟨-∣)⊗(∣+⟩×⟨+∣))) by (subst; lma). + replace (v3 .* (mm1 ⊗ mm1)) with (v3 .* ((∣-⟩×⟨-∣)⊗(∣-⟩×⟨-∣))) by (subst; lma). + replace (v1 .* (∣+⟩ × ⟨+∣ ⊗ (∣+⟩ × ⟨+∣)) .+ v1 .* (∣-⟩ × ⟨-∣ ⊗ (∣+⟩ × ⟨+∣)) .+ (v1 .* (∣+⟩ × ⟨+∣ ⊗ (∣-⟩ × ⟨-∣)) .+ v1 .* (∣-⟩ × ⟨-∣ ⊗ (∣-⟩ × ⟨-∣))) .+ (v3 .* (∣+⟩ × ⟨+∣ ⊗ (∣+⟩ × ⟨+∣)) .+ - v3 .* (∣-⟩ × ⟨-∣ ⊗ (∣+⟩ × ⟨+∣)) .+ (- v3 .* (∣+⟩ × ⟨+∣ ⊗ (∣-⟩ × ⟨-∣)) .+ v3 .* (∣-⟩ × ⟨-∣ ⊗ (∣-⟩ × ⟨-∣))))) with ((v1 + v3) .* (∣+⟩ × ⟨+∣ ⊗ (∣+⟩ × ⟨+∣)) .+ (v1 - v3) .* (∣-⟩ × ⟨-∣ ⊗ (∣+⟩ × ⟨+∣)) .+ (v1 - v3) .* (∣+⟩ × ⟨+∣ ⊗ (∣-⟩ × ⟨-∣)) .+ (v1 + v3) .* (∣-⟩ × ⟨-∣ ⊗ (∣-⟩ × ⟨-∣))) by lma. + replace (v1 + v3) with (/(√2)%R) by (subst; C_field_simplify; [lca | C_field]). + replace (v1 - v3) with (Cexp (PI/2)/(√2)%R) by (subst; C_field_simplify; [lca | C_field]). + lma. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma step_3_N : forall α, + ⟦ Z 1 1 α ⟧ = ∣0⟩⟨0∣ .+ Cexp α .* ∣1⟩⟨1∣. +Proof. + intros. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + easy. +Qed. + +(* @nocheck name *) +(* Conventional name *) +Lemma step_4_N : + ⟦ Z 0 1 (PI/4) ↕ Z 0 1 (PI/4) ⟷ X 2 1 0 ⟧ = (C1 + Cexp (PI / 4) ^ 2) / (√ 2)%R .* ∣0⟩.+ ((√2)%R * Cexp (PI/4)) .* ∣1⟩. +Proof. + rewrite ZX_semantic_equiv. + unfold_dirac_spider. + rewrite Cexp_0. + Msimpl. + repeat rewrite Mmult_plus_distr_r. + repeat rewrite Mmult_assoc. + rewrite (kron_mixed_product ⟨+∣ ⟨+∣). + rewrite (kron_mixed_product ⟨-∣ ⟨-∣). + repeat rewrite Mmult_plus_distr_l. + autorewrite with scalar_move_db. + autorewrite with ketbra_mult_db. + autorewrite with scalar_move_db. + Msimpl. + replace ((/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R) * (/ (√ 2)%R + Cexp (PI / 4) * / (√ 2)%R)) with (((1 + Cexp (PI/4))^2)/2) by (simpl; C_field). + replace ((/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R) * (/ (√ 2)%R + Cexp (PI / 4) * - / (√ 2)%R)) with (((1 - Cexp (PI/4))^2)/2) by (simpl; C_field). + remember ((C1 + Cexp (PI / 4)) ^ 2 / C2) as c1. + remember ((C1 - Cexp (PI / 4)) ^ 2 / C2) as c2. + unfold xbasis_plus, xbasis_minus. + autorewrite with scalar_move_db. + repeat rewrite Mscale_plus_distr_r. + restore_dims. + replace (c1 * / (√ 2)%R .* ∣0⟩ .+ c1 * / (√ 2)%R .* ∣1⟩ .+ (c2 * / (√ 2)%R .* ∣0⟩ .+ c2 * / (√ 2)%R .* (-1 .* ∣1⟩))) with ((c1 + c2)/(√2)%R .* ∣0⟩ .+ ((c1 - c2)/(√2)%R .* ∣1⟩)) by lma. + replace (c1 + c2) with ((1 + Cexp (PI/4)^2)) by (subst; simpl; C_field_simplify; [lca | C_field]). + replace (c1 - c2) with ((2 * Cexp (PI/4))) by (subst; simpl; C_field_simplify; [lca | C_field]). + apply Mplus_simplify. + - simpl; easy. + - apply Mscale_simplify. + + easy. + + C_field. +Qed. diff --git a/src/DiagramRules/DiagramRules.v b/src/DiagramRules/DiagramRules.v index 4c32862..d51af8e 100644 --- a/src/DiagramRules/DiagramRules.v +++ b/src/DiagramRules/DiagramRules.v @@ -1 +1,2 @@ -From VyZX Require Export Bialgebra. \ No newline at end of file +From VyZX Require Export Bialgebra. +From VyZX Require Export Bell. \ No newline at end of file diff --git a/src/Gates/GateRules.v b/src/Gates/GateRules.v index 411276c..f15489c 100644 --- a/src/Gates/GateRules.v +++ b/src/Gates/GateRules.v @@ -1,11 +1,12 @@ Require Import QuantumLib.Quantum. Require Export ZXCore. Require Export GateDefinitions. +Require Export DiagramRules. Require Export CoreRules. Local Open Scope ZX_scope. -Lemma Z_is_Z : ZX_semantics (_Z_) = σz. +Lemma Z_is_Z : ⟦ _Z_ ⟧ = σz. Proof. simpl. unfold Z_semantics. @@ -14,7 +15,7 @@ Proof. solve_matrix. Qed. -Lemma X_is_X : ZX_semantics (_X_) = σx. +Lemma X_is_X : ⟦ _X_ ⟧ = σx. Proof. simpl. unfold X_semantics; solve_matrix. @@ -23,7 +24,6 @@ Proof. all: split; nonzero. Qed. - Lemma _H_is_box : _H_ ∝ □. Proof. prop_exists_nonzero (Cexp (PI/4)). @@ -35,17 +35,16 @@ Proof. try apply c_proj_eq; try simpl; try R_field_simplify; try reflexivity; (try split; try apply RtoC_neq; try apply sqrt2_neq_0; try auto). Qed. - -Lemma cnot_l_is_cnot : ZX_semantics _CNOT_ = (/ √ 2)%C .* cnot. +Lemma _Rz_is_Rz : forall α, ⟦ _Rz_ α ⟧ = phase_shift α. Proof. + intros. simpl. - unfold Z_semantics, X_semantics. - solve_matrix. - all: autorewrite with Cexp_db. - all: lca. + unfold Z_semantics, phase_shift. + simpl. + lma. Qed. -Lemma cnot_inv_is_swapped_cnot : ZX_semantics _CNOT_inv_ = (/ √ 2)%C .* (swap × cnot × swap)%M. +Lemma cnot_l_is_cnot : ⟦ _CNOT_ ⟧ = (/ (√ 2)%R) .* cnot. Proof. simpl. unfold Z_semantics, X_semantics. @@ -54,11 +53,141 @@ Proof. all: lca. Qed. -Lemma _Rz_is_Rz : forall α, ZX_semantics (_Rz_ α) = phase_shift α. +Lemma cnot_involutive : _CNOT_R ⟷ _CNOT_ ∝ n_wire 2. +Proof. + rewrite <- compose_assoc. + rewrite (compose_assoc (— ↕ (X 1 2 0))). + rewrite <- (stack_compose_distr (Z 2 1 0) (Z 1 2 0) — —). + rewrite Z_spider_1_1_fusion. + cleanup_zx. + rewrite (X_wrap_over_top_left 1 1). + rewrite (X_wrap_over_top_right 1 1) at 1. + rewrite <- wire_to_n_wire. + rewrite <- (wire_removal_l —) at 1. + rewrite <- (wire_removal_l —) at 6. + rewrite 2 stack_compose_distr. + rewrite (stack_assoc_back — — (X 1 2 0)). + rewrite (stack_assoc_back — — (X 2 1 0)). + simpl_casts. + bundle_wires. + rewrite (compose_assoc (— ↕ (⊂ ↕ —))). + rewrite wire_to_n_wire at 4. + rewrite (nwire_stack_compose_topleft (X 2 1 0) (Z 2 2 (0 + 0))). + rewrite <- (nwire_stack_compose_botleft (Z 2 2 (0 + 0)) (X 2 1 0)). + repeat rewrite <- compose_assoc. + rewrite (compose_assoc _ (n_wire 2 ↕ (X 2 1 0))). + rewrite <- (stack_compose_distr (n_wire 2) (n_wire (1 + 1)) (X 2 1 0) (X 1 2 0)). + rewrite X_spider_1_1_fusion. + rewrite Rplus_0_r. + simpl; cleanup_zx; simpl_casts. + rewrite (compose_assoc _ (— ↕ — ↕ X 2 2 _)). + rewrite stack_assoc. + simpl_casts. + rewrite <- (stack_compose_distr — — (— ↕ X 2 2 _)). + cleanup_zx. + rewrite wire_to_n_wire at 7. + rewrite <- X_wrap_over_top_left. + rewrite (stack_assoc_back — ⊂ —). + rewrite stack_assoc_back. + simpl_casts. + rewrite <- (stack_compose_distr (— ↕ ⊂) (Z 2 2 _ ↕ —) — —). + cleanup_zx. + rewrite wire_to_n_wire at 1. + erewrite <- (cast_id _ _ (n_wire 1 ↕ ⊂)). + rewrite <- Z_wrap_under_bot_left. + erewrite <- (cast_id _ _ (Z _ (1 + 2) _)); + simpl_casts. + rewrite wire_to_n_wire. + rewrite grow_Z_bot_right. + rewrite grow_X_top_left. + rewrite stack_nwire_distribute_r. + rewrite stack_nwire_distribute_l. + repeat rewrite <- compose_assoc. + rewrite (compose_assoc _ (n_wire 1 ↕ Z 1 2 0 ↕ n_wire 1)). + rewrite stack_assoc. + simpl_casts. + rewrite <- wire_to_n_wire. + rewrite <- (stack_compose_distr — — (Z 1 2 0 ↕ —)). + rewrite <- stack_compose_distr. + cleanup_zx. + rewrite hopf_rule_Z_X. + rewrite wire_to_n_wire. + rewrite stack_nwire_distribute_r. + rewrite stack_nwire_distribute_l. + repeat rewrite <- compose_assoc. + rewrite stack_assoc_back. + simpl_casts. + rewrite <- (stack_nwire_distribute_r (Z 1 (1 + 1) 0) (n_wire 1 ↕ Z 1 0 0 )). + rewrite <- grow_Z_bot_right. + rewrite compose_assoc. + rewrite <- stack_nwire_distribute_l. + rewrite <- X_appendix_rot_l. + rewrite Rplus_0_r. + rewrite Z_0_is_wire, X_0_is_wire. + rewrite <- wire_to_n_wire. + rewrite <- (stack_compose_distr — — — —). + cleanup_zx. + easy. +Unshelve. +all: lia. +Qed. + +Lemma cnot_is_cnot_r : _CNOT_ ∝ _CNOT_R. Proof. intros. - simpl. - unfold Z_semantics, phase_shift. - simpl. - lma. + remember (— ↕ X 1 2 0 ⟷ (Z 2 1 0 ↕ —)) as RHS. + rewrite (Z_wrap_under_bot_left 1 1). + rewrite (X_wrap_over_top_left 1 1). + simpl_casts. + rewrite wire_to_n_wire at 2 3 4 5. + rewrite stack_nwire_distribute_l. + rewrite stack_nwire_distribute_r. + repeat rewrite <- compose_assoc. + rewrite (compose_assoc _ (Z (1 + 1) 1 0 ↕ (n_wire _) ↕ _)). + rewrite stack_assoc. + simpl_casts. + rewrite n_wire_stack. + rewrite (nwire_stack_compose_botleft (Z (1 + 1) 1 0) (n_wire 1 ↕ X 1 2 0)). + rewrite <- (nwire_stack_compose_topleft (n_wire 1 ↕ X 1 2 0)). + rewrite <- compose_assoc. + rewrite stack_assoc_back. + simpl_casts. + rewrite n_wire_stack. + rewrite <- (stack_compose_distr ((n_wire 1) ↕ ⊂) (n_wire 3) (n_wire 1) (X 1 2 0)). + cleanup_zx. + rewrite <- nwire_stack_compose_topleft. + rewrite compose_assoc. + rewrite nwire_stack_compose_botleft. + rewrite <- (nwire_stack_compose_topleft (⊃ ↕ n_wire 1)). + rewrite <- compose_assoc. + rewrite (compose_assoc _ (n_wire 1 ↕ ⊂ ↕ n_wire 2) _). + simpl; cleanup_zx; simpl_casts. + rewrite 2 stack_assoc; simpl_casts. + rewrite <- stack_wire_distribute_l. + rewrite 2 stack_assoc_back; simpl_casts. + rewrite <- (stack_wire_distribute_r (⊂ ↕ —) (— ↕ ⊃)). + rewrite yank_r. + bundle_wires. + cleanup_zx. + subst. + easy. +Unshelve. +all: lia. Qed. + +Lemma cnot_inv_is_swapped_cnot : _CNOT_inv_ ∝ ⨉ ⟷ _CNOT_ ⟷ ⨉. +Admitted. + +Lemma notc_is_swapp_cnot : _NOTC_ ∝ ⨉ ⟷ _CNOT_ ⟷ ⨉. +Admitted. + +Lemma notc_r_is_swapp_cnot_r : _NOTC_R ∝ ⨉ ⟷ _CNOT_R ⟷ ⨉. +Admitted. + +Lemma notc_is_notc_r : _NOTC_ ∝ _NOTC_R. +Proof. + rewrite notc_is_swapp_cnot. + rewrite cnot_is_cnot_r. + rewrite <- notc_r_is_swapp_cnot_r. + easy. +Qed. \ No newline at end of file diff --git a/src/Ingest/Ingest.v b/src/Ingest/Ingest.v index 5575ce7..78bbda4 100644 --- a/src/Ingest/Ingest.v +++ b/src/Ingest/Ingest.v @@ -13,186 +13,10 @@ Local Open Scope ZX_scope. (* Proving correctness of conversion *) -Lemma swap_correct : - ZX_semantics ⨉ = swap. -Proof. solve_matrix. Qed. - -(* A linear mapping which takes | x y1 ... yn > -> | y1 .. yn x > *) -Fixpoint top_wire_to_bottom (n : nat) : Square (2 ^ n) := - match n with - | 0 => I 1 - | S k => match k with - | 0 => I 2 - | S j => (@Mmult _ (2^n) _) ((I 2) ⊗ (top_wire_to_bottom k)) (swap ⊗ (j ⨂ (I 2))) - end - end. - -Open Scope matrix_scope. -Definition bottom_wire_to_top (n : nat) : Square (2 ^ n) := - (top_wire_to_bottom n)⊤. - -Lemma top_to_bottom_correct : forall n, ZX_semantics (top_to_bottom n) = top_wire_to_bottom n. -Proof. - intros. - destruct n; [ reflexivity | ]. - destruct n; [ easy | ]. - induction n. - - easy. - - simpl. - simpl in IHn. - rewrite <- IHn. - rewrite n_wire_semantics. - rewrite kron_n_I. - rewrite 2 id_kron. - replace (2 * 2 ^ n)%nat with (2 ^ n * 2)%nat by lia. - easy. -Qed. - -Lemma top_wire_to_bottom_ind : forall n, top_wire_to_bottom (S (S n)) = @Mmult _ (2 ^ (S (S n))) _ ((I 2) ⊗ top_wire_to_bottom (S n)) (swap ⊗ (I (2 ^ n))). -Proof. - intros. - induction n. - - Msimpl. - simpl. - Msimpl. - easy. - - rewrite IHn. - simpl. - apply Mmult_simplify. - + apply kron_simplify; easy. - + apply kron_simplify; [easy | ]. - rewrite kron_n_I. - rewrite id_kron. - replace (2 ^ n + (2 ^ n + 0))%nat with (2 ^ n * 2)%nat by lia. - easy. -Qed. - -Lemma bottom_wire_to_top_ind : forall n, bottom_wire_to_top (S (S n)) = @Mmult _ (2 ^ (S (S n))) _ (swap ⊗ (I (2 ^ n))) ((I 2) ⊗ bottom_wire_to_top (S n)). -Proof. - intros. - apply transpose_matrices. - unfold bottom_wire_to_top. - rewrite Mmult_transpose. - restore_dims. - rewrite Matrix.transpose_involutive. - restore_dims. - rewrite (kron_transpose 2 2 (2 ^ (S n)) (2 ^ S n)). - replace (Nat.pow 2 (S (S n)))%nat with ((2 * 2) * (2 ^ n))%nat by (simpl; lia). - rewrite (kron_transpose (2 * 2) (2 * 2) (2 ^ n) (2 ^ n) swap (I (2 ^ n))). - rewrite 2 id_transpose_eq. - rewrite swap_transpose. - rewrite Matrix.transpose_involutive. - restore_dims. - rewrite (top_wire_to_bottom_ind n). - easy. -Qed. - -(* Well foundedness of semantics *) - -Lemma WF_top_to_bottom (n : nat) : WF_Matrix (top_wire_to_bottom n). -Proof. - destruct n; try auto with wf_db. - induction n. - - simpl. - auto with wf_db. - - unfold top_wire_to_bottom. - apply WF_mult; try auto with wf_db. - apply WF_kron. - 1,2: simpl; lia. - all: auto with wf_db. -Qed. - -Global Hint Resolve WF_top_to_bottom : wf_db. - -Lemma WF_bottom_to_top (n : nat) : WF_Matrix (bottom_wire_to_top n). -Proof. unfold bottom_wire_to_top. auto with wf_db. Qed. - -Global Hint Resolve WF_bottom_to_top : wf_db. - -Lemma bottom_to_top_correct : forall n, ZX_semantics (bottom_to_top n) = bottom_wire_to_top n. -Proof. - intros. - unfold bottom_to_top. - unfold bottom_wire_to_top. - rewrite semantics_transpose_comm. - rewrite top_to_bottom_correct. - easy. -Qed. - -Lemma swap_spec' : swap = ((ket 0 × bra 0) ⊗ (ket 0 × bra 0) .+ (ket 0 × bra 1) ⊗ (ket 1 × bra 0) - .+ (ket 1 × bra 0) ⊗ (ket 0 × bra 1) .+ (ket 1 × bra 1) ⊗ (ket 1 × bra 1)). -Proof. - solve_matrix. -Qed. - -Definition a_swap_semantics (n : nat) : Square (2 ^ n) := - match n with - | 0 => I 1 - | S k => (@Mmult _ (2 ^ n) _ ((I 2) ⊗ top_wire_to_bottom (k)) ((bottom_wire_to_top (S k)))) - end. - -Lemma a_swap_correct : forall n, ZX_semantics (a_swap n) = a_swap_semantics n. -Proof. - intros. - unfold a_swap_semantics. - destruct n; [ reflexivity | ]. - rewrite <- bottom_to_top_correct. - rewrite <- top_to_bottom_correct. - simpl. - easy. -Qed. - -Lemma WF_a_swap_semantics (n : nat) : - WF_Matrix (a_swap_semantics n). -Proof. - intros. - unfold a_swap_semantics. - destruct n; auto with wf_db. -Qed. - -Global Hint Resolve WF_a_swap_semantics : wf_db. - -(* TODO: Move these to somewhere appropriate *) -Lemma stack_semantics {n m o p} : forall (zx0 : ZX n m) (zx1 : ZX o p), - ZX_semantics (zx0 ↕ zx1) = ZX_semantics zx0 ⊗ ZX_semantics zx1. -Proof. easy. Qed. - -(* TODO: Move these to somewhere appropriate *) -Lemma compose_semantics {n m o} : forall (zx0 : ZX n m) (zx1 : ZX m o), - ZX_semantics (zx0 ⟷ zx1) = @Mmult (2 ^ n) (2 ^ m) (2 ^ o) (ZX_semantics zx1) (ZX_semantics zx0). -Proof. easy. Qed. - -Lemma matrix_offset_swaps_comm_bottom_right : - I 2 ⊗ swap × (swap ⊗ I 2) = - swap ⊗ I 2 × (I 2 ⊗ swap) × (swap ⊗ I 2) × (I 2 ⊗ swap). -Proof. - - (* solve_matrix. *) -Admitted. - -(* Lemma matrix_offset_swaps_comm_top_left : - swap ⊗ I 2 × (I 2 ⊗ swap) = - I 2 ⊗ swap × (swap ⊗ I 2) × (I 2 ⊗ swap) × (swap ⊗ I 2) -Proof. solve_matrix. Qed. *) - -Lemma a_swap_ind : forall n, a_swap_semantics (S (S (S n))) = swap ⊗ (I (2 ^ (S n))) × (I 2 ⊗ a_swap_semantics (S (S n))) × (swap ⊗ (I (2 ^ (S n)))). -Proof. - intros. - remember (swap ⊗ I (2 ^ S n) × (I 2 ⊗ a_swap_semantics (S (S n))) × (swap ⊗ I (2 ^ S n))) as right_side. - unfold a_swap_semantics. - rewrite bottom_wire_to_top_ind. - rewrite top_wire_to_bottom_ind. - rewrite <- Mmult_assoc. - rewrite kron_id_dist_l. - replace (2 ^ S n)%nat with (2 * 2 ^ n)%nat by (simpl; lia). - rewrite <- id_kron. -Admitted. - - Lemma a_swap_sem_base : forall n, a_swap_semantics (S (S n)) = uc_eval (@SWAP (S (S n)) 0 (S n)). Proof. intros. - assert (forall q q', q = qubit0 \/ q = qubit1 -> q' = qubit0 \/ q' = qubit1 -> swap × (I 2 ⊗ (q × q'†)) × swap = (q × q'†) ⊗ I 2). + assert (forall q q', q = qubit0 \/ q = qubit1 -> q' = qubit0 \/ q' = qubit1 -> swap × (I 2 ⊗ (q × q'†%M)) × swap = (q × q'†%M) ⊗ I 2). { intros. destruct H; destruct H0; subst; solve_matrix. @@ -203,8 +27,8 @@ Proof. unfold ueval_swap. simpl. gridify. - unfold bottom_wire_to_top. - unfold top_wire_to_bottom. + unfold Swaps.bottom_wire_to_top. + unfold Swaps.top_wire_to_bottom. rewrite unfold_pad. simpl. rewrite id_kron. @@ -215,7 +39,7 @@ Proof. rewrite swap_transpose. Msimpl. apply swap_spec'. - - rewrite a_swap_ind. + - rewrite a_swap_semantics_ind. rewrite IHn. simpl. rewrite 2 denote_swap. @@ -330,8 +154,10 @@ Qed. Lemma cnot_dim_conv : forall n m dim, (n (m dim = (n + (m - n) + (dim - m))%nat. Proof. intros. - rewrite <- (le_plus_minus n m). - rewrite <- (le_plus_minus). + rewrite (Nat.add_comm n (m - n)). + rewrite (Nat.sub_add n m). + rewrite Nat.add_comm. + rewrite Nat.sub_add. easy. all: bdestruct (n (m < dim)%nat -> (n < m)%nat -> / √ 2 .* uc_eval (@CNOT dim n m) = ZX_semantics (@cnot_n_m_ingest dim n m). +Lemma cnot_n_m_equiv : forall dim n m, (n < dim)%nat -> (m < dim)%nat -> (n < m)%nat -> / (√ 2)%R .* uc_eval (@CNOT dim n m) = ⟦ @cnot_n_m_ingest dim n m ⟧. Proof. intros. rewrite denote_cnot. @@ -710,7 +536,7 @@ Proof. rewrite pad_bot_top_semantics. repeat rewrite kron_assoc; try auto with wf_db; [| shelve]. rewrite <- unpadded_cnot_simpl_args_sem. - rewrite <- minus_Sn_m; try lia. + rewrite Nat.sub_succ_l; try lia. destruct (m - n)%nat eqn:Hmn1; try (exfalso; lia). pose proof (unpadded_cnot_t_sem_equiv n0) as H_unpad_n0. rewrite <- H_unpad_n0. @@ -743,7 +569,7 @@ Unshelve. easy. Qed. -Lemma cnot_m_n_equiv : forall dim n m, (n < dim)%nat -> (m < dim)%nat -> (m < n)%nat -> / √ 2 .* uc_eval (@CNOT dim n m) = ZX_semantics (@cnot_m_n_ingest dim n m). +Lemma cnot_m_n_equiv : forall dim n m, (n < dim)%nat -> (m < dim)%nat -> (m < n)%nat -> / (√ 2)%R .* uc_eval (@CNOT dim n m) = ⟦ @cnot_m_n_ingest dim n m ⟧. Proof. intros. rewrite denote_cnot. @@ -760,7 +586,7 @@ Proof. rewrite pad_bot_top_semantics. repeat rewrite kron_assoc; try auto with wf_db; [| shelve]. rewrite <- unpadded_cnot_simpl_args_sem. - rewrite <- minus_Sn_m; try lia. + rewrite Nat.sub_succ_l; try lia. destruct (n - m)%nat eqn:Hmn1; try (exfalso; lia). pose proof (unpadded_cnot_b_sem_equiv n0) as H_unpad_n0. rewrite <- H_unpad_n0. @@ -793,7 +619,7 @@ Unshelve. easy. Qed. -Lemma cnot_ingest_correct : forall dim n m, (n < dim)%nat -> (m < dim)%nat -> (m <> n)%nat -> / √ 2 .* uc_eval (@CNOT dim n m) = ZX_semantics (@cnot_ingest dim n m). +Lemma cnot_ingest_correct : forall dim n m, (n < dim)%nat -> (m < dim)%nat -> (m <> n)%nat -> / (√ 2)%R .* uc_eval (@CNOT dim n m) = ⟦ @cnot_ingest dim n m ⟧. Proof. intros. unfold cnot_ingest. @@ -831,7 +657,7 @@ Proof. - apply (n_wire dim). Defined. -Lemma gate_ingest_correct : forall n dim (zx : ZX 1 1) (A : Matrix 2 2), (n < dim)%nat -> ZX_semantics zx = A -> pad_u dim n A = ZX_semantics (@gate_ingest dim zx n). +Lemma gate_ingest_correct : forall n dim (zx : ZX 1 1) (A : Matrix 2 2), (n < dim)%nat -> ⟦ zx ⟧ = A -> pad_u dim n A = ⟦ @gate_ingest dim zx n ⟧. Proof. intros. unfold gate_ingest. @@ -850,14 +676,14 @@ Definition H_ingest {dim} n := gate_ingest dim □ n. Definition X_ingest {dim} n := gate_ingest dim (_X_) n. Definition Rz_ingest {dim} n α := gate_ingest dim (_Rz_ α) n. -Lemma H_ingest_correct : forall {dim} n, (n < dim)%nat -> @uc_eval dim (H n) = ZX_semantics (@H_ingest dim n). +Lemma H_ingest_correct : forall {dim} n, (n < dim)%nat -> @uc_eval dim (H n) = ⟦ @H_ingest dim n ⟧. Proof. intros. rewrite denote_H. apply gate_ingest_correct; easy. Qed. -Lemma X_ingest_correct : forall {dim} n, (n < dim)%nat -> @uc_eval dim (SQIR.X n) = ZX_semantics (@X_ingest dim n). +Lemma X_ingest_correct : forall {dim} n, (n < dim)%nat -> @uc_eval dim (SQIR.X n) = ⟦ @X_ingest dim n ⟧. Proof. intros. rewrite denote_X. @@ -865,7 +691,7 @@ Proof. apply X_is_X. Qed. -Lemma Rz_ingest_correct : forall {dim} n α, (n < dim)%nat -> @uc_eval dim (SQIR.Rz α n) = ZX_semantics (@Rz_ingest dim n α). +Lemma Rz_ingest_correct : forall {dim} n α, (n < dim)%nat -> @uc_eval dim (SQIR.Rz α n) = ⟦ @Rz_ingest dim n α ⟧. Proof. intros. rewrite denote_Rz. @@ -874,7 +700,7 @@ Proof. Qed. (* @nocheck name *) -Lemma SKIP_is_n_wire : forall dim, uc_eval (@SKIP (S dim)) = ZX_semantics (n_wire (S dim)). +Lemma SKIP_is_n_wire : forall dim, uc_eval (@SKIP (S dim)) = ⟦ n_wire (S dim) ⟧. Proof. intros. rewrite denote_SKIP; try lia. @@ -917,7 +743,7 @@ Definition ingest_list {n dim} (u : RzQGateSet.U n) (qs : list nat) (pf : List.l Theorem ingest_list_to_base_correct : forall {n dim} (u : RzQGateSet.U n) (qs : list nat) (pf : List.length qs = n), (bounded_list qs dim /\ List.NoDup qs) -> (* Proved equiv to well-typedness *) - exists c, c .* @uc_eval dim (@to_base n dim u qs pf) = ZX_semantics (@ingest_list _ dim u qs pf) /\ c <> C0. + exists c, c .* @uc_eval dim (@to_base n dim u qs pf) = ⟦ @ingest_list _ dim u qs pf ⟧ /\ c <> C0. Proof. intros. induction u. @@ -927,7 +753,7 @@ Proof. 3: apply Rz_ingest_correct. all: destruct H; unfold bounded_list in H. 1-3: apply H; left; easy. - - exists (/ √ 2 )%C; split; [ | apply nonzero_div_nonzero; apply Csqrt2_neq_0 ]. + - exists (/ (√ 2)%R )%C; split; [ | apply nonzero_div_nonzero; apply Csqrt2_neq_0 ]. do 3 (destruct qs; try easy). simpl. apply cnot_ingest_correct. @@ -941,7 +767,7 @@ Proof. easy. Qed. -Theorem ingest_correct : forall {dim} (u : ucom (RzQGateSet.U) dim), uc_well_typed u -> exists (c : C), c .* uc_eval (RzQToBaseUCom u) = ZX_semantics (ingest u) /\ (c <> C0). +Theorem ingest_correct : forall {dim} (u : ucom (RzQGateSet.U) dim), uc_well_typed u -> exists (c : C), c .* uc_eval (RzQToBaseUCom u) = ⟦ ingest u ⟧ /\ (c <> C0). Proof. intros. induction u. @@ -976,7 +802,7 @@ Proof. - inversion H. subst. simpl. - exists (/ √2)%C; split; [ | apply nonzero_div_nonzero; apply Csqrt2_neq_0 ]. + exists (/ (√2)%R)%C; split; [ | apply nonzero_div_nonzero; apply Csqrt2_neq_0 ]. rewrite cnot_ingest_correct; congruence. - simpl. exists C1; split; [ | nonzero ]. diff --git a/src/Ingest/ZXPad.v b/src/Ingest/ZXPad.v index 6b8e019..ca19480 100644 --- a/src/Ingest/ZXPad.v +++ b/src/Ingest/ZXPad.v @@ -10,17 +10,21 @@ Definition pad_bot_1 {n m} (zx : ZX n m) : ZX (S n) (S m) := cast _ _ (eq_sym (N Notation padbt zx := (pad_bot _ (pad_top _ zx)). Notation padtb zx := (pad_top _ (pad_bot _ zx)). -Lemma pad_top_contract : forall {n m} (zx : ZX n m) pad1 pad2, pad_top pad1 (pad_top pad2 zx) ∝ cast (pad1 + (pad2 + n)) (pad1 + (pad2 + m)) (Nat.add_assoc _ _ _) (Nat.add_assoc _ _ _) (pad_top (pad1 + pad2) zx). +Lemma pad_top_contract : forall {n m} (zx : ZX n m) pad1 pad2 prfn prfm, + pad_top pad1 (pad_top pad2 zx) ∝ cast (pad1 + (pad2 + n)) (pad1 + (pad2 + m)) prfn prfm (pad_top (pad1 + pad2) zx). Proof. intros. unfold pad_top. rewrite stack_assoc_back. simpl_casts. - rewrite n_wire_stack. + bundle_wires. easy. +Unshelve. +all: lia. Qed. -Lemma pad_bot_1_simpl : forall {n m} (zx : ZX n m), pad_bot 1 zx ∝ cast _ _ (Nat.add_1_r n) (Nat.add_1_r m) (pad_bot_1 zx). +Lemma pad_bot_1_simpl : forall {n m} (zx : ZX n m) prfn prfm, + pad_bot 1 zx ∝ cast _ _ prfn prfm (pad_bot_1 zx). Proof. intros. unfold pad_bot_1. @@ -28,41 +32,49 @@ Proof. easy. Qed. -Lemma pad_bot_contract : forall {n m} (zx : ZX n m) pad1 pad2, pad_bot pad2 (pad_bot pad1 zx) ∝ cast (n + pad1 + pad2) (m + pad1 + pad2) (eq_sym (Nat.add_assoc _ _ _)) (eq_sym (Nat.add_assoc _ _ _)) (pad_bot (pad1 + pad2) zx). +Lemma pad_bot_contract : forall {n m} (zx : ZX n m) pad1 pad2 prfn prfm, pad_bot pad2 (pad_bot pad1 zx) ∝ cast (n + pad1 + pad2) (m + pad1 + pad2) prfn prfm (pad_bot (pad1 + pad2) zx). Proof. intros. unfold pad_bot. rewrite stack_assoc. simpl_casts. - rewrite n_wire_stack. + bundle_wires. easy. +Unshelve. +all: lia. Qed. -Lemma pad_top_bot_comm : forall {n m} (zx : ZX n m) padT padB, (pad_top padT (pad_bot padB zx)) ∝ cast (padT + (n + padB)) (padT + (m + padB)) (Nat.add_assoc _ _ _) (Nat.add_assoc _ _ _) (pad_bot padB (pad_top padT zx)). +Lemma pad_top_bot_comm : forall {n m} (zx : ZX n m) padT padB prfn prfm, + (pad_top padT (pad_bot padB zx)) ∝ cast (padT + (n + padB)) (padT + (m + padB)) prfn prfm (pad_bot padB (pad_top padT zx)). Proof. intros. unfold pad_top, pad_bot. rewrite stack_assoc_back. simpl_casts. easy. +Unshelve. +all: lia. Qed. -Lemma pad_bot_top_comm : forall {n m} (zx : ZX n m) padT padB, (pad_bot padB (pad_top padT zx)) ∝ cast (padT + n + padB) (padT + m + padB) (eq_sym (Nat.add_assoc _ _ _)) (eq_sym (Nat.add_assoc _ _ _)) (pad_top padT (pad_bot padB zx)). +Lemma pad_bot_top_comm : forall {n m} (zx : ZX n m) padT padB prfn prfm, + (pad_bot padB (pad_top padT zx)) ∝ cast (padT + n + padB) (padT + m + padB) prfn prfm (pad_top padT (pad_bot padB zx)). Proof. intros. unfold pad_top, pad_bot. rewrite stack_assoc. simpl_casts. easy. +Unshelve. +all: lia. Qed. -Lemma pad_top_bot_semantics : forall {n m} (zx : ZX n m) padT padB, ZX_semantics (pad_top padT (pad_bot padB zx)) = I (2 ^ padT) ⊗ (ZX_semantics zx) ⊗ I (2 ^ padB). +Lemma pad_top_bot_semantics : forall {n m} (zx : ZX n m) padT padB, ⟦ pad_top padT (pad_bot padB zx) ⟧ = I (2 ^ padT) ⊗ (⟦ zx ⟧) ⊗ I (2 ^ padB). Proof. intros. simpl. rewrite 2 n_wire_semantics. rewrite kron_assoc; auto with wf_db. Qed. -Lemma pad_bot_top_semantics : forall {n m} (zx : ZX n m) padT padB, ZX_semantics (pad_bot padB (pad_top padT zx)) = I (2 ^ padT) ⊗ (ZX_semantics zx) ⊗ I (2 ^ padB). +Lemma pad_bot_top_semantics : forall {n m} (zx : ZX n m) padT padB, ⟦ pad_bot padB (pad_top padT zx) ⟧ = I (2 ^ padT) ⊗ (⟦ zx ⟧) ⊗ I (2 ^ padB). Proof. intros. simpl. rewrite 2 n_wire_semantics. easy. Qed. \ No newline at end of file