diff --git a/thys/QHLProver/Grover.thy b/thys/QHLProver/Grover.thy --- a/thys/QHLProver/Grover.thy +++ b/thys/QHLProver/Grover.thy @@ -1,3184 +1,3184 @@ section \Grover's algorithm\ theory Grover imports Partial_State Gates Quantum_Hoare begin subsection \Basic definitions\ locale grover_state = fixes n :: nat (* number of qubits *) and f :: "nat \ bool" (* characteristic function, only need values in [0,N). *) assumes n: "n > 1" and dimM: "card {i. i < (2::nat) ^ n \ f i} > 0" "card {i. i < (2::nat) ^ n \ f i} < (2::nat) ^ n" begin definition N where "N = (2::nat) ^ n" definition M where "M = card {i. i < N \ f i}" lemma N_ge_0 [simp]: "0 < N" by (simp add: N_def) lemma M_ge_0 [simp]: "0 < M" by (simp add: M_def dimM N_def) lemma M_neq_0 [simp]: "M \ 0" by simp lemma M_le_N [simp]: "M < N" by (simp add: M_def dimM N_def) lemma M_not_ge_N [simp]: "\ M \ N" using M_le_N by arith definition \ :: "complex vec" where "\ = Matrix.vec N (\i. 1 / sqrt N)" lemma \_dim [simp]: "\ \ carrier_vec N" "dim_vec \ = N" by (simp add: \_def)+ lemma \_eval: "i < N \ \ $i = 1 / sqrt N" by (simp add: \_def) lemma \_inner: "inner_prod \ \ = 1" apply (simp add: \_eval scalar_prod_def) by (smt of_nat_less_0_iff of_real_mult of_real_of_nat_eq real_sqrt_mult_self) lemma \_norm: "vec_norm \ = 1" by (simp add: \_eval vec_norm_def scalar_prod_def) definition \ :: "complex vec" where "\ = Matrix.vec N (\i. if f i then 0 else 1 / sqrt (N - M))" lemma \_dim [simp]: "\ \ carrier_vec N" "dim_vec \ = N" by (simp add: \_def)+ lemma \_eval: "i < N \ \$ i = (if f i then 0 else 1 / sqrt (N - M))" by (simp add: \_def) lemma \_inner: "inner_prod \ \ = 1" apply (simp add: scalar_prod_def \_eval) apply (subst sum.mono_neutral_cong_right[of "{0.. f i}"]) apply auto apply (subgoal_tac "card ({0.. f i}) = N - M") subgoal by (metis of_nat_0_le_iff of_real_of_nat_eq of_real_power power2_eq_square real_sqrt_pow2) unfolding N_def M_def by (metis (no_types, lifting) atLeastLessThan_iff card.infinite card_Diff_subset card_atLeastLessThan diff_zero dimM(1) mem_Collect_eq neq0_conv subsetI zero_order(1)) definition \ :: "complex vec" where "\ = Matrix.vec N (\i. if f i then 1 / sqrt M else 0)" lemma \_dim [simp]: "\ \ carrier_vec N" "dim_vec \ = N" by (simp add: \_def)+ lemma \_eval: "i < N \ \ \$ i = (if f i then 1 / sqrt M else 0)" by (simp add: \_def) lemma \_inner: "inner_prod \ \ = 1" apply (simp add: scalar_prod_def \_eval) apply (subst sum.mono_neutral_cong_right[of "{0.. f i}"]) apply auto apply (fold M_def) by (metis of_nat_0_le_iff of_real_of_nat_eq of_real_power power2_eq_square real_sqrt_pow2) lemma alpha_beta_orth: "inner_prod \ \ = 0" unfolding \_def \_def by (simp add: scalar_prod_def) lemma beta_alpha_orth: "inner_prod \ \ = 0" unfolding \_def \_def by (simp add: scalar_prod_def) definition \ :: real where "\ = 2 * arccos (sqrt ((N - M) / N))" lemma cos_theta_div_2: "cos (\ / 2) = sqrt ((N - M) / N)" proof - have "\ / 2 = arccos (sqrt ((N - M) / N))" using \_def by simp then show "cos (\ / 2) = sqrt ((N - M) / N)" by (simp add: cos_arccos_abs) qed lemma sin_theta_div_2: "sin (\ / 2) = sqrt (M / N)" proof - have a: "\ / 2 = arccos (sqrt ((N - M) / N))" using \_def by simp have N: "N > 0" using N_def by auto have M: "M < N" using M_def dimM N_def by auto then show "sin (\ / 2) = sqrt (M / N)" unfolding a apply (simp add: sin_arccos_abs) proof - have eq: "real (N - M) = real N - real M" using N M using M_not_ge_N nat_le_linear of_nat_diff by blast have "1 - real (N - M) / real N = (real N - (real N - real M)) / real N" unfolding eq using N by (metis diff_divide_distrib divide_self_if eq gr_implies_not0 of_nat_0_eq_iff) then show "1 - real (N - M) / real N = real M / real N" by auto qed qed lemma \_neq_0: "\ \ 0" proof - { assume "\ = 0" then have "\ / 2 = 0" by auto then have "sin (\ / 2) = 0" by auto } note z = this have "sin (\ / 2) = sqrt (M / N)" using sin_theta_div_2 by auto moreover have "M > 0" unfolding M_def N_def using dimM by auto ultimately have "sin (\ / 2) > 0" by auto with z show ?thesis by auto qed abbreviation ccos where "ccos \ \ complex_of_real (cos \)" abbreviation csin where "csin \ \ complex_of_real (sin \)" lemma \_eq: "\ = ccos (\ / 2) \\<^sub>v \ + csin (\ / 2) \\<^sub>v \" apply (simp add: cos_theta_div_2 sin_theta_div_2) apply (rule eq_vecI) by (auto simp add: \_def \_def \_def real_sqrt_divide) lemma psi_inner_alpha: "inner_prod \ \ = ccos (\ / 2)" unfolding \_eq proof - have "inner_prod (ccos (\ / 2) \\<^sub>v \) \ = ccos (\ / 2)" apply (subst inner_prod_smult_right[of _ N]) using \_dim \_inner by auto moreover have "inner_prod (csin (\ / 2) \\<^sub>v \) \ = 0" apply (subst inner_prod_smult_right[of _ N]) using \_dim \_dim beta_alpha_orth by auto ultimately show "inner_prod (ccos (\ / 2) \\<^sub>v \ + csin (\ / 2) \\<^sub>v \) \ = ccos (\ / 2)" apply (subst inner_prod_distrib_left[of _ N]) using \_dim \_dim by auto qed lemma psi_inner_beta: "inner_prod \ \ = csin (\ / 2)" unfolding \_eq proof - have "inner_prod (ccos (\ / 2) \\<^sub>v \) \ = 0" apply (subst inner_prod_smult_right[of _ N]) using \_dim \_dim alpha_beta_orth by auto moreover have "inner_prod (csin (\ / 2) \\<^sub>v \) \ = csin (\ / 2)" apply (subst inner_prod_smult_right[of _ N]) using \_dim \_inner by auto ultimately show "inner_prod (ccos (\ / 2) \\<^sub>v \ + csin (\ / 2) \\<^sub>v \) \ = csin (\ / 2)" apply (subst inner_prod_distrib_left[of _ N]) using \_dim \_dim by auto qed definition alpha_l :: "nat \ complex" where "alpha_l l = ccos ((l + 1 / 2) * \)" lemma alpha_l_real: "alpha_l l \ Reals" unfolding alpha_l_def by auto lemma cnj_alpha_l: "conjugate (alpha_l l) = alpha_l l" using alpha_l_real Reals_cnj_iff by auto definition beta_l :: "nat \ complex" where "beta_l l = csin ((l + 1 / 2) * \)" lemma beta_l_real: "beta_l l \ Reals" unfolding beta_l_def by auto lemma cnj_beta_l: "conjugate (beta_l l) = beta_l l" using beta_l_real Reals_cnj_iff by auto lemma csin_ccos_squared_add: "ccos (a::real) * ccos a + csin a * csin a = 1" by (smt cos_diff cos_zero of_real_add of_real_hom.hom_one of_real_mult) lemma alpha_l_beta_l_add_norm: "alpha_l l * alpha_l l + beta_l l * beta_l l = 1" using alpha_l_def beta_l_def csin_ccos_squared_add by auto definition psi_l where "psi_l l = (alpha_l l) \\<^sub>v \ + (beta_l l) \\<^sub>v \" lemma psi_l_dim: "psi_l l \ carrier_vec N" unfolding psi_l_def \_def \_def by auto lemma inner_psi_l: "inner_prod (psi_l l) (psi_l l) = 1" proof - have eq0: "inner_prod (psi_l l) (psi_l l) = inner_prod ((alpha_l l) \\<^sub>v \) (psi_l l) + inner_prod ((beta_l l) \\<^sub>v \) (psi_l l)" unfolding psi_l_def apply (subst inner_prod_distrib_left) using \_def \_def by auto have "inner_prod ((alpha_l l) \\<^sub>v \) (psi_l l) = inner_prod ((alpha_l l) \\<^sub>v \) ((alpha_l l) \\<^sub>v \) + inner_prod ((alpha_l l) \\<^sub>v \) ((beta_l l) \\<^sub>v \)" unfolding psi_l_def apply (subst inner_prod_distrib_right) using \_def \_def by auto also have "\ = (conjugate (alpha_l l)) * (alpha_l l) * inner_prod \ \ + (conjugate (alpha_l l)) * (beta_l l) * inner_prod \ \" apply (subst (1 2) inner_prod_smult_left_right) using \_def \_def by auto also have "\ = conjugate (alpha_l l) * (alpha_l l) " by (simp add: alpha_beta_orth \_inner) also have "\ = (alpha_l l) * (alpha_l l)" using cnj_alpha_l by simp finally have eq1: "inner_prod (alpha_l l \\<^sub>v \) (psi_l l) = alpha_l l * alpha_l l". have "inner_prod ((beta_l l) \\<^sub>v \) (psi_l l) = inner_prod ((beta_l l) \\<^sub>v \) ((alpha_l l) \\<^sub>v \) + inner_prod ((beta_l l) \\<^sub>v \) ((beta_l l) \\<^sub>v \)" unfolding psi_l_def apply (subst inner_prod_distrib_right) using \_def \_def by auto also have "\ = (conjugate (beta_l l)) * (alpha_l l) * inner_prod \ \ + (conjugate (beta_l l)) * (beta_l l) * inner_prod \ \" apply (subst (1 2) inner_prod_smult_left_right) using \_def \_def by auto also have "\ = (conjugate (beta_l l)) * (beta_l l)" using \_inner beta_alpha_orth by auto also have "\ = (beta_l l) * (beta_l l)" using cnj_beta_l by auto finally have eq2: "inner_prod (beta_l l \\<^sub>v \) (psi_l l) = beta_l l * beta_l l". show ?thesis unfolding eq0 eq1 eq2 using alpha_l_beta_l_add_norm by auto qed abbreviation proj :: "complex vec \ complex mat" where "proj v \ outer_prod v v" definition psi'_l where "psi'_l l = (alpha_l l) \\<^sub>v \ - (beta_l l) \\<^sub>v \" lemma psi'_l_dim: "psi'_l l \ carrier_vec N" unfolding psi'_l_def \_def \_def by auto definition proj_psi'_l where "proj_psi'_l l = proj (psi'_l l)" lemma proj_psi'_dim: "proj_psi'_l l \ carrier_mat N N" unfolding proj_psi'_l_def using psi'_l_dim by auto lemma psi_inner_psi'_l: "inner_prod \ (psi'_l l) = (alpha_l l * ccos (\ / 2) - beta_l l * csin (\ / 2))" proof - have "inner_prod \ (psi'_l l) = inner_prod \ (alpha_l l \\<^sub>v \) - inner_prod \ (beta_l l \\<^sub>v \)" unfolding psi'_l_def apply (subst inner_prod_minus_distrib_right[of _ N]) by auto also have "\ = alpha_l l * (inner_prod \ \) - beta_l l * (inner_prod \ \)" using \_dim \_dim \_dim by auto also have "\ = alpha_l l * (ccos (\ / 2)) - beta_l l * (csin (\ / 2))" using psi_inner_alpha psi_inner_beta by auto finally show ?thesis by auto qed lemma double_ccos_square: "2 * ccos (a::real) * ccos a = ccos (2 * a) + 1" proof - have eq: "ccos (2 * a) = ccos a * ccos a - csin a * csin a" using cos_add[of a a] by auto have "csin a * csin a = 1 - ccos a * ccos a" using csin_ccos_squared_add[of a] by (metis add_diff_cancel_left') then have "ccos a * ccos a - csin a * csin a = 2 * ccos a * ccos a - 1" by simp with eq show ?thesis by simp qed lemma double_csin_square: "2 * csin (a::real) * csin a = 1 - ccos (2 * a)" proof - have eq: "ccos (2 * a) = ccos a * ccos a - csin a * csin a" using cos_add[of a a] by auto have "ccos a * ccos a = 1 - csin a * csin a" using csin_ccos_squared_add[of a] by (auto intro: add_implies_diff) then have "ccos a * ccos a - csin a * csin a = 1 - 2 * csin (a::real) * csin a" by simp with eq show ?thesis by simp qed lemma csin_double: "2 * csin (a::real) * ccos a = csin(2 * a)" using sin_add[of a a] by simp lemma ccos_add: "ccos (x + y) = ccos x * ccos y - csin x * csin y" using cos_add[of x y] by simp lemma alpha_l_Suc_l_derive: "2 * (alpha_l l * ccos (\ / 2) - beta_l l * csin (\ / 2)) * ccos (\ / 2) - alpha_l l = alpha_l (l + 1)" (is "?lhs = ?rhs") proof - have "2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) * ccos (\ / 2) = (alpha_l l) * (2 * ccos (\ / 2)* ccos (\ / 2)) - (beta_l l) * (2 * csin (\ / 2) * ccos (\ / 2))" by (simp add: left_diff_distrib) also have "\ = (alpha_l l) * (ccos (\) + 1) - (beta_l l) * csin \" using double_ccos_square csin_double by auto finally have "2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) * ccos (\ / 2) = (alpha_l l) * (ccos (\) + 1) - (beta_l l) * csin \". then have "?lhs = (alpha_l l) * ccos (\) - (beta_l l) * csin \" by (simp add: algebra_simps) also have "\ = (alpha_l (l + 1))" unfolding alpha_l_def beta_l_def apply (subst ccos_add[of "(real l + 1 / 2) * \" "\", symmetric]) by (simp add: algebra_simps) finally show ?thesis by auto qed lemma csin_add: "csin (x + y) = ccos x * csin y + csin x * ccos y" using sin_add[of x y] by simp lemma beta_l_Suc_l_derive: "2 * (alpha_l l * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) * csin (\ / 2) + beta_l l = beta_l (l + 1)" (is "?lhs = ?rhs") proof - have "2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) * csin (\ / 2) = (alpha_l l) * (2 * csin (\ / 2)* ccos (\ / 2)) - (beta_l l) * (2 * csin (\ / 2) * csin (\ / 2))" by (simp add: left_diff_distrib) also have "\ = (alpha_l l) * (csin \) - (beta_l l) * (1 - ccos (\))" using double_csin_square csin_double by auto finally have "2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) * csin (\ / 2) = (alpha_l l) * (csin \) - (beta_l l) * (1 - ccos (\))". then have "?lhs = (alpha_l l) * (csin \) + (beta_l l) * ccos \" by (simp add: algebra_simps) also have "\ = (beta_l (l + 1))" unfolding alpha_l_def beta_l_def apply (subst csin_add[of "(real l + 1 / 2) * \" "\", symmetric]) by (simp add: algebra_simps) finally show ?thesis by auto qed lemma psi_l_Suc_l_derive: "2 * (alpha_l l * ccos (\ / 2) - beta_l l * csin (\ / 2)) \\<^sub>v \ - psi'_l l = psi_l (l + 1)" (is "?lhs = ?rhs") proof - let ?l = "2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2))" have "?l \\<^sub>v \ = ?l \\<^sub>v (ccos (\ / 2) \\<^sub>v \ + csin (\ / 2) \\<^sub>v \)" unfolding \_eq by auto also have "\ = ?l \\<^sub>v (ccos (\ / 2) \\<^sub>v \) + ?l \\<^sub>v (csin (\ / 2) \\<^sub>v \)" apply (subst smult_add_distrib_vec[of _ N]) using \_dim \_dim by auto also have "\ = (?l * ccos (\ / 2)) \\<^sub>v \ + (?l * csin (\ / 2)) \\<^sub>v \" by auto finally have "?l \\<^sub>v \ = (?l * ccos (\ / 2)) \\<^sub>v \ + (?l * csin (\ / 2)) \\<^sub>v \". then have "?l \\<^sub>v \ - (psi'_l l) = ((?l * ccos (\ / 2)) \\<^sub>v \ - (alpha_l l) \\<^sub>v \) + ((?l * csin (\ / 2)) \\<^sub>v \ + (beta_l l) \\<^sub>v \)" unfolding psi'_l_def by auto also have "\ = (?l * ccos (\ / 2) - alpha_l l) \\<^sub>v \ + (?l * csin (\ / 2) + beta_l l) \\<^sub>v \" apply (subst minus_smult_vec_distrib) apply (subst add_smult_distrib_vec) by auto also have "\ = (alpha_l (l + 1)) \\<^sub>v \ + (beta_l (l + 1)) \\<^sub>v \" using alpha_l_Suc_l_derive beta_l_Suc_l_derive by auto finally have "?l \\<^sub>v \ - (psi'_l l) = (alpha_l (l + 1)) \\<^sub>v \ + (beta_l (l + 1)) \\<^sub>v \". then show ?thesis unfolding psi_l_def by auto qed subsection \Grover operator\ text \Oracle O\ definition proj_O :: "complex mat" where "proj_O = mat N N ($$i, j). if i = j then (if f i then 1 else 0) else 0)" lemma proj_O_dim: "proj_O \ carrier_mat N N" unfolding proj_O_def by auto lemma proj_O_mult_alpha: "proj_O *\<^sub>v \ = zero_vec N" by (auto simp add: proj_O_def \_def scalar_prod_def) lemma proj_O_mult_beta: "proj_O *\<^sub>v \ = \" by (auto simp add: proj_O_def \_def scalar_prod_def sum_only_one_neq_0) definition mat_O :: "complex mat" where "mat_O = mat N N (\(i,j). if i = j then (if f i then -1 else 1) else 0)" lemma mat_O_dim: "mat_O \ carrier_mat N N" unfolding mat_O_def by auto lemma mat_O_mult_alpha: "mat_O *\<^sub>v \ = \" by (auto simp add: mat_O_def \_def scalar_prod_def sum_only_one_neq_0) lemma mat_O_mult_beta: "mat_O *\<^sub>v \ = - \" by (auto simp add: mat_O_def \_def scalar_prod_def sum_only_one_neq_0) lemma hermitian_mat_O: "hermitian mat_O" by (auto simp add: hermitian_def mat_O_def adjoint_eval) lemma unitary_mat_O: "unitary mat_O" proof - have "mat_O \ carrier_mat N N" unfolding mat_O_def by auto moreover have "mat_O * adjoint mat_O = mat_O * mat_O" using hermitian_mat_O unfolding hermitian_def by auto moreover have "mat_O * mat_O = 1\<^sub>m N" apply (rule eq_matI) unfolding mat_O_def apply (simp add: scalar_prod_def) subgoal for i j apply (rule) subgoal apply (subst sum_only_one_neq_0[of "{0..(i,j). if i = j then if i = 0 then 1 else -1 else 0)" lemma hermitian_mat_Ph: "hermitian mat_Ph" unfolding hermitian_def mat_Ph_def apply (rule eq_matI) by (auto simp add: adjoint_eval) lemma unitary_mat_Ph: "unitary mat_Ph" proof - have "mat_Ph \ carrier_mat N N" unfolding mat_Ph_def by auto moreover have "mat_Ph * adjoint mat_Ph = mat_Ph * mat_Ph" using hermitian_mat_Ph unfolding hermitian_def by auto moreover have "mat_Ph * mat_Ph = 1\<^sub>m N" apply (rule eq_matI) unfolding mat_Ph_def apply (simp add: scalar_prod_def) subgoal for i j apply (rule) subgoal apply (subst sum_only_one_neq_0[of "{0..(i,j). if i = j then 2 / N - 1 else 2 / N)" text \Geometrically, the Grover operator G is a rotation\ definition mat_G :: "complex mat" where "mat_G = mat_G' * mat_O" end subsection \State of Grover's algorithm\ text \The dimensions are [2, 2, ..., 2, n]. We work with a very special case as in the paper\ locale grover_state_sig = grover_state + state_sig + fixes R :: nat fixes K :: nat assumes dims_def: "dims = replicate n 2 @ [K]" assumes R: "R = pi / (2 *$$ - 1 / 2" assumes K: "K > R" begin lemma K_gt_0: "K > 0" using K by auto text \Bits q0 to q\_(n-1)\ definition vars1 :: "nat set" where "vars1 = {0 ..< n}" text \Bit r\ definition vars2 :: "nat set" where "vars2 = {n}" lemma length_dims: "length dims = n + 1" unfolding dims_def by auto lemma dims_nth_lt_n: "l < n \ nth dims l = 2" unfolding dims_def by (simp add: nth_append) lemma nths_Suc_n_dims: "nths dims {0..<(Suc n)} = dims" using length_dims nths_upt_eq_take by (metis add_Suc_right add_Suc_shift lessThan_atLeast0 less_add_eq_less less_numeral_extra(4) not_less plus_1_eq_Suc take_all) interpretation ps2_P: partial_state2 dims vars1 vars2 apply unfold_locales unfolding vars1_def vars2_def by auto interpretation ps_P: partial_state ps2_P.dims0 ps2_P.vars1'. abbreviation tensor_P where "tensor_P A B \ ps2_P.ptensor_mat A B" lemma tensor_P_dim: "tensor_P A B \ carrier_mat d d" proof - have "ps2_P.d0 = prod_list (nths dims ({0.. {n}))" unfolding ps2_P.d0_def ps2_P.dims0_def ps2_P.vars0_def by (simp add: vars1_def vars2_def) also have "\ = prod_list (nths dims ({0.. {n} = {0..<(Suc n)}") by auto also have "\ = prod_list dims" using nths_Suc_n_dims by auto also have "\ = d" unfolding d_def by auto finally show ?thesis using ps2_P.ptensor_mat_carrier by auto qed lemma dims_nths_le_n: assumes "l \ n" shows "nths dims {0.. n \ (i < Suc n \ i < l) = (i < l)" for i using less_trans by fastforce then show l: "length (nths dims {0..i. i < l \ {a. a < i \ a \ {0..i. i < l \ card {j. j < i \ j \ {0.. i \ {l}} = {l}" using assms length_dims by auto then have "nths dims {l} = [dims ! l]" using nths_only_one[of dims "{l}" l] by auto moreover have "dims ! l = 2" unfolding dims_def using assms by (simp add: nth_append) ultimately show ?thesis by auto qed lemma dims_vars1: "nths dims vars1 = replicate n 2" proof (rule nth_equalityI, auto) show l: "length (nths dims vars1) = n" apply (auto simp add: length_nths vars1_def length_dims) by (metis (no_types, lifting) Collect_cong Suc_lessD card_Collect_less_nat not_less_eq) have v1: "\i. i < n \ {a. a < i \ a \ vars1} = {0..i. i < n \ card {j. j < i \ j \ vars1} = i" by auto then have "nths dims vars1 ! i = dims ! i" if "i < n" for i using nth_nths_card[of i dims vars1] that length_dims vars1_def by auto moreover have "dims ! i = replicate n 2 ! i" if "i < n" for i unfolding dims_def by (simp add: nth_append that) ultimately show "nths dims vars1 ! i = replicate n 2 ! i" if "i < length (nths dims vars1)" for i using l that by auto qed lemma nths_rep_2_n: "nths (replicate n 2) {n} = []" by (metis (no_types, lifting) Collect_empty_eq card.empty length_0_conv length_replicate less_Suc_eq not_less_eq nths_replicate singletonD) lemma dims_vars2: "nths dims vars2 = [K]" unfolding dims_def vars2_def apply (subst nths_append) apply (subst nths_rep_2_n) by simp lemma d_vars1: "prod_list (nths dims vars1) = N" proof - have eq: "{0.. vars2 = {0.. vars2) = dims" unfolding vars1_def vars2_def using nths_Suc_n_dims by auto then show ?thesis unfolding ps2_P.dims0_def ps2_P.vars0_def apply (subst dims) by auto qed lemma ps2_P_vars1': "ps2_P.vars1' = vars1" unfolding ps2_P.vars1'_def ps2_P.vars0_def proof - have eq: "vars1 \ vars2 = {0..<(Suc n)}" unfolding vars1_def vars2_def by auto have "x < Suc n \ {i \ {0.. ind_in_set {0..<(Suc n)} x = x" for x unfolding ind_in_set_def by auto then have "x \ vars1 \ ind_in_set {0..<(Suc n)} x = x" for x unfolding vars1_def by auto then have "ind_in_set {0..<(Suc n)}  vars1 = vars1" by force with eq show "ind_in_set (vars1 \ vars2)  vars1 = vars1" by auto qed lemma ps2_P_d0: "ps2_P.d0 = d" unfolding ps2_P.d0_def using ps2_P_dims0 d_def by auto lemma ps2_P_d1: "ps2_P.d1 = N" unfolding ps2_P.d1_def ps2_P.dims1_def by (simp add: dims_vars1 N_def) lemma ps2_P_d2: "ps2_P.d2 = K" unfolding ps2_P.d2_def ps2_P.dims2_def by (simp add: dims_vars2) lemma ps_P_d: "ps_P.d = d" unfolding ps_P.d_def ps2_P_dims0 by auto lemma ps_P_d1: "ps_P.d1 = N" unfolding ps_P.d1_def ps_P.dims1_def ps2_P.nths_vars1' using ps2_P_d1 unfolding ps2_P.d1_def by auto lemma ps_P_d2: "ps_P.d2 = K" unfolding ps_P.d2_def ps_P.dims2_def ps2_P.nths_vars2' using ps2_P_d2 unfolding ps2_P.d2_def by auto lemma nths_uminus_vars1: "nths dims (- vars1) = nths dims vars2" using ps2_P.nths_vars2' unfolding ps2_P_dims0 ps2_P_vars1' ps2_P.dims2_def by auto lemma tensor_P_mult: assumes "m1 \ carrier_mat (2^n) (2^n)" and "m2 \ carrier_mat (2^n) (2^n)" and "m3 \ carrier_mat K K" and "m4 \ carrier_mat K K" shows "(tensor_P m1 m3) * (tensor_P m2 m4) = tensor_P (m1 * m2) (m3 * m4)" proof - have eq:"{0..m K)" unfolding Utrans_P_def ps2_P.ptensor_mat_def partial_state.mat_extension_def partial_state.d2_def partial_state.dims2_def ps2_P.nths_vars2'[simplified ps2_P_dims0 ps2_P_vars1'] using ps2_P_d2 unfolding ps2_P.d2_def using ps2_P_dims0 ps2_P_vars1' by auto lemma Utrans_P_is_tensor_P1: "Utrans_P vars1 A = Utrans (tensor_P A (1\<^sub>m K))" unfolding Utrans_P_def ps2_P.ptensor_mat_def partial_state.mat_extension_def partial_state.d2_def partial_state.dims2_def ps2_P.nths_vars2'[simplified ps2_P_dims0 ps2_P_vars1'] using ps2_P_d2 unfolding ps2_P.d2_def using ps2_P_dims0 ps2_P_vars1' by auto lemma nths_dims_uminus_vars2: "nths dims (-vars2) = nths dims vars1" proof - have "nths dims (-vars2) = nths dims ({0.. = nths dims vars1" unfolding vars1_def vars2_def length_dims apply (subgoal_tac "{0.. carrier_mat K K" shows "mat_extension dims vars2 A = tensor_P (1\<^sub>m N) A" proof - have "mat_extension dims vars2 A = tensor_mat dims vars2 A (1\<^sub>m N)" unfolding Utrans_P_def partial_state.mat_extension_def partial_state.d2_def partial_state.dims2_def nths_dims_uminus_vars2 dims_vars1 N_def by auto also have "\ = tensor_mat dims vars1 (1\<^sub>m N) A" apply (subst tensor_mat_comm[of vars1 vars2]) subgoal unfolding vars1_def vars2_def by auto subgoal unfolding length_dims vars1_def vars2_def by auto subgoal unfolding dims_vars1 N_def by auto unfolding dims_vars2 using assms by auto finally show "mat_extension dims vars2 A = tensor_P (1\<^sub>m N) A" unfolding ps2_P.ptensor_mat_def ps2_P_dims0 ps2_P_vars1' by auto qed lemma Utrans_P_is_tensor_P2: assumes "A \ carrier_mat K K" shows "Utrans_P vars2 A = Utrans (tensor_P (1\<^sub>m N) A)" unfolding Utrans_P_def using mat_ext_vars2 assms by auto subsection \Grover's algorithm\ text \Apply hadamard operator to first n variables\ definition hadamard_on_i :: "nat \ complex mat" where "hadamard_on_i i = pmat_extension dims {i} (vars1 - {i}) hadamard" declare hadamard_on_i_def [simp] fun hadamard_n :: "nat \ com" where "hadamard_n 0 = SKIP" | "hadamard_n (Suc i) = hadamard_n i ;; Utrans (tensor_P (hadamard_on_i i) (1\<^sub>m K))" text \Body of the loop\ definition D :: com where "D = Utrans_P vars1 mat_O ;; hadamard_n n ;; Utrans_P vars1 mat_Ph ;; hadamard_n n ;; Utrans_P vars2 (mat_incr K)" lemma unitary_ex_mat_O: "unitary (tensor_P mat_O (1\<^sub>m K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_unitary) subgoal using ps_P_d1 mat_O_def by auto subgoal using ps_P_d2 by auto subgoal using unitary_mat_O by auto using unitary_one by auto lemma unitary_ex_mat_Ph: "unitary (tensor_P mat_Ph (1\<^sub>m K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_unitary) subgoal using ps_P_d1 mat_Ph_def by auto subgoal using ps_P_d2 by auto subgoal using unitary_mat_Ph by auto using unitary_one by auto lemma unitary_hadamard_on_i: assumes "k < n" shows "unitary (hadamard_on_i k)" proof - interpret st2: partial_state2 dims "{k}" "vars1 - {k}" apply unfold_locales by auto show ?thesis unfolding hadamard_on_i_def st2.pmat_extension_def st2.ptensor_mat_def apply (rule partial_state.tensor_mat_unitary) subgoal unfolding partial_state.d1_def partial_state.dims1_def st2.nths_vars1' st2.dims1_def using dims_nths_one_lt_n assms hadamard_dim by auto subgoal unfolding st2.d2_def st2.dims2_def partial_state.d2_def partial_state.dims2_def st2.nths_vars2' st2.dims1_def by auto subgoal using unitary_hadamard by auto subgoal using unitary_one by auto done qed lemma unitary_exhadamard_on_i: assumes "k < n" shows "unitary (tensor_P (hadamard_on_i k) (1\<^sub>m K))" proof - interpret st2: partial_state2 dims "{k}" "vars1 - {k}" apply unfold_locales by auto have d1: "st2.d0 = partial_state.d1 ps2_P.dims0 ps2_P.vars1'" unfolding partial_state.d1_def partial_state.dims1_def ps2_P.nths_vars1' ps2_P.dims1_def st2.d0_def st2.dims0_def st2.vars0_def using assms apply (subgoal_tac "{k} \ (vars1 - {k}) = vars1") apply simp unfolding vars1_def by auto show ?thesis unfolding ps2_P.ptensor_mat_def apply (rule partial_state.tensor_mat_unitary) subgoal unfolding hadamard_on_i_def st2.pmat_extension_def using st2.ptensor_mat_carrier[of hadamard "1\<^sub>m st2.d2"] using d1 by auto subgoal unfolding partial_state.d2_def partial_state.dims2_def ps2_P.nths_vars2' ps2_P.dims2_def dims_vars2 by auto using unitary_hadamard_on_i unitary_one assms by auto qed lemma hadamard_on_i_dim: assumes "k < n" shows "hadamard_on_i k \ carrier_mat N N" proof - interpret st: partial_state2 dims "{k}" "(vars1 - {k})" apply unfold_locales by auto have vars1: "{k} \ (vars1 - {k}) = vars1" unfolding vars1_def using assms by auto show ?thesis unfolding hadamard_on_i_def N_def using st.pmat_extension_carrier unfolding st.d0_def st.dims0_def st.vars0_def using vars1 dims_vars1 by auto qed lemma well_com_hadamard_k: "k \ n \ well_com (hadamard_n k)" proof (induct k) case 0 then show ?case by auto next case (Suc n) then have "well_com (hadamard_n n)" by auto then show ?case unfolding hadamard_n.simps well_com.simps using tensor_P_dim unitary_exhadamard_on_i Suc by auto qed lemma well_com_hadamard_n: "well_com (hadamard_n n)" using well_com_hadamard_k by auto lemma well_com_mat_O: "well_com (Utrans_P vars1 mat_O)" apply (subst Utrans_P_is_tensor_P1) apply simp using tensor_P_dim unitary_ex_mat_O by auto lemma well_com_mat_Ph: "well_com (Utrans_P vars1 mat_Ph)" apply (subst Utrans_P_is_tensor_P1) apply simp using tensor_P_dim unitary_ex_mat_Ph by auto lemma unitary_exmat_incr: "unitary (tensor_P (1\<^sub>m N) (mat_incr K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_unitary) using unitary_mat_incr K unitary_one by (auto simp add: ps_P_d1 ps_P_d2 mat_incr_def) lemma well_com_mat_incr: "well_com (Utrans_P vars2 (mat_incr K))" apply (subst Utrans_P_is_tensor_P2) apply (simp add: mat_incr_def) using tensor_P_dim unitary_exmat_incr by auto lemma well_com_D: "well_com D" unfolding D_def apply auto using well_com_hadamard_n well_com_mat_incr well_com_mat_O well_com_mat_Ph by auto text \Test at while loop\ definition M0 :: "complex mat" where "M0 = mat K K ($$i,j). if i = j \ i \ R then 1 else 0)" lemma hermitian_M0: "hermitian M0" by (auto simp add: hermitian_def M0_def adjoint_eval) lemma M0_dim: "M0 \ carrier_mat K K" unfolding M0_def by auto lemma M0_mult_M0: "M0 * M0 = M0" by (auto simp add: M0_def scalar_prod_def sum_only_one_neq_0) definition M1 :: "complex mat" where "M1 = mat K K (\(i,j). if i = j \ i < R then 1 else 0)" lemma M1_dim: "M1 \ carrier_mat K K" unfolding M1_def by auto lemma hermitian_M1: "hermitian M1" by (auto simp add: hermitian_def M1_def adjoint_eval) lemma M1_mult_M1: "M1 * M1 = M1" by (auto simp add: M1_def scalar_prod_def sum_only_one_neq_0) lemma M1_add_M0: "M1 + M0 = 1\<^sub>m K" unfolding M0_def M1_def by auto text \Test at the end\ definition testN :: "nat \ complex mat" where "testN k = mat N N (\(i,j). if i = k \ j = k then 1 else 0)" lemma hermitian_testN: "hermitian (testN k)" unfolding hermitian_def testN_def by (auto simp add: scalar_prod_def adjoint_eval) lemma testN_mult_testN: "testN k * testN k = testN k" unfolding testN_def by (auto simp add: scalar_prod_def sum_only_one_neq_0) lemma testN_dim: "testN k \ carrier_mat N N" unfolding testN_def by auto definition test_fst_k :: "nat \ complex mat" where "test_fst_k k = mat N N (\(i, j). if (i = j \ i < k) then 1 else 0)" lemma sum_test_k: assumes "m \ N" shows "matrix_sum N (\k. testN k) m = test_fst_k m" proof - have "m \ N \ matrix_sum N (\k. testN k) m = mat N N (\(i, j). if (i = j \ i < m) then 1 else 0)" for m proof (induct m) case 0 then show ?case apply simp apply (rule eq_matI) by auto next case (Suc m) then have m: "m < N" by auto then have m': "m \ N" by auto have "matrix_sum N testN (Suc m) = testN m + matrix_sum N testN m" by simp also have "\ = mat N N (\(i, j). if (i = j \ i < (Suc m)) then 1 else 0)" unfolding testN_def Suc(1)[OF m'] apply (rule eq_matI) by auto finally show ?case by auto qed then show ?thesis unfolding test_fst_k_def using assms by auto qed lemma test_fst_kN: "test_fst_k N = 1\<^sub>m N" apply (rule eq_matI) unfolding test_fst_k_def by auto lemma matrix_sum_tensor_P1: "(\k. k < m \ g k \ carrier_mat N N) \ (A \ carrier_mat K K) \ matrix_sum d (\k. tensor_P (g k) A) m = tensor_P (matrix_sum N g m) A" proof (induct m) case 0 show ?case apply (simp) unfolding ps2_P.ptensor_mat_def using ps_P.tensor_mat_zero1[simplified ps_P_d ps_P_d1, of A] by auto next case (Suc m) then have ind: "matrix_sum d (\k. tensor_P (g k) A) m = tensor_P (matrix_sum N g m) A" and dk: "\k. k < m \ g k \ carrier_mat N N" and "A \ carrier_mat K K" by auto have ds: "matrix_sum N g m \ carrier_mat N N" apply (subst matrix_sum_dim) using dk by auto show ?case apply simp apply (subst ind) unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_add1) unfolding ps_P_d1 ps_P_d2 using Suc ds by auto qed text \Grover's algorithm. Assume we start in the zero state\ definition Grover :: com where "Grover = hadamard_n n ;; While_P vars2 M0 M1 D ;; Measure_P vars1 N testN (replicate N SKIP)" lemma well_com_if: "well_com (Measure_P vars1 N testN (replicate N SKIP))" unfolding Measure_P_def apply auto proof - have eq0: "\n. mat_extension dims vars1 (testN n) = tensor_P (testN n) (1\<^sub>m K)" unfolding mat_ext_vars1 by auto have eq1: "adjoint (tensor_P (testN j) (1\<^sub>m K)) * tensor_P (testN j) (1\<^sub>m K) = tensor_P (testN j) (1\<^sub>m K)" for j unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) apply (auto simp add: ps_P_d1 ps_P_d2 testN_dim hermitian_testN[unfolded hermitian_def] hermitian_one[unfolded hermitian_def]) apply (subst ps_P.tensor_mat_mult[symmetric]) by (auto simp add: ps_P_d1 ps_P_d2 testN_dim testN_mult_testN) have "measurement d N (\n. tensor_P (testN n) (1\<^sub>m K))" unfolding measurement_def apply (simp add: tensor_P_dim) apply (subst eq1) apply (subst matrix_sum_tensor_P1) apply (auto simp add: testN_dim) apply (subst sum_test_k, simp) apply (subst test_fst_kN) unfolding ps2_P.ptensor_mat_def using ps_P.tensor_mat_id ps_P_d ps_P_d1 ps_P_d2 by auto then show "measurement d N (\n. mat_extension dims vars1 (testN n))" using eq0 by auto show "list_all well_com (replicate N SKIP)" apply (subst list_all_length) by simp qed lemma well_com_while: "well_com (While_P vars2 M0 M1 D)" unfolding While_P_def apply auto apply (subst (1 2) mat_ext_vars2) apply (auto simp add: M1_dim M0_dim) proof - have 2: "2 = Suc (Suc 0)" by auto have ad0: "adjoint (tensor_P (1\<^sub>m N) M0) = (tensor_P (1\<^sub>m N) M0)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) unfolding ps_P_d1 ps_P_d2 by (auto simp add: M0_dim adjoint_one hermitian_M0[unfolded hermitian_def]) have ad1: "adjoint (tensor_P (1\<^sub>m N) M1) = (tensor_P (1\<^sub>m N) M1)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) unfolding ps_P_d1 ps_P_d2 by (auto simp add: M1_dim adjoint_one hermitian_M1[unfolded hermitian_def]) have m0: "tensor_P (1\<^sub>m N) M0 * tensor_P (1\<^sub>m N) M0 = tensor_P (1\<^sub>m N) M0" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) unfolding ps_P_d1 ps_P_d2 using M0_dim M0_mult_M0 by auto have m1: "tensor_P (1\<^sub>m N) M1 * tensor_P (1\<^sub>m N) M1 = tensor_P (1\<^sub>m N) M1" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) unfolding ps_P_d1 ps_P_d2 using M1_dim M1_mult_M1 by auto have s: "tensor_P (1\<^sub>m N) M1 + tensor_P (1\<^sub>m N) M0 = 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_add2[symmetric]) unfolding ps_P_d1 ps_P_d2 by (auto simp add: M1_dim M0_dim M1_add_M0 ps_P.tensor_mat_id[simplified ps_P_d1 ps_P_d2 ps_P_d]) show "measurement d 2 (\n. if n = 0 then tensor_P (1\<^sub>m N) M0 else if n = 1 then tensor_P (1\<^sub>m N) M1 else undefined)" unfolding measurement_def apply (auto simp add: tensor_P_dim) apply (subst 2) apply (simp add: ad0 ad1 m0 m1) apply (subst assoc_add_mat[symmetric, of _ d d]) using tensor_P_dim s by auto show "well_com D" using well_com_D by auto qed lemma well_com_Grover: "well_com Grover" unfolding Grover_def apply auto using well_com_hadamard_n well_com_if well_com_while by auto subsection \Correctness\ text \Pre-condition: assume in the zero state\ definition ket_pre :: "complex vec" where "ket_pre = Matrix.vec N (\k. if k = 0 then 1 else 0)" lemma ket_pre_dim: "ket_pre \ carrier_vec N" using ket_pre_def by auto definition pre :: "complex mat" where "pre = proj ket_pre" lemma pre_dim: "pre \ carrier_mat N N" using pre_def ket_pre_def by auto lemma norm_pre: "inner_prod ket_pre ket_pre = 1" unfolding ket_pre_def scalar_prod_def using sum_only_one_neq_0[of "{0..i. (if i = 0 then 1 else 0) * cnj (if i = 0 then 1 else 0)"] by auto lemma pre_trace: "trace pre = 1" unfolding pre_def apply (subst trace_outer_prod[of _ N]) subgoal unfolding ket_pre_def by auto using norm_pre by auto lemma positive_pre: "positive pre" using positive_same_outer_prod unfolding pre_def ket_pre_def by auto lemma pre_le_one: "pre \\<^sub>L 1\<^sub>m N" unfolding pre_def using outer_prod_le_one norm_pre ket_pre_def by auto text \Post-condition: should be in a state i with f i = 1\ definition post :: "complex mat" where "post = mat N N (\(i, j). if (i = j \ f i) then 1 else 0)" lemma post_dim: "post \ carrier_mat N N" unfolding post_def by auto lemma hermitian_post: "hermitian post" unfolding hermitian_def post_def by (auto simp add: adjoint_eval) text \Hoare triples of initialization\ definition ket_zero :: "complex vec" where "ket_zero = Matrix.vec 2 (\k. if k = 0 then 1 else 0)" lemma ket_zero_dim: "ket_zero \ carrier_vec 2" unfolding ket_zero_def by auto definition proj_zero where "proj_zero = proj ket_zero" definition ket_one where "ket_one = Matrix.vec 2 (\k. if k = 1 then 1 else 0)" definition proj_one where "proj_one = proj ket_one" definition ket_plus where "ket_plus = Matrix.vec 2 (\k.1 / csqrt 2) " lemma ket_plus_dim: "ket_plus \ carrier_vec 2" unfolding ket_plus_def by auto lemma ket_plus_eval [simp]: "i < 2 \ ket_plus  i = 1 / csqrt 2" apply (simp only: ket_plus_def) using index_vec less_2_cases by force lemma csqrt_2_sq [simp]: "complex_of_real (sqrt 2) * complex_of_real (sqrt 2) = 2" by (smt of_real_add of_real_hom.hom_one of_real_power one_add_one power2_eq_square real_sqrt_pow2) lemma ket_plus_tensor_n: "partial_state.tensor_vec [2, 2] {0} ket_plus ket_plus = Matrix.vec 4 (\k. 1 / 2)" unfolding partial_state.tensor_vec_def state_sig.d_def proof (rule eq_vecI, auto) fix i :: nat assume i: "i < 4" interpret st: partial_state "[2, 2]" "{0}" . have d1_eq: "st.d1 = 2" by (simp add: st.d1_def st.dims1_def nths_def) have "st.encode1 i < st.d1" by (simp add: st.d_def i) then have i1_lt: "st.encode1 i < 2" using d1_eq by auto have d2_eq: "st.d2 = 2" by (simp add: st.d2_def st.dims2_def nths_def) have "st.encode2 i < st.d2" by (simp add: st.d_def i) then have i2_lt: "st.encode2 i < 2" using d2_eq by auto show "ket_plus  st.encode1 i * ket_plus  st.encode2 i * 2 = 1" by (auto simp add: i1_lt i2_lt) qed definition proj_plus where "proj_plus = proj ket_plus" lemma hadamard_on_zero: "hadamard *\<^sub>v ket_zero = ket_plus" unfolding hadamard_def ket_zero_def ket_plus_def mat_of_rows_list_def apply (rule eq_vecI, auto simp add: scalar_prod_def) subgoal for i apply (drule less_2_cases) apply (drule disjE, auto) by (subst sum_le_2, auto)+. fun exH_k :: "nat \ complex mat" where "exH_k 0 = hadamard_on_i 0" | "exH_k (Suc k) = exH_k k * hadamard_on_i (Suc k)" fun H_k :: "nat \ complex mat" where "H_k 0 = hadamard" | "H_k (Suc k) = ptensor_mat dims {0.. H_k k \ carrier_mat (2^(Suc k)) (2^(Suc k))" proof (induct k) case 0 then show ?case using hadamard_dim by auto next case (Suc k) interpret st: partial_state2 dims "{0..<(Suc k)}" "{Suc k}" apply unfold_locales by auto have "Suc (Suc k) \ n" using Suc by auto then have "nths dims ({0.. {Suc k} = {0..<(Suc (Suc k))}" by auto ultimately have plssk: "prod_list (nths dims ({0.. {Suc k})) = 2^(Suc (Suc k))" by auto have "dim_col (H_k (Suc k)) = 2^(Suc (Suc k))" using st.ptensor_mat_dim_col unfolding st.d0_def st.dims0_def st.vars0_def using plssk by auto moreover have "dim_row (H_k (Suc k)) = 2^(Suc (Suc k))" using st.ptensor_mat_dim_row unfolding st.d0_def st.dims0_def st.vars0_def using plssk by auto ultimately show ?case by auto qed lemma exH_k_eq_H_k: "k < n \ exH_k k = pmat_extension dims {0..<(Suc k)} {(Suc k)..m st.d2)" using st.pmat_extension_def by auto from dims_nths_one_lt_n[OF Suc(2)] have st1d1: "st1.d1 = 2" unfolding st1.d1_def st1.dims1_def by fastforce have "{Suc k} \ {Suc (Suc k)..m 2) (1\<^sub>m st1.d2) = 1\<^sub>m st.d2" using st1.ptensor_mat_id st1d1 by auto have eql3: "st.ptensor_mat (H_k k) (1\<^sub>m st.d2) = st.ptensor_mat (H_k k) (st1.ptensor_mat (1\<^sub>m 2) (1\<^sub>m st1.d2))" apply (subst eql2[symmetric]) by auto have eqr1: "(st2.pmat_extension hadamard) = st2.ptensor_mat hadamard (1\<^sub>m st2.d2)" using st2.pmat_extension_def by auto have splitset: "{0.. {Suc (Suc k).. {Suc (Suc k)..{Suc k} = {0..m 2) (1\<^sub>m st1.d2)) = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m 2)) (1\<^sub>m st1.d2)" apply (subst ptensor_mat_assoc[symmetric, of "{0..m 2" "1\<^sub>m st1.d2", simplified Sksplit]) using Suc length_dims by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m 2) (H_k k)) (1\<^sub>m st1.d2)" using ptensor_mat_comm[of "{0.. = ptensor_mat dims {Suc k} ({0.. {Suc (Suc k)..m 2) (ptensor_mat dims {0..m st1.d2))" apply (subst sup_commute) apply (subst ptensor_mat_assoc[of "{Suc k}" "{0..m 2)" "H_k k" "1\<^sub>m st1.d2"]) using Suc length_dims by auto finally have eql4: "st.pmat_extension (H_k k) = st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" using eql1 eql3 splitset by auto have "st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2)) * st2.ptensor_mat hadamard (1\<^sub>m st2.d2) = st2.ptensor_mat ((1\<^sub>m 2)*hadamard) ((st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))*(1\<^sub>m st2.d2))" apply (rule st2.ptensor_mat_mult[symmetric, of "1\<^sub>m 2" "hadamard" "(st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" "(1\<^sub>m st2.d2)"]) subgoal unfolding st2.d1_def st2.dims1_def by (simp add: dims_nths_one_lt_n Suc(2)) subgoal unfolding st2.d1_def st2.dims1_def apply (simp add: dims_nths_one_lt_n Suc(2)) using hadamard_dim by auto subgoal unfolding st2.d2_def[unfolded st2.dims2_def] using st3.ptensor_mat_dim_col[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] st3.ptensor_mat_dim_row[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] by auto by auto also have "\ = st2.ptensor_mat (hadamard) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" unfolding st2.d2_def[unfolded st2.dims2_def] using hadamard_dim st3.ptensor_mat_dim_col[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] st3.ptensor_mat_dim_row[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m st3.d2)" apply (subst ptensor_mat_assoc[symmetric, of "{Suc k}" "{0..m st3.d2", simplified splitset]) using Suc length_dims by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m st3.d2)" using ptensor_mat_comm[of "{Suc k}"] Sksplit1 by auto also have "\ = ptensor_mat dims ({0..m st3.d2)" using Sksplit1 by auto also have "\ = pmat_extension dims {0..m st.d2)" using st.pmat_extension_def by auto from dims_nths_one_lt_n[OF assms] have st1d1: "st1.d1 = 2" unfolding st1.d1_def st1.dims1_def by fastforce have "{Suc k} \ {Suc (Suc k)..m 2) (1\<^sub>m st1.d2) = 1\<^sub>m st.d2" using st1.ptensor_mat_id st1d1 by auto have eql3: "st.ptensor_mat (H_k k) (1\<^sub>m st.d2) = st.ptensor_mat (H_k k) (st1.ptensor_mat (1\<^sub>m 2) (1\<^sub>m st1.d2))" apply (subst eql2[symmetric]) by auto have eqr1: "(st2.pmat_extension hadamard) = st2.ptensor_mat hadamard (1\<^sub>m st2.d2)" using st2.pmat_extension_def by auto have splitset: "{0.. {Suc (Suc k).. {Suc (Suc k)..{Suc k} = {0..m 2) (1\<^sub>m st1.d2)) = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m 2)) (1\<^sub>m st1.d2)" apply (subst ptensor_mat_assoc[symmetric, of "{0..m 2" "1\<^sub>m st1.d2", simplified Sksplit]) using assms length_dims by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m 2) (H_k k)) (1\<^sub>m st1.d2)" using ptensor_mat_comm[of "{0.. = ptensor_mat dims {Suc k} ({0.. {Suc (Suc k)..m 2) (ptensor_mat dims {0..m st1.d2))" apply (subst sup_commute) apply (subst ptensor_mat_assoc[of "{Suc k}" "{0..m 2)" "H_k k" "1\<^sub>m st1.d2"]) using assms length_dims by auto finally have "st.pmat_extension (H_k k) = st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" using eql1 eql3 splitset by auto moreover have "st.pmat_extension (H_k k) = exH_k k" using exH_k_eq_H_k assms by auto ultimately have eql4: "exH_k k = st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" by auto have "st2.ptensor_mat hadamard (1\<^sub>m st2.d2) * st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2)) = st2.ptensor_mat (hadamard*(1\<^sub>m 2)) ((1\<^sub>m st2.d2)* (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2)))" apply (rule st2.ptensor_mat_mult[symmetric, of "hadamard" "1\<^sub>m 2" "(1\<^sub>m st2.d2)" "(st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))"]) subgoal unfolding st2.d1_def st2.dims1_def apply (simp add: dims_nths_one_lt_n assms) using hadamard_dim by auto subgoal unfolding st2.d1_def st2.dims1_def by (simp add: dims_nths_one_lt_n assms) subgoal by auto subgoal unfolding st2.d2_def[unfolded st2.dims2_def] using st3.ptensor_mat_dim_col[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] st3.ptensor_mat_dim_row[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] by auto done also have "\ = st2.ptensor_mat (hadamard) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2))" unfolding st2.d2_def[unfolded st2.dims2_def] using hadamard_dim st3.ptensor_mat_dim_col[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] st3.ptensor_mat_dim_row[unfolded st3.d0_def st3.dims0_def st3.vars0_def, simplified splitset] by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m st3.d2)" apply (subst ptensor_mat_assoc[symmetric, of "{Suc k}" "{0..m st3.d2", simplified splitset]) using assms length_dims by auto also have "\ = ptensor_mat dims ({0..{Suc k}) {Suc (Suc k)..m st3.d2)" using ptensor_mat_comm[of "{Suc k}"] Sksplit1 by auto also have "\ = ptensor_mat dims ({0..m st3.d2)" using Sksplit1 by auto also have "\ = pmat_extension dims {0.. = exH_k (Suc k)" using exH_k_eq_H_k[of "Suc k"] assms by auto finally have "st2.ptensor_mat hadamard (1\<^sub>m st2.d2) * st2.ptensor_mat (1\<^sub>m 2) (st3.ptensor_mat (H_k k) (1\<^sub>m st3.d2)) =exH_k (Suc k)". then show ?thesis unfolding hadamard_on_i_def using eql4 eqr1 by auto qed lemma exH_eq_H: "exH_k (n - 1) = H_k (n - 1)" proof - have "\m. n = Suc (Suc m)" using n by presburger then obtain m where m: "n = Suc (Suc m)" using n by auto then have "exH_k m = pmat_extension dims {0..<(Suc m)} {(Suc m).. carrier_mat (2^(Suc m)) (2^(Suc m))" using H_k_dim by auto then have Hkm1: "(H_k m) * (1\<^sub>m stm2.d1) = (H_k m)" unfolding stm2d1 by auto have eqd12: "stm1.d2 = stm2.d1" unfolding stm1.d2_def stm1.dims2_def stm2.d1_def stm2.dims1_def by auto have "pmat_extension dims {Suc m} {0..m stm1.d2)" using stm1.pmat_extension_def by auto also have "\ = stm2.ptensor_mat (1\<^sub>m stm2.d1) hadamard" using ptensor_mat_comm eqd12 by auto finally have eqr: "(pmat_extension dims {Suc m} {0..m stm2.d1) hadamard". then have "exH_k (Suc m) = stm2.ptensor_mat (H_k m) (1\<^sub>m stm2.d2) * stm2.ptensor_mat (1\<^sub>m stm2.d1) hadamard" using eqSm unfolding stm2.pmat_extension_def by auto also have "\ = stm2.ptensor_mat ((H_k m) * (1\<^sub>m stm2.d1)) (1\<^sub>m stm2.d2 * hadamard)" apply (rule stm2.ptensor_mat_mult[symmetric, of "H_k m" "1\<^sub>m stm2.d1" "1\<^sub>m stm2.d2" "hadamard"]) unfolding stm2d1 stm2d2 using H_k_dim m hadamard_dim by auto also have "\ = stm2.ptensor_mat (H_k m) (hadamard)" using H_k_dim hadamard_dim stm2d1 stm2d2 Hkm1 by auto also have "\ = H_k (Suc m)" unfolding stm2.ptensor_mat_def H_k.simps by auto finally have "exH_k (Suc m) = H_k (Suc m)" by auto moreover have "Suc m = n - 1" using m by auto ultimately show ?thesis by auto qed fun ket_zero_k :: "nat \ complex vec" where "ket_zero_k 0 = ket_zero" | "ket_zero_k (Suc k) = ptensor_vec dims {0..<(Suc k)} {Suc k} (ket_zero_k k) ket_zero" lemma ket_zero_k_dim: assumes "k < n" shows "ket_zero_k k \ carrier_vec (2^(Suc k))" proof (cases k) case 0 show ?thesis using ket_zero_dim 0 by auto next case (Suc k) interpret st: partial_state2 dims "{0..<(Suc k)}" "{Suc k}" apply unfold_locales by auto have "Suc (Suc k) \ n" using assms Suc by auto then have "nths dims ({0.. {Suc k} = {0..<(Suc (Suc k))}" by auto ultimately have plssk: "prod_list (nths dims ({0.. {Suc k})) = 2^(Suc (Suc k))" by auto show ?thesis apply (rule carrier_vecI) unfolding ket_zero_k.simps Suc using st.ptensor_vec_dim[of "ket_zero_k k" ket_zero] plssk unfolding st.d0_def st.dims0_def st.vars0_def by auto qed fun ket_plus_k where "ket_plus_k 0 = ket_plus" | "ket_plus_k (Suc k) = ptensor_vec dims {0..<(Suc k)} {Suc k} (ket_plus_k k) ket_plus" lemma ket_plus_k_dim: assumes "k < n" shows "ket_plus_k k \ carrier_vec (2^(Suc k))" proof (cases k) case 0 show ?thesis using ket_plus_dim 0 by auto next case (Suc k) interpret st: partial_state2 dims "{0..<(Suc k)}" "{Suc k}" apply unfold_locales by auto have "Suc (Suc k) \ n" using assms Suc by auto then have "nths dims ({0.. {Suc k} = {0..<(Suc (Suc k))}" by auto ultimately have plssk: "prod_list (nths dims ({0.. {Suc k})) = 2^(Suc (Suc k))" by auto show ?thesis apply (rule carrier_vecI) unfolding ket_zero_k.simps Suc using st.ptensor_vec_dim plssk unfolding st.d0_def st.dims0_def st.vars0_def by auto qed lemma H_k_ket_zero_k: "k < n \ (H_k k) *\<^sub>v (ket_zero_k k) = (ket_plus_k k)" proof (induct k) case 0 show ?case using hadamard_on_zero unfolding H_k.simps ket_zero_k.simps ket_plus_k.simps by auto next case (Suc k) then have k: "k < n" by auto interpret st: partial_state2 dims "{0..<(Suc k)}" "{Suc k}" apply unfold_locales by auto have "nths dims {0..v ket_zero_k (Suc k) = st.ptensor_mat (H_k k) hadamard *\<^sub>v st.ptensor_vec (ket_zero_k k) ket_zero" by auto also have "\ = st.ptensor_vec ((H_k k) *\<^sub>v (ket_zero_k k)) (hadamard *\<^sub>v ket_zero)" using st.ptensor_mat_mult_vec[unfolded std1 std2, OF H_k_dim[OF k] ket_zero_k_dim[OF k] hadamard_dim ket_zero_dim] by auto also have "\ = st.ptensor_vec (ket_plus_k k) ket_plus" using Suc hadamard_on_zero by auto finally show ?case by auto qed lemma encode1_replicate_2: "partial_state.encode1 (replicate (Suc k) 2) {0.. ket_zero_k k = Matrix.vec (2^(Suc k)) (\k. if k = 0 then 1 else 0)" proof (induct k) case 0 show ?case apply (rule eq_vecI) by (auto simp add: ket_zero_def) next case (Suc k) then have k: "k < n" by auto have kzkk: "ket_zero_k k = Matrix.vec (2 ^ Suc k) (\k. if (k = 0) then 1 else 0)" using Suc(1)[OF k] by auto have dSk: "ket_zero_k (Suc k) \ carrier_vec (2^(Suc (Suc k)))" using ket_zero_k_dim[OF Suc(2)] by auto interpret st: partial_state "replicate (Suc (Suc k)) 2" "{0.. {Suc k}) = {0..x. (x \ {0.. {y \ {0..x. (x \ {0.. card {y \ {0..g h I. (\x. (x \ I \ g x = h x)) \ {g x | x. x \ I} = {h x | x. x \ I}" by metis have "{card {y \ {0.. {0.. {0.. = {0.. 0" and ile: "i < 2^(Suc (Suc k))" for i proof (cases "i mod (2 ^ Suc k) \ 0") case True then have "ket_zero_k k  st.encode1 i = 0" unfolding kzkk using encode1_replicate_2[of "Suc k" i] ile by auto then show ?thesis unfolding ket_zero_k.simps st2pvsttv st.tensor_vec_def ket_zero_def std using ile by auto next case False have "i div (2 ^ Suc k) \ 0 \ i mod (2 ^ Suc k) \ 0" using ine0 by fastforce then have "i div (2 ^ Suc k) \ 0" using False by auto moreover have "i div (2 ^ Suc k) < 2" using ile less_mult_imp_div_less by auto ultimately have "i div (2 ^ Suc k) = 1" by auto then have "st.encode2 i = 1" using encode2_replicate_2[of i "Suc k"] ile by auto then have "Matrix.vec 2 (\k. if k = 0 then 1 else 0)  st.encode2 i = 0" unfolding kzkk by fastforce then show ?thesis unfolding ket_zero_k.simps st2pvsttv st.tensor_vec_def ket_zero_def std using ile by auto qed show ?case apply (rule eq_vecI) subgoal for i using kzkk0 kzkki by auto using carrier_vecD[OF dSk] by auto qed lemma ket_plus_k_decode: "k < n \ ket_plus_k k = Matrix.vec (2^(Suc k)) (\l. 1 / csqrt (2^(Suc k)))" proof (induct k) case 0 then show ?case unfolding ket_plus_k.simps ket_plus_def by auto next case (Suc k) then have kpkk: "ket_plus_k k = Matrix.vec (2 ^ Suc k) (\l. 1 / csqrt (2 ^ Suc k))" by auto have dSk: "ket_plus_k (Suc k) \ carrier_vec (2^(Suc (Suc k)))" using ket_plus_k_dim[OF Suc(2)] by auto interpret st: partial_state "replicate (Suc (Suc k)) 2" "{0.. {Suc k}) = {0..x. (x \ {0.. {y \ {0..x. (x \ {0.. card {y \ {0..g h I. (\x. (x \ I \ g x = h x)) \ {g x | x. x \ I} = {h x | x. x \ I}" by metis have "{card {y \ {0.. {0.. {0.. = {0..{card {0.. {0.. atLeastLessThan_iff card_atLeastLessThan diff_zero less_SucI) then have std1: "st.d1 = 2^(Suc k)" unfolding st.d1_def st.dims1_def nthsSSk2 by auto have "{i. i < Suc (Suc k) \ i \ {Suc k..}} = {Suc k}" by auto then have "nths (replicate (Suc (Suc k)) 2) ({Suc k..}) = replicate 1 2" unfolding nths_replicate by auto moreover have "(- {0..v ket_pre = \" proof - have "exH_k (n - 1) = H_k (n - 1)" using exH_eq_H by auto moreover have "ket_zero_k (n - 1) = ket_pre" using ket_zero_k_decode[of "n - 1"] ket_pre_def N_def n by auto moreover have "ket_plus_k (n - 1) = \" using ket_plus_k_decode[of "n - 1"] \_def N_def n by auto moreover have "H_k (n - 1) *\<^sub>v ket_zero_k (n - 1) = ket_plus_k (n - 1)" using H_k_ket_zero_k n by auto ultimately show ?thesis by auto qed definition ket_k :: "nat \ complex vec" where "ket_k x = Matrix.vec K (\k. if k = x then 1 else 0)" lemma ket_k_dim: "ket_k k \ carrier_vec K" unfolding ket_k_def by auto lemma mat_incr_mult_ket_k: "k < K \ (mat_incr K) *\<^sub>v (ket_k k) = (ket_k ((k + 1) mod K))" apply (rule eq_vecI) unfolding mat_incr_def ket_k_def apply (simp add: scalar_prod_def) apply (case_tac "k = K - 1") subgoal for i apply auto by (simp add: sum_only_one_neq_0[of _ "K - 1"]) subgoal for i apply auto by (simp add: sum_only_one_neq_0[of _ "i - 1"]) by auto definition proj_k where "proj_k x = proj (ket_k x)" lemma proj_k_dim: "proj_k k \ carrier_mat K K" unfolding proj_k_def using ket_k_dim by auto lemma norm_ket_k_lt_K: "k < K \ inner_prod (ket_k k) (ket_k k) = 1" unfolding ket_k_def apply (simp add: scalar_prod_def) using sum_only_one_neq_0[of "{0..i. (if i = k then 1 else 0) * cnj (if i = k then 1 else 0)"] by auto lemma norm_ket_k_ge_K: "k \ K \ inner_prod (ket_k k) (ket_k k) = 0" unfolding ket_k_def by (simp add: scalar_prod_def) lemma norm_ket_k: "inner_prod (ket_k k) (ket_k k) \ 1" apply (case_tac "k < K") - using norm_ket_k_lt_K norm_ket_k_ge_K by auto + using norm_ket_k_lt_K norm_ket_k_ge_K by (auto simp: less_eq_complex_def) lemma proj_k_mat: assumes "k < K" shows "proj_k k = mat K K (\(i, j). if (i = j \ i = k) then 1 else 0)" apply (rule eq_matI) apply (simp add: proj_k_def ket_k_def index_outer_prod) using proj_k_dim by auto lemma positive_proj_k: "positive (proj_k k)" using positive_same_outer_prod unfolding proj_k_def ket_k_def by auto lemma proj_k_le_one: "(proj_k k) \\<^sub>L 1\<^sub>m K" unfolding proj_k_def using outer_prod_le_one norm_ket_k ket_k_def by auto definition proj_psi where "proj_psi = proj \" lemma proj_psi_dim: "proj_psi \ carrier_mat N N" unfolding proj_psi_def \_def by auto lemma norm_psi: "inner_prod \ \ = 1" apply (simp add: \_eval scalar_prod_def) by (metis norm_of_nat norm_of_real of_real_mult of_real_of_nat_eq real_sqrt_mult_self) lemma proj_psi_mat: "proj_psi = mat N N (\k. 1 / N)" unfolding proj_psi_def apply (rule eq_matI, simp_all) apply (simp add: \_def index_outer_prod) apply (smt of_nat_less_0_iff of_real_of_nat_eq of_real_power power2_eq_square real_sqrt_pow2) by (auto simp add: carrier_matD[OF outer_prod_dim[OF \_dim(1) \_dim(1)]]) lemma hermitian_proj_psi: "hermitian proj_psi" unfolding hermitian_def proj_psi_mat apply (rule eq_matI) by (auto simp add: adjoint_eval) lemma hermitian_exproj_psi: "hermitian (tensor_P proj_psi (1\<^sub>m K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_hermitian) using proj_psi_dim ps_P_d1 ps_P_d2 hermitian_proj_psi hermitian_one by auto lemma proj_psi_is_projection: "proj_psi * proj_psi = proj_psi" proof - have "proj_psi * proj_psi = inner_prod \ \ \\<^sub>m proj_psi" unfolding proj_psi_def apply (subst outer_prod_mult_outer_prod) using \_def by auto also have "\ = proj_psi" using \_inner by auto finally show ?thesis. qed lemma proj_psi_trace: "trace (proj_psi) = 1" unfolding proj_psi_def apply (subst trace_outer_prod[of _ N]) subgoal unfolding \_def by auto using norm_psi by auto lemma positive_proj_psi: "positive (proj_psi)" using positive_same_outer_prod unfolding proj_psi_def \_def by auto lemma proj_psi_le_one: "(proj_psi) \\<^sub>L 1\<^sub>m N" unfolding proj_psi_def using outer_prod_le_one norm_psi \_def by auto lemma hermitian_hadamard_on_k: assumes "k < n" shows "hermitian (hadamard_on_i k)" proof - interpret st2: partial_state2 dims "{k}" "(vars1 - {k})" apply unfold_locales by auto have st2d1: "st2.dims1 = [2]" unfolding st2.dims1_def dims_def using assms dims_nths_one_lt_n local.dims_def st2.dims1_def by auto show "hermitian (hadamard_on_i k)" unfolding hadamard_on_i_def st2.pmat_extension_def st2.ptensor_mat_def apply (rule partial_state.tensor_mat_hermitian) subgoal unfolding partial_state.d1_def partial_state.dims1_def st2.nths_vars1' hadamard_def by (simp add: st2d1) subgoal unfolding partial_state.d2_def partial_state.dims2_def st2.nths_vars2' st2.d2_def by auto subgoal unfolding hermitian_def hadamard_def apply (rule eq_matI) by (auto simp add: adjoint_dim adjoint_eval) using hermitian_one by auto qed lemma hermitian_H_k: "k < n \ hermitian (H_k k)" proof (induct k) case 0 show ?case unfolding H_k.simps hermitian_def hadamard_def apply (rule eq_matI) by (auto simp add: adjoint_dim adjoint_eval) next case (Suc k) interpret st2: partial_state2 dims "{0.. unitary (H_k k)" proof (induct k) case 0 show ?case using unitary_hadamard by auto next case (Suc k) then have k: "k < n" by auto interpret st2: partial_state2 dims "{0.. exH_k k \ carrier_mat N N" apply (induct k) using hadamard_on_i_dim by auto lemma exH_n_dim: shows "exH_k (n - 1) \ carrier_mat N N" using exH_k_dim n by auto lemma unitary_exH_k: shows "k < n \ unitary (exH_k k)" proof (induct k) case 0 then show ?case unfolding exH_k.simps using unitary_hadamard_on_i 0 by auto next case (Suc k) show ?case unfolding exH_k.simps apply (subst unitary_times_unitary[of _ N]) subgoal using exH_k_dim Suc by auto subgoal using hadamard_on_i_dim Suc by auto subgoal using Suc by auto using unitary_hadamard_on_i Suc by auto qed lemma hermitian_exH_n: "hermitian (exH_k (n - 1))" using hermitian_H_k exH_eq_H n by auto lemma exH_k_mult_psi_is_pre: "exH_k (n - 1) *\<^sub>v \ = ket_pre" proof - let ?H = "exH_k (n - 1)" have "hermitian ?H" using hermitian_H_k exH_eq_H n by auto then have eqad: "adjoint ?H = ?H" unfolding hermitian_def by auto have d: "?H \ carrier_mat N N" using exH_k_dim n by auto have "unitary ?H" using unitary_exH_k n by auto then have id: "?H * ?H = 1\<^sub>m N" unfolding unitary_def inverts_mat_def using d apply (subst (2) eqad[symmetric]) by auto have "?H *\<^sub>v \ = ?H *\<^sub>v (?H *\<^sub>v ket_pre)" using exH_k_mult_pre_is_psi by auto also have "\ = (?H * ?H) *\<^sub>v ket_pre" using d ket_pre_def by auto also have "\ = ket_pre" using id ket_pre_def by auto finally show ?thesis by auto qed fun exexH_k :: "nat \ complex mat" where "exexH_k k = tensor_P (exH_k k) (1\<^sub>m K)" lemma unitary_exexH_k: "k < n \ unitary (exexH_k k)" unfolding exexH_k.simps ps2_P.ptensor_mat_def apply (subst partial_state.tensor_mat_unitary) subgoal using exH_k_dim unfolding partial_state.d1_def partial_state.dims1_def ps2_P.nths_vars1' ps2_P.dims1_def dims_vars1 N_def by auto subgoal unfolding partial_state.d2_def partial_state.dims2_def ps2_P.nths_vars2' ps2_P.dims2_def dims_vars2 by auto using unitary_exH_k unitary_one by auto lemma exexH_k_dim: "k < n \ exexH_k k \ carrier_mat d d" unfolding exexH_k.simps using ps2_P.ptensor_mat_carrier ps2_P_d0 by auto lemma hoare_seq_utrans: fixes P :: "complex mat" assumes "unitary U1" and "unitary U2" and "is_quantum_predicate P" and dU1: "U1 \ carrier_mat d d" and dU2: "U2 \ carrier_mat d d" shows " \\<^sub>p {adjoint (U2 * U1) * P * (U2 * U1)} Utrans U1;; Utrans U2 {P}" proof - have hp0: "\\<^sub>p {adjoint (U2) * P * (U2)} Utrans U2 {P}" using assms hoare_partial.intros by auto have qp: "is_quantum_predicate (adjoint (U2) * P * (U2))" using qp_close_under_unitary_operator assms by auto then have hp1: "\\<^sub>p {adjoint U1 * (adjoint (U2) * P * (U2)) * U1} Utrans U1 {adjoint (U2) * P * (U2)}" using hoare_partial.intros by auto have dP: "P \ carrier_mat d d" using assms is_quantum_predicate_def by auto have eq: "adjoint U1 * (adjoint U2 * P * U2) * U1 = adjoint (U2 * U1) * P * (U2 * U1)" using dU1 dU2 dP by (mat_assoc d) with hp1 have hp2: "\\<^sub>p {adjoint (U2 * U1) * P * (U2 * U1)} Utrans U1 {adjoint (U2) * P * (U2)}" by auto have "is_quantum_predicate (adjoint U1 * (adjoint U2 * P * U2) * U1)" using qp qp_close_under_unitary_operator assms by auto then have "is_quantum_predicate (adjoint (U2 * U1) * P * (U2 * U1))" using eq by auto then show ?thesis using hoare_partial.intros(3)[OF _ qp assms(3)] hp0 hp2 by auto qed lemma qp_close_after_exexH_k: fixes P :: "complex mat" assumes "is_quantum_predicate P" shows "k < n \ is_quantum_predicate (adjoint (exexH_k k) * P * exexH_k k)" apply (subst qp_close_under_unitary_operator) subgoal using exexH_k_dim by auto subgoal using unitary_exexH_k by auto using assms by auto lemma hoare_hadamard_n: fixes P :: "complex mat" shows "is_quantum_predicate P \ k < n \ \\<^sub>p {adjoint (exexH_k k) * P * exexH_k k} hadamard_n (Suc k) {P}" proof (induct k arbitrary: P) case 0 have qp: "is_quantum_predicate (adjoint (exexH_k 0) * P * exexH_k 0)" using qp_close_under_unitary_operator[OF _ unitary_exhadamard_on_i[of 0]] tensor_P_dim 0 by auto then have "\\<^sub>p {adjoint (exexH_k 0) * P * exexH_k 0} SKIP {adjoint (exexH_k 0) * P * exexH_k 0}" using hoare_partial.intros(1) by auto moreover have "\\<^sub>p {adjoint (exexH_k 0) * P * exexH_k 0} Utrans (tensor_P (hadamard_on_i 0) (1\<^sub>m K)) {P}" using hoare_partial.intros(2) 0 by auto ultimately have "\\<^sub>p {adjoint (exexH_k 0) * P * exexH_k 0} SKIP;; Utrans (tensor_P (hadamard_on_i 0) (1\<^sub>m K)) {P}" using hoare_partial.intros(3) qp 0 by auto then show ?case using qp by auto next case (Suc k) have h1: "\\<^sub>p {adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K))} Utrans (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) {P}" using hoare_partial.intros Suc by auto have qp: "is_quantum_predicate (adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)))" apply (subst qp_close_under_unitary_operator) subgoal using ps2_P.ptensor_mat_carrier ps2_P_d0 by auto subgoal unfolding ps2_P.ptensor_mat_def apply (subst partial_state.tensor_mat_unitary ) subgoal unfolding partial_state.d1_def partial_state.dims1_def ps2_P.nths_vars1' ps2_P.dims1_def d_vars1 using hadamard_on_i_dim Suc by auto subgoal unfolding partial_state.d2_def partial_state.dims2_def ps2_P.nths_vars2' ps2_P.dims2_def using dims_vars2 by auto using unitary_hadamard_on_i unitary_one Suc by auto using Suc by auto then have h2: "\\<^sub>p {adjoint (exexH_k k) * (adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K))) * exexH_k k} hadamard_n (Suc k) {adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K))}" using Suc by auto have "(tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * exexH_k k = (tensor_P (hadamard_on_i (Suc k) * (exH_k k)) (1\<^sub>m K * (1\<^sub>m K)))" apply (subst ps2_P.ptensor_mat_mult) subgoal using hadamard_on_i_dim ps2_P_d1 Suc by auto subgoal using exH_k_dim ps2_P_d1 Suc by auto using ps2_P_d2 by auto also have "\ = exexH_k (Suc k)" using mult_exH_k_left Suc by auto finally have eq1: "(tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * exexH_k k = exexH_k (Suc k)". then have eq2: "adjoint (exexH_k k) * adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) = adjoint (exexH_k (Suc k))" apply (subst adjoint_mult[symmetric, of _ d d _ d]) subgoal using tensor_P_dim by auto using exexH_k_dim Suc by auto have dP: "P \ carrier_mat d d" using is_quantum_predicate_def Suc by auto moreover have dH: "exexH_k k \ carrier_mat d d" using exexH_k_dim Suc by auto moreover have dHi: "tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K) \ carrier_mat d d" using tensor_P_dim by auto ultimately have eq3: "adjoint (exexH_k k) * (adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * exexH_k k = (adjoint (exexH_k k) * adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K))) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K) * exexH_k k)" by (mat_assoc d) show ?case apply (subst hadamard_n.simps) apply (subst hoare_partial.intros(3)[of _ "adjoint (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K)) * P * (tensor_P (hadamard_on_i (Suc k)) (1\<^sub>m K))"]) subgoal using qp_close_after_exexH_k[of P "Suc k"] Suc by auto subgoal using qp by auto subgoal using Suc by auto subgoal using h2[simplified eq3 eq1 eq2] by auto using h1 by auto qed lemma qp_pre: "is_quantum_predicate (tensor_P pre (proj_k 0))" unfolding is_quantum_predicate_def proof (intro conjI) show "tensor_P pre (proj_k 0) \ carrier_mat d d" using tensor_P_dim by auto interpret st: partial_state dims vars1 . have d1: "st.d1 = N" unfolding st.d1_def st.dims1_def using d_vars1 by auto have d2: "st.d2 = K" unfolding st.d2_def st.dims2_def nths_uminus_vars1 dims_vars2 by auto show "positive (tensor_P pre (proj_k 0))" unfolding ps2_P.ptensor_mat_def ps2_P_dims0 ps2_P_vars1' apply (subst st.tensor_mat_positive) subgoal unfolding pre_def using outer_prod_dim ket_pre_def d1 by auto subgoal unfolding proj_k_def using outer_prod_dim ket_k_def d2 by auto subgoal using positive_pre by auto using positive_proj_k[of 0] K_gt_0 by auto show "tensor_P pre (proj_k 0) \\<^sub>L 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def ps2_P_dims0 ps2_P_vars1' apply (subst st.tensor_mat_le_one) subgoal using pre_def ket_pre_def outer_prod_dim d1 by auto subgoal using proj_k_def K_gt_0 ket_k_def outer_prod_dim d2 by auto using d1 d2 K_gt_0 outer_prod_dim positive_pre positive_proj_k pre_le_one proj_k_le_one by auto qed lemma qp_init_post: "is_quantum_predicate (tensor_P proj_psi (proj_k 0))" unfolding is_quantum_predicate_def proof (intro conjI) show "tensor_P proj_psi (proj_k 0) \ carrier_mat d d" using tensor_P_dim by auto interpret st: partial_state dims vars1 . have d1: "st.d1 = N" unfolding st.d1_def st.dims1_def using d_vars1 by auto have d2: "st.d2 = K" unfolding st.d2_def st.dims2_def nths_uminus_vars1 dims_vars2 by auto show "positive (tensor_P proj_psi (proj_k 0))" unfolding ps2_P.ptensor_mat_def ps2_P_dims0 ps2_P_vars1' apply (subst st.tensor_mat_positive) subgoal unfolding proj_psi_def using outer_prod_dim \_def d1 by auto subgoal unfolding proj_k_def using outer_prod_dim ket_k_def d2 by auto subgoal using positive_proj_psi by auto using positive_proj_k[of 0] K_gt_0 by auto show "tensor_P proj_psi (proj_k 0) \\<^sub>L 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def ps2_P_dims0 ps2_P_vars1' apply (subst st.tensor_mat_le_one) subgoal using proj_psi_def outer_prod_dim d1 by auto subgoal using proj_k_def K_gt_0 ket_k_def outer_prod_dim d2 by auto using d1 d2 K_gt_0 outer_prod_dim positive_proj_psi positive_proj_k proj_psi_le_one proj_k_le_one by auto qed lemma tensor_P_adjoint_left_right: assumes "m1 \ carrier_mat N N" and "m2 \ carrier_mat K K" and "m3 \ carrier_mat N N" and "m4 \ carrier_mat K K" shows "adjoint (tensor_P m1 m2) * tensor_P m3 m4 * tensor_P m1 m2 = tensor_P (adjoint m1 * m3 * m1) (adjoint m2 * m4 * m2)" proof - have eq1: "adjoint (tensor_P m1 m2) = tensor_P (adjoint m1) (adjoint m2)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) using ps_P_d1 ps_P_d2 assms by auto have eq2: "adjoint (tensor_P m1 m2) * tensor_P m3 m4 = tensor_P (adjoint m1 * m3) (adjoint m2 * m4)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult) using ps_P_d1 ps_P_d2 assms eq1 unfolding ps2_P.ptensor_mat_def by (auto simp add: adjoint_dim) have eq3: "tensor_P (adjoint m1 * m3) (adjoint m2 * m4) * (tensor_P m1 m2) = tensor_P (adjoint m1 * m3 * m1) (adjoint m2 * m4 * m2)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[of "adjoint m1 * m3"]) using ps_P_d1 ps_P_d2 assms by (auto simp add: adjoint_dim) show ?thesis using eq1 eq2 eq3 by auto qed abbreviation exH_n where "exH_n \ exH_k (n - 1)" lemma hoare_triple_init: "\\<^sub>p {tensor_P pre (proj_k 0)} hadamard_n n {tensor_P proj_psi (proj_k 0)}" proof - have h: "\\<^sub>p {adjoint (exexH_k (n - 1)) * (tensor_P proj_psi (proj_k 0)) * (exexH_k (n - 1))} hadamard_n n {tensor_P proj_psi (proj_k 0)}" using hoare_hadamard_n[OF qp_init_post, of "n - 1"] qp_init_post n by auto have "adjoint (exexH_k (n - 1)) * tensor_P proj_psi (proj_k 0) * exexH_k (n - 1) = tensor_P (adjoint exH_n * proj_psi * exH_n) (adjoint (1\<^sub>m K) * proj_k 0 * 1\<^sub>m K)" unfolding exexH_k.simps apply (subst tensor_P_adjoint_left_right) using exH_k_dim proj_psi_def \_def proj_k_def ket_k_def n by (auto) moreover have "adjoint exH_n * proj_psi * exH_n = pre" unfolding proj_psi_def pre_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) subgoal using \_def by auto subgoal using exH_k_dim n by (simp add: adjoint_dim) subgoal using exH_k_dim n by simp apply (subst (1 2) hermitian_exH_n[simplified hermitian_def]) apply (subst (1 2) exH_k_mult_psi_is_pre) by auto moreover have "adjoint (1\<^sub>m K) * (proj_k 0) * (1\<^sub>m K) = proj_k 0" apply (subst adjoint_one) using proj_k_dim[of 0] K_gt_0 by auto ultimately have "adjoint (exexH_k (n - 1)) * tensor_P proj_psi (proj_k 0) * exexH_k (n - 1) = tensor_P pre (proj_k 0)" by auto with h show ?thesis by auto qed text \Hoare triples of while loop\ definition proj_psi_l where "proj_psi_l l = proj (psi_l l)" lemma positive_psi_l: "k < K \ positive (proj_psi_l k)" unfolding proj_psi_l_def apply (subst positive_same_outer_prod) using psi_l_dim by auto lemma hermitian_proj_psi_l: "k < K \ hermitian (proj_psi_l k)" using positive_psi_l positive_is_hermitian by auto definition P' where "P' = tensor_P (proj_psi_l R) (proj_k R)" lemma proj_psi_l_dim: "proj_psi_l l \ carrier_mat N N" unfolding proj_psi_l_def using psi_l_def by auto definition Q :: "complex mat" where "Q = matrix_sum d (\l. tensor_P (proj_psi_l l) (proj_k l)) R" lemma psi_l_le_id: shows "proj_psi_l l \\<^sub>L 1\<^sub>m N" proof - have "inner_prod (psi_l l) (psi_l l) = 1" using inner_psi_l by auto then show ?thesis using outer_prod_le_one psi_l_def proj_psi_l_def by auto qed lemma positive_proj_psi_l: shows "positive (proj_psi_l l)" using positive_same_outer_prod proj_psi_l_def psi_l_dim by auto definition proj_fst_k :: "nat \ complex mat" where "proj_fst_k k = mat K K (\(i, j). if (i = j \ i < k) then 1 else 0)" lemma hermitian_proj_fst_k: "adjoint (proj_fst_k k) = proj_fst_k k" by (auto simp add: proj_fst_k_def adjoint_eval) lemma proj_fst_k_is_projection: "proj_fst_k k * proj_fst_k k = proj_fst_k k" by (auto simp add: proj_fst_k_def scalar_prod_def sum_only_one_neq_0) lemma positive_proj_fst_k: "positive (proj_fst_k k)" proof - have "(proj_fst_k k) * adjoint (proj_fst_k k) = (proj_fst_k k)" using hermitian_proj_fst_k proj_fst_k_is_projection by auto then have "\M. M * adjoint M = (proj_fst_k k)" by auto then show ?thesis apply (subst positive_if_decomp) using proj_fst_k_def by auto qed lemma proj_fst_k_le_one: "proj_fst_k k \\<^sub>L 1\<^sub>m K" proof - define M where "M l = mat K K (\(i, j). if (i = j \ i \ l) then (1::complex) else 0)" for l have eq: "1\<^sub>m K - proj_fst_k k = M k" unfolding M_def proj_fst_k_def apply (rule eq_matI) by auto have "M k * M k = M k" unfolding M_def apply (rule eq_matI) apply (simp add: scalar_prod_def) apply (subst sum_only_one_neq_0[of _ j]) by auto moreover have "adjoint (M k) = M k" unfolding M_def apply (rule eq_matI) by (auto simp add: adjoint_eval) ultimately have "M k * adjoint (M k) = M k" by auto then have "\M. M * adjoint M = 1\<^sub>m K - proj_fst_k k" using eq by auto then have "positive (1\<^sub>m K - proj_fst_k k)" apply (subst positive_if_decomp) using proj_fst_k_def by auto then show ?thesis unfolding lowner_le_def using proj_fst_k_def by auto qed lemma sum_proj_k: assumes "m \ K" shows "matrix_sum K (\k. proj_k k) m = proj_fst_k m" proof - have "m \ K \ matrix_sum K (\k. proj_k k) m = mat K K (\(i, j). if (i = j \ i < m) then 1 else 0)" for m proof (induct m) case 0 then show ?case apply simp apply (rule eq_matI) by auto next case (Suc m) then have m: "m < K" by auto then have m': "m \ K" by auto have "matrix_sum K proj_k (Suc m) = proj_k m + matrix_sum K proj_k m" by simp also have "\ = mat K K (\(i, j). if (i = j \ i < (Suc m)) then 1 else 0)" unfolding proj_k_mat[OF m] Suc(1)[OF m'] apply (rule eq_matI) by auto finally show ?case by auto qed then show ?thesis unfolding proj_fst_k_def using assms by auto qed lemma proj_psi_proj_k_le_exproj_k: shows "tensor_P (proj_psi_l k) (proj_k l) \\<^sub>L tensor_P (1\<^sub>m N) (proj_k l)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive_le) subgoal using proj_psi_l_def psi_l_dim ps_P_d1 by auto subgoal using proj_k_def ket_k_def ps_P_d2 by auto subgoal using positive_proj_psi_l by auto subgoal using positive_same_outer_prod proj_k_def ket_k_def by auto subgoal using psi_l_le_id by auto apply (subst lowner_le_refl[of _ K]) by (auto simp add: proj_k_def ket_k_def) definition Q1 :: "complex mat" where "Q1 = matrix_sum d (\l. tensor_P (proj_psi'_l l) (proj_k l)) R" lemma tensor_P_left_right_partial1: assumes "m1 \ carrier_mat N N" and "m2 \ carrier_mat N N" and "m3 \ carrier_mat K K" and "m4 \ carrier_mat N N" shows "tensor_P m1 (1\<^sub>m K) * tensor_P m2 m3 * tensor_P m4 (1\<^sub>m K) = tensor_P (m1 * m2 * m4) m3" proof - have "tensor_P m1 (1\<^sub>m K) * tensor_P m2 m3 = tensor_P (m1 * m2) m3" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) using assms ps_P_d1 ps_P_d2 by auto moreover have "tensor_P (m1 * m2) m3 * tensor_P m4 (1\<^sub>m K) = tensor_P (m1 * m2 * m4) m3" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) using assms ps_P_d1 ps_P_d2 by auto ultimately show ?thesis by auto qed lemma tensor_P_left_right_partial2: assumes "m1 \ carrier_mat K K" and "m2 \ carrier_mat K K" and "m3 \ carrier_mat N N" and "m4 \ carrier_mat K K" shows "tensor_P (1\<^sub>m N) m1 * tensor_P m3 m2 * tensor_P (1\<^sub>m N) m4 = tensor_P m3 (m1 * m2 * m4)" proof - have "tensor_P (1\<^sub>m N) m1 * tensor_P m3 m2 = tensor_P m3 (m1 * m2)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) using assms ps_P_d1 ps_P_d2 by auto moreover have "tensor_P m3 (m1 * m2) * tensor_P (1\<^sub>m N) m4 = tensor_P m3 (m1 * m2 * m4)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_mult[symmetric]) using assms ps_P_d1 ps_P_d2 by auto ultimately show ?thesis by auto qed lemma matrix_sum_mult_left_right: fixes A B :: "complex mat" assumes dg: "(\k. k < l \ g k \ carrier_mat m m) " and dA: "A \ carrier_mat m m" and dB: "B \ carrier_mat m m" shows "matrix_sum m (\k. A * g k * B) l = A * matrix_sum m g l * B" proof - have eq: "A * matrix_sum m g l = matrix_sum m (\k. A * g k) l" using matrix_sum_distrib_left assms by auto have "A * matrix_sum m g l * B = matrix_sum m (\k. A * g k * B) l" apply (subst eq) using matrix_sum_mult_right[of l "\k. A * g k"] assms by auto then show ?thesis by auto qed lemma mat_O_split: "mat_O = 1\<^sub>m N - 2 \\<^sub>m proj_O" apply (rule eq_matI) unfolding mat_O_def proj_O_def by auto lemma mat_O_mult_psi'_l: "mat_O *\<^sub>v (psi'_l l) = psi_l l" proof - have "mat_O *\<^sub>v (psi'_l l) = mat_O *\<^sub>v ((alpha_l l) \\<^sub>v$$ - mat_O *\<^sub>v ((beta_l l) \\<^sub>v \)" unfolding psi'_l_def apply (subst mult_minus_distrib_mat_vec) using mat_O_dim \_dim \_dim by auto also have "\ = (alpha_l l) \\<^sub>v (mat_O *\<^sub>v \) - (beta_l l) \\<^sub>v (mat_O *\<^sub>v \)" using mult_mat_vec_smult_vec_assoc[of mat_O N N] mat_O_dim \_dim \_dim by auto also have "\ = (alpha_l l) \\<^sub>v \ - (beta_l l) \\<^sub>v (- \)" using mat_O_mult_alpha mat_O_mult_beta by auto also have "\ = (alpha_l l) \\<^sub>v \ + (beta_l l) \\<^sub>v \" by auto finally show ?thesis unfolding psi_l_def by auto qed lemma mat_O_times_Q1: "adjoint (tensor_P mat_O (1\<^sub>m K)) * Q1 * (tensor_P mat_O (1\<^sub>m K)) = Q" proof - let ?m1 = "tensor_P mat_O (1\<^sub>m K)" have eq:"adjoint ?m1 = ?m1" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) apply (auto simp add: mat_O_dim ps_P_d1 ps_P_d2) by (simp add: hermitian_mat_O[unfolded hermitian_def] hermitian_one[unfolded hermitian_def]) { fix l let ?m2 = "tensor_P (proj_psi'_l l) (proj_k l)" have "?m1 * ?m2 * ?m1 = tensor_P (mat_O * (proj_psi'_l l) * mat_O) (proj_k l)" apply (subst tensor_P_left_right_partial1) using mat_O_dim proj_psi'_dim proj_k_dim by auto moreover have "mat_O * (proj_psi'_l l) * mat_O = outer_prod (psi_l l) (psi_l l)" unfolding proj_psi'_l_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) using psi'_l_dim mat_O_dim mat_O_mult_psi'_l hermitian_mat_O[unfolded hermitian_def] by auto ultimately have "?m1 * ?m2 * ?m1 = tensor_P (proj_psi_l l) (proj_k l)" unfolding proj_psi_l_def by auto } note p1 = this have "adjoint (tensor_P mat_O (1\<^sub>m K)) * Q1 * (tensor_P mat_O (1\<^sub>m K)) = ?m1 * Q1 * ?m1" using eq by auto also have "\ = matrix_sum d (\l. ?m1 * (tensor_P (proj_psi'_l l) (proj_k l)) * ?m1) R" unfolding Q1_def apply (subst matrix_sum_mult_left_right) using tensor_P_dim by auto also have "\ = Q" unfolding Q_def using p1 by auto finally show ?thesis by auto qed definition Q2 where "Q2 = matrix_sum d (\l. tensor_P (proj_psi_l (l + 1)) (proj_k l)) R" lemma Q2_dim: "Q2 \ carrier_mat d d" unfolding Q2_def apply (subst matrix_sum_dim) using tensor_P_dim by auto lemma Q2_le_one: "Q2 \\<^sub>L 1\<^sub>m d" proof - have leq: "Q2 \\<^sub>L matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) R" unfolding Q2_def apply (subst lowner_le_matrix_sum) subgoal using tensor_P_dim by auto subgoal using tensor_P_dim by auto using proj_psi_proj_k_le_exproj_k by auto have "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) R = tensor_P (1\<^sub>m N) (matrix_sum K proj_k R)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_matrix_sum2[simplified ps_P_d ps_P_d2]) subgoal using ps_P_d1 by auto using proj_k_dim by auto also have "\ = tensor_P (1\<^sub>m N) (proj_fst_k R)" using sum_proj_k K by auto also have "\ \\<^sub>L tensor_P (1\<^sub>m N) (1\<^sub>m K)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive_le) subgoal using ps_P_d1 by auto subgoal using ps_P_d2 proj_fst_k_def by auto subgoal using positive_one by auto subgoal using positive_proj_fst_k by auto subgoal using lowner_le_refl[of "1\<^sub>m N" N] by auto using proj_fst_k_le_one by auto also have "\ = 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def using ps_P.tensor_mat_id ps_P_d1 ps_P_d2 ps_P_d by auto finally have leq2: "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) R \\<^sub>L 1\<^sub>m d" by auto have ds: "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) R \ carrier_mat d d" apply (subst matrix_sum_dim) using tensor_P_dim by auto then show ?thesis using leq leq2 lowner_le_trans[OF Q2_dim ds, of "1\<^sub>m d"] by auto qed lemma qp_Q2: "is_quantum_predicate Q2" unfolding is_quantum_predicate_def proof (intro conjI) show "Q2 \ carrier_mat d d" unfolding Q2_def apply (subst matrix_sum_dim) using tensor_P_dim by auto next show "positive Q2" unfolding Q2_def apply (subst matrix_sum_positive) subgoal using tensor_P_dim by auto subgoal for k unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) subgoal using proj_psi_l_def psi_l_dim ps_P_d1 by auto subgoal using proj_k_dim ps_P_d2 K by auto subgoal using positive_proj_psi_l by auto using positive_proj_k K by auto by auto next show "Q2 \\<^sub>L 1\<^sub>m d" using Q2_le_one by auto qed lemma pre_mat: "pre = mat N N ($$i, j). if i = j \ i = 0 then 1 else 0)" apply (rule eq_matI) subgoal for i j unfolding pre_def apply (subst index_outer_prod[OF ket_pre_dim ket_pre_dim]) apply simp_all unfolding ket_pre_def by auto using outer_prod_dim[OF ket_pre_dim ket_pre_dim, folded pre_def] by auto lemma mat_Ph_split: "mat_Ph = 2 \\<^sub>m pre - 1\<^sub>m N" unfolding mat_Ph_def pre_mat apply (rule eq_matI) by auto lemma H_Ph_H: "exexH_k (n-1) * tensor_P mat_Ph (1\<^sub>m K) * exexH_k (n - 1) = 2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d" unfolding mat_Ph_split exexH_k.simps apply (subst tensor_P_left_right_partial1) subgoal using exH_k_dim[of "n - 1"] n by auto subgoal using pre_dim by auto subgoal by auto proof - have eq1: "exH_n * exH_n = 1\<^sub>m N" using unitary_exH_k[of "n - 1"] unfolding unitary_def inverts_mat_def using n hermitian_exH_n[simplified hermitian_def] exH_n_dim by auto have eq2: "exH_n * pre * exH_n = proj_psi" unfolding pre_def proj_psi_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) subgoal using ket_pre_dim by auto subgoal using exH_n_dim by auto apply (subst hermitian_exH_n[simplified hermitian_def]) using exH_k_mult_pre_is_psi by auto have eq3: "exH_n * (2 \\<^sub>m pre) * exH_n = 2 \\<^sub>m (exH_n * pre * exH_n)" using pre_dim exH_n_dim by (mat_assoc N) have "exH_n * (2 \\<^sub>m pre - 1\<^sub>m N) * exH_n = exH_n * (2 \\<^sub>m pre) * exH_n - exH_n * exH_n" using pre_dim exH_n_dim apply (mat_assoc N) by auto also have "\ = 2 \\<^sub>m (exH_n * pre * exH_n) - 1\<^sub>m N" using eq1 eq3 by auto finally have eq4: "exH_n * (2 \\<^sub>m pre - 1\<^sub>m N) * exH_n = 2 \\<^sub>m proj_psi - 1\<^sub>m N" using eq2 by auto show "tensor_P (exH_n * (2 \\<^sub>m pre - 1\<^sub>m N) * exH_n) (1\<^sub>m K) = 2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d" unfolding eq4 unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_minus1) unfolding ps_P_d1 ps_P_d2 apply (auto simp add: proj_psi_dim) apply (subst ps_P.tensor_mat_scale1) unfolding ps_P_d1 ps_P_d2 apply (auto simp add: proj_psi_dim) apply (subst ps_P.tensor_mat_id[simplified ps_P_d1 ps_P_d2 ps_P_d]) by auto qed lemma hermitian_proj_psi_minus_1: "hermitian (2 \\<^sub>m proj_psi - 1\<^sub>m N)" unfolding hermitian_def apply (subst adjoint_minus[of _ N N]) apply (auto simp add: proj_psi_dim) apply (subst adjoint_scale) using hermitian_proj_psi[simplified hermitian_def] hermitian_def adjoint_one by auto lemma unitary_proj_psi_minus_1: "unitary (2 \\<^sub>m proj_psi - 1\<^sub>m N)" proof - have a: "adjoint (2 \\<^sub>m proj_psi) = 2 \\<^sub>m proj_psi" apply (subst adjoint_scale) using hermitian_proj_psi[simplified hermitian_def] by simp have eq: "adjoint (2 \\<^sub>m proj_psi - 1\<^sub>m N) = 2 \\<^sub>m proj_psi - 1\<^sub>m N" apply (subst adjoint_minus) using proj_psi_dim a adjoint_one by auto have "(2 \\<^sub>m proj_psi) * (2 \\<^sub>m proj_psi) = 4 \\<^sub>m (proj_psi * proj_psi)" using proj_psi_dim by auto also have "\ = 4 \\<^sub>m proj_psi" using proj_psi_is_projection by auto finally have sq: "(2 \\<^sub>m proj_psi) * (2 \\<^sub>m proj_psi) = 4 \\<^sub>m proj_psi". have l: "(2 \\<^sub>m proj_psi) * (2 \\<^sub>m proj_psi - 1\<^sub>m N) = 4 \\<^sub>m proj_psi - (2 \\<^sub>m proj_psi)" apply (subst mult_minus_distrib_mat) using proj_psi_dim sq by auto have "(2 \\<^sub>m proj_psi - 1\<^sub>m N) * adjoint (2 \\<^sub>m proj_psi - 1\<^sub>m N) = (2 \\<^sub>m proj_psi - 1\<^sub>m N) * (2 \\<^sub>m proj_psi - 1\<^sub>m N)" using eq by auto also have "\ = (2 \\<^sub>m proj_psi) * (2 \\<^sub>m proj_psi - 1\<^sub>m N) - 2 \\<^sub>m proj_psi + 1\<^sub>m N" apply (subst minus_mult_distrib_mat[of _ N N]) using proj_psi_dim by auto also have "\ = 4 \\<^sub>m proj_psi - (2 \\<^sub>m proj_psi) - 2 \\<^sub>m proj_psi + 1\<^sub>m N" using l by auto also have "\ = 1\<^sub>m N" using proj_psi_dim by auto finally have "(2 \\<^sub>m proj_psi - 1\<^sub>m N) * adjoint (2 \\<^sub>m proj_psi - 1\<^sub>m N) = 1\<^sub>m N". then show ?thesis unfolding unitary_def inverts_mat_def using proj_psi_dim by auto qed lemma proj_psi_minus_1_mult_psi'_l: "(2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi'_l l = psi_l (l + 1)" proof - have eq1: "(2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi'_l l = 2 \\<^sub>m proj_psi *\<^sub>v psi'_l l - psi'_l l" apply (subst minus_mult_distrib_mat_vec) using psi'_l_dim proj_psi'_dim proj_psi_dim by auto have eq2: "2 \\<^sub>m proj_psi *\<^sub>v (psi'_l l) = 2 \\<^sub>v (proj_psi *\<^sub>v (psi'_l l))" apply (subst smult_mat_mult_mat_vec_assoc) using proj_psi_dim psi'_l_dim by auto have "proj_psi *\<^sub>v (psi'_l l) = inner_prod \ (psi'_l l) \\<^sub>v \" unfolding proj_psi_def apply (subst outer_prod_mult_vec[of _ N _ N]) using \_dim psi'_l_dim by auto also have "\ = ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) \\<^sub>v \" using psi_inner_psi'_l by auto finally have "proj_psi *\<^sub>v (psi'_l l) = ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) \\<^sub>v \" by auto then have eq3: "2 \\<^sub>v (proj_psi *\<^sub>v (psi'_l l)) = 2 * ((alpha_l l) * ccos (\ / 2) - (beta_l l) * csin (\ / 2)) \\<^sub>v \" by auto then show "(2 \\<^sub>m proj_psi - (1\<^sub>m N)) *\<^sub>v (psi'_l l) = psi_l (l + 1)" using eq1 eq2 eq3 psi_l_Suc_l_derive by simp qed lemma proj_psi_minus_1_mult_psi_Suc_l: "(2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi_l (l + 1) = psi'_l l" proof - have id: "(2 \\<^sub>m proj_psi - 1\<^sub>m N) * (2 \\<^sub>m proj_psi - 1\<^sub>m N) = 1\<^sub>m N" using unitary_proj_psi_minus_1 unfolding unitary_def hermitian_proj_psi_minus_1[simplified hermitian_def] unfolding inverts_mat_def by auto have "(2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi_l (l + 1) = (2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v ((2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi'_l l)" using proj_psi_minus_1_mult_psi'_l by auto also have "\ = ((2 \\<^sub>m proj_psi - 1\<^sub>m N) * (2 \\<^sub>m proj_psi - 1\<^sub>m N) *\<^sub>v psi'_l l)" apply (subst assoc_mult_mat_vec) using proj_psi_dim psi'_l_dim by auto also have "\ = psi'_l l" using psi'_l_dim id by auto finally show ?thesis by auto qed lemma exproj_psi_minus_1_tensor: "(2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K)) - 1\<^sub>m d = tensor_P (2 \\<^sub>m proj_psi - (1\<^sub>m N)) (1\<^sub>m K)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_id[symmetric, simplified ps_P_d]) apply (auto simp add: ps_P_d1 ps_P_d2) apply (subst ps_P.tensor_mat_scale1[symmetric]) apply (auto simp add: ps_P_d1 ps_P_d2 proj_psi_dim) apply (subst ps_P.tensor_mat_minus1) by (auto simp add: ps_P_d1 ps_P_d2 proj_psi_dim) lemma unitary_exproj_psi_minus_1: "unitary (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d)" unfolding exproj_psi_minus_1_tensor unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_unitary) using ps_P_d1 ps_P_d2 unitary_proj_psi_minus_1 unitary_one by auto lemma proj_psi_minus_1_Q2: "adjoint (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) * Q2 * (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) = Q1" proof - have eq1: "adjoint (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) = 2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d" apply (subst adjoint_minus[of _ d d]) subgoal using tensor_P_dim[of proj_psi] by auto subgoal by auto apply (subst adjoint_one) apply (subst adjoint_scale) using hermitian_exproj_psi[simplified hermitian_def] by auto let ?m1 = "tensor_P (2 \\<^sub>m proj_psi - (1\<^sub>m N)) (1\<^sub>m K)" { fix l let ?m2 = "tensor_P (proj_psi_l (l + 1)) (proj_k l)" have 121: "?m1 * ?m2 * ?m1 = tensor_P ((2 \\<^sub>m proj_psi - (1\<^sub>m N)) * (proj_psi_l (l + 1)) * (2 \\<^sub>m proj_psi - (1\<^sub>m N))) (proj_k l)" apply (subst tensor_P_left_right_partial1) using proj_psi_dim proj_psi_l_dim proj_k_dim by auto have "(2 \\<^sub>m proj_psi - (1\<^sub>m N)) * (proj_psi_l (l + 1)) * (2 \\<^sub>m proj_psi - (1\<^sub>m N)) = outer_prod ((2 \\<^sub>m proj_psi - (1\<^sub>m N)) *\<^sub>v (psi_l (l + 1))) ((2 \\<^sub>m proj_psi - (1\<^sub>m N)) *\<^sub>v (psi_l (l + 1)))" unfolding proj_psi_l_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) using proj_psi_dim psi_l_dim hermitian_proj_psi_minus_1[simplified hermitian_def] by auto also have "\ = outer_prod (psi'_l l) (psi'_l l)" using proj_psi_minus_1_mult_psi_Suc_l by auto finally have "(2 \\<^sub>m proj_psi - (1\<^sub>m N)) * (proj_psi_l (l + 1)) * (2 \\<^sub>m proj_psi - (1\<^sub>m N)) = outer_prod (psi'_l l) (psi'_l l)". then have "?m1 * ?m2 * ?m1 = tensor_P (proj_psi'_l l) (proj_k l)" using 121 proj_psi'_l_def by auto } note p1 = this have "adjoint (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) * Q2 * (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) = (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) * Q2 * (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d)" using eq1 by auto also have "\ = matrix_sum d (\l. (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d) * tensor_P (proj_psi_l (l + 1)) (proj_k l) * (2 \\<^sub>m tensor_P proj_psi (1\<^sub>m K) - 1\<^sub>m d)) R" unfolding Q2_def apply (subst matrix_sum_mult_left_right) using tensor_P_dim by auto also have "\ = matrix_sum d (\l. tensor_P (proj_psi'_l l) (proj_k l)) R" using p1 exproj_psi_minus_1_tensor by auto also have "\ = Q1" unfolding Q1_def by auto finally show ?thesis using eq1 by auto qed lemma qp_Q1: "is_quantum_predicate Q1" unfolding proj_psi_minus_1_Q2[symmetric] apply (subst qp_close_under_unitary_operator) using tensor_P_dim unitary_exproj_psi_minus_1 qp_Q2 by auto lemma qp_Q: "is_quantum_predicate Q" proof - have u: "unitary (tensor_P mat_O (1\<^sub>m K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_unitary) subgoal unfolding ps_P_d1 mat_O_def by auto subgoal unfolding ps_P_d2 by auto subgoal using unitary_mat_O by auto using unitary_one by auto then show ?thesis using tensor_P_dim qp_Q1 using qp_close_under_unitary_operator[OF tensor_P_dim u qp_Q1] by (simp add: mat_O_times_Q1 ) qed lemma hoare_triple_D1: "\\<^sub>p {Q} Utrans_P vars1 mat_O {Q1}" unfolding Utrans_P_is_tensor_P1 mat_O_times_Q1[symmetric] apply (subst hoare_partial.intros(2)) using qp_Q1 by auto lemma hoare_triple_D2: "\\<^sub>p {Q1} hadamard_n n ;; Utrans_P vars1 mat_Ph ;; hadamard_n n {Q2}" proof - let ?H = "exexH_k (n - 1)" let ?Ph = "tensor_P mat_Ph (1\<^sub>m K)" let ?O = "tensor_P mat_O (1\<^sub>m K)" have h1: "\\<^sub>p {adjoint ?H * Q2 * ?H} hadamard_n n {Q2}" using hoare_hadamard_n[OF qp_Q2, of "n - 1"] n by auto have qp1: "is_quantum_predicate ((adjoint ?H) * Q2 * ?H)" using qp_close_under_unitary_operator unitary_exexH_k n exexH_k_dim qp_Q2 by auto then have h2: "\\<^sub>p {adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph} Utrans_P vars1 mat_Ph {adjoint ?H * Q2 * ?H}" using qp1 Utrans_P_is_tensor_P1 hoare_partial.intros by auto have qp2: "is_quantum_predicate (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph)" using qp_close_under_unitary_operator[of "tensor_P mat_Ph (1\<^sub>m K)"] ps2_P.ptensor_mat_carrier ps2_P_d0 unitary_ex_mat_Ph qp1 by auto then have h3: "\\<^sub>p {adjoint ?H * (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph) * ?H} hadamard_n n {adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph}" using hoare_hadamard_n[OF qp2, of "n - 1"] n by auto have qp3: "is_quantum_predicate (adjoint ?H * (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph) * ?H)" using qp_close_under_unitary_operator[of "?H"] exexH_k_dim unitary_exexH_k qp2 n by auto have h4: "\\<^sub>p {adjoint ?H * (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph) * ?H} hadamard_n n ;; Utrans_P vars1 mat_Ph {adjoint ?H * Q2 * ?H}" using h2 h3 qp1 qp2 qp3 hoare_partial.intros by auto then have h5: "\\<^sub>p {adjoint ?H * (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph) * ?H} hadamard_n n ;; Utrans_P vars1 mat_Ph ;; hadamard_n n {Q2}" using h1 qp_Q2 qp3 qp1 hoare_partial.intros(3)[OF qp3 qp1 qp_Q2 h4 h1] by auto have "adjoint ?H * (adjoint ?Ph * (adjoint ?H * Q2 * ?H) * ?Ph) * ?H = adjoint (?H * ?Ph * ?H) * Q2 * (?H * ?Ph * ?H)" apply (mat_assoc d) using exexH_k_dim n tensor_P_dim Q2_dim by auto also have "\ = Q1" using H_Ph_H proj_psi_minus_1_Q2 by auto finally show ?thesis using h5 by auto qed definition exM0 where "exM0 = tensor_P (1\<^sub>m N) M0" lemma M0_mult_ket_k_R: "M0 *\<^sub>v ket_k R = ket_k R" apply (rule eq_vecI) unfolding M0_def ket_k_def by (auto simp add: scalar_prod_def sum_only_one_neq_0) lemma exP0_P': "adjoint exM0 * P' * exM0 = P'" proof - have eq: "adjoint exM0 = exM0" unfolding exM0_def ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) unfolding ps_P_d1 ps_P_d2 using M0_dim adjoint_one hermitian_M0[unfolded hermitian_def] by auto have eq2: "M0 * (proj_k R) * M0 = (proj_k R)" unfolding proj_k_def apply (subst outer_prod_left_right_mat[of _ K _ K _ K _ K]) unfolding hermitian_M0[unfolded hermitian_def] M0_mult_ket_k_R using ket_k_dim M0_dim by auto show ?thesis unfolding eq unfolding exM0_def P'_def apply (subst tensor_P_left_right_partial2) using M0_dim proj_k_dim eq2 proj_psi_l_dim by auto qed definition exM1 where "exM1 = tensor_P (1\<^sub>m N) M1" lemma M1_mult_ket_k: assumes "k < R" shows "M1 *\<^sub>v ket_k k = ket_k k" apply (rule eq_vecI) unfolding M1_def ket_k_def by (auto simp add: scalar_prod_def assms R sum_only_one_neq_0) lemma exP1_Q: "adjoint exM1 * Q * exM1 = Q" proof - have eq: "adjoint exM1 = exM1" unfolding exM1_def ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) unfolding ps_P_d1 ps_P_d2 using M1_dim adjoint_one hermitian_M1[unfolded hermitian_def] by auto { fix k assume k: "k < R" let ?m = "tensor_P (proj_psi_l k) (proj_k k)" have "exM1 * ?m * exM1 = tensor_P (proj_psi_l k) (M1 * (proj_k k) * M1)" unfolding exM1_def apply (subst tensor_P_left_right_partial2) using M1_dim proj_k_dim proj_psi_l_dim by auto also have "\ = tensor_P (proj_psi_l k) (outer_prod (M1 *\<^sub>v ket_k k) (M1 *\<^sub>v ket_k k))" unfolding proj_k_def apply (subst outer_prod_left_right_mat[of _ K _ K _ K _ K]) unfolding hermitian_M1[unfolded hermitian_def] using ket_k_dim M1_dim by auto finally have "exM1 * ?m * exM1 = ?m" unfolding proj_k_def using k M1_mult_ket_k by auto } note p1 = this have "adjoint exM1 * Q * exM1 = exM1 * Q * exM1" using eq by auto also have "\ = matrix_sum d (\k. exM1 * (tensor_P (proj_psi_l k) (proj_k k)) * exM1) R" unfolding Q_def apply (subst matrix_sum_mult_left_right) using tensor_P_dim exM1_def by auto also have "\ = matrix_sum d (\k. tensor_P (proj_psi_l k) (proj_k k)) R" apply (subst matrix_sum_cong) using p1 by auto finally show ?thesis using Q_def by auto qed lemma qp_P': "is_quantum_predicate P'" unfolding is_quantum_predicate_def proof (intro conjI) show "P' \ carrier_mat d d" unfolding P'_def using tensor_P_dim by auto show "positive P'" unfolding P'_def ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) apply (auto simp add: ps_P_d1 ps_P_d2 proj_O_dim proj_k_dim) using proj_psi_l_dim positive_proj_psi_l positive_proj_k K by auto show "P' \\<^sub>L 1\<^sub>m d" unfolding P'_def ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_le_one[simplified ps_P_d]) by (auto simp add: ps_P_d1 ps_P_d2 proj_psi_l_dim K proj_k_dim positive_proj_psi_l positive_proj_k proj_k_le_one psi_l_le_id) qed lemma P'_add_Q: "P' + Q = matrix_sum d (\l. tensor_P (proj_psi_l l) (proj_k l)) (R + 1)" apply simp unfolding P'_def Q_def by auto lemma positive_Qk: "positive (tensor_P (proj_psi_l l) (proj_k l))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) unfolding ps_P_d1 ps_P_d2 using proj_psi_l_dim proj_k_dim positive_proj_psi_l positive_proj_k by auto lemma P'_Q_dim: "P' + Q \ carrier_mat d d" unfolding P'_add_Q apply (subst matrix_sum_dim) using tensor_P_dim by auto lemma P'_add_Q_le_one: "P' + Q \\<^sub>L 1\<^sub>m d" proof - have leq: "matrix_sum d (\l. tensor_P (proj_psi_l l) (proj_k l)) (R + 1) \\<^sub>L matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) (R + 1)" unfolding Q2_def apply (subst lowner_le_matrix_sum) subgoal using tensor_P_dim by auto subgoal using tensor_P_dim by auto using proj_psi_proj_k_le_exproj_k by auto have "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) (R + 1) = tensor_P (1\<^sub>m N) (matrix_sum K proj_k (R + 1))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_matrix_sum2[simplified ps_P_d ps_P_d2]) subgoal using ps_P_d1 by auto using proj_k_dim by auto also have "\ = tensor_P (1\<^sub>m N) (proj_fst_k (R + 1))" using sum_proj_k[of "R + 1"] K by auto also have "\ \\<^sub>L tensor_P (1\<^sub>m N) (1\<^sub>m K)" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive_le) subgoal using ps_P_d1 by auto subgoal using ps_P_d2 proj_fst_k_def by auto subgoal using positive_one by auto subgoal using positive_proj_fst_k by auto subgoal using lowner_le_refl[of "1\<^sub>m N" N] by auto using proj_fst_k_le_one by auto also have "\ = 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def using ps_P.tensor_mat_id ps_P_d1 ps_P_d2 ps_P_d by auto finally have leq2: "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) (R + 1) \\<^sub>L 1\<^sub>m d" by auto have ds: "matrix_sum d (\k. tensor_P (1\<^sub>m N) (proj_k k)) (R + 1) \ carrier_mat d d" apply (subst matrix_sum_dim) using tensor_P_dim by auto then show ?thesis using leq leq2 lowner_le_trans[OF P'_Q_dim ds, of "1\<^sub>m d"] unfolding P'_add_Q by auto qed lemma qp_P'_Q: "is_quantum_predicate (P' + Q)" unfolding is_quantum_predicate_def proof (intro conjI) show "P' + Q \ carrier_mat d d" unfolding P'_add_Q apply (subst matrix_sum_dim) using tensor_P_dim by auto show "positive (P' + Q)" unfolding P'_add_Q apply (subst matrix_sum_positive) using tensor_P_dim positive_Qk by auto show " P' + Q \\<^sub>L 1\<^sub>m d" using P'_add_Q_le_one by auto qed lemma Q2_leq_lemma: "tensor_P (1\<^sub>m N) (mat_incr K) * Q2 * adjoint (tensor_P (1\<^sub>m N) (mat_incr K)) \\<^sub>L P' + Q" proof - have ad: "adjoint (tensor_P (1\<^sub>m N) (mat_incr K)) = tensor_P (1\<^sub>m N) (adjoint (mat_incr K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) using ps_P_d1 ps_P_d2 mat_incr_dim adjoint_one by auto let ?m1 = "tensor_P (1\<^sub>m N) (mat_incr K)" let ?m3 = "tensor_P (1\<^sub>m N) (adjoint (mat_incr K))" { fix l assume "l < R" then have "l < K - 1" using K by auto then have m: "(mat_incr K) *\<^sub>v (ket_k l) = (ket_k (l + 1))" using mat_incr_mult_ket_k by auto let ?m2 = "tensor_P (proj_psi_l (l + 1)) (proj_k l)" have eq: "?m1 * ?m2 * ?m3 = tensor_P (proj_psi_l (l + 1)) ((mat_incr K) * (proj_k l) * adjoint (mat_incr K))" apply (subst tensor_P_left_right_partial2) using proj_k_dim proj_psi_l_dim mat_incr_dim adjoint_dim[OF mat_incr_dim] by auto have "(mat_incr K) * (proj_k l) * adjoint (mat_incr K) = outer_prod ((mat_incr K) *\<^sub>v (ket_k l)) ((mat_incr K) *\<^sub>v (ket_k l))" unfolding proj_k_def apply (subst outer_prod_left_right_mat[of _ K _ K _ K _ K]) using ket_k_dim mat_incr_dim adjoint_dim[OF mat_incr_dim] adjoint_adjoint[of "mat_incr K"] by auto also have "\ = proj_k (l + 1)" unfolding proj_k_def using m by auto finally have "?m1 * ?m2 * ?m3 = tensor_P (proj_psi_l (l + 1)) (proj_k (l + 1))" using eq by auto } note p1 = this have "?m1 * Q2 * ?m3 = matrix_sum d (\l. ?m1 * (tensor_P (proj_psi_l (l + 1)) (proj_k l)) * ?m3) R" unfolding Q2_def apply(subst matrix_sum_mult_left_right) using tensor_P_dim by auto also have "\ = matrix_sum d (\l. tensor_P (proj_psi_l (l + 1)) (proj_k (l + 1))) R" apply (subst matrix_sum_cong) using p1 by auto finally have eq1: "?m1 * Q2 * ?m3 = matrix_sum d (\l. tensor_P (proj_psi_l (l + 1)) (proj_k (l + 1))) R" (is "_=?r") . have eq2: "P' + Q = tensor_P (proj_psi_l 0) (proj_k 0) + ?r" unfolding P'_add_Q apply (subst matrix_sum_Suc_remove_head) using tensor_P_dim by auto have "tensor_P (proj_psi_l 0) (proj_k 0) + ?r \\<^sub>L P' + Q" unfolding eq2[symmetric] apply (subst lowner_le_refl) using P'_Q_dim by auto moreover have "positive (tensor_P (proj_psi_l 0) (proj_k 0))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) unfolding ps_P_d1 ps_P_d2 using proj_psi_l_dim proj_k_dim positive_proj_psi_l positive_proj_k by auto moreover have "matrix_sum d (\l. tensor_P (proj_psi_l (l + 1)) (proj_k (l + 1))) R \ carrier_mat d d" apply (subst matrix_sum_dim) using tensor_P_dim by auto ultimately have "?r \\<^sub>L P' + Q" apply (subst add_positive_le_reduce2[of ?r d "tensor_P (proj_psi_l 0) (proj_k 0)" "P' + Q"]) using tensor_P_dim P'_Q_dim by auto then show ?thesis using eq1 ad by auto qed lemma Q2_leq: "Q2 \\<^sub>L adjoint (tensor_P (1\<^sub>m N) (mat_incr K)) * (P' + Q) * tensor_P (1\<^sub>m N) (mat_incr K)" proof - let ?m1 = "tensor_P (1\<^sub>m N) (mat_incr K)" let ?m2 = "adjoint (tensor_P (1\<^sub>m N) (mat_incr K))" have "?m1 * ?m2 = 1\<^sub>m d" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_adjoint) unfolding ps_P_d1 ps_P_d2 apply (auto simp add: mat_incr_dim adjoint_one) apply (subst ps_P.tensor_mat_mult[symmetric]) unfolding ps_P_d1 ps_P_d2 apply (auto simp add: mat_incr_dim adjoint_dim mat_incr_mult_adjoint_mat_incr) using ps_P.tensor_mat_id ps_P_d ps_P_d1 ps_P_d2 by auto then have inv: "?m2 * ?m1 = 1\<^sub>m d" using mat_mult_left_right_inverse[of ?m1 d ?m2] tensor_P_dim adjoint_dim by auto have d: "?m1 * Q2 * ?m2 \ carrier_mat d d" using tensor_P_dim adjoint_dim[OF tensor_P_dim] Q2_dim by fastforce have le: "?m2 * (?m1 * Q2 * ?m2) * ?m1 \\<^sub>L ?m2 * (P' + Q) * ?m1" (is "lowner_le ?l ?r") apply (subst lowner_le_keep_under_measurement[of _ d]) using Q2_leq_lemma tensor_P_dim P'_Q_dim d by auto have "?l = (?m2 * ?m1) * Q2 * (?m2 * ?m1)" apply (mat_assoc d) using tensor_P_dim Q2_dim by auto also have "\ = 1\<^sub>m d * Q2 * 1\<^sub>m d" using inv by auto also have "\ = Q2" using Q2_dim by auto finally have eq: "?l = Q2". show ?thesis using eq le by auto qed lemma hoare_triple_D3: "\\<^sub>p {Q2} Utrans_P vars2 (mat_incr K) {adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1}" unfolding exP0_P' exP1_Q proof - let ?m = "tensor_P (1\<^sub>m N) (mat_incr K)" have h1: "\\<^sub>p {adjoint ?m * (P' + Q) * ?m} Utrans ?m {P' + Q}" using qp_P'_Q hoare_partial.intros by auto have qp: "is_quantum_predicate (adjoint ?m * (P' + Q) * ?m)" using qp_close_under_unitary_operator tensor_P_dim qp_P'_Q unitary_exmat_incr by auto then have "\\<^sub>p {Q2} Utrans ?m {P' + Q}" using hoare_partial.intros(6)[OF qp_Q2 qp_P'_Q qp qp_P'_Q] Q2_leq h1 lowner_le_refl[OF P'_Q_dim] by auto moreover have "Utrans ?m = Utrans_P vars2 (mat_incr K)" apply (subst Utrans_P_is_tensor_P2) unfolding mat_incr_def by auto ultimately show "\\<^sub>p {Q2} Utrans_P vars2 (mat_incr K) {P' + Q}" by auto qed lemma qp_D3_post: "is_quantum_predicate (adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1)" unfolding exP0_P' exP1_Q using qp_P'_Q by auto lemma hoare_triple_D: "\\<^sub>p {Q} D {adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1}" proof - have "\\<^sub>p {Q1} hadamard_n n;; (Utrans_P vars1 mat_Ph;; hadamard_n n) {Q2}" using well_com_hadamard_n well_com_mat_Ph hoare_triple_D2 qp_Q1 qp_Q2 by (auto simp add: hoare_patial_seq_assoc) then have "\\<^sub>p {Q} Utrans_P vars1 mat_O;; (hadamard_n n;; (Utrans_P vars1 mat_Ph;; hadamard_n n)) {Q2}" using hoare_triple_D1 qp_Q qp_Q1 qp_Q2 hoare_partial.intros(3) by auto moreover have "well_com (Utrans_P vars1 mat_Ph;; hadamard_n n)" using well_com_hadamard_n well_com_mat_Ph by auto ultimately have "\\<^sub>p {Q} (Utrans_P vars1 mat_O;; hadamard_n n);; (Utrans_P vars1 mat_Ph;; hadamard_n n) {Q2}" using well_com_hadamard_n well_com_mat_O qp_Q qp_Q2 by (auto simp add: hoare_patial_seq_assoc) moreover have "well_com (Utrans_P vars1 mat_O;; hadamard_n n)" using well_com_mat_O well_com_hadamard_n by auto ultimately have "\\<^sub>p {Q} Utrans_P vars1 mat_O;; hadamard_n n;; Utrans_P vars1 mat_Ph;; hadamard_n n {Q2}" using well_com_hadamard_n well_com_mat_Ph qp_Q qp_Q2 by (auto simp add: hoare_patial_seq_assoc) with qp_Q qp_Q2 qp_D3_post hoare_triple_D3 show "\\<^sub>p {Q} D {adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1}" unfolding D_def using hoare_partial.intros(3) by auto qed lemma psi_is_psi_l0: "\ = psi_l 0" unfolding \_eq psi_l_def alpha_l_def beta_l_def by auto lemma proj_psi_is_proj_psi_l0: "proj_psi = proj_psi_l 0" unfolding proj_psi_def psi_is_psi_l0 proj_psi_l_def by auto lemma lowner_le_Q: "tensor_P proj_psi (proj_k 0) \\<^sub>L adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1" proof - let ?r = "matrix_sum d (\l. tensor_P (proj_psi_l l) (proj_k l)) (R + 1)" let ?l = "tensor_P (proj_psi_l 0) (proj_k 0)" have eq: "?r = ?l + matrix_sum d (\l. tensor_P (proj_psi_l (l + 1)) (proj_k (l + 1))) R" (is "_ = _ + ?s") apply (subst matrix_sum_Suc_remove_head) using tensor_P_dim by auto have d: "?s \ carrier_mat d d" apply (subst matrix_sum_dim) using tensor_P_dim by auto have pt: "positive (tensor_P (proj_psi_l l) (proj_k l))" for l unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) unfolding ps_P_d1 ps_P_d2 using proj_psi_l_dim proj_k_dim positive_proj_psi_l positive_proj_k by auto have ps: "positive ?s" apply (subst matrix_sum_positive) subgoal using tensor_P_dim by auto using pt by auto have "?l \\<^sub>L ?r" unfolding eq apply (subst add_positive_le_reduce1[of ?l d ?s]) subgoal using tensor_P_dim by auto subgoal using d by auto subgoal using tensor_P_dim d by auto subgoal using ps by auto apply (subst lowner_le_refl[of _ d]) using tensor_P_dim d by auto then show ?thesis unfolding exP0_P' exP1_Q P'_add_Q proj_psi_is_proj_psi_l0 by auto qed lemma hoare_triple_while: "\\<^sub>p {adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1} While_P vars2 M0 M1 D {P'}" proof - let ?m = "\(n::nat). if n = 0 then mat_extension dims vars2 M0 else if n = 1 then mat_extension dims vars2 M1 else undefined" have dM0: "M0 \ carrier_mat K K" unfolding M0_def by auto have dM1: "M1 \ carrier_mat K K" unfolding M1_def by auto have m0: "?m 0 = exM0" apply (simp) unfolding exM0_def ps2_P.ptensor_mat_def mat_ext_vars2[OF dM0] by auto have m1: "?m 1 = exM1" unfolding exM1_def ps2_P.ptensor_mat_def mat_ext_vars2[OF dM1] by auto have "\\<^sub>p {Q} D {adjoint (?m 0) * P' * (?m 0) + adjoint (?m 1) * Q * (?m 1)}" using hoare_triple_D m0 m1 by auto then show ?thesis unfolding While_P_def using qp_D3_post qp_P' hoare_partial.intros(5)[OF qp_P' qp_Q, of D ?m] m0 m1 by auto qed lemma R_and_a_half_\: "(R + 1/2) * \ = pi / 2" using R \_neq_0 by auto lemma psi_lR_is_beta: "psi_l R = \" unfolding psi_l_def alpha_l_def beta_l_def R_and_a_half_\ by auto lemma post_mult_beta: "post *\<^sub>v \ = \" by (auto simp add: post_def \_def scalar_prod_def sum_only_one_neq_0) lemma post_mult_post: "post * post = post" by (auto simp add: post_def scalar_prod_def sum_only_one_neq_0) lemma post_mult_proj_psi_lR: "post * proj_psi_l R = proj_psi_l R" proof - let ?R = "proj_psi_l R" have "post * ?R = post * ?R * 1\<^sub>m N" using post_dim proj_psi_l_dim[of R] by auto also have "\ = outer_prod (post *\<^sub>v psi_l R) ((1\<^sub>m N) *\<^sub>v psi_l R)" unfolding proj_psi_l_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) by (auto simp add: psi_l_dim post_dim adjoint_one) also have "\ = ?R" unfolding proj_psi_l_def unfolding psi_lR_is_beta unfolding post_mult_beta using \_dim by auto finally show "post * ?R = ?R". qed lemma proj_psi_lR_mult_post: "proj_psi_l R * post = proj_psi_l R" proof - let ?R = "proj_psi_l R" have "?R * post = 1\<^sub>m N * ?R * post" using post_dim proj_psi_l_dim[of R] by auto also have "\ = outer_prod ((1\<^sub>m N) *\<^sub>v psi_l R) (post *\<^sub>v psi_l R)" unfolding proj_psi_l_def apply (subst outer_prod_left_right_mat[of _ N _ N _ N _ N]) by (auto simp add: psi_l_dim post_dim hermitian_post[unfolded hermitian_def]) also have "\ = ?R" unfolding proj_psi_l_def unfolding psi_lR_is_beta unfolding post_mult_beta using \_dim by auto finally show "?R * post = ?R". qed lemma proj_psi_lR_mult_proj_psi_lR: "proj_psi_l R * proj_psi_l R = proj_psi_l R" unfolding proj_psi_l_def psi_lR_is_beta apply (subst outer_prod_mult_outer_prod[of _ N _ N _ _ N]) by (auto simp add: \_inner) lemma proj_psi_lR_le_post: "proj_psi_l R \\<^sub>L post" proof - let ?R = "proj_psi_l R" let ?s = "post - ?R" have eq1: "post * (post - ?R) = post - ?R" apply (subst mult_minus_distrib_mat[of _ N N _ N]) apply (auto simp add: post_dim proj_psi_l_dim[of R]) using post_mult_post post_mult_proj_psi_lR by auto have eq2: "?R * (post - ?R) = 0\<^sub>m N N" apply (subst mult_minus_distrib_mat[of _ N N _ N]) apply (auto simp add: post_dim proj_psi_l_dim[of R]) unfolding proj_psi_lR_mult_post proj_psi_lR_mult_proj_psi_lR using proj_psi_l_dim[of R] by auto have "adjoint ?s = ?s" apply (subst adjoint_minus[of _ N N]) using post_dim proj_psi_l_dim hermitian_post hermitian_proj_psi_l K by (auto simp add: hermitian_def) then have "?s * adjoint ?s = ?s * ?s" by auto also have "\ = post * (post - ?R) - ?R * (post - ?R)" using post_dim proj_psi_l_dim[of R] by (mat_assoc N) also have "\ = post - ?R" unfolding eq1 eq2 using post_dim proj_psi_l_dim[of R] by auto finally have "?s * adjoint ?s = ?s". then have "\M. M * adjoint M = ?s" by auto then have "positive ?s" apply (subst positive_if_decomp[of ?s N]) using post_dim proj_psi_l_dim[of R] by auto then show ?thesis unfolding lowner_le_def using post_dim proj_psi_l_dim[of R] by auto qed lemma P'_le_post_R: "P' \\<^sub>L (tensor_P post (proj_k R))" proof - let ?r = "tensor_P post (proj_k R)" have "?r - P' = tensor_P (post - proj_psi_l R) (proj_k R)" unfolding P'_def ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_minus1) unfolding ps_P_d1 ps_P_d2 using post_dim proj_psi_l_dim proj_k_dim by auto moreover have "positive (tensor_P (post - proj_psi_l R) (proj_k R))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) unfolding ps_P_d1 ps_P_d2 using proj_psi_lR_le_post[unfolded lowner_le_def] post_dim proj_psi_l_dim[of R] proj_k_dim positive_proj_k by auto ultimately show "P' \\<^sub>L ?r" unfolding lowner_le_def P'_def using tensor_P_dim by auto qed lemma positive_post: "positive post" proof - have ad: "adjoint post = post" using hermitian_post[unfolded hermitian_def] by auto then have "post * adjoint post = post" unfolding ad post_mult_post by auto then have "\M. M * adjoint M = post" by auto then show ?thesis using positive_if_decomp post_dim by auto qed lemma lowner_le_P': "P' \\<^sub>L tensor_P post (1\<^sub>m K)" proof - let ?r = "tensor_P post (1\<^sub>m K)" let ?m = "tensor_P post (proj_k R)" have "?m \\<^sub>L ?r" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive_le) unfolding ps_P_d1 ps_P_d2 using post_dim proj_k_dim positive_post positive_proj_k lowner_le_refl[of post] proj_k_le_one by auto then show "P' \\<^sub>L ?r" using lowner_le_trans[of P' d ?m ?r] P'_le_post_R unfolding P'_def using tensor_P_dim by auto qed lemma post_mult_testNk: assumes "f k" shows "post * (testN k) = testN k" using assms by (auto simp add: post_def testN_def scalar_prod_def sum_only_one_neq_0) lemma post_mult_testNk_neg: assumes "\ f k" shows "post * testN k = 0\<^sub>m N N" using assms by (auto simp add: post_def testN_def scalar_prod_def sum_only_one_neq_0) lemma testN_post1: "f k \ adjoint (testN k) * post * testN k = testN k" apply (subst assoc_mult_mat[of _ N N _ N _ N]) apply (auto simp add: adjoint_dim testN_dim post_dim) apply (subst post_mult_testNk, simp) unfolding hermitian_testN[unfolded hermitian_def] using testN_mult_testN by auto lemma testN_post2: "\ f k \ adjoint (testN k) * post * testN k = 0\<^sub>m N N" apply (subst assoc_mult_mat[of _ N N _ N _ N]) apply (auto simp add: adjoint_dim testN_dim post_dim) apply (subst post_mult_testNk_neg, simp) unfolding hermitian_testN[unfolded hermitian_def] using testN_dim[of k] by auto definition post_fst_k :: "nat \ complex mat" where "post_fst_k k = mat N N (\(i, j). if (i = j \ f i \ i < k) then 1 else 0)" lemma post_fst_kN: "post_fst_k N = post" unfolding post_fst_k_def post_def by auto lemma post_fst_k_Suc: "f i \ post_fst_k (Suc i) = testN i + post_fst_k i" apply (rule eq_matI) unfolding post_fst_k_def testN_def by auto lemma post_fst_k_Suc_neg: "\ f i \ post_fst_k (Suc i) = post_fst_k i" apply (rule eq_matI) unfolding post_fst_k_def apply auto using less_antisym by fastforce lemma testN_sum: "matrix_sum N (\k. adjoint (testN k) * post * testN k) N = post" proof - have "m \ N \ matrix_sum N (\k. adjoint (testN k) * post * testN k) m = post_fst_k m" for m proof (induct m) case 0 then show ?case apply simp unfolding post_fst_k_def by auto next case (Suc m) then have m: "m \ N" by auto show ?case proof (cases "f m") case True show ?thesis apply simp apply (subst testN_post1[OF True]) apply (subst Suc(1)[OF m]) using post_fst_k_Suc True by auto next case False show ?thesis apply simp apply (subst testN_post2[OF False]) apply (subst Suc(1)[OF m]) using post_fst_k_Suc_neg False post_fst_k_def by auto qed qed then show ?thesis using post_fst_kN by auto qed lemma tensor_P_testN_sum: "matrix_sum d (\k. adjoint (tensor_P (testN k) (1\<^sub>m K)) * tensor_P post (1\<^sub>m K) * tensor_P (testN k) (1\<^sub>m K)) N = tensor_P post (1\<^sub>m K)" proof - have eq: "adjoint (tensor_P (testN k) (1\<^sub>m K)) * tensor_P post (1\<^sub>m K) * tensor_P (testN k) (1\<^sub>m K) = tensor_P (adjoint (testN k) * post * (testN k)) (1\<^sub>m K)" for k apply (subst tensor_P_adjoint_left_right) subgoal unfolding testN_def by auto subgoal by auto subgoal using post_dim by auto using adjoint_one by auto moreover have "matrix_sum N (\k. adjoint (testN k) * post * testN k) N = post" using testN_sum by auto show ?thesis unfolding eq apply (subst matrix_sum_tensor_P1) subgoal unfolding testN_def by auto subgoal by auto using testN_sum by auto qed lemma post_le_one: "post \\<^sub>L 1\<^sub>m N" proof - let ?s = "1\<^sub>m N - post" have eq1: "1\<^sub>m N * (1\<^sub>m N - post) = 1\<^sub>m N - post" apply (mat_assoc N) using post_dim by auto have eq2: "post * (1\<^sub>m N - post) = 0\<^sub>m N N" apply (subst mult_minus_distrib_mat[of _ N N]) using post_dim by (auto simp add: post_mult_post) have "adjoint ?s = ?s" apply (subst adjoint_minus) apply (auto simp add: post_dim adjoint_dim) using adjoint_one hermitian_post[unfolded hermitian_def] by auto then have "?s * adjoint ?s = ?s * ?s" by auto also have "\ = 1\<^sub>m N * (1\<^sub>m N - post) - post * (1\<^sub>m N - post)" apply (mat_assoc N) using post_dim by auto also have "\ = ?s" unfolding eq1 eq2 using post_dim by auto finally have "?s * adjoint ?s = ?s". then have "\M. M * adjoint M = ?s" by auto then have "positive ?s" apply (subst positive_if_decomp[of ?s N]) using post_dim by auto then show ?thesis unfolding lowner_le_def using post_dim by auto qed lemma qp_post: "is_quantum_predicate (tensor_P post (1\<^sub>m K))" unfolding is_quantum_predicate_def proof (intro conjI) show "tensor_P post (1\<^sub>m K) \ carrier_mat d d" using tensor_P_dim by auto show "positive (tensor_P post (1\<^sub>m K))" unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive) by (auto simp add: ps_P_d1 ps_P_d2 post_dim positive_post positive_one) show "tensor_P post (1\<^sub>m K) \\<^sub>L 1\<^sub>m d" unfolding ps_P.tensor_mat_id[symmetric, unfolded ps_P_d ps_P_d1 ps_P_d2] unfolding ps2_P.ptensor_mat_def apply (subst ps_P.tensor_mat_positive_le) unfolding ps_P_d1 ps_P_d2 using post_dim positive_post positive_one post_le_one lowner_le_refl[of "1\<^sub>m K" K] by auto qed lemma hoare_triple_if: "\\<^sub>p {tensor_P post (1\<^sub>m K)} Measure_P vars1 N testN (replicate N SKIP) {tensor_P post (1\<^sub>m K)}" proof - define M where "M = (\n. mat_extension dims vars1 (testN n))" define Post where "Post = (\(k::nat). tensor_P post (1\<^sub>m K))" have M: "M = (\n. tensor_P (testN n) (1\<^sub>m K))" unfolding M_def using mat_ext_vars1 by auto have skip: "\k. k < N \ (replicate N SKIP) ! k = SKIP" by simp have h: "\k. k < N \ \\<^sub>p {Post k} replicate N SKIP ! k {tensor_P post (1\<^sub>m K)}" unfolding Post_def skip using qp_post hoare_partial.intros by auto moreover have "\k. k < N \ is_quantum_predicate (Post k)" unfolding Post_def using qp_post by auto ultimately show ?thesis unfolding Measure_P_def apply (fold M_def) using hoare_partial.intros(4)[of N Post "tensor_P post (1\<^sub>m K)" "replicate N SKIP" M] unfolding M Post_def using tensor_P_testN_sum qp_post by auto qed theorem grover_partial_deduct: "\\<^sub>p {tensor_P pre (proj_k 0)} Grover {tensor_P post (1\<^sub>m K)}" unfolding Grover_def proof - have "\\<^sub>p {tensor_P pre (proj_k 0)} hadamard_n n {adjoint exM0 * P' * exM0 + adjoint exM1 * Q * exM1}" using hoare_partial.intros(6)[OF qp_pre qp_D3_post qp_pre qp_init_post] hoare_triple_init lowner_le_refl[OF tensor_P_dim] lowner_le_Q by auto then have "\\<^sub>p {tensor_P pre (proj_k 0)} hadamard_n n;; While_P vars2 M0 M1 D {P'}" using hoare_triple_while hoare_partial.intros(3) qp_pre qp_D3_post qp_P' by auto then have "\\<^sub>p {tensor_P pre (proj_k 0)} hadamard_n n;; While_P vars2 M0 M1 D {tensor_P post (1\<^sub>m K)}" using lowner_le_P' hoare_partial.intros(6)[OF qp_pre qp_post qp_pre qp_P'] lowner_le_P' lowner_le_refl[OF tensor_P_dim] by auto then show " \\<^sub>p {tensor_P pre (proj_k 0)} hadamard_n n;; While_P vars2 M0 M1 D;; Measure_P vars1 N testN (replicate N SKIP) {tensor_P post (1\<^sub>m K)}" using hoare_triple_if qp_pre qp_post hoare_partial.intros(3) by auto qed theorem grover_partial_correct: "\\<^sub>p {tensor_P pre (proj_k 0)} Grover {tensor_P post (1\<^sub>m K)}" using grover_partial_deduct well_com_Grover qp_pre qp_post hoare_partial_sound by auto end end diff --git a/thys/QHLProver/Matrix_Limit.thy b/thys/QHLProver/Matrix_Limit.thy --- a/thys/QHLProver/Matrix_Limit.thy +++ b/thys/QHLProver/Matrix_Limit.thy @@ -1,1769 +1,1782 @@ section \Matrix limits\ theory Matrix_Limit imports Complex_Matrix begin subsection \Definition of limit of matrices\ definition limit_mat :: "(nat \ complex mat) \ complex mat \ nat \ bool" where "limit_mat X A m \ (\ n. X n \ carrier_mat m m \ A \ carrier_mat m m \ (\ i < m. \ j < m. (\ n. (X n)  (i, j)) \ (A  (i, j))))" lemma limit_mat_unique: assumes limA: "limit_mat X A m" and limB: "limit_mat X B m" shows "A = B" proof - have dim: "A \ carrier_mat m m" "B \ carrier_mat m m" using limA limB limit_mat_def by auto { fix i j assume i: "i < m" and j: "j < m" have "(\ n. (X n)  (i, j)) \ (A  (i, j))" using limit_mat_def limA i j by auto moreover have "(\ n. (X n)  (i, j)) \ (B  (i, j))" using limit_mat_def limB i j by auto ultimately have "(A  (i, j)) = (B  (i, j))" using LIMSEQ_unique by auto } then show "A = B" using mat_eq_iff dim by auto qed lemma limit_mat_const: fixes A :: "complex mat" assumes "A \ carrier_mat m m" shows "limit_mat (\k. A) A m" unfolding limit_mat_def using assms by auto lemma limit_mat_scale: fixes X :: "nat \ complex mat" and A :: "complex mat" assumes limX: "limit_mat X A m" shows "limit_mat (\n. c \\<^sub>m X n) (c \\<^sub>m A) m" proof - have dimA: "A \ carrier_mat m m" using limX limit_mat_def by auto have dimX: "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have "\i j. i < m \ j < m \ (\n. (c \\<^sub>m X n)  (i, j)) \ (c \\<^sub>m A)  (i, j)" proof - fix i j assume i: "i < m" and j: "j < m" have "(\n. (X n)  (i, j)) \ A(i, j)" using limX limit_mat_def i j by auto moreover have "(\n. c) \ c" by auto ultimately have "(\n. c * (X n)  (i, j)) \ c * A(i, j)" using tendsto_mult[of "\n. c" c] limX limit_mat_def by auto moreover have "(c \\<^sub>m X n)  (i, j) = c * (X n)  (i, j)" for n using index_smult_mat(1)[of i "X n" j c] i j dimX[of n] by auto moreover have "(c \\<^sub>m A)  (i, j) = c * A  (i, j)" using index_smult_mat(1)[of i "A" j c] i j dimA by auto ultimately show "(\n. (c \\<^sub>m X n)  (i, j)) \ (c \\<^sub>m A)  (i, j)" by auto qed then show ?thesis unfolding limit_mat_def using dimA dimX by auto qed lemma limit_mat_add: fixes X :: "nat \ complex mat" and Y :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m" shows "limit_mat (\k. X k + Y k) (A + B) m" proof - have dimA: "A \ carrier_mat m m" using limX limit_mat_def by auto have dimB: "B \ carrier_mat m m" using limY limit_mat_def by auto have dimX: "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have dimY: "\n. Y n \ carrier_mat m m" using limY unfolding limit_mat_def by auto then have dimXAB: "\n. X n + Y n \ carrier_mat m m \ A + B \ carrier_mat m m" using dimA dimB dimX dimY by (simp) have "(\i j. i < m \ j < m \ (\n. (X n + Y n)  (i, j)) \ (A + B)  (i, j))" proof - fix i j assume i: "i < m" and j: "j < m" have "(\n. (X n)  (i, j)) \ A(i, j)" using limX limit_mat_def i j by auto moreover have "(\n. (Y n)  (i, j)) \ B(i, j)" using limY limit_mat_def i j by auto ultimately have "(\n. (X n)(i, j) + (Y n)  (i, j)) \ (A(i, j) + B(i, j))" using tendsto_add[of "\n. (X n)  (i, j)" "A  (i, j)"] by auto moreover have "(X n + Y n)  (i, j) = (X n)(i, j) + (Y n)  (i, j)" for n using i j dimX dimY index_add_mat(1)[of i "Y n" j "X n"] by fastforce moreover have "(A + B)  (i, j) = A(i, j) + B(i, j)" using i j dimA dimB by fastforce ultimately show "(\n. (X n + Y n)  (i, j)) \ (A + B)  (i, j)" by auto qed then show ?thesis unfolding limit_mat_def using dimXAB by auto qed lemma limit_mat_minus: fixes X :: "nat \ complex mat" and Y :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m" shows "limit_mat (\k. X k - Y k) (A - B) m" proof - have dimA: "A \ carrier_mat m m" using limX limit_mat_def by auto have dimB: "B \ carrier_mat m m" using limY limit_mat_def by auto have dimX: "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have dimY: "\n. Y n \ carrier_mat m m" using limY unfolding limit_mat_def by auto have "-1 \\<^sub>m Y n = - Y n" for n using dimY by auto moreover have "-1 \\<^sub>m B = - B" using dimB by auto ultimately have "limit_mat (\n. - Y n) (- B) m" using limit_mat_scale[OF limY, of "-1"] by auto then have "limit_mat (\n. X n + (- Y n)) (A + (- B)) m" using limit_mat_add limX by auto moreover have "X n + (- Y n) = X n - Y n" for n using dimX dimY by auto moreover have "A + (- B) = A - B" by auto ultimately show ?thesis by auto qed lemma limit_mat_mult: fixes X :: "nat \ complex mat" and Y :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes limX: "limit_mat X A m" and limY: "limit_mat Y B m" shows "limit_mat (\k. X k * Y k) (A * B) m" proof - have dimA: "A \ carrier_mat m m" using limX limit_mat_def by auto have dimB: "B \ carrier_mat m m" using limY limit_mat_def by auto have dimX: "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have dimY: "\n. Y n \ carrier_mat m m" using limY unfolding limit_mat_def by auto then have dimXAB: "\n. X n * Y n \ carrier_mat m m \ A * B \ carrier_mat m m" using dimA dimB dimX dimY by fastforce have "(\i j. i < m \ j < m \ (\n. (X n * Y n)  (i, j)) \ (A * B)  (i, j))" proof - fix i j assume i: "i < m" and j: "j < m" have eqn: "(X n * Y n)  (i, j) = (\k=0..k=0..n. (X n)  (i, k)) \ A(i, k)" if "k < m" for k using limX limit_mat_def that i by auto moreover have "(\n. (Y n)  (k, j)) \ B(k, j)" if "k < m" for k using limY limit_mat_def that j by auto ultimately have "(\n. (X n)(i, k) * (Y n)(k,j)) \ A(i, k) * B(k, j)" if "k < m" for k using tendsto_mult[of "\n. (X n)  (i, k)" "A(i, k)" _ "\n. (Y n)(k, j)" "B(k, j)"] that by auto then have "(\n. (\k=0.. (\k=0..k n. (X n)(i,k) * (Y n)(k,j)" "\k. A(i, k) * B(k, j)"] by auto then show "(\n. (X n * Y n)  (i, j)) \ (A * B)  (i, j)" using eqn eq by auto qed then show ?thesis unfolding limit_mat_def using dimXAB by fastforce qed text \Adding matrix A to the sequence X\ definition mat_add_seq :: "complex mat \ (nat \ complex mat) \ nat \ complex mat" where "mat_add_seq A X = (\n. A + X n)" lemma mat_add_limit: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes dimB: "B \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (mat_add_seq B X) (B + A) m" unfolding mat_add_seq_def using limit_mat_add limit_mat_const[OF dimB] limX by auto lemma mat_minus_limit: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes dimB: "B \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (\n. B - X n) (B - A) m" using limit_mat_minus limit_mat_const[OF dimB] limX by auto text \Multiply matrix A by the sequence X\ definition mat_mult_seq :: "complex mat \ (nat \ complex mat) \ nat \ complex mat" where "mat_mult_seq A X = (\n. A * X n)" lemma mat_mult_limit: fixes X :: "nat \ complex mat" and A B :: "complex mat" and m :: nat assumes dimB: "B \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (mat_mult_seq B X) (B * A) m" unfolding mat_mult_seq_def using limit_mat_mult limit_mat_const[OF dimB] limX by auto lemma mult_mat_limit: fixes X :: "nat \ complex mat" and A B :: "complex mat" and m :: nat assumes dimB: "B \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (\k. X k * B) (A * B) m" unfolding mat_mult_seq_def using limit_mat_mult limit_mat_const[OF dimB] limX by auto lemma quadratic_form_mat: fixes A :: "complex mat" and v :: "complex vec" and m :: nat assumes dimv: "dim_vec v = m" and dimA: "A \ carrier_mat m m" shows "inner_prod v (A *\<^sub>v v) = (\i=0..j=0..v v) = (\i=0..j=0.. nat \'a::ab_group_add" shows "(\x\A. \y\B. h x y - g x y) = (\x\A. \y\B. h x y) - (\x\A. \y\B. g x y)" proof - have "\ x \ A. (\y\B. h x y - g x y) = (\y\B. h x y) - (\y\B. g x y)" proof - { fix x assume x: "x \ A" have "(\y\B. h x y - g x y) = (\y\B. h x y) - (\y\B. g x y)" using sum_subtractf by auto } then show ?thesis using sum_subtractf by blast qed then have "(\x\A.\y\B. h x y - g x y) = (\x\A. ((\y\B. h x y) - (\y\B. g x y)))" by auto also have "\ = (\x\A. \y\B. h x y) - (\x\A. \y\B. g x y)" by (simp add: sum_subtractf) finally have " (\x\A. \y\B. h x y - g x y) = (\x\A. sum (h x) B) - (\x\A. sum (g x) B)" by auto then show ?thesis by auto qed lemma sum_abs_complex: fixes h :: "nat \ nat \ complex" shows "cmod (\x\A.\y\B. h x y) \ (\x\A. \y\B. cmod(h x y))" proof - have B: "\ x \ A. cmod( \y\B .h x y) \ (\y\B. cmod(h x y))" using sum_abs norm_sum by blast have "cmod (\x\A.\y\B. h x y) \ (\x\A. cmod( \y\B .h x y))" using sum_abs norm_sum by blast also have "\ \ (\x\A. \y\B. cmod(h x y))" using sum_abs norm_sum B by (simp add: sum_mono) finally have "cmod (\x\A. \y\B. h x y) \ (\x\A. \y\B. cmod (h x y))" by auto then show ?thesis by auto qed lemma hermitian_mat_lim_is_hermitian: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat assumes limX: "limit_mat X A m" and herX: "\ n. hermitian (X n)" shows "hermitian A" proof - have dimX: "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have dimA : "A \ carrier_mat m m" using limX unfolding limit_mat_def by auto from herX have herXn: "\ n. adjoint (X n) = (X n)" unfolding hermitian_def by auto from limX have limXn: "\ijn. X n  (i, j)) \ A  (i, j)" unfolding limit_mat_def by auto have "\ijn. X n  (i, j)) \ A  (i, j)" using limXn i j by auto have ji: "(\n. X n  (j, i)) \ A  (j, i)" using limXn i j by auto then have "\r>0. \no. \n\no. dist (conjugate (X n  (j, i))) (conjugate (A  (j, i))) < r" proof - { fix r :: real assume r : "r > 0" have "\no. \n\no. cmod (X n  (j, i) - A  (j, i)) < r" using ji r unfolding LIMSEQ_def dist_norm by auto then obtain no where Xji: "\n\no. cmod (X n  (j, i) - A  (j, i)) < r" by auto then have "\n\no. cmod (conjugate (X n  (j, i) - A  (j, i))) < r" using complex_mod_cnj conjugate_complex_def by presburger then have "\n\no. dist (conjugate (X n  (j, i))) (conjugate (A  (j, i))) < r" unfolding dist_norm by auto then have "\no. \n\no. dist (conjugate (X n  (j, i))) (conjugate (A  (j, i))) < r" by auto } then show ?thesis by auto qed then have conjX: "(\n. conjugate (X n  (j, i))) \ conjugate (A  (j, i))" unfolding LIMSEQ_def by auto from herXn have "\ n. conjugate (X n  (j,i)) = X n (i, j)" using adjoint_eval i j dimX by (metis adjoint_dim_col carrier_matD(1)) then have "(\n. X n  (i, j)) \ conjugate (A  (j, i))" using conjX by auto then have "conjugate (A  (j,i)) = A (i, j)" using ij by (simp add: LIMSEQ_unique) then have "(adjoint A) (i, j) = A (i, j)" using adjoint_eval i j by (simp add:aij) } then show ?thesis by auto qed then have "hermitian A" using hermitian_def dimA by (metis adjoint_dim carrier_matD(1) carrier_matD(2) eq_matI) then show ?thesis by auto qed lemma quantifier_change_order_once: fixes P :: "nat \ nat \ bool" and m :: nat shows "\jno. \n\no. P n j \ \no. \jn\no. P n j" proof (induct m) case 0 then show ?case by auto next case (Suc m) then show ?case proof - have mm: "\no. \jn\no. P n j" using Suc by auto then obtain M where MM: "\jn\M. P n j" by auto have sucm: "\no. \n\no. P n m" using Suc(2) by auto then obtain N where NN: "\n\N. P n m" by auto let ?N = "max M N" from MM NN have "\jn\?N. P n j" by (metis less_antisym max.boundedE) then have "\no. \jn\no. P n j" by blast then show ?thesis by auto qed qed lemma quantifier_change_order_twice: fixes P :: "nat \ nat \ nat \ bool" and m n :: nat shows "\ij no. \n\no. P n i j \ \no. \ijn\no. P n i j" proof - assume fact: "\ij no. \n\no. P n i j" have one: "\ino.\jn\no. P n i j" using fact quantifier_change_order_once by auto have two: "\ino.\jn\no. P n i j \ \no. \ijn\no. P n i j" proof (induct m) case 0 then show ?case by auto next case (Suc m) then show ?case proof - obtain M where MM: "\ijn\M. P n i j" using Suc by auto obtain N where NN: "\jn\N. P n m j" using Suc(2) by blast let ?N = "max M N" from MM NN have "\ijn\?N. P n i j" by (metis less_antisym max.boundedE) then have "\no. \ijn\no. P n i j" by blast then show ?thesis by auto qed qed with fact show ?thesis using one by auto qed lemma pos_mat_lim_is_pos: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat assumes limX: "limit_mat X A m" and posX: "\n. positive (X n)" shows "positive A" proof (rule ccontr) have dimX : "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto have dimA : "A \ carrier_mat m m" using limX unfolding limit_mat_def by auto have herX : "\ n. hermitian (X n)" using posX positive_is_hermitian by auto then have herA : "hermitian A" using hermitian_mat_lim_is_hermitian limX by auto then have herprod: "\ v. dim_vec v = dim_col A \ inner_prod v (A *\<^sub>v v) \ Reals" using hermitian_inner_prod_real dimA by auto assume npA: " \ positive A" from npA have "\ (A \ carrier_mat (dim_col A) (dim_col A)) \ \ (\v. dim_vec v = dim_col A \ 0 \ inner_prod v (A *\<^sub>v v))" unfolding positive_def by blast then have evA: "\ v. dim_vec v = dim_col A \ \ inner_prod v (A *\<^sub>v v) \ 0" using dimA by blast then have "\ v. dim_vec v = dim_col A \ inner_prod v (A *\<^sub>v v) < 0" proof - obtain v where vA: "dim_vec v = dim_col A \ \ inner_prod v (A *\<^sub>v v) \ 0" using evA by auto from vA herprod have "\ 0 \ inner_prod v (A *\<^sub>v v) \ inner_prod v (A *\<^sub>v v) \ Reals" by auto then have "inner_prod v (A *\<^sub>v v) < 0" - using complex_is_Real_iff by auto + using complex_is_Real_iff by (auto simp: less_complex_def less_eq_complex_def) then have "\ v. dim_vec v = dim_col A \ inner_prod v (A *\<^sub>v v) < 0" using vA by auto then show ?thesis by auto qed then obtain v where neg: "dim_vec v = dim_col A \ inner_prod v (A *\<^sub>v v) < 0" by auto have nzero: "v \ 0\<^sub>v m" proof (rule ccontr) assume nega: " \ v \ 0\<^sub>v m" have zero: "v = 0\<^sub>v m" using nega by auto have "(A *\<^sub>v v) = 0\<^sub>v m" unfolding mult_mat_vec_def using zero using dimA by auto then have zerov: "inner_prod v (A *\<^sub>v v) = 0" by (simp add: zero) from neg zerov have "\ v \ 0\<^sub>v m \ False" using dimA by auto with nega show False by auto qed have invgeq: "inner_prod v v > 0" proof - have "inner_prod v v = vec_norm v * vec_norm v" unfolding vec_norm_def by (metis carrier_matD(2) carrier_vec_dim_vec dimA mult_cancel_left1 neg normalized_cscalar_prod normalized_vec_norm nzero vec_norm_def) moreover have "vec_norm v > 0" using nzero vec_norm_ge_0 neg dimA by (metis carrier_matD(2) carrier_vec_dim_vec) - ultimately have "inner_prod v v > 0" by auto + ultimately have "inner_prod v v > 0" by (auto simp: less_eq_complex_def less_complex_def) then show ?thesis by auto qed have invv: "inner_prod v v = (\i = 0.. i < m. conjugate (v  i) * (v  i) \ 0" using conjugate_square_smaller_0 by simp + have "\ i < m. conjugate (v  i) * (v  i) \ 0" using conjugate_square_smaller_0 + by (simp add: less_eq_complex_def) then have vi: "\ i < m. conjugate (v  i) * (v  i) = cmod (conjugate (v  i) * (v  i))" using cmod_eq_Re by (simp add: complex.expand) have "inner_prod v v= (\i = 0.. = (\i = 0.. = (\i = 0..i = 0..v v) = (\i=0..j=0..ijn. X n  (i, j)) \ A  (i, j)" unfolding limit_mat_def by auto then have limXv: "(\ n. inner_prod v ((X n) *\<^sub>v v)) \ inner_prod v (A *\<^sub>v v)" proof - have XAless: "cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) \ (\i = 0..j = 0.. i < m. \ j < m. conjugate (vi) * X n (i, j) * vj - conjugate (vi) * A(i, j) * vj = conjugate (vi) * (X n (i, j)-A(i, j)) * vj" by (simp add: mult.commute right_diff_distrib) then have ele: "\ i < m.(\j=0..j=0.. i < m. \ j < m. cmod(conjugate (v  i) * (X n  (i, j) - A  (i, j)) * v  j) = cmod(conjugate (v  i)) * cmod (X n  (i, j) - A  (i, j)) * cmod(v  j)" by (simp add: norm_mult) then have less: "\ i < m.(\j = 0..j = 0..v v) - inner_prod v (A *\<^sub>v v) = (\i=0..j=0..i=0..j=0.. = (\i=0..j=0.. i j. conjugate (v  i) * X n  (i, j) * v  j" "\ i j. conjugate (v  i) * A  (i, j) * v  j" "{0.. = (\i=0..j=0..v v) - inner_prod v (A *\<^sub>v v) = (\i = 0..j = 0..v v) - inner_prod v (A *\<^sub>v v)) = cmod (\i = 0..j = 0.. \ (\i = 0..j = 0.. = (\i = 0..j = 0..ijr>0. \no. \n\no. cmod (X n  (i, j) - A  (i, j)) < r" unfolding LIMSEQ_def dist_norm by auto from limX have mg: "m > 0" using limit_mat_def by (metis carrier_matD(1) carrier_matD(2) mat_eq_iff neq0_conv not_less0 npA posX) have cmoda: "\no. \n\no. (\i = 0..j = 0.. 0" for r proof - let ?u = "(\i = 0..j = 0.. 0" proof - have ur: "?u = (\i = 0..j = 0..j = 0.. cmod (v  i)" if i: "i < m" for i using member_le_sum[of i "{0.. j. cmod (vj)"] cmod_def i by simp then have "\ i < m. (cmod (conjugate (v  i)) * (\j = 0.. (cmod (conjugate (v  i)) * cmod (v  i))" by (simp add: mult_left_mono) then have "?u \ (\i = 0.. i. cmod (conjugate (v  i)) * cmod (v  i)" "\ i. cmod (conjugate (v  i)) * (\j = 0..i = 0..i = 0..i = 0.. inner_prod v v" by (metis (no_types, lifting) Im_complex_of_real Re_complex_of_real invv less_eq_complex_def norm_mult sum.cong) - then have "?u > 0" using invgeq by auto + then have "?u > 0" using invgeq by (auto simp: less_eq_complex_def less_complex_def) then show ?thesis by auto qed let ?s = "r / (2 * ?u)" have sgz: "?s > 0" using ug rl by (smt divide_pos_pos dual_order.strict_iff_order linordered_semiring_strict_class.mult_pos_pos zero_less_norm_iff r) from limijm have sij: "\no. \n\no. cmod (X n  (i, j) - A  (i, j)) < ?s" if i: "i < m" and j: "j < m" for i j proof - obtain N where Ns: "\n\N. cmod (X n  (i, j) - A  (i, j)) < ?s" using sgz limijm i j by blast then show ?thesis by auto qed then have "\no. \ijn\no. cmod (X n  (i, j) - A  (i, j)) < ?s" using quantifier_change_order_twice[of m m "\ n i j. (cmod (X n  (i, j) - A  (i, j))ijn\N. cmod (X n  (i, j) - A  (i, j)) < ?s" by auto then have mmN: "cmod (conjugate (v  i)) * cmod (X n  (i, j) - A  (i, j)) * cmod (v  j) \ ?s * (cmod (conjugate (v  i)) * cmod (v  j))" if i: "i < m" and j: "j < m" and n: "n \ N" for i j n proof - have geq: "cmod (conjugate (v  i)) \ 0 \ cmod (v  j)\0" by simp then have "cmod (conjugate (v  i)) * cmod (X n  (i, j) - A  (i, j)) \cmod (conjugate (v  i)) * ?s" using Nno i j n by (smt mult_left_mono) then have "cmod (conjugate (v  i)) * cmod (X n  (i, j) - A  (i, j)) * cmod (v  j) \ cmod (conjugate (v  i)) *?s * cmod (v  j)" using geq mult_right_mono by blast also have "\ = ?s * (cmod (conjugate (v  i)) * cmod (v  j))" by simp finally show ?thesis by auto qed then have "(\i = 0..j = 0.. N" for n proof - have mmX: "\ij ?s * (cmod (conjugate (v  i)) * cmod (v  j))" using n mmN by blast have "(\j = 0.. (\j = 0..j ?s * (cmod (conjugate (v  i)) * cmod (v  j))" using mmX i by auto then show ?thesis using sum_mono[of "{0.. j. cmod (conjugate (v  i)) * cmod (X n  (i, j) - A  (i, j)) * cmod (v  j)" "\ j. (?s * (cmod (conjugate (v  i)) * cmod (v  j)))"] atLeastLessThan_iff by blast qed then have "(\i = 0..j = 0.. (\i = 0..j = 0.. = ?s * (\i = 0..j = 0.. = r / 2" using nonzero_mult_divide_mult_cancel_right sgz by fastforce finally show ?thesis using r by auto qed then show ?thesis by auto qed then have XnAv:"\no. \n\no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" if r: "r > 0" for r proof - obtain no where nno: "\n\no. (\i = 0..j = 0..n\no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" using XAless neg by smt then show ?thesis by auto qed then have "(\n. inner_prod v (X n *\<^sub>v v)) \ inner_prod v (A *\<^sub>v v)" unfolding LIMSEQ_def dist_norm by auto then show ?thesis by auto qed from limXv have "\r>0. \no. \n\no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < r" unfolding LIMSEQ_def dist_norm by auto - then have "\no. \n\no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" using rl by auto + then have "\no. \n\no. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" using rl + by (auto simp: less_eq_complex_def less_complex_def) then obtain N where Ng: "\n\N. cmod (inner_prod v (X n *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" by auto then have XN: "cmod (inner_prod v (X N *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) < -?r" by auto from posX have "positive (X N)" by auto then have XNv:"inner_prod v (X N *\<^sub>v v) \ 0" by (metis Complex_Matrix.positive_def carrier_matD(2) dimA dimX neg) from rl XNv have XX: "cmod (inner_prod v (X N *\<^sub>v v) - inner_prod v (A *\<^sub>v v)) = cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v))" - using XN cmod_eq_Re by auto + using XN cmod_eq_Re by (auto simp: less_eq_complex_def less_complex_def) then have YY: "cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v)) < -?r" using XN by auto - then have "cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v)) < cmod(inner_prod v (A *\<^sub>v v))" using rl cmod_eq_Re by auto - then have "cmod(inner_prod v (X N *\<^sub>v v)) < 0" using XNv XX YY cmod_eq_Re by auto + then have "cmod(inner_prod v (X N *\<^sub>v v)) - cmod(inner_prod v (A *\<^sub>v v)) < cmod(inner_prod v (A *\<^sub>v v))" + using rl cmod_eq_Re by (auto simp: less_eq_complex_def less_complex_def) + then have "cmod(inner_prod v (X N *\<^sub>v v)) < 0" using XNv XX YY cmod_eq_Re + by (auto simp: less_eq_complex_def less_complex_def) then have "False" using XNv by simp with npA show False by auto qed lemma limit_mat_ignore_initial_segment: "limit_mat g A d \ limit_mat (\n. g (n + k)) A d" proof - assume asm: "limit_mat g A d" then have lim: "\ i < d. \ j < d. (\ n. (g n)  (i, j)) \ (A  (i, j))" using limit_mat_def by auto then have limk: "\ i < d. \ j < d. (\ n. (g (n + k))  (i, j)) \ (A  (i, j))" proof - { fix i j assume dims: "i < d" "j < d" then have "(\ n. (g n)  (i, j)) \ (A  (i, j))" using lim by auto then have "(\ n. (g (n + k))  (i, j)) \ (A  (i, j))" using LIMSEQ_ignore_initial_segment by auto } then show "\ i < d. \ j < d. (\ n. (g (n + k))  (i, j)) \ (A  (i, j))" by auto qed have "\ n. g n \ carrier_mat d d" using asm unfolding limit_mat_def by auto then have "\ n. g (n + k) \ carrier_mat d d" by auto moreover have "A \ carrier_mat d d" using asm limit_mat_def by auto ultimately show "limit_mat (\n. g (n + k)) A d" using limit_mat_def limk by auto qed lemma mat_trace_limit: "limit_mat g A d \ (\n. trace (g n)) \ trace A" proof - assume lim: "limit_mat g A d" then have dgn: "g n \ carrier_mat d d" for n using limit_mat_def by auto from lim have dA: "A \ carrier_mat d d" using limit_mat_def by auto have trg: "trace (g n) = (\k=0..k < d. (\n. (g n)(k, k)) \ A(k, k)" using limit_mat_def lim by auto then have "(\n. (\k=0.. (\k=0..n. trace (g n)) \ trace A" unfolding trace_def using trg carrier_matD[OF dgn] carrier_matD[OF dA] by auto qed subsection \Existence of least upper bound for the L\"{o}wner order\ definition lowner_is_lub :: "(nat \ complex mat) \ complex mat \ bool" where "lowner_is_lub f M \ (\n. f n \\<^sub>L M) \ (\M'. (\n. f n \\<^sub>L M') \ M \\<^sub>L M')" locale matrix_seq = fixes dim :: nat and f :: "nat \ complex mat" assumes dim: "\n. f n \ carrier_mat dim dim" and pdo: "\n. partial_density_operator (f n)" and inc: "\n. lowner_le (f n) (f (Suc n))" begin definition lowner_is_lub :: "complex mat \ bool" where "lowner_is_lub M \ (\n. f n \\<^sub>L M) \ (\M'. (\n. f n \\<^sub>L M') \ M \\<^sub>L M')" lemma lowner_is_lub_dim: assumes "lowner_is_lub M" shows "M \ carrier_mat dim dim" proof - have "f 0 \\<^sub>L M" using assms lowner_is_lub_def by auto then have 1: "dim_row (f 0) = dim_row M \ dim_col (f 0) = dim_col M" using lowner_le_def by auto moreover have 2: "f 0 \ carrier_mat dim dim" using dim by auto ultimately show ?thesis by auto qed lemma trace_adjoint_eq_u: fixes A :: "complex mat" shows "trace (A * adjoint A) = (\ i \ {0 ..< dim_row A}. \ j \ {0 ..< dim_col A}. (norm(A  (i,j)))\<^sup>2)" proof - have "trace (A * adjoint A) = (\ i \ {0 ..< dim_row A}. row A i \ conjugate (row A i))" by (simp add: trace_def cmod_def adjoint_def scalar_prod_def) also have "\ = (\ i \ {0 ..< dim_row A}. \ j \ {0 ..< dim_col A}. (norm(A  (i,j)))\<^sup>2)" proof (simp add: scalar_prod_def cmod_def) have cnjmul: "\ i ia. A  (i, ia) * cnj (A  (i, ia)) = ((complex_of_real (Re (A  (i, ia))))\<^sup>2 + (complex_of_real (Im (A  (i, ia))))\<^sup>2)" by (simp add: complex_mult_cnj) then have "\ i. (\ia = 0..ia = 0..2 + (complex_of_real (Im (A  (i, ia))))\<^sup>2))" by auto then show"(\i = 0..ia = 0..x = 0..xa = 0..2) + (\x = 0..xa = 0..2)" by auto qed finally show ?thesis . qed lemma trace_adjoint_element_ineq: fixes A :: "complex mat" assumes rindex: "i \ {0 ..< dim_row A}" and cindex: "j \ {0 ..< dim_col A}" shows "(norm(A  (i,j)))\<^sup>2 \ trace (A * adjoint A)" -proof (simp add: trace_adjoint_eq_u) +proof (simp add: trace_adjoint_eq_u less_eq_complex_def) have ineqi: "(cmod (A  (i, j)))\<^sup>2 \ (\xa = 0..2)" using cindex member_le_sum[of j " {0 ..< dim_col A}" "\ x. (cmod (A  (i, x)))\<^sup>2"] by auto also have ineqj: "\ \ (\x = 0..xa = 0..2)" using rindex member_le_sum[of i " {0 ..< dim_row A}" "\ x. \xa = 0..2"] by (simp add: sum_nonneg) then show "(cmod (A  (i, j)))\<^sup>2 \ (\x = 0..xa = 0..2)" using ineqi by linarith qed lemma positive_is_normal: fixes A :: "complex mat" assumes pos: "positive A" shows "A * adjoint A = adjoint A * A" proof - have hA: "hermitian A" using positive_is_hermitian pos by auto then show ?thesis by (simp add: hA hermitian_is_normal) qed lemma diag_mat_mul_diag_diag: fixes A B :: "complex mat" assumes dimA: "A \ carrier_mat n n" and dimB: "B \ carrier_mat n n" and dA: "diagonal_mat A" and dB: "diagonal_mat B" shows "diagonal_mat (A * B)" proof - have AB: "A * B = mat n n (\(i,j). (if (i = j) then (A(i, i)) * (B(i, i)) else 0))" using diag_mat_mult_diag_mat[of A n B] dimA dimB dA dB by auto then have dAB: "\ij j \ (A*B)  (i,j) = 0" proof - { fix i j assume i: "i < n" and j: "j < n" and ij: "i \ j" have "(A*B)  (i,j) = 0" using AB i j ij by auto } then show ?thesis by auto qed then show ?thesis using diagonal_mat_def dAB dimA dimB by (metis carrier_matD(1) carrier_matD(2) index_mult_mat(2) index_mult_mat(3)) qed lemma diag_mat_mul_diag_ele: fixes A B :: "complex mat" assumes dimA: "A \ carrier_mat n n" and dimB: "B \ carrier_mat n n" and dA: "diagonal_mat A" and dB: "diagonal_mat B" shows "\i(i,j). if i = j then (A(i, i)) * (B(i, i)) else 0)" using diag_mat_mult_diag_mat[of A n B] dimA dimB dA dB by auto then show ?thesis using AB by auto qed lemma trace_square_less_square_trace: fixes B :: "complex mat" assumes dimB: "B \ carrier_mat n n" and dB: "diagonal_mat B" and pB: "\i. i < n \ B(i, i) \ 0" shows "trace (B*B) \ (trace B)\<^sup>2" proof - have tB: "trace B = (\ i \ {0 ..2 = (\ i \ {0 .. j \ {0 ..i. i < n \ (B*B)  (i,i) = (B(i, i))\<^sup>2" using diag_mat_mul_diag_ele[of B n B] dimB dB by (metis numeral_1_eq_Suc_0 power_Suc0_right power_add_numeral semiring_norm(2)) have tBB: "trace (B*B) = (\ i \ {0 .. = (\ i \ {0 ..2)" using BB by auto finally have BBt: " trace (B * B) = (\i = 0..2)" by auto have lesseq: "\i \ {0 ..2 \ (\ j \ {0 ..j = 0..2 + sum (\ j. (B  (i, i) * B  (j, j))) ({0 .. j. (B  (i, i) * B  (j, j))) ({0 .. 0" proof (cases "{0.. {}") case True then show ?thesis using pB i sum_nonneg[of "{0.. j. (B  (i, i) * B  (j, j))"] by auto next case False have "(\j\{0..j = 0.. (B  (i, i))\<^sup>2" by auto } then show ?thesis by auto qed from tBtB BBt lesseq have "trace (B*B) \ (trace B)\<^sup>2" using sum_mono[of "{0.. i. (B  (i, i))\<^sup>2" "\ i. (\j = 0.. (trace A)\<^sup>2" proof - from assms have normal: "A * adjoint A = adjoint A * A" by (rule positive_is_normal) moreover from assms positive_dim_eq obtain n where cA: "A \ carrier_mat n n" by auto moreover from assms complex_mat_char_poly_factorizable cA obtain es where charpo: " char_poly A = (\ a \ es. [:- a, 1:]) \ length es = n" by auto moreover obtain B P Q where B: "unitary_schur_decomposition A es = (B,P,Q)" by (cases "unitary_schur_decomposition A es", auto) ultimately have smw: "similar_mat_wit A B P (adjoint P)" and ut: "diagonal_mat B" and uP: "unitary P" and dB: "diag_mat B = es" and QaP: "Q = adjoint P" using normal_complex_mat_has_spectral_decomposition[of A n es B P Q] unitary_schur_decomposition by auto from smw cA QaP uP have cB: "B \ carrier_mat n n" and cP: "P \ carrier_mat n n" and cQ: "Q \ carrier_mat n n" unfolding similar_mat_wit_def Let_def unitary_def by auto then have caP: "adjoint P \ carrier_mat n n" using adjoint_dim[of P n] by auto from smw QaP cA have A: "A = P * B * adjoint P" and traceA: "trace A = trace (P * B * Q)" and PB: "P * Q = 1\<^sub>m n \ Q * P = 1\<^sub>m n" unfolding similar_mat_wit_def by auto have traceAB: "trace (P * B * Q) = trace ((Q*P)*B)" using cQ cP cB by (mat_assoc n) also have traceelim: "\ = trace B" using traceAB PB cA cB cP cQ left_mult_one_mat[of "P*Q" n n] using similar_mat_wit_sym by auto finally have traceAB: "trace A = trace B" using traceA by auto from A cB cP have aAa: "adjoint A = adjoint((P * B) * adjoint P)" by auto have aA: "adjoint A = P * adjoint B * adjoint P" unfolding aAa using cP cB by (mat_assoc n) have hA: "hermitian A" using pos positive_is_hermitian by auto then have AaA: "A = adjoint A" using hA hermitian_def[of A] by auto then have PBaP: "P * B * adjoint P = P * adjoint B * adjoint P" using A aA by auto then have BaB: "B = adjoint B" using unitary_elim[of B n "adjoint B" P] uP cP cB adjoint_dim[of B n] by auto have aPP: "adjoint P * P = 1\<^sub>m n" using uP PB QaP by blast have "A * A = P * B * (adjoint P * P) * B * adjoint P" unfolding A using cP cB by (mat_assoc n) also have "\ = P * B * B * adjoint P" unfolding aPP using cP cB by (mat_assoc n) finally have AA: "A * A = P * B * B * adjoint P" by auto then have tAA: "trace (A*A) = trace (P * B * B * adjoint P)" by auto also have tBB: "\ = trace (adjoint P * P * B * B)" using cP cB by (mat_assoc n) also have "\ = trace (B * B)" using uP unitary_def[of P] inverts_mat_def[of P "adjoint P"] using PB QaP cB by auto finally have traceAABB: "trace (A * A) = trace (B * B)" by auto have BP: "\i. i < n \ B(i, i) \ 0" proof - { fix i assume i: "i < n" then have "B(i, i) \ 0" using positive_eigenvalue_positive[of A n es B P Q i] cA pos charpo B by auto then show "B(i, i) \ 0" by auto } qed have Brel: "trace (B*B) \ (trace B)\<^sup>2" using trace_square_less_square_trace[of B n] cB ut BP by auto from AaA traceAABB traceAB Brel have "trace (A*adjoint A) \ (trace A)\<^sup>2" by auto then show ?thesis by auto qed lemma lowner_le_transitive: fixes m n :: nat assumes re: "n \ m" shows "positive (f n - f m)" proof - from re show "positive (f n - f m)" proof (induct n) case 0 then show ?case using positive_zero by (metis dim le_0_eq minus_r_inv_mat) next case (Suc n) then show ?case proof (cases "Suc n = m") case True then show ?thesis using positive_zero by (metis dim minus_r_inv_mat) next case False then show ?thesis proof - from False Suc have nm: "n \ m" by linarith from Suc nm have pnm: "positive (f n - f m)" by auto from inc have "positive (f (Suc n) - f n)" unfolding lowner_le_def by auto then have pf: "positive ((f (Suc n) - f n) + (f n - f m))" using positive_add dim pnm by (meson minus_carrier_mat) have "(f (Suc n) - f n) + (f n - f m) = f (Suc n) + ((- f n) + f n) + (- f m)" using local.dim by (mat_assoc dim, auto) also have "\ = f (Suc n) + 0\<^sub>m dim dim + (- f m)" using local.dim by (subst uminus_l_inv_mat[where nc=dim and nr=dim], auto) also have "\ = f (Suc n) - f m" using local.dim by (mat_assoc dim, auto) finally have re: "f (Suc n) - f n + (f n - f m) = f (Suc n) - f m" . from pf re have "positive (f (Suc n) - f m)" by auto then show ?thesis by auto qed qed qed qed text \The sequence of matrices converges pointwise.\ lemma inc_partial_density_operator_converge: assumes i: "i \ {0 .. {0 ..n. f n  (i, j))" proof- have tracefn: "trace (f n) \ 0 \ trace (f n) \ 1" for n proof - from pdo show ?thesis unfolding partial_density_operator_def using positive_trace[of "f n"] using dim by blast qed from tracefn have normf: "norm(trace (f n)) \ norm(trace (f (Suc n))) \ norm(trace (f n)) \ 1" for n proof - have trless: "trace (f n) \ trace (f (Suc n))" using pdo inc dim positive_trace[of "f(Suc n) - f n"] trace_minus_linear[of "f (Suc n)" dim "f n"] unfolding partial_density_operator_def lowner_le_def using Complex_Matrix.positive_def by force - moreover from trless tracefn have "norm(trace (f n)) \ norm(trace (f (Suc n)))" unfolding cmod_def by simp - moreover from trless tracefn have "norm(trace (f n)) \ 1" using pdo partial_density_operator_def cmod_def by simp + moreover from trless tracefn have "norm(trace (f n)) \ norm(trace (f (Suc n)))" unfolding cmod_def + by (simp add: less_eq_complex_def less_complex_def) + moreover from trless tracefn have "norm(trace (f n)) \ 1" using pdo partial_density_operator_def cmod_def + by (simp add: less_eq_complex_def less_complex_def) ultimately show ?thesis by auto qed then have inctrace: "incseq (\ n. norm(trace (f n)))" by (simp add: incseq_SucI) then have tr_sup: "(\ n. norm(trace (f n))) \ (SUP i. norm (trace (f i)))" using LIMSEQ_incseq_SUP[of "\ n. norm(trace (f n))"] pdo partial_density_operator_def normf by (meson bdd_aboveI2) then have tr_cauchy: "Cauchy (\ n. norm(trace (f n)))" using Cauchy_convergent_iff convergent_def by blast then have tr_cauchy_def: "\e>0. \M. \m\M. \n\M. dist(norm(trace (f n))) (norm(trace (f m))) < e" unfolding Cauchy_def by blast moreover have "\m n. dist(norm(trace (f m))) (norm(trace (f n))) = norm(trace (f m) - trace (f n))" - using tracefn cmod_eq_Re dist_real_def by auto + using tracefn cmod_eq_Re dist_real_def by (auto simp: less_eq_complex_def less_complex_def) ultimately have norm_trace: "\e>0.\M. \m\M. \n\M. norm((trace (f n)) - (trace (f m))) < e" by auto have eq_minus: "\ m n. trace (f m) - trace (f n) = trace (f m - f n)" using trace_minus_linear dim by metis from eq_minus norm_trace have norm_trace_cauchy: "\e>0.\M. \m\M. \n\M. norm((trace (f n - f m))) < e" by auto then have norm_trace_cauchy_iff: "\e>0.\M. \m\M. \n\m. norm((trace (f n - f m))) < e" by (meson order_trans_rules(23)) then have norm_square: "\e>0.\M. \m\M. \n\m. (norm((trace (f n - f m))))\<^sup>2 < e\<^sup>2" by (metis abs_of_nonneg norm_ge_zero order_less_le real_sqrt_abs real_sqrt_less_iff) have tr_re: "\ m. \ n \ m. trace ((f n - f m) * adjoint (f n - f m)) \ ((trace (f n- f m)))\<^sup>2" using trace_positive_eq lowner_le_transitive by auto have tr_re_g: "\ m. \ n \ m. trace ((f n - f m) * adjoint (f n - f m)) \ 0" using lowner_le_transitive positive_trace trace_adjoint_positive by auto have norm_trace_fmn: "norm(trace ((f n - f m) * adjoint (f n - f m))) \ (norm(trace (f n - f m)))\<^sup>2" if nm: "n \ m" for m n proof - have mnA: "trace ((f n - f m) * adjoint (f n - f m)) \ (trace (f n - f m))\<^sup>2" using tr_re nm by auto have mnB: "trace ((f n - f m) * adjoint (f n - f m)) \ 0" using tr_re_g nm by auto from mnA mnB show ?thesis by (smt cmod_eq_Re less_eq_complex_def norm_power zero_complex.sel(1) zero_complex.sel(2)) qed then have cauchy_adj: "\M. \m\M. \n\m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" if e: "e > 0" for e proof - have "\M. \m\M. \n\m. (cmod (trace (f n - f m)))\<^sup>2 < e\<^sup>2" using norm_square e by auto then obtain M where " \m\M. \n\m. (cmod (trace (f n - f m)))\<^sup>2 < e\<^sup>2" by auto then have "\m\M. \n\m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" using norm_trace_fmn by fastforce then show ?thesis by auto qed have norm_minus: "\ m. \ n \ m. (norm ((f n - f m)  (i, j)))\<^sup>2 \ trace ((f n - f m) * adjoint (f n - f m))" using trace_adjoint_element_ineq i j by (smt adjoint_dim_row carrier_matD(1) index_minus_mat(2) index_mult_mat(2) lowner_le_transitive matrix_seq_axioms matrix_seq_def positive_is_normal) then have norm_minus_le: "(norm ((f n - f m)  (i, j)))\<^sup>2 \ norm (trace ((f n - f m) * adjoint (f n - f m)))" if nm: "n \ m" for n m proof - have "(norm ((f n - f m)  (i, j)))\<^sup>2 \ (trace ((f n - f m) * adjoint (f n - f m)))" using norm_minus nm by auto also have "\ = norm (trace ((f n - f m) * adjoint (f n - f m)))" using tr_re_g nm by (smt Re_complex_of_real less_eq_complex_def matrix_seq.trace_adjoint_eq_u matrix_seq_axioms mult_cancel_left2 norm_one norm_scaleR of_real_def of_real_hom.hom_zero) - finally show ?thesis by auto + finally show ?thesis by (auto simp: less_eq_complex_def less_complex_def) qed from norm_minus_le cauchy_adj have cauchy_ij: "\M. \m\M. \n\m. (norm ((f n - f m)  (i, j)))\<^sup>2 < e\<^sup>2" if e: "e > 0" for e proof - have "\M. \m\M. \n\m. norm(trace ((f n- f m) * adjoint (f n - f m))) < e\<^sup>2" using cauchy_adj e by auto then obtain M where " \m\M. \n\m. norm(trace ((f n - f m) * adjoint (f n - f m))) < e\<^sup>2" by auto then have "\m\M. \n\m. (norm ((f n - f m)  (i, j)))\<^sup>2 < e\<^sup>2" using norm_minus_le by fastforce then show ?thesis by auto qed then have cauchy_ij_norm: "\M. \m\M. \n\m. (norm ((f n - f m)  (i, j))) < e" if e: "e > 0" for e proof - have "\M. \m\M. \n\m. (norm ((f n - f m)  (i, j)))\<^sup>2 < e\<^sup>2" using cauchy_ij e by auto then obtain M where mn: "\m\M. \n\m. (norm ((f n - f m)  (i, j)))\<^sup>2 < e\<^sup>2" by auto have "(norm ((f n - f m)  (i, j))) < e" if m: "m \ M" and n: "n \ m" for m n :: nat proof - from m n mn have "(norm ((f n- f m)  (i, j)))\<^sup>2 < e\<^sup>2" by auto then show ?thesis using e power_less_imp_less_base by fastforce qed then show ?thesis by auto qed have cauchy_final: "\M. \m\M. \n\M. norm ((f m)  (i, j) - (f n)  (i, j)) < e" if e: "e > 0" for e proof - obtain M where mnm: "\m\M. \n\m. norm ((f n - f m)  (i, j)) < e" using cauchy_ij_norm e by auto have "norm ((f m)  (i, j) - (f n)  (i, j)) < e" if m: "m \ M" and n: "n \ M" for m n proof (cases "n \ m") case True then show ?thesis proof - from mnm m True have "norm ((f n)  (i, j) - (f m)  (i, j)) < e" by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) dim i index_minus_mat(1) j) then have "norm ((f m)  (i, j) - (f n)  (i, j)) < e" by (simp add: norm_minus_commute) then show ?thesis by auto qed next case False then show ?thesis proof - from False n mnm have norm: "norm ((f m - f n)  (i, j)) < e" by auto have minus: "(f m - f n)  (i, j) = f m  (i, j) -f n  (i, j)" by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) dim i index_minus_mat(1) j) also have "\ = - (f n - f m)  (i, j)" using dim by (metis atLeastLessThan_iff carrier_matD(1) carrier_matD(2) i index_minus_mat(1) j minus_diff_eq) finally have fmn: "(f m - f n)  (i, j) = - (f n - f m)  (i, j)" by auto then have "norm ((- (f n - f m))  (i, j)) < e" using norm by (metis (no_types, lifting) atLeastLessThan_iff carrier_matD(1) carrier_matD(2) i index_minus_mat(2) index_minus_mat(3) index_uminus_mat(1) j matrix_seq_axioms matrix_seq_def) then have "norm (((f n - f m))  (i, j)) < e" using fmn norm by auto then have "norm (f n  (i, j) - f m  (i, j)) < e" by (metis minus norm norm_minus_commute) then have "norm (f m  (i, j) - f n  (i, j)) < e" by (simp add: norm_minus_commute) then show ?thesis by auto qed qed then show ?thesis by auto qed from cauchy_final have "Cauchy (\ n. f n  (i, j))" by (simp add: Cauchy_def dist_norm) then show ?thesis by (simp add: Cauchy_convergent_iff) qed definition mat_seq_minus :: "(nat \ complex mat) \ complex mat \ nat \ complex mat" where "mat_seq_minus X A = (\n. X n - A)" definition minus_mat_seq :: "complex mat \ (nat \ complex mat) \ nat \ complex mat" where "minus_mat_seq A X = (\n. A - X n)" lemma pos_mat_lim_is_pos_aux: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat assumes limX: "limit_mat X A m" and posX: "\k. \n\k. positive (X n)" shows "positive A" proof - from posX obtain k where posk: "\ n\k. positive (X n)" by auto let ?Y = "\n. X (n + k)" have posY: "\n. positive (?Y n)" using posk by auto from limX have dimXA: "\n. X (n + k) \ carrier_mat m m \ A \ carrier_mat m m" unfolding limit_mat_def by auto have "(\n. X (n + k)  (i, j)) \ A  (i, j)" if i: "i < m" and j: "j < m" for i j proof - have "(\n. X n  (i, j)) \ A  (i, j)" using limX limit_mat_def i j by auto then have limseqX: "\r>0. \no. \n\no. dist (X n  (i, j)) (A  (i, j)) < r" unfolding LIMSEQ_def by auto then have "\no. \n\no. dist (X (n + k)  (i, j)) (A  (i, j)) < r" if r: "r > 0" for r proof - obtain no where "\n\no. dist (X n  (i, j)) (A  (i, j)) < r" using limseqX r by auto then have "\n\no. dist (X (n + k)  (i, j)) (A  (i, j)) < r" by auto then show ?thesis by auto qed then show ?thesis unfolding LIMSEQ_def by auto qed then have limXA: "limit_mat (\n. X (n + k)) A m" unfolding limit_mat_def using dimXA by auto from posY limXA have "positive A" using pos_mat_lim_is_pos[of ?Y A m] by auto then show ?thesis by auto qed lemma minus_mat_limit: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes dimB: "B \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (mat_seq_minus X B) (A - B) m" proof - have dimXAB: "\n. X n - B \ carrier_mat m m \ A - B \ carrier_mat m m" using index_minus_mat dimB by auto have "(\n. (X n - B)  (i, j)) \ (A - B)  (i, j)" if i: "i < m" and j: "j < m" for i j proof - from limX i j have "(\n. (X n)  (i, j)) \ (A)  (i, j)" unfolding limit_mat_def by auto then have X: "\r>0. \no. \n\no. dist (X n  (i, j)) (A  (i, j)) < r" unfolding LIMSEQ_def by auto then have XB: "\no. \n\no. dist ((X n - B)  (i, j)) ((A - B)  (i, j)) < r" if r: "r > 0" for r proof - obtain no where "\n\no. dist (X n  (i, j)) (A  (i, j)) < r" using r X by auto then have dist: "\n\no. norm (X n  (i, j) - A  (i, j)) < r" unfolding dist_norm by auto then have "norm ((X n - B)  (i, j) - (A - B)  (i, j)) < r" if n: "n \ no" for n proof - have "(X n - B)  (i, j) - (A - B)  (i, j) = (X n)  (i, j) - A  (i, j)" using dimB i j by auto then have "norm ((X n - B)  (i, j) - (A - B)  (i, j)) = norm ((X n)  (i, j) - A  (i, j))" by auto then show ?thesis using dist n by auto qed then show ?thesis using dist_norm by metis qed then show ?thesis unfolding LIMSEQ_def by auto qed then show ?thesis unfolding limit_mat_def mat_seq_minus_def using dimXAB by auto qed lemma mat_minus_limit: fixes X :: "nat \ complex mat" and A :: "complex mat" and m :: nat and B :: "complex mat" assumes dimA: "A \ carrier_mat m m" and limX: "limit_mat X A m" shows "limit_mat (minus_mat_seq B X) (B - A) m" proof- have dimX : "\n. X n \ carrier_mat m m" using limX unfolding limit_mat_def by auto then have dimXAB: "\n. B - X n \ carrier_mat m m \ B - A \ carrier_mat m m" using index_minus_mat dimA by (simp add: minus_carrier_mat) have "(\n. (B - X n)  (i, j)) \ (B - A)  (i, j)" if i: "i < m" and j: "j < m" for i j proof - from limX i j have "(\n. (X n)  (i, j)) \ (A)  (i, j)" unfolding limit_mat_def by auto then have X: "\r>0. \no. \n\no. dist (X n  (i, j)) (A  (i, j)) < r" unfolding LIMSEQ_def by auto then have XB: "\no. \n\no. dist ((B - X n)  (i, j)) ((B - A)  (i, j)) < r" if r: "r > 0" for r proof - obtain no where "\n\no. dist (X n  (i, j)) (A  (i, j)) < r" using r X by auto then have dist: "\n\no. norm (X n  (i, j) - A  (i, j)) < r" unfolding dist_norm by auto then have "norm ((B - X n)  (i, j) - (B - A)  (i, j)) < r" if n: "n \ no" for n proof - have "(B - X n)  (i, j) - (B - A)  (i, j) = - ((X n)  (i, j) - A  (i, j))" using dimA i j by (smt cancel_ab_semigroup_add_class.diff_right_commute cancel_comm_monoid_add_class.diff_cancel carrier_matD(1) carrier_matD(2) diff_add_cancel dimX index_minus_mat(1) minus_diff_eq) then have "norm ((B - X n)  (i, j) - (B - A)  (i, j)) = norm ((X n)  (i, j) - A  (i, j))" by (metis norm_minus_cancel) then show ?thesis using dist n by auto qed then show ?thesis using dist_norm by metis qed then show ?thesis unfolding LIMSEQ_def by auto qed then have "limit_mat (minus_mat_seq B X) (B - A) m" unfolding limit_mat_def minus_mat_seq_def using dimXAB by auto then show ?thesis by auto qed lemma lowner_lub_form: "lowner_is_lub (mat dim dim (\ (i, j). (lim (\ n. (f n)  (i, j)))))" proof - from inc_partial_density_operator_converge have conf: "\ i \ {0 .. j \ {0 .. n. f n  (i, j))" by auto let ?A = "mat dim dim (\ (i, j). (lim (\ n. (f n)  (i, j))))" have dim_A: "?A \ carrier_mat dim dim" by auto have lim_A: "(\n. f n  (i, j)) \ mat dim dim (\(i, j). lim (\n. f n  (i, j)))  (i, j)" if i: "i < dim" and j: "j < dim" for i j proof - from i j have ij: "mat dim dim (\(i, j). lim (\n. f n  (i, j)))  (i, j) = lim (\n. f n  (i, j))" by (metis case_prod_conv index_mat(1)) have "convergent (\n. f n  (i, j))" using conf i j by auto then have "(\n. f n  (i, j)) \ lim (\n. f n  (i, j)) " using convergent_LIMSEQ_iff by auto then show ?thesis using ij by auto qed from dim dim_A lim_A have lim_mat_A: "limit_mat f ?A dim" unfolding limit_mat_def by auto have is_ub: "f n \\<^sub>L ?A" for n proof - have "\ m \ n. positive (f m - f n)" using lowner_le_transitive by auto then have le: "\ m \ n. f n \\<^sub>L f m " unfolding lowner_le_def using dim by (metis carrier_matD(1) carrier_matD(2)) have dimn: "f n \ carrier_mat dim dim" using dim by auto then have limAf: "limit_mat (mat_seq_minus f (f n)) (?A - f n) dim" using minus_mat_limit lim_mat_A by auto have " \m\n. positive (f m - f n)" using lowner_le_transitive by auto then have "\k. \m\k. positive (f m - f n)" by auto then have posAf: "\ k. \ m \ k. positive ((mat_seq_minus f (f n)) m)" unfolding mat_seq_minus_def by auto from limAf posAf have "positive (?A - f n)" using pos_mat_lim_is_pos_aux by auto then have "f n \\<^sub>L mat dim dim (\(i, j). lim (\n. f n  (i, j)))" unfolding lowner_le_def using dim by auto then show ?thesis by auto qed have is_lub: "?A \\<^sub>L M'" if ub: "\n. f n \\<^sub>L M'" for M' proof - have dim_M: "M' \ carrier_mat dim dim" using ub unfolding lowner_le_def using dim by (metis carrier_matD(1) carrier_matD(2) carrier_mat_triv) from ub have posAf: "\ n. positive (minus_mat_seq M' f n)" unfolding minus_mat_seq_def lowner_le_def by auto have limAf: "limit_mat (minus_mat_seq M' f) (M' - ?A) dim" using mat_minus_limit dim_A lim_mat_A by auto from posAf limAf have "positive (M' - ?A)" using pos_mat_lim_is_pos_aux by auto then have "?A \\<^sub>L M'" unfolding lowner_le_def using dim dim_A dim_M by auto then show ?thesis by auto qed from is_ub is_lub show ?thesis unfolding lowner_is_lub_def by auto qed text \Lowner partial order is a complete partial order.\ lemma lowner_lub_exists: "\M. lowner_is_lub M" using lowner_lub_form by auto lemma lowner_lub_unique: "\!M. lowner_is_lub M" proof (rule HOL.ex_ex1I) show "\M. lowner_is_lub M" by (rule lowner_lub_exists) next fix M N assume M: "lowner_is_lub M" and N: "lowner_is_lub N" have Md: "M \ carrier_mat dim dim" using M by (rule lowner_is_lub_dim) have Nd: "N \ carrier_mat dim dim" using N by (rule lowner_is_lub_dim) have MN: "M \\<^sub>L N" using M N by (simp add: lowner_is_lub_def) have NM: "N \\<^sub>L M" using M N by (simp add: lowner_is_lub_def) show "M = N" using MN NM by (auto intro: lowner_le_antisym[OF Md Nd]) qed definition lowner_lub :: "complex mat" where "lowner_lub = (THE M. lowner_is_lub M)" lemma lowner_lub_prop: "lowner_is_lub lowner_lub" unfolding lowner_lub_def apply (rule HOL.theI') by (rule lowner_lub_unique) lemma lowner_lub_is_limit: "limit_mat f lowner_lub dim" proof - define A where "A = lowner_lub" then have "A = (THE M. lowner_is_lub M)" using lowner_lub_def by auto then have Af: "A = (mat dim dim (\ (i, j). (lim (\ n. (f n)  (i, j)))))" using lowner_lub_form lowner_lub_unique by auto show "limit_mat f A dim" unfolding Af limit_mat_def apply (auto simp add: dim) proof - fix i j assume dims: "i < dim" "j < dim" then have "convergent (\n. f n  (i, j))" using inc_partial_density_operator_converge by auto then show "(\n. f n  (i, j)) \ lim (\n. f n  (i, j))" using convergent_LIMSEQ_iff by auto qed qed lemma lowner_lub_trace: assumes "\ n. trace (f n) \ x" shows "trace lowner_lub \ x" proof - have "\ n. trace (f n) \ 0" using positive_trace pdo unfolding partial_density_operator_def using dim by blast - then have Re: "\ n. Re (trace (f n)) \ 0 \ Im (trace (f n)) = 0" by auto - then have lex: "\ n. Re (trace (f n)) \ Re x \ Im x = 0" using assms by auto + then have Re: "\ n. Re (trace (f n)) \ 0 \ Im (trace (f n)) = 0" + by (auto simp: less_eq_complex_def less_complex_def) + then have lex: "\ n. Re (trace (f n)) \ Re x \ Im x = 0" using assms + by (auto simp: less_eq_complex_def less_complex_def) have "limit_mat f lowner_lub dim" using lowner_lub_is_limit by auto then have conv: "(\n. trace (f n)) \ trace lowner_lub" using mat_trace_limit by auto then have "(\n. Re (trace (f n))) \ Re (trace lowner_lub)" by (simp add: tendsto_Re) then have Rell: "Re (trace lowner_lub) \ Re x" using lex Lim_bounded[of "(\n. Re (trace (f n)))" "Re (trace lowner_lub)" 0 "Re x"] by simp from conv have "(\n. Im (trace (f n))) \ Im (trace lowner_lub)" by (simp add: tendsto_Im) then have Imll: "Im (trace lowner_lub) = 0" using Re by (simp add: Lim_bounded Lim_bounded2 dual_order.antisym) - from Rell Imll lex show ?thesis by simp + from Rell Imll lex show ?thesis by (simp add: less_eq_complex_def less_complex_def) qed lemma lowner_lub_is_positive: shows "positive lowner_lub" using lowner_lub_is_limit pos_mat_lim_is_pos pdo unfolding partial_density_operator_def by auto end subsection \Finite sum of matrices\ text \Add f in the interval [0, n)\ fun matrix_sum :: "nat \ (nat \ 'b::semiring_1 mat) \ nat \ 'b mat" where "matrix_sum d f 0 = 0\<^sub>m d d" | "matrix_sum d f (Suc n) = f n + matrix_sum d f n" definition matrix_inf_sum :: "nat \ (nat \ complex mat) \ complex mat" where "matrix_inf_sum d f = matrix_seq.lowner_lub (\n. matrix_sum d f n)" lemma matrix_sum_dim: fixes f :: "nat \ 'b::semiring_1 mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ matrix_sum d f n \ carrier_mat d d" proof (induct n) case 0 show ?case by auto next case (Suc n) then have "f n \ carrier_mat d d" by auto then show ?case using Suc by auto qed lemma matrix_sum_cong: fixes f :: "nat \ 'b::semiring_1 mat" shows "(\k. k < n \ f k = f' k) \ matrix_sum d f n = matrix_sum d f' n" proof (induct n) case 0 show ?case by auto next case (Suc n) then show ?case unfolding matrix_sum.simps by auto qed lemma matrix_sum_add: fixes f :: "nat \ 'b::semiring_1 mat" and g :: "nat \ 'b::semiring_1 mat" and h :: "nat \ 'b::semiring_1 mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ (\k. k < n \ g k \ carrier_mat d d) \ (\k. k < n \ h k \ carrier_mat d d) \ (\k. k < n \ f k = g k + h k) \ matrix_sum d f n = matrix_sum d g n + matrix_sum d h n" proof (induct n) case 0 then show ?case by auto next case (Suc n) then show ?case proof - have gh: "matrix_sum d g n \ carrier_mat d d \ matrix_sum d h n \ carrier_mat d d" using matrix_sum_dim Suc(3, 4) by (simp add: matrix_sum_dim) have nSuc: "n < Suc n" by auto have sumf: "matrix_sum d f n = matrix_sum d g n + matrix_sum d h n" using Suc by auto have "matrix_sum d f (Suc n) = matrix_sum d g (Suc n) + matrix_sum d h (Suc n)" unfolding matrix_sum.simps Suc(5)[OF nSuc] sumf apply (mat_assoc d) using gh Suc by auto then show ?thesis by auto qed qed lemma matrix_sum_smult: fixes f :: "nat \ 'b::semiring_1 mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ matrix_sum d (\ k. c \\<^sub>m f k) n = c \\<^sub>m matrix_sum d f n" proof (induct n) case 0 then show ?case by auto next case (Suc n) then show ?case apply auto using add_smult_distrib_left_mat Suc matrix_sum_dim by (metis lessI less_SucI) qed lemma matrix_sum_remove: fixes f :: "nat \ 'b::semiring_1 mat" assumes j: "j < n" and df: "(\k. k < n \ f k \ carrier_mat d d)" and f': "(\k. f' k = (if k = j then 0\<^sub>m d d else f k))" shows "matrix_sum d f n = f j + matrix_sum d f' n" proof - have df': "\k. k < n \ f' k \ carrier_mat d d" using f' df by auto have dsf: "k < n \ matrix_sum d f k \ carrier_mat d d" for k using matrix_sum_dim[OF df] by auto have dsf': "k < n \ matrix_sum d f' k \ carrier_mat d d" for k using matrix_sum_dim[OF df'] by auto have flj: "\k. k < j \ f' k = f k" using j f' by auto then have "matrix_sum d f j = matrix_sum d f' j" using matrix_sum_cong[of j f' f, OF flj] df df' j by auto then have eqj: "matrix_sum d f (Suc j) = f j + matrix_sum d f' (Suc j)" unfolding matrix_sum.simps by (subst (1) f', simp add: df dsf' j) have lm: "(j + 1) + l \ n \ matrix_sum d f ((j + 1) + l) = f j + matrix_sum d f' ((j + 1) + l)" for l proof (induct l) case 0 show ?case using j eqj by auto next case (Suc l) then have eq: "matrix_sum d f ((j + 1) + l) = f j + matrix_sum d f' ((j + 1) + l)" by auto have s: "((j + 1) + Suc l) = Suc ((j + 1) + l)" by simp have eqf': "f' (j + 1 + l) = f (j + 1 + l)" using f' Suc by auto have dims: "f (j + 1 + l) \ carrier_mat d d" "f j \ carrier_mat d d" "matrix_sum d f' (j + 1 + l) \ carrier_mat d d" using df df' dsf' Suc by auto show ?case apply (subst (1 2) s) unfolding matrix_sum.simps apply (subst eq, subst eqf') apply (mat_assoc d) using dims by auto qed have p: "(j + 1) + (n - j - 1) \ n" using j by auto show ?thesis using lm[OF p] j by auto qed lemma matrix_sum_Suc_remove_head: fixes f :: "nat \ complex mat" shows "(\k. k < n + 1 \ f k \ carrier_mat d d) \ matrix_sum d f (n + 1) = f 0 + matrix_sum d (\k. f (k + 1)) n" proof (induct n) case 0 then show ?case by auto next case (Suc n) then have dSS: "\k. k < Suc (Suc n) \ f k \ carrier_mat d d" by auto have ds: "matrix_sum d (\k. f (k + 1)) n \ carrier_mat d d" using matrix_sum_dim[OF dSS, of "n" "\k. k + 1"] by auto have "matrix_sum d f (Suc n + 1) = f (n + 1) + matrix_sum d f (n + 1)" by auto also have "\ = f (n + 1) + (f 0 + matrix_sum d (\k. f (k + 1)) n)" using Suc by auto also have "\ = f 0 + (f (n + 1) + matrix_sum d (\k. f (k + 1)) n)" using ds apply (mat_assoc d) using dSS by auto finally show ?case by auto qed lemma matrix_sum_positive: fixes f :: "nat \ complex mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ (\k. k < n \ positive (f k)) \ positive (matrix_sum d f n)" proof (induct n) case 0 show ?case using positive_zero by auto next case (Suc n) then have dfn: "f n \ carrier_mat d d" and psn: "positive (matrix_sum d f n)" and pn: "positive (f n)" and d: "k < n \ f k \ carrier_mat d d" for k by auto then have dsn: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim by auto show ?case unfolding matrix_sum.simps using positive_add[OF pn psn dfn dsn] by auto qed lemma matrix_sum_mult_right: shows "(\k. k < n \ f k \ carrier_mat d d) \ A \ carrier_mat d d \ matrix_sum d (\k. (f k) * A) n = matrix_sum d (\k. f k) n * A" proof (induct n) case 0 then show ?case by auto next case (Suc n) then have "k < n \ f k \ carrier_mat d d" and dfn: "f n \ carrier_mat d d" for k by auto then have dsfn: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim by auto have "(f n + matrix_sum d f n) * A = f n * A + matrix_sum d f n * A" apply (mat_assoc d) using Suc dsfn by auto also have "\ = f n * A + matrix_sum d (\k. f k * A) n" using Suc by auto finally show ?case by auto qed lemma matrix_sum_add_distrib: shows "(\k. k < n \ f k \ carrier_mat d d) \ (\k. k < n \ g k \ carrier_mat d d) \ matrix_sum d (\k. (f k) + (g k)) n = matrix_sum d f n + matrix_sum d g n" proof (induct n) case 0 then show ?case by auto next case (Suc n) then have dfn: "f n \ carrier_mat d d" and dgn: "g n \ carrier_mat d d" and dfk: "k < n \ f k \ carrier_mat d d" and dgk: "k < n \ g k \ carrier_mat d d" and eq: "matrix_sum d (\k. f k + g k) n = matrix_sum d f n + matrix_sum d g n" for k by auto have dsf: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim dfk by auto have dsg: "matrix_sum d g n \ carrier_mat d d" using matrix_sum_dim dgk by auto show ?case unfolding matrix_sum.simps eq using dfn dgn dsf dsg by (mat_assoc d) qed lemma matrix_sum_minus_distrib: fixes f g :: "nat \ complex mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ (\k. k < n \ g k \ carrier_mat d d) \ matrix_sum d (\k. (f k) - (g k)) n = matrix_sum d f n - matrix_sum d g n" proof - have eq: "-1 \\<^sub>m g k = - g k" for k by auto assume dfk: "\k. k < n \ f k \ carrier_mat d d" and dgk: "\k. k < n \ (g k) \ carrier_mat d d" then have "k < n \ (f k) - (g k) = (f k) + (- (g k))" for k by auto then have "matrix_sum d (\k. (f k) - (g k)) n = matrix_sum d (\k. (f k) + (- (g k))) n" using matrix_sum_cong[of n "\k. (f k) - (g k)"] dfk dgk by auto also have "\ = matrix_sum d f n + matrix_sum d (\k. - (g k)) n" using matrix_sum_add_distrib[of n "f"] dfk dgk by auto also have "\ = matrix_sum d f n - matrix_sum d g n" apply (subgoal_tac "matrix_sum d (\k. - (g k)) n = - matrix_sum d g n", auto) apply (subgoal_tac "- 1 \\<^sub>m matrix_sum d g n = - matrix_sum d g n") by (simp add: matrix_sum_smult[of n g d "-1", OF dgk, simplified eq, simplified], auto) finally show ?thesis . qed lemma matrix_sum_shift_Suc: shows "(\k. k < (Suc n) \ f k \ carrier_mat d d) \ matrix_sum d f (Suc n) = f 0 + matrix_sum d (\k. f (Suc k)) n" proof (induct n) case 0 then show ?case by auto next case (Suc n) have dfk: "k < Suc (Suc n) \ f k \ carrier_mat d d" for k using Suc by auto have dsSk: "k < Suc n \ matrix_sum d (\k. f (Suc k)) n \ carrier_mat d d" for k using matrix_sum_dim[of _ "\k. f (Suc k)"] dfk by fastforce have "matrix_sum d f (Suc (Suc n)) = f (Suc n) + matrix_sum d f (Suc n)" by auto also have "\ = f (Suc n) + f 0 + matrix_sum d (\k. f (Suc k)) n" using Suc dsSk assoc_add_mat[of "f (Suc n)" d d "f 0"] by fastforce also have "\ = f 0 + (f (Suc n) + matrix_sum d (\k. f (Suc k)) n)" apply (mat_assoc d) using dsSk dfk by auto also have "\ = f 0 + matrix_sum d (\k. f (Suc k)) (Suc n)" by auto finally show ?case . qed lemma lowner_le_matrix_sum: fixes f g :: "nat \ complex mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ (\k. k < n \ g k \ carrier_mat d d) \ (\k. k < n \ f k \\<^sub>L g k) \ matrix_sum d f n \\<^sub>L matrix_sum d g n" proof (induct n) case 0 show ?case unfolding matrix_sum.simps using lowner_le_refl[of "0\<^sub>m d d" d] by auto next case (Suc n) then have dfn: "f n \ carrier_mat d d" and dgn: "g n \ carrier_mat d d" and le1: "f n \\<^sub>L g n" by auto then have le2: "matrix_sum d f n \\<^sub>L matrix_sum d g n" using Suc by auto have "k < n \ f k \ carrier_mat d d" for k using Suc by auto then have dsf: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim by auto have "k < n \ g k \ carrier_mat d d" for k using Suc by auto then have dsg: "matrix_sum d g n \ carrier_mat d d" using matrix_sum_dim by auto show ?case unfolding matrix_sum.simps using lowner_le_add dfn dsf dgn dsg le1 le2 by auto qed lemma lowner_lub_add: assumes "matrix_seq d f" "matrix_seq d g" "\ n. trace (f n + g n) \ 1" shows "matrix_seq.lowner_lub (\n. f n + g n) = matrix_seq.lowner_lub f + matrix_seq.lowner_lub g" proof - have msf: "matrix_seq.lowner_is_lub f (matrix_seq.lowner_lub f)" using assms(1) matrix_seq.lowner_lub_prop by auto then have "limit_mat f (matrix_seq.lowner_lub f) d" using matrix_seq.lowner_lub_is_limit assms by auto then have lim1: "\ijn. f n  (i, j)) \ (matrix_seq.lowner_lub f)  (i, j)" using limit_mat_def assms by auto have msg: "matrix_seq.lowner_is_lub g (matrix_seq.lowner_lub g)" using assms(2) matrix_seq.lowner_lub_prop by auto then have "limit_mat g (matrix_seq.lowner_lub g) d" using matrix_seq.lowner_lub_is_limit assms by auto then have lim2: "\ijn. g n  (i, j)) \ (matrix_seq.lowner_lub g)  (i, j)" using limit_mat_def assms by auto have "\n. f n + g n \ carrier_mat d d" using assms unfolding matrix_seq_def by fastforce moreover have "\n. partial_density_operator (f n + g n)" using assms unfolding matrix_seq_def partial_density_operator_def using positive_add by blast moreover have "(f n + g n) \\<^sub>L (f (Suc n) + g (Suc n))" for n using assms unfolding matrix_seq_def using lowner_le_add[of "f n" d "f (Suc n)" "g n" "g (Suc n)"] by auto ultimately have msfg: "matrix_seq d (\n. f n + g n)" using assms unfolding matrix_seq_def by auto then have mslfg: "matrix_seq.lowner_is_lub (\n. f n + g n) (matrix_seq.lowner_lub (\n. f n + g n))" using matrix_seq.lowner_lub_prop by auto then have "limit_mat (\n. f n + g n) (matrix_seq.lowner_lub (\n. f n + g n)) d" using matrix_seq.lowner_lub_is_limit msfg by auto then have lim3: "\ijn. (f n + g n)  (i, j)) \ (matrix_seq.lowner_lub (\n. f n + g n))  (i, j)" using limit_mat_def assms by auto have "\ i j n. (f n + g n)  (i, j) = f n  (i, j) + g n  (i, j)" using assms unfolding matrix_seq_def by (metis carrier_matD(1) carrier_matD(2) index_add_mat(1)) then have add: "\ijn. f n  (i, j) + g n  (i, j)) \ (matrix_seq.lowner_lub (\n. f n + g n))  (i, j)" using lim3 by auto have "matrix_seq.lowner_lub f  (i, j) + matrix_seq.lowner_lub g  (i, j) = matrix_seq.lowner_lub (\n. f n + g n)  (i, j)" if i: "i < d" and j: "j < d" for i j proof - have "(\n. f n  (i, j)) \ matrix_seq.lowner_lub f  (i, j)" using lim1 i j by auto moreover have "(\n. g n  (i, j)) \ matrix_seq.lowner_lub g  (i, j)" using lim2 i j by auto ultimately have "(\n. f n  (i, j) + g n  (i, j)) \ matrix_seq.lowner_lub f  (i, j) + matrix_seq.lowner_lub g  (i, j)" using tendsto_add[of "\n. f n  (i, j)" "matrix_seq.lowner_lub f  (i, j)" sequentially "\n. g n  (i, j)" "matrix_seq.lowner_lub g  (i, j)"] by auto moreover have "(\n. f n  (i, j) + g n  (i, j)) \ matrix_seq.lowner_lub (\n. f n + g n)  (i, j)" using add i j by auto ultimately show ?thesis using LIMSEQ_unique by auto qed moreover have "matrix_seq.lowner_lub f \ carrier_mat d d" using matrix_seq.lowner_is_lub_dim assms(1) msf unfolding matrix_seq_def by auto moreover have "matrix_seq.lowner_lub g \ carrier_mat d d" using matrix_seq.lowner_is_lub_dim assms(2) msg unfolding matrix_seq_def by auto moreover have "matrix_seq.lowner_lub (\n. f n + g n) \ carrier_mat d d" using matrix_seq.lowner_is_lub_dim msfg mslfg unfolding matrix_seq_def by auto ultimately show ?thesis unfolding matrix_seq_def using mat_eq_iff by auto qed lemma lowner_lub_scale: fixes c :: real assumes "matrix_seq d f" "\ n. trace (c \\<^sub>m f n) \ 1" "c\0" shows "matrix_seq.lowner_lub (\n. c \\<^sub>m f n) = c \\<^sub>m matrix_seq.lowner_lub f" proof - have msf: "matrix_seq.lowner_is_lub f (matrix_seq.lowner_lub f)" using assms(1) matrix_seq.lowner_lub_prop by auto then have "limit_mat f (matrix_seq.lowner_lub f) d" using matrix_seq.lowner_lub_is_limit assms by auto then have lim1: "\ijn. f n  (i, j)) \ (matrix_seq.lowner_lub f)  (i, j)" using limit_mat_def assms by auto have dimcf: "\n. c \\<^sub>m f n \ carrier_mat d d" using assms unfolding matrix_seq_def by fastforce moreover have "\n. partial_density_operator (c \\<^sub>m f n)" using assms unfolding matrix_seq_def partial_density_operator_def using positive_scale by blast moreover have "\n. c \\<^sub>m f n \\<^sub>L c \\<^sub>m f (Suc n)" using lowner_le_smult assms(1,3) unfolding matrix_seq_def partial_density_operator_def by blast ultimately have mscf: "matrix_seq d (\n. c \\<^sub>m f n)" unfolding matrix_seq_def by auto then have mslfg: "matrix_seq.lowner_is_lub (\n. c \\<^sub>m f n) (matrix_seq.lowner_lub (\n. c \\<^sub>m f n))" using matrix_seq.lowner_lub_prop by auto then have "limit_mat (\n. c \\<^sub>m f n) (matrix_seq.lowner_lub (\n. c \\<^sub>m f n)) d" using matrix_seq.lowner_lub_is_limit mscf by auto then have lim3: "\ijn. (c \\<^sub>m f n)  (i, j)) \ (matrix_seq.lowner_lub (\n. c \\<^sub>m f n))  (i, j)" using limit_mat_def assms by auto from mslfg mscf have dleft: "matrix_seq.lowner_lub (\n. c \\<^sub>m f n) \ carrier_mat d d" using matrix_seq.lowner_is_lub_dim by auto have dllf: "matrix_seq.lowner_lub f \ carrier_mat d d" using matrix_seq.lowner_is_lub_dim assms(1) msf unfolding matrix_seq_def by auto then have dright: "c \\<^sub>m matrix_seq.lowner_lub f \ carrier_mat d d" using index_smult_mat(2,3) by auto have "\ i j n. (c \\<^sub>m f n)  (i, j) = c * f n  (i, j)" using assms(1) unfolding matrix_seq_def using index_smult_mat(1) by (metis carrier_matD(1-2)) then have smult: "\ijn. c * f n  (i, j)) \ (matrix_seq.lowner_lub (\n. c \\<^sub>m f n))  (i, j)" using lim3 by auto have ij: "(c \\<^sub>m matrix_seq.lowner_lub f)  (i, j) = (matrix_seq.lowner_lub (\n. c \\<^sub>m f n))  (i, j)" if i: "i < d" and j: "j < d" for i j proof - have "(\n. f n  (i, j)) \ matrix_seq.lowner_lub f  (i, j)" using lim1 i j by auto moreover have "\ij\<^sub>m matrix_seq.lowner_lub f)  (i, j) = c * matrix_seq.lowner_lub f  (i, j)" using index_smult_mat dllf by fastforce ultimately have "\ijn. c * f n  (i, j)) \(c \\<^sub>m matrix_seq.lowner_lub f)  (i, j)" using tendsto_intros(18)[of "\n. c" "c" sequentially "\n. f n  (i, j)" "matrix_seq.lowner_lub f  (i, j)"] i j by (simp add: lim1 tendsto_mult_left) then show ?thesis using smult i j LIMSEQ_unique by metis qed from dleft dright ij show ?thesis using mat_eq_iff[of "matrix_seq.lowner_lub (\n. c \\<^sub>m f n)" "c \\<^sub>m matrix_seq.lowner_lub f"] by (metis (mono_tags) carrier_matD(1) carrier_matD(2)) qed lemma trace_matrix_sum_linear: fixes f :: "nat \ complex mat" shows "(\k. k < n \ f k \ carrier_mat d d) \ trace (matrix_sum d f n) = sum (\k. trace (f k)) {0..k. k < n \ f k \ carrier_mat d d" by auto then have ds: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim by auto have "trace (matrix_sum d f (Suc n)) = trace (f n) + trace (matrix_sum d f n)" unfolding matrix_sum.simps apply (mat_assoc d) using ds Suc by auto also have "\ = sum (trace \ f) {0.. f) n" using Suc by auto also have "\ = sum (trace \ f) {0.. complex mat" shows "P \ carrier_mat d d \ (\k. k < n \ f k \ carrier_mat d d) \ matrix_sum d (\k. P * (f k)) n = P * (matrix_sum d f n)" proof (induct n) case 0 show ?case unfolding matrix_sum.simps using 0 by auto next case (Suc n) then have "\k. k < n \ f k \ carrier_mat d d" by auto then have ds: "matrix_sum d f n \ carrier_mat d d" using matrix_sum_dim by auto then have dPf: "\k. k < n \ P * f k \ carrier_mat d d" using Suc by auto then have "matrix_sum d (\k. P * f k) n \ carrier_mat d d" using matrix_sum_dim[OF dPf] by auto have "matrix_sum d (\k. P * f k) (Suc n) = P * f n + matrix_sum d (\k. P * f k) n " unfolding matrix_sum.simps using Suc(2) by auto also have "\ = P * f n + P * matrix_sum d f n" using Suc by auto also have "\ = P * (f n + matrix_sum d f n)" apply (mat_assoc d) using ds dPf Suc by auto finally show "matrix_sum d (\k. P * f k) (Suc n) = P * (matrix_sum d f (Suc n))" by auto qed subsection \Measurement\ definition measurement :: "nat \ nat \ (nat \ complex mat) \ bool" where "measurement d n M \ (\j < n. M j \ carrier_mat d d) \ matrix_sum d (\j. (adjoint (M j)) * M j) n = 1\<^sub>m d" lemma measurement_dim: assumes "measurement d n M" shows "\k. k < n \ (M k) \ carrier_mat d d" using assms unfolding measurement_def by auto lemma measurement_id2: assumes "measurement d 2 M" shows "adjoint (M 0) * M 0 + adjoint (M 1) * M 1 = 1\<^sub>m d" proof - have ssz: "(Suc (Suc 0)) = 2" by auto have "M 0 \ carrier_mat d d" "M 1 \ carrier_mat d d" using assms measurement_def by auto then have "adjoint (M 0) * M 0 + adjoint (M 1) * M 1 = matrix_sum d (\j. (adjoint (M j)) * M j) (Suc (Suc 0)) " by auto also have "\ = matrix_sum d (\j. (adjoint (M j)) * M j) (2::nat)" by (subst ssz, auto) also have "\ = 1\<^sub>m d" using measurement_def[of d 2 M] assms by auto finally show ?thesis by auto qed text \Result of measurement on \rho by matrix M\ definition measurement_res :: "complex mat \ complex mat \ complex mat" where "measurement_res M \ = M * \ * adjoint M" lemma add_positive_le_reduce1: assumes dA: "A \ carrier_mat n n" and dB: "B \ carrier_mat n n" and dC: "C \ carrier_mat n n" and pB: "positive B" and le: "A + B \\<^sub>L C" shows "A \\<^sub>L C" unfolding lowner_le_def positive_def proof (auto simp add: carrier_matD[OF dA] carrier_matD[OF dC] simp del: less_eq_complex_def) have eq: "C - (A + B) = (C - A + (-B))" using dA dB dC by auto have "positive (C - (A + B))" using le lowner_le_def dA dB dC by auto with eq have p: "positive (C - A + (-B))" by auto fix v :: "complex vec" assume " n = dim_vec v" then have dv: "v \ carrier_vec n" by auto have ge: "inner_prod v (B *\<^sub>v v) \ 0" using pB dv dB positive_def by auto have "0 \ inner_prod v ((C - A + (-B)) *\<^sub>v v) " using p positive_def dv dA dB dC by auto also have "\ = inner_prod v ((C - A)*\<^sub>v v + (-B) *\<^sub>v v) " using dv dA dB dC add_mult_distrib_mat_vec[OF minus_carrier_mat[OF dA]] by auto also have "\ = inner_prod v ((C - A) *\<^sub>v v) + inner_prod v ((-B) *\<^sub>v v)" apply (subst inner_prod_distrib_right) by (rule dv, auto simp add: mult_mat_vec_carrier[OF minus_carrier_mat[OF dA]] mult_mat_vec_carrier[OF uminus_carrier_mat[OF dB]] dv) also have "\ = inner_prod v ((C - A) *\<^sub>v v) - inner_prod v (B *\<^sub>v v)" using dB dv by auto also have "\ \ inner_prod v ((C - A) *\<^sub>v v)" using ge by auto finally show "0 \ inner_prod v ((C - A) *\<^sub>v v)". qed lemma add_positive_le_reduce2: assumes dA: "A \ carrier_mat n n" and dB: "B \ carrier_mat n n" and dC: "C \ carrier_mat n n" and pB: "positive B" and le: "B + A \\<^sub>L C" shows "A \\<^sub>L C" apply (subgoal_tac "B + A = A + B") using add_positive_le_reduce1[of A n B C] assms by auto lemma measurement_le_one_mat: assumes "measurement d n f" shows "\j. j < n \ adjoint (f j) * f j \\<^sub>L 1\<^sub>m d" proof - fix j assume j: "j < n" define M where "M = adjoint (f j) * f j" have df: "k < n \ f k \ carrier_mat d d" for k using assms measurement_dim by auto have daf: "k < n \ adjoint (f k) * f k \ carrier_mat d d" for k proof - assume "k < n" then have "f k \ carrier_mat d d" "adjoint (f k) \ carrier_mat d d" using df adjoint_dim by auto then show "adjoint (f k) * f k \ carrier_mat d d" by auto qed have pafj: "k < n \ positive (adjoint (f k) * (f k)) " for k apply (subst (2) adjoint_adjoint[of "f k", symmetric]) by (metis adjoint_adjoint daf positive_if_decomp) define f' where "\k. f' k = (if k = j then 0\<^sub>m d d else adjoint (f k) * f k)" have pf': "k < n \ positive (f' k)" for k unfolding f'_def using positive_zero pafj j by auto have df': "k < n \ f' k \ carrier_mat d d" for k using daf j zero_carrier_mat f'_def by auto then have dsf': "matrix_sum d f' n \ carrier_mat d d" using matrix_sum_dim[of n f' d] by auto have psf': "positive (matrix_sum d f' n)" using matrix_sum_positive pafj df' pf' by auto have "M + matrix_sum d f' n = matrix_sum d (\k. adjoint (f k) * f k) n" using matrix_sum_remove[OF j , of "(\k. adjoint (f k) * f k)", OF daf, of f'] f'_def unfolding M_def by auto also have "\ = 1\<^sub>m d" using measurement_def assms by auto finally have "M + matrix_sum d f' n = 1\<^sub>m d". moreover have "1\<^sub>m d \\<^sub>L 1\<^sub>m d" using lowner_le_refl[of _ d] by auto ultimately have "(M + matrix_sum d f' n) \\<^sub>L 1\<^sub>m d" by auto then show "M \\<^sub>L 1\<^sub>m d" unfolding M_def using add_positive_le_reduce1[OF _ dsf' one_carrier_mat psf'] daf j by auto qed lemma pdo_close_under_measurement: fixes M \ :: "complex mat" assumes dM: "M \ carrier_mat n n" and dr: "\ \ carrier_mat n n" and pdor: "partial_density_operator \" and le: "adjoint M * M \\<^sub>L 1\<^sub>m n" shows "partial_density_operator (M * \ * adjoint M)" unfolding partial_density_operator_def proof show "positive (M * \ * adjoint M)" using positive_close_under_left_right_mult_adjoint[OF dM dr] pdor partial_density_operator_def by auto next have daM: "adjoint M \ carrier_mat n n" using dM by auto then have daMM: "adjoint M * M \ carrier_mat n n" using dM by auto have "trace (M * \ * adjoint M) = trace (adjoint M * M *$$" using dM dr by (mat_assoc n) also have "\ \ trace (1\<^sub>m n * \)" using lowner_le_trace[where ?B = "1\<^sub>m n" and ?A = "adjoint M * M", OF daMM one_carrier_mat] le dr pdor by auto also have "\ = trace \" using dr by auto also have "\ \ 1" using pdor partial_density_operator_def by auto finally show "trace (M * \ * adjoint M) \ 1" by auto qed lemma trace_measurement: assumes m: "measurement d n M" and dA: "A \ carrier_mat d d" shows "trace (matrix_sum d (\k. (M k) * A * adjoint (M k)) n) = trace A" proof - have dMk: "k < n \ (M k) \ carrier_mat d d" for k using m unfolding measurement_def by auto then have daMk: "k < n \ adjoint (M k) \ carrier_mat d d" for k using m adjoint_dim unfolding measurement_def by auto have d1: "k < n \ M k * A * adjoint (M k) \ carrier_mat d d"for k using dMk daMk dA by fastforce then have ds1: "k < n \ matrix_sum d (\k. M k * A * adjoint (M k)) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. M k * A * adjoint (M k)" d] by auto have d2: "k < n \ adjoint (M k) *M k * A \ carrier_mat d d" for k using daMk dMk dA by fastforce then have ds2: "k < n \ matrix_sum d (\k. adjoint (M k) *M k * A) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. adjoint (M k) *M k * A" d] by auto have daMMk: "k < n \ adjoint (M k) * M k \ carrier_mat d d" for k using dMk by fastforce have "k \ n \ trace (matrix_sum d (\k. (M k) * A * adjoint (M k)) k) = trace (matrix_sum d (\k. adjoint (M k) * (M k) * A) k)" for k proof (induct k) case 0 then show ?case by auto next case (Suc k) then have k: "k < n" by auto have "trace (M k * A * adjoint (M k)) = trace (adjoint (M k) * M k * A)" using dA apply (mat_assoc d) using dMk k by auto then show ?case unfolding matrix_sum.simps using ds1 ds2 d1 d2 k Suc daMk dMk dA by (subst trace_add_linear[of _ d], auto)+ qed then have "trace (matrix_sum d (\k. (M k) * A * adjoint (M k)) n) = trace (matrix_sum d (\k. adjoint (M k) * (M k) * A) n)" by auto also have "\ = trace (matrix_sum d (\k. adjoint (M k) * (M k)) n * A)" using matrix_sum_mult_right[OF daMMk, of n id A] dA by auto also have "\ = trace A" using m dA unfolding measurement_def by auto finally show ?thesis by auto qed lemma mat_inc_seq_positive_transform: assumes dfn: "\n. f n \ carrier_mat d d" and inc: "\n. f n \\<^sub>L f (Suc n)" shows "\n. f n - f 0 \ carrier_mat d d" and "\n. (f n - f 0) \\<^sub>L (f (Suc n) - f 0)" proof - show "\n. f n - f 0 \ carrier_mat d d" using dfn by fastforce have "f 0 \\<^sub>L f 0" using lowner_le_refl[of "f 0" d] dfn by auto then show "(f n - f 0) \\<^sub>L (f (Suc n) - f 0)" for n using lowner_le_minus[of "f n" d "f (Suc n)" "f 0" "f 0"] dfn inc by fastforce qed lemma mat_inc_seq_lub: assumes dfn: "\n. f n \ carrier_mat d d" and inc: "\n. f n \\<^sub>L f (Suc n)" and ub: "\n. f n \\<^sub>L A" shows "\B. lowner_is_lub f B \ limit_mat f B d" proof - have dmfn0: "\n. f n - f 0 \ carrier_mat d d" and incm0: "\n. (f n - f 0) \\<^sub>L (f (Suc n) - f 0)" using mat_inc_seq_positive_transform[OF dfn, of id] assms by auto define c where "c = 1 / (trace (A - f 0) + 1)" have "f 0 \\<^sub>L A" using ub by auto then have dA: "A \ carrier_mat d d" using ub unfolding lowner_le_def using dfn[of 0] by fastforce then have dAmf0: "A - f 0 \ carrier_mat d d" using dfn[of 0] by auto have "positive (A - f 0)" using ub lowner_le_def by auto then have tgeq0: "trace (A - f 0) \ 0" using positive_trace dAmf0 by auto - then have "trace (A - f 0) + 1 > 0" by auto - then have gtc: "c > 0" unfolding c_def using complex_is_Real_iff by auto - then have gtci: "(1 / c) > 0" using complex_is_Real_iff by auto + then have "trace (A - f 0) + 1 > 0" by (auto simp: less_eq_complex_def less_complex_def) + then have gtc: "c > 0" unfolding c_def using complex_is_Real_iff + by (auto simp: less_eq_complex_def less_complex_def) + then have gtci: "(1 / c) > 0" using complex_is_Real_iff + by (auto simp: less_eq_complex_def less_complex_def) have "trace (c \\<^sub>m (A - f 0)) = c * trace (A - f 0)" using trace_smult dAmf0 by auto also have "\ = (1 / (trace (A - f 0) + 1)) * trace (A - f 0)" unfolding c_def by auto - also have "\ < 1" using tgeq0 by (simp add: complex_is_Real_iff) + also have "\ < 1" using tgeq0 by (simp add: complex_is_Real_iff less_eq_complex_def less_complex_def) finally have lt1: "trace (c \\<^sub>m (A - f 0)) < 1". have le0: "- f 0 \\<^sub>L - f 0" using lowner_le_refl[of "- f 0" d] dfn by auto have dmf0: "- f 0 \ carrier_mat d d" using dfn by auto have mf0smcle: "(c \\<^sub>m (X - f 0)) \\<^sub>L (c \\<^sub>m (Y - f 0))" if "X \\<^sub>L Y" and "X \ carrier_mat d d" and "Y \ carrier_mat d d" for X Y proof - have "(X - f 0) \\<^sub>L (Y - f 0)" using lowner_le_minus[of "X" d "Y" "f 0" "f 0"] that dfn lowner_le_refl by auto then show ?thesis using lowner_le_smultc[of c "(X - f 0)" "Y - f 0" d] using that dfn gtc by fastforce qed have "(c \\<^sub>m (f n - f 0)) \\<^sub>L (c \\<^sub>m (A - f 0))" for n using mf0smcle ub dfn dA by auto then have "trace (c \\<^sub>m (f n - f 0)) \ trace (c \\<^sub>m (A - f 0))" for n using lowner_le_imp_trace_le[of "c \\<^sub>m (f n - f 0)" d] dmfn0 dAmf0 by auto - then have trlt1: "trace (c \\<^sub>m (f n - f 0)) < 1" for n using lt1 by fastforce + then have trlt1: "trace (c \\<^sub>m (f n - f 0)) < 1" for n using lt1 + unfolding less_eq_complex_def less_complex_def + by (metis add.commute add_less_cancel_right add_mono_thms_linordered_field(3)) have "f 0 \\<^sub>L f n" for n proof (induct n) case 0 then show ?case using dfn lowner_le_refl by auto next case (Suc n) then show ?case using dfn lowner_le_trans[of "f 0" d "f n"] inc by auto qed then have "positive (f n - f 0)" for n using lowner_le_def by auto then have p: "positive (c \\<^sub>m (f n - f 0))" for n by (intro positive_smult, insert gtc dmfn0, auto) have inc': "c \\<^sub>m (f n - f 0) \\<^sub>L c \\<^sub>m (f (Suc n) - f 0)" for n using incm0 lowner_le_smultc[of c "f n - f 0"] gtc dmfn0 by fastforce define g where "g n = c \\<^sub>m (f n - f 0)" for n then have "positive (g n)" and "trace (g n) < 1" and "(g n) \\<^sub>L (g (Suc n))" and dgn: "(g n) \ carrier_mat d d" for n unfolding g_def using p trlt1 inc' dmfn0 by auto - then have ms: "matrix_seq d g" unfolding matrix_seq_def partial_density_operator_def by fastforce + then have ms: "matrix_seq d g" unfolding matrix_seq_def partial_density_operator_def + by (simp add: less_eq_complex_def less_complex_def dual_order.strict_iff_not) then have uniM: "\!M. matrix_seq.lowner_is_lub g M" using matrix_seq.lowner_lub_unique by auto then obtain M where M: "matrix_seq.lowner_is_lub g M" by auto then have leg: "g n \\<^sub>L M" and lubg: "\M'. (\n. g n \\<^sub>L M') \ M \\<^sub>L M'" for n unfolding matrix_seq.lowner_is_lub_def[OF ms] by auto have "M = matrix_seq.lowner_lub g" using matrix_seq.lowner_lub_def[OF ms] M uniM theI_unique[of "matrix_seq.lowner_is_lub g"] by auto then have limg: "limit_mat g M d" using M matrix_seq.lowner_lub_is_limit[OF ms] by auto then have dM: "M \ carrier_mat d d" unfolding limit_mat_def by auto define B where "B = f 0 + (1 / c) \\<^sub>m M" have eqinv: "f 0 + (1 / c) \\<^sub>m (c \\<^sub>m (X - f 0)) = X" if "X \ carrier_mat d d" for X proof - have "f 0 + (1 / c) \\<^sub>m (c \\<^sub>m (X - f 0)) = f 0 + (1 / c * c) \\<^sub>m (X - f 0)" apply (subgoal_tac "(1 / c) \\<^sub>m (c \\<^sub>m (X - f 0)) = (1 / c * c) \\<^sub>m (X - f 0)", simp) using smult_smult_mat dfn that by auto also have "\ = f 0 + 1 \\<^sub>m (X - f 0)" using gtc by auto also have "\ = f 0 + (X - f 0)" by auto also have "\ = (- f 0) + f 0 + X" apply (mat_assoc d) using that dfn by auto also have "\ = 0\<^sub>m d d + X" using dfn uminus_l_inv_mat[of "f 0" d d] by fastforce also have "\ = X" using that by auto finally show ?thesis by auto qed have "limit_mat (\n. (1 / c) \\<^sub>m g n) ((1 / c) \\<^sub>m M) d" using limit_mat_scale[OF limg] gtci by auto then have "limit_mat (\n. f 0 + (1 / c) \\<^sub>m g n) (f 0 + (1 / c) \\<^sub>m M ) d" using mat_add_limit[of "f 0"] limg dfn unfolding mat_add_seq_def by auto then have limf: "limit_mat f B d" using eqinv[OF dfn] unfolding B_def g_def by auto have f0acmcile: "(f 0 + (1 / c) \\<^sub>m X) \\<^sub>L (f 0 + (1 / c) \\<^sub>m Y )" if "X \\<^sub>L Y" and "X \ carrier_mat d d" and "Y \ carrier_mat d d" for X Y proof - have "((1 / c) \\<^sub>m X) \\<^sub>L ((1 / c) \\<^sub>m Y)" using lowner_le_smultc[of "1/c"] that gtci by fastforce then show "(f 0 + (1 / c) \\<^sub>m X) \\<^sub>L (f 0 + (1 / c) \\<^sub>m Y)" using lowner_le_add[of _ d _ "(1 / c) \\<^sub>m X" "(1 / c) \\<^sub>m Y"] that gtci dfn lowner_le_refl[of "f 0", OF dfn] by fastforce qed have "(f 0 + (1 / c) \\<^sub>m g n) \\<^sub>L (f 0 + (1 / c) \\<^sub>m M )" for n using f0acmcile[OF leg dgn dM] by auto then have lubf: "f n \\<^sub>L B" for n using eqinv[OF dfn] g_def B_def by auto { fix B' assume asm: "\n. f n \\<^sub>L B'" then have "f 0 \\<^sub>L B'" by auto then have dB': "B' \ carrier_mat d d" unfolding lowner_le_def using dfn[of 0] by auto have "f n \\<^sub>L B'" for n using asm by auto then have "(c \\<^sub>m (f n - f 0)) \\<^sub>L (c \\<^sub>m (B' - f 0))" for n using mf0smcle[of "f n" B'] dfn dB' by auto then have "g n \\<^sub>L (c \\<^sub>m (B' - f 0))" for n using g_def by auto then have "M \\<^sub>L (c \\<^sub>m (B' - f 0))" using lubg by auto then have "(f 0 + (1 / c) \\<^sub>m M) \\<^sub>L (f 0 + (1 / c) \\<^sub>m (c \\<^sub>m (B' - f 0)))" using f0acmcile[of "M" "(c \\<^sub>m (B' - f 0))", OF _ dM] using dB' dfn by fastforce then have "B \\<^sub>L B'" unfolding B_def using eqinv[OF dB'] by auto } with limf lubf have "((\n. f n \\<^sub>L B) \ (\M'. (\n. f n \\<^sub>L M') \ B \\<^sub>L M')) \ limit_mat f B d" by auto then show ?thesis unfolding lowner_is_lub_def by auto qed end diff --git a/thys/QHLProver/Quantum_Hoare.thy b/thys/QHLProver/Quantum_Hoare.thy --- a/thys/QHLProver/Quantum_Hoare.thy +++ b/thys/QHLProver/Quantum_Hoare.thy @@ -1,1417 +1,1421 @@ section \Partial and total correctness\ theory Quantum_Hoare imports Quantum_Program begin context state_sig begin definition density_states :: "state set" where "density_states = {\ \ carrier_mat d d. partial_density_operator \}" lemma denote_density_states: "\ \ density_states \ well_com S \ denote S \ \ density_states" by (simp add: denote_dim_pdo density_states_def) definition is_quantum_predicate :: "complex mat \ bool" where "is_quantum_predicate P \ P \ carrier_mat d d \ positive P \ P \\<^sub>L 1\<^sub>m d" lemma trace_measurement2: assumes m: "measurement n 2 M" and dA: "A \ carrier_mat n n" shows "trace ((M 0) * A * adjoint (M 0)) + trace ((M 1) * A * adjoint (M 1)) = trace A" proof - from m have dM0: "M 0 \ carrier_mat n n" and dM1: "M 1 \ carrier_mat n n" and id: "adjoint (M 0) * (M 0) + adjoint (M 1) * (M 1) = 1\<^sub>m n" using measurement_def measurement_id2 by auto have "trace (M 1 * A * adjoint (M 1)) + trace (M 0 * A * adjoint (M 0)) = trace ((adjoint (M 0) * M 0 + adjoint (M 1) * M 1) * A)" using dM0 dM1 dA by (mat_assoc n) also have "\ = trace (1\<^sub>m n * A)" using id by auto also have "\ = trace A" using dA by auto finally show ?thesis using dA dM0 dM1 local.id state_sig.trace_measure2_id by blast qed lemma qp_close_under_unitary_operator: fixes U P :: "complex mat" assumes dU: "U \ carrier_mat d d" and u: "unitary U" and qp: "is_quantum_predicate P" shows "is_quantum_predicate (adjoint U * P * U)" unfolding is_quantum_predicate_def proof (auto) have dP: "P \ carrier_mat d d" using qp is_quantum_predicate_def by auto show "adjoint U * P * U \ carrier_mat d d" using dU dP by fastforce have "positive P" using qp is_quantum_predicate_def by auto then show "positive (adjoint U * P * U)" using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dU] dP, simplified adjoint_adjoint] by fastforce have "adjoint U * U = 1\<^sub>m d" apply (subgoal_tac "inverts_mat (adjoint U) U") subgoal unfolding inverts_mat_def using dU by auto using u unfolding unitary_def using inverts_mat_symm[OF dU adjoint_dim[OF dU]] by auto then have u': "adjoint U * 1\<^sub>m d * U = 1\<^sub>m d" using dU by auto have le: "P \\<^sub>L 1\<^sub>m d" using qp is_quantum_predicate_def by auto show "adjoint U * P * U \\<^sub>L 1\<^sub>m d" using lowner_le_keep_under_measurement[OF dU dP one_carrier_mat le] u' by auto qed lemma qps_after_measure_is_qp: assumes m: "measurement d n M " and qpk: "\k. k < n \ is_quantum_predicate (P k)" shows "is_quantum_predicate (matrix_sum d (\k. adjoint (M k) * P k * M k) n)" unfolding is_quantum_predicate_def proof (auto) have dMk: "k < n \ M k \ carrier_mat d d" for k using m measurement_def by auto moreover have dPk: "k < n \ P k \ carrier_mat d d" for k using qpk is_quantum_predicate_def by auto ultimately have dk: "k < n \ adjoint (M k) * P k * M k \ carrier_mat d d" for k by fastforce then show d: "matrix_sum d (\k. adjoint (M k) * P k * M k) n \ carrier_mat d d" using matrix_sum_dim[of n "\k. adjoint (M k) * P k * M k"] by auto have "k < n \ positive (P k)" for k using qpk is_quantum_predicate_def by auto then have "k < n \ positive (adjoint (M k) * P k * M k)" for k using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dMk] dPk, simplified adjoint_adjoint] by fastforce then show "positive (matrix_sum d (\k. adjoint (M k) * P k * M k) n)" using matrix_sum_positive dk by auto have "k < n \ P k \\<^sub>L 1\<^sub>m d" for k using qpk is_quantum_predicate_def by auto then have "k < n \ positive (1\<^sub>m d - P k)" for k using lowner_le_def by auto then have p: "k < n \ positive (adjoint (M k) * (1\<^sub>m d - P k) * M k)" for k using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dMk], simplified adjoint_adjoint, of _ "1\<^sub>m d - P k"] dPk by fastforce { fix k assume k: "k < n" have "adjoint (M k) * (1\<^sub>m d - P k) * M k = adjoint (M k) * M k - adjoint (M k) * P k * M k" apply (mat_assoc d) using dMk dPk k by auto } note split = this have dk': "k < n \ adjoint (M k) * M k - adjoint (M k) * P k * M k \ carrier_mat d d" for k using dMk dPk by fastforce have "k < n \ positive (adjoint (M k) * M k - adjoint (M k) * P k * M k)" for k using p split by auto then have p': "positive (matrix_sum d (\k. adjoint (M k) * M k - adjoint (M k) * P k * M k) n)" using matrix_sum_positive[OF dk', of n id, simplified] by auto have daMMk: "k < n \ adjoint (M k) * M k \ carrier_mat d d" for k using dMk by fastforce have daMPMk: "k < n \ adjoint (M k) * P k * M k \ carrier_mat d d" for k using dMk dPk by fastforce have "matrix_sum d (\k. adjoint (M k) * M k - adjoint (M k) * P k * M k) n = matrix_sum d (\k. adjoint (M k) * M k) n - matrix_sum d (\k. adjoint (M k) * P k * M k) n" using matrix_sum_minus_distrib[OF daMMk daMPMk] by auto also have "\ = 1\<^sub>m d - matrix_sum d (\k. adjoint (M k) * P k * M k) n" using m measurement_def by auto finally have "positive (1\<^sub>m d - matrix_sum d (\k. adjoint (M k) * P k * M k) n)" using p' by auto then show "matrix_sum d (\k. adjoint (M k) * P k * M k) n \\<^sub>L 1\<^sub>m d" using lowner_le_def d by auto qed definition hoare_total_correct :: "complex mat \ com \ complex mat \ bool" ("\\<^sub>t {(1_)}/ (_)/ {(1_)}" 50) where "\\<^sub>t {P} S {Q} \ (\\\density_states. trace (P * \) \ trace (Q * denote S \))" definition hoare_partial_correct :: "complex mat \ com \ complex mat \ bool" ("\\<^sub>p {(1_)}/ (_)/ {(1_)}" 50) where "\\<^sub>p {P} S {Q} \ (\\\density_states. trace (P * \) \ trace (Q * denote S \) + (trace \ - trace (denote S \)))" (* Proposition 6.1 (1) *) lemma total_implies_partial: assumes S: "well_com S" and total: "\\<^sub>t {P} S {Q}" shows "\\<^sub>p {P} S {Q}" proof - have "trace (P * \) \ trace (Q * denote S \) + (trace \ - trace (denote S \))" if \: "\ \ density_states" for \ proof - have "trace (P * \) \ trace (Q * denote S \)" using total hoare_total_correct_def \ by auto moreover have "trace (denote S \) \ trace \" using denote_trace[OF S] \ density_states_def by auto - ultimately show ?thesis by auto + ultimately show ?thesis by (auto simp: less_eq_complex_def) qed then show ?thesis using hoare_partial_correct_def by auto qed lemma predicate_prob_positive: assumes "0\<^sub>m d d \\<^sub>L P" and "\ \ density_states" shows "0 \ trace (P * \)" proof - have "trace (0\<^sub>m d d * \) \ trace (P * \)" apply (rule lowner_le_traceD) using assms unfolding lowner_le_def density_states_def by auto then show ?thesis using assms(2) density_states_def by auto qed (* Proposition 6.1 (2a) *) lemma total_pre_zero: assumes S: "well_com S" and Q: "is_quantum_predicate Q" shows "\\<^sub>t {0\<^sub>m d d} S {Q}" proof - have "trace (0\<^sub>m d d * \) \ trace (Q * denote S \)" if \: "\ \ density_states" for \ proof - have 1: "trace (0\<^sub>m d d * \) = 0" using \ unfolding density_states_def by auto show ?thesis apply (subst 1) apply (rule predicate_prob_positive) subgoal apply (simp add: lowner_le_def, subgoal_tac "Q - 0\<^sub>m d d = Q") using Q is_quantum_predicate_def[of Q] by auto subgoal using denote_density_states \ S by auto done qed then show ?thesis using hoare_total_correct_def by auto qed (* Proposition 6.1 (2b) *) lemma partial_post_identity: assumes S: "well_com S" and P: "is_quantum_predicate P" shows "\\<^sub>p {P} S {1\<^sub>m d}" proof - have "trace (P * \) \ trace (1\<^sub>m d * denote S \) + (trace \ - trace (denote S \))" if \: "\ \ density_states" for \ proof - have "denote S \ \ carrier_mat d d" using S denote_dim \ density_states_def by auto then have "trace (1\<^sub>m d * denote S \) = trace (denote S \)" by auto moreover have "trace (P * \) \ trace (1\<^sub>m d * \)" apply (rule lowner_le_traceD) using \ unfolding density_states_def apply auto using P is_quantum_predicate_def by auto ultimately show ?thesis using density_states_def that by auto qed then show ?thesis using hoare_partial_correct_def by auto qed subsection \Weakest liberal preconditions\ definition is_weakest_liberal_precondition :: "complex mat \ com \ complex mat \ bool" where "is_weakest_liberal_precondition W S P \ is_quantum_predicate W \ \\<^sub>p {W} S {P} \ (\Q. is_quantum_predicate Q \ \\<^sub>p {Q} S {P} \ Q \\<^sub>L W)" definition wlp_measure :: "nat \ (nat \ complex mat) \ ((complex mat \ complex mat) list) \ complex mat \ complex mat" where "wlp_measure n M WS P = matrix_sum d (\k. adjoint (M k) * ((WS!k) P) * (M k)) n" fun wlp_while_n :: "complex mat \ complex mat \ (complex mat \ complex mat) \ nat \ complex mat \ complex mat" where "wlp_while_n M0 M1 WS 0 P = 1\<^sub>m d" | "wlp_while_n M0 M1 WS (Suc n) P = adjoint M0 * P * M0 + adjoint M1 * (WS (wlp_while_n M0 M1 WS n P)) * M1" lemma measurement2_leq_one_mat: assumes dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" and leP: "P \\<^sub>L 1\<^sub>m d" and leQ: "Q \\<^sub>L 1\<^sub>m d" and m: "measurement d 2 M" shows "(adjoint (M 0) * P * (M 0) + adjoint (M 1) * Q * (M 1)) \\<^sub>L 1\<^sub>m d" proof - define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using m M0_def M1_def measurement_def by auto have "adjoint M1 * Q * M1 \\<^sub>L adjoint M1 * 1\<^sub>m d * M1" using lowner_le_keep_under_measurement[OF dM1 dQ _ leQ] by auto then have le1: "adjoint M1 * Q * M1 \\<^sub>L adjoint M1 * M1" using dM1 dQ by fastforce have "adjoint M0 * P * M0 \\<^sub>L adjoint M0 * 1\<^sub>m d * M0" using lowner_le_keep_under_measurement[OF dM0 dP _ leP] by auto then have le0: "adjoint M0 * P * M0 \\<^sub>L adjoint M0 * M0" using dM0 dP by fastforce have "adjoint M0 * P * M0 + adjoint M1 * Q * M1 \\<^sub>L adjoint M0 * M0 + adjoint M1 * M1" apply (rule lowner_le_add[of "adjoint M0 * P * M0" d "adjoint M0 * M0" "adjoint M1 * Q * M1" "adjoint M1 * M1"]) using dM0 dP dM1 dQ le0 le1 by auto also have "\ = 1\<^sub>m d" using m M0_def M1_def measurement_id2 by auto finally show "adjoint M0 * P * M0 + adjoint M1 * Q * M1 \\<^sub>L 1\<^sub>m d". qed lemma wlp_while_n_close: assumes close: "\P. is_quantum_predicate P \ is_quantum_predicate (WS P)" and m: "measurement d 2 M" and qpP: "is_quantum_predicate P" shows "is_quantum_predicate (wlp_while_n (M 0) (M 1) WS k P)" proof (induct k) case 0 then show ?case unfolding wlp_while_n.simps is_quantum_predicate_def using positive_one[of d] lowner_le_refl[of "1\<^sub>m d"] by fastforce next case (Suc k) define M0 where "M0 = M 0" define M1 where "M1 = M 1" define W where "W k = wlp_while_n M0 M1 WS k P" for k show ?case unfolding wlp_while_n.simps is_quantum_predicate_def proof (fold M0_def M1_def, fold W_def, auto) have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using m M0_def M1_def measurement_def by auto have dP: "P \ carrier_mat d d" using qpP is_quantum_predicate_def by auto have qpWk: "is_quantum_predicate (W k)" using Suc M0_def M1_def W_def by auto then have qpWWk: "is_quantum_predicate (WS (W k))" using close by auto from qpWk have dWk: "W k \ carrier_mat d d" using is_quantum_predicate_def by auto from qpWWk have dWWk: "WS (W k) \ carrier_mat d d" using is_quantum_predicate_def by auto show "adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1 \ carrier_mat d d" using dM0 dP dM1 dWWk by auto have pP: "positive P" using qpP is_quantum_predicate_def by auto then have pM0P: "positive (adjoint M0 * P * M0)" using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM0]] dM0 dP adjoint_adjoint[of M0] by auto have pWWk: "positive (WS (W k))" using qpWWk is_quantum_predicate_def by auto then have pM1WWk: "positive (adjoint M1 * WS (W k) * M1)" using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM1]] dM1 dWWk adjoint_adjoint[of M1] by auto then show "positive (adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1)" using positive_add[OF pM0P pM1WWk] dM0 dP dM1 dWWk by fastforce have leWWk: "WS (W k) \\<^sub>L 1\<^sub>m d" using qpWWk is_quantum_predicate_def by auto have leP: "P \\<^sub>L 1\<^sub>m d" using qpP is_quantum_predicate_def by auto show "(adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1) \\<^sub>L 1\<^sub>m d " using measurement2_leq_one_mat[OF dP dWWk leP leWWk m] M0_def M1_def by auto qed qed lemma wlp_while_n_mono: assumes "\P. is_quantum_predicate P \ is_quantum_predicate (WS P)" and "\P Q. is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ WS P \\<^sub>L WS Q" and "measurement d 2 M" and "is_quantum_predicate P" and "is_quantum_predicate Q" and "P \\<^sub>L Q" shows "(wlp_while_n (M 0) (M 1) WS k P) \\<^sub>L (wlp_while_n (M 0) (M 1) WS k Q)" proof (induct k) case 0 then show ?case unfolding wlp_while_n.simps using lowner_le_refl[of "1\<^sub>m d"] by fastforce next case (Suc k) define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using assms M0_def M1_def measurement_def by auto define W where "W P k = wlp_while_n M0 M1 WS k P" for k P have dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" using assms is_quantum_predicate_def by auto have eq1: "W P (Suc k) = adjoint M0 * P * M0 + adjoint M1 * (WS (W P k)) * M1" unfolding W_def wlp_while_n.simps by auto have eq2: "W Q (Suc k) = adjoint M0 * Q * M0 + adjoint M1 * (WS (W Q k)) * M1" unfolding W_def wlp_while_n.simps by auto have le1: "adjoint M0 * P * M0 \\<^sub>L adjoint M0 * Q * M0" using lowner_le_keep_under_measurement dM0 dP dQ assms by auto have leWk: "(W P k) \\<^sub>L (W Q k)" unfolding W_def M0_def M1_def using Suc by auto have qpWPk: "is_quantum_predicate (W P k)" unfolding W_def M0_def M1_def using wlp_while_n_close assms by auto then have "is_quantum_predicate (WS (W P k))" unfolding W_def M0_def M1_def using assms by auto then have dWWPk: "(WS (W P k)) \ carrier_mat d d" using is_quantum_predicate_def by auto have qpWQk: "is_quantum_predicate (W Q k)" unfolding W_def M0_def M1_def using wlp_while_n_close assms by auto then have "is_quantum_predicate (WS (W Q k))" unfolding W_def M0_def M1_def using assms by auto then have dWWQk: "(WS (W Q k)) \ carrier_mat d d" using is_quantum_predicate_def by auto have "(WS (W P k)) \\<^sub>L (WS (W Q k))" using qpWPk qpWQk leWk assms by auto then have le2: "adjoint M1 * (WS (W P k)) * M1 \\<^sub>L adjoint M1 * (WS (W Q k)) * M1" using lowner_le_keep_under_measurement dM1 dWWPk dWWQk by auto have "(adjoint M0 * P * M0 + adjoint M1 * (WS (W P k)) * M1) \\<^sub>L (adjoint M0 * Q * M0 + adjoint M1 * (WS (W Q k)) * M1)" using lowner_le_add[OF _ _ _ _ le1 le2] dM0 dP dM1 dQ dWWPk dWWQk le1 le2 by fastforce then have "W P (Suc k) \\<^sub>L W Q (Suc k)" using eq1 eq2 by auto then show ?case unfolding W_def M0_def M1_def by auto qed definition wlp_while :: "complex mat \ complex mat \ (complex mat \ complex mat) \ complex mat \ complex mat" where "wlp_while M0 M1 WS P = (THE Q. limit_mat (\n. wlp_while_n M0 M1 WS n P) Q d)" lemma wlp_while_exists: assumes "\P. is_quantum_predicate P \ is_quantum_predicate (WS P)" and "\P Q. is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ WS P \\<^sub>L WS Q" and m: "measurement d 2 M" and qpP: "is_quantum_predicate P" shows "is_quantum_predicate (wlp_while (M 0) (M 1) WS P) \ (\n. (wlp_while (M 0) (M 1) WS P) \\<^sub>L (wlp_while_n (M 0) (M 1) WS n P)) \ (\W'. (\n. W' \\<^sub>L (wlp_while_n (M 0) (M 1) WS n P)) \ W' \\<^sub>L (wlp_while (M 0) (M 1) WS P)) \ limit_mat (\n. wlp_while_n (M 0) (M 1) WS n P) (wlp_while (M 0) (M 1) WS P) d" proof (auto) define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using assms M0_def M1_def measurement_def by auto define W where "W k = wlp_while_n M0 M1 WS k P" for k have leP: "P \\<^sub>L 1\<^sub>m d" and dP: "P \ carrier_mat d d" and pP: "positive P" using qpP is_quantum_predicate_def by auto have pM0P: "positive (adjoint M0 * P * M0)" using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM0]] adjoint_adjoint[of "M0"] dP pP by auto have le_qp: "W (Suc k) \\<^sub>L W k \ is_quantum_predicate (W k)" for k proof (induct k) case 0 have "is_quantum_predicate (1\<^sub>m d)" unfolding is_quantum_predicate_def using positive_one lowner_le_refl[of "1\<^sub>m d"] by fastforce then have "is_quantum_predicate (WS (1\<^sub>m d))" using assms by auto then have "(WS (1\<^sub>m d)) \ carrier_mat d d" and "(WS (1\<^sub>m d)) \\<^sub>L 1\<^sub>m d" using is_quantum_predicate_def by auto then have "W 1 \\<^sub>L W 0" unfolding W_def wlp_while_n.simps M0_def M1_def using measurement2_leq_one_mat[OF dP _ leP _ m] by auto moreover have "is_quantum_predicate (W 0)" unfolding W_def wlp_while_n.simps is_quantum_predicate_def using positive_one lowner_le_refl[of "1\<^sub>m d"] by fastforce ultimately show ?case by auto next case (Suc k) then have leWSk: "W (Suc k) \\<^sub>L W k" and qpWk: "is_quantum_predicate (W k)" by auto then have "is_quantum_predicate (WS (W k))" using assms by auto then have dWWk: "WS (W k) \ carrier_mat d d" and leWWk1: "(WS (W k)) \\<^sub>L 1\<^sub>m d" and pWWk: "positive (WS (W k))" using is_quantum_predicate_def by auto then have leWSk1: "W (Suc k) \\<^sub>L 1\<^sub>m d" using measurement2_leq_one_mat[OF dP dWWk leP leWWk1 m] unfolding W_def wlp_while_n.simps M0_def M1_def by auto then have dWSk: "W (Suc k) \ carrier_mat d d" using lowner_le_def by fastforce have pM1WWk: "positive (adjoint M1 * (WS (W k)) * M1)" using positive_close_under_left_right_mult_adjoint[OF adjoint_dim[OF dM1] dWWk pWWk] adjoint_adjoint[of "M1"] by auto have pWSk: "positive (W (Suc k))" unfolding W_def wlp_while_n.simps apply (fold W_def) using positive_add[OF pM0P pM1WWk] dM0 dP dM1 by fastforce have qpWSk:"is_quantum_predicate (W (Suc k))" unfolding is_quantum_predicate_def using dWSk pWSk leWSk1 by auto then have qpWWSk: "is_quantum_predicate (WS (W (Suc k)))" using assms(1) by auto then have dWWSk: "(WS (W (Suc k))) \ carrier_mat d d" using is_quantum_predicate_def by auto have "WS (W (Suc k)) \\<^sub>L WS (W k)" using assms(2)[OF qpWSk qpWk] leWSk by auto then have "adjoint M1 * WS (W (Suc k)) * M1 \\<^sub>L adjoint M1 * WS (W k) * M1" using lowner_le_keep_under_measurement[OF dM1 dWWSk dWWk] by auto then have "(adjoint M0 * P * M0 + adjoint M1 * WS (W (Suc k)) * M1) \\<^sub>L (adjoint M0 * P * M0 + adjoint M1 * WS (W k) * M1)" using lowner_le_add[of _ d _ "adjoint M1 * WS (W (Suc k)) * M1" "adjoint M1 * WS (W k) * M1", OF _ _ _ _ lowner_le_refl[of "adjoint M0 * P * M0"]] dM0 dM1 dP dWWSk dWWk by fastforce then have "W (Suc (Suc k)) \\<^sub>L W (Suc k)" unfolding W_def wlp_while_n.simps by auto with qpWSk show ?case by auto qed then have dWk: "W k \ carrier_mat d d" for k using is_quantum_predicate_def by auto then have dmWk: "- W k \ carrier_mat d d" for k by auto have incmWk: "- (W k) \\<^sub>L - (W (Suc k))" for k using lowner_le_swap[of "W (Suc k)" d "W k"] dWk le_qp by auto have pWk: "positive (W k)" for k using le_qp is_quantum_predicate_def by auto have ubmWk: "- W k \\<^sub>L 0\<^sub>m d d" for k proof - have "0\<^sub>m d d \\<^sub>L W k" for k using zero_lowner_le_positiveI dWk pWk by auto then have "- W k \\<^sub>L - 0\<^sub>m d d" for k using lowner_le_swap[of "0\<^sub>m d d" d "W k"] dWk by auto moreover have "(- 0\<^sub>m d d :: complex mat) = (0\<^sub>m d d)" by auto ultimately show ?thesis by auto qed have "\B. lowner_is_lub (\k. - W k) B \ limit_mat (\k. - W k) B d" using mat_inc_seq_lub[of "\k. - W k" d "0\<^sub>m d d"] dmWk incmWk ubmWk by auto then obtain B where lubB: "lowner_is_lub (\k. - W k) B" and limB: "limit_mat (\k. - W k) B d" by auto then have dB: "B \ carrier_mat d d" using limit_mat_def by auto define A where "A = - B" then have dA: "A \ carrier_mat d d" using dB by auto have "limit_mat (\k. (-1) \\<^sub>m (- W k)) (-1 \\<^sub>m B) d" using limit_mat_scale[OF limB] by auto moreover have "W k = -1 \\<^sub>m (- W k)" for k using dWk by auto moreover have "-1 \\<^sub>m B = - B" by auto ultimately have limA: "limit_mat W A d" using A_def by auto moreover have "(limit_mat W A' d \ A' = A)" for A' using limit_mat_unique[of W A d] limA by auto ultimately have eqA: "(wlp_while (M 0) (M 1) WS P) = A" unfolding wlp_while_def W_def M0_def M1_def using the_equality[of "\X. limit_mat (\n. wlp_while_n (M 0) (M 1) WS n P) X d" A] by fastforce show "limit_mat (\n. wlp_while_n (M 0) (M (Suc 0)) WS n P) (wlp_while (M 0) (M (Suc 0)) WS P) d" using limA eqA unfolding W_def M0_def M1_def by auto have "- W k \\<^sub>L B" for k using lubB lowner_is_lub_def by auto then have glbA: "A \\<^sub>L W k" for k unfolding A_def using lowner_le_swap[of "- W k" d] dB dWk by fastforce then show "\n. wlp_while (M 0) (M (Suc 0)) WS P \\<^sub>L wlp_while_n (M 0) (M (Suc 0)) WS n P" using eqA unfolding W_def M0_def M1_def by auto have "W k \\<^sub>L 1\<^sub>m d" for k using le_qp unfolding is_quantum_predicate_def by auto then have "positive (1\<^sub>m d - W k)" for k using lowner_le_def by auto moreover have "limit_mat (\k. 1\<^sub>m d - W k) (1\<^sub>m d - A) d" using mat_minus_limit limA by auto ultimately have "positive (1\<^sub>m d - A)" using pos_mat_lim_is_pos by auto then have leA1: "A \\<^sub>L 1\<^sub>m d" using dA lowner_le_def by auto have pA: "positive A" using pos_mat_lim_is_pos limA pWk by auto show "is_quantum_predicate (wlp_while (M 0) (M (Suc 0)) WS P)" unfolding is_quantum_predicate_def using pA dA leA1 eqA by auto { fix W' assume asmW': "\k. W' \\<^sub>L W k" then have dW': "W' \ carrier_mat d d" unfolding lowner_le_def using carrier_matD[OF dWk] by auto then have "- W k \\<^sub>L - W'" for k using lowner_le_swap dWk asmW' by auto then have "B \\<^sub>L - W'" using lubB unfolding lowner_is_lub_def by auto then have "W' \\<^sub>L A" unfolding A_def using lowner_le_swap[of "B" d "- W'"] dB dW' by auto then have "W' \\<^sub>L wlp_while (M 0) (M 1) WS P" using eqA by auto } then show "\W'. \n. W' \\<^sub>L wlp_while_n (M 0) (M (Suc 0)) WS n P \ W' \\<^sub>L wlp_while (M 0) (M (Suc 0)) WS P" unfolding W_def M0_def M1_def by auto qed lemma wlp_while_mono: assumes "\P. is_quantum_predicate P \ is_quantum_predicate (WS P)" and "\P Q. is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ WS P \\<^sub>L WS Q" and "measurement d 2 M" and "is_quantum_predicate P" and "is_quantum_predicate Q" and "P \\<^sub>L Q" shows "wlp_while (M 0) (M 1) WS P \\<^sub>L wlp_while (M 0) (M 1) WS Q" proof - define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using assms M0_def M1_def measurement_def by auto define Wn where "Wn P k = wlp_while_n M0 M1 WS k P" for P k define W where "W P = wlp_while M0 M1 WS P" for P have lePQk: "Wn P k \\<^sub>L Wn Q k" for k unfolding Wn_def M0_def M1_def using wlp_while_n_mono assms by auto have "is_quantum_predicate (Wn P k)" for k unfolding Wn_def M0_def M1_def using wlp_while_n_close assms by auto then have dWPk: "Wn P k \ carrier_mat d d" for k using is_quantum_predicate_def by auto have "is_quantum_predicate (Wn Q k)" for k unfolding Wn_def M0_def M1_def using wlp_while_n_close assms by auto then have dWQk:"Wn Q k \ carrier_mat d d" for k using is_quantum_predicate_def by auto have "is_quantum_predicate (W P)" and lePk: "(W P) \\<^sub>L (Wn P k)" and "limit_mat (Wn P) (W P) d" for k unfolding W_def Wn_def M0_def M1_def using wlp_while_exists assms by auto then have dWP: "W P \ carrier_mat d d" using is_quantum_predicate_def by auto have "is_quantum_predicate (W Q)" and "(W Q) \\<^sub>L (Wn Q k)" and glb:"(\k. W' \\<^sub>L (Wn Q k)) \ W' \\<^sub>L (W Q)" and "limit_mat (Wn Q) (W Q) d" for k W' unfolding W_def Wn_def M0_def M1_def using wlp_while_exists assms by auto have "W P \\<^sub>L Wn Q k" for k using lowner_le_trans[of "W P" d "Wn P k" "Wn Q k"] lePk lePQk dWPk dWQk dWP by auto then show "W P \\<^sub>L W Q" using glb by auto qed fun wlp :: "com \ complex mat \ complex mat" where "wlp SKIP P = P" | "wlp (Utrans U) P = adjoint U * P * U" | "wlp (Seq S1 S2) P = wlp S1 (wlp S2 P)" | "wlp (Measure n M S) P = wlp_measure n M (map wlp S) P" | "wlp (While M S) P = wlp_while (M 0) (M 1) (wlp S) P" lemma wlp_measure_expand_m: assumes m: "m \ n" and wc: "well_com (Measure n M S)" shows "wlp (Measure m M S) P = matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * (M k)) m" unfolding wlp.simps wlp_measure_def proof - have "k < m \ map wlp S ! k = wlp (S!k)" for k using wc m by auto then have "k < m \ (map wlp S ! k) P = wlp (S!k) P" for k by auto then show "matrix_sum d (\k. adjoint (M k) * ((map wlp S ! k) P) * (M k)) m = matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * (M k)) m" using matrix_sum_cong[of m "\k. adjoint (M k) * ((map wlp S ! k) P) * (M k)" "\k. adjoint (M k) * (wlp (S!k) P) * (M k)"] by auto qed lemma wlp_measure_expand: assumes wc: "well_com (Measure n M S)" shows "wlp (Measure n M S) P = matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * (M k)) n" using wlp_measure_expand_m[OF Nat.le_refl[of n]] wc by auto lemma wlp_mono_and_close: shows "well_com S \ is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ is_quantum_predicate (wlp S P) \ wlp S P \\<^sub>L wlp S Q" proof (induct S arbitrary: P Q) case SKIP then show ?case by auto next case (Utrans U) then have dU: "U \ carrier_mat d d" and u: "unitary U" and qp: "is_quantum_predicate P" and le: "P \\<^sub>L Q" and dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" using is_quantum_predicate_def by auto then have qp': "is_quantum_predicate (wlp (Utrans U) P)" using qp_close_under_unitary_operator by auto moreover have "adjoint U * P * U \\<^sub>L adjoint U * Q * U" using lowner_le_keep_under_measurement[OF dU dP dQ le] by auto ultimately show ?case by auto next case (Seq S1 S2) then have qpP: "is_quantum_predicate P" and qpQ: "is_quantum_predicate Q" and wc1: "well_com S1" and wc2: "well_com S2" and dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" and le: "P \\<^sub>L Q"using is_quantum_predicate_def by auto have qpP2: "is_quantum_predicate (wlp S2 P)" using Seq qpP wc2 by auto have qpQ2: "is_quantum_predicate (wlp S2 Q)" using Seq(2)[OF wc2 qpQ qpQ] lowner_le_refl dQ by blast have qpP1: "is_quantum_predicate (wlp S1 (wlp S2 P))" using Seq(1)[OF wc1 qpP2 qpP2] qpP2 is_quantum_predicate_def[of "wlp S2 P"] lowner_le_refl by auto have "wlp S2 P \\<^sub>L wlp S2 Q" using Seq(2) wc2 qpP qpQ le by auto then have "wlp S1 (wlp S2 P) \\<^sub>L wlp S1 (wlp S2 Q)" using Seq(1) wc1 qpP2 qpQ2 by auto then show ?case using qpP1 by auto next case (Measure n M S) then have wc: "well_com (Measure n M S)" and wck: "k < n \ well_com (S!k)" and l: "length S = n" and m: "measurement d n M" and le: "P \\<^sub>L Q" and qpP: "is_quantum_predicate P" and dP: "P \ carrier_mat d d" and qpQ: "is_quantum_predicate Q" and dQ: "Q \ carrier_mat d d" for k using measure_well_com is_quantum_predicate_def by auto have dMk: "k < n \ M k \ carrier_mat d d" for k using m measurement_def by auto have set: "k < n \ S!k \ set S" for k using l by auto have qpk: "k < n \ is_quantum_predicate (wlp (S!k) P)" for k using Measure(1)[OF set wck qpP qpP] lowner_le_refl[of P] dP by auto then have dWkP: "k < n \ wlp (S!k) P \ carrier_mat d d" for k using is_quantum_predicate_def by auto then have dMkP: "k < n \ adjoint (M k) * (wlp (S!k) P) * (M k) \ carrier_mat d d" for k using dMk by fastforce have "k < n \ is_quantum_predicate (wlp (S!k) Q)" for k using Measure(1)[OF set wck qpQ qpQ] lowner_le_refl[of Q] dQ by auto then have dWkQ: "k < n \ wlp (S!k) Q \ carrier_mat d d" for k using is_quantum_predicate_def by auto then have dMkQ: "k < n \ adjoint (M k) * (wlp (S!k) Q) * (M k) \ carrier_mat d d" for k using dMk by fastforce have "k < n \ wlp (S!k) P \\<^sub>L wlp (S!k) Q" for k using Measure(1)[OF set wck qpP qpQ le] by auto then have "k < n \ adjoint (M k) * (wlp (S!k) P) * (M k) \\<^sub>L adjoint (M k) * (wlp (S!k) Q) * (M k)" for k using lowner_le_keep_under_measurement[OF dMk dWkP dWkQ] by auto then have le': "wlp (Measure n M S) P \\<^sub>L wlp (Measure n M S) Q" unfolding wlp_measure_expand[OF wc] using lowner_le_matrix_sum dMkP dMkQ by auto have qp': "is_quantum_predicate (wlp (Measure n M S) P)" unfolding wlp_measure_expand[OF wc] using qps_after_measure_is_qp[OF m] qpk by auto show ?case using le' qp' by auto next case (While M S) then have m: "measurement d 2 M" and wcs: "well_com S" and qpP: "is_quantum_predicate P" by auto have closeWS: "is_quantum_predicate P \ is_quantum_predicate (wlp S P)" for P proof - assume asm: "is_quantum_predicate P" then have dP: "P \ carrier_mat d d" using is_quantum_predicate_def by auto then show "is_quantum_predicate (wlp S P)" using While(1)[OF wcs asm asm lowner_le_refl] dP by auto qed have monoWS: "is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ wlp S P \\<^sub>L wlp S Q" for P Q using While(1)[OF wcs] by auto have "is_quantum_predicate (wlp (While M S) P)" using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto moreover have "wlp (While M S) P \\<^sub>L wlp (While M S) Q" using wlp_while_mono[of "wlp S" M P Q] closeWS monoWS m While by auto ultimately show ?case by auto qed lemma wlp_close: assumes wc: "well_com S" and qp: "is_quantum_predicate P" shows "is_quantum_predicate (wlp S P)" using wlp_mono_and_close[OF wc qp qp] is_quantum_predicate_def[of P] qp lowner_le_refl by auto lemma wlp_soundness: "well_com S \ (\P. (is_quantum_predicate P \ (\\ \ density_states. trace (wlp S P * \) = trace (P * (denote S \)) + trace \ - trace (denote S \))))" proof (induct S) case SKIP then show ?case by auto next case (Utrans U) then have dU: "U \ carrier_mat d d" and u: "unitary U" and wc: "well_com (Utrans U)" and qp: "is_quantum_predicate P" and dP: "P \ carrier_mat d d" using is_quantum_predicate_def by auto have qp': "is_quantum_predicate (wlp (Utrans U) P)" using wlp_close[OF wc qp] by auto have eq1: "trace (adjoint U * P * U * \) = trace (P * (U * \ * adjoint U))" if dr: "\ \ carrier_mat d d" for \ using dr dP apply (mat_assoc d) using wc by auto have eq2: "trace (U * \ * adjoint U) = trace \" if dr: "\ \ carrier_mat d d" for \ using unitary_operator_keep_trace[OF adjoint_dim[OF dU] dr unitary_adjoint[OF dU u]] adjoint_adjoint[of U] by auto show ?case using qp' eq1 eq2 density_states_def by auto next case (Seq S1 S2) then have qp: "is_quantum_predicate P" and wc1: "well_com S1" and wc2: "well_com S2" by auto then have qp2: "is_quantum_predicate (wlp S2 P)" using wlp_close by auto then have qp1: "is_quantum_predicate (wlp S1 (wlp S2 P))" using wlp_close wc1 by auto have eq1: "trace (wlp S2 P * \) = trace (P * denote S2 \) + trace \ - trace (denote S2 \)" if ds: "\ \ density_states" for \ using Seq(2) wc2 qp ds by auto have eq2: "trace (wlp S1 (wlp S2 P) * \) = trace ((wlp S2 P) * denote S1 \) + trace \ - trace (denote S1 \)" if ds: "\ \ density_states" for \ using Seq(1) wc1 qp2 ds by auto have eq3: "trace (wlp S1 (wlp S2 P) * \) = trace (P * (denote S2 (denote S1 \))) + trace \ - trace (denote S2 (denote S1 \))" if ds: "\ \ density_states" for \ proof - have "denote S1 \ \ density_states" using ds denote_density_states wc1 by auto then have "trace ((wlp S2 P) * denote S1 \) = trace (P * denote S2 (denote S1 \)) + trace (denote S1 \) - trace (denote S2 (denote S1 \))" using eq1 by auto then show "trace (wlp S1 (wlp S2 P) * \) = trace (P * (denote S2 (denote S1 \))) + trace \ - trace (denote S2 (denote S1 \))" using eq2 ds by auto qed then show ?case using qp1 by auto next case (Measure n M S) then have wc: "well_com (Measure n M S)" and wck: "k < n \ well_com (S!k)" and qpP: "is_quantum_predicate P" and dP: "P \ carrier_mat d d" and qpWk: "k < n \ is_quantum_predicate (wlp (S!k) P)" and dWk: "k < n \ (wlp (S!k) P) \ carrier_mat d d" and c: "k < n \ \ \ density_states \ trace (wlp (S!k) P * \) = trace (P * denote (S!k) \) + trace \ - trace (denote (S!k) \)" and m: "measurement d n M" and aMMkleq: "k < n \ adjoint (M k) * M k \\<^sub>L 1\<^sub>m d" and dMk: "k < n \ M k \ carrier_mat d d" for k \ using is_quantum_predicate_def measurement_def measure_well_com measurement_le_one_mat wlp_close by auto { fix \ assume \: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto have dsr: "k < n \ (M k) * \ * adjoint (M k) \ density_states" for k unfolding density_states_def using dMk pdo_close_under_measurement[OF dMk dr pdor aMMkleq] dr by fastforce then have leqk: "k < n \ trace (wlp (S!k) P * ((M k) * \ * adjoint (M k))) = trace (P * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))" for k using c by auto have "k < n \ M k * \ * adjoint (M k) \ carrier_mat d d" for k using dMk dr by fastforce then have dsMrk: "k < n \ matrix_sum d (\k. (M k * \ * adjoint (M k))) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. (M k * \ * adjoint (M k))" d] by fastforce have "k < n \ adjoint (M k) * (wlp (S!k) P) * M k \ carrier_mat d d" for k using dMk by fastforce then have dsMW: "k < n \ matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. adjoint (M k) * (wlp (S!k) P) * M k" d] by fastforce have dSMrk: "k < n \ denote (S ! k) (M k * \ * adjoint (M k)) \ carrier_mat d d" for k using denote_dim[OF wck, of k "M k * \ * adjoint (M k)"] dsr density_states_def by fastforce have dsSMrk: "k < n \ matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. denote (S ! k) (M k * \ * adjoint (M k))" d, OF dSMrk] by fastforce have "k \ n \ trace (matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) k * \) = trace (P * (denote (Measure k M S) \)) + (trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) k) - trace (denote (Measure k M S) \))" for k unfolding denote_measure_expand[OF _ wc] proof (induct k) case 0 then show ?case unfolding matrix_sum.simps using dP dr by auto next case (Suc k) then have k: "k < n" by auto have eq1: "trace (matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) (Suc k) * \) = trace (adjoint (M k) * (wlp (S!k) P) * M k * \) + trace (matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) k * \)" unfolding matrix_sum.simps using dMk[OF k] dWk[OF k] dr dsMW[OF k] by (mat_assoc d) have "trace (adjoint (M k) * (wlp (S!k) P) * M k * \) = trace ((wlp (S!k) P) * (M k * \ * adjoint (M k)))" using dMk[OF k] dWk[OF k] dr by (mat_assoc d) also have "\ = trace (P * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))" using leqk k by auto finally have eq2: "trace (adjoint (M k) * (wlp (S!k) P) * M k * \) = trace (P * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))" . have eq3: "trace (P * matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) (Suc k)) = trace (P * (denote (S!k) (M k * \ * adjoint (M k)))) + trace (P * matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k)" unfolding matrix_sum.simps using dP dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d) have eq4: "trace (denote (S ! k) (M k * \ * adjoint (M k)) + matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k) = trace (denote (S ! k) (M k * \ * adjoint (M k))) + trace (matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k)" using dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d) show ?case apply (subst eq1) apply (subst eq3) apply (simp del: less_eq_complex_def) apply (subst trace_add_linear[of "M k * \ * adjoint (M k)" d "matrix_sum d (\k. M k * \ * adjoint (M k)) k"]) apply (simp add: dMk adjoint_dim[OF dMk] dr mult_carrier_mat[of _ d d _ d] k) apply (simp add: dsMrk k) apply (subst eq4) apply (insert eq2 Suc(1) k, fastforce) done qed then have leq: "trace (matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) n * \) = trace (P * denote (Measure n M S) \) + (trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) n) - trace (denote (Measure n M S) \))" by auto have "trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) n) = trace \" using trace_measurement m dr by auto with leq have "trace (matrix_sum d (\k. adjoint (M k) * (wlp (S!k) P) * M k) n * \) = trace (P * denote (Measure n M S) \) + (trace \ - trace (denote (Measure n M S) \))" unfolding denote_measure_def by auto } then show ?case unfolding wlp_measure_expand[OF wc] by auto next case (While M S) then have qpP: "is_quantum_predicate P" and dP: "P \ carrier_mat d d" and wcS: "well_com S" and m: "measurement d 2 M" and wc: "well_com (While M S)" using is_quantum_predicate_def by auto define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using m measurement_def M0_def M1_def by auto have leM1: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto define W where "W k = wlp_while_n M0 M1 (wlp S) k P" for k define DS where "DS = denote S" define D0 where "D0 = denote_while_n M0 M1 DS" define D1 where "D1 = denote_while_n_comp M0 M1 DS" define D where "D = denote_while_n_iter M0 M1 DS" have eqk: "\ \ density_states \ trace ((W k) * \) = (\k=0..))) + trace \ - (\k=0..))" for k \ proof (induct k arbitrary: \) case 0 then have dsr: "\ \ density_states" by auto show ?case unfolding W_def wlp_while_n.simps using dsr density_states_def by auto next case (Suc k) then have dsr: "\ \ density_states" and dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto then have dsM1r: "M1 * \ * adjoint M1 \ density_states" unfolding density_states_def using pdo_close_under_measurement[OF dM1 dr pdor leM1] dr dM1 by auto then have dsDSM1r: "(DS (M1 * \ * adjoint M1)) \ density_states" unfolding density_states_def DS_def using denote_dim[OF wcS] denote_partial_density_operator[OF wcS] dsM1r by auto have qpWk: "is_quantum_predicate (W k)" using wlp_while_n_close[OF _ m qpP, folded M0_def M1_def, of "wlp S", folded W_def] wlp_close[OF wcS] by auto then have "is_quantum_predicate (wlp S (W k))" using wlp_close[OF wcS] by auto then have dWWk: "wlp S (W k) \ carrier_mat d d" using is_quantum_predicate_def by auto have "trace (P * (M0 * \ * adjoint M0)) + (\k=0.. * adjoint M1))))) = trace (P * (D0 0 \)) + (\k=0..)))" unfolding D0_def by auto also have "\ = trace (P * (D0 0 \)) + (\k=1..<(Suc k). trace (P * (D0 k \)))" using sum.shift_bounds_Suc_ivl[symmetric, of "\k. trace (P * (D0 k \))"] by auto also have "\ = (\k=0..<(Suc k). trace (P * (D0 k \)))" using sum.atLeast_Suc_lessThan[of 0 "Suc k" "\k. trace (P * (D0 k \))"] by auto finally have eq1: "trace (P * (M0 * \ * adjoint M0)) + (\k=0.. * adjoint M1))))) = (\k=0..<(Suc k). trace (P * (D0 k \)))". have eq2: "trace (M1 * \ * adjoint M1) = trace \ - trace (M0 * \ * adjoint M0)" unfolding M0_def M1_def using m trace_measurement2[OF m dr] dr by (simp add: algebra_simps) have "trace (M0 * \ * adjoint M0) + (\k=0.. * adjoint M1)))) = trace (D0 0 \) + (\k=0..))" unfolding D0_def by auto also have "\ = trace (D0 0 \) + (\k=1..<(Suc k). trace (D0 k \))" using sum.shift_bounds_Suc_ivl[symmetric, of "\k. trace (D0 k \)"] by auto also have "\ = (\k=0..<(Suc k). trace (D0 k \))" using sum.atLeast_Suc_lessThan[of 0 "Suc k" "\k. trace (D0 k \)"] by auto finally have eq3: "trace (M0 * \ * adjoint M0) + (\k=0.. * adjoint M1)))) = (\k=0..<(Suc k). trace (D0 k \))". then have "trace (M1 * \ * adjoint M1) - (\k=0.. * adjoint M1)))) = trace \ - (trace (M0 * \ * adjoint M0) + (\k=0.. * adjoint M1)))))" by (simp add: algebra_simps eq2) then have eq4: "trace (M1 * \ * adjoint M1) - (\k=0.. * adjoint M1)))) = trace \ - (\k=0..<(Suc k). trace (D0 k \))" by (simp add: eq3) have "trace ((W (Suc k)) * \) = trace (P * (M0 * \ * adjoint M0)) + trace ((wlp S (W k)) * (M1 * \ * adjoint M1))" unfolding W_def wlp_while_n.simps apply (fold W_def) using dM0 dP dM1 dWWk dr by (mat_assoc d) also have "\ = trace (P * (M0 * \ * adjoint M0)) + trace ((W k) * (DS (M1 * \ * adjoint M1))) + trace (M1 * \ * adjoint M1) - trace (DS (M1 * \ * adjoint M1))" using While(1)[OF wcS, of "W k"] qpWk dsM1r DS_def by auto also have "\ = trace (P * (M0 * \ * adjoint M0)) + (\k=0.. * adjoint M1))))) + trace (DS (M1 * \ * adjoint M1)) - (\k=0.. * adjoint M1)))) + trace (M1 * \ * adjoint M1) - trace (DS (M1 * \ * adjoint M1))" using Suc(1)[OF dsDSM1r] by auto also have "\ = trace (P * (M0 * \ * adjoint M0)) + (\k=0.. * adjoint M1))))) + trace (M1 * \ * adjoint M1) - (\k=0.. * adjoint M1))))" by auto also have "\ = (\k=0..<(Suc k). trace (P * (D0 k \))) + trace \ - (\k=0..<(Suc k). trace (D0 k \))" by (simp add: eq1 eq4) finally show ?case. qed { fix \ assume dsr: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto have limDW: "limit_mat (\n. matrix_sum d (\k. D0 k \) (n)) (denote (While M S) \) d" using limit_mat_denote_while_n[OF wc dr pdor] unfolding D0_def M0_def M1_def DS_def by auto then have "limit_mat (\n. (P * (matrix_sum d (\k. D0 k \) (n)))) (P * (denote (While M S) \)) d" using mat_mult_limit[OF dP] unfolding mat_mult_seq_def by auto then have limtrPm: "(\n. trace (P * (matrix_sum d (\k. D0 k \) (n)))) \ trace (P * (denote (While M S) \))" using mat_trace_limit by auto with limDW have limtrDW:"(\n. trace (matrix_sum d (\k. D0 k \) (n))) \ trace (denote (While M S) \)" using mat_trace_limit by auto have limm: "(\n. trace (matrix_sum d (\k. D0 k \) (n))) \ trace (denote (While M S) \)" using mat_trace_limit limDW by auto have closeWS: "is_quantum_predicate P \ is_quantum_predicate (wlp S P)" for P proof - assume asm: "is_quantum_predicate P" then have dP: "P \ carrier_mat d d" using is_quantum_predicate_def by auto then show "is_quantum_predicate (wlp S P)" using wlp_mono_and_close[OF wcS asm asm] lowner_le_refl by auto qed have monoWS: "is_quantum_predicate P \ is_quantum_predicate Q \ P \\<^sub>L Q \ wlp S P \\<^sub>L wlp S Q" for P Q using wlp_mono_and_close[OF wcS] by auto have "is_quantum_predicate (wlp (While M S) P)" using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto have "limit_mat W (wlp_while M0 M1 (wlp S) P) d" unfolding W_def M0_def M1_def using wlp_while_exists[of "wlp S" M P] closeWS monoWS m qpP by auto then have "limit_mat (\k. (W k) * \) ((wlp_while M0 M1 (wlp S) P) * \) d" using mult_mat_limit dr by auto then have lim1: "(\k. trace ((W k) * \)) \ trace ((wlp_while M0 M1 (wlp S) P) * \)" using mat_trace_limit by auto have dD0kr: "D0 k \ \ carrier_mat d d" for k unfolding D0_def using denote_while_n_dim[OF dr dM0 dM1 pdor] denote_positive_trace_dim[OF wcS, folded DS_def] by auto then have "(P * (matrix_sum d (\k. D0 k \) (n))) = matrix_sum d (\k. P * (D0 k \)) n" for n using matrix_sum_distrib_left[OF dP] by auto moreover have "trace (matrix_sum d (\k. P * (D0 k \)) n) = (\k=0..)))" for n using trace_matrix_sum_linear dD0kr dP by auto ultimately have eqPsD0kr: "trace (P * (matrix_sum d (\k. D0 k \) (n))) = (\k=0..)))" for n by auto with limtrPm have lim2: "(\k. (\k=0..)))) \ trace (P * (denote (While M S) \))" by auto have "trace (matrix_sum d (\k. D0 k \) (n)) = (\k=0..))" for n using trace_matrix_sum_linear dD0kr by auto with limtrDW have lim3: "(\k. (\k=0..))) \ trace (denote (While M S) \)" by auto have "(\k. (\k=0..))) + trace \) \ trace (P * (denote (While M S) \)) + trace \" using tendsto_add[of "\k. (\k=0..)))"] lim2 by auto then have "(\k. (\k=0..))) + trace \ - (\k=0..))) \ trace (P * (denote (While M S) \)) + trace \ - trace (denote (While M S) \)" using tendsto_diff[of _ _ _ "\k. (\k=0..))"] lim3 by auto then have lim4: "(\k. trace ((W k) * \)) \ trace (P * (denote (While M S) \)) + trace \ - trace (denote (While M S) \)" using eqk[OF dsr] by auto then have "trace ((wlp_while M0 M1 (wlp S) P) * \) = trace (P * (denote (While M S) \)) + trace \ - trace (denote (While M S) \)" using eqk[OF dsr] tendsto_unique[OF _ lim1 lim4] by auto } then show ?case unfolding M0_def M1_def DS_def wlp.simps by auto qed lemma denote_while_split: assumes wc: "well_com (While M S)" and dsr: "\ \ density_states" shows "denote (While M S) \ = (M 0) * \ * adjoint (M 0) + denote (While M S) (denote S (M 1 * \ * adjoint (M 1)))" proof - have m: "measurement d 2 M" using wc by auto have wcs: "well_com S" using wc by auto define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using m measurement_def M0_def M1_def by auto have M1leq: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto define DS where "DS = denote S" define D0 where "D0 = denote_while_n M0 M1 DS" define D1 where "D1 = denote_while_n_comp M0 M1 DS" define D where "D = denote_while_n_iter M0 M1 DS" define DW where "DW \ = denote (While M S) \" for \ { fix \ assume dsr: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto have pdoDkr: "\k. partial_density_operator (D k \)" unfolding D_def using pdo_denote_while_n_iter[OF dr pdor dM1 M1leq] denote_partial_density_operator[OF wcs] denote_dim[OF wcs, folded DS_def] apply (fold DS_def) by auto then have pDkr: "\k. positive (D k \)" unfolding partial_density_operator_def by auto have dDkr: "\k. D k \ \ carrier_mat d d" using denote_while_n_iter_dim[OF dr pdor dM1 M1leq denote_dim_pdo[OF wcs, folded DS_def], of id M0, simplified, folded D_def] by auto then have dD0kr: "\k. D0 k \ \ carrier_mat d d" unfolding D0_def denote_while_n.simps apply (fold D_def) using dM0 by auto } note dD0k = this have "matrix_sum d (\k. D0 k \) k \ carrier_mat d d" if dsr: "\ \ density_states" for \ k using matrix_sum_dim[OF dD0k, of _ "\k. \" id, OF dsr] dsr by auto { fix k have "matrix_sum d (\k. D0 k \) (Suc k) = (D0 0 \) + matrix_sum d (\k. D0 (Suc k) \) k" using matrix_sum_shift_Suc[of _ "\k. D0 k \"] dD0k[OF dsr] by fastforce also have "\ = M0 * \ * adjoint M0 + matrix_sum d (\k. D0 k (DS (M1 * \ * adjoint M1))) k" unfolding D0_def by auto finally have "matrix_sum d (\k. D0 k \) (Suc k) = M0 * \ * adjoint M0 + matrix_sum d (\k. D0 k (DS (M1 * \ * adjoint M1))) k". } note eqk = this have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def dsr by auto then have "M1 * \ * adjoint M1 \ carrier_mat d d" and "partial_density_operator (M1 * \ * adjoint M1)" using dM1 dr pdo_close_under_measurement[OF dM1 dr pdor M1leq] by auto then have dSM1r: "(DS (M1 * \ * adjoint M1)) \ carrier_mat d d" and pdoSM1r: "partial_density_operator (DS (M1 * \ * adjoint M1))" unfolding DS_def using denote_dim_pdo[OF wcs] by auto have "limit_mat (matrix_sum d (\k. D0 k \)) (DW \) d" unfolding M0_def M1_def D0_def DS_def DW_def using limit_mat_denote_while_n[OF wc dr pdor] by auto then have liml: "limit_mat (\k. matrix_sum d (\k. D0 k \) (Suc k)) (DW \) d" using limit_mat_ignore_initial_segment[of "matrix_sum d (\k. D0 k \)" "DW \" d 1] by auto have dM0r: "M0 * \ * adjoint M0 \ carrier_mat d d" using dM0 dr by fastforce have "limit_mat (matrix_sum d (\k. D0 k (DS (M1 * \ * adjoint M1)))) (DW (DS (M1 * \ * adjoint M1))) d" using limit_mat_denote_while_n[OF wc dSM1r pdoSM1r] unfolding M0_def M1_def D0_def DS_def DW_def by auto then have limr: "limit_mat (mat_add_seq (M0 * \ * adjoint M0) (matrix_sum d (\k. D0 k (DS (M1 * \ * adjoint M1))))) (M0 * \ * adjoint M0 + (DW (DS (M1 * \ * adjoint M1)))) d" using mat_add_limit[OF dM0r] by auto moreover have "(\k. matrix_sum d (\k. D0 k \) (Suc k)) = (mat_add_seq (M0 * \ * adjoint M0) (matrix_sum d (\k. D0 k (DS (M1 * \ * adjoint M1)))))" using eqk mat_add_seq_def by auto ultimately have "limit_mat (\k. matrix_sum d (\k. D0 k \) (Suc k)) (M0 * \ * adjoint M0 + (DW (DS (M1 * \ * adjoint M1)))) d" by auto with liml limit_mat_unique have "DW \ = (M0 * \ * adjoint M0 + (DW (DS (M1 * \ * adjoint M1))))" by auto then show ?thesis unfolding DW_def M0_def M1_def DS_def by auto qed lemma wlp_while_split: assumes wc: "well_com (While M S)" and qpP: "is_quantum_predicate P" shows "wlp (While M S) P = adjoint (M 0) * P * (M 0) + adjoint (M 1) * (wlp S (wlp (While M S) P)) * (M 1)" proof - have m: "measurement d 2 M" using wc by auto have wcs: "well_com S" using wc by auto define M0 where "M0 = M 0" define M1 where "M1 = M 1" have dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" using m measurement_def M0_def M1_def by auto have M1leq: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat m M1_def by auto define DS where "DS = denote S" define D0 where "D0 = denote_while_n M0 M1 DS" define D1 where "D1 = denote_while_n_comp M0 M1 DS" define D where "D = denote_while_n_iter M0 M1 DS" define DW where "DW \ = denote (While M S) \" for \ have dP: "P \ carrier_mat d d" using qpP is_quantum_predicate_def by auto have qpWP: "is_quantum_predicate (wlp (While M S) P)" using qpP wc wlp_close[OF wc qpP] by auto then have "is_quantum_predicate (wlp S (wlp (While M S) P))" using wc wlp_close[OF wcs] by auto then have dWWP: "(wlp S (wlp (While M S) P)) \ carrier_mat d d" using is_quantum_predicate_def by auto have dWP: "(wlp (While M S) P) \ carrier_mat d d" using qpWP is_quantum_predicate_def by auto { fix \ assume dsr: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto have dsM1r: "M1 * \ * adjoint M1 \ density_states" unfolding density_states_def using pdo_close_under_measurement[OF dM1 dr pdor] M1leq dM1 dr by fastforce then have dsDSM1r: "DS (M1 * \ * adjoint M1) \ density_states" unfolding density_states_def DS_def using denote_dim_pdo[OF wcs] by auto have dM0r: "M0 * \ * adjoint M0 \ carrier_mat d d" using dM0 dr by fastforce have dDWDSM1r: "DW (DS (M1 * \ * adjoint M1)) \ carrier_mat d d" unfolding DW_def using denote_dim[OF wc] dsDSM1r density_states_def by auto have eq2: "trace ((wlp (While M S) P) * DS (M1 * \ * adjoint M1)) = trace (P * (DW (DS (M1 * \ * adjoint M1)))) + trace (DS (M1 * \ * adjoint M1)) - trace (DW (DS (M1 * \ * adjoint M1)))" unfolding DW_def using wlp_soundness[OF wc qpP] dsDSM1r by auto have eq3: "trace (M1 * \ * adjoint M1) = trace \ - trace (M0 * \ * adjoint M0)" unfolding M0_def M1_def using m trace_measurement2[OF m dr] dr by (simp add: algebra_simps) have "trace (adjoint M1 * (wlp S (wlp (While M S) P)) * M1 * \) = trace ((wlp S (wlp (While M S) P)) * (M1 * \ * adjoint M1))" using dWWP dM1 dr by (mat_assoc d) also have "\ = trace ((wlp (While M S) P) * DS (M1 * \ * adjoint M1)) + trace (M1 * \ * adjoint M1) - trace (DS (M1 * \ * adjoint M1))" unfolding DS_def using wlp_soundness[OF wcs qpWP] dsM1r by auto also have "\ = trace (P * (DW (DS (M1 * \ * adjoint M1)))) + trace (M1 * \ * adjoint M1) - trace (DW (DS (M1 * \ * adjoint M1)))" using eq2 by auto also have "\ = trace (P * (DW (DS (M1 * \ * adjoint M1)))) + trace \ - (trace (M0 * \ * adjoint M0) + trace (DW (DS (M1 * \ * adjoint M1))))" using eq3 by auto finally have eq4: "trace (adjoint M1 * (wlp S (wlp (While M S) P)) * M1 * \) = trace (P * (DW (DS (M1 * \ * adjoint M1)))) + trace \ - (trace (M0 * \ * adjoint M0) + trace (DW (DS (M1 * \ * adjoint M1))))". have "trace (adjoint M0 * P * M0 * \) + trace (P * (DW (DS (M1 * \ * adjoint M1)))) = trace (P * ((M0 * \ * adjoint M0) + (DW (DS (M1 * \ * adjoint M1)))))" using dP dr dM0 dDWDSM1r by (mat_assoc d) also have "\ = trace (P * (DW \))" unfolding DW_def M0_def M1_def DS_def using denote_while_split[OF wc dsr] by auto finally have eq5: "trace (adjoint M0 * P * M0 * \) + trace (P * (DW (DS (M1 * \ * adjoint M1)))) = trace (P * (DW \))". have "trace (M0 * \ * adjoint M0) + trace (DW (DS (M1 * \ * adjoint M1))) = trace (M0 * \ * adjoint M0 + (DW (DS (M1 * \ * adjoint M1))))" using dr dM0 dDWDSM1r by (mat_assoc d) also have "\ = trace (DW \)" unfolding DW_def DS_def M0_def M1_def denote_while_split[OF wc dsr] by auto finally have eq6: "trace (M0 * \ * adjoint M0) + trace (DW (DS (M1 * \ * adjoint M1))) = trace (DW \)". from eq5 eq4 eq6 have eq7: "trace (adjoint M0 * P * M0 * \) + trace (adjoint M1 * wlp S (wlp (While M S) P) * M1 * \) = trace (P * DW \) + trace \ - trace (DW \)" by auto have eq8: "trace (adjoint M0 * P * M0 * \) + trace (adjoint M1 * wlp S (wlp (While M S) P) * M1 * \) = trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \)" using dM0 dM1 dr dP dWWP by (mat_assoc d) from eq7 eq8 have eq9: "trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \) = trace (P * DW \) + trace \ - trace (DW \)" by auto have eq10: "trace ((wlp (While M S) P) * \) = trace (P * DW \) + trace \ - trace (DW \)" unfolding DW_def using wlp_soundness[OF wc qpP] dsr by auto with eq9 have "trace ((wlp (While M S) P) * \) = trace ((adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1) * \)" by auto } then have "(wlp (While M S) P) = (adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1)" using trace_pdo_eq_imp_eq[OF dWP, of "adjoint M0 * P * M0 + adjoint M1 * wlp S (wlp (While M S) P) * M1"] dM0 dP dM1 dWWP density_states_def by fastforce then show ?thesis using M0_def M1_def by auto qed lemma wlp_is_weakest_liberal_precondition: assumes "well_com S" and "is_quantum_predicate P" shows "is_weakest_liberal_precondition (wlp S P) S P" unfolding is_weakest_liberal_precondition_def proof (auto) show qpWP: "is_quantum_predicate (wlp S P)" using wlp_close assms by auto have eq: "trace (wlp S P * \) = trace (P * (denote S \)) + trace \ - trace (denote S \)" if dsr: "\ \ density_states" for \ using wlp_soundness assms dsr by auto then show "\\<^sub>p {wlp S P} S {P}" unfolding hoare_partial_correct_def by auto fix Q assume qpQ: "is_quantum_predicate Q" and p: "\\<^sub>p {Q} S {P}" { fix \ assume dsr: "\ \ density_states" then have "trace (Q * \) \ trace (P * (denote S \)) + trace \ - trace (denote S \)" - using hoare_partial_correct_def p by auto + using hoare_partial_correct_def p by (auto simp: less_eq_complex_def) then have "trace (Q * \) \ trace (wlp S P * \)" using eq[symmetric] dsr by auto } then show "Q \\<^sub>L wlp S P" using lowner_le_trace density_states_def qpQ qpWP is_quantum_predicate_def by auto qed subsection \Hoare triples for partial correctness\ inductive hoare_partial :: "complex mat \ com \ complex mat \ bool" ("\\<^sub>p ({(1_)}/ (_)/ {(1_)})" 50) where "is_quantum_predicate P \ \\<^sub>p {P} SKIP {P}" | "is_quantum_predicate P \ \\<^sub>p {adjoint U * P * U} Utrans U {P}" | "is_quantum_predicate P \ is_quantum_predicate Q \ is_quantum_predicate R \ \\<^sub>p {P} S1 {Q} \ \\<^sub>p {Q} S2 {R} \ \\<^sub>p {P} Seq S1 S2 {R}" | "(\k. k < n \ is_quantum_predicate (P k)) \ is_quantum_predicate Q \ (\k. k < n \ \\<^sub>p {P k} S ! k {Q}) \ \\<^sub>p {matrix_sum d (\k. adjoint (M k) * P k * M k) n} Measure n M S {Q}" | "is_quantum_predicate P \ is_quantum_predicate Q \ \\<^sub>p {Q} S {adjoint (M 0) * P * M 0 + adjoint (M 1) * Q * M 1} \ \\<^sub>p {adjoint (M 0) * P * M 0 + adjoint (M 1) * Q * M 1} While M S {P}" | "is_quantum_predicate P \ is_quantum_predicate Q \ is_quantum_predicate P' \ is_quantum_predicate Q' \ P \\<^sub>L P' \ \\<^sub>p {P'} S {Q'} \ Q' \\<^sub>L Q \ \\<^sub>p {P} S {Q}" theorem hoare_partial_sound: "\\<^sub>p {P} S {Q} \ well_com S \ \\<^sub>p {P} S {Q}" proof (induction rule: hoare_partial.induct) case (1 P) then show ?case unfolding hoare_partial_correct_def by auto next case (2 P U) (*utrans*) then have dU: "U \ carrier_mat d d" and "unitary U" and dP: "P \ carrier_mat d d" using is_quantum_predicate_def by auto then have uU: "adjoint U * U = 1\<^sub>m d" using unitary_def by auto show ?case unfolding hoare_partial_correct_def denote.simps(2) proof fix \ assume "\ \ density_states" then have dr: "\ \ carrier_mat d d" using density_states_def by auto have e1: "trace (U * \ * adjoint U) = trace ((adjoint U * U) * \)" using dr dU by (mat_assoc d) also have "\ = trace \" using uU dr by auto finally have e1: "trace (U * \ * adjoint U) = trace \" . have e2: "trace (P * (U * \ * adjoint U)) = trace (adjoint U * P * U * \)" using dU dP dr by (mat_assoc d) with e1 have "trace (P * (U * \ * adjoint U)) + (trace \ - trace (U * \ * adjoint U)) = trace (adjoint U * P * U * \)" using e1 by auto then show "trace (adjoint U * P * U * \) \ trace (P * (U * \ * adjoint U)) + (trace \ - trace (U * \ * adjoint U))" by auto qed next case (3 P Q R S1 S2) (*seq*) then have wc1: "\\<^sub>p {P} S1 {Q}" and wc2: "\\<^sub>p {Q} S2 {R}" by auto show ?case unfolding hoare_partial_correct_def denote.simps(3) proof clarify fix \ assume \: "\ \ density_states" have 1: "trace (P * \) \ trace (Q * denote S1 \) + (trace \ - trace (denote S1 \))" using wc1 hoare_partial_correct_def \ by auto have \': "denote S1 \ \ density_states" using 3(8) denote_density_states \ by auto have 2: "trace (Q * denote S1 \) \ trace (R * denote S2 (denote S1 \)) + (trace (denote S1 \) - trace (denote S2 (denote S1 \)))" using wc2 hoare_partial_correct_def \' by auto show "trace (P * \) \ trace (R * denote S2 (denote S1 \)) + (trace \ - trace (denote S2 (denote S1 \)))" - using 1 2 by auto + using 1 2 by (auto simp: less_eq_complex_def) qed next case (4 n P Q S M) (*if*) then have wc: "k < n \ well_com (S!k)" and c: "k < n \ \\<^sub>p {P k} (S!k) {Q}" and m: "measurement d n M" and dMk: "k < n \ M k \ carrier_mat d d" and aMMkleq: "k < n \ adjoint (M k) * M k \\<^sub>L 1\<^sub>m d" and dPk: "k < n \ P k \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" for k using is_quantum_predicate_def measurement_def measure_well_com measurement_le_one_mat by auto { fix \ assume \: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" using density_states_def by auto have dsr: "k < n \ (M k) * \ * adjoint (M k) \ density_states" for k unfolding density_states_def using dMk pdo_close_under_measurement[OF dMk dr pdor aMMkleq] dr by fastforce then have leqk: "k < n \ trace ((P k) * ((M k) * \ * adjoint (M k))) \ trace (Q * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))" for k using c unfolding hoare_partial_correct_def by auto have "k < n \ M k * \ * adjoint (M k) \ carrier_mat d d" for k using dMk dr by fastforce then have dsMrk: "k < n \ matrix_sum d (\k. (M k * \ * adjoint (M k))) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. (M k * \ * adjoint (M k))" d] by fastforce have "k < n \ adjoint (M k) * P k * M k \ carrier_mat d d" for k using dMk dPk by fastforce then have dsMP: "k < n \ matrix_sum d (\k. adjoint (M k) * P k * M k) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. adjoint (M k) * P k * M k" d] by fastforce have dSMrk: "k < n \ denote (S ! k) (M k * \ * adjoint (M k)) \ carrier_mat d d" for k using denote_dim[OF wc, of k "M k * \ * adjoint (M k)"] dsr density_states_def by fastforce have dsSMrk: "k < n \ matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. denote (S ! k) (M k * \ * adjoint (M k))" d, OF dSMrk] by fastforce have "k \ n \ trace (matrix_sum d (\k. adjoint (M k) * P k * M k) k * \) \ trace (Q * (denote (Measure k M S) \)) + (trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) k) - trace (denote (Measure k M S) \))" for k unfolding denote_measure_expand[OF _ 4(5)] proof (induct k) case 0 then show ?case using dQ dr pdor partial_density_operator_def positive_trace by auto next case (Suc k) then have k: "k < n" by auto have eq1: "trace (matrix_sum d (\k. adjoint (M k) * P k * M k) (Suc k) * \) = trace (adjoint (M k) * P k * M k * \) + trace (matrix_sum d (\k. adjoint (M k) * P k * M k) k * \)" unfolding matrix_sum.simps using dMk[OF k] dPk[OF k] dr dsMP[OF k] by (mat_assoc d) have "trace (adjoint (M k) * P k * M k * \) = trace (P k * (M k * \ * adjoint (M k)))" using dMk[OF k] dPk[OF k] dr by (mat_assoc d) also have "\ \ trace (Q * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))" using leqk k by auto finally have eq2: "trace (adjoint (M k) * P k * M k * \) \ trace (Q * (denote (S!k) ((M k) * \ * adjoint (M k)))) + (trace ((M k) * \ * adjoint (M k)) - trace (denote (S ! k) ((M k) * \ * adjoint (M k))))". have eq3: "trace (Q * matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) (Suc k)) = trace (Q * (denote (S!k) (M k * \ * adjoint (M k)))) + trace (Q * matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k)" unfolding matrix_sum.simps using dQ dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d) have eq4: "trace (denote (S ! k) (M k * \ * adjoint (M k)) + matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k) = trace (denote (S ! k) (M k * \ * adjoint (M k))) + trace (matrix_sum d (\k. denote (S!k) (M k * \ * adjoint (M k))) k)" using dSMrk[OF k] dsSMrk[OF k] by (mat_assoc d) show ?case apply (subst eq1) apply (subst eq3) apply (simp del: less_eq_complex_def) apply (subst trace_add_linear[of "M k * \ * adjoint (M k)" d "matrix_sum d (\k. M k * \ * adjoint (M k)) k"]) apply (simp add: dMk adjoint_dim[OF dMk] dr mult_carrier_mat[of _ d d _ d] k) apply (simp add: dsMrk k) apply (subst eq4) - apply (insert eq2 Suc(1) k, fastforce) + apply (insert eq2 Suc(1) k, fastforce simp: less_eq_complex_def) done qed then have leq: "trace (matrix_sum d (\k. adjoint (M k) * P k * M k) n * \) \ trace (Q * denote (Measure n M S) \) + (trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) n) - trace (denote (Measure n M S) \))" by auto have "trace (matrix_sum d (\k. (M k) * \ * adjoint (M k)) n) = trace \" using trace_measurement m dr by auto with leq have "trace (matrix_sum d (\k. adjoint (M k) * P k * M k) n * \) \ trace (Q * denote (Measure n M S) \) + (trace \ - trace (denote (Measure n M S) \))" unfolding denote_measure_def by auto } then show ?case unfolding hoare_partial_correct_def by auto next case (5 P Q S M) (*while*) define M0 where "M0 = M 0" define M1 where "M1 = M 1" from 5 have wcs: "well_com S" and c: "\\<^sub>p {Q} S {adjoint M0 * P * M0 + adjoint M1 * Q * M1}" and m: "measurement d 2 M" and dM0: "M0 \ carrier_mat d d" and dM1: "M1 \ carrier_mat d d" and dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" and qpQ: "is_quantum_predicate Q" and wc: "well_com (While M S)" using measurement_def is_quantum_predicate_def M0_def M1_def by auto then have M0leq: "adjoint M0 * M0 \\<^sub>L 1\<^sub>m d" and M1leq: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat[OF m] M0_def M1_def by auto define DS where "DS = denote S" have "\\ \ density_states. trace (Q * \) \ trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * DS \) + trace \ - trace (DS \)" - using hoare_partial_correct_def[of Q S "adjoint M0 * P * M0 + adjoint M1 * Q * M1"] c DS_def by auto + using hoare_partial_correct_def[of Q S "adjoint M0 * P * M0 + adjoint M1 * Q * M1"] c DS_def + by (auto simp: less_eq_complex_def) define D0 where "D0 = denote_while_n M0 M1 DS" define D1 where "D1 = denote_while_n_comp M0 M1 DS" define D where "D = denote_while_n_iter M0 M1 DS" { fix \ assume dsr: "\ \ density_states" then have dr: "\ \ carrier_mat d d" and pr: "positive \" and pdor: "partial_density_operator \" using density_states_def partial_density_operator_def by auto have pdoDkr: "\k. partial_density_operator (D k \)" unfolding D_def using pdo_denote_while_n_iter[OF dr pdor dM1 M1leq] denote_partial_density_operator[OF wcs] denote_dim[OF wcs, folded DS_def] apply (fold DS_def) by auto then have pDkr: "\k. positive (D k \)" unfolding partial_density_operator_def by auto have dDkr: "\k. D k \ \ carrier_mat d d" using denote_while_n_iter_dim[OF dr pdor dM1 M1leq denote_dim_pdo[OF wcs, folded DS_def], of id M0, simplified, folded D_def] by auto then have dD0kr: "\k. D0 k \ \ carrier_mat d d" unfolding D0_def denote_while_n.simps apply (fold D_def) using dM0 by auto then have dPD0kr: "\k. P * (D0 k \) \ carrier_mat d d" using dP by auto have "\k. positive (D0 k \)" unfolding D0_def denote_while_n.simps by (fold D_def, rule positive_close_under_left_right_mult_adjoint[OF dM0 dDkr pDkr]) then have trge0: "\k. trace (D0 k \) \ 0" using positive_trace dD0kr by blast have DSr: "\ \ density_states \ DS \ \ density_states" for "\" unfolding DS_def density_states_def using denote_partial_density_operator denote_dim wcs by auto have dsD1nr: "D1 n \ \ density_states" for n unfolding D1_def denote_while_n_comp.simps apply (fold D_def) unfolding density_states_def apply (auto) apply (insert dDkr dM1 adjoint_dim[OF dM1], auto) apply (rule pdo_close_under_measurement[OF dM1 spec[OF allI[OF dDkr], of "\x. n"] spec[OF allI[OF pdoDkr], of "\x. n"] M1leq]) done have leQn: "trace (Q * D1 n \) \ trace (P * D0 (Suc n) \) + trace (Q * D1 (Suc n) \) + trace (D1 n \) - trace (D (Suc n) \)" for n proof - have "(\\\density_states. trace (Q * \) \ trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * denote S \) + (trace \ - trace (denote S \)))" using c hoare_partial_correct_def by auto then have leQn': "trace (Q * (D1 n \)) \ trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \))) + (trace (D1 n \) - trace (DS (D1 n \)))" using dsD1nr[of n] DS_def by auto have "(DS (D1 n \)) \ carrier_mat d d" unfolding DS_def using denote_dim[OF wcs] dsD1nr density_states_def by auto then have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \))) = trace (P * (M0 * (DS (D1 n \)) * adjoint M0)) + trace (Q * (M1 * (DS (D1 n \)) * adjoint M1))" using dP dQ dM0 dM1 by (mat_assoc d) moreover have "trace (P * (M0 * (DS (D1 n \)) * adjoint M0)) = trace (P * D0 (Suc n) \)" unfolding D0_def denote_while_n.simps apply (subst denote_while_n_iter_assoc) by (fold denote_while_n_comp.simps D1_def, auto) moreover have "trace (Q * (M1 * (DS (D1 n \)) * adjoint M1)) = trace (Q * D1 (Suc n) \)" apply (subst (2) D1_def) unfolding denote_while_n_comp.simps apply (subst denote_while_n_iter_assoc) by (fold denote_while_n_comp.simps D1_def, auto) ultimately have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * (DS (D1 n \))) = trace (P * D0 (Suc n) \) + trace (Q * D1 (Suc n) \)" by auto moreover have "trace (DS (D1 n \)) = trace (D (Suc n) \)" unfolding D_def apply (subst denote_while_n_iter_assoc) by (fold denote_while_n_comp.simps D1_def, auto) - ultimately show ?thesis using leQn' by auto + ultimately show ?thesis using leQn' by (auto simp: less_eq_complex_def) qed have 12: "trace (P * (M0 * \ * adjoint M0)) + trace (Q * (M1 * \ * adjoint M1)) \ (\k=0..<(n+2). trace (P * (D0 k \))) + trace (Q * (D1 (n+1) \)) + (\k=0..<(n+1). trace (D1 k \) - trace (D (k+1) \))" for n proof (induct n) case 0 show ?case apply (simp del: less_eq_complex_def) unfolding D0_def D1_def D_def denote_while_n_comp.simps denote_while_n.simps denote_while_n_iter.simps - using leQn[of 0] unfolding D1_def D0_def D_def denote_while_n.simps denote_while_n_comp.simps denote_while_n_iter.simps by auto + using leQn[of 0] unfolding D1_def D0_def D_def denote_while_n.simps denote_while_n_comp.simps denote_while_n_iter.simps + by (auto simp: less_eq_complex_def) next case (Suc n) have "trace (Q * D1 (n + 1) \) \ trace (P * D0 (Suc (Suc n)) \) + trace (Q * D1 (Suc (Suc n)) \) + trace (D1 (Suc n) \) - trace (D (Suc (Suc n)) \)" using leQn[of "n + 1"] by auto - with Suc show ?case apply (simp del: less_eq_complex_def) by auto + with Suc show ?case apply (simp del: less_eq_complex_def) by (auto simp: less_eq_complex_def) qed have tr_measurement: "\ \ carrier_mat d d \ trace (M0 * \ * adjoint M0) + trace (M1 * \ * adjoint M1) = trace \" for \ using trace_measurement2[OF m, folded M0_def M1_def] by auto have 14: "(\k=0..<(n+1). trace (D1 k \) - trace (D (k+1) \)) = trace \ - trace (D (n+1) \) - (\k=0..<(n+1). trace (D0 k \))" for n proof (induct n) case 0 show ?case apply (simp) unfolding D1_def D0_def denote_while_n_comp.simps denote_while_n.simps denote_while_n_iter.simps using tr_measurement[OF dr] by (auto simp add: algebra_simps) next case (Suc n) have "trace (D0 (Suc n) \) + trace (D1 (Suc n) \) = trace (D (Suc n) \)" unfolding D0_def D1_def denote_while_n.simps denote_while_n_comp.simps apply (fold D_def) using tr_measurement dDkr by auto then have "trace (D1 (Suc n) \) = trace (D (Suc n) \) - trace (D0 (Suc n) \)" by (auto simp add: algebra_simps) then show ?case using Suc by simp qed have 15: "trace (Q * (D1 n \)) \ trace (D n \) - trace (D0 n \)" for n proof - have QleId: "Q \\<^sub>L 1\<^sub>m d" using is_quantum_predicate_def qpQ by auto then have "trace (Q * (D1 n \)) \ trace (1\<^sub>m d * (D1 n \))" using dsD1nr[of n] unfolding density_states_def lowner_le_trace[OF dQ one_carrier_mat] by auto also have "\ = trace (D1 n \)" using dsD1nr[of n] unfolding density_states_def by auto also have "\ = trace (M1 * (D n \) * adjoint M1)" unfolding D1_def denote_while_n_comp.simps D_def by auto also have "\ = trace (D n \) - trace (M0 * (D n \) * adjoint M0)" using tr_measurement[OF dDkr[of n]] by (simp add: algebra_simps) also have "\ = trace (D n \) - trace (D0 n \)" unfolding D0_def denote_while_n.simps by (fold D_def, auto) finally show ?thesis. qed - have tmp: "\a b c. 0 \ a \ b \ c - a \ b \ (c::complex)" by simp + have tmp: "\a b c. 0 \ a \ b \ c - a \ b \ (c::complex)" + by (simp add: less_eq_complex_def) then have 151: "\n. trace (Q * (D1 n \)) \ trace (D n \)" by (auto simp add: tmp[OF trge0 15] simp del: less_eq_complex_def) have main_leq: "\n. trace (P * (M0 * \ * adjoint M0)) + trace (Q * (M1 * \ * adjoint M1)) \ trace (P * (matrix_sum d (\k. D0 k \) (n+2))) + trace \ - trace (matrix_sum d (\k. D0 k \) (n+2))" proof - fix n have "(\k=0..<(n+2). trace (P * (D0 k \))) + trace (Q * (D1 (n+1) \)) + (\k=0..<(n+1). trace (D1 k \) - trace (D (k+1) \)) \ (\k=0..<(n+2). trace (P * (D0 k \))) + trace (Q * (D1 (n+1) \)) + trace \ - trace (D (n+1) \) - (\k=0..<(n+1). trace (D0 k \))" by (subst 14, auto) also have "\ \ (\k=0..<(n+2). trace (P * (D0 k \))) + trace (D (n+1) \) - trace (D0 (n+1) \) + trace \ - trace (D (n+1) \) - (\k=0..<(n+1). trace (D0 k \))" - using 15[of "n+1"] by auto + using 15[of "n+1"] by (auto simp: less_eq_complex_def) also have "\ = (\k=0..<(n+2). trace (P * (D0 k \))) + trace \ - (\k=0..<(n+2). trace (D0 k \))" by auto also have "\ = trace (matrix_sum d (\k. (P * (D0 k \))) (n+2)) + trace \ - (\k=0..<(n+2). trace (D0 k \))" using trace_matrix_sum_linear[of "n+2" "\k. (P * (D0 k \))" d, symmetric] dPD0kr by auto also have "\ = trace (matrix_sum d (\k. (P * (D0 k \))) (n+2)) + trace \ - trace (matrix_sum d (\k. D0 k \) (n+2))" using trace_matrix_sum_linear[of "n+2" "\k. D0 k \" d, symmetric] dD0kr by auto also have "\ = trace (P * (matrix_sum d (\k. D0 k \) (n+2))) + trace \ - trace (matrix_sum d (\k. D0 k \) (n+2))" using matrix_sum_distrib_left[OF dP dD0kr, of id "n+2"] by auto finally have "(\k=0..<(n+2). trace (P * (D0 k \))) + trace (Q * (D1 (n+1) \)) + (\k=0..<(n+1). trace (D1 k \) - trace (D (k+1) \)) \ trace (P * (matrix_sum d (\k. D0 k \) (n+2))) + trace \ - trace (matrix_sum d (\k. D0 k \) (n+2))" . then show "trace (P * (M0 * \ * adjoint M0)) + trace (Q * (M1 * \ * adjoint M1)) \ trace (P * (matrix_sum d (\k. D0 k \) (n+2))) + trace \ - trace (matrix_sum d (\k. D0 k \) (n+2))" using 12[of n] by auto qed have "limit_mat (\n. matrix_sum d (\k. D0 k \) (n)) (denote (While M S) \) d" using limit_mat_denote_while_n[OF wc dr pdor] unfolding D0_def M0_def M1_def DS_def by auto then have limp2: "limit_mat (\n. matrix_sum d (\k. D0 k \) (n + 2)) (denote (While M S) \) d" using limit_mat_ignore_initial_segment[of "\n. matrix_sum d (\k. D0 k \) (n)" "(denote (While M S) \)" d 2] by auto then have "limit_mat (\n. (P * (matrix_sum d (\k. D0 k \) (n+2)))) (P * (denote (While M S) \)) d" using mat_mult_limit[OF dP] unfolding mat_mult_seq_def by auto then have limPm: "(\n. trace (P * (matrix_sum d (\k. D0 k \) (n+2)))) \ trace (P * (denote (While M S) \))" using mat_trace_limit by auto have limm: "(\n. trace (matrix_sum d (\k. D0 k \) (n+2))) \ trace (denote (While M S) \)" using mat_trace_limit limp2 by auto have leq_lim: "trace (P * (M0 * \ * adjoint M0)) + trace (Q * (M1 * \ * adjoint M1)) \ trace (P * (denote (While M S) \)) + trace \ - trace (denote (While M S) \)" (is "?lhs \ ?rhs") using main_leq proof - define seq where "seq n = trace (P * matrix_sum d (\k. D0 k \) (n + 2)) - trace (matrix_sum d (\k. D0 k \) (n + 2)) " for n define seqlim where "seqlim = trace (P * (denote (While M S) \)) - trace (denote (While M S) \)" have main_leq': "?lhs \ trace \ + seq n" for n unfolding seq_def using main_leq by (simp add: algebra_simps) have limseq: "seq \ seqlim" unfolding seq_def seqlim_def using tendsto_diff[OF limPm limm] by auto have limrs: "(\n. trace \ + seq n) \ (trace \ + seqlim)" using tendsto_add[OF _ limseq] by auto have limrsRe: "(\n. Re (trace \ + seq n)) \ Re (trace \ + seqlim)" using tendsto_Re[OF limrs] by auto - have main_leq_Re: "Re ?lhs \ Re (trace \ + seq n)" for n using main_leq' by auto + have main_leq_Re: "Re ?lhs \ Re (trace \ + seq n)" for n using main_leq' + by (auto simp: less_eq_complex_def) have Re: "Re ?lhs \ Re (trace \ + seqlim)" - using Lim_bounded2[OF limrsRe ] main_leq_Re by auto + using Lim_bounded2[OF limrsRe ] main_leq_Re by (auto simp: less_eq_complex_def) have limrsIm: "(\n. Im (trace \ + seq n)) \ Im (trace \ + seqlim)" using tendsto_Im[OF limrs] by auto have main_leq_Im: "Im ?lhs = Im (trace \ + seq n)" for n using main_leq' unfolding less_eq_complex_def by auto then have limIm: "(\n. Im (trace \ + seq n)) \ Im ?lhs" using tendsto_intros(1) by auto have Im: "Im ?lhs = Im (trace \ + seqlim)" using tendsto_unique[OF _ limIm limrsIm] by auto - have "?lhs \ trace \ + seqlim" using Re Im by auto - then show "?lhs \ ?rhs" unfolding seqlim_def by auto + have "?lhs \ trace \ + seqlim" using Re Im by (auto simp: less_eq_complex_def) + then show "?lhs \ ?rhs" unfolding seqlim_def by (auto simp: less_eq_complex_def) qed have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * \) = trace (P * (M0 * \ * adjoint M0)) + trace (Q * (M1 * \ * adjoint M1))" using dr dM0 dM1 dP dQ by (mat_assoc d) then have "trace ((adjoint M0 * P * M0 + adjoint M1 * Q * M1) * \) \ trace (P * (denote (While M S) \)) + (trace \ - trace (denote (While M S) \))" - using leq_lim by auto + using leq_lim by (auto simp: less_eq_complex_def) } then show ?case unfolding hoare_partial_correct_def denote.simps(5) apply (fold M0_def M1_def DS_def D0_def D1_def) by auto next case (6 P Q P' Q' S) then have wcs: "well_com S" and c: "\\<^sub>p {P'} S {Q'}" and dP: "P \ carrier_mat d d" and dQ: "Q \ carrier_mat d d" and dP': "P' \ carrier_mat d d" and dQ': "Q' \ carrier_mat d d" using is_quantum_predicate_def by auto show ?case unfolding hoare_partial_correct_def proof fix \ assume pds: "\ \ density_states" then have pdor: "partial_density_operator \" and dr: "\ \ carrier_mat d d" using density_states_def by auto have pdoSr: "partial_density_operator (denote S \)" using denote_partial_density_operator pdor dr wcs by auto have dSr: "denote S \ \ carrier_mat d d" using denote_dim pdor dr wcs by auto have "trace (P * \) \ trace (P' * \)" using lowner_le_trace[OF dP dP'] 6 dr pdor by auto also have "\ \ trace (Q' * denote S \) + (trace \ - trace (denote S \))" using c unfolding hoare_partial_correct_def using pds by auto also have "\ \ trace (Q * denote S \) + (trace \ - trace (denote S \))" using lowner_le_trace[OF dQ' dQ] 6 dSr pdoSr by auto finally show "trace (P * \) \ trace (Q * denote S \) + (trace \ - trace (denote S \)) ". qed qed lemma wlp_complete: "well_com S \ is_quantum_predicate P \ \\<^sub>p {wlp S P} S {P}" proof (induct S arbitrary: P) case SKIP then show ?case unfolding wlp.simps using hoare_partial.intros by auto next case (Utrans U) then show ?case unfolding wlp.simps using hoare_partial.intros by auto next case (Seq S1 S2) then have wc1: "well_com S1" and wc2: "well_com S2" and qpP: "is_quantum_predicate P" and p2: "\\<^sub>p {wlp S2 P} S2 {P}" by auto have qpW2P: "is_quantum_predicate (wlp S2 P)" using wlp_close[OF wc2 qpP] by auto then have p1: "\\<^sub>p {wlp S1 (wlp S2 P)} S1 {wlp S2 P}" using Seq by auto have qpW1W2P: "is_quantum_predicate (wlp S1 (wlp S2 P))" using wlp_close[OF wc1 qpW2P] by auto then show ?case unfolding wlp.simps using hoare_partial.intros qpW1W2P qpW2P qpP p1 p2 by auto next case (Measure n M S) then have wc: "well_com (Measure n M S)" and qpP: "is_quantum_predicate P" by auto have set: "k < n \ (S!k) \ set S" for k using wc by auto have wck: "k < n \ well_com (S!k)" for k using wc measure_well_com by auto then have qpWkP: "k < n \ is_quantum_predicate (wlp (S!k) P)" for k using wlp_close qpP by auto have pk: "k < n \ \\<^sub>p {(wlp (S!k) P)} (S!k) {P}" for k using Measure(1) set wck qpP by auto show ?case unfolding wlp_measure_expand[OF wc] using hoare_partial.intros qpWkP qpP pk by auto next case (While M S) then have wc: "well_com (While M S)" and wcS: "well_com S" and qpP: "is_quantum_predicate P " by auto have qpWP: "is_quantum_predicate (wlp (While M S) P)" using wlp_close[OF wc qpP] by auto then have qpWWP: "is_quantum_predicate (wlp S (wlp (While M S) P))" using wlp_close wcS by auto have "\\<^sub>p {wlp S (wlp (While M S) P)} S {wlp (While M S) P}" using While(1) wcS qpWP by auto moreover have eq: "wlp (While M S) P = adjoint (M 0) * P * M 0 + adjoint (M 1) * wlp S (wlp (While M S) P) * M 1" using wlp_while_split wc qpP by auto ultimately have p: "\\<^sub>p {wlp S (wlp (While M S) P)} S {adjoint (M 0) * P * M 0 + adjoint (M 1) * wlp S (wlp (While M S) P) * M 1}" by auto then show ?case using hoare_partial.intros(5)[OF qpP qpWWP p] eq by auto qed theorem hoare_partial_complete: "\\<^sub>p {P} S {Q} \ well_com S \ is_quantum_predicate P \ is_quantum_predicate Q \ \\<^sub>p {P} S {Q}" proof - assume p: "\\<^sub>p {P} S {Q}" and wc: "well_com S" and qpP: "is_quantum_predicate P" and qpQ: "is_quantum_predicate Q" then have dQ: "Q \ carrier_mat d d" using is_quantum_predicate_def by auto have qpWP: "is_quantum_predicate (wlp S Q)" using wlp_close wc qpQ by auto then have dWP: "wlp S Q \ carrier_mat d d" using is_quantum_predicate_def by auto have eq: "trace (wlp S Q * \) = trace (Q * (denote S \)) + trace \ - trace (denote S \)" if dsr: "\ \ density_states" for \ using wlp_soundness wc qpQ dsr by auto then have "\\<^sub>p {wlp S Q} S {Q}" unfolding hoare_partial_correct_def by auto { fix \ assume dsr: "\ \ density_states" then have "trace (P * \) \ trace (Q * (denote S \)) + trace \ - trace (denote S \)" - using hoare_partial_correct_def p by auto + using hoare_partial_correct_def p by (auto simp: less_eq_complex_def) then have "trace (P * \) \ trace (wlp S Q * \)" using eq[symmetric] dsr by auto } then have le: "P \\<^sub>L wlp S Q" using lowner_le_trace density_states_def qpP qpWP is_quantum_predicate_def by auto moreover have wlp: "\\<^sub>p {wlp S Q} S {Q}" using wlp_complete wc qpQ by auto ultimately show "\\<^sub>p {P} S {Q}" using hoare_partial.intros(6)[OF qpP qpQ qpWP qpQ] lowner_le_refl[OF dQ] by auto qed subsection \Consequences of completeness\ lemma hoare_patial_seq_assoc_sem: shows "\\<^sub>p {A} (S1 ;; S2) ;; S3 {B} \ \\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" unfolding hoare_partial_correct_def denote.simps by auto lemma hoare_patial_seq_assoc: assumes "well_com S1" and "well_com S2" and "well_com S3" and "is_quantum_predicate A" and "is_quantum_predicate B" shows "\\<^sub>p {A} (S1 ;; S2) ;; S3 {B} \ \\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" proof assume "\\<^sub>p {A} S1;; S2;; S3 {B}" then have "\\<^sub>p {A} (S1 ;; S2) ;; S3 {B}" using hoare_partial_sound assms by auto then have "\\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" using hoare_patial_seq_assoc_sem by auto then show "\\<^sub>p {A} S1 ;; (S2 ;; S3) {B}" using hoare_partial_complete assms by auto next assume "\\<^sub>p {A} S1;; (S2;; S3) {B}" then have "\\<^sub>p {A} S1;; (S2;; S3) {B}" using hoare_partial_sound assms by auto then have "\\<^sub>p {A} S1;; S2;; S3 {B}" using hoare_patial_seq_assoc_sem by auto then show "\\<^sub>p {A} S1;; S2;; S3 {B}" using hoare_partial_complete assms by auto qed end end diff --git a/thys/QHLProver/Quantum_Program.thy b/thys/QHLProver/Quantum_Program.thy --- a/thys/QHLProver/Quantum_Program.thy +++ b/thys/QHLProver/Quantum_Program.thy @@ -1,1109 +1,1110 @@ section \Quantum programs\ theory Quantum_Program imports Matrix_Limit begin subsection \Syntax\ text \Datatype for quantum programs\ datatype com = SKIP | Utrans "complex mat" | Seq com com ("_;;/ _" [60, 61] 60) | Measure nat "nat \ complex mat" "com list" | While "nat \ complex mat" com text \A state corresponds to the density operator\ type_synonym state = "complex mat" text \List of dimensions of quantum states\ locale state_sig = fixes dims :: "nat list" begin definition d :: nat where "d = prod_list dims" text \Wellformedness of commands\ fun well_com :: "com \ bool" where "well_com SKIP = True" | "well_com (Utrans U) = (U \ carrier_mat d d \ unitary U)" | "well_com (Seq S1 S2) = (well_com S1 \ well_com S2)" | "well_com (Measure n M S) = (measurement d n M \ length S = n \ list_all well_com S)" | "well_com (While M S) = (measurement d 2 M \ well_com S)" subsection \Denotational semantics\ text \Denotation of going through the while loop n times\ fun denote_while_n_iter :: "complex mat \ complex mat \ (state \ state) \ nat \ state \ state" where "denote_while_n_iter M0 M1 DS 0 \ = \" | "denote_while_n_iter M0 M1 DS (Suc n) \ = denote_while_n_iter M0 M1 DS n (DS (M1 * \ * adjoint M1))" fun denote_while_n :: "complex mat \ complex mat \ (state \ state) \ nat \ state \ state" where "denote_while_n M0 M1 DS n \ = M0 * denote_while_n_iter M0 M1 DS n \ * adjoint M0" fun denote_while_n_comp :: "complex mat \ complex mat \ (state \ state) \ nat \ state \ state" where "denote_while_n_comp M0 M1 DS n \ = M1 * denote_while_n_iter M0 M1 DS n \ * adjoint M1" lemma denote_while_n_iter_assoc: "denote_while_n_iter M0 M1 DS (Suc n) \ = DS (M1 * (denote_while_n_iter M0 M1 DS n \) * adjoint M1)" proof (induct n arbitrary: \) case 0 show ?case by auto next case (Suc n) show ?case apply (subst denote_while_n_iter.simps) apply (subst Suc, auto) done qed lemma denote_while_n_iter_dim: "\ \ carrier_mat m m \ partial_density_operator \ \ M1 \ carrier_mat m m \ adjoint M1 * M1 \\<^sub>L 1\<^sub>m m \ (\\. \ \ carrier_mat m m \ partial_density_operator \ \ DS \ \ carrier_mat m m \ partial_density_operator (DS \)) \ denote_while_n_iter M0 M1 DS n \ \ carrier_mat m m \ partial_density_operator (denote_while_n_iter M0 M1 DS n \)" proof (induct n arbitrary: \) case 0 then show ?case unfolding denote_while_n_iter.simps by auto next case (Suc n) then have dr: "\ \ carrier_mat m m" and dM1: "M1 \ carrier_mat m m" by auto have dMr: "M1 * \ * adjoint M1 \ carrier_mat m m" using dr dM1 by fastforce have pdoMr: "partial_density_operator (M1 * \ * adjoint M1)" using pdo_close_under_measurement Suc by auto from Suc dMr pdoMr have d: "DS (M1 * \ * adjoint M1) \ carrier_mat m m" and "partial_density_operator (DS (M1 * \ * adjoint M1))" by auto then show ?case unfolding denote_while_n_iter.simps using Suc by auto qed lemma pdo_denote_while_n_iter: "\ \ carrier_mat m m \ partial_density_operator \ \ M1 \ carrier_mat m m \ adjoint M1 * M1 \\<^sub>L 1\<^sub>m m \ (\\. \ \ carrier_mat m m \ partial_density_operator \ \ partial_density_operator (DS \)) \ (\\. \ \ carrier_mat m m \ partial_density_operator \ \ DS \ \ carrier_mat m m) \ partial_density_operator (denote_while_n_iter M0 M1 DS n \)" proof (induct n arbitrary: \) case 0 then show ?case unfolding denote_while_n_iter.simps by auto next case (Suc n) have "partial_density_operator (M1 * \ * adjoint M1)" using Suc pdo_close_under_measurement by auto moreover have "M1 * \ * adjoint M1 \ carrier_mat m m" using Suc by auto ultimately have p: "partial_density_operator (DS (M1 * \ * adjoint M1))" and d: "DS (M1 * \ * adjoint M1) \ carrier_mat m m "using Suc by auto show ?case unfolding denote_while_n_iter.simps using Suc(1)[OF d p Suc(4) Suc(5)] Suc by auto qed text \Denotation of while is simply the infinite sum of denote\_while\_n\ definition denote_while :: "complex mat \ complex mat \ (state \ state) \ state \ state" where "denote_while M0 M1 DS \ = matrix_inf_sum d (\n. denote_while_n M0 M1 DS n \)" lemma denote_while_n_dim: assumes "\ \ carrier_mat d d" "M0 \ carrier_mat d d" "M1 \ carrier_mat d d" "partial_density_operator \" "\\'. \' \ carrier_mat d d \ partial_density_operator \' \ positive (DS \') \ trace (DS \') \ trace \' \ DS \' \ carrier_mat d d" shows "denote_while_n M0 M1 DS n \ \ carrier_mat d d" proof (induction n arbitrary: \) case 0 then show ?case proof - have "M0 * \ * adjoint M0 \ carrier_mat d d" using assms assoc_mult_mat by auto then show ?thesis by auto qed next case (Suc n) then show ?case proof - have "denote_while_n M0 M1 DS n (DS (M1 * \ * adjoint M1)) \ carrier_mat d d" using Suc assms by auto then show ?thesis by auto qed qed lemma denote_while_n_sum_dim: assumes "\ \ carrier_mat d d" "M0 \ carrier_mat d d" "M1 \ carrier_mat d d" "partial_density_operator \" "\\'. \' \ carrier_mat d d \ partial_density_operator \' \ positive (DS \') \ trace (DS \') \ trace \' \ DS \' \ carrier_mat d d" shows "matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \ carrier_mat d d" proof (induct n) case 0 then show ?case by auto next case (Suc n) then show ?case proof - have " denote_while_n M0 M1 DS n \ \ carrier_mat d d" using denote_while_n_dim assms by auto then have "matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n) \ carrier_mat d d" using Suc by auto then show ?thesis by auto qed qed lemma trace_decrease_mul_adj: assumes pdo: "partial_density_operator \" and dimr: "\ \ carrier_mat d d" and dimx: "x \ carrier_mat d d" and un: "adjoint x * x \\<^sub>L 1\<^sub>m d " shows "trace (x * \ * adjoint x) \ trace \" proof - have ad: "adjoint x * x \ carrier_mat d d" using adjoint_dim index_mult_mat dimx by auto have "trace (x * \ * adjoint x) = trace ((adjoint x * x) * \)" using dimx dimr by (mat_assoc d) also have "\ \ trace (1\<^sub>m d * \)" using lowner_le_trace un ad dimr pdo by auto also have "\ = trace \" using dimr by auto ultimately show ?thesis by auto qed lemma denote_while_n_positive: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and un: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" shows "partial_density_operator \ \ \ \ carrier_mat d d \ positive (denote_while_n M0 M1 DS n \)" proof (induction n arbitrary: \) case 0 then show ?case using positive_close_under_left_right_mult_adjoint dim0 unfolding partial_density_operator_def by auto next case (Suc n) then show ?case proof - have pdoM: "partial_density_operator (M1 * \ * adjoint M1)" using pdo_close_under_measurement Suc dim1 un by auto moreover have cM: "M1 * \ * adjoint M1 \ carrier_mat d d" using Suc dim1 adjoint_dim index_mult_mat by auto ultimately have DSM1: "positive (DS (M1 * \ * adjoint M1)) \ trace (DS (M1 * \ * adjoint M1)) \ trace (M1 * \ * adjoint M1) \ DS (M1 * \ * adjoint M1) \ carrier_mat d d" using DS by auto moreover have "trace (M1 * \ * adjoint M1) \ trace \" using trace_decrease_mul_adj Suc dim1 un by auto ultimately have "partial_density_operator (DS (M1 * \ * adjoint M1))" using Suc unfolding partial_density_operator_def by auto then have "positive (M0 * denote_while_n_iter M0 M1 DS n (DS (M1 * \ * adjoint M1)) * adjoint M0)" using Suc DSM1 by auto then have "positive (denote_while_n M0 M1 DS (Suc n) \)" by auto then show ?thesis by auto qed qed lemma denote_while_n_sum_positive: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and un: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and pdo: "partial_density_operator \" and r: " \ \ carrier_mat d d" shows "positive (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" proof - have "\k. k < n \ positive (denote_while_n M0 M1 DS k \)" using assms denote_while_n_positive by auto moreover have "\k. k < n \ denote_while_n M0 M1 DS k \ \ carrier_mat d d" using denote_while_n_dim assms by auto ultimately show ?thesis using matrix_sum_positive by auto qed lemma trace_measure2_id: assumes dM0: "M0 \ carrier_mat n n" and dM1: "M1 \ carrier_mat n n" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m n" and dA: "A \ carrier_mat n n" shows "trace (M0 * A * adjoint M0) + trace (M1 * A * adjoint M1) = trace A" proof - have "trace (M0 * A * adjoint M0) + trace (M1 * A * adjoint M1) = trace ((adjoint M0 * M0 + adjoint M1 * M1) * A)" using assms by (mat_assoc n) also have "\ = trace (1\<^sub>m n * A)" using id by auto also have "\ = trace A" using dA by auto finally show ?thesis. qed lemma measurement_lowner_le_one1: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" shows "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" proof - have paM0: "positive (adjoint M0 * M0)" apply (subgoal_tac "adjoint M0 * adjoint (adjoint M0) = adjoint M0 * M0") subgoal using positive_if_decomp[of "adjoint M0 * M0"] dim0 adjoint_dim[OF dim0] by fastforce using adjoint_adjoint[of M0] by auto have le1: "adjoint M0 * M0 + adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using id lowner_le_refl[of "1\<^sub>m d"] by fastforce show "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using add_positive_le_reduce2[OF _ _ _ paM0 le1] dim0 dim1 by fastforce qed lemma denote_while_n_sum_trace: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and r: " \ \ carrier_mat d d" and pdor: "partial_density_operator \" shows "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ trace \" proof - have un: "adjoint M1 * M1 \\<^sub>L 1\<^sub>m d" using measurement_lowner_le_one1 using dim0 dim1 id by auto have DS': "(DS \ \ carrier_mat d d) \ partial_density_operator (DS \)" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ proof - have res: "positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" using DS that by auto moreover have "trace \ \ 1" using that partial_density_operator_def by auto ultimately have "trace (DS \) \ 1" by auto with res show ?thesis unfolding partial_density_operator_def by auto qed have dWk: "denote_while_n_iter M0 M1 DS k \ \ carrier_mat d d" for k using denote_while_n_iter_dim[OF r pdor dim1 un] DS' dim0 dim1 by auto have pdoWk: "partial_density_operator (denote_while_n_iter M0 M1 DS k \)" for k using pdo_denote_while_n_iter[OF r pdor dim1 un] DS' dim0 dim1 by auto have dW0k: "denote_while_n M0 M1 DS k \ \ carrier_mat d d" for k using denote_while_n_dim r dim0 dim1 pdor by auto then have dsW0k: "matrix_sum d (\n. denote_while_n M0 M1 DS n \) k \ carrier_mat d d" for k using matrix_sum_dim[of k "\k. denote_while_n M0 M1 DS k \"] by auto have "(denote_while_n_comp M0 M1 DS n \) \ carrier_mat d d" for n unfolding denote_while_n_comp.simps using dim1 dWk by auto moreover have pdoW1k: "partial_density_operator (denote_while_n_comp M0 M1 DS n \)" for n unfolding denote_while_n_comp.simps using pdo_close_under_measurement[OF dim1 dWk pdoWk un] by auto ultimately have "trace (DS (denote_while_n_comp M0 M1 DS n \)) \ trace (denote_while_n_comp M0 M1 DS n \)" for n using DS by auto moreover have "trace (denote_while_n_iter M0 M1 DS (Suc n) \) = trace (DS (denote_while_n_comp M0 M1 DS n \))" for n using denote_while_n_iter_assoc[folded denote_while_n_comp.simps] by auto ultimately have leq3: "trace (denote_while_n_iter M0 M1 DS (Suc n) \) \ trace (denote_while_n_comp M0 M1 DS n \)" for n by auto have mainleq: "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)) + trace (denote_while_n_comp M0 M1 DS n \) \ trace \" for n proof (induct n) case 0 then show ?case unfolding matrix_sum.simps denote_while_n.simps denote_while_n_comp.simps denote_while_n_iter.simps apply (subgoal_tac "M0 * \ * adjoint M0 + 0\<^sub>m d d = M0 * \ * adjoint M0") using trace_measure2_id[OF dim0 dim1 id r] dim0 apply simp using dim0 by auto next case (Suc n) have eq1: "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc (Suc n))) = trace (denote_while_n M0 M1 DS (Suc n) \) + trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n))" unfolding matrix_sum.simps using trace_add_linear dW0k[of "Suc n"] dsW0k[of "Suc n"] by auto have eq2: "trace (denote_while_n M0 M1 DS (Suc n) \) + trace (denote_while_n_comp M0 M1 DS (Suc n) \) = trace (denote_while_n_iter M0 M1 DS (Suc n) \)" unfolding denote_while_n.simps denote_while_n_comp.simps using trace_measure2_id[OF dim0 dim1 id dWk[of "Suc n"]] by auto have "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc (Suc n))) + trace (denote_while_n_comp M0 M1 DS (Suc n) \) = trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)) + trace (denote_while_n M0 M1 DS (Suc n) \) + trace (denote_while_n_comp M0 M1 DS (Suc n) \)" using eq1 by auto also have "\ = trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)) + trace (denote_while_n_iter M0 M1 DS (Suc n) \)" using eq2 by auto also have "\ \ trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)) + trace (denote_while_n_comp M0 M1 DS n \)" using leq3 by auto also have "\ \ trace \" using Suc by auto finally show ?case. qed - have reduce_le_complex: "(b::complex) \ 0 \ a + b \ c \ a \ c" for a b c by simp + have reduce_le_complex: "(b::complex) \ 0 \ a + b \ c \ a \ c" for a b c + by (simp add: less_eq_complex_def) have "positive (denote_while_n_comp M0 M1 DS n \)" for n using pdoW1k unfolding partial_density_operator_def by auto then have "trace (denote_while_n_comp M0 M1 DS n \) \ 0" for n using positive_trace using \\n. denote_while_n_comp M0 M1 DS n \ \ carrier_mat d d\ by blast then have "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)) \ trace \" for n using mainleq reduce_le_complex[of "trace (denote_while_n_comp M0 M1 DS n \)"] by auto moreover have "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) 0) \ trace \" unfolding matrix_sum.simps using trace_zero positive_trace pdor unfolding partial_density_operator_def using r by auto ultimately show "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ trace \" for n apply (induct n) by auto qed lemma denote_while_n_sum_partial_density: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and pdo: "partial_density_operator \" and r: " \ \ carrier_mat d d" shows "(partial_density_operator (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n))" proof - have "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ trace \" using denote_while_n_sum_trace assms by auto then have "trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ 1" using pdo unfolding partial_density_operator_def by auto moreover have "positive (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" using assms DS denote_while_n_sum_positive measurement_lowner_le_one1[OF dim0 dim1 id] by auto ultimately show ?thesis unfolding partial_density_operator_def by auto qed lemma denote_while_n_sum_lowner_le: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and pdo: "partial_density_operator \" and dimr: " \ \ carrier_mat d d" shows "(matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \\<^sub>L matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n))" proof auto have whilenc: "denote_while_n M0 M1 DS n \ \ carrier_mat d d" using denote_while_n_dim assms by auto have sumc: "matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \ carrier_mat d d" using denote_while_n_sum_dim assms by auto have "denote_while_n M0 M1 DS n \ + matrix_sum d (\n. denote_while_n M0 M1 DS n \) n - matrix_sum d (\n. denote_while_n M0 M1 DS n \) n = denote_while_n M0 M1 DS n \ + matrix_sum d (\n. denote_while_n M0 M1 DS n \) n + (- matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" using minus_add_uminus_mat[of "matrix_sum d (\n. denote_while_n M0 M1 DS n \) n" d d "matrix_sum d (\n. denote_while_n M0 M1 DS n \) n"] by auto also have "\ = denote_while_n M0 M1 DS n \ + 0\<^sub>m d d" by (smt assoc_add_mat minus_add_uminus_mat minus_r_inv_mat sumc uminus_carrier_mat whilenc) also have "\ = denote_while_n M0 M1 DS n \" using whilenc by auto finally have simp: "denote_while_n M0 M1 DS n \ + matrix_sum d (\n. denote_while_n M0 M1 DS n \) n - matrix_sum d (\n. denote_while_n M0 M1 DS n \) n = denote_while_n M0 M1 DS n \ " by auto have "positive (denote_while_n M0 M1 DS n \)" using denote_while_n_positive assms measurement_lowner_le_one1[OF dim0 dim1 id] by auto then have "matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \\<^sub>L (denote_while_n M0 M1 DS n \ + matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" unfolding lowner_le_def using simp by auto then show "matrix_sum d (\n. M0 * denote_while_n_iter M0 M1 DS n \ * adjoint M0) n \\<^sub>L (M0 * denote_while_n_iter M0 M1 DS n \ * adjoint M0 + matrix_sum d (\n. M0 * denote_while_n_iter M0 M1 DS n \ * adjoint M0) n)" by auto qed lemma lowner_is_lub_matrix_sum: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and pdo: "partial_density_operator \" and dimr: " \ \ carrier_mat d d" shows "matrix_seq.lowner_is_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \)) (matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \)))" proof- have sumdd: "\n. matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \ carrier_mat d d" using denote_while_n_sum_dim assms by auto have sumtr: "\n. trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ trace \" using denote_while_n_sum_trace assms by auto have sumpar: "\n. partial_density_operator (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" using denote_while_n_sum_partial_density assms by auto have sumle:"\n. matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \\<^sub>L matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)" using denote_while_n_sum_lowner_le assms by auto have seqd: "matrix_seq d (matrix_sum d (\n. denote_while_n M0 M1 DS n \))" using matrix_seq_def sumdd sumpar sumle by auto then show ?thesis using matrix_seq.lowner_lub_prop[of d "(matrix_sum d (\n. denote_while_n M0 M1 DS n \))"] by auto qed lemma denote_while_dim_positive: assumes dim0: "M0 \ carrier_mat d d" and dim1: "M1 \ carrier_mat d d" and id: "adjoint M0 * M0 + adjoint M1 * M1 = 1\<^sub>m d" and DS: "\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (DS \) \ trace (DS \) \ trace \ \ DS \ \ carrier_mat d d" and pdo: "partial_density_operator \" and dimr: " \ \ carrier_mat d d" shows "denote_while M0 M1 DS \ \ carrier_mat d d \ positive (denote_while M0 M1 DS \) \ trace (denote_while M0 M1 DS \) \ trace \" proof - have sumdd: "\n. matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \ carrier_mat d d" using denote_while_n_sum_dim assms by auto have sumtr: "\n. trace (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n) \ trace \" using denote_while_n_sum_trace assms by auto have sumpar: "\n. partial_density_operator (matrix_sum d (\n. denote_while_n M0 M1 DS n \) n)" using denote_while_n_sum_partial_density assms by auto have sumle:"\n. matrix_sum d (\n. denote_while_n M0 M1 DS n \) n \\<^sub>L matrix_sum d (\n. denote_while_n M0 M1 DS n \) (Suc n)" using denote_while_n_sum_lowner_le assms by auto have seqd: "matrix_seq d (matrix_sum d (\n. denote_while_n M0 M1 DS n \))" using matrix_seq_def sumdd sumpar sumle by auto have "matrix_seq.lowner_is_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \)) (matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \)))" using lowner_is_lub_matrix_sum assms by auto then have "matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \)) \ carrier_mat d d \ positive (matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \))) \ trace (matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n M0 M1 DS n \))) \ trace \" using matrix_seq.lowner_is_lub_dim seqd matrix_seq.lowner_lub_is_positive matrix_seq.lowner_lub_trace sumtr by auto then show ?thesis unfolding denote_while_def matrix_inf_sum_def by auto qed definition denote_measure :: "nat \ (nat \ complex mat) \ ((state \ state) list) \ state \ state" where "denote_measure n M DS \ = matrix_sum d (\k. (DS!k) ((M k) * \ * adjoint (M k))) n" lemma denote_measure_dim: assumes "\ \ carrier_mat d d" "measurement d n M" "\\' k. \' \ carrier_mat d d \ k < n \ (DS!k) \' \ carrier_mat d d" shows "denote_measure n M DS \ \ carrier_mat d d" proof - have dMk: "k < n \ M k \ carrier_mat d d" for k using assms measurement_def by auto have d: "k < n \ (M k) * \ * adjoint (M k) \ carrier_mat d d" for k using mult_carrier_mat[OF mult_carrier_mat[OF dMk assms(1)] adjoint_dim[OF dMk]] by auto then have "k < n \ (DS!k) ((M k) * \ * adjoint (M k)) \ carrier_mat d d" for k using assms(3) by auto then show ?thesis unfolding denote_measure_def using matrix_sum_dim[of n "\k. (DS!k) ((M k) * \ * adjoint (M k))"] by auto qed lemma measure_well_com: assumes "well_com (Measure n M S)" shows "\k. k < n \ well_com (S ! k)" using assms unfolding well_com.simps using list_all_length by auto text \Semantics of commands\ fun denote :: "com \ state \ state" where "denote SKIP \ = \" | "denote (Utrans U) \ = U * \ * adjoint U" | "denote (Seq S1 S2) \ = denote S2 (denote S1 \)" | "denote (Measure n M S) \ = denote_measure n M (map denote S) \" | "denote (While M S) \ = denote_while (M 0) (M 1) (denote S) \" lemma denote_measure_expand: assumes m: "m \ n" and wc: "well_com (Measure n M S)" shows "denote (Measure m M S) \ = matrix_sum d (\k. denote (S!k) ((M k) * \ * adjoint (M k))) m" unfolding denote.simps denote_measure_def proof - have "k < m \ map denote S ! k = denote (S!k)" for k using wc m by auto then have "k < m \ (map denote S ! k) (M k * \ * adjoint (M k)) = denote (S!k) ((M k) * \ * adjoint (M k))" for k by auto then show "matrix_sum d (\k. (map denote S ! k) (M k * \ * adjoint (M k))) m = matrix_sum d (\k. denote (S ! k) (M k * \ * adjoint (M k))) m" using matrix_sum_cong[of m "\k. (map denote S ! k) (M k * \ * adjoint (M k))" "\k. denote (S ! k) (M k * \ * adjoint (M k))"] by auto qed lemma matrix_sum_trace_le: fixes f :: "nat \ complex mat" and g :: "nat \ complex mat" assumes "(\k. k < n \ f k \ carrier_mat d d)" "(\k. k < n \ g k \ carrier_mat d d)" "(\k. k < n \ trace (f k) \ trace (g k))" shows "trace (matrix_sum d f n) \ trace (matrix_sum d g n)" proof - have "sum (\k. trace (f k)) {0.. sum (\k. trace (g k)) {0.. carrier_mat d d" "partial_density_operator x4" "\x3aa \. x3aa \ set x3a \ well_com x3aa \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x3aa \) \ trace (denote x3aa \) \ trace \ \ denote x3aa \ \ carrier_mat d d" shows "\k < x1. positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ carrier_mat d d \ trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ trace (x2a k * x4 * adjoint (x2a k))" proof - have x2ak: "\ k < x1. x2a k \ carrier_mat d d" using assms(1) measurement_dim by auto then have x2aa:"\ k < x1. (x2a k * x4 * adjoint (x2a k)) \ carrier_mat d d" using assms(2) by fastforce have posct: "positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ carrier_mat d d \ trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ trace (x2a k * x4 * adjoint (x2a k))" if k: "k < x1" for k proof - have lea: "adjoint (x2a k) * x2a k \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms(1) k by auto have "(x2a k * x4 * adjoint (x2a k)) \ carrier_mat d d" using k x2aa assms(2) by fastforce moreover have "(x3a ! k) \ set x3a" using k assms(1) by simp moreover have "well_com (x3a ! k)" using k assms(1) using measure_well_com by blast moreover have "partial_density_operator (x2a k * x4 * adjoint (x2a k))" using pdo_close_under_measurement x2ak assms(2,3) lea k by blast ultimately have "positive (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ carrier_mat d d \ trace (denote (x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ trace (x2a k * x4 * adjoint (x2a k))" using assms(4) by auto then show ?thesis using assms(1) k by auto qed then show ?thesis by auto qed lemma denote_measure_positive_trace_dim: assumes "well_com (Measure x1 x2a x3a)" "x4 \ carrier_mat d d" "partial_density_operator x4" "\x3aa \. x3aa \ set x3a \ well_com x3aa \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x3aa \) \ trace (denote x3aa \) \ trace \ \ denote x3aa \ \ carrier_mat d d" shows "positive (denote (Measure x1 x2a x3a) x4) \ trace (denote (Measure x1 x2a x3a) x4) \ trace x4 \ (denote (Measure x1 x2a x3a) x4) \ carrier_mat d d" proof - have x2ak: "\ k < x1. x2a k \ carrier_mat d d" using assms(1) measurement_dim by auto then have x2aa:"\ k < x1. (x2a k * x4 * adjoint (x2a k)) \ carrier_mat d d" using assms(2) by fastforce have posct:"\ k < x1. positive ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ carrier_mat d d \ trace ((map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) \ trace (x2a k * x4 * adjoint (x2a k))" using map_denote_positive_trace_dim assms by auto have "trace (matrix_sum d (\k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) x1) \ trace (matrix_sum d (\k. (x2a k * x4 * adjoint (x2a k))) x1)" using posct matrix_sum_trace_le[of x1 "(\k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k)))" "(\k. x2a k * x4 * adjoint (x2a k)) "] x2aa by auto also have "\ = trace x4" using trace_measurement[of d "x1" "x2a" x4] assms(1,2) by auto finally have " trace (matrix_sum d (\k. (map denote x3a ! k) (x2a k * x4 * adjoint (x2a k))) x1) \ trace x4" by auto then have "trace (denote_measure x1 x2a (map denote x3a) x4) \ trace x4" unfolding denote_measure_def by auto then have "trace (denote (Measure x1 x2a x3a) x4) \ trace x4" by auto moreover from posct have "positive (denote (Measure x1 x2a x3a) x4)" apply auto unfolding denote_measure_def using matrix_sum_positive by auto moreover have "(denote (Measure x1 x2a x3a) x4) \ carrier_mat d d" apply auto unfolding denote_measure_def using matrix_sum_dim posct by (simp add: matrix_sum_dim) ultimately show ?thesis by auto qed lemma denote_positive_trace_dim: "well_com S \ \ \ carrier_mat d d \ partial_density_operator \ \ (positive (denote S \) \ trace (denote S \) \ trace \ \ denote S \ \ carrier_mat d d)" proof (induction arbitrary: \) case SKIP then show ?case unfolding partial_density_operator_def by auto next case (Utrans x) then show ?case proof - assume wc: "well_com (Utrans x)" and r: "\ \ carrier_mat d d" and pdo: "partial_density_operator \" show "positive (denote (Utrans x) \) \ trace (denote (Utrans x) \) \ trace \ \ denote (Utrans x) \ \ carrier_mat d d" proof - have "trace (x * \ * adjoint x) = trace ((adjoint x * x) * \)" using r apply (mat_assoc d) using wc by auto also have "\ = trace (1\<^sub>m d * \)" using wc inverts_mat_def inverts_mat_symm adjoint_dim by auto also have "\ = trace \" using r by auto finally have fst: "trace (x * \ * adjoint x) = trace \" by auto moreover have "positive (x * \ * adjoint x)" using positive_close_under_left_right_mult_adjoint r pdo wc unfolding partial_density_operator_def by auto moreover have "x * \ * adjoint x \ carrier_mat d d" using r wc adjoint_dim index_mult_mat by auto ultimately show ?thesis by auto qed qed next case (Seq x1 x2a) then show ?case proof - assume dx1: "(\\. well_com x1 \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x1 \) \ trace (denote x1 \) \ trace \ \ denote x1 \ \ carrier_mat d d)" and dx2a: "(\\. well_com x2a \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x2a \) \ trace (denote x2a \) \ trace \ \ denote x2a \ \ carrier_mat d d)" and wc: "well_com (Seq x1 x2a)" and r: "\ \ carrier_mat d d" and pdo: "partial_density_operator \" show "positive (denote (Seq x1 x2a) \) \ trace (denote (Seq x1 x2a) \) \ trace \ \ denote (Seq x1 x2a) \ \ carrier_mat d d" proof - have ptc: "positive (denote x1 \) \ trace (denote x1 \) \ trace \ \ denote x1 \ \ carrier_mat d d" using wc r pdo dx1 by auto then have "partial_density_operator (denote x1 \)" using pdo unfolding partial_density_operator_def by auto then show ?thesis using ptc dx2a wc dual_order.trans by auto qed qed next case (Measure x1 x2a x3a) then show ?case using denote_measure_positive_trace_dim by auto next case (While x1 x2a) then show ?case proof - have "adjoint (x1 0) * (x1 0) + adjoint (x1 1) * (x1 1) = 1\<^sub>m d" using measurement_id2 While by auto moreover have "(\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x2a \) \ trace (denote x2a \) \ trace \ \ denote x2a \ \ carrier_mat d d)" using While by fastforce moreover have "x1 0 \ carrier_mat d d \ x1 1 \ carrier_mat d d" using measurement_dim While by fastforce ultimately have "denote_while (x1 0) (x1 1) (denote x2a) \ \ carrier_mat d d \ positive (denote_while (x1 0) (x1 1) (denote x2a) \) \ trace (denote_while (x1 0) (x1 1) (denote x2a) \) \ trace \" using denote_while_dim_positive[of "x1 0" "x1 1" "denote x2a" "\"] While by fastforce then show ?thesis by auto qed qed lemma denote_dim_pdo: "well_com S \ \ \ carrier_mat d d \ partial_density_operator \ \ (denote S \ \ carrier_mat d d) \ (partial_density_operator (denote S \))" using denote_positive_trace_dim unfolding partial_density_operator_def by fastforce lemma denote_dim: "well_com S \ \ \ carrier_mat d d \ partial_density_operator \ \ (denote S \ \ carrier_mat d d)" using denote_positive_trace_dim by auto lemma denote_trace: "well_com S \ \ \ carrier_mat d d \ partial_density_operator \ \ trace (denote S \) \ trace \" using denote_positive_trace_dim by auto lemma denote_partial_density_operator: assumes "well_com S" "partial_density_operator \" "\ \ carrier_mat d d" shows "partial_density_operator (denote S \)" using assms denote_positive_trace_dim unfolding partial_density_operator_def using dual_order.trans by blast lemma denote_while_n_sum_mat_seq: assumes "\ \ carrier_mat d d" and "x1 0 \ carrier_mat d d" and "x1 1 \ carrier_mat d d" and "partial_density_operator \" and wc: "well_com x2" and mea: "measurement d 2 x1" shows "matrix_seq d (matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \))" proof - let ?A = "x1 0" and ?B = "x1 1" have dx2:"\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive ((denote x2) \) \ trace ((denote x2) \) \ trace \ \ (denote x2) \ \ carrier_mat d d" using denote_positive_trace_dim wc by auto have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto have "\n. matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n \ carrier_mat d d" using assms dx2 by (metis denote_while_n_dim matrix_sum_dim) moreover have "(\n. partial_density_operator (matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n))" using assms dx2 lo1 by (metis denote_while_n_sum_partial_density) moreover have "(\n. matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n \\<^sub>L matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) (Suc n))" using assms dx2 lo1 by (metis denote_while_n_sum_lowner_le) ultimately show ?thesis unfolding matrix_seq_def by auto qed lemma denote_while_n_add: assumes M0: "x1 0 \ carrier_mat d d" and M1: "x1 1 \ carrier_mat d d" and wc: "well_com x2" and mea: "measurement d 2 x1" and DS: "(\\\<^sub>1 \\<^sub>2. \\<^sub>1 \ carrier_mat d d \ \\<^sub>2 \ carrier_mat d d \ partial_density_operator \\<^sub>1 \ partial_density_operator \\<^sub>2 \ trace (\\<^sub>1 + \\<^sub>2) \ 1 \ denote x2 (\\<^sub>1 + \\<^sub>2) = denote x2 \\<^sub>1 + denote x2 \\<^sub>2)" shows "\\<^sub>1 \ carrier_mat d d \ \\<^sub>2 \ carrier_mat d d \ partial_density_operator \\<^sub>1 \ partial_density_operator \\<^sub>2 \ trace (\\<^sub>1 + \\<^sub>2) \ 1 \ denote_while_n (x1 0) (x1 1) (denote x2) k (\\<^sub>1 + \\<^sub>2) = denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>1 + denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>2" proof (auto, induct k arbitrary: \\<^sub>1 \\<^sub>2) case 0 then show ?case apply auto using M0 by (mat_assoc d) next case (Suc k) then show ?case proof - let ?A = "x1 0" and ?B = "x1 1" have dx2:"(\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive ((denote x2) \) \ trace ((denote x2) \) \ trace \ \ (denote x2) \ \ carrier_mat d d) " using denote_positive_trace_dim wc by auto have lo1: "adjoint ?B * ?B \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms by auto have dim1: "x1 1 * \\<^sub>1 * adjoint (x1 1) \ carrier_mat d d" using assms Suc by (metis adjoint_dim mult_carrier_mat) moreover have pdo1: "partial_density_operator (x1 1 * \\<^sub>1 * adjoint (x1 1))" using pdo_close_under_measurement assms(2) Suc(2,4) lo1 by auto ultimately have dimr1: "denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1)) \ carrier_mat d d" using dx2 by auto have dim2: "x1 1 * \\<^sub>2 * adjoint (x1 1) \ carrier_mat d d" using assms Suc by (metis adjoint_dim mult_carrier_mat) moreover have pdo2: "partial_density_operator (x1 1 * \\<^sub>2 * adjoint (x1 1))" using pdo_close_under_measurement assms(2) Suc lo1 by auto ultimately have dimr2: "denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1)) \ carrier_mat d d" using dx2 by auto have pdor1: "partial_density_operator (denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1)))" using denote_partial_density_operator assms dim1 pdo1 by auto have pdor2: "partial_density_operator (denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1)))" using denote_partial_density_operator assms dim2 pdo2 by auto have "trace (denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1))) \ trace (x1 1 * \\<^sub>1 * adjoint (x1 1))" using dx2 dim1 pdo1 by auto also have tr1: "\ \ trace \\<^sub>1" using trace_decrease_mul_adj assms Suc lo1 by auto finally have trr1:" trace (denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1))) \ trace \\<^sub>1" by auto have "trace (denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ trace (x1 1 * \\<^sub>2 * adjoint (x1 1))" using dx2 dim2 pdo2 by auto also have tr2: "\ \ trace \\<^sub>2" using trace_decrease_mul_adj assms Suc lo1 by auto finally have trr2:" trace (denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ trace \\<^sub>2" by auto from tr1 tr2 Suc have "trace ( (x1 1 * \\<^sub>1 * adjoint (x1 1)) + (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ trace (\\<^sub>1 + \\<^sub>2)" using trace_add_linear trace_add_linear[of "(x1 1 * \\<^sub>1 * adjoint (x1 1))" d "(x1 1 * \\<^sub>2 * adjoint (x1 1))"] trace_add_linear[of \\<^sub>1 d \\<^sub>2] - using dim1 dim2 by auto + using dim1 dim2 by (auto simp: less_eq_complex_def) then have trless1: "trace ( (x1 1 * \\<^sub>1 * adjoint (x1 1)) + (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ 1" using Suc by auto from trr1 trr2 Suc have "trace (denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ trace (\\<^sub>1 + \\<^sub>2)" using trace_add_linear[of "denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1))" d "denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))"] trace_add_linear[of \\<^sub>1 d \\<^sub>2] - using dimr1 dimr2 by auto + using dimr1 dimr2 by (auto simp: less_eq_complex_def) then have trless2: "trace (denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))) \ 1" using Suc by auto have "x1 1 * (\\<^sub>1 + \\<^sub>2) * adjoint (x1 1) = (x1 1 * \\<^sub>1 * adjoint (x1 1)) + (x1 1 * \\<^sub>2 * adjoint (x1 1))" using M1 Suc by (mat_assoc d) then have deadd: "denote x2 (x1 1 * (\\<^sub>1 + \\<^sub>2) * adjoint (x1 1)) = denote x2 (x1 1 * \\<^sub>1 * adjoint (x1 1)) + denote x2 (x1 1 * \\<^sub>2 * adjoint (x1 1))" using assms(5) dim1 dim2 pdo1 pdo2 trless1 by auto from dimr1 dimr2 pdor1 pdor2 trless2 Suc(1) deadd show ?thesis by auto qed qed lemma denote_while_add: assumes r1: "\\<^sub>1 \ carrier_mat d d" and r2: "\\<^sub>2 \ carrier_mat d d" and M0: "x1 0 \ carrier_mat d d" and M1: "x1 1 \ carrier_mat d d" and pdo1: "partial_density_operator \\<^sub>1" and pdo2: "partial_density_operator \\<^sub>2" and tr12: "trace (\\<^sub>1 + \\<^sub>2) \ 1" and wc: "well_com x2" and mea: "measurement d 2 x1" and DS: "(\\\<^sub>1 \\<^sub>2. \\<^sub>1 \ carrier_mat d d \ \\<^sub>2 \ carrier_mat d d \ partial_density_operator \\<^sub>1 \ partial_density_operator \\<^sub>2 \ trace (\\<^sub>1 + \\<^sub>2) \ 1 \ denote x2 (\\<^sub>1 + \\<^sub>2) = denote x2 \\<^sub>1 + denote x2 \\<^sub>2)" shows "denote_while (x1 0) (x1 1) (denote x2) (\\<^sub>1 + \\<^sub>2) = denote_while (x1 0) (x1 1) (denote x2) \\<^sub>1 + denote_while (x1 0) (x1 1) (denote x2) \\<^sub>2" proof - let ?A = "x1 0" and ?B = "x1 1" have dx2:"(\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive ((denote x2) \) \ trace ((denote x2) \) \ trace \ \ (denote x2) \ \ carrier_mat d d) " using denote_positive_trace_dim wc by auto have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto have pdo12: "partial_density_operator (\\<^sub>1 + \\<^sub>2)" using pdo1 pdo2 unfolding partial_density_operator_def using tr12 positive_add assms by auto have ms1: "matrix_seq d (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1))" using denote_while_n_sum_mat_seq assms by auto have ms2: "matrix_seq d (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2))" using denote_while_n_sum_mat_seq assms by auto have dim1: "(\n. matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \\<^sub>1) n \ carrier_mat d d)" using assms dx2 by (metis denote_while_n_dim matrix_sum_dim) have dim2: "(\n. matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \\<^sub>2) n \ carrier_mat d d)" using assms dx2 by (metis denote_while_n_dim matrix_sum_dim) have "trace (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1) n + matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2) n) \ trace (\\<^sub>1 + \\<^sub>2)" for n proof - have "trace (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1) n) \ trace \\<^sub>1" using denote_while_n_sum_trace dx2 lo1 assms by auto moreover have "trace (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2) n) \ trace \\<^sub>2" using denote_while_n_sum_trace dx2 lo1 assms by auto ultimately show ?thesis using trace_add_linear dim1 dim2 by (metis add_mono_thms_linordered_semiring(1) r1 r2) qed then have "\n. trace (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1) n + matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2) n) \ 1" using assms(7) dual_order.trans by blast then have lladd: "matrix_seq.lowner_lub (\n. (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1)) n + (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2)) n) = matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1)) + matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2))" using lowner_lub_add ms1 ms2 by auto have "matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n (\\<^sub>1 + \\<^sub>2)) m = matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1) m + matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2) m" for m proof - have "(\k. k < m \ denote_while_n (x1 0) (x1 1) (denote x2) k (\\<^sub>1 + \\<^sub>2) \ carrier_mat d d)" using denote_while_n_dim dx2 pdo12 assms measurement_dim by auto moreover have "(\k. k < m \ denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>1 \ carrier_mat d d)" using denote_while_n_dim dx2 assms measurement_dim by auto moreover have "(\k. k < m \ denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>2 \ carrier_mat d d)" using denote_while_n_dim dx2 assms measurement_dim by auto moreover have "(\ k < m. denote_while_n (x1 0) (x1 1) (denote x2) k (\\<^sub>1 + \\<^sub>2) = denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>1 + denote_while_n (x1 0) (x1 1) (denote x2) k \\<^sub>2)" using denote_while_n_add assms by auto ultimately show ?thesis using matrix_sum_add[of m "(\n. denote_while_n (x1 0) (x1 1) (denote x2) n (\\<^sub>1 + \\<^sub>2))" d "(\n. denote_while_n (x1 0) (x1 1) (denote x2) n \\<^sub>1)" "(\n. denote_while_n (x1 0) (x1 1) (denote x2) n \\<^sub>2)"] by auto qed then have "matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n (\\<^sub>1 + \\<^sub>2))) = matrix_seq.lowner_lub (\n. (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>1)) n + (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \\<^sub>2)) n)" using lladd by presburger then show ?thesis unfolding denote_while_def matrix_inf_sum_def using lladd by auto qed lemma denote_add: "well_com S \ \\<^sub>1 \ carrier_mat d d \ \\<^sub>2 \ carrier_mat d d \ partial_density_operator \\<^sub>1 \ partial_density_operator \\<^sub>2 \ trace (\\<^sub>1 + \\<^sub>2) \ 1 \ denote S (\\<^sub>1 + \\<^sub>2) = denote S \\<^sub>1 + denote S \\<^sub>2" proof (induction arbitrary: \\<^sub>1 \\<^sub>2) case SKIP then show ?case by auto next case (Utrans U) then show ?case by (clarsimp, mat_assoc d) next case (Seq x1 x2a) then show ?case proof - have dim1: "denote x1 \\<^sub>1 \ carrier_mat d d" using denote_positive_trace_dim Seq by auto have dim2: "denote x1 \\<^sub>2 \ carrier_mat d d" using denote_positive_trace_dim Seq by auto have "trace (denote x1 \\<^sub>1) \ trace \\<^sub>1" using denote_positive_trace_dim Seq by auto moreover have "trace (denote x1 \\<^sub>2) \ trace \\<^sub>2" using denote_positive_trace_dim Seq by auto ultimately have tr: "trace (denote x1 \\<^sub>1 + denote x1 \\<^sub>2) \ 1" using Seq(4,5,8) trace_add_linear dim1 dim2 by (smt add_mono order_trans) have "denote (Seq x1 x2a) (\\<^sub>1 + \\<^sub>2) = denote x2a (denote x1 (\\<^sub>1 + \\<^sub>2))" by auto moreover have "denote x1 (\\<^sub>1 + \\<^sub>2) = denote x1 \\<^sub>1 + denote x1 \\<^sub>2" using Seq by auto moreover have "partial_density_operator (denote x1 \\<^sub>1)" using denote_partial_density_operator Seq by auto moreover have "partial_density_operator (denote x1 \\<^sub>2)" using denote_partial_density_operator Seq by auto ultimately show ?thesis using Seq dim1 dim2 tr by auto qed next case (Measure x1 x2a x3a) then show ?case proof - have ptc: "\x3aa \. x3aa \ set x3a \ well_com x3aa \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x3aa \) \ trace (denote x3aa \) \ trace \ \ denote x3aa \ \ carrier_mat d d" using denote_positive_trace_dim Measure by auto then have map:"\\. \ \ carrier_mat d d \ partial_density_operator \ \ \ k < x1. positive ((map denote x3a ! k) (x2a k * \ * adjoint (x2a k))) \ ((map denote x3a ! k) (x2a k * \ * adjoint (x2a k))) \ carrier_mat d d \ trace ((map denote x3a ! k) (x2a k * \ * adjoint (x2a k))) \ trace (x2a k * \ * adjoint (x2a k))" using Measure map_denote_positive_trace_dim by auto from map have mapd1: "\k. k < x1 \ (map denote x3a ! k) (x2a k * \\<^sub>1 * adjoint (x2a k)) \ carrier_mat d d" using Measure by auto from map have mapd2: "\k. k < x1 \ (map denote x3a ! k) (x2a k * \\<^sub>2 * adjoint (x2a k)) \ carrier_mat d d" using Measure by auto have dim1:"\k. k < x1 \ x2a k * \\<^sub>1 * adjoint (x2a k) \ carrier_mat d d" using well_com.simps(5) measurement_dim Measure by fastforce have dim2: "\k. k < x1 \ x2a k * \\<^sub>2 * adjoint (x2a k) \ carrier_mat d d" using well_com.simps(5) measurement_dim Measure by fastforce have "\k. k < x1 \ (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) \ carrier_mat d d" using well_com.simps(5) measurement_dim Measure by fastforce have lea: "\k. k < x1 \ adjoint (x2a k) * x2a k \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat Measure by auto moreover have dimx: "\k. k < x1 \ x2a k \ carrier_mat d d" using Measure measurement_dim by auto ultimately have pdo12:"\k. k < x1 \ partial_density_operator (x2a k * \\<^sub>1 * adjoint (x2a k)) \ partial_density_operator (x2a k * \\<^sub>2 * adjoint (x2a k))" using pdo_close_under_measurement Measure measurement_dim by blast have trless: "trace (x2a k * \\<^sub>1 * adjoint (x2a k) + x2a k * \\<^sub>2 * adjoint (x2a k)) \ 1" if k: "k < x1" for k proof - have "trace (x2a k * \\<^sub>1 * adjoint (x2a k)) \ trace \\<^sub>1" using trace_decrease_mul_adj dimx Measure lea k by auto moreover have "trace (x2a k * \\<^sub>2 * adjoint (x2a k)) \ trace \\<^sub>2" using trace_decrease_mul_adj dimx Measure lea k by auto ultimately have "trace (x2a k * \\<^sub>1 * adjoint (x2a k) + x2a k * \\<^sub>2 * adjoint (x2a k)) \ trace (\\<^sub>1 + \\<^sub>2)" using trace_add_linear dim1 dim2 Measure k by (metis add_mono_thms_linordered_semiring(1)) then show ?thesis using Measure(7) by auto qed have dist: "(x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) = (x2a k * \\<^sub>1 * adjoint (x2a k)) + (x2a k * \\<^sub>2 * adjoint (x2a k))" if k: "k < x1" for k proof - have "(x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) = ((x2a k * \\<^sub>1 + x2a k * \\<^sub>2) * adjoint (x2a k))" using mult_add_distrib_mat Measure well_com.simps(4) measurement_dim by (metis k) also have "\ = (x2a k * \\<^sub>1 * adjoint (x2a k)) + (x2a k * \\<^sub>2 * adjoint (x2a k))" apply (mat_assoc d) using Measure k well_com.simps(4) measurement_dim by auto finally show ?thesis by auto qed have mapadd: "(map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) = (map denote x3a ! k) (x2a k * \\<^sub>1 * adjoint (x2a k)) + (map denote x3a ! k) (x2a k * \\<^sub>2 * adjoint (x2a k))" if k: "k < x1" for k proof - have "(map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) = denote (x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k))" using Measure.prems(1) k by auto then have mapx: "(map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) = denote (x3a ! k) ((x2a k * \\<^sub>1 * adjoint (x2a k)) + (x2a k * \\<^sub>2 * adjoint (x2a k)))" using dist k by auto have "denote (x3a ! k) ((x2a k * \\<^sub>1 * adjoint (x2a k)) + (x2a k * \\<^sub>2 * adjoint (x2a k))) = denote (x3a ! k) (x2a k * \\<^sub>1 * adjoint (x2a k)) + denote (x3a ! k) (x2a k * \\<^sub>2 * adjoint (x2a k))" using Measure(1,2) dim1 dim2 pdo12 trless k by (simp add: list_all_length) then show ?thesis using Measure.prems(1) mapx k by auto qed then have mapd12:"(\k. k < x1 \ (map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)) \ carrier_mat d d)" using mapd1 mapd2 by auto have "matrix_sum d (\k. (map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k))) x1 = matrix_sum d (\k. (map denote x3a ! k) (x2a k * \\<^sub>1 * adjoint (x2a k))) x1 + matrix_sum d (\k. (map denote x3a ! k) (x2a k * \\<^sub>2 * adjoint (x2a k))) x1" using matrix_sum_add[of x1 "(\k. (map denote x3a ! k) (x2a k * (\\<^sub>1 + \\<^sub>2) * adjoint (x2a k)))" d "(\k. (map denote x3a ! k) (x2a k * \\<^sub>1 * adjoint (x2a k)))" "(\k. (map denote x3a ! k) (x2a k * \\<^sub>2 * adjoint (x2a k)))"] using mapd12 mapd1 mapd2 mapadd by auto then show ?thesis using denote.simps(4) unfolding denote_measure_def by auto qed next case (While x1 x2) then show ?case apply auto using denote_while_add measurement_dim by auto qed lemma mulfact: fixes c:: real and a:: complex and b:: complex assumes "c\0" "a \ b" shows "c * a \ c * b" - using assms mult_le_cancel_iff2 by force + using assms mult_le_cancel_iff2 unfolding less_eq_complex_def by force lemma denote_while_n_scale: fixes c:: real assumes "c\0" "measurement d 2 x1" "well_com x2" "(\\. \ \ carrier_mat d d \ partial_density_operator \ \ trace (c \\<^sub>m \) \ 1 \ denote x2 (c \\<^sub>m \) = c \\<^sub>m denote x2 \)" shows "\ \ carrier_mat d d \ partial_density_operator \ \ trace (c \\<^sub>m \) \ 1 \ denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \\<^sub>m \) = c \\<^sub>m (denote_while_n (x1 0) (x1 1) (denote x2) n \)" proof (auto, induct n arbitrary: \) case 0 then show ?case apply auto apply (mat_assoc d) using assms measurement_dim by auto next case (Suc n) then show ?case proof - let ?A = "x1 0" and ?B = "x1 1" have dx2:"(\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive ((denote x2) \) \ trace ((denote x2) \) \ trace \ \ (denote x2) \ \ carrier_mat d d) " using denote_positive_trace_dim assms by auto have lo1: "adjoint ?B * ?B \\<^sub>L 1\<^sub>m d" using measurement_le_one_mat assms by auto have dim1: "x1 1 * \ * adjoint (x1 1) \ carrier_mat d d" using assms(2) Suc(2) measurement_dim by (meson adjoint_dim mult_carrier_mat one_less_numeral_iff semiring_norm(76)) moreover have pdo1: "partial_density_operator (x1 1 * \ * adjoint (x1 1))" using pdo_close_under_measurement assms Suc lo1 measurement_dim by (metis One_nat_def lessI numeral_2_eq_2) ultimately have dimr: "denote x2 (x1 1 * \ * adjoint (x1 1)) \ carrier_mat d d" using dx2 by auto have pdor: "partial_density_operator (denote x2 (x1 1 * \ * adjoint (x1 1)))" using denote_partial_density_operator assms dim1 pdo1 by auto have "trace (denote x2 (x1 1 * \ * adjoint (x1 1))) \ trace (x1 1 * \ * adjoint (x1 1))" using dx2 dim1 pdo1 by auto also have trr1: "\ \ trace \" using trace_decrease_mul_adj assms Suc lo1 measurement_dim by auto finally have trr: "trace (denote x2 (x1 1 * \ * adjoint (x1 1))) \ trace \" by auto moreover have "trace (c \\<^sub>m denote x2 (x1 1 * \ * adjoint (x1 1))) = c * trace (denote x2 (x1 1 * \ * adjoint (x1 1)))" using trace_smult dimr by auto moreover have trcr: "trace (c \\<^sub>m \) = c * trace \" using trace_smult Suc by auto ultimately have "trace (c \\<^sub>m denote x2 (x1 1 * \ * adjoint (x1 1))) \ trace (c \\<^sub>m \)" using assms(1) state_sig.mulfact by auto then have trrc: "trace (c \\<^sub>m denote x2 (x1 1 * \ * adjoint (x1 1))) \ 1" using Suc by auto have "trace (c \\<^sub>m (x1 1 * \ * adjoint (x1 1))) = c * trace (x1 1 * \ * adjoint (x1 1))" using trace_smult dim1 by auto then have "trace (c \\<^sub>m (x1 1 * \ * adjoint (x1 1))) \ trace (c \\<^sub>m \)" using trcr trr1 assms(1) using state_sig.mulfact by auto then have trrle: "trace (c \\<^sub>m (x1 1 * \ * adjoint (x1 1))) \ 1" using Suc by auto have "x1 1 * (complex_of_real c \\<^sub>m \) * adjoint (x1 1) = complex_of_real c \\<^sub>m (x1 1 * \ * adjoint (x1 1))" apply (mat_assoc d) using Suc.prems(1) assms measurement_dim by auto then have "denote x2 (x1 1 * (complex_of_real c \\<^sub>m \) * adjoint (x1 1)) = (denote x2 (c \\<^sub>m (x1 1 * (\) * adjoint (x1 1))))" by auto moreover have "denote x2 (c \\<^sub>m (x1 1 * \ * adjoint (x1 1))) = c \\<^sub>m denote x2 (x1 1 * \ * adjoint (x1 1))" using assms(4) dim1 pdo1 trrle by auto ultimately have "denote x2 (x1 1 * (complex_of_real c \\<^sub>m \) * adjoint (x1 1)) = c \\<^sub>m denote x2 (x1 1 * \ * adjoint (x1 1))" using assms by auto then show ?thesis using Suc dimr pdor trrc by auto qed qed lemma denote_while_scale: fixes c:: real assumes "\ \ carrier_mat d d" "partial_density_operator \" "trace (c \\<^sub>m \) \ 1" "c \ 0" "measurement d 2 x1" "well_com x2" "(\\. \ \ carrier_mat d d \ partial_density_operator \ \ trace (c \\<^sub>m \) \ 1 \ denote x2 (c \\<^sub>m \) = c \\<^sub>m denote x2 \)" shows "denote_while (x1 0) (x1 1) (denote x2) (c \\<^sub>m \) = c \\<^sub>m denote_while (x1 0) (x1 1) (denote x2) \" proof - let ?A = "x1 0" and ?B = "x1 1" have dx2:"(\\. \ \ carrier_mat d d \ partial_density_operator \ \ positive ((denote x2) \) \ trace ((denote x2) \) \ trace \ \ (denote x2) \ \ carrier_mat d d) " using denote_positive_trace_dim assms by auto have lo1: "adjoint ?A * ?A + adjoint ?B * ?B = 1\<^sub>m d" using measurement_id2 assms by auto have ms: "matrix_seq d (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \))" using denote_while_n_sum_mat_seq assms measurement_dim by auto have trcless: "trace (c \\<^sub>m matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n) \ 1" for n proof - have dimr: "matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n \ carrier_mat d d" using assms dx2 denote_while_n_dim matrix_sum_dim using matrix_seq.dim ms by auto have "trace (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \) n) \ trace \" using denote_while_n_sum_trace dx2 lo1 assms measurement_dim by auto moreover have "trace (c \\<^sub>m matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n) = c * trace (matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n)" using trace_smult dimr by auto moreover have "trace (c \\<^sub>m \) = c * trace \" using trace_smult assms by auto ultimately have "trace (c \\<^sub>m matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \) n) \ trace (c \\<^sub>m \)" - using assms(4) by (simp add: ordered_comm_semiring_class.comm_mult_left_mono) + using assms(4) by (simp add: ordered_comm_semiring_class.comm_mult_left_mono less_eq_complex_def) then show ?thesis using assms by auto qed have llscale: "matrix_seq.lowner_lub (\n. c \\<^sub>m (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \)) n) = c \\<^sub>m matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \))" using lowner_lub_scale[of d "(matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n \))" c] ms trcless assms(4) by auto have "matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \\<^sub>m \)) m = c \\<^sub>m (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \)) m" for m proof - have dim:"(\k. k < m \ denote_while_n (x1 0) (x1 1) (denote x2) k \ \ carrier_mat d d)" using denote_while_n_dim dx2 assms measurement_dim by auto then have dimr: "(\k. k < m \ c \\<^sub>m denote_while_n (x1 0) (x1 1) (denote x2) k \ \ carrier_mat d d)" using smult_carrier_mat by auto have "\ n\<^sub>m \) = c \\<^sub>m (denote_while_n (x1 0) (x1 1) (denote x2) n \)" using denote_while_n_scale assms by auto then have "(matrix_sum d (\n. c \\<^sub>m denote_while_n ?A ?B (denote x2) n \)) m = matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \\<^sub>m \)) m " using matrix_sum_cong[of m "\n. complex_of_real c \\<^sub>m denote_while_n (x1 0) (x1 1) (denote x2) n \"] dimr by fastforce moreover have "(matrix_sum d (\n. c \\<^sub>m denote_while_n ?A ?B (denote x2) n \)) m = c \\<^sub>m (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \)) m" using matrix_sum_smult[of m "(\n. denote_while_n (x1 0) (x1 1) (denote x2) n \)" d c] dim by auto ultimately show ?thesis by auto qed then have "matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n (x1 0) (x1 1) (denote x2) n (complex_of_real c \\<^sub>m \))) = matrix_seq.lowner_lub (\n. c \\<^sub>m (matrix_sum d (\n. denote_while_n ?A ?B (denote x2) n \)) n)" by meson then show ?thesis unfolding denote_while_def matrix_inf_sum_def using llscale by auto qed lemma denote_scale: fixes c :: real assumes "c\0" shows "well_com S \ \ \ carrier_mat d d \ partial_density_operator \ \ trace (c \\<^sub>m \) \ 1 \ denote S (c \\<^sub>m \) = c \\<^sub>m denote S \" proof (induction arbitrary: \) case SKIP then show ?case by auto next case (Utrans x) then show ?case unfolding denote.simps apply (mat_assoc d) using Utrans by auto next case (Seq x1 x2a) then show ?case proof - have cd: "denote x1 (c \\<^sub>m \) = c \\<^sub>m denote x1 \" using Seq by auto have x1: "denote x1 \ \ carrier_mat d d \ partial_density_operator (denote x1 \) \ trace (denote x1 \) \ trace \" using denote_positive_trace_dim Seq denote_partial_density_operator by auto have "trace (c \\<^sub>m denote x1 \) = c * trace (denote x1 \)" using trace_smult x1 by auto also have "\ \ c * trace \" using x1 assms by (metis Seq.prems cd denote_positive_trace_dim partial_density_operator_def positive_scale smult_carrier_mat trace_smult well_com.simps(3)) also have "\ \ 1" using Seq(6) trace_smult Seq(4) by (simp add: trace_smult) finally have "trace (c \\<^sub>m denote x1 \) \1" by auto then have "denote x2a (c \\<^sub>m denote x1 \) = c \\<^sub>m denote x2a ( denote x1 \)" using x1 Seq by auto then show ?thesis using denote.simps(4) cd by auto qed next case (Measure x1 x2a x3a) then show ?case proof - have ptc: "\x3aa \. x3aa \ set x3a \ well_com x3aa \ \ \ carrier_mat d d \ partial_density_operator \ \ positive (denote x3aa \) \ trace (denote x3aa \) \ trace \ \ denote x3aa \ \ carrier_mat d d" using denote_positive_trace_dim Measure by auto have cad: "x2a k * (c \\<^sub>m \) * adjoint (x2a k) = c \\<^sub>m (x2a k * \ * adjoint (x2a k))" if k: "k < x1" for k apply (mat_assoc d) using well_com.simps Measure measurement_dim k by auto have "\k * adjoint (x2a k) \ carrier_mat d d" using Measure(2) measurement_dim Measure(3) by fastforce have lea: "\k\<^sub>L 1\<^sub>m d" using measurement_le_one_mat Measure(2) by auto then have pdox: "\ k * adjoint (x2a k))" using pdo_close_under_measurement Measure(2,3,4) measurement_dim by (meson state_sig.well_com.simps(4)) have x2aa:"\ k < x1. (x2a k * \ * adjoint (x2a k)) \ carrier_mat d d" using Measure(2,3) measurement_dim by fastforce have dimm: "(\k. k < x1 \ (map denote x3a ! k) (x2a k * \ * adjoint (x2a k)) \ carrier_mat d d)" using map_denote_positive_trace_dim Measure(2,3,4) ptc by auto then have dimcm: "(\k. k < x1 \ c \\<^sub>m (map denote x3a ! k) (x2a k * \ * adjoint (x2a k)) \ carrier_mat d d)" using smult_carrier_mat by auto have tra: "\ k < x1. trace ((x2a k * \ * adjoint (x2a k))) \ trace \" using trace_decrease_mul_adj Measure lea measurement_dim by auto have tra1: "trace (c \\<^sub>m (x2a k * \ * adjoint (x2a k))) \ 1" if k: "k < x1" for k proof - have trle: "trace (x2a k * \ * adjoint (x2a k)) \ trace \" using tra k by auto have "trace (c \\<^sub>m (x2a k * \ * adjoint (x2a k))) = c * trace ((x2a k * \ * adjoint (x2a k)))" using trace_smult x2aa k by auto also have "\ \ c * trace \" using trle assms mulfact by auto also have "\ \ 1" using Measure(3,5) trace_smult by metis finally show ?thesis by auto qed have "(map denote x3a ! k) (x2a k * (c \\<^sub>m \) * adjoint (x2a k)) = c \\<^sub>m (map denote x3a ! k) (x2a k * \ * adjoint (x2a k))" if k: "k < x1" for k proof - have "denote (x3a ! k) (x2a k * (c \\<^sub>m \) * adjoint (x2a k)) = denote (x3a ! k) (c \\<^sub>m (x2a k * \ * adjoint (x2a k)))" using cad k by auto also have "\ = c \\<^sub>m denote (x3a ! k) ( (x2a k * \ * adjoint (x2a k)))" using Measure(1,2) pdox x2aa tra1 k using measure_well_com by auto finally have "denote (x3a ! k) (x2a k * (complex_of_real c \\<^sub>m \) * adjoint (x2a k)) = complex_of_real c \\<^sub>m denote (x3a ! k) (x2a k * \ * adjoint (x2a k))" by auto then show ?thesis using Measure.prems(1) k by auto qed then have "matrix_sum d (\k. c \\<^sub>m (map denote x3a ! k) (x2a k * \ * adjoint (x2a k))) x1 = matrix_sum d (\k. (map denote x3a ! k) (x2a k * (c \\<^sub>m \) * adjoint (x2a k))) x1" using matrix_sum_cong[of x1 "(\k. complex_of_real c \\<^sub>m (map denote x3a ! k) (x2a k * \ * adjoint (x2a k)))" "(\k. (map denote x3a ! k) (x2a k * (complex_of_real c \\<^sub>m \) * adjoint (x2a k)))"] dimcm by auto then have "matrix_sum d (\k. (map denote x3a ! k) (x2a k * (c \\<^sub>m \) * adjoint (x2a k))) x1 = c \\<^sub>m matrix_sum d (\k. (map denote x3a ! k) (x2a k * \ * adjoint (x2a k))) x1" using matrix_sum_smult[of x1 "(\k. (map denote x3a ! k) (x2a k * \ * adjoint (x2a k)))" d c] dimm by auto then have "denote (Measure x1 x2a x3a) (c \\<^sub>m \) = c \\<^sub>m denote (Measure x1 x2a x3a) \" using denote.simps(4)[of x1 x2a x3a "c \\<^sub>m \"] using denote.simps(4)[of x1 x2a x3a "\"] unfolding denote_measure_def by auto then show ?thesis by auto qed next case (While x1 x2a) then show ?case apply auto using denote_while_scale assms by auto qed lemma limit_mat_denote_while_n: assumes wc: "well_com (While M S)" and dr: "\ \ carrier_mat d d" and pdor: "partial_density_operator \" shows "limit_mat (matrix_sum d (\k. denote_while_n (M 0) (M 1) (denote S) k \)) (denote (While M S) \) d" proof - have m: "measurement d 2 M" using wc by auto then have dM0: "M 0 \ carrier_mat d d" and dM1: "M 1 \ carrier_mat d d" and id: "adjoint (M 0) * (M 0) + adjoint (M 1) * (M 1) = 1\<^sub>m d" using measurement_id2 m measurement_def by auto have wcs: "well_com S" using wc by auto have DS: "positive (denote S \) \ trace (denote S \) \ trace \ \ denote S \ \ carrier_mat d d" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using wcs that denote_positive_trace_dim by auto have sumdd: "(\n. matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \) n \ carrier_mat d d)" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using denote_while_n_sum_dim dM0 dM1 DS that by auto have sumtr: "\ n. trace (matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \) n) \ trace \" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using denote_while_n_sum_trace[OF dM0 dM1 id DS] that by auto have sumpar: "(\n. partial_density_operator (matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \) n))" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using denote_while_n_sum_partial_density[OF dM0 dM1 id DS] that by auto have sumle:"(\n. matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \) n \\<^sub>L matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \) (Suc n))" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using denote_while_n_sum_lowner_le[OF dM0 dM1 id DS] that by auto have seqd: "matrix_seq d (matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \))" if "\ \ carrier_mat d d" and "partial_density_operator \" for \ using matrix_seq_def sumdd sumpar sumle that by auto have "matrix_seq.lowner_is_lub (matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \)) (matrix_seq.lowner_lub (matrix_sum d (\n. denote_while_n (M 0) (M 1) (denote S) n \)))" using DS lowner_is_lub_matrix_sum dM0 dM1 id pdor dr by auto then show "limit_mat (matrix_sum d (\k. denote_while_n (M 0) (M 1) (denote S) k \)) (denote (While M S) \) d" unfolding denote.simps denote_while_def matrix_inf_sum_def using matrix_seq.lowner_lub_is_limit[OF seqd[OF dr pdor]] by auto qed end end