Theory QFT

(* -----------------------------------------------------------------------------------------------
-- Quantum Fourier Transform

-- Author: Pablo Manrique Merchán < pabmanmer at alum.us.es >
-- Universidad de Sevilla
-- -----------------------------------------------------------------------------------------------*)

theory QFT

imports
  Isabelle_Marries_Dirac.Deutsch
begin

section ‹Some useful lemmas›

lemma gate_carrier_mat[simp]:
  assumes "gate n U"
  shows "U  carrier_mat (2^n) (2^n)"
proof
  show "dim_row U = 2^n" using gate_def assms by auto
next
  show "dim_col U = 2^n" using gate_def assms by auto
qed

lemma state_carrier_mat[simp]:
  assumes "state n ψ"
  shows "ψ  carrier_mat (2^n) 1"
proof
  show "dim_row ψ = 2^n" using state_def assms by auto
next
  show "dim_col ψ = 1" using state_def assms by auto
qed

lemma state_basis_carrier_mat[simp]:
  "|state_basis n j  carrier_mat (2^n) 1"
  by (simp add: ket_vec_def state_basis_def)

lemma left_tensor_id[simp]:
  assumes "A  carrier_mat nr nc"
  shows "(1m 1)  A = A"
  by auto

lemma right_tensor_id[simp]:
  assumes "A  carrier_mat nr nc"
  shows "A  (1m 1) = A"
  by auto

lemma tensor_carrier_mat[simp]:
  assumes "A  carrier_mat ra ca"
    and "B  carrier_mat rb cb"
  shows "A  B  carrier_mat (ra*rb) (ca*cb)"
proof
  show "dim_row (A  B) = ra * rb" using dim_row_tensor_mat assms by auto
  show "dim_col (A  B) = ca * cb" using dim_col_tensor_mat assms by auto
qed

lemma smult_tensor[simp]:
  assumes "dim_col A > 0" and "dim_col B > 0"
  shows "(a m A)  (b m B) = (a*b) m (A  B)"
proof
  fix i j::nat
  assume ai:"i < dim_row (a * b m (A  B))" and aj:"j < dim_col (a * b m (A  B))"
  show "(a m A  b m B) $$ (i, j) = ((a * b) m (A  B)) $$ (i, j)"
  proof -
    define rA cA rB cB where "rA = dim_row A" and "cA = dim_col A" and "rB = dim_row B" 
      and "cB = dim_col B"
    have "(a m A  b m B)$$(i, j) = (a m A)$$(i div rB, j div cB)*(b m B)$$(i mod rB, j mod cB)"
    proof (rule index_tensor_mat)
      show "dim_row (a m A) = rA" using rA_def by simp
      show "dim_col (a m A) = cA" using cA_def by simp
      show "dim_row (b m B) = rB" using rB_def by simp
      show "dim_col (b m B) = cB" using cB_def by simp
      show "i < rA * rB" using ai rA_def rB_def smult_carrier_mat tensor_carrier_mat by auto
      show "j < cA * cB" using aj cA_def cB_def smult_carrier_mat tensor_carrier_mat by auto
      show "0 < cA" using cA_def assms(1) by simp
      show "0 < cB" using cB_def assms(2) by simp
    qed
    also have " = a*A$$(i div rB, j div cB)*b*B$$(i mod rB, j mod cB)"
      using index_smult_mat by (smt (verit) Euclidean_Rings.div_eq_0_iff 
          ab_semigroup_mult_class.mult_ac(1) ai aj cB_def dim_col_tensor_mat dim_row_tensor_mat 
          less_mult_imp_div_less mod_less_divisor mult_0_right not_gr0 rB_def)
    also have " = (a*b)*(A$$(i div rB, j div cB)*B$$(i mod rB, j mod cB))" by auto
    also have " = (a*b)*((A  B) $$ (i,j))"
    proof -
      have "(A  B) $$ (i,j) = A$$(i div rB, j div cB)*B$$(i mod rB, j mod cB)"
        using index_tensor_mat rA_def cA_def rB_def cB_def ai aj smult_carrier_mat 
          tensor_carrier_mat assms by auto
      thus ?thesis by simp
    qed
    also have " = ((a*b) m (A  B)) $$ (i,j)" using index_smult_mat(1)
      by (metis ai aj index_smult_mat(2) index_smult_mat(3))
    finally show ?thesis by this
  qed
next
  show "dim_row (a m A  b m B) = dim_row (a * b m (A  B))" by simp
next
  show "dim_col (a m A  b m B) = dim_col (a * b m (A  B))" by simp
qed

lemma smult_tensor1[simp]:
  assumes "dim_col A > 0" and "dim_col B > 0"
  shows "a m (A  B) = (a m A)  B"
proof -
  have "a m (A  B) = (a*1) m (A  B)" by auto
  also have " = (a m A)  (1 m B)" using assms smult_tensor by simp
  also have " = (a m A)  B" 
    by (metis eq_matI index_smult_mat(1) index_smult_mat(2) index_smult_mat(3) mult_cancel_right1)
  finally show ?thesis by this
qed

lemma set_list:
  "set [m..<n] = {m..<n}"
  by auto

lemma sumof2:
  "(k<(2::nat). f k) = f 0 + f 1"
  by (metis One_nat_def Suc_1 add.left_neutral lessThan_0 sum.empty sum.lessThan_Suc)

lemma sumof4:
  "(k<(4::nat). f k) = f 0 + f 1 + f 2 + f 3"
proof -
  have "(k<(4::nat). f k) = sum f (set [0..<4])" using set_list atLeast_upt by presburger
  also have " = f 0 + (f (Suc 0) + (f 2 + f 3))" by simp
  also have " = f 0 + f 1 + f 2 + f 3" by (simp add: add.commute add.left_commute)
  finally show ?thesis by this
qed



section ‹The operator $R_k$›

definition R:: "nat  complex Matrix.mat" where
  "R k = mat_of_cols_list 2 [[1, 0],
                            [0, exp(2*pi*𝗂/2^k)]]"


section ‹The SWAP gate:›

definition SWAP:: "complex Matrix.mat" where
  "SWAP  Matrix.mat 4 4 (λ(i,j). if i=0  j=0 then 1 else
                                  if i=1  j=2 then 1 else
                                  if i=2  j=1 then 1 else
                                  if i=3  j=3 then 1 else 0)"

lemma SWAP_index:
  "SWAP $$ (0,0) = 1 
   SWAP $$ (0,1) = 0 
   SWAP $$ (0,2) = 0 
   SWAP $$ (0,3) = 0 
   SWAP $$ (1,0) = 0 
   SWAP $$ (1,1) = 0 
   SWAP $$ (1,2) = 1 
   SWAP $$ (1,3) = 0 
   SWAP $$ (2,0) = 0 
   SWAP $$ (2,1) = 1 
   SWAP $$ (2,2) = 0 
   SWAP $$ (2,3) = 0 
   SWAP $$ (3,0) = 0 
   SWAP $$ (3,1) = 0 
   SWAP $$ (3,2) = 0 
   SWAP $$ (3,3) = 1"
  by (simp add: SWAP_def)

lemma SWAP_nrows:
  "dim_row SWAP = 4"
  by (simp add: SWAP_def)

lemma SWAP_ncols:
  "dim_col SWAP = 4"
  by (simp add: SWAP_def)

lemma SWAP_carrier_mat[simp]:
  "SWAP  carrier_mat 4 4"
  using SWAP_nrows SWAP_ncols by auto


text ‹The SWAP gate indeed swaps the states of two qubits (it is not necessary to assume unitarity)›

lemma SWAP_tensor:
  assumes "u  carrier_mat 2 1"
    and "v  carrier_mat 2 1"
  shows "SWAP * (u  v) = v  u"
proof
  show "dim_row (SWAP * (u  v)) = dim_row (v  u)"
    using SWAP_nrows assms(1) assms(2) by auto
next
  show "dim_col (SWAP * (u  v)) = dim_col (v  u)"
    using SWAP_ncols assms by auto
next
  fix i j::nat assume "i < dim_row (v  u)" and "j < dim_col (v  u)"
  hence a3:"i < 4" and a4:"j = 0" using assms by auto
  thus "(SWAP * (u  v)) $$ (i, j) = (v  u) $$ (i, j)"
  proof -
    define u0 where "u0 = u $$ (0,0)"
    define u1 where "u1 = u $$ (1,0)"
    define v0 where "v0 = v $$ (0,0)"
    define v1 where "v1 = v $$ (1,0)"
    have vu0:"(v  u) $$ (0,0) = v0*u0" using index_tensor_mat assms u0_def v0_def by auto
    have vu1:"(v  u) $$ (1,0) = v0*u1" using index_tensor_mat assms u1_def v0_def by auto
    have vu2:"(v  u) $$ (2,0) = v1*u0" using index_tensor_mat assms u0_def v1_def by auto
    have vu3:"(v  u) $$ (3,0) = v1*u1" using index_tensor_mat assms u1_def v1_def by auto
    have uv0:"(u  v) $$ (0,0) = u0*v0" using index_tensor_mat assms u0_def v0_def by auto
    have uv1:"(u  v) $$ (1,0) = u0*v1" using index_tensor_mat assms u0_def v1_def by auto
    have uv2:"(u  v) $$ (2,0) = u1*v0" using index_tensor_mat assms u1_def v0_def by auto
    have uv3:"(u  v) $$ (3,0) = u1*v1" using index_tensor_mat assms u1_def v1_def by auto

    have uvi:"Matrix.vec 4 (λ i. (u  v) $$ (i,0)) $ i = (u  v) $$ (i,0)"
      using a3 index_vec by blast
    have sw:"k<4. Matrix.vec 4 (λ j. SWAP $$ (i,j)) $ k = SWAP $$ (i,k)"
      using a3 index_vec by auto 

    have s0:"(SWAP * (u  v)) $$ (i,0) = Matrix.vec (dim_col SWAP) (λ j. SWAP $$ (i,j))  
              Matrix.vec (dim_row (u  v)) (λ i. (u  v) $$ (i,0))"
      by (metis Matrix.col_def Matrix.row_def SWAP_nrows i < 4 j < dim_col (v  u) j = 0 
          dim_col_tensor_mat index_mult_mat(1) mult.commute)
    also have " = Matrix.vec 4 (λ j. SWAP $$ (i,j))  Matrix.vec 4 (λ i. (u  v) $$ (i,0))"
      using SWAP_ncols assms(1) assms(2) by fastforce
    also have " =  (k<4. ((Matrix.vec 4 (λ j. SWAP $$ (i,j))) $ k) * 
                              ((Matrix.vec 4 (λ i. (u  v) $$ (i,0))) $ k))"
      using scalar_prod_def by (metis calculation dim_vec lessThan_atLeast0)
    also have " = SWAP $$ (i,0) * (u  v) $$ (0,0) +
                    SWAP $$ (i,1) * (u  v) $$ (1,0) +
                    SWAP $$ (i,2) * (u  v) $$ (2,0) +
                    SWAP $$ (i,3) * (u  v) $$ (3,0)"
      using sumof4 by auto
    also have " = SWAP $$ (i,0) * u0 * v0 +
                    SWAP $$ (i,1) * u0 * v1 +
                    SWAP $$ (i,2) * u1 * v0 +
                    SWAP $$ (i,3) * u1 * v1"
      using uv0 uv1 uv2 uv3 by simp
    also have " = (v  u) $$ (i,j)"
    proof (rule disjE)
      show "i=0  i=1  i=2  i=3" using a3 by auto
    next
      assume i0:"i=0"
      hence "SWAP $$ (i,0) * u0 * v0 +
             SWAP $$ (i,1) * u0 * v1 +
             SWAP $$ (i,2) * u1 * v0 +
             SWAP $$ (i,3) * u1 * v1 =
             SWAP $$ (0,0) * u0 * v0 +
             SWAP $$ (0,1) * u0 * v1 +
             SWAP $$ (0,2) * u1 * v0 +
             SWAP $$ (0,3) * u1 * v1" by simp
      also have " = (v  u) $$ (i, j)" using i0 vu0 SWAP_index a4 by simp
      finally show ?thesis by this
    next
      assume disj3:"i = 1  i = 2  i = 3"
      show ?thesis
      proof (rule disjE)
        show "i = 1  i = 2  i = 3" using disj3 by this
      next
        assume i1:"i=1"
        hence "SWAP $$ (i,0) * u0 * v0 +
               SWAP $$ (i,1) * u0 * v1 +
               SWAP $$ (i,2) * u1 * v0 +
               SWAP $$ (i,3) * u1 * v1 =
               SWAP $$ (1,0) * u0 * v0 +
               SWAP $$ (1,1) * u0 * v1 +
               SWAP $$ (1,2) * u1 * v0 +
               SWAP $$ (1,3) * u1 * v1" by simp
        also have " = (v  u) $$ (i, j)" using i1 vu1 SWAP_index a4 by simp
        finally show ?thesis by this
      next
        assume disj2:"i = 2  i = 3"
        show ?thesis
        proof (rule disjE)
          show "i = 2  i = 3" using disj2 by this
        next
          assume i2:"i=2"
          hence "SWAP $$ (i,0) * u0 * v0 +
                 SWAP $$ (i,1) * u0 * v1 +
                 SWAP $$ (i,2) * u1 * v0 +
                 SWAP $$ (i,3) * u1 * v1 =
                 SWAP $$ (2,0) * u0 * v0 +
                 SWAP $$ (2,1) * u0 * v1 +
                 SWAP $$ (2,2) * u1 * v0 +
                 SWAP $$ (2,3) * u1 * v1" by simp
          also have " = (v  u) $$ (i, j)" using i2 vu2 SWAP_index a4 by simp
          finally show ?thesis by this
        next
          assume i3:"i=3"
          hence "SWAP $$ (i,0) * u0 * v0 +
               SWAP $$ (i,1) * u0 * v1 +
               SWAP $$ (i,2) * u1 * v0 +
               SWAP $$ (i,3) * u1 * v1 =
               SWAP $$ (3,0) * u0 * v0 +
               SWAP $$ (3,1) * u0 * v1 +
               SWAP $$ (3,2) * u1 * v0 +
               SWAP $$ (3,3) * u1 * v1" by simp
          also have " = (v  u) $$ (i, j)" using i3 vu3 SWAP_index a4 by simp
          finally show ?thesis by this
        qed
      qed
    qed
    finally show ?thesis using a4 by simp
  qed
qed

subsection ‹Downwards SWAP cascade›

fun SWAP_down:: "nat  complex Matrix.mat" where
  "SWAP_down 0 = 1m 1"
| "SWAP_down (Suc 0) = 1m 2"
| "SWAP_down (Suc (Suc 0)) = SWAP"
| "SWAP_down (Suc (Suc n)) = ((1m (2^n))  SWAP) * ((SWAP_down (Suc n))  (1m 2))"

lemma SWAP_down_carrier_mat[simp]:
  shows "SWAP_down n  carrier_mat (2^n) (2^n)" (is "?P n")
proof (induct n rule: SWAP_down.induct)
  show "?P 0" by auto
next
  show "?P (Suc 0)" by auto
next
  show "?P (Suc (Suc 0))" using SWAP_carrier_mat by auto
next
  fix n::nat
  define k::nat where "k = Suc n"
  assume HI:"SWAP_down (Suc k)  carrier_mat (2^(Suc k)) (2^(Suc k))"
  show "?P (Suc (Suc k))"
  proof
    have "dim_row (SWAP_down (Suc (Suc k))) = 
          dim_row (((1m (2^k))  SWAP) * ((SWAP_down (Suc k))  (1m 2)))"
      using SWAP_down.simps(4) k_def by simp
    also have " = dim_row (((1m (2^k))  SWAP))" by simp
    also have " = (dim_row ((1m (2^k)))) * (dim_row SWAP)" by simp
    thus "dim_row (SWAP_down (Suc (Suc k))) = 2 ^ Suc (Suc k)" using SWAP_nrows index_one_mat
      by (simp add: calculation)
  next
    have "dim_col (SWAP_down (Suc (Suc k))) =
          dim_col (((1m (2^k))  SWAP) * ((SWAP_down (Suc k))  (1m 2)))"
      using SWAP_down.simps(4) k_def by simp
    also have " = dim_col ((SWAP_down (Suc k))  (1m 2))" by simp
    also have " = dim_col (SWAP_down (Suc k)) * dim_col (1m 2)" by simp
    thus "dim_col (SWAP_down (Suc (Suc k))) = 2 ^ Suc (Suc k)"
      using SWAP_ncols index_one_mat calculation HI by simp
  qed
qed


subsection ‹Upwards SWAP cascade›

fun SWAP_up:: "nat  complex Matrix.mat" where
  "SWAP_up 0 = 1m 1"
| "SWAP_up (Suc 0) = 1m 2"
| "SWAP_up (Suc (Suc 0)) = SWAP"
| "SWAP_up (Suc (Suc n)) = (SWAP  (1m (2^n))) * ((1m 2)  (SWAP_up (Suc n)))"

lemma SWAP_up_carrier_mat[simp]:
  shows "SWAP_up n  carrier_mat (2^n) (2^n)" (is "?P n")
proof (induct n rule: SWAP_up.induct)
  case 1
  then show ?case by auto
next
  case 2
  then show ?case by auto
next
  case 3
  then show ?case by auto
next
  case (4 v)
  then show ?case using SWAP_nrows by fastforce
qed


section ‹Reversing qubits›

text ‹In order to reverse the order of n qubits, we iteratively swap opposite qubits (swap 0th
and (n-1)th qubits, 1st and (n-2)th qubits, and so on).›

fun reverse_qubits:: "nat  complex Matrix.mat" where
  "reverse_qubits 0 = 1m 1"
| "reverse_qubits (Suc 0) = (1m 2)"
| "reverse_qubits (Suc (Suc 0)) = SWAP"
| "reverse_qubits (Suc n) = ((reverse_qubits n)  (1m 2)) * (SWAP_down (Suc n))"


lemma reverse_qubits_carrier_mat[simp]:
  "(reverse_qubits n)  carrier_mat (2^n) (2^n)"
proof (induct n rule: reverse_qubits.induct)
  case 1
  then show ?case by auto
next
  case 2
  then show ?case by auto
next
  case 3
  then show ?case by auto
next
  case (4 va)
  then show ?case
    by (metis SWAP_down_carrier_mat carrier_matD(1) carrier_matD(2) carrier_matI dim_row_tensor_mat
        index_mult_mat(2) index_mult_mat(3) index_one_mat(2) power_Suc2 reverse_qubits.simps(4))
qed



section ‹Controlled operations›

text ‹The two-qubit gate control2 performs a controlled U operation on the first qubit with the 
second qubit as control›

definition control2:: "complex Matrix.mat  complex Matrix.mat" where
  "control2 U  mat_of_cols_list 4 [[1, 0, 0, 0],
                                    [0, U$$(0,0), 0, U$$(1,0)],
                                    [0, 0, 1, 0],
                                    [0, U$$(0,1), 0, U$$(1,1)]]"

lemma control2_carrier_mat[simp]:
  shows "control2 U  carrier_mat 4 4"
  by (simp add: Tensor.mat_of_cols_list_def control2_def numeral_Bit0)


lemma control2_zero:
  assumes "dim_row v = 2" and "dim_col v = 1"
  shows "control2 U * (v  |zero) = v  |zero"
proof 
  fix i j::nat
  assume "i < dim_row (v  |zero)"
  hence i4:"i < 4" using assms tensor_carrier_mat ket_vec_def by auto
  assume "j < dim_col (v  |zero)"
  hence j0:"j = 0" using assms tensor_carrier_mat ket_vec_def by auto
  show "(control2 U * (v  |zero)) $$ (i,j) = (v  |zero) $$ (i,j)"
  proof -
    have "(control2 U * (v  |zero)) $$ (i,j) = 
          (k<dim_row (v  |zero). control2 U $$ (i, k) * (v  |zero) $$ (k, j))"
      using assms index_matrix_prod 
      by (smt (z3) One_nat_def Suc_1 Tensor.mat_of_cols_list_def i < dim_row (v  |Deutsch.zero)
          j < dim_col (v  |Deutsch.zero) add.commute add_Suc_right control2_def dim_col_mat(1)
          dim_row_mat(1) dim_row_tensor_mat ket_zero_to_mat_of_cols_list list.size(3) list.size(4) 
          mult_2 numeral_Bit0 plus_1_eq_Suc sum.cong)
    also have " = (k<4. control2 U $$ (i, k) * (v  |zero) $$ (k, j))"
      using assms tensor_carrier_mat ket_vec_def by auto
    also have " = control2 U $$ (i, 0) * (v  |zero) $$ (0, 0) +
                    control2 U $$ (i, 1) * (v  |zero) $$ (1, 0) +
                    control2 U $$ (i, 2) * (v  |zero) $$ (2, 0) +
                    control2 U $$ (i, 3) * (v  |zero) $$ (3, 0)"
      using sumof4 j0 by blast
    also have " = (v  |zero) $$ (i,0)"
    proof (rule disjE)
      show "i = 0  i = 1  i = 2  i = 3" using i4 by auto
    next
      assume i0:"i = 0"
      have c00:"control2 U $$ (0,0) = 1"
        by (simp add: control2_def one_complex.code)
      have c01:"control2 U $$ (0,1) = 0"
        by (simp add: control2_def zero_complex.code)
      have c02:"control2 U $$ (0,2) = 0"
        by (simp add: control2_def zero_complex.code)
      have c03:"control2 U $$ (0,3) = 0"
        by (simp add: control2_def zero_complex.code)
      have "control2 U $$ (0, 0) * (v  |zero) $$ (0, 0) +
             control2 U $$ (0, 1) * (v  |zero) $$ (1, 0) +
             control2 U $$ (0, 2) * (v  |zero) $$ (2, 0) +
             control2 U $$ (0, 3) * (v  |zero) $$ (3, 0) =
             1 * (v  |zero) $$ (0, 0) +
             0 * (v  |zero) $$ (1, 0) +
             0 * (v  |zero) $$ (2, 0) +
             0 * (v  |zero) $$ (3, 0)"
        using c00 c01 c02 c03 by simp
      also have " = (v  |zero) $$ (0, 0)" by auto
      finally show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
                    control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
                    control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
                    control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
                    (v  |Deutsch.zero) $$ (i, 0)"
        using i0 by simp
    next
      assume id:"i = 1  i = 2  i = 3"
      show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
            control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
            control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
            control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
            (v  |Deutsch.zero) $$ (i, 0)"
      proof (rule disjE)
        show "i = 1  i = 2  i = 3" using id by this
      next
        assume i1:"i = 1"
        have c10:"control2 U $$ (1,0) = 0"
          by (simp add: control2_def zero_complex.code)
        have t10:"(v  |zero) $$ (1,0) = 0"
          using index_tensor_mat ket_vec_def Tensor.mat_of_cols_list_def 
            i < dim_row (v  |Deutsch.zero) j < dim_col (v  |Deutsch.zero) i1 
          by fastforce
        have c12:"control2 U $$ (1,2) = 0"
          by (simp add: control2_def zero_complex.code)
        have t30:"(v  |zero) $$ (3,0) = 0"
        proof -
          have "(v  |zero) $$ (3,0) = v $$ (1,0) * |zero $$ (1,0)"
            using index_tensor_mat
            by (smt (verit) Euclidean_Rings.div_eq_0_iff H_on_ket_zero_is_state 
                H_without_scalar_prod One_nat_def Suc_1 j < dim_col (v  |Deutsch.zero) 
                add.commute assms(1) dim_col_tensor_mat dim_row_mat(1) index_mult_mat(2) j0 
                ket_zero_is_state mod_less mod_less_divisor mod_mult2_eq mult_2 nat_0_less_mult_iff 
                numeral_3_eq_3 plus_1_eq_Suc pos2 state.dim_row three_div_two three_mod_two)
          also have " = 0" by auto
          finally show ?thesis by this
        qed
        show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
              control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
              control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
              control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
              (v  |Deutsch.zero) $$ (i, 0)"
          using i1 c10 t10 c12 t30 by auto
      next
        assume id2:"i = 2  i = 3"
        show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
              control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
              control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
              control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
              (v  |Deutsch.zero) $$ (i, 0)"
        proof (rule disjE)
          show "i = 2  i = 3"
            using id2 by this
        next
          assume i2:"i = 2"
          have c20:"control2 U $$ (2,0) = 0"
            by (simp add: control2_def zero_complex.code)
          have c21:"control2 U $$ (2,1) = 0"
            by (simp add: control2_def zero_complex.code)
          have c22:"control2 U $$ (2,2) = 1"
            by (simp add: control2_def one_complex.code)
          have c23:"control2 U $$ (2,3) = 0"
            by (simp add: control2_def zero_complex.code)
          show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
                control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
                control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
                control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
                (v  |Deutsch.zero) $$ (i, 0)"
            using i2 c20 c21 c22 c23 by auto
        next
          assume i3:"i = 3"
          have c30:"control2 U $$ (3,0) = 0"
            by (simp add: control2_def zero_complex.code)
          have t10:"(v  |zero) $$ (1,0) = 0"
            using index_tensor_mat ket_vec_def Tensor.mat_of_cols_list_def 
              i < dim_row (v  |Deutsch.zero) j < dim_col (v  |Deutsch.zero) i3
            by fastforce
          have c32:"control2 U $$ (3,2) = 0"
            by (simp add: control2_def zero_complex.code)
          have t30:"(v  |zero) $$ (3,0) = 0"
          proof -
            have "(v  |zero) $$ (3,0) = v $$ (1,0) * |zero $$ (1,0)"
              using index_tensor_mat
              by (smt (verit) Euclidean_Rings.div_eq_0_iff H_on_ket_zero_is_state 
                  H_without_scalar_prod One_nat_def Suc_1 j < dim_col (v  |Deutsch.zero) 
                  add.commute assms(1) dim_col_tensor_mat dim_row_mat(1) index_mult_mat(2) j0 
                  ket_zero_is_state mod_less mod_less_divisor mod_mult2_eq mult_2 nat_0_less_mult_iff 
                  numeral_3_eq_3 plus_1_eq_Suc pos2 state.dim_row three_div_two three_mod_two)
            also have " = 0" by auto
            finally show ?thesis by this
          qed
          show "control2 U $$ (i, 0) * (v  |Deutsch.zero) $$ (0, 0) +
                control2 U $$ (i, 1) * (v  |Deutsch.zero) $$ (1, 0) +
                control2 U $$ (i, 2) * (v  |Deutsch.zero) $$ (2, 0) +
                control2 U $$ (i, 3) * (v  |Deutsch.zero) $$ (3, 0) =
                (v  |Deutsch.zero) $$ (i, 0)"
            using i3 c30 t10 c32 t30 by auto
        qed
      qed
    qed
    finally show ?thesis using j0 by simp
  qed
next
  show "dim_row (control2 U * (v  |Deutsch.zero)) = dim_row (v  |Deutsch.zero)"
    by (metis assms(1) carrier_matD(1) control2_carrier_mat dim_row_mat(1) dim_row_tensor_mat 
        index_mult_mat(2) index_unit_vec(3) ket_vec_def num_double numeral_times_numeral)
next
  show "dim_col (control2 U * (v  |Deutsch.zero)) = dim_col (v  |Deutsch.zero)"
    using index_mult_mat(3) by blast
qed


lemma vtensorone_index[simp]:
  assumes "dim_row v = 2" and "dim_col v = 1"
  shows "(v  |one) $$ (0,0) = 0 
         (v  |one) $$ (1,0) = v $$ (0,0) 
         (v  |one) $$ (2,0) = 0 
         (v  |one) $$ (3,0) = v $$ (1,0)"
  by (simp add: assms(1) assms(2) ket_vec_def)

lemma control2_one:
  assumes "dim_row v = 2" and "dim_col v = 1" and "dim_row U = 2" and "dim_col U = 2"
  shows "control2 U * (v  |one) = (U*v)  |one"
proof
  fix i j::nat
  assume "i < dim_row ((U*v)  |one)"
  hence il4:"i < 4" by (simp add: assms(3) ket_vec_def)
  assume "j < dim_col ((U*v)  |one)"
  hence j0:"j = 0" using assms ket_vec_def by simp
  show "(control2 U * (v  |Deutsch.one)) $$ (i, j) = (U * v  |Deutsch.one) $$ (i, j)"
  proof -
    have "(control2 U * (v  |one)) $$ (i,j) = 
          (k<dim_row (v  |one). (control2 U) $$ (i, k) * (v  |one) $$ (k, j))"
      using assms index_matrix_prod tensor_carrier_mat
    proof -
      have "m. dim_col (v  m) = dim_col m"
        by (simp add: assms(2))
      then have "i < dim_row (control2 U)  0 < dim_col (v  Matrix.mat 2 1 (λ(n, n). Deutsch.one $ n))  dim_row (v  Matrix.mat 2 1 (λ(n, n). Deutsch.one $ n)) = dim_col (control2 U)"
        by (smt (z3) assms(1) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_mat(1) dim_row_mat(1) dim_row_tensor_mat il4 mult_2 numeral_Bit0 zero_less_one_class.zero_less_one)
      then show ?thesis
        by (simp add: j0 ket_vec_def)
    qed
    also have " = (k<4. control2 U $$ (i, k) * (v  |one) $$ (k, j))"
      using assms tensor_carrier_mat ket_vec_def by auto
    also have " = control2 U $$ (i, 0) * (v  |one) $$ (0, 0) +
                    control2 U $$ (i, 1) * (v  |one) $$ (1, 0) +
                    control2 U $$ (i, 2) * (v  |one) $$ (2, 0) +
                    control2 U $$ (i, 3) * (v  |one) $$ (3, 0)"
      using sumof4 j0 by blast
    also have " = ((U*v)  |one) $$ (i,0)"
    proof (rule disjE)
      show "i = 0  i = 1  i = 2  i = 3" using il4 by auto
    next
      assume i0:"i = 0"
      thus "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
            control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
            control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
            control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
            (U * v  |Deutsch.one) $$ (i, 0)"
        using j0 control2_def zero_complex.code one_complex.code vtensorone_index assms by auto
    next
      assume id3:"i = 1  i = 2  i = 3"
      show "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
            control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
            control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
            control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
            (U * v  |Deutsch.one) $$ (i, 0)"
      proof (rule disjE)
        show "i = 1  i = 2  i = 3" using id3 by this
      next
        assume i1:"i = 1"
        thus "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
            control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
            control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
            control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
            (U * v  |Deutsch.one) $$ (i, 0)"
          using j0 control2_def zero_complex.code one_complex.code vtensorone_index assms
          by (simp add: sumof2)
      next
        assume il2:"i = 2  i = 3"
        show "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
            control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
            control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
            control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
            (U * v  |Deutsch.one) $$ (i, 0)"
        proof (rule disjE)
          show "i = 2  i = 3" using il2 by this
        next
          assume i2:"i = 2"
          thus "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
                control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
                control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
                control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
                (U * v  |Deutsch.one) $$ (i, 0)"
            using j0 control2_def zero_complex.code one_complex.code vtensorone_index assms by auto
        next
          assume i3:"i = 3"
          thus "control2 U $$ (i, 0) * (v  |Deutsch.one) $$ (0, 0) +
                control2 U $$ (i, 1) * (v  |Deutsch.one) $$ (1, 0) +
                control2 U $$ (i, 2) * (v  |Deutsch.one) $$ (2, 0) +
                control2 U $$ (i, 3) * (v  |Deutsch.one) $$ (3, 0) =
                (U * v  |Deutsch.one) $$ (i, 0)"
            using j0 control2_def zero_complex.code one_complex.code vtensorone_index assms
            by (simp add: sumof2)
        qed
      qed
    qed
    finally show ?thesis using j0 by simp
  qed
next
  show "dim_row (control2 U * (v  |Deutsch.one)) = dim_row (U * v  |Deutsch.one)"
    by (metis assms(3) carrier_matD(1) control2_carrier_mat dim_row_mat(1) dim_row_tensor_mat 
        index_mult_mat(2) index_unit_vec(3) ket_vec_def mult_2_right numeral_Bit0)
next
  show "dim_col (control2 U * (v  |Deutsch.one)) = dim_col (U * v  |Deutsch.one)"
    by simp
qed


text ‹Given a single qubit gate U, control n U creates a quantum n-qubit gate that performs
a controlled-U operation on the first qubit using the last qubit as control.›

fun control:: "nat  complex Matrix.mat  complex Matrix.mat" where
  "control 0 U = 1m 1"
| "control (Suc 0) U = 1m 2"
| "control (Suc (Suc 0)) U = control2 U"
| "control (Suc (Suc n)) U = 
   ((1m 2)  SWAP_down (Suc n)) * (control2 U  (1m (2^n))) * ((1m 2)  SWAP_up (Suc n))"

lemma control_carrier_mat[simp]:
  shows "control n U  carrier_mat (2^n) (2^n)"
proof (cases n)
  case 0
  then show ?thesis by auto
next
  case (Suc nat)
  then show ?thesis
    by (smt (verit, best) One_nat_def SWAP_down_carrier_mat SWAP_up.simps(2) SWAP_up.simps(4) 
        SWAP_up_carrier_mat Suc_1 Zero_not_Suc carrier_matD(1) carrier_matD(2) carrier_matI 
        control.elims control2_carrier_mat dim_col_tensor_mat dim_row_tensor_mat index_mult_mat(2)
        index_mult_mat(3) mult_2 numeral_Bit0 power2_eq_square)
qed



section ‹Quantum Fourier Transform Circuit›

subsection ‹QFT definition›

text ‹The function kron is the generalization of the Kronecker product to a finite number of qubits›

fun kron:: "(nat  complex Matrix.mat)  nat list  complex Matrix.mat" where
  "kron f [] = 1m 1"
| "kron f (x#xs) = (f x)  (kron f xs)"


lemma kron_carrier_mat[simp]:
  assumes "m. dim_row (f m) = 2  dim_col (f m) = 1" 
  shows "kron f xs  carrier_mat (2^(length xs)) 1"
proof (induct xs)
  case Nil
  show ?case
  proof
    have "dim_row (kron f []) = dim_row (1m 1)" using kron.simps(1) by simp
    then show "dim_row (kron f []) = 2 ^ length []" by simp
  next
    have "dim_col (kron f []) = dim_col (1m 1)" using kron.simps(1) by simp
    then show "dim_col (kron f []) = 1" by simp
  qed
next
  case (Cons x xs)
  assume HI:"kron f xs  carrier_mat (2 ^ length xs) 1"
  have "f x  carrier_mat 2 1" using assms by auto
  moreover have "(f x)  (kron f xs)  carrier_mat ((2 ^ length xs) * 2) 1"
    using tensor_carrier_mat HI calculation by auto
  moreover have "kron f (x#xs)  carrier_mat (2 ^ (length (x#xs))) 1"
    using kron.simps(2) length_Cons by (metis calculation(2) power_Suc2)
  thus ?case by this
qed

lemma kron_cons_right:
  shows "kron f (xs@[x]) = kron f xs  f x"
proof (induct xs)
  case Nil
  have "kron f ([]@[x]) = kron f [x]" by simp
  also have " = f x" using kron.simps by auto
  also have " = kron f []  f x" by auto
  finally show ?case by this
next
  case (Cons a xs)
  assume IH:"kron f (xs@[x]) = kron f xs  f x"
  have "kron f ((a#xs)@[x]) = f a  (kron f (xs@[x]))" using kron.simps by auto
  also have " = f a  (kron f xs  f x)" using IH by simp
  also have " = kron f (a#xs)  f x" using kron.simps tensor_mat_is_assoc by auto
  finally show ?case by this
qed


text ‹We define the QFT product representation›

definition QFT_product_representation:: "nat  nat  complex Matrix.mat" where
  "QFT_product_representation j n  1/(sqrt (2^n)) m 
                                    (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                                    (map nat [1..n]))"


text ‹We also define the reverse version of the QFT product representation, which is the output
state of the QFT circuit alone›

definition reverse_QFT_product_representation:: "nat  nat  complex Matrix.mat" where
  "reverse_QFT_product_representation j n  1/(sqrt (2^n)) m 
                                            (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                                            (map nat (rev [1..n])))"


subsection ‹QFT circuit›

text ‹The recursive function controlled$\_$rotations computes the controlled-$R_k$ gates subcircuit
 of the QFT circuit at each stage (i.e. for each qubit).›

fun controlled_rotations:: "nat  complex Matrix.mat" where
  "controlled_rotations 0 = 1m 1"
| "controlled_rotations (Suc 0) = 1m 2"
| "controlled_rotations (Suc n) = (control (Suc n) (R (Suc n))) *
                                  ((controlled_rotations n)  (1m 2))"


lemma controlled_rotations_carrier_mat[simp]:
  "controlled_rotations n  carrier_mat (2^n) (2^n)"
proof (induct n rule: controlled_rotations.induct)
  case 1
  then show ?case by auto
next
  case 2 
  then show ?case by auto
next
  case 3
  then show ?case 
    by (smt (verit, del_insts) carrier_matD(1) carrier_matD(2) carrier_mat_triv control_carrier_mat
        controlled_rotations.simps(3) dim_col_tensor_mat index_mult_mat(2) index_mult_mat(3)
        index_one_mat(3) mult.commute power_Suc)
qed


text ‹The recursive function QFT computes the Quantum Fourier Transform circuit.›

fun QFT:: "nat  complex Matrix.mat" where
  "QFT 0 = 1m 1"
| "QFT (Suc 0) = H"
| "QFT (Suc n) =  ((1m 2)  (QFT n)) * (controlled_rotations (Suc n)) * (H  ((1m (2^n))))"


lemma QFT_carrier_mat[simp]:
  "QFT n  carrier_mat (2^n) (2^n)"
proof (induct n rule: QFT.induct)
  case 1
  then show ?case by auto
next
  case 2
  then show ?case
    using H_is_gate One_nat_def QFT.simps(2) gate_carrier_mat by presburger
next
  case 3
  then show ?case
    by (metis H_inv QFT.simps(3) carrier_matD(1) carrier_mat_triv dim_col_tensor_mat
        dim_row_tensor_mat index_mult_mat(2) index_mult_mat(3) index_one_mat(2) index_one_mat(3) 
        power.simps(2))
qed


text ‹ordered$\_$QFT reverses the order of the qubits at the end of the QFT circuit›

definition ordered_QFT:: "nat  complex Matrix.mat" where
  "ordered_QFT n  (reverse_qubits n) * (QFT n)"



section ‹QFT circuit correctness›

text ‹Some useful lemmas:›

lemma state_basis_dec:
  assumes "j < 2 ^ Suc n"
  shows "|state_basis 1 (j div 2^n)  |state_basis n (j mod 2^n) = |state_basis (Suc n) j"
proof -
  define jd jm where "jd = j div 2^n" and "jm = j mod 2^n"
  hence jml:"jm < 2^n" by auto
  have j_dec:"j = jd*(2^n) + jm" using jd_def jm_def by presburger
  show ?thesis
  proof (rule disjE)
    show "jd = 0  jd = 1" using jd_def assms
      by (metis One_nat_def less_2_cases less_power_add_imp_div_less plus_1_eq_Suc power_one_right)
  next
    assume jd0:"jd = 0"
    hence jjm:"j = jm" using j_dec by auto
    show "|state_basis 1 (j div 2^n)  |state_basis n (j mod 2^n) = |state_basis (Suc n) j"
    proof
      fix i ja
      assume "i < dim_row ( |state_basis (Suc n) j)"
        and ja_dim:"ja < dim_col ( |state_basis (Suc n) j)"
      hence il:"i < 2^Suc n" using state_basis_carrier_mat ket_vec_def state_basis_def by simp
      have jal:"ja < 1" using ja_dim state_basis_carrier_mat state_basis_def ket_vec_def by simp
      hence ja0:"ja = 0" by auto
      show "( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) $$ (i, ja) =
              |state_basis (Suc n) j $$ (i, ja)"
      proof -
        have "( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) $$ (i, ja) =
              ( |state_basis 1 0  |state_basis n jm) $$ (i,0)"
          using jm_def jd0 ja0 jd_def by auto
        also have " = |state_basis 1 0 $$ 
                        (i div (dim_row |state_basis n jm), 0 div (dim_col |state_basis n jm)) *
                        |state_basis n jm $$ 
                        (i mod (dim_row |state_basis n jm), 0 mod (dim_col |state_basis n jm))"
        proof (rule index_tensor_mat)
          show "dim_row |state_basis 1 0 = 2" 
            using state_basis_carrier_mat state_basis_def ket_vec_def by simp
          show "dim_col |state_basis 1 0 = 1"
            using state_basis_carrier_mat state_basis_def ket_vec_def by simp
          show "dim_row |state_basis n jm = dim_row |state_basis n jm" by auto
          show "dim_col |state_basis n jm = dim_col |state_basis n jm" by auto
          show "i < 2 * dim_row |state_basis n jm" 
            using il state_basis_def state_basis_carrier_mat ket_vec_def by simp
          show "0 < 1 * dim_col |state_basis n jm"
            using state_basis_def state_basis_carrier_mat ket_vec_def by simp
          show "0 < (1::nat)" using zero_less_Suc One_nat_def by blast
          show "0 < dim_col |state_basis n jm"
            using state_basis_def state_basis_carrier_mat ket_vec_def by simp
        qed
        also have " = |state_basis 1 0 $$ (i div 2^n, 0) * |state_basis n jm $$ (i mod 2^n, 0)"
          using state_basis_def state_basis_carrier_mat ket_vec_def by auto
        also have " = (mat_of_cols_list 2 [[1,0]]) $$ (i div 2^n, 0) * 
                        |state_basis n jm $$ (i mod 2^n, 0)"
          using state_basis_def unit_vec_def by auto
        also have " = |state_basis (Suc n) j $$ (i,0)"
        proof -
          define id im where "id = i div 2^n" and "im = i mod 2^n"
          have i_dec:"i = id*(2^n) + im" using id_def im_def by presburger
          show ?thesis
          proof (rule disjE)
            show "id = 0  id = 1" using id_def by (metis One_nat_def il less_2_cases 
                  less_power_add_imp_div_less plus_1_eq_Suc power_one_right)
          next
            assume id0:"id = 0"
            hence iim:"i = im" using i_dec by presburger
            have "mat_of_cols_list 2 [[1,0]] $$ (i div 2^n,0) * |state_basis n jm $$ (i mod 2^n, 0)
                = mat_of_cols_list 2 [[1,0]] $$ (0,0) * |state_basis n jm $$ (im,0)"
              using id_def id0 im_def by simp
            also have " = 1 * |state_basis n jm $$ (im,0)" using mat_of_cols_list_def by auto
            also have " = |state_basis (Suc n) jm $$ (im,0)" using iim jjm state_basis_def
              by (smt (verit, best) il im_def index_unit_vec(3) index_vec ket_vec_index lambda_one 
                  mod_less_divisor pos2 unit_vec_def zero_less_power)
            also have " = |state_basis (Suc n) j $$ (i,0)" using iim jjm by simp
            finally show ?thesis by this
          next
            assume id1:"id = 1"
            hence iid:"i = 2^n + im" using i_dec by simp
            have jma:"jm  2^n + im" using jml iid by auto
            have "mat_of_cols_list 2 [[1,0]] $$ (i div 2^n,0) * |state_basis n jm $$ (i mod 2^n,0)
                = mat_of_cols_list 2 [[1,0]] $$ (1,0) * |state_basis n jm $$ (im,0)"
              using id1 id_def im_def by simp
            also have " = 0" using mat_of_cols_list_def by auto
            also have " = |state_basis (Suc n) jm $$ (2^n + im,0)" 
            proof -
              have "|state_basis (Suc n) jm $$ (2^n + im,0) = 
                    |unit_vec (2^(Suc n)) jm $$ (2^n+im,0)"
                using state_basis_def by simp
              also have " = Matrix.mat (2^(Suc n)) 1 (λ(i, j). (unit_vec (2^(Suc n)) jm) $ i)
                              $$ (2^n+im,0)"
                using ket_vec_def by simp
              also have " = Matrix.mat (2^(Suc n)) 1 (λ(i,j). Matrix.vec (2^(Suc n)) 
                              (λj'. if j'=jm then 1 else 0) $ i) $$ (2^n+im,0)"
                using unit_vec_def by metis
              also have " = 0" using iid il jma by fastforce
              finally show ?thesis by auto
            qed
            also have " = |state_basis (Suc n) j $$ (i,0)" using jjm iid by simp
            finally show ?thesis by this
          qed
        qed
        finally show ?thesis using ja0 by auto
      qed
    next
      show "dim_row ( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) =
            dim_row |state_basis (Suc n) j" 
        using state_basis_def state_basis_carrier_mat ket_vec_def by auto
    next
      show "dim_col ( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) =
            dim_col |state_basis (Suc n) j"
        using state_basis_def state_basis_carrier_mat ket_vec_def by auto
    qed
  next
    assume jd1:"jd = 1"
    hence j_dec2:"j = 2^n + jm" using j_dec by auto
    show "|state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n) = |state_basis (Suc n) j"
    proof
      fix i ja
      assume "i < dim_row |state_basis (Suc n) j"
      hence il:"i < 2^(Suc n)" using state_basis_def state_basis_carrier_mat ket_vec_def by simp
      assume "ja < dim_col |state_basis (Suc n) j"
      hence jal:"ja < 1" using state_basis_def state_basis_carrier_mat ket_vec_def by simp
      hence ja0:"ja = 0" by auto
      show "( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) $$ (i, ja) =
              |state_basis (Suc n) j $$ (i, ja)"
      proof -
        have "( |state_basis 1 jd  |state_basis n jm) $$ (i, 0) =
              ( |state_basis 1 1  |state_basis n jm) $$ (i, 0)"
          using jd1 by simp
        also have " = |state_basis 1 1 $$ 
                        (i div (dim_row |state_basis n jm), 0 div (dim_col |state_basis n jm)) *
                        |state_basis n jm $$ 
                        (i mod (dim_row |state_basis n jm), 0 mod (dim_col |state_basis n jm))"
        proof (rule index_tensor_mat)
          show "dim_row |state_basis 1 1 = 2" 
            using state_basis_carrier_mat state_basis_def ket_vec_def by simp
          show "dim_col |state_basis 1 1 = 1"
            using state_basis_carrier_mat state_basis_def ket_vec_def by simp
          show "dim_row |state_basis n jm = dim_row |state_basis n jm" by auto
          show "dim_col |state_basis n jm = dim_col |state_basis n jm" by auto
          show "i < 2 * dim_row |state_basis n jm"
            using state_basis_carrier_mat state_basis_def ket_vec_def il by auto
          show "0 < 1 * dim_col |state_basis n jm"
            using state_basis_carrier_mat state_basis_def ket_vec_def by auto
          show "0 < (1::nat)" by simp
          show "0 < dim_col |state_basis n jm"
            using state_basis_carrier_mat state_basis_def ket_vec_def by auto
        qed
        also have " = (mat_of_cols_list 2 [[0,1]]) $$ (i div 2^n,0) *
                        |state_basis n jm $$ (i mod 2^n,0)"
          using state_basis_carrier_mat state_basis_def ket_vec_def mat_of_cols_list_def 
            ket_one_to_mat_of_cols_list
          by auto
        also have " = |state_basis (Suc n) j $$ (i,0)"
        proof -
          define id im where "id = i div 2^n" and "im = i mod 2^n"
          have i_dec:"i = id*(2^n) + im" using id_def im_def by presburger
          show ?thesis
          proof (rule disjE)
            show "id = 0  id = 1" using id_def il
              by (metis One_nat_def less_2_cases less_power_add_imp_div_less plus_1_eq_Suc 
                  power_one_right)
          next
            assume id0:"id = 0"
            hence iim:"i = im" using i_dec by presburger
            have "mat_of_cols_list 2 [[0,1]] $$ (i div 2^n,0) * |state_basis n jm $$ (i mod 2^n,0)
                = mat_of_cols_list 2 [[0,1]] $$ (0,0) * |state_basis n jm $$ (im,0)"
              using id0 id_def im_def by simp
            also have " = 0" using mat_of_cols_list_def by auto
            also have " = |state_basis (Suc n) j $$ (im,0)"
              using state_basis_def ket_vec_def j_dec2 assms id0 iim il local.id_def by force
            also have " = |state_basis (Suc n) j $$ (i,0)" using iim by simp
            finally show ?thesis by this
          next
            assume id1:"id = 1"
            hence i2m:"i = 2^n + im" using i_dec by presburger
            have "mat_of_cols_list 2 [[0,1]] $$ (i div 2^n,0) * |state_basis n jm $$ (i mod 2^n,0)
                = mat_of_cols_list 2 [[0,1]] $$ (1,0) * |state_basis n jm $$ (im,0)"
              using id1 id_def im_def by simp
            also have " = |state_basis n jm $$ (im,0)" using mat_of_cols_list_def by auto
            also have " = |state_basis (Suc n) j $$ (i,0)"
              using i2m j_dec2 il assms state_basis_def by auto
            finally show ?thesis by this
          qed
        qed
        finally show "( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) $$ (i, ja) =
                      |state_basis (Suc n) j $$ (i, ja)" 
          using ja0 jd_def jm_def by auto
      qed
    next
      show "dim_row ( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) =
            dim_row |state_basis (Suc n) j"
        using state_basis_def state_basis_carrier_mat ket_vec_def by simp
    next
      show "dim_col ( |state_basis 1 (j div 2 ^ n)  |state_basis n (j mod 2 ^ n)) =
            dim_col |state_basis (Suc n) j"
        using state_basis_def state_basis_carrier_mat ket_vec_def by simp
    qed
  qed
qed

lemma state_basis_dec':
  "j. j < 2 ^ Suc n  
    |state_basis n (j div 2)  |state_basis 1 (j mod 2) = |state_basis (Suc n) j"
proof (induct n)
  case 0
  show ?case
  proof 
    fix j::nat
    show "j < 2 ^ Suc 0 
         |state_basis 0 (j div 2)  |state_basis 1 (j mod 2) = |state_basis (Suc 0) j"
    proof
      assume "j < 2 ^ Suc 0"
      hence j2:"j < 2" by auto
      hence jd0:"j div 2 = 0" by auto
      have jmj:"j mod 2 = j" using j2 by auto
      have "|state_basis 0 (j div 2)  |state_basis 1 (j mod 2) =
            |state_basis 0 0  |state_basis 1 j"
        using jmj jd0 by simp
      also have " = (1m 1)  |state_basis 1 j"
        using state_basis_def unit_vec_def ket_vec_def by auto
      also have " = |state_basis 1 j" using left_tensor_id by blast
      finally show "|state_basis 0 (j div 2)  |state_basis 1 (j mod 2) = |state_basis (Suc 0) j"
        by auto
    qed
  qed
next
  case (Suc n)
  assume HI:"j<2 ^ Suc n. |state_basis n (j div 2)  |state_basis 1 (j mod 2) =
                           |state_basis (Suc n) j"
  define m where "m = Suc n"
  show ?case
  proof 
    fix j::nat
    show "j < 2 ^ Suc (Suc n) 
       |state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2) = |state_basis (Suc (Suc n)) j"
    proof 
      assume jleq:"j < 2 ^ Suc (Suc n)"
      define jd2 where "jd2 = j div 2"
      define jm2 where "jm2 = j mod 2"
      define jd2m where "jd2m = j div 2^m"
      define jm2m where "jm2m = j mod 2^m"
      define jmm where "jmm = jd2 mod 2^n"
      have "|state_basis m jd2  |state_basis 1 jm2 =
            ( |state_basis 1 jd2m  |state_basis n jmm)  |state_basis 1 jm2"
        using jleq state_basis_dec m_def jd2_def jm2_def jd2m_def jmm_def jm2_def
        by (metis Suc_eq_plus1 div_exp_eq less_power_add_imp_div_less plus_1_eq_Suc power_one_right)
      also have " = |state_basis 1 jd2m  ( |state_basis n jmm  |state_basis 1 jm2)"
        using tensor_mat_is_assoc by presburger
      also have " = |state_basis 1 jd2m  |state_basis m jm2m"
        using HI jm2m_def jmm_def jm2_def 
        by (metis Suc_eq_plus1 div_exp_mod_exp_eq jd2_def le_simps(2) less_add_same_cancel2 m_def 
            mod_less_divisor mod_mod_power_cancel plus_1_eq_Suc pos2 power_one_right zero_less_Suc 
            zero_less_power)
      also have " = |state_basis (Suc m) j"
        using state_basis_dec m_def jleq jd2m_def jm2m_def by presburger
      finally show "|state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2) =
                    |state_basis (Suc (Suc n)) j"
        using jd2_def jm2_def m_def by simp
    qed
  qed
qed


text ‹Action of the H gate in the circuit›

lemma H_on_first_qubit:
  assumes "j < 2 ^ Suc n"
  shows "((H  ((1m (2^n))))) * |state_basis (Suc n) j = 
         1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  
         |state_basis n (j mod 2^n)"
proof -
  define jd jm where "jd = j div 2^n" and "jm = j mod 2^n"
  have "((H  ((1m (2^n))))) * |state_basis (Suc n) j = 
        ((H  ((1m (2^n))))) * ( |state_basis 1 jd  |state_basis n jm)"
    using jd_def jm_def state_basis_dec assms by simp
  also have " = (H * |state_basis 1 jd)  ((1m (2^n)) * |state_basis n jm)"
    using H_def state_basis_carrier_mat state_basis_def ket_vec_def mult_distr_tensor 
    by (metis (no_types, lifting) H_without_scalar_prod carrier_matD(1) dim_col_mat(1) 
        index_one_mat(3) pos2 power_one_right zero_less_one_class.zero_less_one zero_less_power)
  also have " = 1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat jd)/2) m |one)  
                  |state_basis n jm"
  proof -
    have 0:"1m (2 ^ n) * |state_basis n jm = |state_basis n jm" 
      using left_mult_one_mat state_basis_carrier_mat by metis
    have "H * |state_basis 1 jd =
          1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat jd)/2) m |one)"
    proof (rule disjE)
      show "jd = 0  jd = 1" using jd_def assms by (metis One_nat_def less_2_cases 
            less_power_add_imp_div_less plus_1_eq_Suc power_one_right)
    next
      assume jd0:"jd = 0"
      have "H * |state_basis 1 0 = 
            mat_of_cols_list 2 (map (map complex_of_real) [[1 / sqrt 2, 1 / sqrt 2]])" 
        using H_on_ket_zero state_basis_def by auto
      also have " = 1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat 0)/2) m |one)"
      proof 
        fix i j
        assume ai:"i < dim_row ((1/sqrt 2) m ( |zero + exp (2*𝗂*pi*complex_of_nat 0/2) m |one))"
        hence "i < 2" using mat_of_cols_list_def smult_carrier_mat ket_vec_def by simp
        hence i2:"i  {0,1}" by auto
        assume aj:"j < dim_col ((1/sqrt 2) m ( |zero + exp (2*𝗂*pi*complex_of_nat 0/2) m |one))"
        hence j0:"j = 0" using mat_of_cols_list_def smult_carrier_mat ket_vec_def by simp
        have "(mat_of_cols_list 2 (map (map complex_of_real) [[1 / sqrt 2, 1 / sqrt 2]])) $$ (i,0) =
              (mat_of_cols_list 2 [[1/sqrt 2, 1/sqrt 2]]) $$ (i,0)"
          using map_def by simp
        also have " = 1/sqrt 2" using i2 index_mat_of_cols_list by auto
        also have " = (1/sqrt 2 m (mat_of_cols_list 2 [[1,1]])) $$ (i,0)"
          using smult_mat_def mat_of_cols_list_def index_mat_of_cols_list 
          by (smt (verit, best) Suc_1 i < 2 dim_col_mat(1) dim_row_mat(1) index_smult_mat(1) 
              ket_one_is_state ket_one_to_mat_of_cols_list less_Suc_eq_0_disj less_one list.size(4) 
              mult.right_neutral nth_Cons_0 nth_Cons_Suc state_def)
        also have " = (1/sqrt 2 m ( |zero + |one)) $$ (i,0)"
        proof -
          have "mat_of_cols_list 2 [[1,1]] = |zero + |one"
          proof 
            fix i j::nat 
            define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
            assume "i < dim_row s2" and "j < dim_col s2"
            hence "i  {0,1}  j = 0" using index_add_mat 
              by (simp add: ket_vec_def less_Suc_eq numerals(2) s2_def)
            thus "s1 $$ (i,j) = s2 $$ (i,j)" using s1_def s2_def mat_of_cols_list_def 
                i < dim_row s2 ket_one_to_mat_of_cols_list by force
          next
            define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
            thus "dim_row s1 = dim_row s2" using mat_of_cols_list_def by (simp add: ket_vec_def)
          next
            define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
            thus "dim_col s1 = dim_col s2" using mat_of_cols_list_def by (simp add: ket_vec_def)
          qed
          thus ?thesis by simp
        qed
        also have " = (1/sqrt 2 m ( |zero + 1 m |one)) $$ (i,0)"
          using smult_mat_def i < 2 ket_one_is_state state_def by force
        also have " = (1/sqrt 2 m ( |zero + exp (2*𝗂*pi*(complex_of_nat 0)/2) m |one)) $$ (i,0)"
          by auto
        finally show "Tensor.mat_of_cols_list 2 (map (map complex_of_real) 
                      [[1 / sqrt 2, 1 / sqrt 2]]) $$ (i, j) =
                      (complex_of_real (1 / sqrt 2) m ( |Deutsch.zero + 
                       exp (2 * 𝗂 * complex_of_real pi * complex_of_nat 0 / 2) m |Deutsch.one)) $$
                       (i, j)" 
          using j0 i2 ai aj by auto
      next
        show "dim_row (Tensor.mat_of_cols_list 2 (map (map complex_of_real)
              [[1 / sqrt 2, 1 / sqrt 2]])) = dim_row (complex_of_real (1 / sqrt 2) m
              ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat 0 /2) m
                |Deutsch.one))" 
          using mat_of_cols_list_def index_mat_of_cols_list smult_carrier_mat ket_vec_def by auto
      next
        show "dim_col (Tensor.mat_of_cols_list 2 (map (map complex_of_real)
              [[1 / sqrt 2, 1 / sqrt 2]])) = dim_col (complex_of_real (1 / sqrt 2) m
              ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat 0 /2) m
                |Deutsch.one))"
          using mat_of_cols_list_def index_mat_of_cols_list smult_carrier_mat ket_vec_def by auto
      qed
      finally show ?thesis using jd0 by simp
    next
      assume jd1:"jd = 1"
      have "H * |state_basis 1 1 = 
            mat_of_cols_list 2 (map (map complex_of_real) [[1 / sqrt 2, - 1 / sqrt 2]])"
        using H_on_ket_one map_def by (simp add: state_basis_def)
      also have " = (1 / sqrt 2) m ( |zero + exp (2*𝗂*pi*complex_of_nat 1 / 2) m |one)"
      proof 
        fix i j
        assume ai:"i < dim_row (complex_of_real (1 / sqrt 2) m ( |zero + 
                       exp (2*𝗂*complex_of_real pi *complex_of_nat 1 /2) m |one))"
        hence "i < 2" using mat_of_cols_list_def smult_carrier_mat ket_vec_def by simp
        hence i2:"i  {0,1}" by auto
        assume aj:"j < dim_col (complex_of_real (1 / sqrt 2) m ( |zero + 
                       exp (2*𝗂*complex_of_real pi *complex_of_nat 1 /2) m |one))"
        hence j0:"j = 0" using mat_of_cols_list_def smult_carrier_mat ket_vec_def by simp
        have "(mat_of_cols_list 2 (map (map complex_of_real) [[1 / sqrt 2,-1 / sqrt 2]])) $$ (i,0) =
              (mat_of_cols_list 2 [[1/sqrt 2,- 1/sqrt 2]]) $$ (i,0)"
          using map_def by simp
        also have " = ((1/sqrt 2) m (mat_of_cols_list 2 [[1,-1]])) $$ (i,0)"
          using i2 smult_mat_def index_mat_of_cols_list mat_of_cols_list_def Suc_1 i < 2 
            dim_col_mat(1) dim_row_mat(1) index_smult_mat(1) nth_Cons_0 nth_Cons_Suc
            ket_one_is_state ket_one_to_mat_of_cols_list
          by (smt (z3) One_nat_def ψ0_to_ψ1 bot_nat_0.not_eq_extremum dim_col_tensor_mat 
              less_2_cases_iff list.map(2) list.size(4) mult_0_right mult_1 of_real_1 
              of_real_divide of_real_minus state_def times_divide_eq_left)
        also have " = (1/sqrt 2 m ( |zero - |one)) $$ (i,0)"
        proof -
          define r1 r2 where "r1 = mat_of_cols_list 2 [[1,-1]]" and "r2 = |zero - |one"
          have "r1 $$ (0,0) = r2 $$ (0,0)" using r1_def r2_def mat_of_cols_list_def
            by (smt (verit, ccfv_threshold) One_nat_def add.commute diff_zero dim_row_mat(1) 
                index_mat(1) index_mat_of_cols_list ket_one_is_state ket_one_to_mat_of_cols_list 
                ket_zero_to_mat_of_cols_list list.size(3) list.size(4) minus_mat_def nth_Cons_0 
                plus_1_eq_Suc pos2 state_def zero_less_one_class.zero_less_one)
          moreover have "r1 $$ (1,0) = r2 $$ (1,0)" 
            using r1_def r2_def mat_of_cols_list_def ket_vec_def by simp
          ultimately show ?thesis using r1_def r2_def i2 
            by (smt (verit) One_nat_def Tensor.mat_of_cols_list_def i < 2 add.commute 
                dim_col_mat(1) dim_row_mat(1) empty_iff index_smult_mat(1) index_unit_vec(3) 
                insert_iff ket_vec_def list.size(3) list.size(4) minus_mat_def plus_1_eq_Suc 
                zero_less_one_class.zero_less_one)
        qed
        also have " = (1/sqrt 2 m ( |zero + (-1) m |one)) $$ (i,0)"
          using smult_mat_def i < 2 ket_one_is_state state_def by force
        also have " = (1/sqrt 2 m ( |zero + exp (2*𝗂*pi*complex_of_nat 1 / 2) m |one)) $$ (i,0)"
          using exp_pi_i' by auto
        finally show "mat_of_cols_list 2 (map (map complex_of_real) [[1/sqrt 2,-1/sqrt 2]]) $$ (i,j)
                   = (complex_of_real (1 / sqrt 2) m ( |zero + exp (2*𝗂*pi*complex_of_nat 1 /2) m
                     |one)) $$ (i, j)" using i2 ai aj j0 by auto
      next
        show "dim_row (Tensor.mat_of_cols_list 2 (map (map complex_of_real)
              [[1 / sqrt 2,- 1 / sqrt 2]])) = dim_row (complex_of_real (1 / sqrt 2) m
              ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat 1 /2) m
                |Deutsch.one))" 
          using mat_of_cols_list_def index_mat_of_cols_list smult_carrier_mat ket_vec_def by auto
      next
        show "dim_col (Tensor.mat_of_cols_list 2 (map (map complex_of_real)
              [[1 / sqrt 2,- 1 / sqrt 2]])) = dim_col (complex_of_real (1 / sqrt 2) m
              ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat 1 /2) m
                |Deutsch.one))"
          using mat_of_cols_list_def index_mat_of_cols_list smult_carrier_mat ket_vec_def by auto
      qed
      finally show ?thesis using jd1 by simp
    qed
    hence "(H * |state_basis 1 jd)  |state_basis n jm = 
          (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*(complex_of_nat jd)/2) m |one)))  |state_basis n jm"
      by simp
    thus ?thesis using 0 by presburger
  qed
  finally show ?thesis using jm_def jd_def by auto
qed


text ‹Action of the R gate in the circuit›

lemma R_action:
  assumes "j < 2 ^ Suc n" and "j mod 2 = 1"
  shows "(R (Suc n)) * ( |zero + exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m |one) =
         |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc n)) m |one"
proof 
  fix i ja::nat
  assume "i < dim_row ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc n)) m |one)"
  hence il2:"i < 2" by (simp add: ket_vec_def)
  assume "ja < dim_col ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc n)) m |one)"
  hence ja0:"ja = 0" by (simp add: ket_vec_def)
  have "(R (Suc n)) * ( |zero + exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m |one) =
        (mat_of_cols_list 2 [[1, 0],[0, exp(2*pi*𝗂/2^(Suc n))]]) *
        ( |zero + exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m |one)"
    using R_def by simp
  also have " = (mat_of_cols_list 2 [[1, 0],[0, exp(2*pi*𝗂/2^(Suc n))]]) *
                  (mat_of_cols_list 2 [[1,0]] + 
                   exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m mat_of_cols_list 2 [[0,1]])"
    using ket_one_to_mat_of_cols_list ket_zero_to_mat_of_cols_list by presburger
  also have " = (mat_of_cols_list 2 [[1, 0],[0, exp(2*pi*𝗂/2^(Suc n))]]) *
                  (mat_of_cols_list 2 [[1,0]] + 
                   mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
  proof -
    have "exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m mat_of_cols_list 2 [[0,1]] =
          mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]"
    proof 
      fix a b::nat
      assume "a < dim_row (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
      hence a2:"a < 2" by (simp add: Tensor.mat_of_cols_list_def)
      assume "b < dim_col (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
      hence b0:"b = 0" 
        by (metis One_nat_def Suc_eq_plus1 Tensor.mat_of_cols_list_def dim_col_mat(1) less_Suc0 
            list.size(3) list.size(4))
      have "(exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m mat_of_cols_list 2 [[0,1]]) $$ (a,0) =
            exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * (mat_of_cols_list 2 [[0,1]] $$ (a,0))"
        using index_smult_mat a2 ket_one_is_state ket_one_to_mat_of_cols_list state_def by force
      also have " = (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,0)"
      proof (rule disjE)
        show "a = 0  a = 1" using a2 by auto
      next
        assume a0:"a = 0"
        have "exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * (mat_of_cols_list 2 [[0,1]] $$ (0,0)) =
              exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * 0"
          using index_mat_of_cols_list by auto
        thus "exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * (mat_of_cols_list 2 [[0,1]] $$ (a,0)) =
              (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,0)"
          using a0 by auto
      next
        assume a1:"a = 1"
        have "exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * (mat_of_cols_list 2 [[0,1]] $$ (1,0)) =
              exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * 1"
          using index_mat_of_cols_list by auto
        thus "exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) * (mat_of_cols_list 2 [[0,1]] $$ (a,0)) =
              (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,0)"
          using a1 by auto
      qed
      finally show "(exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n) m mat_of_cols_list 2 [[0,1]]) 
        $$ (a,b) = (mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b)"
        using b0 by simp
    next
      show "dim_row (exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n) m
            Tensor.mat_of_cols_list 2 [[0, 1]]) =
            dim_row (Tensor.mat_of_cols_list 2 [[0, exp (2 * 𝗂 * complex_of_real pi *
                      complex_of_nat (j div 2) / 2 ^ n)]])" 
        by (simp add: Tensor.mat_of_cols_list_def)
    next
      show "dim_col (exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n) m
            Tensor.mat_of_cols_list 2 [[0, 1]]) =
            dim_col (Tensor.mat_of_cols_list 2 [[0, exp (2 * 𝗂 * complex_of_real pi *
                      complex_of_nat (j div 2) / 2 ^ n)]])"
        by (simp add: mat_of_cols_list_def)
    qed
    thus ?thesis by auto
  qed
  also have " = (mat_of_cols_list 2 [[1, 0],[0, exp(2*pi*𝗂/2^(Suc n))]]) *
                  (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
  proof -
    have "mat_of_cols_list 2 [[1,0]] + 
          mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]] = 
          mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]"
    proof 
      fix a b::nat
      assume "a < dim_row (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
      hence a2:"a < 2" using mat_of_cols_list_def by simp 
      assume "b < dim_col (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]])"
      hence b0:"b = 0" using mat_of_cols_list_def by auto
      show "(mat_of_cols_list 2 [[1,0]] + 
             mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b) = 
            (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b)"
      proof (rule disjE)
        show "a = 0  a = 1" using a2 by auto
      next
        assume a0:"a = 0"
        have "(mat_of_cols_list 2 [[1,0]] + 
               mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (0,0) = 
              (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (0,0)"
          using index_mat_of_cols_list by (simp add: Tensor.mat_of_cols_list_def)
        thus "(mat_of_cols_list 2 [[1,0]] + 
               mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b) = 
              (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b)"
          using a0 b0 by simp
      next
        assume a1:"a = 1"
        show "(mat_of_cols_list 2 [[1,0]] + 
               mat_of_cols_list 2 [[0,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b) = 
              (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^n)]]) $$ (a,b)"
          using a1 b0 index_mat_of_cols_list mat_of_cols_list_def by simp
      qed
    next
      show "dim_row (Tensor.mat_of_cols_list 2 [[1, 0]] + Tensor.mat_of_cols_list 2
            [[0, exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n)]]) =
            dim_row (Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi *
                    complex_of_nat (j div 2) / 2 ^ n)]])"
        by (simp add: Tensor.mat_of_cols_list_def)
    next 
      show "dim_col (Tensor.mat_of_cols_list 2 [[1, 0]] + Tensor.mat_of_cols_list 2
            [[0, exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n)]]) =
            dim_col (Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi *
                    complex_of_nat (j div 2) / 2 ^ n)]])"
        by (simp add: mat_of_cols_list_def)
    qed
    thus ?thesis by simp
  qed
  finally have 1:"R (Suc n) * ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi *
                  complex_of_nat (j div 2) / 2 ^ n) m |Deutsch.one) =
                  Tensor.mat_of_cols_list 2 [[1, 0], [0, exp (complex_of_real (2 * pi) * 𝗂 /
                  2 ^ Suc n)]] * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi *
                  complex_of_nat (j div 2) / 2 ^ n)]]"
    by this
  show "(R (Suc n) * ( |Deutsch.zero + exp (2 * 𝗂 * pi *  complex_of_nat (j div 2) /  2 ^ n) m
        |Deutsch.one)) $$ (i, ja) =
       ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc n) m
        |Deutsch.one) $$ (i, ja)"
  proof -
    have "((R (Suc n) * ( |Deutsch.zero + exp (2 * 𝗂 * pi *  complex_of_nat (j div 2) /  2 ^ n) m
          |Deutsch.one))) $$ (i, ja) = 
          (Tensor.mat_of_cols_list 2 [[1, 0], [0, exp (complex_of_real (2 * pi) * 𝗂 /
                  2 ^ Suc n)]] * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi *
                  complex_of_nat (j div 2) / 2 ^ n)]]) $$ (i,ja)"
      using 1 by simp
    also have " = mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]] $$ (i,ja)"
    proof (rule disjE)
      show "i = 0  i = 1" using il2 by auto
    next
      assume i0:"i = 0"
      have "(Tensor.mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]]
             * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
             complex_of_nat (j div 2) / 2 ^ n)]]) $$ (0, 0) = 
           (k<2. (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
            $$ (0,k) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
             complex_of_nat (j div 2) / 2 ^ n)]]) $$ (k,0))"
        using index_mult_mat mat_of_cols_list_def by auto
      also have " = (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
                      $$ (0,0) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                       complex_of_nat (j div 2) / 2 ^ n)]]) $$ (0,0) +
                      (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
                      $$ (0,1) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                       complex_of_nat (j div 2) / 2 ^ n)]]) $$ (1,0)"
        by (simp only:sumof2)
      also have " = 1" by auto
      also have " = mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]] $$ (0,0)"
        using index_mat_of_cols_list by simp
      finally show "(Tensor.mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 
                    2 ^ Suc n)]] * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                    complex_of_nat (j div 2) / 2 ^ n)]]) $$ (i, ja) = 
                    (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (i,ja)"
        using i0 ja0 by simp
    next
      assume i1:"i = 1"
      have "(Tensor.mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]]
             * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
             complex_of_nat (j div 2) / 2 ^ n)]]) $$ (1, 0) = 
           (k<2. (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
            $$ (1,k) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
             complex_of_nat (j div 2) / 2 ^ n)]]) $$ (k,0))"
        using index_mult_mat mat_of_cols_list_def by auto
      also have " = (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
                      $$ (1,0) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                       complex_of_nat (j div 2) / 2 ^ n)]]) $$ (0,0) +
                      (mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n)]])
                      $$ (1,1) * (mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                       complex_of_nat (j div 2) / 2 ^ n)]]) $$ (1,0)"
        by (simp only: sumof2)
      also have " = exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n) *
                      exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n)"
        using index_mat_of_cols_list by auto
      also have " = exp (complex_of_real (2 * pi) * 𝗂 / 2 ^ Suc n +
                          2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n)"
        using mult_exp_exp by simp
      also have " = exp (2 * 𝗂 * pi / 2 ^ Suc n +
                          2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ n)"
        by (simp add: mult.commute)
      also have " = exp (2*𝗂*pi*(1/2^Suc n + complex_of_nat (j div 2)/2^n))"
        by (simp add: distrib_left)
      also have " = exp (2*𝗂*pi*((1 + 2*(j div 2))/2^Suc n))" 
        by (simp add: add_divide_distrib)
      also have " = exp (2*𝗂*pi*(j)/2^Suc n)"
        using assms
        by (smt (verit, ccfv_threshold) Suc_eq_plus1 div_mult_mod_eq mult.commute of_real_1 
            of_real_add of_real_divide of_real_of_nat_eq of_real_power one_add_one plus_1_eq_Suc 
            times_divide_eq_right)
      also have " = (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (1,0)"
        using index_mat_of_cols_list by simp
      finally show "(Tensor.mat_of_cols_list 2 [[1, 0],[0, exp (complex_of_real (2 * pi) * 𝗂 / 
                    2 ^ Suc n)]] * Tensor.mat_of_cols_list 2 [[1, exp (2 * 𝗂 * complex_of_real pi * 
                    complex_of_nat (j div 2) / 2 ^ n)]]) $$ (i, ja) = 
                    (mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (i,ja)"
        using i1 ja0 by simp
    qed
    also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (i,ja)"
    proof (rule disjE)
      show "i = 0  i = 1" using il2 by auto
    next
      assume i0:"i = 0"
      have "(mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (0,0) = 1"
        by auto
      also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (0,0)"
      proof -
        have "|zero $$ (0,0) = 1" by auto
        moreover have "(exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (0,0) = 0"
        proof -
          have "(exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (0,0) =
                exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) * |one $$ (0,0)"
            using index_smult_mat using ket_one_is_state state_def by auto
          also have " = 0" by auto
          finally show ?thesis by this
        qed
        ultimately show ?thesis by (simp add: ket_vec_def)
      qed
      finally show "(mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (i,ja) =
                    ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (i,ja)"
        using i0 ja0 by simp
    next
      assume i1:"i = 1"
      have "(mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (1,0) =
            exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)" by auto
      also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (1,0)"
      proof -
        have "|zero $$ (1,0) = 0" by auto
        moreover have "(exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (1,0) =
                        exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)"
        proof -
          have "(exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (1,0) =
                exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) * |one $$ (1,0)"
            using index_smult_mat ket_one_is_state state_def by auto
          also have " = exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)" by auto
          finally show ?thesis by this
        qed
        ultimately show ?thesis by (simp add: ket_vec_def)
      qed
      finally show "(mat_of_cols_list 2 [[1,exp (2*𝗂*pi*complex_of_nat j / 2^Suc n)]]) $$ (i,ja) =
                    ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) $$ (i,ja)"
        using i1 ja0 by simp
    qed
    finally show ?thesis by this
  qed
next
  show "dim_row (R (Suc n) * ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi *
        complex_of_nat (j div 2) / 2 ^ n) m |Deutsch.one)) =
        dim_row ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc n) m
        |Deutsch.one)" 
    by (simp add: R_def Tensor.mat_of_cols_list_def ket_vec_def)
next
  show "dim_col (R (Suc n) * ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi *
        complex_of_nat (j div 2) / 2 ^ n) m |Deutsch.one)) =
        dim_col ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc n) m
        |Deutsch.one)"
    by (simp add: R_def Tensor.mat_of_cols_list_def ket_vec_def)
qed


text ‹Action of the SWAP cascades in the circuit›

lemma SWAP_up_action:
  "j. j < 2 ^(Suc (Suc n))  
    SWAP_up (Suc (Suc n)) * ( |state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2)) =
    |state_basis 1 (j mod 2)  |state_basis (Suc n) (j div 2)"
proof (induct n)
  case 0
  show ?case
  proof
    fix j
    show "j < 2 ^ Suc (Suc 0)  SWAP_up (Suc (Suc 0)) * ( |state_basis (Suc 0) (j div 2) 
          |state_basis 1 (j mod 2)) =
          |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2)"
    proof
      assume "j < 2^ Suc (Suc 0)"
      show "SWAP_up (Suc (Suc 0)) * ( |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2)) 
            = |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2)"
      proof -
        have "SWAP_up (Suc (Suc 0))*( |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2))
              = SWAP * ( |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2))"
          using SWAP_up.simps by simp
        also have " = |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2)"
          using SWAP_tensor
          by (metis One_nat_def power_one_right state_basis_carrier_mat)
        finally show ?thesis by this
      qed
    qed
  qed
next
  case (Suc n)
  assume HI:"j<2 ^ Suc (Suc n).
            SWAP_up (Suc (Suc n)) * ( |state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2))
            = |state_basis 1 (j mod 2)  |state_basis (Suc n) (j div 2)"
  show "j<2 ^ Suc (Suc (Suc n)).
         SWAP_up (Suc (Suc (Suc n))) * ( |state_basis (Suc (Suc n)) (j div 2)  
         |state_basis 1 (j mod 2)) =
         |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)"
  proof 
    fix j::nat
    show "j < 2 ^ Suc (Suc (Suc n)) 
         SWAP_up (Suc (Suc (Suc n))) * ( |state_basis (Suc (Suc n)) (j div 2) 
          |state_basis 1 (j mod 2)) =
         |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)"
    proof 
      assume jl:"j < 2 ^ Suc (Suc (Suc n))"
      show "SWAP_up (Suc (Suc (Suc n))) * ( |state_basis (Suc (Suc n)) (j div 2) 
            |state_basis 1 (j mod 2)) =
            |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)"
      proof -
        have "SWAP_up (Suc (Suc (Suc n))) * ( |state_basis (Suc (Suc n)) (j div 2) 
              |state_basis 1 (j mod 2)) =
              ((SWAP  (1m (2^(Suc n)))) * ((1m 2)  (SWAP_up (Suc (Suc n))))) *
              ( |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2))"
          using SWAP_up.simps by simp
        also have " = (SWAP  (1m (2^(Suc n)))) * (((1m 2)  (SWAP_up (Suc (Suc n)))) *
                        ( |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2)))"
          using assoc_mult_mat
          by (smt (verit, ccfv_threshold) Groups.mult_ac(2) Groups.mult_ac(3) One_nat_def 
              SWAP_up.simps(3) SWAP_up_carrier_mat carrier_matD(2) carrier_matI dim_col_tensor_mat 
              dim_row_mat(1) dim_row_tensor_mat index_mult_mat(2) index_one_mat(3) 
              index_unit_vec(3) ket_vec_def left_mult_one_mat power_Suc2 power_one_right 
              state_basis_def)
        also have " = (SWAP  (1m (2^(Suc n)))) * (((1m 2)  (SWAP_up (Suc (Suc n)))) *
                        (( |state_basis 1 ((j div 2) div 2^Suc n)  
                           |state_basis (Suc n) ((j div 2) mod 2^Suc n))
                          |state_basis 1 (j mod 2)))"
          using state_basis_dec
          by (metis jl less_mult_imp_div_less power_Suc2)
        also have " = (SWAP  (1m (2^(Suc n)))) * (((1m 2)  (SWAP_up (Suc (Suc n)))) *
                        ( |state_basis 1 ((j div 2) div 2^Suc n)  
                         ( |state_basis (Suc n) ((j div 2) mod 2^Suc n)
                          |state_basis 1 (j mod 2))))"
          using tensor_mat_is_assoc state_basis_carrier_mat by auto
        also have " = (SWAP  (1m (2^(Suc n)))) * (((1m 2)  (SWAP_up (Suc (Suc n)))) *
                        ( |state_basis 1 ((j div 2) div 2^Suc n)  
                        ( |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2)
                         |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2))))"
          using jl power_Suc power_add power_one_right
          by (smt (z3) Suc_1 add_0 div_Suc div_exp_mod_exp_eq lessI mod_less mod_mod_cancel 
              mod_mult_self2 n_not_Suc_n odd_Suc_div_two plus_1_eq_Suc)
        also have " = (SWAP  (1m (2^(Suc n)))) *
                        (((1m 2) * |state_basis 1 ((j div 2) div 2^Suc n)) 
                        ((SWAP_up (Suc (Suc n)))) *
                        ( |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2)
                         |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2)))"
          using mult_distr_tensor
          by (metis SWAP_up_carrier_mat carrier_matD(1) carrier_matD(2) index_one_mat(3) 
              less_numeral_extra(1) mod_less_divisor pos2 power_one_right state_basis_carrier_mat 
              state_basis_dec' zero_less_power)
        also have " = (SWAP  (1m (2^(Suc n)))) *
                        ( |state_basis 1 ((j div 2) div 2^Suc n) 
                        ( |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2) 
                          |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2)))"
          using HI
          by (metis left_mult_one_mat mod_less_divisor pos2 power_one_right state_basis_carrier_mat
              zero_less_power)
        also have " = (SWAP  (1m (2^(Suc n)))) *
                        (( |state_basis 1 ((j div 2) div 2^Suc n) 
                           |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2)) 
                           |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2))"
          using tensor_mat_is_assoc by simp
        also have " = (SWAP * ( |state_basis 1 ((j div 2) div 2^Suc n) 
                                  |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2))) 
                        ((1m (2^(Suc n))) * |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2))"
          using mult_distr_tensor 
          by (smt (verit, del_insts) One_nat_def SWAP_ncols SWAP_nrows SWAP_tensor carrier_matD(2) 
              dim_col_tensor_mat dim_row_mat(1) dim_row_tensor_mat index_mult_mat(2) 
              index_one_mat(3) index_unit_vec(3) ket_vec_def lessI one_power2 pos2 power_Suc2 
              power_one_right state_basis_carrier_mat state_basis_def zero_less_power)
        also have " = ( |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2) 
                          |state_basis 1 ((j div 2) div 2^Suc n)) 
                          |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2)"
          using SWAP_tensor
          by (metis left_mult_one_mat power_one_right state_basis_carrier_mat)
        also have " = |state_basis 1 ((j mod 2^Suc (Suc n)) mod 2) 
                      ( |state_basis 1 ((j div 2) div 2^Suc n) 
                        |state_basis (Suc n) ((j mod 2^Suc (Suc n)) div 2))"
          using tensor_mat_is_assoc by simp
        also have " = |state_basis 1 (j mod 2) 
                      ( |state_basis 1 ((j div 2) div 2^Suc n) 
                        |state_basis (Suc n) ((j div 2) mod 2^Suc n))" 
        proof -
          have f1: "n na. (n::nat) ^ (1 + na) = n ^ Suc na"
            by simp
          have "n na. (n::nat) dvd n ^ Suc na"
            by simp
          then show ?thesis
            using f1 by (smt (z3) div_exp_mod_exp_eq mod_mod_cancel power_one_right)
        qed
        also have " = |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)"
          using state_basis_dec jl
          by (metis less_mult_imp_div_less power_Suc2)
        finally show ?thesis by this
      qed
    qed
  qed
qed



lemma SWAP_down_action:
  "j. j < 2 ^Suc (Suc n)  
    SWAP_down (Suc (Suc n)) * ( |state_basis 1 (j mod 2)  |state_basis (Suc n) (j div 2)) =
    |state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2)"
proof (induct n)
  case 0
  show ?case
  proof
    fix j::nat
    show "j < 2 ^ Suc (Suc 0) 
         SWAP_down (Suc (Suc 0)) * ( |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2)) =
         |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2)"
    proof
      assume "j < 2 ^ Suc (Suc 0)"
      show "SWAP_down (Suc (Suc 0))*( |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2))
         = |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2)"
      proof -
        have "SWAP_down (Suc (Suc 0))*( |state_basis 1 (j mod 2)|state_basis (Suc 0) (j div 2))
            = SWAP * ( |state_basis 1 (j mod 2)  |state_basis (Suc 0) (j div 2))" 
          using SWAP_down.simps by simp
        also have " = |state_basis (Suc 0) (j div 2)  |state_basis 1 (j mod 2)"
          using SWAP_tensor state_basis_carrier_mat 
          by (metis One_nat_def power_one_right)
        finally show ?thesis by this
      qed
    qed
  qed
next
  case (Suc n)
  assume HI:"j<2 ^ Suc (Suc n).
            SWAP_down (Suc (Suc n))*( |state_basis 1 (j mod 2)  |state_basis (Suc n) (j div 2))
          = |state_basis (Suc n) (j div 2)  |state_basis 1 (j mod 2)"
  show "j<2 ^ Suc (Suc (Suc n)).
            SWAP_down (Suc (Suc (Suc n)))*( |state_basis 1 (j mod 2)  
            |state_basis (Suc (Suc n)) (j div 2))
          = |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2)"
  proof
    fix j::nat
    show "j < 2 ^ Suc (Suc (Suc n)) 
         SWAP_down (Suc (Suc (Suc n))) * ( |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n))
            (j div 2)) =
         |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2)"
    proof
      assume jl:"j < 2 ^ Suc (Suc (Suc n))"
      show "SWAP_down (Suc (Suc (Suc n))) * ( |state_basis 1 (j mod 2)  
            |state_basis (Suc (Suc n)) (j div 2)) =
            |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2)"
      proof -
        define x where "x = 2*((j div 2) div 2) + (j mod 2)"
        have xl:"x < 2^Suc (Suc n)"
        proof -
          have "j mod 2 < 2" by auto
          moreover have 0:"(j div 2) div 2 < 2^Suc n" using jl by auto
          moreover have "2*((j div 2) div 2) < 2^Suc (Suc n)" using 0 by auto
          ultimately show ?thesis using x_def
            by (metis (no_types, lifting) Suc_double_not_eq_double add.right_neutral add_Suc_right 
                less_2_cases_iff linorder_neqE_nat not_less_eq power_Suc)
        qed
        have xm:"x mod 2 = j mod 2" using x_def by auto
        have xd:"x div 2 = j div 2 div 2" using x_def by auto
        have "SWAP_down (Suc (Suc (Suc n))) * ( |state_basis 1 (j mod 2)  
              |state_basis (Suc (Suc n)) (j div 2)) =
              (((1m (2^(Suc n)))  SWAP) * ((SWAP_down (Suc (Suc n)))  (1m 2))) *
            ( |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2))"
          using SWAP_down.simps by simp
        also have " = ((1m (2^(Suc n)))  SWAP) * (((SWAP_down (Suc (Suc n)))  (1m 2)) *
                        ( |state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)))"
        proof (rule assoc_mult_mat)
          show "1m (2 ^ Suc n)  SWAP  carrier_mat (2^Suc (Suc (Suc n))) (2^Suc (Suc (Suc n)))"
            by (simp add: SWAP_ncols SWAP_nrows carrier_matI)
          show "SWAP_down (Suc (Suc n))  1m 2
                 carrier_mat (2 ^ Suc (Suc (Suc n))) (2 ^ Suc (Suc (Suc n)))"
            by (metis One_nat_def SWAP_down.simps(2) SWAP_down_carrier_mat power_Suc2
                power_one_right tensor_carrier_mat)
          show "|state_basis 1 (j mod 2)  |state_basis (Suc (Suc n)) (j div 2)
                 carrier_mat (2 ^ Suc (Suc (Suc n))) 1"
            by (metis Suc_1 one_power2 power_Suc power_one_right state_basis_carrier_mat 
                tensor_carrier_mat)
        qed
        also have " = ((1m (2^(Suc n)))  SWAP) * (((SWAP_down (Suc (Suc n)))  (1m 2)) *
                        ( |state_basis 1 (j mod 2)  
                        ( |state_basis (Suc n) ((j div 2) div 2) 
                          |state_basis 1 ((j div 2) mod 2))))"
          using state_basis_dec' jl 
          by (metis less_mult_imp_div_less power_Suc2)
        also have " = ((1m (2^(Suc n)))  SWAP) * (((SWAP_down (Suc (Suc n)))  (1m 2)) *
                        (( |state_basis 1 (j mod 2)  
                          |state_basis (Suc n) ((j div 2) div 2)) 
                          |state_basis 1 ((j div 2) mod 2)))"
          using tensor_mat_is_assoc by simp
        also have " = ((1m (2^(Suc n)))  SWAP) * 
                        (((SWAP_down (Suc (Suc n))) * ( |state_basis 1 (j mod 2)  
                          |state_basis (Suc n) ((j div 2) div 2))) 
                        ((1m 2) * |state_basis 1 ((j div 2) mod 2)))"
          using mult_distr_tensor
          by (smt (verit, ccfv_threshold) SWAP_down_carrier_mat carrier_matD(1) carrier_matD(2)
              dim_col_tensor_mat dim_row_tensor_mat index_one_mat(3) mult.right_neutral 
              nat_zero_less_power_iff pos2 power_Suc2 power_commutes power_one_right 
              state_basis_carrier_mat zero_less_one_class.zero_less_one)
        also have " = ((1m (2^(Suc n)))  SWAP) * 
                        (((SWAP_down (Suc (Suc n))) * ( |state_basis 1 (x mod 2)  
                          |state_basis (Suc n) (x div 2))) 
                        ((1m 2) * |state_basis 1 ((j div 2) mod 2)))"
          using xm xd by simp
        also have " = ((1m (2^(Suc n)))  SWAP) *
                        (( |state_basis (Suc n) (x div 2)  |state_basis 1 (x mod 2)) 
                           |state_basis 1 ((j div 2) mod 2))"
          using HI
          by (metis dim_row_mat(1) index_unit_vec(3) ket_vec_def left_mult_one_mat' power_one_right 
              state_basis_def xl)
        also have " = ((1m (2^(Suc n)))  SWAP) *
                        ( |state_basis (Suc n) (x div 2)  ( |state_basis 1 (x mod 2) 
                           |state_basis 1 ((j div 2) mod 2)))"
          using tensor_mat_is_assoc by force
        also have " = ((1m (2^(Suc n))) * |state_basis (Suc n) (x div 2)) 
                        (SWAP * ( |state_basis 1 (x mod 2)  |state_basis 1 ((j div 2) mod 2)))"
          using mult_distr_tensor state_basis_carrier_mat SWAP_carrier_mat
          by (smt (verit, del_insts) SWAP_tensor carrier_matD(1) carrier_matD(2) dim_col_tensor_mat
              index_mult_mat(2) index_one_mat(3) nat_0_less_mult_iff power_one_right 
              tensor_mat_is_assoc zero_less_numeral zero_less_one_class.zero_less_one 
              zero_less_power) 
        also have " = |state_basis (Suc n) (x div 2) 
                      ( |state_basis 1 ((j div 2) mod 2)  |state_basis 1 (x mod 2))"
          using SWAP_tensor
          by (metis left_mult_one_mat power_one_right state_basis_carrier_mat)
        also have " = ( |state_basis (Suc n) (x div 2)  |state_basis 1 ((j div 2) mod 2)) 
                          |state_basis 1 (x mod 2)"
          using assoc_mult_mat tensor_mat_is_assoc by presburger
        also have " = |state_basis (Suc (Suc n)) (j div 2)  |state_basis 1 (j mod 2)"
          using state_basis_dec' xd xm
          by (metis jl less_mult_imp_div_less power_Suc2)
        finally show ?thesis by this
      qed
    qed
  qed
qed


text ‹Action of the controlled-R gates in the circuit›

lemma controlR_action:
  assumes "j < 2 ^ Suc (Suc n)"
  shows "(control (Suc (Suc n)) (R (Suc (Suc n)))) *
         (( |zero + exp (2*𝗂*pi*complex_of_nat (j div 2) / 2^(Suc n)) m |one) 
          |state_basis n ((j mod 2^(Suc n)) div 2)  |state_basis 1 (j mod 2)) =
          ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc (Suc n))) m |one) 
          |state_basis n ((j mod 2^(Suc n)) div 2)  |state_basis 1 (j mod 2)"
proof (cases n)
  case 0
  then show ?thesis
  proof -
    assume n0:"n = 0"
    show "control (Suc (Suc n)) (R (Suc (Suc n))) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n)
          m |Deutsch.one  |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2)) =
          |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc (Suc n)) m
          |Deutsch.one  |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2)"
    proof -
      have "control (Suc (Suc 0)) (R (Suc (Suc 0))) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |state_basis 0 (j mod 2 ^ Suc 0 div 2)  |state_basis 1 (j mod 2)) =
          control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |state_basis 0 (j mod 2 ^ Suc 0 div 2)  |state_basis 1 (j mod 2))"
        using control.simps by (metis One_nat_def Suc_1)
      also have " = control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |state_basis 1 (j mod 2))"
        using state_basis_def unit_vec_def ket_vec_def
        by (smt (verit, del_insts) H_inv H_is_gate One_nat_def gate_def index_mult_mat(2) 
            index_one_mat(2) mod_less_divisor mod_mod_trivial pos2 state_basis_dec' 
            tensor_mat_is_assoc)
      also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc (Suc 0))) m |one) 
                      |state_basis 1 (j mod 2)"
      proof (rule disjE)
        show "j mod 2 = 0  j mod 2 = 1" by auto
      next
        assume jm0:"j mod 2 = 0"
        hence jdj:"j div 2 = j/2" by auto
        have "control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |state_basis 1 (j mod 2)) =
          control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |zero)"
          using jm0 state_basis_def mat_of_cols_list_def by fastforce
        also have " = |Deutsch.zero + exp (2*𝗂*pi* complex_of_nat (j div 2) / 2 ^ Suc 0)
                        m |Deutsch.one  |zero"
          using control2_zero by (simp add: ket_vec_def)
        also have " = |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi *
                        complex_of_nat j / 2 ^ Suc (Suc 0)) m |Deutsch.one 
                        |state_basis 1 (j mod 2)" 
          using jm0 state_basis_def mat_of_cols_list_def jdj 
          by (smt (verit, best) Euclidean_Rings.div_eq_0_iff One_nat_def Suc_1 assms 
              divide_divide_eq_left divide_eq_0_iff less_2_cases_iff less_power_add_imp_div_less n0
              neq_imp_neq_div_or_mod of_nat_0 of_nat_1 of_nat_Suc of_nat_numeral of_real_1 
              of_real_divide of_real_numeral power_Suc power_one_right times_divide_eq_right 
              two_div_two two_mod_two)
        finally show ?thesis by this
      next
        assume jm1:"j mod 2 = 1"
        have "control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |state_basis 1 (j mod 2)) =
          control2 (R 2) *
          ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
          m |Deutsch.one  |one)"
          using jm1 by (simp add: state_basis_def)
        also have " = ((R 2) * 
           ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc 0)
            m |Deutsch.one))  |one"
          using control2_one ket_vec_def R_def mat_of_cols_list_def by simp
        also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j/2^Suc (Suc 0)) m |one)  |one"
          using R_action jm1 assms by (metis One_nat_def Suc_1 n0)
        finally show ?thesis by (metis jm1 power_one_right state_basis_def)
      qed
      finally show ?thesis
        by (smt (verit, best) Euclidean_Rings.div_eq_0_iff Suc_1 mod_less_divisor n0 
            not_mod2_eq_Suc_0_eq_0 one_mod_two_eq_one pos2 power_0 power_one_right state_basis_dec' 
            tensor_mat_is_assoc)
    qed
  qed
next
  case (Suc nat)
  then show ?thesis
  proof -
    assume "n = Suc nat"
    define jd2 where "jd2 = j div 2"
    define jm2 where "jm2 = j mod 2"
    define jm2sn where "jm2sn = j mod 2^Suc n"
    have jeq:"jm2sn mod 2 = j mod 2" using jm2sn_def 
      by (metis One_nat_def Suc_le_mono mod_mod_power_cancel power_one_right zero_order(1))
    have "(control (Suc (Suc n)) (R (Suc (Suc n)))) * ( |Deutsch.zero + 
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |Deutsch.one 
          |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2)) = 
          (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n))) * 
          ((1m 2)  SWAP_up (Suc n))) * ( |Deutsch.zero + 
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |Deutsch.one 
          |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2))"
      using control.simps Suc by presburger
    also have " = (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n)))) * 
          (((1m 2)  SWAP_up (Suc n)) * ( |Deutsch.zero + 
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |Deutsch.one 
          |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2)))"
    proof (rule assoc_mult_mat)
      show "(1m 2  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  1m (2 ^ n))
             carrier_mat (2^Suc (Suc n)) (2^Suc (Suc n))"
        using SWAP_down_carrier_mat SWAP_up_carrier_mat control2_carrier_mat 
        by (smt (verit) Suc carrier_matD(1) carrier_matD(2) carrier_matI control.simps(4) 
            control_carrier_mat dim_col_tensor_mat index_mult_mat(2) index_mult_mat(3) 
            index_one_mat(3) mult_numeral_left_semiring_numeral num_double power_Suc)
      show "1m 2  SWAP_up (Suc n)  carrier_mat (2 ^ Suc (Suc n)) (2 ^ Suc (Suc n))"
        using SWAP_up_carrier_mat
        by (metis One_nat_def SWAP_up.simps(2) power_Suc power_one_right tensor_carrier_mat)
      show "|Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi *  complex_of_nat (j div 2) /
            2 ^ Suc n) m |Deutsch.one  |state_basis n (j mod 2 ^ Suc n div 2) 
            |state_basis 1 (j mod 2)  carrier_mat (2 ^ Suc (Suc n)) 1"
        using ket_vec_def state_basis_carrier_mat
        by (simp add: carrier_matI state_basis_def)
    qed
    also have " = (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n)))) * 
          (((1m 2)  SWAP_up (Suc n)) * ( |Deutsch.zero + 
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |Deutsch.one 
          ( |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2))))"
      using tensor_mat_is_assoc by presburger
    also have " = (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n)))) *
          (((1m 2) * ( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m 
            |Deutsch.one))  ((SWAP_up (Suc n)) * ( |state_basis n (j mod 2 ^ Suc n div 2)  
            |state_basis 1 (j mod 2))))"
      using mult_distr_tensor
      by (smt (verit, del_insts) SWAP_up_carrier_mat carrier_matD(2) dim_col_mat(1) 
          dim_col_tensor_mat dim_row_mat(1) dim_row_tensor_mat index_add_mat(2) index_add_mat(3) 
          index_one_mat(3) index_smult_mat(2) index_smult_mat(3) index_unit_vec(3) ket_vec_def 
          one_power2 pos2 power_Suc2 power_one_right state_basis_def 
          zero_less_one_class.zero_less_one zero_less_power)   
    also have " = (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n)))) *
          (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m 
            |one)  ( |state_basis 1 (j mod 2)  |state_basis n (j mod 2 ^ Suc n div 2)))"
      using SWAP_up_action jeq 
      by (smt (verit, best) Suc index_add_mat(2) index_smult_mat(2) jm2sn_def ket_one_is_state 
          left_mult_one_mat' mod_less_divisor pos2 power_one_right state.dim_row zero_less_power)
    also have " = (((1m 2)  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n)))  (1m (2^n)))) *
          ((( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m 
            |one)   |state_basis 1 (j mod 2))  |state_basis n (j mod 2 ^ Suc n div 2))"
      using tensor_mat_is_assoc by presburger
    also have " = ((1m 2)  SWAP_down (Suc n)) * (((control2 (R (Suc (Suc n)))  (1m (2^n)))) *
          ((( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m 
            |one)   |state_basis 1 (j mod 2))  |state_basis n (j mod 2 ^ Suc n div 2)))"
    proof (rule assoc_mult_mat)
      show "1m 2  SWAP_down (Suc n)  carrier_mat (2^Suc (Suc n)) (2^Suc (Suc n))"
        using SWAP_down_carrier_mat 
        by (metis One_nat_def SWAP_down.simps(2) power_Suc power_one_right tensor_carrier_mat)
      show "control2 (R (Suc (Suc n)))  1m (2 ^ n)  carrier_mat (2^Suc (Suc n)) (2^Suc (Suc n))"
        using control2_carrier_mat by simp
      show "|Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n)
             m |Deutsch.one  |state_basis 1 (j mod 2)  |state_basis n (j mod 2 ^ Suc n div 2)
             carrier_mat (2 ^ Suc (Suc n)) 1"
        using state_basis_carrier_mat ket_vec_def
        by (simp add: carrier_matI state_basis_def)
    qed
    also have " = ((1m 2)  SWAP_down (Suc n)) * (((control2 (R (Suc (Suc n)))) *
              (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
             |state_basis 1 (j mod 2)))  ((1m (2^n)) * |state_basis n (j mod 2 ^ Suc n div 2)))"
      using mult_distr_tensor 
      by (smt (verit, del_insts) SWAP_nrows SWAP_tensor carrier_matD(1) carrier_matD(2) 
          carrier_matI control2_carrier_mat dim_col_tensor_mat index_add_mat(2) index_add_mat(3) 
          index_mult_mat(2) index_one_mat(3) index_smult_mat(2) index_smult_mat(3) ket_one_is_state
          less_numeral_extra(1) one_power2 power_Suc2 power_one_right state_basis_carrier_mat
          state_def zero_less_numeral zero_less_power)
    also have " = ((1m 2)  SWAP_down (Suc n)) * 
               (( |zero + exp (2 * 𝗂 * pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |one) 
               |state_basis 1 (j mod 2)  ((1m (2^n)) * |state_basis n (j mod 2 ^ Suc n div 2)))"
    proof (rule disjE)
      show "j mod 2 = 0  j mod 2 = 1" by auto
    next
      assume jm0:"j mod 2 = 0"
      hence jid:"j / 2 = j div 2" by auto
      have "(control2 (R (Suc (Suc n)))) *
              (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
               |state_basis 1 (j mod 2)) = 
            (control2 (R (Suc (Suc n)))) *
              (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
               |zero)"
        using state_basis_def jm0 by fastforce
      also have " = (( |zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
               |zero)"
        using control2_zero by (simp add: ket_vec_def)
      also have " = ( |zero + exp (2 * 𝗂 * pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |one) 
                        |zero"
        using jid 
        by (smt (verit, del_insts) dbl_simps(3) dbl_simps(5) divide_divide_eq_left numerals(1) 
            of_nat_1 of_nat_numeral of_real_divide of_real_of_nat_eq power_Suc
            times_divide_eq_right)
      finally show "(1m 2  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n))) * ( |Deutsch.zero +
                    exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m
                    |Deutsch.one  |state_basis 1 (j mod 2))  1m (2 ^ n) *
                    |state_basis n (j mod 2 ^ Suc n div 2)) = (1m 2  SWAP_down (Suc n)) *
                  ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j /
                    2 ^ Suc (Suc n)) m |Deutsch.one  |state_basis 1 (j mod 2)  1m (2 ^ n) *
                    |state_basis n (j mod 2 ^ Suc n div 2))" 
        by (metis jm0 power_one_right state_basis_def)
    next
      assume jm1:"j mod 2 = 1"
      have "(control2 (R (Suc (Suc n)))) *
              (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
               |state_basis 1 (j mod 2)) = 
            (control2 (R (Suc (Suc n)))) *
              (( |Deutsch.zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one)
               |one)"
        using jm1 state_basis_def by fastforce
      also have " = ((R (Suc (Suc n))) * 
                      ( |zero + exp (2 * 𝗂 * pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |one))
                       |one"
        using control2_one by (simp add: ket_vec_def R_def mat_of_cols_list_def)
      also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^(Suc (Suc n))) m |one)  |one"
        using R_action
        by (metis assms jm1)
      finally show "(1m 2  SWAP_down (Suc n)) * (control2 (R (Suc (Suc n))) * ( |Deutsch.zero +
                    exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m
                    |Deutsch.one  |state_basis 1 (j mod 2))  1m (2 ^ n) *
                    |state_basis n (j mod 2 ^ Suc n div 2)) =
                    (1m 2  SWAP_down (Suc n)) * ( |Deutsch.zero + exp (2 * 𝗂 * 
                    complex_of_real pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |Deutsch.one 
                 |state_basis 1 (j mod 2)  1m (2 ^ n) * |state_basis n (j mod 2 ^ Suc n div 2))" 
        by (metis jm1 power_one_right state_basis_def)
    qed
    also have " = ((1m 2)  SWAP_down (Suc n)) * 
                    (( |zero + exp (2 * 𝗂 * pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |one) 
                  ( |state_basis 1 (j mod 2)  ((1m (2^n)) * 
                    |state_basis n (j mod 2 ^ Suc n div 2))))"
      using tensor_mat_is_assoc ket_vec_def by auto
    also have " = ( |zero + exp (2 * 𝗂 * pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |one) 
                    ((SWAP_down (Suc n)) * ( |state_basis 1 (j mod 2)  ((1m (2^n)) * 
                    |state_basis n (j mod 2 ^ Suc n div 2))))"
      using mult_distr_tensor
      by (smt (verit, del_insts) SWAP_down_carrier_mat carrier_matD(1) carrier_matD(2) 
          dim_col_tensor_mat dim_row_tensor_mat index_add_mat(2) index_add_mat(3) index_one_mat(3)
          index_smult_mat(2) index_smult_mat(3) ket_one_is_state left_mult_one_mat' one_power2 pos2
          power.simps(2) power_one_right state_basis_carrier_mat state_def 
          zero_less_one_class.zero_less_one zero_less_power)
    also have " = ( |zero + exp (2 * 𝗂 * pi * complex_of_nat j / 2 ^ Suc (Suc n)) m |one) 
                    ( |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2))"
      using SWAP_down_action jeq 
      by (metis Suc dim_row_mat(1) index_unit_vec(3) jm2sn_def ket_vec_def left_mult_one_mat' 
          mod_less_divisor pos2 state_basis_def zero_less_power)
    finally show "control (Suc (Suc n)) (R (Suc (Suc n))) * ( |Deutsch.zero + exp (2 * 𝗂 *
                  complex_of_real pi * complex_of_nat (j div 2) / 2 ^ Suc n) m |Deutsch.one 
                  |state_basis n (j mod 2 ^ Suc n div 2)  |state_basis 1 (j mod 2)) =
                  |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j /
                  2 ^ Suc (Suc n)) m |Deutsch.one  |state_basis n (j mod 2 ^ Suc n div 2) 
                  |state_basis 1 (j mod 2)"
      using tensor_mat_is_assoc ket_vec_def by auto
  qed
qed


text ‹Action of the controlled rotations subcircuit›

lemma controlled_rotations_ind:
  "j. j < 2 ^ Suc n  
  controlled_rotations (Suc n) * 
  (( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  |state_basis n (j mod 2^n)) =
  ( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)  |state_basis n (j mod 2^n)" 
proof (induct n)
  case 0
  then show ?case
  proof (rule allI)
    fix j::nat
    show "j < 2 ^ Suc 0 
         controlled_rotations (Suc 0) * ( |zero +
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ 0) / 2) m |one 
          |state_basis 0 (j mod 2 ^ 0)) =
         |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc 0) m |one 
         |state_basis 0 (j mod 2 ^ 0)"
    proof
      assume "j < 2 ^ Suc 0"
      hence j2:"j < 2" by auto
      have "controlled_rotations (Suc 0) * ( |zero +
            exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ 0) / 2) m |one 
            |state_basis 0 (j mod 2 ^ 0)) = 
            (1m 2)  * ( |zero +
            exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ 0) / 2) m |one 
            |state_basis 0 (j mod 2 ^ 0))"
        using controlled_rotations.simps by simp
      also have " = |zero +
                      exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ 0) / 2) m |one 
                      |state_basis 0 (j mod 2 ^ 0)"
        using left_mult_one_mat by (simp add: ket_vec_def state_basis_def)
      also have " = |zero +
                      exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2^Suc 0) m |one 
                      |state_basis 0 (j mod 2 ^ 0)"
        by auto
      finally show "controlled_rotations (Suc 0) * ( |zero +
                    exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ 0) / 2) m |one 
                    |state_basis 0 (j mod 2 ^ 0)) =
                    |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc 0) m |one
                     |state_basis 0 (j mod 2 ^ 0)"
        by this
    qed
  qed
next
  case (Suc n')
  define n where "n = Suc n'"
  assume HI:" j<2 ^ Suc n'. controlled_rotations (Suc n') * ( |zero +
             exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ n') / 2) m |one 
             |state_basis n' (j mod 2 ^ n')) =
            |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc n') m
            |Deutsch.one  |state_basis n' (j mod 2 ^ n')"
  show "j<2 ^ Suc (Suc n').
            controlled_rotations (Suc (Suc n')) *
            ( |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * 
              complex_of_nat (j div 2 ^ Suc n') / 2) m |Deutsch.one 
             |state_basis (Suc n') (j mod 2 ^ Suc n')) =
            |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * 
            complex_of_nat j / 2 ^ Suc (Suc n')) m |Deutsch.one 
            |state_basis (Suc n') (j mod 2 ^ Suc n')"
  proof (rule allI)
    fix j::nat
    show "j < 2 ^ Suc (Suc n') 
         controlled_rotations (Suc (Suc n')) * ( |Deutsch.zero +
          exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ Suc n') / 2) m
          |Deutsch.one  |state_basis (Suc n') (j mod 2 ^ Suc n')) =
         |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc (Suc n')) m
         |Deutsch.one  |state_basis (Suc n') (j mod 2 ^ Suc n')"
    proof 
      assume jass:"j < 2 ^ Suc (Suc n')"
      show "controlled_rotations (Suc (Suc n')) * ( |Deutsch.zero +
            exp (2 * 𝗂 * complex_of_real pi * complex_of_nat (j div 2 ^ Suc n') / 2) m
            |Deutsch.one  |state_basis (Suc n') (j mod 2 ^ Suc n')) =
            |Deutsch.zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ Suc (Suc n'))m
            |Deutsch.one  |state_basis (Suc n') (j mod 2 ^ Suc n')"
      proof -
        define jd2n jm2n where "jd2n = j div 2^n" and "jm2n = j mod 2^n"
        define jlast where "jlast = jm2n mod 2"
        define jmm where "jmm = jm2n div 2"
        define jd2 where "jd2 = j div 2"
        have jlastj:"jlast = j mod 2" using jlast_def jm2n_def 
          by (metis less_Suc_eq_0_disj less_Suc_eq_le mod_mod_power_cancel n_def power_Suc0_right)
        have "controlled_rotations (Suc n) * ( |Deutsch.zero +
            exp (2 * 𝗂 * complex_of_real pi * complex_of_nat jd2n / 2) m
            |Deutsch.one  |state_basis n jm2n) = 
            ((control (Suc n) (R (Suc n))) * ((controlled_rotations n)  (1m 2))) * ( |zero +
            exp (2 * 𝗂 * complex_of_real pi * complex_of_nat jd2n / 2) m
            |Deutsch.one  |state_basis n jm2n)"
          using controlled_rotations.simps n_def by simp
        also have " = ((control (Suc n) (R (Suc n))) * ((controlled_rotations n)  (1m 2))) * 
            ( |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat jd2n / 2) m  |one  
            ( |state_basis n' jmm  |state_basis 1 jlast))"
          using state_basis_dec' jass n_def jlast_def jmm_def jm2n_def mod_less_divisor pos2
          by presburger
        also have " = (control (Suc n) (R (Suc n))) * ((((controlled_rotations n)  (1m 2))) * 
            ( |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat jd2n / 2) m  |one  
            ( |state_basis n' jmm  |state_basis 1 jlast)))"
        proof (rule assoc_mult_mat)
          show "control (Suc n) (R (Suc n))  carrier_mat (2^(Suc n)) (2^(Suc n))"
            using control_carrier_mat n_def by blast
          show "controlled_rotations n  1m 2  carrier_mat (2 ^ Suc n) (2 ^ Suc n)"
            using controlled_rotations_carrier_mat n_def
            by (metis One_nat_def controlled_rotations.simps(2) power_Suc2 power_one_right 
                tensor_carrier_mat)
          show "|zero + exp (2*𝗂*pi*complex_of_nat jd2n /2) m |one  ( |state_basis n' jmm 
                |state_basis 1 jlast)  carrier_mat (2 ^ Suc n) 1"
            using state_basis_carrier_mat ket_vec_def 
            by (simp add: carrier_matI n_def state_basis_def)
        qed
        also have " = (control (Suc n) (R (Suc n))) * ((((controlled_rotations n)  (1m 2))) * 
            (( |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat jd2n / 2) m  |one  
             |state_basis n' jmm)  |state_basis 1 jlast))"
          using tensor_mat_is_assoc control_carrier_mat n_def controlled_rotations_carrier_mat
            state_basis_carrier_mat ket_vec_def by simp
        also have " = (control (Suc n) (R (Suc n))) * (((controlled_rotations n) *
                        (( |zero + exp (2 * 𝗂 * pi * complex_of_nat jd2n / 2) m  |one) 
                        |state_basis n' jmm))  ((1m 2) * |state_basis 1 jlast))"
          using mult_distr_tensor control_carrier_mat n_def controlled_rotations_carrier_mat
            state_basis_carrier_mat ket_vec_def 
          by (smt (verit) carrier_matD(1) carrier_matD(2) dim_col_tensor_mat dim_row_tensor_mat
              index_add_mat(2) index_add_mat(3) index_one_mat(3) index_smult_mat(2) 
              index_smult_mat(3) ket_one_is_state one_power2 pos2 power_Suc power_one_right 
              state_def zero_less_one_class.zero_less_one zero_less_power)
        also have " = (control (Suc n) (R (Suc n))) * 
                        (( |zero + exp (2*𝗂*pi*complex_of_nat jd2 / 2^n) m
                        |one  |state_basis n' (jd2 mod 2 ^ n'))  
                        ((1m 2) * |state_basis 1 jlast))"
          using HI jd2_def n_def
          by (smt (verit, del_insts) Suc_eq_plus1 div_exp_eq div_exp_mod_exp_eq jass jd2n_def 
              jm2n_def jmm_def less_power_add_imp_div_less plus_1_eq_Suc power_one_right)
        also have " = (control (Suc n) (R (Suc n))) * 
                        (( |zero + exp (2*𝗂*pi*complex_of_nat jd2 / 2^n) m
                        |one  |state_basis n' jmm)  
                        |state_basis 1 jlast)"
          using jmm_def jd2_def 
          by (metis div_exp_mod_exp_eq jm2n_def left_mult_one_mat n_def plus_1_eq_Suc
              power_one_right state_basis_carrier_mat)
        also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) 
                        |state_basis n' jmm  |state_basis 1 jlast"
          using controlR_action jmm_def jlast_def jd2_def n_def jm2n_def jass jlastj by presburger
        also have " = ( |zero + exp (2*𝗂*pi*complex_of_nat j / 2^Suc n) m |one) 
                        |state_basis n jm2n"
          using state_basis_dec' jm2n_def jmm_def jlast_def
          by (metis mod_less_divisor n_def pos2 tensor_mat_is_assoc zero_less_power)
        finally show ?thesis using jm2n_def n_def jd2n_def by meson
      qed
    qed
  qed
qed


lemma controlled_rotations_on_first_qubit:
  assumes "j < 2 ^ Suc n"
  shows "controlled_rotations (Suc n) *
        (1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  
        |state_basis n (j mod 2^n)) =
        (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))  |state_basis n (j mod 2^n))"
proof -
  have "controlled_rotations (Suc n) *
        (1/sqrt 2 m ( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  
        |state_basis n (j mod 2^n)) = 
        controlled_rotations (Suc n) *
        (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  
        |state_basis n (j mod 2^n)))"
    using smult_mat_def tensor_mat_def 
    by (smt (verit) One_nat_def carrier_matD(2) index_add_mat(3) index_smult_mat(3) lessI power_one_right smult_tensor1 state_basis_carrier_mat state_basis_def)
  also have " = 1/sqrt 2 m (controlled_rotations (Suc n) * 
                  (( |zero + exp(2*𝗂*pi*(complex_of_nat (j div 2^n))/2) m |one)  
                  |state_basis n (j mod 2^n)))"
    using mult_smult_distrib controlled_rotations_carrier_mat state_basis_carrier_mat
    by (smt (verit) carrier_matI dim_row_mat(1) dim_row_tensor_mat index_add_mat(2) 
        index_smult_mat(2) index_unit_vec(3) ket_vec_def power_Suc state_basis_def)
  also have " = (1/sqrt 2 m 
                  (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))  |state_basis n (j mod 2^n))"
    using assms controlled_rotations_ind ket_vec_def by simp
  finally show ?thesis by this
qed


text ‹More useful lemmas:›

lemma exp_j:
  assumes "l < Suc n"
  shows "exp (2*𝗂*pi*j/(2^l)) = exp (2*𝗂*pi*(j mod 2^n)/(2^l))"
proof -
  define jd jm where "jd = j div 2^n" and "jm = j mod 2^n"
  have 0:"real (2^n)/(2^l) = (2^(n-l))"
  proof -
    have 1:"(2::nat)  0" by simp
    have 2:"l  n" using assms by simp
    show ?thesis
      using 1 2 power_diff
      by (metis numeral_power_eq_of_nat_cancel_iff zero_neq_numeral)
  qed
  have "j = jd*(2^n) + jm" using jd_def jm_def by presburger
  hence "exp (2*𝗂*pi*j/(2^l)) = exp (2*pi*𝗂*(jd*(2^n) + jm)/(2^l))"
    by (simp add: mult.commute mult.left_commute)
  also have " = exp (2*pi*𝗂*(jd*(2^n))/(2^l) + 2*𝗂*pi*jm/(2^l))"
    by (simp add: add_divide_distrib distrib_left mult.left_commute semigroup_mult_class.mult.assoc)
  also have " = exp (2*pi*𝗂*(jd*(2^n))/(2^l)) * exp (2*𝗂*pi*jm/(2^l))" using exp_add by blast
  also have " = exp (2*pi*𝗂*jd*((2^n)/(2^l))) * exp (2*𝗂*pi*jm/(2^l))"
    by (simp add: semigroup_mult_class.mult.assoc)
  also have " = exp (2*pi*𝗂*jd*((2^(n-l)))) * exp (2*𝗂*pi*jm/(2^l))" 
    using 0 by (smt (verit) dbl_simps(3) dbl_simps(5) numerals(1) of_nat_1 of_nat_numeral 
        of_nat_power of_real_divide of_real_of_nat_eq)
  also have " = exp ((2*pi*𝗂*jd)*(of_nat (2^(n-l)))) * exp (2*𝗂*pi*jm/(2^l))" by auto
  also have " = (exp (2*pi*𝗂))^(2^(n-l)) * exp (2*𝗂*pi*jm/(2^l))" 
    using exp_of_nat2_mult by (smt (verit, best) cis_2pi cis_conv_exp exp_power_int exp_zero 
        mult.commute mult_zero_right)
  also have " = 1^(2^(n-l)) * exp (2*𝗂*pi*jm/(2^l))" using exp_two_pi_i by auto
  also have " = exp (2*𝗂*pi*jm/(2^l))" by auto
  finally show ?thesis using jd_def jm_def by simp
qed



lemma kron_list_fun[simp]:
  "x. List.member xs x  f x = g x  kron f xs = kron g xs"
proof (induct xs)
  case Nil
  show "kron f [] = kron g []" by simp
next
  fix a xs
  assume HI:"(x. List.member xs x  f x = g x  kron f xs = kron g xs)"
  show "x. List.member (a # xs) x  f x = g x  kron f (a # xs) = kron g (a # xs)"
  proof -
    assume 1:"x. List.member (a # xs) x  f x = g x"
    show "kron f (a # xs) = kron g (a # xs)"
    proof -
      from 1 have "List.member (a # xs) a  f a = g a" by auto
      moreover have "List.member (a # xs) a" by (simp add: List.member_rec(1))
      ultimately have 2:"f a = g a" by auto
      have "kron f (a#xs) = f a  kron f xs" by simp
      also have " = g a  kron f xs" using 2 by simp
      also have " = g a  kron g xs" using HI 1 by (simp add: member_rec(1))
      also have " = kron g (a#xs)" using kron.simps(2) by simp
      finally show ?thesis by this
    qed
  qed
qed


lemma member_rev:
  shows "List.member (rev xs) x = List.member xs x"
proof (induct xs)
  show "List.member (rev []) x = List.member [] x" by simp
next
  case (Cons a xs)
  assume HI:"List.member (rev xs) x = List.member xs x"
  have "List.member (rev (a#xs)) x = List.member ((rev xs)@[a]) x" using rev_append by auto
  also have " = (x  set ((rev xs) @ [a]))" using List.member_def by metis
  also have " = (x  set (rev xs)  set [a])" using set_append by metis
  also have " = (x  set [a]  x  set (rev xs))" by blast
  also have " = (x = a  List.member (rev xs) x)" using List.member_def by fastforce
  also have " = (x = a  List.member xs x)" using HI by metis
  also have " = List.member (a#xs) x" using List.member_rec(1) by metis
  finally show "List.member (rev (a#xs)) x = List.member (a#xs) x" by this
qed


lemma kron_j:
  shows "kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) (map nat (rev [1..n])) =
         kron (λ(l::nat). |zero + exp (2*𝗂*pi*(complex_of_nat (j mod 2^n))/(2^l)) m |one) 
         (map nat (rev [1..n]))"
proof -
  define fj fjm where "fj = (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one)"
    and "fjm = (λ(l::nat). |zero + exp (2*𝗂*pi*(complex_of_nat (j mod 2^n))/(2^l)) m |one)" 
  have "x. ((List.member (map nat (rev [1..n])) x)  (x < Suc n))"
  proof (rule allI)
    fix x
    show "List.member (map nat (rev [1..int n])) x  x < Suc n"
    proof
      assume "List.member (map nat (rev [1..int n])) x"
      hence "List.member (rev (map nat [1..int n])) x" using rev_map by metis
      hence "List.member (map nat [1..int n]) x" using member_rev by metis
      hence "x  set (map nat [1..int n])" using List.member_def by metis
      hence "x  {1..n}" by auto
      thus "x < Suc n" by auto
    qed
  qed
  hence "x. ((List.member (map nat (rev [1..n])) x)  
             (exp (2*𝗂*pi*j/(2^x)) = exp (2*𝗂*pi*(j mod 2^n)/(2^x))))"
    using exp_j
    by (metis (mono_tags, lifting) of_int_of_nat_eq of_nat_numeral of_nat_power zmod_int)
  hence "x. ((List.member (map nat (rev [1..n])) x)  (fj x = fjm x))"
    using fj_def fjm_def by presburger
  hence "kron fj (map nat (rev [1..n])) = kron fjm (map nat (rev [1..n]))"
    by simp
  thus ?thesis using fj_def fjm_def by auto
qed


text ‹We proof that the QFT circuit is correct:›

theorem QFT_is_correct:
  shows "j. j < 2^n  (QFT n) * |state_basis n j = reverse_QFT_product_representation j n"
proof (induct n rule: QFT.induct)
  case 1
  thus ?case
  proof (rule allI)
    fix j::nat
    show "j < 2 ^ 0  QFT 0 * |state_basis 0 j = reverse_QFT_product_representation j 0"
    proof 
      assume "j < 2 ^ 0"
      hence j0:"j = 0" by auto
      have "QFT 0 * |state_basis 0 j = (1m 1) * |state_basis 0 j" using QFT.simps by simp
      also have " = |unit_vec 1 j" using state_basis_def
        by (metis left_mult_one_mat power_0 state_basis_carrier_mat)
      also have " = (1m 1)" using unit_vec_def unit_vec_carrier ket_vec_def j0 by auto
      also have " = reverse_QFT_product_representation j 0"
        using reverse_QFT_product_representation_def by auto
      finally show "QFT 0 * |state_basis 0 j = reverse_QFT_product_representation j 0" by this
    qed
  qed
next
  case 2
  thus ?case
  proof (rule allI)
    fix j::nat
    show "j < 2 ^ Suc 0 
         QFT (Suc 0) *
         |state_basis (Suc 0) j =
         reverse_QFT_product_representation j
          (Suc 0)"
    proof 
      assume a1:"j < 2^Suc 0"
      then show "QFT (Suc 0) * |state_basis (Suc 0) j = 
                 reverse_QFT_product_representation j (Suc 0)"
      proof -
        have "QFT (Suc 0) * |state_basis (Suc 0) j = H * |unit_vec (2^(Suc 0)) j"
          using QFT.simps(2) state_basis_def by auto
        also have " = reverse_QFT_product_representation j (Suc 0)"
        proof (rule disjE)
          show "j=0  j=1" using a1 by auto
        next
          assume j0:"j=0"
          hence "H * |unit_vec (2^(Suc 0)) j = H * |unit_vec (2^(Suc 0)) 0" by simp
          also have " = H * |zero" by auto
          also have " = mat_of_cols_list 2 [[1/sqrt(2),1/sqrt(2)]]"
            using H_on_ket_zero by simp
          also have " = 1/sqrt(2) m (mat_of_cols_list 2 [[1,1]])"
          proof 
            fix i j::nat
            define ψ1 ψ2 where "ψ1 = mat_of_cols_list 2 [[1/sqrt(2),1/sqrt(2)]]" and 
              "ψ2 = 1/sqrt(2) m (mat_of_cols_list 2 [[1,1]])"
            assume "i < dim_row ψ2" and "j < dim_col ψ2"
            hence a2:"i  {0,1}  j=0"
              by (simp add: Tensor.mat_of_cols_list_def ψ2_def less_Suc_eq_0_disj numerals(2))
            have "ψ1 $$ (0,0) = 1/sqrt 2" using mat_of_cols_list_def ψ1_def by simp
            moreover have "ψ1 $$ (1,0) = 1/sqrt 2" using mat_of_cols_list_def ψ1_def by simp
            moreover have "ψ2 $$ (0,0) = 1/sqrt 2" 
              using smult_mat_def mat_of_cols_list_def ψ2_def by simp
            moreover have "ψ2 $$ (1,0) = 1/sqrt 2" 
              using smult_mat_def mat_of_cols_list_def ψ2_def by simp
            ultimately show "ψ1 $$ (i,j) = ψ2 $$ (i,j)" using a2 by auto
          next
            define ψ1 ψ2 where "ψ1 = mat_of_cols_list 2 [[1/sqrt(2),1/sqrt(2)]]" and 
              "ψ2 = 1/sqrt(2) m (mat_of_cols_list 2 [[1,1]])"
            show "dim_row ψ1 = dim_row ψ2" using ψ1_def ψ2_def Tensor.mat_of_cols_list_def by simp
          next
            define ψ1 ψ2 where "ψ1 = mat_of_cols_list 2 [[1/sqrt(2),1/sqrt(2)]]" and 
              "ψ2 = 1/sqrt(2) m (mat_of_cols_list 2 [[1,1]])"
            show "dim_col ψ1 = dim_col ψ2" using ψ1_def ψ2_def Tensor.mat_of_cols_list_def by simp
          qed
          also have " = 1/sqrt 2 m ( |zero + |one)"
          proof -
            have "mat_of_cols_list 2 [[1,1]] = |zero + |one"
            proof 
              fix i j::nat 
              define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
              assume "i < dim_row s2" and "j < dim_col s2"
              hence "i  {0,1}  j = 0" using index_add_mat 
                by (simp add: ket_vec_def less_Suc_eq numerals(2) s2_def)
              thus "s1 $$ (i,j) = s2 $$ (i,j)" using s1_def s2_def mat_of_cols_list_def 
                  i < dim_row s2 ket_one_to_mat_of_cols_list by force
            next
              define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
              thus "dim_row s1 = dim_row s2" using mat_of_cols_list_def by (simp add: ket_vec_def)
            next
              define s1 s2 where "s1 = mat_of_cols_list 2 [[1,1]]" and "s2 = |zero + |one"
              thus "dim_col s1 = dim_col s2" using mat_of_cols_list_def by (simp add: ket_vec_def)
            qed
            thus ?thesis by simp
          qed
          also have " = 1/sqrt 2 m (kron (λ l. |zero + |one) [1])" using kron.simps by auto
          also have " = 1/sqrt 2 m (kron (λ l. |zero + exp (2*𝗂*pi*0/(2^l)) m |one) [1])"
            using exp_zero smult_mat_def by auto
          also have " = reverse_QFT_product_representation 0 (Suc 0)"
            using reverse_QFT_product_representation_def rev_def map_def by auto
          finally show "H * |unit_vec (2 ^ Suc 0) j = reverse_QFT_product_representation j (Suc 0)"
            using j0 by simp
        next
          assume j1:"j = 1"
          hence "H * |unit_vec (2 ^ Suc 0) j = H * |one" by simp
          also have " = mat_of_cols_list 2 [[1/sqrt(2), -1/sqrt(2)]]" using H_on_ket_one by simp
          also have " = 1/sqrt 2 m (mat_of_cols_list 2 [[1,-1]])"
          proof
            fix i j::nat
            define φ1 φ2 where "φ1 = mat_of_cols_list 2 [[1/sqrt(2), -1/sqrt(2)]]" and
              "φ2 = 1/sqrt 2 m (mat_of_cols_list 2 [[1,-1]])"
            assume "i < dim_row φ2" and "j < dim_col φ2"
            hence a3:"i  {0,1}  j = 0" 
              using φ2_def mat_of_cols_list_def numerals(2) less_2_cases by simp
            have "φ1 $$ (0,0) = φ2 $$ (0,0)"
              using φ1_def φ2_def smult_def mat_of_cols_list_def by simp
            moreover have "φ1 $$ (1,0) = φ2 $$ (1,0)"
              using φ1_def φ2_def smult_def mat_of_cols_list_def by simp
            ultimately show "φ1 $$ (i,j) = φ2 $$ (i,j)" using a3 by auto
          next
            define φ1 φ2 where "φ1 = mat_of_cols_list 2 [[1/sqrt(2), -1/sqrt(2)]]" and
              "φ2 = 1/sqrt 2 m (mat_of_cols_list 2 [[1,-1]])"
            then show "dim_row φ1 = dim_row φ2" using smult_def mat_of_cols_list_def by simp
          next
            define φ1 φ2 where "φ1 = mat_of_cols_list 2 [[1/sqrt(2), -1/sqrt(2)]]" and
              "φ2 = 1/sqrt 2 m (mat_of_cols_list 2 [[1,-1]])"
            then show "dim_col φ1 = dim_col φ2" using smult_def mat_of_cols_list_def by simp
          qed
          also have " = 1/sqrt 2 m ( |zero - |one)"
          proof -
            have "mat_of_cols_list 2 [[1,-1]] = |zero - |one"
            proof
              fix i j::nat
              define r1 r2 where "r1 = mat_of_cols_list 2 [[1,-1]]" and "r2 = |zero - |one"
              assume "i < dim_row r2" and "j < dim_col r2"
              hence a4:"i  {0,1}  j=0" 
                using ket_vec_def index_add_mat by (simp add: less_2_cases r2_def)
              have "r1 $$ (0,0) = r2 $$ (0,0)" using r1_def r2_def mat_of_cols_list_def
                by (smt (verit, ccfv_threshold) One_nat_def add.commute diff_zero dim_row_mat(1) 
                    index_mat(1) index_mat_of_cols_list ket_one_is_state ket_one_to_mat_of_cols_list 
                    ket_zero_to_mat_of_cols_list list.size(3) list.size(4) minus_mat_def nth_Cons_0 
                    plus_1_eq_Suc pos2 state_def zero_less_one_class.zero_less_one)
              moreover have "r1 $$ (1,0) = r2 $$ (1,0)" 
                using r1_def r2_def mat_of_cols_list_def ket_vec_def by simp
              ultimately show "r1 $$ (i,j) = r2 $$ (i,j)" using a4 by auto
            next
              define r1 r2 where "r1 = mat_of_cols_list 2 [[1,-1]]" and "r2 = |zero - |one"
              thus "dim_row r1 = dim_row r2" using mat_of_cols_list_def ket_vec_def by simp
            next
              define r1 r2 where "r1 = mat_of_cols_list 2 [[1,-1]]" and "r2 = |zero - |one"
              thus "dim_col r1 = dim_col r2" using mat_of_cols_list_def ket_vec_def by simp
            qed
            thus ?thesis by simp
          qed
          also have " = 1/sqrt 2 m (kron (λl. |zero - |one) [1])"
            using kron.simps by auto
          also have " = 1/sqrt 2 m (kron (λl. |zero + exp (2*𝗂*pi*1/(2^l)) m |one) [1])"
          proof -
            have "exp (2*𝗂*pi*1/(2^1)) = -1" using exp_pi_i by auto
            hence "|zero + exp (2*𝗂*pi*1/(2^1)) m |one = |zero + (-1) m |one" by simp
            also have " = |zero - |one" by auto
            thus ?thesis by auto
          qed
          also have " = reverse_QFT_product_representation 1 (Suc 0)" 
            using reverse_QFT_product_representation_def by auto
          finally show "H * |unit_vec (2 ^ Suc 0) j = reverse_QFT_product_representation j (Suc 0)"
            using j1 by simp
        qed
        finally show ?thesis by this
      qed
    qed
  qed
next
  case 3
  fix n'::nat
  define n where "n = Suc n'"
  assume HI:"j<2 ^ n. QFT n * |state_basis n j = reverse_QFT_product_representation j n"
  show "j<2^Suc n.
           QFT (Suc n) * |state_basis (Suc n) j = reverse_QFT_product_representation j (Suc n)"
  proof (rule allI)
    fix j::nat
    show "j < 2 ^ Suc n  QFT (Suc n) * |state_basis (Suc n) j =
                            reverse_QFT_product_representation j (Suc n)"
    proof 
      assume aj:"j < 2 ^ Suc n"
      show "QFT (Suc n) *
         |state_basis (Suc n) j =
         reverse_QFT_product_representation j
          (Suc n)"
      proof -
        define jd jm where "jd = j div 2^n" and "jm = j mod 2^n"
        hence "jm < 2^n" by auto
        hence HI_jm:"QFT n * |state_basis n jm = reverse_QFT_product_representation jm n" 
          using HI by auto
        have "(QFT (Suc n)) * |state_basis (Suc n) j = 
        (((1m 2)  (QFT n)) * (controlled_rotations (Suc n)) * (H  ((1m (2^n))))) * 
        |state_basis (Suc n) j"
          using QFT.simps(3) n_def by simp
        also have " = (((1m 2)  (QFT n)) * (controlled_rotations (Suc n))) * 
                        (((H  ((1m (2^n))))) * |state_basis (Suc n) j)"
        proof (rule assoc_mult_mat)
          show "(1m 2  QFT n) * controlled_rotations (Suc n)  carrier_mat (2^(Suc n)) (2^(Suc n))"
          proof (rule mult_carrier_mat)
            show "1m 2  QFT n  carrier_mat (2 ^ Suc n) (2 ^ Suc n)" by simp
            show "controlled_rotations (Suc n)  carrier_mat (2 ^ Suc n) (2 ^ Suc n)"
              using controlled_rotations_carrier_mat by blast
          qed
        next
          show "H  1m (2 ^ n)  carrier_mat (2 ^ Suc n) (2 ^ Suc n)"
            using tensor_carrier_mat 
            by (metis QFT.simps(2) QFT_carrier_mat one_carrier_mat power_Suc power_Suc0_right)
        next
          show "|state_basis (Suc n) j  carrier_mat (2 ^ Suc n) 1"
            using state_basis_carrier_mat by blast
        qed
        also have " = (((1m 2)  (QFT n)) * (controlled_rotations (Suc n))) *
                        ((1/sqrt 2 m ( |zero + exp(2*𝗂*pi*jd/2) m |one))  |state_basis n jm)"
          using aj H_on_first_qubit jd_def jm_def by simp
        also have " = ((1m 2)  (QFT n)) * (controlled_rotations (Suc n) *
                        (((1/sqrt 2 m ( |zero + exp(2*𝗂*pi*jd/2) m |one))  |state_basis n jm)))"
          using assoc_mult_mat tensor_carrier_mat QFT_carrier_mat one_carrier_mat 
            state_basis_carrier_mat
          by (smt (verit, ccfv_threshold) H_on_first_qubit QFT.simps(2) aj 
              controlled_rotations_carrier_mat jd_def jm_def mult_carrier_mat power_Suc 
              power_Suc0_right)
        also have " = ((1m 2)  (QFT n)) * 
                        (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))  
                        |state_basis n jm)"
          using controlled_rotations_on_first_qubit aj jd_def jm_def by simp
        also have " = ((1m 2) * (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)))) 
                        ((QFT n) * |state_basis n jm)"
        proof -
          have "dim_col (1m 2) = dim_row (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)))"
          proof -
            have "dim_col (1m 2) = 2" by simp
            moreover have "dim_row (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) = 2"
              using smult_carrier_mat mat_of_cols_list_def add_carrier_mat ket_vec_def by simp
            ultimately show ?thesis by simp
          qed
          moreover have "dim_col (QFT n) = dim_row |state_basis n jm"
            using state_basis_carrier_mat QFT_carrier_mat
            by (metis carrier_matD(1) carrier_matD(2))
          moreover have "dim_col (1m 2) > 0" by simp
          moreover have "dim_col (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) > 0"
            using smult_carrier_mat mat_of_cols_list_def add_carrier_mat ket_vec_def by simp
          moreover have "dim_col (QFT n) > 0" using QFT_carrier_mat
            by (metis carrier_matD(2) pos2 zero_less_power)
          moreover have "dim_col |state_basis n jm > 0" using state_basis_carrier_mat
            by (simp add: ket_vec_def)
          ultimately show "((1m 2)  (QFT n)) * 
                (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))  |state_basis n jm) =
                ((1m 2) * (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)))) 
                ((QFT n) * |state_basis n jm)" 
            using mult_distr_tensor by (smt (verit, best))
        qed
        also have " = (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) 
                        reverse_QFT_product_representation jm n"
          using ket_one_is_state state.dim_row HI_jm by auto
        also have " = reverse_QFT_product_representation j (Suc n)"
        proof -
          have "(1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) 
                reverse_QFT_product_representation jm n =
                (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) 
                (1/sqrt (2^n) m (kron (λ(l::nat). |zero + exp (2*𝗂*pi*jm/(2^l)) m |one) 
                                 (map nat (rev [1..n]))))"
            using reverse_QFT_product_representation_def by simp
          also have " = (1/sqrt 2 m (( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one))) 
                          (1/sqrt (2^n) m (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..n]))))"
            using kron_j jm_def by simp
          also have " = ((1/sqrt 2)*(1/sqrt (2^n))) m 
                          ((( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)) 
                          (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..n]))))"
          proof -
            have "dim_col ( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one) > 0"
              by (simp add: ket_vec_def)
            moreover have "dim_col (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..n]))) > 0"
              using kron_carrier_mat ket_vec_def
              by (metis (no_types, lifting) calculation carrier_matD(2) dim_col_mat(1) 
                  dim_row_mat(1) index_add_mat(2) index_add_mat(3) index_smult_mat(2) 
                  index_smult_mat(3) index_unit_vec(3))
            ultimately show ?thesis by simp
          qed
          also have " = (1/sqrt (2^(Suc n))) m 
                          ((( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)) 
                          (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..n]))))"
            by (simp add: real_sqrt_mult)
          also have " = (1/sqrt (2^(Suc n))) m 
                          (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..(Suc n)])))"
          proof -
            define f where "f = (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one)"
            hence "|zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one = f (Suc n)" by simp
            hence "((( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)) 
                   (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                   (map nat (rev [1..n])))) = 
                   (f (Suc n))  (kron f (map nat (rev [1..n])))"
              using f_def by simp
            also have " = kron f ((Suc n)#(map nat (rev [1..n])))"
              using kron.simps(2) by simp
            also have " = kron f (map nat (rev [1..(Suc n)]))"
              using map_def rev_append
              by (smt (z3) append_Cons append_self_conv2 list.simps(9) nat_int negative_zless 
                  of_nat_Suc rev_eq_Cons_iff rev_is_Nil_conv upto_rec2)
            finally have "((( |zero + exp(2*𝗂*pi*j/(2^(Suc n))) m |one)) 
                          (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..n])))) =
                          (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) 
                          (map nat (rev [1..(Suc n)])))"
              using f_def by simp
            thus ?thesis by simp
          qed
          also have " = reverse_QFT_product_representation j (Suc n)"
            using reverse_QFT_product_representation_def by simp
          finally show ?thesis by this
        qed
        finally show ?thesis by this
      qed
    qed
  qed
qed


subsection ‹QFT with qubits reordering correctness›

lemma SWAP_down_kron:
  assumes "m. dim_row (f m) = 2  dim_col (f m) = 1" 
  shows "SWAP_down (length (x#xs)) * kron f (x#xs) = kron f xs  f x"
proof (induct xs rule: rev_induct)
  case Nil
  have "SWAP_down (length [x]) * kron f [x] = (1m 2) * f x" using SWAP_down.simps(2) kron.simps(2)
    by (metis carrier_matI kron.simps(1) length_0_conv length_Cons right_tensor_id)
  also have " = f x" using left_mult_one_mat' assms by auto
  also have " = (1m 1)  f x" using left_tensor_id by auto
  also have " = kron f []  f x" using kron.simps by auto
  finally show ?case by this
next
  case (snoc a xs)
  assume HI:"SWAP_down (length (x#xs)) * kron f (x#xs) = kron f xs  f x"
  define n::nat where "n = length xs"
  show ?case
  proof (cases)
    assume Nil:"xs = []"
    hence "n = 0" using n_def by auto
    have "SWAP_down (length (x#xs@[a])) * kron f (x#xs@[a]) =
          SWAP_down (Suc (Suc 0)) * kron f (x#[a])"
      using n_def Nil by simp
    also have " = SWAP * kron f (x#[a])" using SWAP_down.simps(3) by simp
    also have " = SWAP * ((f x)  (f a))" using kron.simps(2)
      by (metis carrier_matI kron.simps(1) right_tensor_id)
    also have " = (f a)  (f x)" using SWAP_tensor assms by auto
    also have " = kron f (xs@[a])  (f x)" using kron.simps Nil
      by (metis carrier_mat_triv kron_cons_right left_tensor_id)
    finally show ?case by this
  next
    assume NNil:"xs  []"
    hence "n > 0" using n_def by auto
    hence e:"m. n = Suc m" by (simp add: gr0_implies_Suc)
    have "SWAP_down (length (x#xs@[a])) * kron f (x#xs@[a]) =
          SWAP_down (Suc (Suc n)) * kron f (x#xs@[a])"
      using n_def by auto
    also have " = ((1m (2^n))  SWAP) * ((SWAP_down (Suc n))  (1m 2)) * kron f (x#xs@[a])"
      using SWAP_down.simps e by auto
    also have " = ((1m (2^n))  SWAP) * (((SWAP_down (Suc n))  (1m 2)) * kron f (x#xs@[a]))"
    proof (rule assoc_mult_mat)
      show "((1m (2^n))  SWAP)  carrier_mat (2^(Suc (Suc n))) (2^(Suc (Suc n)))"
      proof -
        have "(1m (2^n))  carrier_mat (2^n) (2^n)" by simp
        moreover have "SWAP  carrier_mat 4 4" using SWAP_carrier_mat by simp
        ultimately show ?thesis using tensor_carrier_mat
          by (smt (verit, ccfv_threshold) mult_numeral_left_semiring_numeral num_double 
              numeral_times_numeral power_Suc power_commuting_commutes)
      qed
    next
      show "SWAP_down (Suc n)  1m 2  carrier_mat (2 ^ Suc (Suc n)) (2 ^ Suc (Suc n))"
      proof -
        have "SWAP_down (Suc n)  carrier_mat (2^(Suc n)) (2^(Suc n))" using SWAP_down_carrier_mat
          by blast
        moreover have "1m 2  carrier_mat 2 2" by simp
        ultimately show ?thesis using tensor_carrier_mat by auto
      qed
    next
      show "kron f (x # xs @ [a])  carrier_mat (2 ^ Suc (Suc n)) 1" using kron_carrier_mat
        by (metis assms length_Cons length_append_singleton n_def)
    qed
    also have " = ((1m (2^n))  SWAP) * (((SWAP_down (Suc n))  (1m 2)) * 
                    (kron f (x#xs)  f a))"
      using kron.simps by (metis append_Cons kron_cons_right)
    also have " = ((1m (2^n))  SWAP) * (((SWAP_down (Suc n))*(kron f (x#xs))) 
                                            (1m 2) * (f a))"
    proof -
      have c1:"dim_col (SWAP_down (Suc n)) = 2^(Suc n)" using SWAP_down_carrier_mat by blast
      hence a3: "dim_col (SWAP_down (Suc n)) > 0" by simp
      have r2:"dim_row (kron f (x#xs)) = 2^(Suc n)" using kron_carrier_mat assms n_def by auto
      hence a4:"dim_row (kron f (x#xs)) > 0" by simp
      with c1 r2 have a1:"dim_col (SWAP_down (Suc n)) = dim_row (kron f (x#xs))" by simp
      have c3:"dim_col (1m 2) = 2" by simp
      have r4:"dim_row (f a) = 2" using assms by simp
      hence a6:"dim_row (f a) > 0" by simp
      with c3 r4 have a2:"dim_col (1m 2) = dim_row (f a)" by simp
      have "(((SWAP_down (Suc n))  (1m 2)) * (kron f (x#xs)  f a)) = 
            (((SWAP_down (Suc n))*(kron f (x#xs)))  (1m 2) * (f a))"
        using a1 a2 a3 a4 a6
        by (metis assms carrier_matD(2) gr0I kron_carrier_mat mult_distr_tensor zero_neq_one)
      thus ?thesis by simp
    qed
    also have " = ((1m (2^n))  SWAP) * (kron f xs  f x  f a)"
      using HI by (simp add: assms n_def)
    also have " = ((1m (2^n))  SWAP) * (kron f xs  (f x  f a))"
      using tensor_mat_is_assoc by auto 
    also have " = ((1m (2^n)) * (kron f xs))  (SWAP * (f x  f a))"
      using mult_distr_tensor 
      by (smt (verit, del_insts) SWAP_ncols assms carrier_matD(2) dim_col_tensor_mat 
          dim_row_tensor_mat index_mult_mat(2) index_one_mat(2) index_one_mat(3) kron_carrier_mat
          left_mult_one_mat n_def numeral_One numeral_times_numeral semiring_norm(11) 
          semiring_norm(13) zero_less_numeral zero_less_power)
    also have " = kron f xs  f a  f x" using SWAP_tensor
      by (metis assms carrier_matI kron_carrier_mat left_mult_one_mat n_def tensor_mat_is_assoc)
    also have " = kron f (xs@[a])  f x" using kron.simps kron_cons_right by presburger 
    finally show ?thesis by this
  qed
qed


lemma SWAP_down_kron_map_rev:
  assumes "m. dim_row (f m) = 2  dim_col (f m) = 1"
  shows "(SWAP_down (Suc k)) * 
        kron f (map nat (rev [1..int (Suc k)])) = 
         (kron f (map nat (rev [1..int k]))  (f (Suc k)))"
proof -
  have "rev [1..int (Suc k)] = int (Suc k) # rev [1..int k]" using rev_append upto_rec2 by simp
  hence 1:"map nat (rev [1..int (Suc k)]) = Suc k # (map nat (rev [1.. int k]))"
    using list.map(2) by simp
  define x xs where "x = Suc k" and "xs = (map nat (rev [1.. int k]))"
  have "length xs = k" using xs_def by simp
  hence 2:"length (x#xs) = Suc k" by simp
  with 1 2 x_def xs_def have "(SWAP_down (Suc k)) * kron f (map nat (rev [1..int (Suc k)])) =
                              (SWAP_down (length (x#xs))) * kron f (x#xs)" by auto
  also have " = kron f xs  f x" using SWAP_down_kron x_def xs_def assms by blast
  finally show ?thesis using x_def xs_def by simp
qed


lemma reverse_qubits_kron:
  assumes "m. dim_row (f m) = 2  dim_col (f m) = 1"
  shows "(reverse_qubits n) * (kron f (map nat (rev [1..n]))) = kron f (map nat [1..n])"
proof (induct n rule: reverse_qubits.induct)
  case 1
  then show ?case by auto
next
  case 2
  then show ?case
  proof -
    have 1:"rev [1] = [1]" using rev_def by auto
    have 2:"reverse_qubits (Suc 0) = 1m 2" by simp
    have 3:"(f 1)  carrier_mat 2 1" using assms carrier_mat_def by auto
    have 4:"kron f [1] = (f 1)" using kron.simps(2) by auto
    show ?case using 1 2 3 4 by auto
  qed
next
  case 3
  have "reverse_qubits (Suc (Suc 0)) * kron f (map nat (rev [1..int (Suc (Suc 0))])) = 
        SWAP * kron f [2,1]"
    using reverse_qubits.simps(3) upto_rec1 by auto
  also have " = SWAP * ((f 2)  (f 1))"
    using right_tensor_id by (metis carrier_mat_triv kron.simps(1) kron.simps(2))
  also have " = (f 1)  (f 2)" using SWAP_tensor assms by auto
  also have " = kron f [1,2]" using upto_rec1 assms by auto
  also have " = kron f (map nat [1..int (Suc (Suc 0))])" using right_tensor_id assms 
    by (auto simp add: upto_rec1)
  finally show "reverse_qubits (Suc (Suc 0)) * kron f (map nat (rev [1..int (Suc (Suc 0))])) =
                kron f (map nat [1..int (Suc (Suc 0))])" by this
next 
  case 4
  fix n::nat
  define k::nat where "k = Suc (Suc n)"
  assume HI:"reverse_qubits (Suc (Suc n)) * kron f (map nat (rev [1..int (Suc (Suc n))])) =
             kron f (map nat [1..int (Suc (Suc n))])"
  have sk:"(SWAP_down (Suc k)) * kron f (map nat (rev [1..int (Suc k)])) = 
        (kron f (map nat (rev [1..int k]))  (f (Suc k)))" 
    using SWAP_down_kron_map_rev assms by this
  have "reverse_qubits (Suc k) * kron f (map nat (rev [1..int (Suc k)])) =
        ((reverse_qubits k)  (1m 2)) * (SWAP_down (Suc k)) * 
        kron f (map nat (rev [1..int (Suc k)]))"
    using reverse_qubits.simps(4) k_def by simp
  also have " = ((reverse_qubits k)  (1m 2)) * ((SWAP_down (Suc k)) * 
            kron f (map nat (rev [1..int (Suc k)])))"
  proof (rule assoc_mult_mat)
    show "(reverse_qubits k)  (1m 2)  carrier_mat (2^(k+1)) (2^(k+1))"
    proof -
      have "reverse_qubits k  carrier_mat (2^k) (2^k)" by simp
      moreover have "1m 2  carrier_mat 2 2" by simp
      ultimately show ?thesis using tensor_carrier_mat by (smt (verit) power_add power_one_right)
    qed
  next
    show "(SWAP_down (Suc k))  carrier_mat (2^(k+1)) (2^(k+1))"
      using Suc_eq_plus1 SWAP_down_carrier_mat by presburger
  next
    show "kron f (map nat (rev [1..int (Suc k)]))  carrier_mat (2 ^ (k + 1)) 1"
    proof -
      define xs where "xs = (map nat (rev [1..int (Suc k)]))"
      then have k1:"length xs = k + 1" by auto
      then have "kron f xs  carrier_mat (2 ^ (k + 1)) 1"
        using kron_carrier_mat assms k1 by metis
      thus ?thesis using xs_def by simp
    qed
  qed
  also have " = ((reverse_qubits k)  (1m 2)) * (kron f (map nat (rev [1..int k]))  (f (Suc k)))"
    using sk by simp
  also have " = ((reverse_qubits k) * (kron f (map nat (rev [1..int k]))))  ((1m 2) * (f (Suc k)))"
  proof -
    have c1:"dim_col (reverse_qubits k) = 2^k" using reverse_qubits_carrier_mat by blast
    have r2:"dim_row (kron f (map nat (rev [1..int k]))) = 2^k" 
      using kron_carrier_mat by (metis HI assms carrier_matD(1) index_mult_mat(2) k_def length_map 
          length_rev reverse_qubits_carrier_mat)
    with c1 r2 have a1:"dim_col (reverse_qubits k) = dim_row (kron f (map nat (rev [1..int k])))"
      by auto
    have c3:"dim_col (1m 2) = 2" by simp
    have r4:"dim_row (f (Suc k)) = 2" using assms by simp
    with c3 r4 have a2:"dim_col (1m 2) = dim_row (f (Suc k))" by simp
    have a3:"dim_col (reverse_qubits k) > 0" using c1 by auto
    have a4:"dim_row (kron f (map nat (rev [1..int k]))) > 0" using r2 by auto
    have a6:"dim_row (f (Suc k)) > 0" using r4 by auto
    show ?thesis using a1 a2 a3 a4 a6 mult_distr_tensor
      by (metis assms carrier_matD(2) kron_carrier_mat zero_less_one_class.zero_less_one)
  qed
  also have " = kron f (map nat [1..int k])  (f (Suc k))"
    using HI k_def assms by auto
  also have " = kron f (map nat [1..int (Suc k)])" using kron_cons_right
    by (smt (verit, ccfv_threshold) list.simps(8) list.simps(9) map_append nat_int negative_zless 
        of_nat_Suc upto_rec2)
  finally show "reverse_qubits (Suc (Suc (Suc n))) * 
                kron f (map nat (rev [1..int (Suc (Suc (Suc n)))])) =
                kron f (map nat [1..int (Suc (Suc (Suc n)))])" using k_def by simp
qed


lemma prod_rep_fun:
  assumes "f = (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one)"
  shows "m. dim_row (f m) = 2  dim_col (f m) = 1"
  apply (rule allI)
  apply (rule conjI)
   apply (simp add: assms ket_vec_def cpx_vec_length_def)+
  done

lemma rev_upto:
  assumes "n1  n2"
  shows "rev [n1..n2] = n2 # rev [n1..(n2-1)]"
  apply (simp)
  apply (rule upto_rec2)
  apply (simp add:assms)
  done

lemma dim_row_kron:
  shows "dim_row (kron f xs) = (xxs. dim_row (f x))"
proof (induct xs)
  case Nil
  show ?case using kron.simps(1) prod_list_def by auto
next
  case (Cons a xs)
  assume HI:"dim_row (kron f xs) = (xxs. dim_row (f x))"
  have "dim_row (kron f (a#xs)) = dim_row ((f a)  (kron f xs))" using kron.simps(2) by auto
  hence " = (dim_row (f a)) * (dim_row (kron f xs))" by auto
  hence " = (dim_row (f a)) * (xxs. dim_row (f x))" using HI by auto
  hence " = (xa # xs. dim_row (f x))" by auto
  thus ?case using HI by auto
qed

lemma dim_col_kron:
  shows "dim_col (kron f xs) = (xxs. dim_col (f x))"
proof (induct xs)
  case Nil
  show ?case using kron.simps(1) prod_list_def by auto
next
  case (Cons a xs)
  assume HI:"dim_col (kron f xs) = (xxs. dim_col (f x))"
  have "dim_col (kron f (a#xs)) = dim_col ((f a)  (kron f xs))" using kron.simps(2) by auto
  hence " = (dim_col (f a)) * (dim_col (kron f xs))" by auto
  hence " = (dim_col (f a)) * (xxs. dim_col (f x))" using HI by auto
  hence " = (xa # xs. dim_col (f x))" by auto
  thus ?case using HI by auto
qed

lemma prod_2_n:
  "(xmap nat (rev [1..int n]). 2) = 2 ^ n"
  apply (induct n)
   apply (simp add: rev_upto)+
  done

lemma prod_2_n_b:
  "(xmap nat [1..int n]. 2) = 2 ^ n"
  apply (induct n)
   apply simp
  apply (simp add: upto_rec2 power_commutes)
  done

lemma prod_1_n:
  "(xmap nat (rev [1..int n]). 1) = 1"
  apply (induct n)
   apply (simp add: rev_upto)+
  done

lemma prod_1_n_b:
  "(xmap nat [1..int n]. Suc 0) = Suc 0"
  apply (induct n)
   apply simp
  apply (simp add: upto_rec2)
  done

lemma reverse_qubits_product_representation:
  "reverse_qubits n * reverse_QFT_product_representation j n = QFT_product_representation j n"
proof -
  have "(reverse_qubits n) * reverse_QFT_product_representation j n = (reverse_qubits n) *
       ((1/sqrt(2^n)) m kron (λl. |zero + exp (2*𝗂*pi*j/2^l) m |one) (map nat (rev [1..int n])))"
    using reverse_QFT_product_representation_def by simp
  also have " = (1/sqrt(2^n)) m ((reverse_qubits n) *
                kron (λl. |zero + exp (2*𝗂*pi*j/2^l) m |one) (map nat (rev [1..int n])))"
  proof (rule mult_smult_distrib)
    show "reverse_qubits n  carrier_mat (2^n) (2^n)" by simp
  next
    show "kron (λl. |zero + exp (2*𝗂*pi*j/2^l) m |one) (map nat (rev [1..int n])) 
           carrier_mat (2^n) 1"
    proof
      show "dim_row (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) (map nat (rev [1..n])))
          = 2 ^ n"
      proof -
        have a1:"dim_row (kron (λl. |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ l) m |one) (map nat (rev [1..int n])))
            = (x(map nat (rev [1..int n])). (dim_row ((λl. |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ l) m |one) x)))"
          using dim_row_kron by simp
        hence b1:" = (x(map nat (rev [1..int n])). 2)" using prod_rep_fun by auto
        hence " = 2 ^ n" using prod_2_n by simp
        thus ?thesis using a1 b1 by auto
      qed
    next
      show "dim_col (kron (λ(l::nat). |zero + exp (2*𝗂*pi*j/(2^l)) m |one) (map nat (rev [1..n])))
            = 1"
      proof -
        have a2:"dim_col (kron (λl. |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ l) m |one) (map nat (rev [1..int n])))
            = (x(map nat (rev [1..int n])). (dim_col ((λl. |zero + exp (2 * 𝗂 * complex_of_real pi * complex_of_nat j / 2 ^ l) m |one) x)))"
          using dim_col_kron by simp
        also have " = (x(map nat (rev [1..int n])). 1)" using prod_rep_fun by auto
        also have " = 1" using prod_1_n by metis
        finally show ?thesis using a2 by auto
      qed
    qed
  qed
  also have " = (1 / sqrt (2^n)) m kron (λl. |zero + exp (2*𝗂*pi*j/2^l) m |one) (map nat [1..int n])"
    using reverse_qubits_kron prod_rep_fun by presburger
  also have " = QFT_product_representation j n" using QFT_product_representation_def by simp
  finally show ?thesis by this
qed

text ‹Finally, we proof the correctness of the algorithm›

theorem ordered_QFT_is_correct:
  assumes "j < 2^n"
  shows "(ordered_QFT n) * |state_basis n j = QFT_product_representation j n"
proof -
  have "(ordered_QFT n) * |state_basis n j = (reverse_qubits n) * (QFT n) * |state_basis n j"
    using ordered_QFT_def by simp
  also have " = (reverse_qubits n) * ((QFT n) * |state_basis n j)"
  proof (rule assoc_mult_mat)
    show "reverse_qubits n  carrier_mat (2^n) (2^n)" by simp
  next
    show "QFT n  carrier_mat (2^n) (2^n)" by simp
  next
    show "|state_basis n j  carrier_mat (2 ^ n) 1" using state_basis_carrier_mat by simp
  qed
  also have " = (reverse_qubits n) * reverse_QFT_product_representation j n"
    using QFT_is_correct assms by simp
  also have " = QFT_product_representation j n"
    using reverse_qubits_product_representation by simp
  finally show ?thesis by this
qed


(* -------------------------------------------------------------------------------------------- *)

section ‹Unitarity›

text ‹Although unitarity is not required to proof QFT's correctness, in this section we will prove
it, i.e., QFT and ordered\_QFT functions create quantum gates and QFT product representation is a 
quantum state.›


lemma state_basis_is_state:
  assumes "j < n"
  shows "state n |state_basis n j"
proof
  show "dim_col |state_basis n j = 1" by (simp add: ket_vec_def)
  show "dim_row |state_basis n j = 2^n" by (simp add: ket_vec_def state_basis_def)
  show "Matrix.col |state_basis n j 0 = 1"
    by (metis assms ket_vec_col less_exp order_less_trans state_basis_def unit_cpx_vec_length)
qed

lemma R_dagger_mat:
  shows "(R k) = Matrix.mat 2 2 (λ(i,j). if ij then 0 else (if i=0 then 1 else exp(-2*pi*𝗂/2^k)))"
proof
  let ?Rkd = "(R k)" 
  define m where "m = Matrix.mat 2 2 
  (λ(i,j). if ij then 0 else (if i=0 then 1 else exp(-2*pi*𝗂/2^k)))"
  thus "i j. i < dim_row m  j < dim_col m  ?Rkd $$ (i, j) = m $$ (i, j)"
  proof -
    fix i j
    assume "i < dim_row m"
    hence i2:"i < 2" using m_def by auto
    assume "j < dim_col m"
    hence j2:"j < 2" using m_def by auto
    show "?Rkd $$ (i, j) = m $$ (i, j)"
    proof (rule disjE)
      show "i = 0  i = 1" using i2 by auto
    next
      assume i0:"i = 0"
      show "?Rkd $$ (i, j) = m $$ (i, j)"
      proof (rule disjE)
        show "j = 0  j = 1" using j2 by auto
      next 
        assume j0:"j = 0"
        show "?Rkd $$ (i, j) = m $$ (i, j)" 
        proof -
          have "?Rkd $$ (0,0) = cnj (R k $$ (0,0))" 
            using dagger_def
            by (metis (no_types, lifting) One_nat_def R_def Suc_1 Suc_eq_plus1 
                Tensor.mat_of_cols_list_def dim_col_mat(1) dim_row_mat(1) index_mat(1) list.size(3)
                list.size(4) old.prod.case power_eq_0_iff power_zero_numeral)
          also have " = 1" 
            using R_def mat_of_cols_list_def
            by (metis One_nat_def Suc_1 Suc_eq_plus1 complex_cnj_one_iff index_mat_of_cols_list 
                list.size(3) list.size(4) nth_Cons_0 pos2)
          also have " = m $$ (0,0)" using m_def by simp
          finally show ?thesis using i0 j0 by auto
        qed
      next
        assume j1:"j = 1"
        show "?Rkd $$ (i, j) = m $$ (i, j)"
        proof -
          have "?Rkd $$ (0,1) = cnj (R k $$ (1,0))"
            using dagger_def 
            by (metis (no_types, lifting) One_nat_def R_def Suc_1 Suc_eq_plus1 
                Tensor.mat_of_cols_list_def j < dim_col m dim_col_mat(1) dim_row_mat(1) 
                index_mat(1) j1 list.size(3) list.size(4) m_def old.prod.case pos2)
          also have " = 0"
            using R_def mat_of_cols_list_def
            by (metis (no_types, lifting) One_nat_def Suc_1 Suc_eq_plus1 j < dim_col m 
                complex_cnj_zero_iff dim_col_mat(1) index_mat_of_cols_list j1 list.size(3) 
                list.size(4) m_def nth_Cons_0 nth_Cons_Suc pos2)
          also have " = m $$ (0,1)" using m_def by auto
          finally show ?thesis using i0 j1 by auto
        qed
      qed
    next
      assume i1:"i = 1"
      show "?Rkd $$ (i, j) = m $$ (i, j)"
      proof (rule disjE)
        show "j = 0  j = 1" using j2 by auto
      next 
        assume j0:"j = 0"
        show "?Rkd $$ (i, j) = m $$ (i, j)"
        proof -
          have "?Rkd $$ (1,0) = cnj (R k $$ (0,1))"
            using dagger_def
            by (metis (no_types, lifting) One_nat_def R_def Suc_1 Suc_eq_plus1 
                Tensor.mat_of_cols_list_def dim_col_mat(1) dim_row_mat(1) index_mat(1) 
                less_Suc_numeral list.size(3) list.size(4) old.prod.case power_eq_0_iff 
                power_zero_numeral pred_numeral_simps(2))
          also have " = 0"
            using R_def mat_of_cols_list_def
            by (metis One_nat_def Suc_eq_plus1 complex_cnj_zero_iff index_mat_of_cols_list
                less_Suc_eq_0_disj list.size(4) nth_Cons_0 nth_Cons_Suc pos2)
          also have " = m $$ (1,0)" using m_def by simp
          finally show ?thesis using i1 j0 by simp
        qed
      next
        assume j1:"j = 1"
        show "?Rkd $$ (i, j) = m $$ (i, j)" 
        proof -
          have "?Rkd $$ (1,1) = cnj (R k $$ (1,1))"
            using dagger_def
            by (metis (no_types, lifting) One_nat_def R_def Suc_1 Suc_eq_plus1 
                Tensor.mat_of_cols_list_def dim_col_mat(1) dim_row_mat(1) index_mat(1) 
                less_Suc_numeral list.size(3) list.size(4) old.prod.case power_eq_0_iff 
                power_zero_numeral pred_numeral_simps(2))
          also have " = cnj (exp(2*pi*𝗂/2^k))"
            using R_def mat_of_cols_list_def 
            by (metis One_nat_def Suc_1 Suc_eq_plus1 index_mat_of_cols_list lessI list.size(3) 
                list.size(4) nth_Cons_0 nth_Cons_Suc)
          also have " = exp (-2*pi*𝗂/2^k)"
            by (smt (verit, ccfv_threshold) exp_of_real_cnj mult.commute mult.left_commute 
                mult_1s_ring_1(1) of_real_divide of_real_minus of_real_numeral of_real_power 
                times_divide_eq_right)
          also have " = m $$ (1,1)" using m_def by simp
          finally have "?Rkd $$ (i, j) = m $$ (i, j)" using i1 j1 by simp
          thus ?thesis by this
        qed
      qed
    qed
  qed
next
  define m where "m = Matrix.mat 2 2 
  (λ(i,j). if ij then 0 else (if i=0 then 1 else exp(-2*pi*𝗂/2^k)))"
  thus "dim_row ((R k)) = dim_row m" 
    by (metis (no_types, lifting) One_nat_def R_def Suc_1 Suc_eq_plus1 Tensor.mat_of_cols_list_def
        dim_col_mat(1) dim_row_mat(1) dim_row_of_dagger list.size(3) list.size(4))
next
  define m where "m = Matrix.mat 2 2 
  (λ(i,j). if ij then 0 else (if i=0 then 1 else exp(-2*pi*𝗂/2^k)))"
  thus "dim_col ((R k)) = dim_col m" 
    by (simp add: R_def Tensor.mat_of_cols_list_def)
qed

lemma R_is_gate:
  shows "gate 1 (R n)"
proof
  let ?Rnd = "(R n)" 
  show "dim_row (R n) = 2^1" using R_def by (simp add: Tensor.mat_of_cols_list_def)
  show "square_mat (R n)" using R_def by (simp add: Tensor.mat_of_cols_list_def)
  show "unitary (R n)"
  proof -
    have "?Rnd * R n = 1m 2  R n * ?Rnd = 1m 2"
    proof
      show "?Rnd * R n = 1m 2"
      proof
        show "i j. i < dim_row (1m 2)  j < dim_col (1m 2)  
              (?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
        proof -
          fix i j
          assume "i < dim_row (1m 2)"
          hence i2:"i < 2" by auto
          assume "j < dim_col (1m 2)"
          hence j2:"j < 2" by auto
          show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
          proof (rule disjE)
            show "i = 0  i = 1" using i2 by auto
          next
            assume i0:"i = 0"
            show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
            proof (rule disjE)
              show "j = 0  j = 1" using j2 by auto
            next
              assume j0:"j = 0"
              show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(?Rnd * R n) $$ (0,0) = (?Rnd $$ (0,0)) * ((R n) $$ (0,0)) +
                      (?Rnd $$ (0,1)) * ((R n) $$ (1,0))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 1" using R_dagger_mat R_def index_mat_of_cols_list
                  by (smt (verit, del_insts) Suc_1 Suc_eq_plus1 add.commute add_0 index_mat(1) 
                      lessI list.size(3) list.size(4) mult_1 mult_zero_left nth_Cons_0 
                      nth_Cons_Suc old.prod.case pos2)
                also have " = 1m 2 $$ (0,0)" by simp
                finally show ?thesis using i0 j0 by simp
              qed 
            next
              assume j1:"j = 1"
              show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)" 
              proof -
                have "(?Rnd * R n) $$ (0,1) = (?Rnd $$ (0,0)) * ((R n) $$ (0,1)) +
                      (?Rnd $$ (0,1)) * ((R n) $$ (1,1))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 0" using R_dagger_mat R_def index_mat_of_cols_list
                  by (smt (verit) Suc_1 Suc_eq_plus1 add_cancel_left_left index_mat(1) lessI
                      list.size(3) list.size(4) mult_eq_0_iff nth_Cons_0 nth_Cons_Suc old.prod.case 
                      pos2)
                also have " = 1m 2 $$ (0,1)" by simp
                finally show ?thesis using i0 j1 by simp
              qed
            qed
          next
            assume i1:"i = 1"
            show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
            proof (rule disjE)
              show "j = 0  j = 1" using j2 by auto
            next
              assume j0:"j = 0"
              show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(?Rnd * R n) $$ (1,0) = (?Rnd $$ (1,0)) * ((R n) $$ (0,0)) +
                      (?Rnd $$ (1,1)) * ((R n) $$ (1,0))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 0" using R_dagger_mat R_def index_mat_of_cols_list
                  by (smt (verit) Suc_1 Suc_eq_plus1 add_cancel_right_right index_mat(1) lessI 
                      list.size(3) list.size(4) mult_eq_0_iff nth_Cons_0 nth_Cons_Suc old.prod.case
                      plus_1_eq_Suc pos2)
                also have " = 1m 2 $$ (1,0)" by simp
                finally show ?thesis using i1 j0 by simp
              qed
            next
              assume j1:"j = 1"
              show "(?Rnd * R n) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(?Rnd * R n) $$ (1,1) = (?Rnd $$ (1,0)) * ((R n) $$ (0,1)) +
                      (?Rnd $$ (1,1)) * ((R n) $$ (1,1))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = exp(-2*pi*𝗂/2^n) * exp(2*pi*𝗂/2^n)"
                  using R_dagger_mat R_def index_mat_of_cols_list by auto
                also have " = 1"
                  by (metis (no_types, lifting) exp_minus_inverse minus_divide_divide 
                      minus_divide_right mult_minus_left of_real_minus)
                also have " = 1m 2 $$ (1,1)" by simp
                finally show ?thesis using i1 j1 by simp
              qed
            qed
          qed
        qed
      next
        show "dim_row (?Rnd * R n) = dim_row (1m 2)"
          using dim_row (R n) = 2 ^ 1 square_mat (R n) by auto
      next
        show "dim_col (?Rnd * R n) = dim_col (1m 2)"
          using dim_row (R n) = 2 ^ 1 square_mat (R n) by auto
      qed
    next
      show "R n * ?Rnd = 1m 2"
      proof
        show "i j. i < dim_row (1m 2)  j < dim_col (1m 2) 
              (R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
        proof -
          fix i j
          assume "i < dim_row (1m 2)"
          hence i2:"i < 2" by auto
          assume "j < dim_col (1m 2)"
          hence j2:"j < 2" by auto
          show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
          proof (rule disjE)
            show "i = 0  i = 1" using i2 by auto
          next
            assume i0:"i = 0"
            show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
            proof (rule disjE)
              show "j = 0  j = 1" using j2 by auto
            next
              assume j0:"j = 0"
              show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(R n * ?Rnd) $$ (0,0) = ((R n) $$ (0,0)) * (?Rnd $$ (0,0)) +
                      ((R n) $$ (0,1)) * (?Rnd $$ (1,0))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 1" using R_dagger_mat R_def index_mat_of_cols_list by simp
                also have " = 1m 2 $$ (0,0)" by simp
                finally show ?thesis using i0 j0 by simp
              qed
            next
              assume j1:"j = 1"
              show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(R n * ?Rnd) $$ (0,1) = ((R n) $$ (0,0)) * (?Rnd $$ (0,1)) +
                      (R n $$ (0,1)) * (?Rnd $$ (1,1))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 0" using R_dagger_mat R_def index_mat_of_cols_list by simp
                also have " = 1m 2 $$ (0,1)" by simp
                finally show ?thesis using i0 j1 by simp
              qed
            qed
          next
            assume i1:"i = 1"
            show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
            proof (rule disjE)
              show "j = 0  j = 1" using j2 by auto
            next
              assume j0:"j = 0"
              show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)"
              proof -
                have "(R n * ?Rnd) $$ (1,0) = ((R n) $$ (1,0)) * (?Rnd $$ (0,0)) +
                      ((R n) $$ (1,1)) * (?Rnd $$ (1,0))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = 1m 2 $$ (1,0)" 
                  using R_dagger_mat R_def index_mat_of_cols_list by simp
                finally show ?thesis using i1 j0 by simp
              qed
            next
              assume j1:"j = 1"
              show "(R n * ?Rnd) $$ (i, j) = 1m 2 $$ (i, j)" 
              proof -
                have "(R n * ?Rnd) $$ (1,1) = (R n $$ (1,0)) * (?Rnd $$ (0,1)) +
                      (R n $$ (1,1)) * (?Rnd $$ (1,1))"
                  using dim_row (R n) = 2 ^ 1 square_mat (R n) sumof2 by fastforce
                also have " = exp(2*pi*𝗂/2^n) * exp(-2*pi*𝗂/2^n)"
                  using R_dagger_mat R_def index_mat_of_cols_list by simp
                also have " = 1"
                  by (simp add: exp_minus_inverse)
                also have " = 1m 2 $$ (1,1)" by simp
                finally show ?thesis using i1 j1 by simp
              qed
            qed
          qed
        qed
      next
        show "dim_row (R n * ?Rnd) = dim_row (1m 2)"
          by (simp add: dim_row (R n) = 2 ^ 1)
      next
        show "dim_col (R n * ?Rnd) = dim_col (1m 2)"
          by (simp add: dim_row (R n) = 2 ^ 1)
      qed
    qed
    thus ?thesis using unitary_def R_def mat_of_cols_list_def by auto
  qed
qed

lemma SWAP_dagger_mat:
  shows "SWAP = SWAP"
proof -
  have "SWAP = Matrix.mat 4 4 (λ(i,j). cnj (SWAP $$ (j,i)))" 
    using dagger_def SWAP_carrier_mat 
    by (metis SWAP_ncols carrier_matD(1))
  also have " = Matrix.mat 4 4 (λ(i,j). cnj (SWAP $$ (i,j)))" 
    using SWAP_def SWAP_index
  proof -
    obtain nn :: "(nat × nat  complex)  (nat × nat  complex)  nat  nat  nat" and nna :: "(nat × nat  complex)  (nat × nat  complex)  nat  nat  nat" where
      "x0 x1 x3 x5. (v6 v7. (v6 < x5  v7 < x3)  x1 (v6, v7)  x0 (v6, v7)) = ((nn x0 x1 x3 x5 < x5  nna x0 x1 x3 x5 < x3)  x1 (nn x0 x1 x3 x5, nna x0 x1 x3 x5)  x0 (nn x0 x1 x3 x5, nna x0 x1 x3 x5))"
      by moura
    then have "n na nb nc f fa. (n  na  nb  nc  (nn fa f nb n < n  nna fa f nb n < nb)  f (nn fa f nb n, nna fa f nb n)  fa (nn fa f nb n, nna fa f nb n))  Matrix.mat n nb f = Matrix.mat na nc fa"
      by (meson cong_mat)
    moreover
    { assume "nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3"
      then have "(if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  1 then if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3 then (if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 0 else (if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1 else (if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1)  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  (if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 0"
        by presburger }
    moreover
    { assume "nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3"
      then have "(if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  1 then if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4  3 then (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 0 else (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1 else (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1)  (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1"
        by presburger }
    moreover
    { assume "(if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 0  (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 0"
      moreover
      { assume "((if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 0  (if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 0)  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (n, na)))  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (na, n)))"
        then have "Matrix.mat 4 4 (λ(n, na). if n = 0  na = 0 then 1::complex else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0) $$ (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) = (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  ((if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 0  (if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 0)  SWAP $$ (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4)  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)"
          by (smt (z3) SWAP_def old.prod.case)
        then have "Matrix.mat 4 4 (λ(n, na). if n = 0  na = 0 then 1::complex else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0) $$ (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4)  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  SWAP $$ (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4)  (case (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)"
          by fastforce }
      ultimately have "SWAP $$ (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) = (case (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  Matrix.mat 4 4 (λ(n, na). if n = 0  na = 0 then 1::complex else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0) $$ (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) = (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  ¬ nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 < 4  ¬ nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 < 4  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (n, na))) = (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (na, n)))"
        by blast }
    moreover
    { assume "(if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1  (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1"
      moreover
      { assume "((if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 1  (if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 0 then 1::complex else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 2  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 1 then 1 else if nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3  nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 = 3 then 1 else 0) = 1)  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (n, na)))  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (na, n)))"
        then have "((if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1  (if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 0 then 1::complex else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 2  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 1 then 1 else if nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3  nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4 = 3 then 1 else 0) = 1)  SWAP $$ (nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4, nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4)  SWAP $$ (nn (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4, nna (λ(na, n). cnj (SWAP $$ (n, na))) (λ(na, n). cnj (SWAP $$ (na, n))) 4 4)"
          by (smt (z3) old.prod.case)
        then have "Matrix.mat 4 4 (λ(n, na). if n = 0  na = 0 then 1::complex else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0) $$ (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4)  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  SWAP $$ (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4)  (case (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)"
          using SWAP_def by auto }
      ultimately have "SWAP $$ (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) = (case (nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  Matrix.mat 4 4 (λ(n, na). if n = 0  na = 0 then 1::complex else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0) $$ (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) = (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  if n = 0  na = 0 then 1 else if n = 1  na = 2 then 1 else if n = 2  na = 1 then 1 else if n = 3  na = 3 then 1 else 0)  ¬ nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 < 4  ¬ nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4 < 4  (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (n, na))) = (case (nn (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4, nna (λ(n, na). cnj (SWAP $$ (na, n))) (λ(n, na). cnj (SWAP $$ (n, na))) 4 4) of (n, na)  cnj (SWAP $$ (na, n)))"
        by linarith }
    ultimately show ?thesis
      by (smt (z3) SWAP_def index_mat(1))
  qed
  also have " = SWAP" using SWAP_def SWAP_index
    by (smt (verit, ccfv_SIG) case_prod_conv complex_cnj_one complex_cnj_zero cong_mat index_mat(1))
  finally show ?thesis by this
qed

lemma SWAP_inv:
  shows "SWAP * (SWAP) = 1m 4"
  apply (simp add: SWAP_def times_mat_def one_mat_def)
  apply (rule cong_mat)
  by (auto simp: scalar_prod_def complex_eqI)

lemma SWAP_inv':
  shows "(SWAP) * SWAP = 1m 4"
  apply (simp add: SWAP_def times_mat_def one_mat_def)
  apply (rule cong_mat)
  by (auto simp: scalar_prod_def complex_eqI)

lemma SWAP_is_gate:
  shows "gate 2 SWAP"
proof
  show "dim_row SWAP = 22" using SWAP_carrier_mat by (simp add: numeral_Bit0)
next
  show "square_mat SWAP" using SWAP_carrier_mat by (simp add: numeral_Bit0)
next
  show "unitary SWAP"
    using unitary_def SWAP_inv SWAP_inv' SWAP_ncols SWAP_nrows by presburger
qed


lemma control2_inv:
  assumes "gate 1 U"
  shows "(control2 U) * ((control2 U)) = 1m 4"
proof 
  show "i j. i < dim_row (1m 4)  j < dim_col (1m 4) 
           (control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
  proof -
    fix i j
    assume "i < dim_row (1m 4)"
    hence i4:"i < 4" by auto
    assume "j < dim_col (1m 4)"
    hence j4:"j < 4" by auto
    show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
    proof (rule disjE)
      show "i = 0  i = 1  i = 2  i = 3" using i4 by auto
    next
      assume i0:"i = 0"
      show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
      proof (rule disjE)
        show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
      next
        assume j0:"j = 0"
        show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
        proof -
          have "(control2 U * ((control2 U))) $$ (0,0) = 
                (control2 U) $$ (0,0) * ((control2 U)) $$ (0,0) +
                (control2 U) $$ (0,1) * ((control2 U)) $$ (1,0) +
                (control2 U) $$ (0,2) * ((control2 U)) $$ (2,0) +
                (control2 U) $$ (0,3) * ((control2 U)) $$ (3,0)"
            using times_mat_def sumof4
            by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dagger_def 
                dim_col_of_dagger dim_row_mat(1) i0 i4 index_matrix_prod)
          also have " = ((control2 U)) $$ (0,0)"
            using control2_def index_mat_of_cols_list by force
          also have " = cnj ((control2 U) $$ (0,0))"
            using dagger_def 
            by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat i0 i4 index_mat(1) 
                old.prod.case)
          also have " = 1" using control2_def index_mat_of_cols_list by auto
          also have " = 1m 4 $$ (0,0)" by simp
          finally show ?thesis using i0 j0 by simp
        qed
      next
        assume jl3:"j = 1  j = 2  j = 3"
        show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show "j = 1  j = 2  j = 3" using jl3 by this
        next
          assume j1:"j = 1"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof -
            have "(control2 U * ((control2 U))) $$ (0,1) = 
                  (control2 U) $$ (0,0) * ((control2 U)) $$ (0,1) +
                  (control2 U) $$ (0,1) * ((control2 U)) $$ (1,1) +
                  (control2 U) $$ (0,2) * ((control2 U)) $$ (2,1) +
                  (control2 U) $$ (0,3) * ((control2 U)) $$ (3,1)"
              using times_mat_def sumof4
              by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                  dim_row_of_dagger i0 i4 index_matrix_prod j1 j4)
            also have " = ((control2 U)) $$ (0,1)"
              using control2_def index_mat_of_cols_list by force
            also have " = cnj ((control2 U) $$ (1,0))"
              using dagger_def 
              by (metis (mono_tags, lifting) One_nat_def Suc_1 add_Suc_right carrier_matD(1) 
                  carrier_matD(2) control2_carrier_mat index_mat(1) less_Suc_eq_0_disj numeral_Bit0
                  prod.simps(2))
            also have " = 0" using control2_def index_mat_of_cols_list by auto
            also have " = 1m 4 $$ (0,1)" by simp
            finally show ?thesis using i0 j1 by simp
          qed
        next
          assume jl2:"j = 2  j = 3"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 2  j = 3" using jl2 by this
          next
            assume j2:"j = 2"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "(control2 U * ((control2 U))) $$ (0,2) = 
                    (control2 U) $$ (0,0) * ((control2 U)) $$ (0,2) +
                    (control2 U) $$ (0,1) * ((control2 U)) $$ (1,2) +
                    (control2 U) $$ (0,2) * ((control2 U)) $$ (2,2) +
                    (control2 U) $$ (0,3) * ((control2 U)) $$ (3,2)"
                using times_mat_def sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger i0 i4 index_matrix_prod j2 j4)
              also have " = ((control2 U)) $$ (0,2)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (2,0))"
                using dagger_def 
                by (smt (verit, del_insts) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                    index_mat(1) less_add_same_cancel2 numeral_Bit0 prod.simps(2) zero_less_numeral)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (0,2)" by simp
              finally show ?thesis using i0 j2 by simp
            qed
          next
            assume j3:"j = 3"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "(control2 U * ((control2 U))) $$ (0,3) = 
                    (control2 U) $$ (0,0) * ((control2 U)) $$ (0,3) +
                    (control2 U) $$ (0,1) * ((control2 U)) $$ (1,3) +
                    (control2 U) $$ (0,2) * ((control2 U)) $$ (2,3) +
                    (control2 U) $$ (0,3) * ((control2 U)) $$ (3,3)"
                using times_mat_def sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger i0 i4 index_matrix_prod j3 j4)
              also have " = ((control2 U)) $$ (0,3)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (3,0))"
                using dagger_def 
                by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat index_mat(1) j3 j4 
                    prod.simps(2) zero_less_numeral)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (0,3)" by simp
              finally show ?thesis using i0 j3 by simp
            qed
          qed
        qed
      qed
    next
      assume il3:"i = 1  i = 2  i = 3"
      show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
      proof (rule disjE)
        show "i = 1  i = 2  i = 3" using il3 by this
      next
        assume i1:"i = 1"
        show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show jl4:"j = 0  j = 1  j = 2  j = 3" using j4 by auto
        next
          assume j0:"j = 0"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof -
            have "(control2 U * ((control2 U))) $$ (1,0) = 
                    (control2 U) $$ (1,0) * ((control2 U)) $$ (0,0) +
                    (control2 U) $$ (1,1) * ((control2 U)) $$ (1,0) +
                    (control2 U) $$ (1,2) * ((control2 U)) $$ (2,0) +
                    (control2 U) $$ (1,3) * ((control2 U)) $$ (3,0)"
              using times_mat_def sumof4
              by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                  dim_row_of_dagger i1 i4 index_matrix_prod j0 j4)
            also have " = (control2 U) $$ (1,1) * ((control2 U)) $$ (1,0) + 
                              (control2 U) $$ (1,3) * ((control2 U)) $$ (3,0)"
              using control2_def index_mat_of_cols_list by force
            also have " = (control2 U) $$ (1,1) * (cnj ((control2 U) $$ (0,1))) + 
                              (control2 U) $$ (1,3) * (cnj ((control2 U) $$ (0,3)))"
              using dagger_def
              by (smt (verit, ccfv_threshold) One_nat_def Suc_1 add.commute add_Suc_right 
                  carrier_matD(1) carrier_matD(2) control2_carrier_mat i1 i4 index_mat(1) j0 j4 
                  lessI numeral_3_eq_3 numeral_Bit0 plus_1_eq_Suc prod.simps(2))
            also have " = (control2 U) $$ (1,1) * (cnj 0) +
                              (control2 U) $$ (1,3) * (cnj 0)"
              using control2_def index_mat_of_cols_list by simp
            also have " = 0" by auto
            also have " = 1m 4 $$ (1,0)" by simp
            finally show ?thesis using i1 j0 by simp
          qed
        next
          assume jl3:"j = 1  j = 2  j = 3"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 1  j = 2  j = 3" using jl3 by this
          next
            assume j1:"j = 1"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "(control2 U * ((control2 U))) $$ (1,1) = 
                    (control2 U) $$ (1,0) * ((control2 U)) $$ (0,1) +
                    (control2 U) $$ (1,1) * ((control2 U)) $$ (1,1) +
                    (control2 U) $$ (1,2) * ((control2 U)) $$ (2,1) +
                    (control2 U) $$ (1,3) * ((control2 U)) $$ (3,1)"
                using times_mat_def sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger i1 i4 index_matrix_prod j1 j4)
              also have " = (control2 U) $$ (1,1) * ((control2 U)) $$ (1,1) + 
                                (control2 U) $$ (1,3) * ((control2 U)) $$ (3,1)"
                using control2_def index_mat_of_cols_list by force
              also have " = (control2 U) $$ (1,1) * (cnj ((control2 U) $$ (1,1))) + 
                                (control2 U) $$ (1,3) * (cnj ((control2 U) $$ (1,3)))"
                using dagger_def
                by (smt (verit, best) One_nat_def Suc_1 add.commute add_Suc_right carrier_matD(1)
                    carrier_matD(2) control2_carrier_mat i1 i4 index_mat(1) lessI numeral_3_eq_3 
                    numeral_Bit0 plus_1_eq_Suc prod.simps(2))
              also have " = U $$ (0,0) * (cnj (U $$ (0,0))) +
                              U $$ (0,1) * (cnj (U $$ (0,1)))"
                using control2_def index_mat_of_cols_list by simp
              also have " = (U $$ (0,0)) * ((U) $$ (0,0)) +
                              (U $$ (0,1)) * ((U) $$ (1,0))"
                using dagger_def assms(1) gate_def by force
              also have " = (U * (U)) $$ (0,0)" 
                using times_mat_def assms(1) gate_carrier_mat sumof2
                by (smt (z3) carrier_matD(2) dagger_def dim_col_mat(1) dim_row_of_dagger 
                    gate.dim_row index_matrix_prod pos2 power_one_right)
              also have " = (1m 2) $$ (0,0)" using assms(1) gate_def unitary_def by auto
              also have " = 1" by auto
              also have " = 1m 4 $$ (1,1)" by simp
              finally show ?thesis using i1 j1 by simp
            qed
          next
            assume jl2:"j = 2  j = 3"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 2  j = 3" using jl2 by this
            next
              assume j2:"j = 2"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "(control2 U * ((control2 U))) $$ (1,2) = 
                    (control2 U) $$ (1,0) * ((control2 U)) $$ (0,2) +
                    (control2 U) $$ (1,1) * ((control2 U)) $$ (1,2) +
                    (control2 U) $$ (1,2) * ((control2 U)) $$ (2,2) +
                    (control2 U) $$ (1,3) * ((control2 U)) $$ (3,2)"
                  using times_mat_def sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                      dim_row_of_dagger i1 i4 index_matrix_prod j2 j4)
                also have " = (control2 U) $$ (1,1) * ((control2 U)) $$ (1,2) + 
                                (control2 U) $$ (1,3) * ((control2 U)) $$ (3,2)"
                  using control2_def index_mat_of_cols_list by force
                also have " = (control2 U) $$ (1,1) * (cnj ((control2 U) $$ (2,1))) + 
                                (control2 U) $$ (1,3) * (cnj ((control2 U) $$ (2,3)))"
                  using dagger_def
                  by (smt (verit, ccfv_threshold) One_nat_def Suc_1 add.commute add_Suc_right 
                      carrier_matD(1) carrier_matD(2) control2_carrier_mat i1 i4 index_mat(1) j2 j4 
                      lessI numeral_3_eq_3 numeral_Bit0 plus_1_eq_Suc prod.simps(2))
                also have " = (control2 U) $$ (1,1) * (cnj 0) +
                                (control2 U) $$ (1,3) * (cnj 0)"
                  using control2_def index_mat_of_cols_list by simp
                also have " = 0" by auto
                also have " = 1m 4 $$ (1,2)" by simp
                finally show ?thesis using i1 j2 by simp
              qed
            next
              assume j3:"j = 3"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "(control2 U * ((control2 U))) $$ (1,3) = 
                    (control2 U) $$ (1,0) * ((control2 U)) $$ (0,3) +
                    (control2 U) $$ (1,1) * ((control2 U)) $$ (1,3) +
                    (control2 U) $$ (1,2) * ((control2 U)) $$ (2,3) +
                    (control2 U) $$ (1,3) * ((control2 U)) $$ (3,3)"
                  using times_mat_def sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                      dim_row_of_dagger i1 i4 index_matrix_prod j3 j4)
                also have " = (control2 U) $$ (1,1) * ((control2 U)) $$ (1,3) + 
                                (control2 U) $$ (1,3) * ((control2 U)) $$ (3,3)"
                  using control2_def index_mat_of_cols_list by force
                also have " = (control2 U) $$ (1,1) * (cnj ((control2 U) $$ (3,1))) + 
                                (control2 U) $$ (1,3) * (cnj ((control2 U) $$ (3,3)))"
                  using dagger_def
                  by (smt (verit, best) One_nat_def Suc_1 add.commute add_Suc_right carrier_matD(1)
                      carrier_matD(2) control2_carrier_mat i1 i4 index_mat(1) lessI numeral_3_eq_3 
                      numeral_Bit0 plus_1_eq_Suc prod.simps(2))
                also have " = U $$ (0,0) * (cnj (U $$ (1,0))) +
                              U $$ (0,1) * (cnj (U $$ (1,1)))"
                  using control2_def index_mat_of_cols_list by simp
                also have " = (U $$ (0,0)) * ((U) $$ (0,1)) +
                              (U $$ (0,1)) * ((U) $$ (1,1))"
                  using dagger_def assms(1) gate_def by force
                also have " = (U * (U)) $$ (0,1)" 
                  using times_mat_def assms(1) gate_carrier_mat sumof2
                  by (smt (z3) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) dim_row_of_dagger 
                      gate.dim_row index_matrix_prod lessI pos2 power_one_right)
                also have " = (1m 2) $$ (0,1)" using assms(1) gate_def unitary_def by auto
                also have " = 0" by auto
                also have " = 1m 4 $$ (1,3)" by simp
                finally show ?thesis using i1 j3 by simp
              qed
            qed
          qed
        qed
      next
        assume il2:"i = 2  i = 3"
        show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show "i = 2  i = 3" using il2 by this
        next
          assume i2:"i = 2"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
          next
            assume j0:"j = 0"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "(control2 U * ((control2 U))) $$ (2,0) = 
                  (control2 U) $$ (2,0) * ((control2 U)) $$ (0,0) +
                  (control2 U) $$ (2,1) * ((control2 U)) $$ (1,0) +
                  (control2 U) $$ (2,2) * ((control2 U)) $$ (2,0) +
                  (control2 U) $$ (2,3) * ((control2 U)) $$ (3,0)"
                using times_mat_def sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger i2 i4 index_matrix_prod j0 j4)
              also have " = ((control2 U)) $$ (2,0)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (0,2))"
                using dagger_def 
                by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat i2 i4 index_mat(1) 
                    j0 j4 prod.simps(2))
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (2,0)" by simp
              finally show ?thesis using i2 j0 by simp
            qed
          next
            assume jl3:"j = 1  j = 2  j = 3"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 1  j = 2  j = 3" using jl3 by this
            next
              assume j1:"j = 1"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "(control2 U * ((control2 U))) $$ (2,1) = 
                  (control2 U) $$ (2,0) * ((control2 U)) $$ (0,1) +
                  (control2 U) $$ (2,1) * ((control2 U)) $$ (1,1) +
                  (control2 U) $$ (2,2) * ((control2 U)) $$ (2,1) +
                  (control2 U) $$ (2,3) * ((control2 U)) $$ (3,1)"
                  using times_mat_def sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                      dim_row_of_dagger i2 i4 index_matrix_prod j1 j4)
                also have " = ((control2 U)) $$ (2,1)"
                  using control2_def index_mat_of_cols_list by force
                also have " = cnj ((control2 U) $$ (1,2))"
                  using dagger_def 
                  by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat i2 i4 index_mat(1) 
                      j1 j4 prod.simps(2))
                also have " = 0" using control2_def index_mat_of_cols_list by auto
                also have " = 1m 4 $$ (2,1)" by simp
                finally show ?thesis using i2 j1 by simp
              qed
            next
              assume jl2:"j = 2  j = 3"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof (rule disjE)
                show "j = 2  j = 3" using jl2 by this
              next
                assume j2:"j = 2"
                show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "(control2 U * ((control2 U))) $$ (2,2) = 
                  (control2 U) $$ (2,0) * ((control2 U)) $$ (0,2) +
                  (control2 U) $$ (2,1) * ((control2 U)) $$ (1,2) +
                  (control2 U) $$ (2,2) * ((control2 U)) $$ (2,2) +
                  (control2 U) $$ (2,3) * ((control2 U)) $$ (3,2)"
                    using times_mat_def sumof4
                    by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                        dim_row_of_dagger i2 i4 index_matrix_prod j2 j4)
                  also have " = ((control2 U)) $$ (2,2)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (2,2))"
                    using dagger_def 
                    by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat i2 index_mat(1) 
                        j2 j4 prod.simps(2))
                  also have " = 1" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (2,2)" by simp
                  finally show ?thesis using i2 j2 by simp
                qed
              next
                assume j3:"j = 3"
                show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "(control2 U * ((control2 U))) $$ (2,3) = 
                  (control2 U) $$ (2,0) * ((control2 U)) $$ (0,3) +
                  (control2 U) $$ (2,1) * ((control2 U)) $$ (1,3) +
                  (control2 U) $$ (2,2) * ((control2 U)) $$ (2,3) +
                  (control2 U) $$ (2,3) * ((control2 U)) $$ (3,3)"
                    using times_mat_def sumof4
                    by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                        dim_row_of_dagger i2 i4 index_matrix_prod j3 j4)
                  also have " = ((control2 U)) $$ (2,3)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (3,2))"
                    using dagger_def 
                    by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat i2 i4 index_mat(1) 
                        j3 j4 prod.simps(2))
                  also have " = 0" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (2,3)" by simp
                  finally show ?thesis using i2 j3 by simp
                qed
              qed
            qed
          qed
        next
          assume i3:"i = 3"
          show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
          next
            assume j0:"j = 0"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "(control2 U * ((control2 U))) $$ (3,0) = 
                    (control2 U) $$ (3,0) * ((control2 U)) $$ (0,0) +
                    (control2 U) $$ (3,1) * ((control2 U)) $$ (1,0) +
                    (control2 U) $$ (3,2) * ((control2 U)) $$ (2,0) +
                    (control2 U) $$ (3,3) * ((control2 U)) $$ (3,0)"
                using times_mat_def sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger i3 i4 index_matrix_prod j0 j4)
              also have " = (control2 U) $$ (3,1) * ((control2 U)) $$ (1,0) + 
                            (control2 U) $$ (3,3) * ((control2 U)) $$ (3,0)"
                using control2_def index_mat_of_cols_list by force
              also have " = (control2 U) $$ (3,1) * (cnj ((control2 U) $$ (0,1))) + 
                            (control2 U) $$ (3,3) * (cnj ((control2 U) $$ (0,3)))"
                using dagger_def Tensor.mat_of_cols_list_def control2_def by auto
              also have " = (control2 U) $$ (3,1) * (cnj 0) +
                            (control2 U) $$ (3,3) * (cnj 0)"
                using control2_def index_mat_of_cols_list by simp
              also have " = 0" by auto
              also have " = 1m 4 $$ (3,0)" by simp
              finally show ?thesis using i3 j0 by simp
            qed
          next
            assume jl3:"j = 1  j = 2  j = 3"
            show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 1  j = 2  j = 3" using jl3 by this
            next
              assume j1:"j = 1"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "(control2 U * ((control2 U))) $$ (3,1) = 
                    (control2 U) $$ (3,0) * ((control2 U)) $$ (0,1) +
                    (control2 U) $$ (3,1) * ((control2 U)) $$ (1,1) +
                    (control2 U) $$ (3,2) * ((control2 U)) $$ (2,1) +
                    (control2 U) $$ (3,3) * ((control2 U)) $$ (3,1)"
                  using times_mat_def sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                      dim_row_of_dagger i3 i4 index_matrix_prod j1 j4)
                also have " = (control2 U) $$ (3,1) * ((control2 U)) $$ (1,1) + 
                              (control2 U) $$ (3,3) * ((control2 U)) $$ (3,1)"
                  using control2_def index_mat_of_cols_list by force
                also have " = (control2 U) $$ (3,1) * (cnj ((control2 U) $$ (1,1))) + 
                              (control2 U) $$ (3,3) * (cnj ((control2 U) $$ (1,3)))"
                  using dagger_def Tensor.mat_of_cols_list_def control2_def by auto
                also have " = U $$ (1,0) * (cnj (U $$ (0,0))) +
                            U $$ (1,1) * (cnj (U $$ (0,1)))"
                  using control2_def index_mat_of_cols_list by simp
                also have " = (U $$ (1,0)) * ((U) $$ (0,0)) +
                            (U $$ (1,1)) * ((U) $$ (1,0))"
                  using dagger_def assms(1) gate_def by force
                also have " = (U * (U)) $$ (1,0)" 
                  using times_mat_def assms(1) gate_carrier_mat sumof2
                  by (smt (z3) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) dim_row_of_dagger 
                      gate.dim_row index_matrix_prod lessI pos2 power_one_right)
                also have " = (1m 2) $$ (1,0)" using assms(1) gate_def unitary_def by auto
                also have " = 0" by auto
                also have " = 1m 4 $$ (3,1)" by simp
                finally show ?thesis using i3 j1 by simp
              qed
            next
              assume jl2:"j = 2  j = 3"
              show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
              proof (rule disjE)
                show "j = 2  j = 3" using jl2 by this
              next
                assume j2:"j = 2"
                show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "(control2 U * ((control2 U))) $$ (3,2) = 
                    (control2 U) $$ (3,0) * ((control2 U)) $$ (0,2) +
                    (control2 U) $$ (3,1) * ((control2 U)) $$ (1,2) +
                    (control2 U) $$ (3,2) * ((control2 U)) $$ (2,2) +
                    (control2 U) $$ (3,3) * ((control2 U)) $$ (3,2)"
                    using times_mat_def sumof4
                    by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                        dim_row_of_dagger i3 i4 index_matrix_prod j2 j4)
                  also have " = (control2 U) $$ (3,1) * ((control2 U)) $$ (1,2) + 
                                (control2 U) $$ (3,3) * ((control2 U)) $$ (3,2)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = (control2 U) $$ (3,1) * (cnj ((control2 U) $$ (2,1))) + 
                                (control2 U) $$ (3,3) * (cnj ((control2 U) $$ (2,3)))"
                    using dagger_def Tensor.mat_of_cols_list_def control2_def by auto
                  also have " = (control2 U) $$ (3,1) * (cnj 0) +
                                (control2 U) $$ (3,3) * (cnj 0)"
                    using control2_def index_mat_of_cols_list by simp
                  also have " = 0" by auto
                  also have " = 1m 4 $$ (3,2)" by simp
                  finally show ?thesis using i3 j2 by simp
                qed
              next
                assume j3:"j = 3"
                show "(control2 U * ((control2 U))) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "(control2 U * ((control2 U))) $$ (3,3) = 
                    (control2 U) $$ (3,0) * ((control2 U)) $$ (0,3) +
                    (control2 U) $$ (3,1) * ((control2 U)) $$ (1,3) +
                    (control2 U) $$ (3,2) * ((control2 U)) $$ (2,3) +
                    (control2 U) $$ (3,3) * ((control2 U)) $$ (3,3)"
                    using times_mat_def sumof4
                    by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                        dim_row_of_dagger i3 i4 index_matrix_prod j3 j4)
                  also have " = (control2 U) $$ (3,1) * ((control2 U)) $$ (1,3) + 
                                (control2 U) $$ (3,3) * ((control2 U)) $$ (3,3)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = (control2 U) $$ (3,1) * (cnj ((control2 U) $$ (3,1))) + 
                                (control2 U) $$ (3,3) * (cnj ((control2 U) $$ (3,3)))"
                    using dagger_def Tensor.mat_of_cols_list_def control2_def by auto
                  also have " = U $$ (1,0) * (cnj (U $$ (1,0))) +
                              U $$ (1,1) * (cnj (U $$ (1,1)))"
                    using control2_def index_mat_of_cols_list by simp
                  also have " = (U $$ (1,0)) * ((U) $$ (0,1)) +
                              (U $$ (1,1)) * ((U) $$ (1,1))"
                    using dagger_def assms(1) gate_def by force
                  also have " = (U * (U)) $$ (1,1)" 
                    using times_mat_def assms(1) gate_carrier_mat sumof2
                    by (smt (z3) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) dim_row_of_dagger 
                        gate.dim_row index_matrix_prod lessI pos2 power_one_right)
                  also have " = (1m 2) $$ (1,1)" using assms(1) gate_def unitary_def by auto
                  also have " = 1" by auto
                  also have " = 1m 4 $$ (3,3)" by simp
                  finally show ?thesis using i3 j3 by simp
                qed
              qed
            qed
          qed
        qed
      qed
    qed
  qed
next
  show "dim_row (control2 U * ((control2 U))) = dim_row (1m 4)"
    by (metis carrier_matD(1) control2_carrier_mat index_mult_mat(2) index_one_mat(2))
next
  show "dim_col (control2 U * ((control2 U))) = dim_col (1m 4)"
    by (metis carrier_matD(1) control2_carrier_mat dim_col_of_dagger index_mult_mat(3) 
        index_one_mat(3))
qed

lemma control2_inv':
  assumes "gate 1 U"
  shows "(control2 U) * (control2 U) = 1m 4"
proof
  show "i j. i < dim_row (1m 4)  j < dim_col (1m 4) 
           ((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
  proof -
    fix i j
    assume "i < dim_row (1m 4)"
    hence i4:"i < 4" by auto
    assume "j < dim_col (1m 4)"
    hence j4:"j < 4" by auto
    show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
    proof (rule disjE)
      show "i = 0  i = 1  i = 2  i = 3" using i4 by auto
    next
      assume i0:"i = 0"
      show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
      proof (rule disjE)
        show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
      next
        assume j0:"j = 0"
        show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
        proof -
          have "((control2 U) * control2 U) $$ (0,0) =
                ((control2 U)) $$ (0,0) * (control2 U) $$ (0,0) +
                ((control2 U)) $$ (0,1) * (control2 U) $$ (1,0) +
                ((control2 U)) $$ (0,2) * (control2 U) $$ (2,0) +
                ((control2 U)) $$ (0,3) * (control2 U) $$ (3,0)"
            using sumof4
            by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                dim_col_of_dagger dim_row_of_dagger i0 i4 index_matrix_prod)
          also have " = ((control2 U)) $$ (0,0)"
            using control2_def index_mat_of_cols_list by force
          also have " = cnj ((control2 U) $$ (0,0))"
            using dagger_def
            by (simp add: Tensor.mat_of_cols_list_def control2_def)
          also have " = 1" using control2_def index_mat_of_cols_list by auto
          also have " = 1m 4 $$ (0,0)" by simp
          finally show ?thesis using i0 j0 by simp
        qed
      next
        assume jl3:"j = 1  j = 2  j = 3"
        show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show "j = 1  j = 2  j = 3" using jl3 by this
        next
          assume j1:"j = 1"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof -
            have "((control2 U) * control2 U) $$ (0,1) =
                ((control2 U)) $$ (0,0) * (control2 U) $$ (0,1) +
                ((control2 U)) $$ (0,1) * (control2 U) $$ (1,1) +
                ((control2 U)) $$ (0,2) * (control2 U) $$ (2,1) +
                ((control2 U)) $$ (0,3) * (control2 U) $$ (3,1)"
              using sumof4
              by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                  dim_row_of_dagger index_matrix_prod one_less_numeral_iff semiring_norm(76) 
                  zero_less_numeral)
            also have " = ((control2 U)) $$ (0,1) * (control2 U) $$ (1,1) +
                            ((control2 U)) $$ (0,3) * (control2 U) $$ (3,1)"
              using control2_def index_mat_of_cols_list by force
            also have " = cnj ((control2 U) $$ (1,0)) * (control2 U) $$ (1,1) +
                            cnj ((control2 U) $$ (3,0)) * (control2 U) $$ (3,1)"
              using dagger_def
              by (simp add: Tensor.mat_of_cols_list_def control2_def)
            also have " = 0" using control2_def index_mat_of_cols_list by auto
            also have " = 1m 4 $$ (0,1)" by simp
            finally show ?thesis using i0 j1 by simp
          qed
        next
          assume jl2:"j = 2  j = 3"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 2  j = 3" using jl2 by this
          next
            assume j2:"j = 2"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "((control2 U) * control2 U) $$ (0,2) =
                ((control2 U)) $$ (0,0) * (control2 U) $$ (0,2) +
                ((control2 U)) $$ (0,1) * (control2 U) $$ (1,2) +
                ((control2 U)) $$ (0,2) * (control2 U) $$ (2,2) +
                ((control2 U)) $$ (0,3) * (control2 U) $$ (3,2)"
                using sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger index_matrix_prod j2 j4 zero_less_numeral)
              also have " = ((control2 U)) $$ (0,2)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (2,0))"
                using dagger_def
                by (simp add: Tensor.mat_of_cols_list_def control2_def)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (0,2)" by simp
              finally show ?thesis using i0 j2 by simp
            qed
          next
            assume j3:"j = 3"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "((control2 U) * control2 U) $$ (0,3) =
                ((control2 U)) $$ (0,0) * (control2 U) $$ (0,3) +
                ((control2 U)) $$ (0,1) * (control2 U) $$ (1,3) +
                ((control2 U)) $$ (0,2) * (control2 U) $$ (2,3) +
                ((control2 U)) $$ (0,3) * (control2 U) $$ (3,3)"
                using sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger index_matrix_prod j3 j4 zero_less_numeral)
              also have " = ((control2 U)) $$ (0,1) * (control2 U) $$ (1,3) +
                              ((control2 U)) $$ (0,3) * (control2 U) $$ (3,3)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (1,0)) * (control2 U) $$ (1,3) +
                              cnj ((control2 U) $$ (3,0)) * (control2 U) $$ (3,3)"
                using dagger_def
                by (simp add: Tensor.mat_of_cols_list_def control2_def)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (0,3)" by simp
              finally show ?thesis using i0 j3 by simp
            qed
          qed
        qed
      qed
    next
      assume il3:"i = 1  i = 2  i = 3"
      show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
      proof (rule disjE)
        show "i = 1  i = 2  i = 3" using il3 by this
      next
        assume i1:"i = 1"
        show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
        next
          assume j0:"j = 0"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof -
            have "((control2 U) * control2 U) $$ (1,0) =
                ((control2 U)) $$ (1,0) * (control2 U) $$ (0,0) +
                ((control2 U)) $$ (1,1) * (control2 U) $$ (1,0) +
                ((control2 U)) $$ (1,2) * (control2 U) $$ (2,0) +
                ((control2 U)) $$ (1,3) * (control2 U) $$ (3,0)"
              using sumof4
              by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                  dim_row_of_dagger index_matrix_prod one_less_numeral_iff semiring_norm(76) 
                  zero_less_numeral)
            also have " = ((control2 U)) $$ (1,0)"
              using control2_def index_mat_of_cols_list by force
            also have " = cnj ((control2 U) $$ (0,1))"
              using dagger_def
              by (simp add: Tensor.mat_of_cols_list_def control2_def)
            also have " = 0" using control2_def index_mat_of_cols_list by auto
            also have " = 1m 4 $$ (1,0)" by simp
            finally show ?thesis using i1 j0 by simp
          qed
        next
          assume jl3:"j = 1  j = 2  j = 3"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 1  j = 2  j = 3" using jl3 by this
          next
            assume j1:"j = 1"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "((control2 U) * control2 U) $$ (1,1) =
                ((control2 U)) $$ (1,0) * (control2 U) $$ (0,1) +
                ((control2 U)) $$ (1,1) * (control2 U) $$ (1,1) +
                ((control2 U)) $$ (1,2) * (control2 U) $$ (2,1) +
                ((control2 U)) $$ (1,3) * (control2 U) $$ (3,1)"
                using sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger 
                    dim_row_of_dagger index_matrix_prod one_less_numeral_iff semiring_norm(76) 
                    zero_less_numeral)
              also have " = ((control2 U)) $$ (1,1) * (control2 U) $$ (1,1) +
                              ((control2 U)) $$ (1,3) * (control2 U) $$ (3,1)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (1,1)) * (control2 U) $$ (1,1) +
                              cnj ((control2 U) $$ (3,1)) * (control2 U) $$ (3,1)"
                using dagger_def
                by (simp add: Tensor.mat_of_cols_list_def control2_def)
              also have " = cnj (U $$ (0,0)) * (U $$ (0,0)) +
                              cnj (U $$ (1,0)) * (U $$ (1,0))"
                using control2_def index_mat_of_cols_list by simp
              also have " = ((U) * U) $$ (0,0)"
                using times_mat_def sumof2 assms(1) gate_carrier_mat
                by (smt (verit, del_insts) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) 
                    dim_row_of_dagger gate.dim_row index_mat(1) index_matrix_prod lessI 
                    old.prod.case pos2 power_one_right)
              also have " = (1m 2) $$ (0,0)" using assms(1) gate_def unitary_def by auto
              also have " = 1" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (1,1)" by simp
              finally show ?thesis using i1 j1 by simp
            qed
          next
            assume jl2:"j = 2  j = 3"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 2  j = 3" using jl2 by this
            next
              assume j2:"j = 2"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "((control2 U) * control2 U) $$ (1,2) =
                ((control2 U)) $$ (1,0) * (control2 U) $$ (0,2) +
                ((control2 U)) $$ (1,1) * (control2 U) $$ (1,2) +
                ((control2 U)) $$ (1,2) * (control2 U) $$ (2,2) +
                ((control2 U)) $$ (1,3) * (control2 U) $$ (3,2)"
                  using sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                      dim_col_of_dagger dim_row_of_dagger index_matrix_prod j2 j4 
                      one_less_numeral_iff semiring_norm(76))
                also have " = ((control2 U)) $$ (1,2)"
                  using control2_def index_mat_of_cols_list by force
                also have " = cnj ((control2 U) $$ (2,1))"
                  using dagger_def
                  by (simp add: Tensor.mat_of_cols_list_def control2_def)
                also have " = 0" using control2_def index_mat_of_cols_list by auto
                also have " = 1m 4 $$ (1,2)" by simp
                finally show ?thesis using i1 j2 by simp
              qed
            next
              assume j3:"j = 3"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "((control2 U) * control2 U) $$ (1,3) =
                ((control2 U)) $$ (1,0) * (control2 U) $$ (0,3) +
                ((control2 U)) $$ (1,1) * (control2 U) $$ (1,3) +
                ((control2 U)) $$ (1,2) * (control2 U) $$ (2,3) +
                ((control2 U)) $$ (1,3) * (control2 U) $$ (3,3)"
                  using sumof4
                  by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) 
                      control2_carrier_mat dim_col_of_dagger dim_row_of_dagger i1 i4 
                      index_matrix_prod j3 j4)
                also have " = ((control2 U)) $$ (1,1) * (control2 U) $$ (1,3) +
                                ((control2 U)) $$ (1,3) * (control2 U) $$ (3,3)"
                  using control2_def index_mat_of_cols_list by force
                also have " = cnj ((control2 U) $$ (1,1)) * (control2 U) $$ (1,3) +
                                cnj ((control2 U) $$ (3,1)) * (control2 U) $$ (3,3)"
                  using dagger_def
                  by (simp add: Tensor.mat_of_cols_list_def control2_def)
                also have " = cnj (U $$ (0,0)) * (U $$ (0,1)) +
                                cnj (U $$ (1,0)) * (U $$ (1,1))"
                  using control2_def index_mat_of_cols_list by simp
                also have " = ((U) * U) $$ (0,1)"
                  using times_mat_def sumof2 assms(1) gate_carrier_mat
                  by (smt (verit, del_insts) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) 
                      dim_row_of_dagger gate.dim_row index_mat(1) index_matrix_prod lessI 
                      old.prod.case pos2 power_one_right)
                also have " = (1m 2) $$ (0,1)" using assms(1) gate_def unitary_def by auto
                also have " = 0" using control2_def index_mat_of_cols_list by auto
                also have " = 1m 4 $$ (1,3)" by simp
                finally show ?thesis using i1 j3 by simp
              qed
            qed
          qed
        qed
      next
        assume il2:"i = 2  i = 3"
        show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
        proof (rule disjE)
          show "i = 2  i = 3" using il2 by this
        next
          assume i2:"i = 2"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
          next
            assume j0:"j = 0"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "((control2 U) * control2 U) $$ (2,0) =
                ((control2 U)) $$ (2,0) * (control2 U) $$ (0,0) +
                ((control2 U)) $$ (2,1) * (control2 U) $$ (1,0) +
                ((control2 U)) $$ (2,2) * (control2 U) $$ (2,0) +
                ((control2 U)) $$ (2,3) * (control2 U) $$ (3,0)"
                using sumof4
                by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger
                    dim_row_of_dagger i2 i4 index_matrix_prod zero_less_numeral)
              also have " = ((control2 U)) $$ (2,0)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (0,2))"
                using dagger_def
                by (simp add: Tensor.mat_of_cols_list_def control2_def)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (2,0)" by simp
              finally show ?thesis using i2 j0 by simp
            qed
          next
            assume jl3:"j = 1  j = 2  j = 3"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 1  j = 2  j = 3" using jl3 by this
            next
              assume j1:"j = 1"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "((control2 U) * control2 U) $$ (2,1) =
                ((control2 U)) $$ (2,0) * (control2 U) $$ (0,1) +
                ((control2 U)) $$ (2,1) * (control2 U) $$ (1,1) +
                ((control2 U)) $$ (2,2) * (control2 U) $$ (2,1) +
                ((control2 U)) $$ (2,3) * (control2 U) $$ (3,1)"
                  using sumof4
                  by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                      dim_col_of_dagger dim_row_of_dagger i2 i4 index_matrix_prod 
                      one_less_numeral_iff semiring_norm(76))
                also have " = ((control2 U)) $$ (2,1) * (control2 U) $$ (1,1) +
                                ((control2 U)) $$ (2,3) * (control2 U) $$ (3,1)"
                  using control2_def index_mat_of_cols_list by force
                also have " = cnj ((control2 U) $$ (1,2)) * (control2 U) $$ (1,1) +
                                cnj ((control2 U) $$ (3,2)) * (control2 U) $$ (3,1)"
                  using dagger_def
                  by (simp add: Tensor.mat_of_cols_list_def control2_def)
                also have " = 0" using control2_def index_mat_of_cols_list by auto
                also have " = 1m 4 $$ (2,1)" by simp
                finally show ?thesis using i2 j1 by simp
              qed
            next
              assume jl2:"j = 2  j = 3"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof (rule disjE)
                show "j = 2  j = 3" using jl2 by this
              next
                assume j2:"j = 2"
                show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "((control2 U) * control2 U) $$ (2,2) =
                        ((control2 U)) $$ (2,0) * (control2 U) $$ (0,2) +
                        ((control2 U)) $$ (2,1) * (control2 U) $$ (1,2) +
                        ((control2 U)) $$ (2,2) * (control2 U) $$ (2,2) +
                        ((control2 U)) $$ (2,3) * (control2 U) $$ (3,2)"
                    using sumof4
                    by (smt (z3) carrier_matD(1) carrier_matD(2) control2_carrier_mat dim_col_of_dagger
                        dim_row_of_dagger i2 i4 index_matrix_prod zero_less_numeral)
                  also have " = ((control2 U)) $$ (2,2)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (2,2))"
                    using dagger_def
                    by (simp add: Tensor.mat_of_cols_list_def control2_def)
                  also have " = 1" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (2,2)" by simp
                  finally show ?thesis using i2 j2 by simp
                qed
              next
                assume j3:"j = 3"
                show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "((control2 U) * control2 U) $$ (2,3) =
                        ((control2 U)) $$ (2,0) * (control2 U) $$ (0,3) +
                        ((control2 U)) $$ (2,1) * (control2 U) $$ (1,3) +
                        ((control2 U)) $$ (2,2) * (control2 U) $$ (2,3) +
                        ((control2 U)) $$ (2,3) * (control2 U) $$ (3,3)"
                    using sumof4
                    by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) 
                        control2_carrier_mat dim_col_of_dagger dim_row_of_dagger i2 i4 
                        index_matrix_prod j3 j4)
                  also have " = ((control2 U)) $$ (2,1) * (control2 U) $$ (1,3) +
                                  ((control2 U)) $$ (2,3) * (control2 U) $$ (3,3)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (1,2)) * (control2 U) $$ (1,3) +
                                  cnj ((control2 U) $$ (3,2)) * (control2 U) $$ (3,3)"
                    using dagger_def
                    by (simp add: Tensor.mat_of_cols_list_def control2_def)
                  also have " = 0" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (2,3)" by simp
                  finally show ?thesis using i2 j3 by simp
                qed
              qed
            qed
          qed
        next
          assume i3:"i = 3"
          show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
          proof (rule disjE)
            show "j = 0  j = 1  j = 2  j = 3" using j4 by auto
          next
            assume j0:"j = 0"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof -
              have "((control2 U) * control2 U) $$ (3,0) =
                ((control2 U)) $$ (3,0) * (control2 U) $$ (0,0) +
                ((control2 U)) $$ (3,1) * (control2 U) $$ (1,0) +
                ((control2 U)) $$ (3,2) * (control2 U) $$ (2,0) +
                ((control2 U)) $$ (3,3) * (control2 U) $$ (3,0)"
                using sumof4
                by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                    dim_col_of_dagger dim_row_of_dagger i3 i4 index_matrix_prod j0 j4)
              also have " = ((control2 U)) $$ (3,0)"
                using control2_def index_mat_of_cols_list by force
              also have " = cnj ((control2 U) $$ (0,3))"
                using dagger_def
                by (simp add: Tensor.mat_of_cols_list_def control2_def)
              also have " = 0" using control2_def index_mat_of_cols_list by auto
              also have " = 1m 4 $$ (3,0)" by simp
              finally show ?thesis using i3 j0 by simp
            qed
          next
            assume jl3:"j = 1  j = 2  j = 3"
            show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
            proof (rule disjE)
              show "j = 1  j = 2  j = 3" using jl3 by this
            next
              assume j1:"j = 1"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof -
                have "((control2 U) * control2 U) $$ (3,1) =
                ((control2 U)) $$ (3,0) * (control2 U) $$ (0,1) +
                ((control2 U)) $$ (3,1) * (control2 U) $$ (1,1) +
                ((control2 U)) $$ (3,2) * (control2 U) $$ (2,1) +
                ((control2 U)) $$ (3,3) * (control2 U) $$ (3,1)"
                  using sumof4
                  by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) 
                      control2_carrier_mat dim_col_of_dagger dim_row_of_dagger i3 i4 
                      index_matrix_prod j1 j4)
                also have " = ((control2 U)) $$ (3,1) * (control2 U) $$ (1,1) +
                                ((control2 U)) $$ (3,3) * (control2 U) $$ (3,1)"
                  using control2_def index_mat_of_cols_list by force
                also have " = cnj ((control2 U) $$ (1,3)) * (control2 U) $$ (1,1) +
                                cnj ((control2 U) $$ (3,3)) * (control2 U) $$ (3,1)"
                  using dagger_def
                  by (simp add: Tensor.mat_of_cols_list_def control2_def)
                also have " = cnj (U $$ (0,1)) * (U $$ (0,0)) +
                                cnj (U $$ (1,1)) * (U $$ (1,0))"
                  using control2_def index_mat_of_cols_list by simp
                also have " = ((U) * U) $$ (1,0)"
                  using times_mat_def sumof2 assms(1) gate_carrier_mat
                  by (smt (verit, del_insts) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) 
                      dim_row_of_dagger gate.dim_row index_mat(1) index_matrix_prod lessI 
                      old.prod.case pos2 power_one_right)
                also have " = (1m 2) $$ (1,0)" using assms(1) gate_def unitary_def by auto
                also have " = 0" using control2_def index_mat_of_cols_list by auto
                also have " = 1m 4 $$ (3,1)" by simp
                finally show ?thesis using i3 j1 by simp
              qed
            next
              assume jl2:"j = 2  j = 3"
              show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
              proof (rule disjE)
                show "j = 2  j = 3" using jl2 by this
              next
                assume j2:"j = 2"
                show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "((control2 U) * control2 U) $$ (3,2) =
                        ((control2 U)) $$ (3,0) * (control2 U) $$ (0,2) +
                        ((control2 U)) $$ (3,1) * (control2 U) $$ (1,2) +
                        ((control2 U)) $$ (3,2) * (control2 U) $$ (2,2) +
                        ((control2 U)) $$ (3,3) * (control2 U) $$ (3,2)"
                    using sumof4
                    by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) control2_carrier_mat 
                        dim_col_of_dagger dim_row_of_dagger i3 i4 index_matrix_prod j2 j4)
                  also have " = ((control2 U)) $$ (3,2)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (2,3))"
                    using dagger_def
                    by (simp add: Tensor.mat_of_cols_list_def control2_def)
                  also have " = 0" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (3,2)" by simp
                  finally show ?thesis using i3 j2 by simp
                qed
              next
                assume j3:"j = 3"
                show "((control2 U) * control2 U) $$ (i, j) = 1m 4 $$ (i, j)"
                proof -
                  have "((control2 U) * control2 U) $$ (3,3) =
                        ((control2 U)) $$ (3,0) * (control2 U) $$ (0,3) +
                        ((control2 U)) $$ (3,1) * (control2 U) $$ (1,3) +
                        ((control2 U)) $$ (3,2) * (control2 U) $$ (2,3) +
                        ((control2 U)) $$ (3,3) * (control2 U) $$ (3,3)"
                    using sumof4
                    by (metis (no_types, lifting) carrier_matD(1) carrier_matD(2) 
                        control2_carrier_mat dim_col_of_dagger dim_row_of_dagger i3 
                        index_matrix_prod j3 j4)
                  also have " = ((control2 U)) $$ (3,1) * (control2 U) $$ (1,3) +
                                  ((control2 U)) $$ (3,3) * (control2 U) $$ (3,3)"
                    using control2_def index_mat_of_cols_list by force
                  also have " = cnj ((control2 U) $$ (1,3)) * (control2 U) $$ (1,3) +
                                  cnj ((control2 U) $$ (3,3)) * (control2 U) $$ (3,3)"
                    using dagger_def
                    by (simp add: Tensor.mat_of_cols_list_def control2_def)
                  also have " = cnj (U $$ (0,1)) * (U $$ (0,1)) +
                                  cnj (U $$ (1,1)) * (U $$ (1,1))"
                    using control2_def index_mat_of_cols_list by simp
                  also have " = ((U) * U) $$ (1,1)"
                    using times_mat_def sumof2 assms(1) gate_carrier_mat
                    by (smt (verit, del_insts) Suc_1 carrier_matD(2) dagger_def dim_col_mat(1) 
                        dim_row_of_dagger gate.dim_row index_mat(1) index_matrix_prod lessI 
                        old.prod.case pos2 power_one_right)
                  also have " = (1m 2) $$ (1,1)" using assms(1) gate_def unitary_def by auto
                  also have " = 1" using control2_def index_mat_of_cols_list by auto
                  also have " = 1m 4 $$ (3,3)" by simp
                  finally show ?thesis using i3 j3 by simp
                qed
              qed
            qed
          qed
        qed
      qed
    qed
  qed
next
  show "dim_row ((control2 U) * control2 U) = dim_row (1m 4)"
    by (metis carrier_matD(2) control2_carrier_mat dim_row_of_dagger 
        index_mult_mat(2) index_one_mat(2))
next
  show "dim_col ((control2 U) * control2 U) = dim_col (1m 4)"
    by (metis carrier_matD(2) control2_carrier_mat index_mult_mat(3) 
        index_one_mat(3))
qed

lemma control2_is_gate:
  assumes "gate 1 U"
  shows "gate 2 (control2 U)"
proof
  show "dim_row (control2 U) = 2^2" using control2_carrier_mat 
    by (simp add: Tensor.mat_of_cols_list_def control2_def)
next
  show "square_mat (control2 U)"
    by (metis carrier_matD(1) carrier_matD(2) control2_carrier_mat square_mat.elims(3))
next
  show "unitary (control2 U)" 
    using control2_inv control2_inv' unitary_def
    by (metis assms carrier_matD(1) carrier_matD(2) control2_carrier_mat)
qed

lemma SWAP_down_is_gate:
  shows "gate n (SWAP_down n)"
proof (induct n rule: SWAP_down.induct)
  case 1
  then show ?case
    by (metis Quantum.Id_def SWAP_down.simps(1) SWAP_up.simps(1) SWAP_up_carrier_mat 
        carrier_matD(2) id_is_gate index_one_mat(3))
next
  case 2
  then show ?case
    by (metis H_inv H_is_gate One_nat_def SWAP_down.simps(2) prod_of_gate_is_gate)
next
  case 3
  then show ?case
    by (metis One_nat_def SWAP_down.simps(3) SWAP_is_gate Suc_1)
next
  case (4 v)
  then show ?case
  proof -
    assume HI:"gate (Suc (Suc v)) (SWAP_down (Suc (Suc v)))"
    show "gate (Suc (Suc (Suc v))) (SWAP_down (Suc (Suc (Suc v))))"
    proof -
      have "gate (Suc (Suc (Suc v))) (((1m (2^Suc v))  SWAP) * 
                                      ((SWAP_down (Suc (Suc v)))  (1m 2)))"
      proof (rule prod_of_gate_is_gate)
        show "gate (Suc (Suc (Suc v))) (1m (2 ^ Suc v)  SWAP)"
          using SWAP_is_gate tensor_gate
          by (metis Quantum.Id_def add_2_eq_Suc' id_is_gate)
      next
        show "gate (Suc (Suc (Suc v))) (SWAP_down (Suc (Suc v))  1m 2)"
          using HI tensor_gate
          by (metis Suc_eq_plus1 Y_inv Y_is_gate prod_of_gate_is_gate)
      qed
      thus ?thesis using SWAP_down.simps by auto
    qed
  qed
qed

lemma SWAP_up_is_gate:
  shows "gate n (SWAP_up n)"
proof (induct n rule: SWAP_up.induct)
  case 1
  then show ?case using id_is_gate SWAP_up.simps
    by (metis SWAP_down.simps(1) SWAP_down_is_gate)
next
  case 2
  then show ?case
    by (metis SWAP_down.simps(2) SWAP_down_is_gate SWAP_up.simps(2))
next
  case 3
  then show ?case 
    by (metis One_nat_def SWAP_is_gate SWAP_up.simps(3) Suc_1)
next
  case (4 v)
  then show ?case
  proof -
    assume HI:"gate (Suc (Suc v)) (SWAP_up (Suc (Suc v)))"
    show "gate (Suc (Suc (Suc v))) (SWAP_up (Suc (Suc (Suc v))))"
    proof -
      have "gate (Suc (Suc (Suc v))) ((SWAP  (1m (2^(Suc v)))) * ((1m 2)  
                                      (SWAP_up (Suc (Suc v)))))"
      proof (rule prod_of_gate_is_gate)
        show "gate (Suc (Suc (Suc v))) (SWAP  1m (2 ^ Suc v))"
          using tensor_gate SWAP_is_gate
          by (metis Quantum.Id_def add_2_eq_Suc id_is_gate)
      next
        show "gate (Suc (Suc (Suc v))) (1m 2  SWAP_up (Suc (Suc v)))"
          using tensor_gate HI 
          by (metis One_nat_def SWAP_down.simps(2) SWAP_down_is_gate plus_1_eq_Suc)
      qed
      thus ?thesis using SWAP_up.simps(3) by simp
    qed
  qed
qed

lemma control_is_gate:
  assumes "gate 1 U"
  shows "gate n (control n U)"
proof (cases n)
  case 0
  then show ?thesis
    by (metis SWAP_up.simps(1) SWAP_up_is_gate control.simps(1))
next
  case (Suc nat)
  then show ?thesis
  proof -
    assume nnat:"n = Suc nat"
    show "gate n (control n U)"
    proof -
      have "gate (Suc nat) (control (Suc nat) U)"
      proof (cases nat)
        case 0
        then show ?thesis 
          by (simp add: gate_def)
      next
        case (Suc nata)
        then show ?thesis
        proof -
          assume nnat_:"nat = Suc nata"
          show "gate (Suc nat) (control (Suc nat) U)"
          proof -
            have "gate (Suc (Suc nata)) (control (Suc (Suc nata)) U)"
            proof (cases nata)
              case 0
              then show ?thesis
                using One_nat_def Suc_1 assms control.simps(3) control2_is_gate by presburger
            next
              case (Suc natb)
              then show ?thesis
              proof -
                assume nnatb:"nata = Suc natb"
                show "gate (Suc (Suc nata)) (control (Suc (Suc nata)) U)"
                proof -
                  have "gate (Suc (Suc (Suc natb))) (control (Suc (Suc (Suc natb))) U)"
                  proof -
                    have "gate (Suc (Suc (Suc natb))) (((1m 2)  SWAP_down (Suc (Suc natb))) * 
                        (control2 U  (1m (2^(Suc natb)))) * ((1m 2)  SWAP_up (Suc (Suc natb))))"
                    proof (rule prod_of_gate_is_gate)+
                      show "gate (Suc (Suc (Suc natb))) (1m 2  SWAP_down (Suc (Suc natb)))"
                        using SWAP_down_is_gate id_is_gate tensor_gate
                        by (metis One_nat_def SWAP_up.simps(2) SWAP_up_is_gate plus_1_eq_Suc)
                    next
                      show "gate (Suc (Suc (Suc natb))) (control2 U  1m (2 ^ Suc natb))"
                        using control2_is_gate id_is_gate tensor_gate
                        by (metis Quantum.Id_def add_2_eq_Suc assms)
                    next
                      show "gate (Suc (Suc (Suc natb))) (1m 2  SWAP_up (Suc (Suc natb)))"
                        using SWAP_up_is_gate id_is_gate tensor_gate
                        by (metis Y_inv Y_is_gate plus_1_eq_Suc prod_of_gate_is_gate)
                    qed
                    thus ?thesis using control.simps by simp
                  qed
                  thus ?thesis using nnatb by simp
                qed
              qed
            qed
            thus ?thesis using nnat_ by simp
          qed
        qed
      qed
      thus ?thesis using nnat by simp
    qed
  qed
qed

lemma controlled_rotations_is_gate:
  shows "gate n (controlled_rotations n)"
proof (induct n rule: controlled_rotations.induct)
  case 1
  then show ?case 
    by (metis SWAP_down.simps(1) SWAP_down_is_gate controlled_rotations.simps(1))
next
  case 2
  then show ?case 
    by (metis SWAP_down.simps(2) SWAP_down_is_gate controlled_rotations.simps(2))
next
  case (3 v)
  then show ?case
  proof -
    assume HI:"gate (Suc v) (controlled_rotations (Suc v))"
    show "gate (Suc (Suc v)) (controlled_rotations (Suc (Suc v)))"
    proof -
      have "gate (Suc (Suc v)) ((control (Suc (Suc v)) (R (Suc (Suc v)))) * 
                               ((controlled_rotations (Suc v))  (1m 2)))"
      proof (rule prod_of_gate_is_gate)
        show "gate (Suc (Suc v)) (control (Suc (Suc v)) (R (Suc (Suc v))))"
          using control_is_gate R_is_gate by blast
      next
        show "gate (Suc (Suc v)) (controlled_rotations (Suc v)  1m 2)"
          using tensor_gate HI id_is_gate 
          by (metis One_nat_def SWAP_up.simps(2) SWAP_up_is_gate Suc_eq_plus1)
      qed
      thus ?thesis using controlled_rotations.simps by simp
    qed
  qed
qed

theorem QFT_is_gate:
  shows "gate n (QFT n)"
proof (induction n rule: QFT.induct)
  case 1
  then show ?case
    by (metis QFT.simps(1) controlled_rotations.simps(1) controlled_rotations_is_gate)
next
  case 2
  then show ?case
    using H_is_gate by auto
next
  case (3 v)
  then show ?case
  proof -
    assume HI:"gate (Suc v) (QFT (Suc v))"
    show "gate (Suc (Suc v)) (QFT (Suc (Suc v)))"
    proof -
      have "gate (Suc (Suc v)) (((1m 2)  (QFT (Suc v))) * 
                                (controlled_rotations (Suc (Suc v))) * (H  ((1m (2^Suc v)))))"
      proof (rule prod_of_gate_is_gate)+
        show "gate (Suc (Suc v)) (1m 2  QFT (Suc v))"
          using HI tensor_gate id_is_gate
          by (metis One_nat_def controlled_rotations.simps(2) controlled_rotations_is_gate 
              plus_1_eq_Suc)
        show "gate (Suc (Suc v)) (controlled_rotations (Suc (Suc v)))"
          using controlled_rotations_is_gate by metis
        show "gate (Suc (Suc v)) (H  1m (2 ^ Suc v))"
          using H_is_gate id_is_gate tensor_gate 
          by (metis Quantum.Id_def plus_1_eq_Suc)
      qed
      thus ?thesis using QFT.simps by simp
    qed
  qed
qed

corollary QFT_is_unitary:
  shows "unitary (QFT n)"
  using QFT_is_gate gate_def by simp

corollary reverse_product_rep_is_state:
  assumes "j < 2^n"
  shows "state n (reverse_QFT_product_representation j n)"
  using QFT_is_gate QFT_is_correct gate_on_state_is_state assms state_basis_is_state
  by (metis dim_col_mat(1) dim_row_mat(1) index_unit_vec(3) ket_vec_col ket_vec_def 
      state_basis_def state_def unit_cpx_vec_length)

lemma reverse_qubits_is_gate:
  shows "gate n (reverse_qubits n)"
proof (induct n rule: reverse_qubits.induct)
  case 1
  then show ?case 
    by (metis QFT.simps(1) QFT_is_gate reverse_qubits.simps(1))
next
  case 2
  then show ?case
    using Y_is_gate prod_of_gate_is_gate by fastforce
next
  case 3
  then show ?case
    using One_nat_def SWAP_is_gate Suc_1 reverse_qubits.simps(3) by presburger
next
  case (4 va)
  then show ?case
  proof -
    assume HI:"gate (Suc (Suc va)) (reverse_qubits (Suc (Suc va)))"
    show "gate (Suc (Suc (Suc va))) (reverse_qubits (Suc (Suc (Suc va))))"
    proof -
      have "gate (Suc (Suc (Suc va))) (((reverse_qubits (Suc (Suc va)))  (1m 2)) *
                                         (SWAP_down (Suc (Suc (Suc va)))))"
      proof (rule prod_of_gate_is_gate)
        show "gate (Suc (Suc (Suc va))) (reverse_qubits (Suc (Suc va))  1m 2)"
          using HI id_is_gate tensor_gate 
          by (metis One_nat_def Suc_eq_plus1 controlled_rotations.simps(2) 
              controlled_rotations_is_gate)
      next
        show "gate (Suc (Suc (Suc va))) (SWAP_down (Suc (Suc (Suc va))))"
          using SWAP_down_is_gate by metis
      qed
      thus ?thesis using reverse_qubits.simps by simp
    qed
  qed
qed

theorem ordered_QFT_is_gate:
  shows "gate n (ordered_QFT n)"
  using reverse_qubits_is_gate QFT_is_gate ordered_QFT_def prod_of_gate_is_gate by auto

corollary ordered_QFT_is_unitary:
  shows "unitary (ordered_QFT n)"
  using ordered_QFT_is_gate gate_def by simp

corollary product_rep_is_state:
  assumes "j < 2^n"
  shows "state n (QFT_product_representation j n)"
  using ordered_QFT_is_gate ordered_QFT_is_correct gate_on_state_is_state assms 
    state_basis_is_state
  by (metis reverse_product_rep_is_state reverse_qubits_is_gate 
      reverse_qubits_product_representation)

end