section \<open>Number theory problems\<close>

subsection \<open>IMO 2017 SL - N1\<close>

theory IMO_2017_SL_N1_sol
imports Complex_Main
begin

lemma square_mod_3:
  fixes x :: nat
  shows "(x * x) mod 3 = 0 \<longleftrightarrow> x mod 3 = 0"
proof
  assume "x * x mod 3 = 0"
  show "x mod 3 = 0"
  proof-
    from division_decomp[of 3 x x] \<open>x * x mod 3 = 0\<close>
    obtain b c where "b * c = 3" "b dvd x" "c dvd x"
      by auto
    have "b \<le> 3 \<and> c \<le> 3"
      using \<open>b * c = 3\<close>
      by (metis One_nat_def le_add1 mult_eq_if mult_le_mono mult_numeral_1_right numerals(1) one_le_mult_iff order_refl zero_neq_numeral)
    then have "b \<in> {0, 1, 2, 3} \<and> c \<in> {0, 1, 2, 3}"
      by auto
    then have "(b = 1 \<and> c = 3) \<or> (b = 3 \<and> c = 1)"
      using \<open>b * c = 3\<close>
      by auto
    then show ?thesis
      using \<open>b dvd x\<close> \<open>c dvd x\<close>
      by auto
  qed
next
  assume "x mod 3 = 0"
  then show "x * x mod 3 = 0"
    by auto
qed

lemma square_mod_3_not_2:
  fixes s :: nat
  shows "(s * s) mod 3 \<noteq> 2"
proof-
  {
    assume "s mod 3 = 0"
    then have ?thesis
      by auto
  }

  moreover

  {
    assume "s mod 3 = 1"
    then have ?thesis
      by (metis mod_mult_right_eq mult.right_neutral numeral_eq_one_iff semiring_norm(85))
  }

  moreover

  {
    assume "s mod 3 = 2"
    then have ?thesis
      by (metis add_2_eq_Suc' calculation(2) eq_numeral_Suc less_add_same_cancel1 mod_add_self2 mod_less mod_mult_right_eq mult.commute mult_2 plus_1_eq_Suc pos2 pred_numeral_simps(3))
  }

  ultimately
  show ?thesis
    by presburger
qed

lemma not_square_3:
  shows "\<not> (\<exists> s::nat. s * s = 3)"
  by (simp add: mult_eq_if)

lemma not_square_6:
  shows "\<not> (\<exists> s::nat. s * s = 6)"
  by (simp add: mult_eq_if)

lemma not_square_7:
  shows "\<not> (\<exists> s::nat. s * s = 7)"
  by (simp add: mult_eq_if)

lemma not_square_10:
  shows "\<not> (\<exists> s::nat. s * s = 10)"
  by (simp add: mult_eq_if)

lemma not_square_13:
  shows "\<not> (\<exists> s::nat. s * s = 13)"
  by (simp add: mult_eq_if)

lemma consecutive_squares_mod_3:
  fixes t :: nat
  shows "{(t + 1)\<^sup>2 mod 3, (t + 2)\<^sup>2 mod 3, (t + 3)\<^sup>2 mod 3} = {0, 1}"
proof-
  {
    assume "t mod 3 = 0"
    then obtain k where "t = 3 * k"
      by auto
    have "(t + 1)\<^sup>2 = 3*(3*k*k + 2*k) + 1"
      using \<open>t = 3 * k\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 1)\<^sup>2 mod 3 = 1"
      by presburger
    moreover
    have "(t + 2)\<^sup>2 = 3*(3*k*k + 4*k + 1) + 1"
      using \<open>t = 3 * k\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 2)\<^sup>2 mod 3 = 1"
      by presburger
    moreover
    have "(t + 3)\<^sup>2 = 3*(3*k*k + 6*k + 3)"
      using \<open>t = 3 * k\<close>
      unfolding power2_eq_square
      by (auto simp add: algebra_simps)
    then have "(t + 3)\<^sup>2 mod 3 = 0"
      by presburger
    ultimately
    have ?thesis
      by auto
  }
  moreover
  {
    assume "t mod 3 = 1"
    then obtain k where "t = 3 * k + 1"
      by (metis mult_div_mod_eq)
    have "(t + 1)\<^sup>2 = 3*(3*k*k + 4*k + 1) + 1"
      using \<open>t = 3 * k + 1\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 1)\<^sup>2 mod 3 = 1"
      by presburger
    moreover
    have "(t + 2)\<^sup>2 = 3*(3*k*k + 6*k + 3)"
      using \<open>t = 3 * k + 1\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 2)\<^sup>2 mod 3 = 0"
      by presburger
    moreover
    have "(t + 3)\<^sup>2 = 3*(3*k*k + 8*k+5) + 1"
      using \<open>t = 3 * k + 1\<close>
      unfolding power2_eq_square
      by (auto simp add: algebra_simps)
    then have "(t + 3)\<^sup>2 mod 3 = 1"
      by presburger
    ultimately
    have ?thesis
      by auto
  }
  moreover
  {
    assume "t mod 3 = 2"
    then obtain k where "t = 3 * k + 2"
      by (metis mult_div_mod_eq)
    have "(t + 1)\<^sup>2 = 3*(3*k*k + 6*k + 3)"
      using \<open>t = 3 * k + 2\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 1)\<^sup>2 mod 3 = 0"
      by presburger
    moreover
    have "(t + 2)\<^sup>2 = 3*(3*k*k + 8*k+5) + 1"
      using \<open>t = 3 * k + 2\<close>
      unfolding power2_eq_square
      by auto
    then have "(t + 2)\<^sup>2 mod 3 = 1"
      by presburger
    moreover
    have "(t + 3)\<^sup>2 = 3*(3*k*k+10*k+8)+1"
      using \<open>t = 3 * k + 2\<close>
      unfolding power2_eq_square
      by (auto simp add: algebra_simps)
    then have "(t + 3)\<^sup>2 mod 3 = 1"
      by presburger
    ultimately
    have ?thesis
      by auto
  }
  moreover
  have "t mod 3 = 0 \<or> t mod 3 = 1 \<or> t mod 3 = 2"
    by auto
  ultimately
  show ?thesis
    by metis
qed

definition eventually_periodic :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool" where
  "eventually_periodic a \<longleftrightarrow> (\<exists> p > 0. \<exists> n0. \<forall> n \<ge> n0. a (n + p) = a n)"

lemma initial_condition:
  fixes a :: "nat \<Rightarrow> 'a"
  assumes "\<forall> n. a (n + 1) = f (a n)" "a n1 = a n2"
  shows "a (n1 + k) = a (n2 + k)"
  using assms
  by (induction k) auto

lemma two_same_periodic:
  fixes a :: "nat \<Rightarrow> 'a"
  assumes "\<forall> n. a (n + 1) = f (a n)" "n1 < n2" "a n1 = a n2"
  shows "eventually_periodic a"
proof-
  have "\<forall>n\<ge>n1. a (n + (n2 - n1)) = a n"
  proof safe
    fix n
    assume "n \<ge> n1"
    then show "a (n + (n2 - n1)) = a n"
      using initial_condition[of a f n2 n1 "n - n1"] assms \<open>n1 < n2\<close> \<open>a n1 = a n2\<close>
      by (simp add: add.commute)
  qed
  then show "eventually_periodic a"
    using \<open>n1 < n2\<close>
    unfolding eventually_periodic_def
    using zero_less_diff
    by blast
qed

lemma eventually_periodic_repeats:
  fixes a :: "nat \<Rightarrow> 'a"
  assumes "\<forall> n \<ge> n0. a (n + p) = a n"
  shows "\<forall> k. a (n0 + k * p) = a n0"
proof
  fix k
  show "a (n0 + k * p) = a n0"
  proof (induction k)
    case 0 then show ?case by simp
  next
    case (Suc k)
    then show ?case
      using \<open>\<forall> n \<ge> n0. a (n + p) = a n\<close>[rule_format, of "n0 + k * p"]
      by (simp add: add.commute add.left_commute)
  qed
qed

lemma infinite_periodic:
  fixes a :: "nat \<Rightarrow> 'a"
  assumes "\<forall> n. a (n + 1) = f (a n)"
  shows "(\<exists> A. infinite {n. a n = A}) \<longleftrightarrow> eventually_periodic a"
proof
  assume "\<exists> A. infinite {n. a n = A}"
  then obtain A where "infinite {n. a n = A}"
    by auto
  then obtain n1 n2 where "n1 < n2" "a n1 = A" "a n2 = A"
    by (metis (full_types, lifting) bounded_nat_set_is_finite less_add_one mem_Collect_eq nat_neq_iff)
  then show "eventually_periodic a"
    using two_same_periodic[OF assms]
    by simp
next
  assume "eventually_periodic a"
  then obtain n0 p where "p > 0" "\<forall> n \<ge> n0. a (n + p) = a n"
    unfolding eventually_periodic_def
    by auto
  show "\<exists>A. infinite {n. a n = A}"
  proof (rule_tac x="a n0" in exI)
    have "(\<lambda> k. n0 + k * p) ` {n::nat. True} \<subseteq> {n. a n = a n0}"
      using eventually_periodic_repeats[OF `\<forall> n \<ge> n0. a (n + p) = a n`]
      by auto
    moreover
    have "infinite {n::nat. True}"
      by auto
    moreover
    have "inj_on (\<lambda> k. n0 + k * p) {n::nat. True}"
      using \<open>p > 0\<close>
      unfolding inj_on_def
      by auto
    ultimately
    show "infinite {n. a n = a n0}"
      using finite_subset[of "(\<lambda> k. n0 + k * p) ` {n::nat. True}" "{n. a n = a n0}"]
      using finite_image_iff
      by auto
  qed
qed

definition eventually_increasing :: "(nat \<Rightarrow> nat) \<Rightarrow> bool" where
  "eventually_increasing a \<longleftrightarrow> (\<exists> n0. \<forall> n \<ge> n0. a n < a (n + 1))"

lemma eventually_increasing:
  shows "eventually_increasing a \<longleftrightarrow> (\<exists> n0. \<forall> i j. n0 \<le> i \<and> i < j \<longrightarrow> a i < a j)"
proof
  assume "eventually_increasing a"
  then obtain n0 where *: "\<forall> n \<ge> n0. a n < a (n + 1)"
    unfolding eventually_increasing_def
    by auto

  show "\<exists> n0. \<forall> i j. n0 \<le> i \<and> i < j \<longrightarrow> a i < a j"
  proof (rule_tac x="n0" in exI, safe)
    fix i j :: nat
    assume "n0 \<le> i" "i < j"
    then show "a i < a j"
    proof (induction k \<equiv> "j - i + 1" arbitrary: j)
      case 0
      then show ?case
        using *
        by auto
    next
      case (Suc k)
      show ?case
      proof (cases "i = j - 1")
        case True
        then show ?thesis
          using \<open>n0 \<le> i\<close> \<open>i < j\<close> *[rule_format, of "j-1"]
          by simp
      next
        case False
        then have "a i < a (j - 1)"
          using Suc
          by auto
        moreover
        have "a (j - 1) < a j"
          using \<open>n0 \<le> i\<close> \<open>i < j\<close> *[rule_format, of "j-1"]
          by simp
        ultimately
        show ?thesis
          by simp
      qed
    qed
  qed
next
  assume "\<exists> n0. \<forall>i j. n0 \<le> i \<and> i < j \<longrightarrow> a i < a j"
  then show "eventually_increasing a"
    unfolding eventually_increasing_def
    by auto
qed

lemma increasing_non_periodic:
  assumes "eventually_increasing a"
  shows "\<not> eventually_periodic a"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then obtain p n0 where "p > 0" "\<forall> n \<ge> n0. a (n + p) = a n"
    using assms
    unfolding eventually_periodic_def
    by auto
  then show False
    using eventually_increasing[of a] assms
    by (metis add.left_neutral le_add1 le_add2 less_add_eq_less less_irrefl_nat)
qed

definition sqrt_nat :: "nat \<Rightarrow> nat" where
  "sqrt_nat x = (THE s. x = s * s)"

lemma sqrt_nat:
  fixes x s :: nat
  assumes "x = s * s"
  shows "sqrt_nat x = s"
  unfolding sqrt_nat_def
proof (rule the_equality)
  show "x = s * s" by fact
next
  fix s'
  assume "x = s' * s'"
  then show "s' = s" using assms
    by (metis le0 le_less_trans less_or_eq_imp_le mult_less_cancel2 nat_mult_less_cancel_disj nat_neq_iff)
qed

lemma Least_nat_in:
  fixes A :: "nat set"
  assumes "A \<noteq> {}"
  shows "(LEAST x. x \<in> A) \<in> A"
  using assms
  using Inf_nat_def Inf_nat_def1
  by auto

lemma Least_nat_le:
  fixes A :: "nat set"
  assumes "A \<noteq> {}"
  shows "\<forall> x \<in> A. (LEAST x. x \<in> A) \<le> x"
  by (simp add: Least_le)

theorem IMO_2017_SL_N1:
  fixes a :: "nat \<Rightarrow> nat"
  assumes "\<forall> n. a (n + 1) = (if (\<exists> s. a n  = s * s) then sqrt_nat (a n) else (a n) + 3)"
          "a 0 > 1"
  shows "(\<exists> A. infinite {n. a n = A}) \<longleftrightarrow> a 0 mod 3 = 0"
proof-
  have perfect_square: "\<And> n s. a n = s * s \<Longrightarrow> a (n + 1) = s"
    using sqrt_nat assms(1)
    by auto

  have not_perfect_square: "\<And> n. (\<nexists> s. a n = s * s) \<Longrightarrow> a (n + 1) = a n + 3"
    using sqrt_nat assms(1)
    by auto

  have gt1: "\<And> n. a n > 1"
  proof-
    fix n
    show "a n > 1"
    proof (induction n)
      case 0 then show ?case using \<open>a 0 > 1\<close> by simp
    next
      case (Suc n)
      show ?case
      proof (cases "\<exists> s. a n = s * s")
        case True
        then obtain s where "a n = s * s" by auto
        then show ?thesis
          using Suc.IH perfect_square[of n s]
          by (metis One_nat_def Suc_lessI add.commute le_less_trans nat_0_less_mult_iff nat_1_eq_mult_iff plus_1_eq_Suc zero_le_one)
      next
        case False
        then show ?thesis
          using Suc.IH not_perfect_square
          by auto
      qed
    qed
  qed

  have mod3: "\<And>n n'. \<lbrakk>a n mod 3 = 0; n \<le> n'\<rbrakk> \<Longrightarrow> a n' mod 3 = 0"
  proof-
    fix n n'
    assume "a n mod 3 = 0" "n \<le> n'"
    then show "a n' mod 3 = 0"
    proof (induction k \<equiv> "n' - n" arbitrary: n')
      case 0
      then show ?case
        by simp
    next
      case (Suc k)
      then have "a (n' - 1) mod 3 = 0" "n' > 0"
        by auto
      show "a n' mod 3 = 0"
      proof (cases "\<exists> s. a (n' - 1) = s * s")
        case False
        then have "a n' = a (n' - 1) + 3"
          using not_perfect_square[of "n' - 1"] \<open>n' > 0\<close>
          by auto
        then show ?thesis
          using \<open>a (n' - 1) mod 3 = 0\<close>
          by auto
      next
        case True
        then obtain s where "a (n' - 1) = s * s"
          by auto
        then have "a n' = s"
          using perfect_square[of "n' - 1" s] \<open>n' > 0\<close>
          by auto
        then show ?thesis
          using \<open>a (n' - 1) mod 3 = 0\<close> \<open>a (n' - 1) = s * s\<close> square_mod_3[of s]
          by auto
      qed
    qed
  qed

  have not_mod3: "\<And>n n'. \<lbrakk>a n mod 3 \<noteq> 0; n \<le> n'\<rbrakk> \<Longrightarrow> a n' mod 3 \<noteq> 0"
  proof-
    fix n n'
    assume "a n mod 3 \<noteq> 0" "n \<le> n'"
    then show "a n' mod 3 \<noteq> 0"
    proof (induction k \<equiv> "n' - n" arbitrary: n')
      case 0
      then show ?case
        by simp
    next
      case (Suc k)
      then have "a (n' - 1) mod 3 \<noteq> 0" "n' > 0"
        by auto
      show ?case
      proof (cases "\<exists> s. a (n' - 1) = s * s")
        case True
        then obtain s where "a (n' - 1) = s * s"
          by auto
        then have "a n' = s"
          using perfect_square[of "n' - 1" s] \<open>n' > 0\<close>
          by auto
        then show ?thesis
          using \<open>a (n' - 1) = s * s\<close> \<open>a (n' - 1) mod 3 \<noteq> 0\<close> square_mod_3[of s]
          by auto
      next
        case False
        then have "a n' = a (n' - 1) + 3"
          using not_perfect_square[of "n' - 1"] \<open>n' > 0\<close>
          by auto
        then show ?thesis
          using \<open>a (n' - 1) mod 3 \<noteq> 0\<close>
          by auto
      qed
    qed
  qed

  have Claim1: "\<exists> n. a n mod 3 = 2 \<Longrightarrow> \<not> eventually_periodic a"
  proof-
    assume "\<exists> n. a n mod 3 = 2"
    then obtain n where "a n mod 3 = 2"
      by auto
    have "\<forall> m \<ge> n. \<not> (\<exists> s. a m = s * s) \<and> a m mod 3 = 2 \<and> a (m + 1) = a m + 3"
    proof (rule, rule)
      fix m
      assume "n \<le> m"
      then show "\<not> (\<exists> s. a m = s * s) \<and> a m mod 3 = 2 \<and> a (m + 1) = a m + 3"
        using \<open>a n mod 3 = 2\<close>
      proof (induction k \<equiv> "m - n" arbitrary: m)
        case 0
        then show ?case
          using square_mod_3_not_2 not_perfect_square[of m]
          by force
      next
        case (Suc k)
        then have "(\<nexists>s. a (m - 1) = s * s) \<and> a (m - 1) mod 3 = 2"
          by auto
        then have "a m = a (m - 1) + 3" "a m mod 3 = 2"
          using not_perfect_square[of "m-1"] \<open>Suc k = m - n\<close>
          by auto
        then show ?case
          using square_mod_3_not_2 not_perfect_square[of "m"]
          by metis
      qed
    qed
    then have "eventually_increasing a"
      unfolding eventually_increasing_def
      by force
    then show ?thesis
      by (simp add: increasing_non_periodic)
  qed

  have Claim2: "\<forall> n. a n mod 3 \<noteq> 2 \<and> a n > 9 \<longrightarrow> (\<exists> m > n. a m < a n)"
  proof safe
    fix n
    assume "a n mod 3 \<noteq> 2" "a n > 9"
    let ?T = "{t | t. t*t < a n}"
    have "finite ?T"
    proof (rule finite_subset)
      show "?T \<subseteq> {0..<a n}"
        by (smt atLeastLessThan_iff le_less_trans le_square less_eq_nat.simps(1) mem_Collect_eq subset_iff)
    qed simp
    have "3 \<in> ?T"
      using \<open>a n > 9\<close>
      by auto

    let ?t = "Max ?T"
    have "?t \<ge> 3"
      using \<open>finite ?T\<close> \<open>3 \<in> ?T\<close>
      by auto

    have "?t\<^sup>2 < a n"
      using \<open>finite ?T\<close> \<open>3 \<in> ?T\<close> Max_in[of ?T]
      by (metis (no_types, lifting) empty_iff mem_Collect_eq power2_eq_square)

    have "a n \<le> (?t + 1)\<^sup>2"
      using Max_ge[of ?T "?t + 1"] \<open>finite ?T\<close>
      by (metis (no_types, lifting) add.right_neutral add_le_imp_le_left mem_Collect_eq not_less not_one_le_zero power2_eq_square)

    have "\<exists> k. a (n + k) \<in> {(?t+1)\<^sup>2, (?t+2)\<^sup>2, (?t+3)\<^sup>2}"
    proof-
      {
        fix i
        assume "i > 0"
               "\<forall> i'. 0 < i' \<and> i' < i \<longrightarrow> a n mod 3 \<noteq> (?t + i')\<^sup>2 mod 3"
               "a n mod 3 = (?t + i)\<^sup>2 mod 3"

        let ?k = "((?t + i)\<^sup>2 - a n) div 3"

        have "(?t + 1)\<^sup>2 \<le> (?t + i)\<^sup>2"
          using \<open>i > 0\<close>
          by auto
        then have "a n \<le> (?t + i)\<^sup>2"
          using \<open>a n \<le> (?t + 1)\<^sup>2\<close>
          using le_trans by blast

        have "3 dvd ((?t + i)\<^sup>2 - a n)"
          using \<open>a n mod 3 = (?t + i)\<^sup>2 mod 3\<close> \<open>a n \<le> (?t + i)\<^sup>2\<close>
          using mod_eq_dvd_iff_nat
          by fastforce
        then have "3 * (((?t + i)\<^sup>2 - a n) div 3) = (?t + i)\<^sup>2 - a n"
          by simp

        have 1: "\<forall> k' \<le> ?k. a (n + k') = a n + 3 * k'"
        proof safe
          fix k'
          assume "k' \<le> ?k"
          then show "a (n + k') = a n + 3 * k'"
          proof (induction k')
            case 0 then show ?case by simp
          next
            case (Suc k')
            then have "a (n + k') = a n + 3 * k'"
              by auto
            have "\<not> (\<exists> s. a (n + k') = s * s)"
            proof (rule ccontr)
              assume "\<not> ?thesis"
              then obtain s where "a (n + k') = s * s" by auto

              have "3 * (k' + 1) \<le> (?t + i)\<^sup>2 - a n"
                using Suc(2)
                using \<open>3 * (((?t + i)\<^sup>2 - a n) div 3) = (?t + i)\<^sup>2 - a n\<close>
                by simp
              then have "a (n + k') < (?t + i)\<^sup>2"
                using \<open>a (n + k') = a n + 3 * k'\<close>
                by simp
              moreover
              have "a (n + k') > ?t\<^sup>2"
                using \<open>a (n + k') = a n + 3 * k'\<close> \<open>a n > ?t\<^sup>2\<close>
                by simp
              ultimately
              have "?t\<^sup>2 < s\<^sup>2 \<and> s\<^sup>2 < (?t + i)\<^sup>2"
                using \<open>a (n + k') = s * s\<close>
                by (simp add: power2_eq_square)
              then have "?t < s \<and> s < ?t + i"
                using power_less_imp_less_base by blast
              then obtain i' where "0 < i'" "i' < i"  "s = ?t + i'"
                using less_imp_add_positive by auto

              moreover

              have "\<forall> i'. 0 < i' \<and> i' < i \<longrightarrow> a (n + k') \<noteq> (?t + i')\<^sup>2"
                using \<open>a (n + k') = a n + 3 * k'\<close> \<open>\<forall> i'. 0 < i' \<and> i' < i \<longrightarrow> a n mod 3 \<noteq> (?t + i')\<^sup>2 mod 3\<close>
                by fastforce

              ultimately

              show False
                using \<open>a (n + k') = s * s\<close>
                by (auto simp add: power2_eq_square)
            qed
            then show ?case
              using not_perfect_square[of "n + k'"] \<open>a (n + k') = a n + 3 * k'\<close>
              by auto
          qed
        qed

        have "a (n + ?k) = (?t + i)\<^sup>2"
          using 1[rule_format, of ?k] \<open>a n \<le> (?t + i)\<^sup>2\<close> \<open>3 * (((?t + i)\<^sup>2 - a n) div 3) = (?t + i)\<^sup>2 - a n\<close>
          by simp
        then have "\<exists> k. a (n + k) = (?t + i)\<^sup>2"
          by blast
      } note ti = this

      have "a n mod 3 = 0 \<or> a n mod 3 = 1"
        using \<open>a n mod 3 \<noteq> 2\<close>
        by auto
      then have cc: "a n mod 3 = (?t+1)\<^sup>2 mod 3 \<or> a n mod 3 = (?t+2)\<^sup>2 mod 3 \<or> a n mod 3 = (?t+3)\<^sup>2 mod 3"
        using consecutive_squares_mod_3[of ?t]
        by (smt empty_iff insert_iff)

      show ?thesis
      proof (cases "a n mod 3 = (?t+1)\<^sup>2 mod 3")
        case True
        then show ?thesis
          using ti[of 1]
          by auto
      next
        case False
        then have "\<forall>i'. 0 < i' \<and> i' < 2 \<longrightarrow> a n mod 3 \<noteq> (?t + i')\<^sup>2 mod 3"
          by (metis mod2_gr_0 mod_less)
        show ?thesis
        proof (cases "a n mod 3 = (?t+2)\<^sup>2 mod 3")
          case True
          then show ?thesis
            using ti[of 2] \<open>\<forall>i'. 0 < i' \<and> i' < 2 \<longrightarrow> a n mod 3 \<noteq> (?t + i')\<^sup>2 mod 3\<close>
            by auto
        next
          case False
          have "a n mod 3 = (?t + 3)\<^sup>2 mod 3"
            using \<open>a n mod 3 \<noteq> (?t + 1)\<^sup>2 mod 3\<close>  \<open>a n mod 3 \<noteq> (?t + 2)\<^sup>2 mod 3\<close>
            using cc
            by auto
          moreover
          have "\<forall>i'. 0 < i' \<and> i' < 3 \<longrightarrow> a n mod 3 \<noteq> (?t + i')\<^sup>2 mod 3"
            using \<open>a n mod 3 \<noteq> (?t + 1)\<^sup>2 mod 3\<close>  \<open>a n mod 3 \<noteq> (?t + 2)\<^sup>2 mod 3\<close>
            by (metis (mono_tags, lifting) One_nat_def Suc_1 linorder_neqE_nat not_less_eq numeral_3_eq_3)
          ultimately
          show ?thesis
            using ti[of 3]
            by auto
        qed
      qed
    qed
    then obtain k where "a (n + k) \<in> {(?t+1)\<^sup>2, (?t+2)\<^sup>2, (?t+3)\<^sup>2}"
      by auto
    have "a (n + k + 1) \<le> ?t + 3"
    proof-
      have "a (n + k + 1) = ?t + 1 \<or> a (n + k + 1) = ?t + 2 \<or> a (n + k + 1) = ?t + 3"
        using \<open>a (n + k) \<in> {(?t+1)\<^sup>2, (?t+2)\<^sup>2, (?t+3)\<^sup>2}\<close>
        unfolding power2_eq_square
        using perfect_square
        by auto
      then show ?thesis
        by auto
    qed
    also have "... < ?t * ?t"
    proof-
      {
        fix t::nat
        assume "t \<ge> 3"
        then have "t + 3 < t * t"
          using div_nat_eqI le_add1 mult_eq_if
          by auto
      } then show ?thesis
        using \<open>?t \<ge> 3\<close>
        by simp
    qed
    also have "... < a n"
    proof-
      have "?t \<in> ?T"
      proof (rule Max_in)
        show "finite ?T" by fact
      next
        show "?T \<noteq> {}"
          using \<open>3 \<in> ?T\<close>
          by blast
      qed
      then show ?thesis
        by auto
    qed
    finally show "\<exists>m>n. a m < a n"
      using add_lessD1 less_add_one by blast
  qed

  have Claim3_a: "\<forall> n. a n mod 3 = 0 \<and> a n \<le> 9 \<longrightarrow> (\<exists> m > n. a m = 3)"
  proof safe
    fix n
    assume "3 dvd a n" "a n \<le> 9"
    then have "a n = 3 \<or> a n = 6 \<or> a n = 9"
      using \<open>3 dvd a n\<close> gt1[of n]
      by auto
    show "\<exists>m>n. a m = 3"
    proof-
      have "\<And> n. a n = 3 \<Longrightarrow> a (n + 1) = 6"
        using not_perfect_square not_square_3
        by (auto split: if_split_asm)

      moreover

      have "\<And> n. a n = 6 \<Longrightarrow> a (n + 1) = 9"
        using not_perfect_square not_square_6
        by (auto split: if_split_asm)

      moreover

      have "\<And> n. a n = 9 \<Longrightarrow> a (n + 1) = 3"
        using perfect_square
        by simp

      ultimately
      show ?thesis
        using \<open>a n = 3 \<or> a n = 6 \<or> a n = 9\<close>
        by (meson add_lessD1 less_add_one)
    qed
  qed

  have Claim3: "\<forall> n. a n mod 3 = 0 \<longrightarrow> (\<exists> m > n. a m = 3)"
  proof safe
    fix n
    assume "3 dvd a n"
    show "\<exists> m > n. a m = 3"
    proof (cases "a n \<le> 9")
      case True
      then show ?thesis
        using \<open>3 dvd a n\<close> Claim3_a
        by auto
    next
      case False
      let ?m = "LEAST x. x \<in> (a ` {n+1..})"
      let ?j = "SOME j. j > n \<and> a j = ?m"
      have "\<exists> j. j > n \<and> a j = ?m"
        using Least_nat_in[of "a ` {n+1..}"]
        by (smt atLeast_iff imageE image_is_empty less_add_one less_le_trans not_Ici_eq_empty)
      then have "?j > n" "a ?j = ?m"
        using someI_ex[of "\<lambda> j. j > n \<and> a j = ?m"]
        by auto
      show ?thesis
      proof (cases "a ?j \<le> 9")
        case True
        then show ?thesis
          using Claim3_a[rule_format, of "?j"] mod3[of n "?j"] \<open>?j > n\<close> \<open>3 dvd a n\<close>
          by (meson dvd_imp_mod_0 less_trans nat_less_le)
      next
        case False
        have "a ?j mod 3 \<noteq> 2"
          using \<open>3 dvd a n\<close> mod3[of n ?j] \<open>n < ?j\<close>
          by simp
        then obtain m where "m > ?j" "a m < a ?j"
          using Claim2[rule_format, of ?j] False
          by auto
        then have "m > n" "a m < ?m"
          using \<open>n < ?j\<close> \<open>a ?j = ?m\<close>
          by auto
        then have False
          using Least_nat_le[of "a ` {n + 1..}", rule_format, of "a m"]
          by simp
        then show ?thesis
          by simp
      qed
    qed
  qed

  have Claim4_a: "\<forall> n. a n mod 3 = 1 \<and> a n \<le> 9 \<longrightarrow> (\<exists> m > n. a m mod 3 = 2)"
  proof safe
    fix n
    assume "a n mod 3 = 1" "a n \<le> 9"
    then have "a n = 2 \<or> a n = 3 \<or> a n = 4 \<or> a n = 5 \<or> a n = 6 \<or> a n = 7 \<or> a n = 8 \<or> a n = 9"
      using gt1[of n]
      by auto
    then have "a n = 4 \<or> a n = 7"
      using \<open>a n mod 3 = 1\<close>
      by auto
    then show "\<exists> m > n. a m mod 3 = 2"
    proof
      assume "a n = 4"
      then have "a (n + 1) = 2"
        using perfect_square[of n 2]
        by simp
      then show ?thesis
        by force
    next
      assume "a n = 7"
      then have "a (n + 1) = 10"
        using not_square_7 not_perfect_square
        by auto
      then have "a (n + 2) = 13"
        using not_square_10 not_perfect_square
        by auto
      then have "a (n + 3) = 16"
        using not_square_13 assms(1)
        by (simp add: numeral_3_eq_3)
      then have "a (n + 4) = 4"
        using perfect_square[of "n+3" 4]
        by (auto simp add: add.commute)
      then have "a (n + 5) = 2"
        using perfect_square[of "n+4" 2]
        by (auto simp add: add.commute)
      then show ?thesis
        by (rule_tac x="n+5" in exI, simp)
    qed
  qed

  have Claim4: "\<forall> n. a n mod 3 = 1 \<longrightarrow> (\<exists> m > n. a m mod 3 = 2)"
  proof safe
    fix n
    assume "a n mod 3 = 1"
    show "\<exists>m>n. a m mod 3 = 2"
    proof (cases "a n < 10")
      case True
      then show ?thesis
        using Claim4_a \<open>a n mod 3 = 1\<close>
        by auto
    next
      case False
      let ?m = "LEAST x. x \<in> (a ` {n+1..})"
      let ?j = "SOME j. j > n \<and> a j = ?m"
      have "\<exists> j. j > n \<and> a j = ?m"
        using Least_nat_in[of "a ` {n+1..}"]
        by (smt atLeast_iff imageE image_is_empty less_add_one less_le_trans not_Ici_eq_empty)
      then have "?j > n" "a ?j = ?m"
        using someI_ex[of "\<lambda> j. j > n \<and> a j = ?m"]
        by auto
      {
        assume "a ?j mod 3 = 1"
        have ?thesis
        proof (cases "a ?j \<le> 9")
          case False
          then obtain m where "m > ?j" "a m < a ?j"
            using Claim2[rule_format, of "?j"] \<open>a ?j mod 3 = 1\<close>
            by auto
          then have "m > n" "a m < ?m"
            using \<open>n < ?j\<close> \<open>a ?j = ?m\<close>
            by auto
          then have False
            using Least_nat_le[of "a ` {n + 1..}", rule_format, of "a m"]
            by simp
          then show ?thesis
            by simp
        next
          case True
          then show ?thesis
            using Claim4_a[rule_format, of ?j] \<open>a ?j mod 3 = 1\<close> \<open>n < ?j\<close>
            using less_trans
            by blast
        qed
      }

      moreover

      have "a ?j mod 3 = 2 \<Longrightarrow> ?thesis"
        using \<open>?j > n\<close>
        by force

      moreover
      {
        have "a ?j mod 3 \<noteq> 0"
          using not_mod3[of n ?j] \<open>a n mod 3 = 1\<close> \<open>n < ?j\<close>
          by auto
      }

      moreover
      have "a ?j mod 3 < 3"
        by auto
      then have "a ?j mod 3 = 0 \<or> a ?j mod 3 = 1 \<or> a ?j mod 3 = 2"
        by auto
      ultimately

      show ?thesis
        by auto
    qed
  qed

  show ?thesis
  proof
    assume "a 0 mod 3 = 0"
    then have "eventually_periodic a"
      using Claim3 two_same_periodic[OF assms(1)]
      by (metis mod_self)
    then show "\<exists> A. infinite {n. a n = A}"
      by (simp add: infinite_periodic[OF assms(1)])
  next
    assume "\<exists> A. infinite {n. a n = A}"
    then have "eventually_periodic a"
      by (simp add: infinite_periodic[OF assms(1)])
    {
      assume "a 0 mod 3 = 1"
      then obtain m where "a m mod 3 = 2"
        using Claim4
        by auto
      then have False
        using Claim1 \<open>eventually_periodic a\<close>
        by force
    }
    moreover
    {
      assume "a 0 mod 3 = 2"
      then have False
        using Claim1 \<open>eventually_periodic a\<close>
        by force
    }
    ultimately
    show "a 0 mod 3 = 0"
      by presburger
  qed
qed

end


theory ExF003
imports Main
begin

lemma "(\<forall>x. P x \<longrightarrow> P(Q x)) \<and> P a \<longrightarrow> P (Q (Q a))"
proof -
{
  assume "(\<forall>x. P x \<longrightarrow> P(Q x)) \<and> P a"
  hence "\<forall>x. P x \<longrightarrow> P(Q x)" by (rule conjE)
  from \<open>(\<forall>x. P x \<longrightarrow> P(Q x)) \<and> P a\<close> have "P a" by (rule conjE)
  from  \<open>(\<forall>x. P x \<longrightarrow> P(Q x))\<close> have "P a \<longrightarrow> P(Q a)" by (rule allE)
  from this and \<open>P a\<close> have "P (Q a)" by (rule impE)
  from  \<open>(\<forall>x. P x \<longrightarrow> P(Q x))\<close> have "P (Q a) \<longrightarrow> P (Q (Q a))" by (rule allE)
  from this and \<open>P (Q a)\<close> have " P (Q (Q a))" by (rule impE)
}
thus ?thesis by (rule impI)
qed


theory prop_66
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun len :: "'a list => Nat" where
  "len (Nil2) = Z"
  | "len (Cons2 y xs) = S (len xs)"
  fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
  | "le (S z) (Z) = False"
  | "le (S z) (S x2) = le z x2"
  fun filter2 :: "('a => bool) => 'a list => 'a list" where
  "filter2 x (Nil2) = Nil2"
  | "filter2 x (Cons2 z xs) =
       (if x z then Cons2 z (filter2 x xs) else filter2 x xs)"
  (*hipster len le filter *)
hipster len filter2
lemma lemma_a []: "filter2 x13 (filter2 y13 z13) = filter2 y13 (filter2 x13 z13)"
by (hipster_induct_schemes len.simps filter2.simps)

lemma lemma_aa []: "filter2 x9 (filter2 x9 y9) = filter2 x9 y9"
by (hipster_induct_schemes len.simps filter2.simps)

(*hipster le*)
lemma lemma_ab []: "le x2 x2 = True"
by (hipster_induct_schemes le.simps)

lemma lemma_ac []: "le x2 (S x2) = True"
by (hipster_induct_schemes le.simps)

lemma lemma_ad []: "le (S x2) x2 = False"
by (hipster_induct_schemes le.simps)

(*hipster_cond le len*)
lemma lemma_ae [thy_expl]: "le x2 y2 \<Longrightarrow> le x2 (S y2) = True"
by (hipster_induct_schemes)

lemma lemma_af []: "le y2 x2 \<Longrightarrow> le (S x2) y2 = False"
by (hipster_induct_schemes le.simps)

lemma lemma_ag []: "le y x \<and> le x y \<Longrightarrow> x = y"
by (hipster_induct_schemes le.simps Nat.exhaust)

lemma lemma_ah []: "le z y \<and> le x z \<Longrightarrow> le x y = True"
by (hipster_induct_schemes le.simps Nat.exhaust)

(* Trivial
lemma lemma_ai [thy_expl]: "le z y \<and> le x z \<Longrightarrow> le x (S y) = True"
lemma lemma_aj [thy_expl]: "le z x \<and> le y z \<Longrightarrow> le (S x) y = False"
lemma lemma_ak [thy_expl]: "le z y \<and> le x z \<Longrightarrow> le (S x) (S y) = True"
*)

  theorem x0 :
    "le (len (filter2 q xs)) (len xs)"
    by (hipster_induct_schemes)

end


(* Adapted from Tobias Nipkow in order to accommodate
   bounded regular expressions *)

section "Extended Regular Expressions 3"

theory Regular_Exps3
imports "Regular-Sets.Regular_Set"
begin

datatype (atoms: 'a) rexp =
  is_Zero: Zero |
  is_One: One |
  Atom 'a |
  Plus "('a rexp)" "('a rexp)" |
  Times "('a rexp)" "('a rexp)" |
  Star "('a rexp)" |
  NTimes "('a rexp)" "nat" | (* r{n}    - exactly n-times *)
  Upto "('a rexp)" "nat" |   (* r{..n}  - up to n-times *)
  From "('a rexp)" "nat" |   (* r{n..}  - from n-times *)
  Rec string "('a rexp)" |  (* record regular expression *)
  Charset "('a set)"

fun lang :: "'a rexp => 'a lang" where
"lang Zero = {}" |
"lang One = {[]}" |
"lang (Atom a) = {[a]}" |
"lang (Plus r s) = (lang r) Un (lang s)" |
"lang (Times r s) = conc (lang r) (lang s)" |
"lang (Star r) = star(lang r)" |
"lang (NTimes r n) = ((lang r) ^^ n)" |
"lang (Upto r n) = (\<Union>i \<in> {..n}. (lang r) ^^ i)" |
"lang (From r n) = (\<Union>i \<in> {n..}. (lang r) ^^ i)" |
"lang (Rec l r) = lang r" |
"lang (Charset cs) = {[c] | c . c \<in> cs}"

primrec nullable :: "'a rexp \<Rightarrow> bool" where
"nullable Zero = False" |
"nullable One = True" |
"nullable (Atom c) = False" |
"nullable (Plus r1 r2) = (nullable r1 \<or> nullable r2)" |
"nullable (Times r1 r2) = (nullable r1 \<and> nullable r2)" |
"nullable (Star r) = True" |
"nullable (NTimes r n) = (if n = 0 then True else nullable r)" |
"nullable (Upto r n) = True" |
"nullable (From r n) = (if n = 0 then True else nullable r)" |
"nullable (Rec l r) = nullable r" |
"nullable (Charset cs) = False"

lemma pow_empty_iff:
  shows "[] \<in> (lang r) ^^ n \<longleftrightarrow> (if n = 0 then True else [] \<in> (lang r))"
  by (induct n)(auto)

lemma nullable_iff:
  shows "nullable r \<longleftrightarrow> [] \<in> lang r"
  by (induct r) (auto simp add: conc_def pow_empty_iff split: if_splits)

end


(*
Authors:

  Anthony Bordg, University of Cambridge, apdb3@cam.ac.uk;
  Yijun He, University of Cambridge, yh403@cam.ac.uk
*)

section \<open>Quantum Teleportation\<close>

theory Quantum_Teleportation
imports
  More_Tensor
  Basics
  Measurement
begin

definition alice:: "complex Matrix.mat \<Rightarrow> complex Matrix.mat" where
"alice \<phi> \<equiv> (H \<Otimes> Id 2) * ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>))"

abbreviation M1:: "complex Matrix.mat" where
"M1 \<equiv> mat_of_cols_list 8 [[1, 0, 0, 0, 0, 0, 0, 0],
                          [0, 1, 0, 0, 0, 0, 0, 0],
                          [0, 0, 1, 0, 0, 0, 0, 0],
                          [0, 0, 0, 1, 0, 0, 0, 0],
                          [0, 0, 0, 0, 0, 0, 1, 0],
                          [0, 0, 0, 0, 0, 0, 0, 1],
                          [0, 0, 0, 0, 1, 0, 0, 0],
                          [0, 0, 0, 0, 0, 1, 0, 0]]"

lemma tensor_prod_of_cnot_id_1:
  shows "(CNOT \<Otimes> Id 1) = M1"
proof
  show "dim_col (CNOT \<Otimes> Id 1) = dim_col M1"
    by(simp add: CNOT_def Id_def mat_of_cols_list_def)
  show "dim_row (CNOT \<Otimes> Id 1) = dim_row M1"
    by(simp add: CNOT_def Id_def  mat_of_cols_list_def)
  fix i j::nat assume "i < dim_row M1" and "j < dim_col M1"
  then have "i \<in> {0..<8} \<and> j \<in> {0..<8}"
    by (auto simp add:  mat_of_cols_list_def)
  then show "(CNOT \<Otimes> Id 1) $$ (i, j) = M1 $$ (i, j)"
    by (auto simp add: Id_def CNOT_def mat_of_cols_list_def)
qed

abbreviation M2:: "complex Matrix.mat" where
"M2 \<equiv> mat_of_cols_list 8 [[1/sqrt(2), 0, 0, 0, 1/sqrt(2), 0, 0, 0],
                          [0, 1/sqrt(2), 0, 0, 0, 1/sqrt(2), 0, 0],
                          [0, 0, 1/sqrt(2), 0, 0, 0, 1/sqrt(2), 0],
                          [0, 0, 0, 1/sqrt(2), 0, 0, 0, 1/sqrt(2)],
                          [1/sqrt(2), 0, 0, 0, -1/sqrt(2), 0, 0, 0],
                          [0, 1/sqrt(2), 0, 0, 0, -1/sqrt(2), 0, 0],
                          [0, 0, 1/sqrt(2), 0, 0, 0, -1/sqrt(2), 0],
                          [0, 0, 0, 1/sqrt(2), 0, 0, 0, -1/sqrt(2)]]"

lemma tensor_prod_of_h_id_2:
  shows "(H \<Otimes> Id 2) = M2"
proof
  show "dim_col (H \<Otimes> Id 2) = dim_col M2"
    by(simp add: H_def Id_def mat_of_cols_list_def)
  show "dim_row (H \<Otimes> Id 2) = dim_row M2"
    by(simp add: H_def Id_def mat_of_cols_list_def)
  fix i j::nat assume "i < dim_row M2" and "j < dim_col M2"
  then have "i \<in> {0..<8} \<and> j \<in> {0..<8}"
    by (auto simp add:  mat_of_cols_list_def)
  then show "(H \<Otimes> Id 2) $$ (i, j) = M2 $$ (i, j)"
    by (auto simp add: Id_def H_def mat_of_cols_list_def)
qed

lemma alice_step_1_state [simp]:
  assumes "state 1 \<phi>"
  shows "state 3 (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)"
  using assms bell00_is_state tensor_state by(metis One_nat_def Suc_1 numeral_3_eq_3 plus_1_eq_Suc)

lemma alice_step_2_state:
  assumes "state 1 \<phi>"
  shows "state 3 ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>))"
proof-
  have "gate 3 (CNOT \<Otimes> Id 1)"
    using CNOT_is_gate id_is_gate tensor_gate by (metis numeral_plus_one semiring_norm(5))
  then show "state 3 ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>))" using assms by simp
qed

lemma alice_state [simp]:
  assumes "state 1 \<phi>"
  shows "state 3 (alice \<phi>) "
proof-
  have "gate 3 (H \<Otimes> Id 2)"
    using tensor_gate id_is_gate H_is_gate by(metis eval_nat_numeral(3) plus_1_eq_Suc)
  then show ?thesis
    using assms alice_step_2_state by(simp add: alice_def)
qed

lemma alice_step_1:
  assumes "state 1 \<phi>" and "\<alpha> = \<phi> $$ (0,0)" and "\<beta> = \<phi> $$ (1,0)"
  shows "(\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) = mat_of_cols_list 8 [[\<alpha>/sqrt(2),0,0,\<alpha>/sqrt(2),\<beta>/sqrt(2),0,0,\<beta>/sqrt(2)]]"
proof
  define v where asm:"v = mat_of_cols_list 8 [[\<alpha>/sqrt(2),0,0,\<alpha>/sqrt(2),\<beta>/sqrt(2),0,0,\<beta>/sqrt(2)]]"
  then show "dim_row (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) = dim_row v"
    using assms(1) alice_step_1_state state.dim_row mat_of_cols_list_def by fastforce
  show "dim_col (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) = dim_col v"
    using assms(1) alice_step_1_state state.is_column asm mat_of_cols_list_def by fastforce
  show "\<And>i j. i < dim_row v \<Longrightarrow> j < dim_col v \<Longrightarrow> (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) $$ (i,j) = v $$ (i,j)"
  proof-
    fix i j assume "i < dim_row v" and "j < dim_col v"
    then have "i \<in> {0..<8} \<and> j = 0"
      using asm by (auto simp add: mat_of_cols_list_def)
    moreover have "dim_row |\<beta>\<^sub>0\<^sub>0\<rangle> = 4"
      using bell00_is_state state_def by simp
    moreover have "dim_col |\<beta>\<^sub>0\<^sub>0\<rangle> = 1"
      using bell00_is_state state_def by simp
    ultimately show "(\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) $$ (i, j) = v $$ (i,j)"
      using state_def assms asm by (auto simp add: bell00_def)
  qed
qed

lemma alice_step_2:
  assumes "state 1 \<phi>" and "\<alpha> = \<phi> $$ (0,0)" and "\<beta> = \<phi> $$ (1,0)"
  shows "(CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) = mat_of_cols_list 8 [[\<alpha>/sqrt(2),0,0,\<alpha>/sqrt(2),0,\<beta>/sqrt(2),\<beta>/sqrt(2),0]]"
proof
  have f0:"(\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>) = mat_of_cols_list 8 [[\<alpha>/sqrt(2),0,0,\<alpha>/sqrt(2),\<beta>/sqrt(2),0,0,\<beta>/sqrt(2)]]"
    using assms alice_step_1 by simp
  define v where asm:"v = mat_of_cols_list 8 [[\<alpha>/sqrt(2),0,0,\<alpha>/sqrt(2),0,\<beta>/sqrt(2),\<beta>/sqrt(2),0]]"
  then show "dim_row ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)) = dim_row v"
    using assms(1) alice_step_2_state state.dim_row mat_of_cols_list_def by fastforce
  show "dim_col ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)) = dim_col v"
    using assms(1) alice_step_2_state state.is_column asm mat_of_cols_list_def by fastforce
  show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> ((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)) $$ (i,j) = v $$ (i,j)"
  proof-
    fix i j assume "i < dim_row v" and "j < dim_col v"
    then have "i \<in> {0..<8::nat} \<and> j = 0"
      using asm by (auto simp add: mat_of_cols_list_def)
    then have "(M1 * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)) $$ (i,j) = v $$ (i,j)"
      by (auto simp add: f0 asm mat_of_cols_list_def times_mat_def scalar_prod_def)
    then show "((CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)) $$ (i,j) = v $$ (i,j)"
      using tensor_prod_of_cnot_id_1 by simp
  qed
qed

lemma alice_result:
  assumes "state 1 \<phi>" and "\<alpha> = \<phi> $$ (0,0)" and "\<beta> = \<phi> $$ (1,0)"
  shows "alice \<phi> = mat_of_cols_list 8 [[\<alpha>/2, \<beta>/2, \<beta>/2, \<alpha>/2, \<alpha>/2, -\<beta>/2, -\<beta>/2, \<alpha>/2]]"
proof
  define v where a0:"v = mat_of_cols_list 8 [[\<alpha>/2, \<beta>/2, \<beta>/2, \<alpha>/2, \<alpha>/2, -\<beta>/2, -\<beta>/2, \<alpha>/2]]"
  define w where a1:"w = (CNOT \<Otimes> Id 1) * (\<phi> \<Otimes> |\<beta>\<^sub>0\<^sub>0\<rangle>)"
  then have f0:"w = mat_of_cols_list 8 [[\<alpha>/sqrt(2), 0, 0, \<alpha>/sqrt(2), 0, \<beta>/sqrt(2), \<beta>/sqrt(2), 0]]"
    using assms alice_step_2 by simp
  show "dim_row (alice \<phi>) = dim_row v"
    using assms(1) alice_state state_def a0 by (simp add: mat_of_cols_list_def)
  show "dim_col (alice \<phi>) = dim_col v"
    using assms(1) alice_state state_def a0 by (simp add: mat_of_cols_list_def)
  show "\<And>i j. i < dim_row v \<Longrightarrow> j < dim_col v \<Longrightarrow> alice \<phi> $$ (i,j) = v $$ (i,j)"
  proof-
    fix i j assume "i < dim_row v" and "j < dim_col v"
    then have "i \<in> {0..<8} \<and> j = 0"
      using a0 by (auto simp add: Tensor.mat_of_cols_list_def)
    then have "(M2 * w) $$ (i,j) = v $$ (i,j)"
      by (auto simp add: f0 a0 mat_of_cols_list_def times_mat_def scalar_prod_def)
    then show "alice \<phi> $$ (i,j) = v $$ (i,j)"
      by (simp add: tensor_prod_of_h_id_2 alice_def a1)
  qed
qed

text \<open>
An application of function @{term "alice"} to a state @{term "\<phi>"} of a 1-qubit system results in the following cases.
\<close>

definition alice_meas:: "complex Matrix.mat \<Rightarrow> _list" where
"alice_meas \<phi> = [
  ((prob0 3 (alice \<phi>) 0) * (prob0 3 (post_meas0 3 (alice \<phi>) 0) 1), post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1)
, ((prob0 3 (alice \<phi>) 0) * (prob1 3 (post_meas0 3 (alice \<phi>) 0) 1), post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1)
, ((prob1 3 (alice \<phi>) 0) * (prob0 3 (post_meas1 3 (alice \<phi>) 0) 1), post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1)
, ((prob1 3 (alice \<phi>) 0) * (prob1 3 (post_meas1 3 (alice \<phi>) 0) 1), post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1)
]"

definition alice_pos:: "complex Matrix.mat \<Rightarrow> complex Matrix.mat \<Rightarrow> bool" where
"alice_pos \<phi> q \<equiv>  q = mat_of_cols_list 8 [[\<phi> $$ (0,0), \<phi> $$ (1,0), 0, 0, 0, 0, 0, 0]] \<or>
                  q = mat_of_cols_list 8 [[0, 0, \<phi> $$ (1,0), \<phi> $$ (0,0), 0, 0, 0, 0]] \<or>
                  q = mat_of_cols_list 8 [[0, 0, 0, 0, \<phi> $$ (0,0), - \<phi> $$ (1,0), 0, 0]] \<or>
                  q = mat_of_cols_list 8 [[0, 0, 0, 0, 0, 0, - \<phi> $$ (1,0), \<phi> $$ (0,0)]]"

lemma phi_vec_length:
  assumes "state 1 \<phi>"
  shows "cmod(\<phi> $$ (0,0))^2 + cmod(\<phi> $$ (Suc 0,0))^2 = 1"
  using set_2 assms state_def Matrix.col_def cpx_vec_length_def by(auto simp add: atLeast0LessThan)

lemma select_index_3_subsets [simp]:
  shows "{j::nat. select_index 3 0 j} = {4,5,6,7} \<and>
         {j::nat. j < 8 \<and> \<not> select_index 3 0 j} = {0,1,2,3} \<and>
         {j::nat. select_index 3 1 j} = {2,3,6,7} \<and>
         {j::nat. j < 8 \<and> \<not> select_index 3 1 j} = {0,1,4,5}"
proof-
  have "{j::nat. select_index 3 0 j} = {4,5,6,7}" by (auto simp add: select_index_def)
  moreover have "{j::nat. j < 8 \<and> \<not> select_index 3 0 j} = {0,1,2,3}" by(auto simp add: select_index_def)
  moreover have f1:"{j::nat. select_index 3 1 j} = {2,3,6,7}"
  proof
    show "{j. select_index 3 1 j} \<subseteq> {2,3,6,7}"
    proof
      fix j::nat assume "j \<in> {j. select_index 3 1 j}"
      then have "j \<in> {0..<8} \<and> j mod 4 \<in> {2,3}" by (auto simp add: select_index_def)
      then show "j \<in> {2,3,6,7}" by auto
    qed
    show "{2,3,6,7} \<subseteq> {j. select_index 3 1 j}" by (auto simp add: select_index_def)
  qed
  moreover have "{j::nat. j < 8 \<and> \<not> select_index 3 1 j} = {0,1,4,5}"
  proof-
    have "{j::nat. j < 8 \<and> j \<notin> {2,3,6,7}} = {0,1,4,5}"  by auto
    then show ?thesis using f1 by blast
  qed
  ultimately show ?thesis by simp
qed

lemma prob_index_0_alice:
  assumes "state 1 \<phi>"
  shows "prob0 3 (alice \<phi>) 0 = 1/2 \<and> prob1 3 (alice \<phi>) 0 = 1/2"
proof
  show "prob0 3 (alice \<phi>) 0 = 1/2"
    using alice_result assms prob0_def alice_state
    apply auto by (metis (no_types, opaque_lifting) One_nat_def phi_vec_length four_x_squared mult.commute
nonzero_mult_div_cancel_right times_divide_eq_right zero_neq_numeral)
  then show"prob1 3 (alice \<phi>) 0 = 1/2"
    using prob_sum_is_one[of "3" "alice \<phi>" "0"] alice_state[of "\<phi>"] assms by linarith
qed

lemma post_meas0_index_0_alice:
  assumes "state 1 \<phi>" and "\<alpha> = \<phi> $$ (0,0)" and "\<beta> = \<phi> $$ (1,0)"
  shows "post_meas0 3 (alice \<phi>) 0 =
mat_of_cols_list 8 [[\<alpha>/sqrt(2), \<beta>/sqrt(2), \<beta>/sqrt(2), \<alpha>/sqrt(2), 0, 0, 0, 0]]"
proof
  define v where asm:"v = mat_of_cols_list 8 [[\<alpha>/sqrt(2),\<beta>/sqrt(2),\<beta>/sqrt(2),\<alpha>/sqrt(2),0,0,0,0]]"
  then show "dim_row (post_meas0 3 (alice \<phi>) 0) = dim_row v"
    using mat_of_cols_list_def post_meas0_def assms(1) alice_state ket_vec_def by simp
  show "dim_col (post_meas0 3 (alice \<phi>) 0) = dim_col v"
    using mat_of_cols_list_def post_meas0_def assms(1) alice_state ket_vec_def asm by simp
  show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas0 3 (alice \<phi>) 0 $$ (i,j) = v $$ (i,j)"
  proof-
    fix i j assume "i < dim_row v" and "j < dim_col v"
    then have "i \<in> {0..<8} \<and> j = 0"
      using asm set_8_atLeast0 mat_of_cols_list_def by auto
    then show "post_meas0 3 (alice \<phi>) 0 $$ (i, j) = v $$ (i, j)"
      using post_meas0_def assms asm mat_of_cols_list_def ket_vec_def
      apply (auto simp add: prob_index_0_alice)
      using assms(1) alice_result select_index_def by auto
  qed
qed

lemma post_meas1_index_0_alice:
  assumes "state 1 \<phi>" and "\<alpha> = \<phi> $$ (0,0)" and "\<beta> = \<phi> $$ (1,0)"
  shows "post_meas1 3 (alice \<phi>) 0 = mat_of_cols_list 8 [[0,0,0,0,\<alpha>/sqrt(2),-\<beta>/sqrt(2),-\<beta>/sqrt(2),\<alpha>/sqrt(2)]]"
proof
  define v where asm:"v = mat_of_cols_list 8 [[0,0,0,0,\<alpha>/sqrt(2),-\<beta>/sqrt(2),-\<beta>/sqrt(2),\<alpha>/sqrt(2)]]"
  then show "dim_row (post_meas1 3 (alice \<phi>) 0) = dim_row v"
    using mat_of_cols_list_def post_meas1_def assms(1) alice_state ket_vec_def by simp
  show "dim_col (post_meas1 3 (alice \<phi>) 0) = dim_col v"
    using mat_of_cols_list_def post_meas1_def assms(1) alice_state ket_vec_def asm by simp
  show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas1 3 (alice \<phi>) 0 $$ (i,j) = v $$ (i,j)"
  proof-
    fix i j assume "i < dim_row v" and "j < dim_col v"
    then have "i \<in> {0..<8} \<and> j = 0"
      using asm set_8_atLeast0 mat_of_cols_list_def by auto
    then show "post_meas1 3 (alice \<phi>) 0 $$ (i,j) = v $$ (i,j)"
      using post_meas1_def assms asm mat_of_cols_list_def ket_vec_def
      apply (auto simp add: prob_index_0_alice)
      using assms(1) alice_result select_index_def by auto
  qed
qed

lemma post_meas0_index_0_alice_state [simp]:
  assumes "state 1 \<phi>"
  shows "state 3 (post_meas0 3 (alice \<phi>) 0)"
  using assms by (simp add: prob_index_0_alice)

lemma post_meas1_index_0_alice_state [simp]:
  assumes "state 1 \<phi>"
  shows "state 3 (post_meas1 3 (alice \<phi>) 0)"
  using assms by (simp add: prob_index_0_alice)

lemma Alice_case [simp]:
  assumes "state 1 \<phi>" and "state 3 q" and "List.member (alice_meas \<phi>) (p, q)"
  shows "alice_pos \<phi> q"
proof-
  define \<alpha> \<beta> where a0:"\<alpha> = \<phi> $$ (0,0)" and a1:"\<beta> = \<phi> $$ (1,0)"
  have f0:"prob0 3 (Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[\<phi> $$ (0,0)/sqrt 2, \<phi> $$ (Suc 0,0)/sqrt 2,
                    \<phi> $$ (Suc 0,0)/sqrt 2, \<phi> $$ (0,0)/sqrt 2,0,0,0,0]]!j!i)) (Suc 0) = 1/2"
    using post_meas0_index_0_alice prob0_def mat_of_cols_list_def post_meas0_index_0_alice_state
assms(1) a0 a1 select_index_3_subsets by (auto simp add: norm_divide power_divide phi_vec_length)
  have f1:"prob1 3 (Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[\<phi> $$ (0,0)/sqrt 2, \<phi> $$ (Suc 0,0)/sqrt 2,
                    \<phi> $$ (Suc 0,0)/sqrt 2, \<phi> $$ (0,0)/sqrt 2, 0, 0, 0, 0]] ! j ! i)) (Suc 0) = 1/2"
    using post_meas0_index_0_alice prob1_def mat_of_cols_list_def post_meas0_index_0_alice_state
assms(1) a0 a1 select_index_3_subsets by(auto simp add: norm_divide power_divide phi_vec_length algebra_simps)
  have f2:"prob0 3 (Matrix.mat 8 (Suc 0)
          (\<lambda>(i,j). [[0,0,0,0,\<phi> $$ (0,0)/complex_of_real (sqrt 2),-(\<phi> $$ (Suc 0,0)/complex_of_real (sqrt 2)),
-(\<phi> $$ (Suc 0,0)/complex_of_real (sqrt 2)),\<phi> $$ (0,0)/complex_of_real (sqrt 2)]] ! j ! i)) (Suc 0) = 1/2"
    using post_meas1_index_0_alice prob0_def mat_of_cols_list_def post_meas1_index_0_alice_state
      assms(1) a0 a1 select_index_3_subsets by(auto simp add: norm_divide power_divide phi_vec_length)
  have f3:"prob1 3 (Matrix.mat 8 (Suc 0)
          (\<lambda>(i,j). [[0,0,0,0,\<phi> $$ (0,0)/complex_of_real (sqrt 2),-(\<phi> $$ (Suc 0,0)/complex_of_real (sqrt 2)),
-(\<phi> $$ (Suc 0,0)/complex_of_real (sqrt 2)), \<phi> $$ (0,0)/complex_of_real (sqrt 2)]] ! j ! i)) (Suc 0) = 1/2"
    using post_meas1_index_0_alice prob1_def mat_of_cols_list_def post_meas1_index_0_alice_state
assms(1) a0 a1 select_index_3_subsets by(auto simp add: norm_divide power_divide phi_vec_length algebra_simps)
  have "(p, q) = ((prob0 3 (alice \<phi>) 0) * (prob0 3 (post_meas0 3 (alice \<phi>) 0) 1), post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1) \<or>
        (p, q) = ((prob0 3 (alice \<phi>) 0) * (prob1 3 (post_meas0 3 (alice \<phi>) 0) 1), post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1) \<or>
        (p, q) = ((prob1 3 (alice \<phi>) 0) * (prob0 3 (post_meas1 3 (alice \<phi>) 0) 1), post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1) \<or>
        (p, q) = ((prob1 3 (alice \<phi>) 0) * (prob1 3 (post_meas1 3 (alice \<phi>) 0) 1), post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1)"
    using assms(3) alice_meas_def List.member_def by(smt list.distinct(1) list.exhaust list.inject member_rec(1) member_rec(2))
  then have "q = post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1 \<or> q = post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1 \<or>
             q = post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1 \<or> q = post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1"
    by auto
  moreover have "post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1 = mat_of_cols_list 8 [[\<alpha>,\<beta>,0,0,0,0,0,0]]"
  proof
    define v where asm:"v = mat_of_cols_list 8 [[\<alpha>, \<beta>, 0, 0, 0, 0, 0, 0]]"
    then show "dim_row (post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1) = dim_row v"
      using mat_of_cols_list_def post_meas0_def ket_vec_def by simp
    show "dim_col (post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1) = dim_col v"
      using mat_of_cols_list_def post_meas0_def ket_vec_def asm by simp
    show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
    proof-
      fix i j assume "i < dim_row v" and "j < dim_col v"
      then have "i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def by auto
      then show "post_meas0 3 (post_meas0 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
        using post_meas0_index_0_alice assms(1) a0 a1
        apply (auto)
        using post_meas0_def asm mat_of_cols_list_def ket_vec_def select_index_def
        by (auto simp add: f0 real_sqrt_divide)
    qed
  qed
  moreover have "post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1 = mat_of_cols_list 8 [[0,0,\<beta>,\<alpha>,0,0,0,0]]"
  proof
    define v where asm:"v = mat_of_cols_list 8 [[0,0,\<beta>,\<alpha>,0,0,0,0]]"
    then show "dim_row (post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1) = dim_row v"
      using mat_of_cols_list_def post_meas1_def ket_vec_def asm by auto
    show "dim_col (post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1) = dim_col v"
      using mat_of_cols_list_def post_meas1_def ket_vec_def asm by auto
    show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
    proof-
      fix i j assume "i < dim_row v" and "j < dim_col v"
      then have "i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def by auto
      then show "post_meas1 3 (post_meas0 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
        using post_meas0_index_0_alice assms(1) a0 a1
        apply (auto)
        using post_meas1_def asm mat_of_cols_list_def ket_vec_def select_index_def
        by (auto simp add: f1 real_sqrt_divide)
    qed
  qed
  moreover have "post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1 = mat_of_cols_list 8 [[0,0,0,0,\<alpha>,-\<beta>,0,0]]"
  proof
    define v where asm:"v = mat_of_cols_list 8 [[0, 0, 0, 0, \<alpha>, -\<beta>, 0, 0]]"
    then show "dim_row (post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1) = dim_row v"
      using mat_of_cols_list_def post_meas0_def ket_vec_def by simp
    show "dim_col (post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1) = dim_col v"
      using mat_of_cols_list_def post_meas0_def ket_vec_def asm by simp
    show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
    proof-
      fix i j assume "i < dim_row v" and "j < dim_col v"
      then have "i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def by auto
      then show "post_meas0 3 (post_meas1 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
        using post_meas1_index_0_alice assms(1) a0 a1
        apply (auto)
        using post_meas0_def asm mat_of_cols_list_def ket_vec_def select_index_def
        by (auto simp add: f2 real_sqrt_divide)
    qed
  qed
  moreover have "post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1 = mat_of_cols_list 8 [[0,0,0,0,0,0,-\<beta>,\<alpha>]]"
  proof
    define v where asm:"v = mat_of_cols_list 8 [[0,0,0,0,0,0,-\<beta>,\<alpha>]]"
    then show "dim_row (post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1) = dim_row v"
      using mat_of_cols_list_def post_meas1_def ket_vec_def by simp
    show "dim_col (post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1) = dim_col v"
      using mat_of_cols_list_def post_meas1_def ket_vec_def asm by simp
    show "\<And>i j. i<dim_row v \<Longrightarrow> j<dim_col v \<Longrightarrow> post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
    proof-
      fix i j assume "i < dim_row v" and "j < dim_col v"
      then have "i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def by auto
      then show "post_meas1 3 (post_meas1 3 (alice \<phi>) 0) 1 $$ (i,j) = v $$ (i,j)"
        using post_meas1_index_0_alice assms(1) a0 a1
        apply (auto)
        using post_meas1_def asm mat_of_cols_list_def ket_vec_def select_index_def
        by (auto simp add: f3 real_sqrt_divide)
    qed
  qed
  ultimately show ?thesis using alice_pos_def a0 a1 by simp
qed

datatype bit = zero | one

definition alice_out:: "complex Matrix.mat => complex Matrix.mat => bit \<times> bit" where
"alice_out \<phi> q \<equiv>
if q = mat_of_cols_list 8 [[\<phi> $$ (0,0), \<phi> $$ (1,0), 0, 0, 0, 0, 0, 0]] then (zero, zero) else
  if q = mat_of_cols_list 8 [[0, 0, \<phi> $$ (1,0), \<phi> $$ (0,0), 0, 0, 0, 0]] then (zero, one) else
    if q = mat_of_cols_list 8 [[0, 0, 0, 0, \<phi> $$ (0,0), - \<phi> $$ (1,0), 0, 0]] then (one, zero) else
      if q = mat_of_cols_list 8 [[0, 0, 0, 0, 0, 0, - \<phi> $$ (1,0), \<phi> $$ (0,0)]] then (one, one) else
        undefined"

definition bob:: "complex Matrix.mat => bit \<times> bit \<Rightarrow> complex Matrix.mat" where
"bob q b \<equiv>
if (fst b, snd b) = (zero, zero) then q else
  if (fst b, snd b) = (zero, one) then (Id 2 \<Otimes> X) * q else
    if (fst b, snd b) = (one, zero) then (Id 2 \<Otimes> Z) * q else
      if (fst b, snd b) = (one, one) then (Id 2 \<Otimes> Z * X) * q else
        undefined"

lemma alice_out_unique [simp]:
  assumes "state 1 \<phi>"
  shows "Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, \<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0), 0, 0, 0, 0]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[\<phi> $$ (0, 0), \<phi> $$ (Suc 0, 0), 0, 0, 0, 0, 0, 0]]!j!i) \<and>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, \<phi> $$ (0, 0), -\<phi> $$ (Suc 0, 0), 0, 0]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[\<phi> $$ (0, 0), \<phi> $$ (Suc 0, 0), 0, 0, 0, 0, 0, 0]]!j!i) \<and>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, 0, 0, -\<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0)]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[\<phi> $$ (0, 0), \<phi> $$ (Suc 0, 0), 0, 0, 0, 0, 0, 0]]!j!i) \<and>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, \<phi> $$ (0, 0), -\<phi> $$ (Suc 0, 0), 0, 0]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, \<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0), 0, 0, 0, 0]]!j!i) \<and>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, 0, 0, -\<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0)]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, \<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0), 0, 0, 0, 0]]!j!i) \<and>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, 0, 0, -\<phi> $$ (Suc 0, 0), \<phi> $$ (0, 0)]]!j!i) \<noteq>
         Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0, 0, 0, 0, \<phi> $$ (0, 0), -\<phi> $$ (Suc 0, 0), 0, 0]]!j!i)"
proof-
  have f0:"\<phi> $$ (0,0) \<noteq> 0 \<or> \<phi> $$ (1,0) \<noteq> 0"
    using assms state_def Matrix.col_def cpx_vec_length_def set_2 by(auto simp add: atLeast0LessThan)
  define v1 v2 v3 v4 where d0:"v1 = Matrix.mat 8 1 (\<lambda>(i,j). [[\<phi> $$ (0,0),\<phi> $$ (1,0),0,0,0,0,0,0]]!j!i)"
                       and d1:"v2 = Matrix.mat 8 1 (\<lambda>(i,j). [[0,0,\<phi> $$ (1,0), \<phi> $$ (0,0),0,0,0,0]]!j!i)"
                       and d2:"v3 = Matrix.mat 8 1 (\<lambda>(i,j). [[0,0,0,0,\<phi> $$ (0,0),-\<phi> $$ (1,0),0,0]]!j!i)"
                       and d3:"v4 = Matrix.mat 8 1 (\<lambda>(i,j). [[0,0,0,0,0,0,-\<phi> $$ (1,0),\<phi> $$ (0,0)]]!j!i)"
  then have "(v1 $$ (0,0) \<noteq> v2 $$ (0,0) \<or> v1 $$ (1,0) \<noteq> v2 $$ (1,0)) \<and>
             (v1 $$ (0,0) \<noteq> v3 $$ (0,0) \<or> v1 $$ (1,0) \<noteq> v3 $$ (1,0)) \<and>
             (v1 $$ (0,0) \<noteq> v4 $$ (0,0) \<or> v1 $$ (1,0) \<noteq> v4 $$ (1,0)) \<and>
             (v2 $$ (2,0) \<noteq> v3 $$ (2,0) \<or> v2 $$ (3,0) \<noteq> v3 $$ (3,0)) \<and>
             (v2 $$ (2,0) \<noteq> v4 $$ (2,0) \<or> v2 $$ (3,0) \<noteq> v4 $$ (3,0)) \<and>
             (v3 $$ (4,0) \<noteq> v4 $$ (4,0) \<or> v3 $$ (5,0) \<noteq> v4 $$ (5,0))" using f0 by auto
  then have "v1 \<noteq> v2 \<and> v1 \<noteq> v3 \<and> v1 \<noteq> v4 \<and> v2 \<noteq> v3 \<and> v2 \<noteq> v4 \<and> v3 \<noteq> v4" by auto
  thus ?thesis by (auto simp add: d0 d1 d2 d3)
qed

abbreviation M3:: "complex Matrix.mat" where
"M3 \<equiv> mat_of_cols_list 8 [[0, 1, 0, 0, 0, 0, 0, 0],
                          [1, 0, 0, 0, 0, 0, 0, 0],
                          [0, 0, 0, 1, 0, 0, 0, 0],
                          [0, 0, 1, 0, 0, 0, 0, 0],
                          [0, 0, 0, 0, 0, 1, 0, 0],
                          [0, 0, 0, 0, 1, 0, 0, 0],
                          [0, 0, 0, 0, 0, 0, 0, 1],
                          [0, 0, 0, 0, 0, 0, 1, 0]]"

lemma tensor_prod_of_id_2_x:
  shows "(Id 2 \<Otimes> X) = M3"
proof
    have f0:"gate 3 (Id 2 \<Otimes> X)"
      using X_is_gate tensor_gate[of "2" "Id 2" "1" "X"] by simp
    then show "dim_row (Id 2 \<Otimes> X) = dim_row M3"
      using gate_def by (simp add: mat_of_cols_list_def)
    show "dim_col (Id 2 \<Otimes> X) = dim_col M3"
      using f0 gate_def by (simp add: mat_of_cols_list_def)
    show "\<And>i j. i < dim_row M3 \<Longrightarrow> j < dim_col M3 \<Longrightarrow> (Id 2 \<Otimes> X) $$ (i,j) = M3 $$ (i,j)"
    proof-
      fix i j assume "i < dim_row M3" and "j < dim_col M3"
      then have "i \<in> {0..<8} \<and> j \<in> {0..<8}" by (auto simp add: mat_of_cols_list_def)
      then show "(Id 2 \<Otimes> X) $$ (i,j) = M3 $$ (i,j)"
        using Id_def X_def index_tensor_mat[of "Id 2" "4" "4" "X" "2" "2" "i" "j"] gate_def X_is_gate
id_is_gate Id_def by (auto simp add: mat_of_cols_list_def X_def)
    qed
qed

abbreviation M4:: "complex Matrix.mat" where
"M4 \<equiv> mat_of_cols_list 8 [[0, -1, 0, 0, 0, 0, 0, 0],
                          [1, 0, 0, 0, 0, 0, 0, 0],
                          [0, 0, 0, -1, 0, 0, 0, 0],
                          [0, 0, 1, 0, 0, 0, 0, 0],
                          [0, 0, 0, 0, 0, -1, 0, 0],
                          [0, 0, 0, 0, 1, 0, 0, 0],
                          [0, 0, 0, 0, 0, 0, 0, -1],
                          [0, 0, 0, 0, 0, 0, 1, 0]]"

abbreviation ZX:: "complex Matrix.mat" where
"ZX \<equiv> mat_of_cols_list 2 [[0, -1], [1, 0]]"

lemma l_inv_of_ZX:
  shows "ZX\<^sup>\<dagger> * ZX = 1\<^sub>m 2"
proof
  show "dim_row (ZX\<^sup>\<dagger> * ZX) = dim_row (1\<^sub>m 2)" using dagger_def mat_of_cols_list_def by simp
  show "dim_col (ZX\<^sup>\<dagger> * ZX) = dim_col (1\<^sub>m 2)" using dagger_def mat_of_cols_list_def by simp
  show "\<And>i j. i < dim_row (1\<^sub>m 2) \<Longrightarrow> j < dim_col (1\<^sub>m 2) \<Longrightarrow> (ZX\<^sup>\<dagger> * ZX) $$ (i, j) = 1\<^sub>m 2 $$ (i, j)"
  proof-
    fix i j assume "i < dim_row (1\<^sub>m 2)" and "j < dim_col (1\<^sub>m 2)"
    then have "i \<in> {0..<2} \<and> j \<in> {0..<2}" by auto
    then show "(ZX\<^sup>\<dagger> * ZX) $$ (i, j) = 1\<^sub>m 2 $$ (i, j)"
      using mat_of_cols_list_def dagger_def by (auto simp add: set_2)
  qed
qed

lemma r_inv_of_ZX:
  shows "ZX * (ZX\<^sup>\<dagger>) = 1\<^sub>m 2"
proof
  show "dim_row (ZX * (ZX\<^sup>\<dagger>)) = dim_row (1\<^sub>m 2)" using dagger_def mat_of_cols_list_def by simp
  show "dim_col (ZX * (ZX\<^sup>\<dagger>)) = dim_col (1\<^sub>m 2)" using dagger_def mat_of_cols_list_def by simp
  show "\<And>i j. i < dim_row (1\<^sub>m 2) \<Longrightarrow> j < dim_col (1\<^sub>m 2) \<Longrightarrow> (ZX * (ZX\<^sup>\<dagger>)) $$ (i, j) = 1\<^sub>m 2 $$ (i, j)"
  proof-
    fix i j assume "i < dim_row (1\<^sub>m 2)" and "j < dim_col (1\<^sub>m 2)"
    then have "i \<in> {0..<2} \<and> j \<in> {0..<2}" by auto
    then show "(ZX * (ZX\<^sup>\<dagger>)) $$ (i, j) = 1\<^sub>m 2 $$ (i, j)"
      using mat_of_cols_list_def dagger_def by (auto simp add: set_2)
  qed
qed

lemma ZX_is_gate [simp]:
  shows "gate 1 ZX"
proof
  show "dim_row ZX = 2 ^ 1" using mat_of_cols_list_def by simp
  show "square_mat ZX" using mat_of_cols_list_def by simp
  show "unitary ZX" using unitary_def l_inv_of_ZX r_inv_of_ZX mat_of_cols_list_def by auto
qed

lemma prod_of_ZX:
  shows "Z * X = ZX"
proof
  show "dim_row (Z * X) = dim_row ZX"
    using Z_is_gate mat_of_cols_list_def gate_def by auto
  show "dim_col (Z * X) = dim_col ZX"
    using X_is_gate mat_of_cols_list_def gate_def by auto
  show "\<And>i j. i < dim_row ZX \<Longrightarrow> j < dim_col ZX \<Longrightarrow> (Z * X) $$ (i, j) = ZX $$ (i, j)"
  proof-
    fix i j assume "i < dim_row ZX" and "j < dim_col ZX"
    then have "i \<in> {0..<2} \<and> j \<in> {0..<2}" by (auto simp add: mat_of_cols_list_def)
    then show "(Z * X) $$ (i, j) = ZX $$ (i, j)" by (auto simp add: set_2 Z_def X_def)
  qed
qed

lemma tensor_prod_of_id_2_y:
  shows "(Id 2 \<Otimes> Z * X) = M4"
proof
  have f0:"gate 3 (Id 2 \<Otimes> Z * X)"
    using prod_of_ZX ZX_is_gate tensor_gate[of "2" "Id 2" "1" "Z * X"] by simp
  then show "dim_row (Id 2 \<Otimes> Z * X) = dim_row M4"
      using gate_def by (simp add: mat_of_cols_list_def)
  show "dim_col (Id 2 \<Otimes> Z * X) = dim_col M4"
    using f0 gate_def by (simp add: mat_of_cols_list_def)
  show "\<And>i j. i < dim_row M4 \<Longrightarrow> j < dim_col M4 \<Longrightarrow> (Id 2 \<Otimes> Z * X) $$ (i,j) = M4 $$ (i,j)"
  proof-
    fix i j assume "i < dim_row M4" and "j < dim_col M4"
    then have "i \<in> {0..<8} \<and> j \<in> {0..<8}" by (auto simp add: mat_of_cols_list_def)
    then have "(Id 2 \<Otimes> ZX) $$ (i, j) = M4 $$ (i,j)"
      using Id_def mat_of_cols_list_def index_tensor_mat[of "Id 2" "4" "4" "ZX" "2" "2" "i" "j"]
        gate_def ZX_is_gate id_is_gate
      by (auto simp add: mat_of_cols_list_def)
    then show "(Id 2 \<Otimes> Z * X) $$ (i, j) = M4 $$ (i,j)"
      using prod_of_ZX by simp
    qed
qed

abbreviation M5:: "complex Matrix.mat" where
"M5 \<equiv> mat_of_cols_list 8 [[1, 0, 0, 0, 0, 0, 0, 0],
                          [0, -1, 0, 0, 0, 0, 0, 0],
                          [0, 0, 1, 0, 0, 0, 0, 0],
                          [0, 0, 0, -1, 0, 0, 0, 0],
                          [0, 0, 0, 0, 1, 0, 0, 0],
                          [0, 0, 0, 0, 0, -1, 0, 0],
                          [0, 0, 0, 0, 0, 0, 1, 0],
                          [0, 0, 0, 0, 0, 0, 0, -1]]"

lemma tensor_prod_of_id_2_z:
  shows "(Id 2 \<Otimes> Z) = M5"
proof
    have f0:"gate 3 (Id 2 \<Otimes> Z)"
      using Z_is_gate tensor_gate[of "2" "Id 2" "1" "Z"] by simp
    then show "dim_row (Id 2 \<Otimes> Z) = dim_row M5"
      using gate_def by (simp add:  mat_of_cols_list_def)
    show "dim_col (Id 2 \<Otimes> Z) = dim_col M5"
      using f0 gate_def by (simp add:  mat_of_cols_list_def)
    show "\<And>i j. i < dim_row M5 \<Longrightarrow> j < dim_col M5 \<Longrightarrow> (Id 2 \<Otimes> Z) $$ (i,j) = M5 $$ (i,j)"
    proof-
      fix i j assume "i < dim_row M5" and "j < dim_col M5"
      then have "i \<in> {0..<8} \<and> j \<in> {0..<8}" by (auto simp add: mat_of_cols_list_def)
      then show "(Id 2 \<Otimes> Z) $$ (i, j) = M5 $$ (i,j)"
        using Id_def Z_def index_tensor_mat[of "Id 2" "4" "4" "Z" "2" "2" "i" "j"] gate_def Z_is_gate
id_is_gate Id_def by (auto simp add: mat_of_cols_list_def Z_def)
    qed
qed

lemma teleportation:
  assumes "state 1 \<phi>" and "state 3 q" and "List.member (alice_meas \<phi>) (p, q)"
  shows "\<exists>r. state 2 r \<and> bob q (alice_out \<phi> q) = r \<Otimes> \<phi>"
proof-
  define \<alpha> \<beta> where a0:"\<alpha> = \<phi> $$ (0,0)" and a1:"\<beta> = \<phi> $$ (1,0)"
  then have "q = mat_of_cols_list 8 [[\<alpha>, \<beta>, 0, 0, 0, 0, 0, 0]] \<or>
             q = mat_of_cols_list 8 [[0, 0, \<beta>, \<alpha>, 0, 0, 0, 0]] \<or>
             q = mat_of_cols_list 8 [[0, 0, 0, 0, \<alpha>, -\<beta>, 0, 0]] \<or>
             q = mat_of_cols_list 8 [[0, 0, 0, 0, 0, 0, -\<beta>, \<alpha>]]"
    using assms Alice_case alice_pos_def by simp
  moreover have "q = mat_of_cols_list 8 [[\<alpha>,\<beta>,0,0,0,0,0,0]] \<Longrightarrow> bob q (alice_out \<phi> q) =
mat_of_cols_list 4 [[1, 0, 0, 0]] \<Otimes> \<phi>"
  proof
    assume asm:"q = Tensor.mat_of_cols_list 8 [[\<alpha>, \<beta>, 0, 0, 0, 0, 0, 0]]"
    show "dim_row (bob q (alice_out \<phi> q)) = dim_row (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm by simp
    show "dim_col (bob q (alice_out \<phi> q)) = dim_col (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm by simp
    show "\<And>i j. i < dim_row (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>) \<Longrightarrow>
                j < dim_col (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>) \<Longrightarrow>
           bob q (alice_out \<phi> q) $$ (i, j) = (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>) $$ (i,j)"
    proof-
      fix i j assume "i < dim_row (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>)" and
                     "j < dim_col (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>)"
      then have "i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def assms state_def by auto
      then show "bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[1,0,0,0]] \<Otimes> \<phi>) $$ (i,j)"
        using bob_def alice_out_def asm mat_of_cols_list_def a0 a1 assms state_def by auto
    qed
  qed
  moreover have "q = mat_of_cols_list 8 [[0,0,\<beta>,\<alpha>,0,0,0,0]] \<Longrightarrow> bob q (alice_out \<phi> q) =
mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>"
  proof
    assume asm:"q = Tensor.mat_of_cols_list 8 [[0,0,\<beta>,\<alpha>,0,0,0,0]]"
    show "dim_row (bob q (alice_out \<phi> q)) = dim_row (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm tensor_prod_of_id_2_x by simp
    show "dim_col (bob q (alice_out \<phi> q)) = dim_col (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm by simp
    show "\<And>i j. i < dim_row (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>) \<Longrightarrow>
                j < dim_col (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>) \<Longrightarrow>
           bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>) $$ (i,j)"
    proof-
      fix i j assume "i < dim_row (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>)" and
                     "j < dim_col (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>)"
      then have c1:"i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def assms(1) state_def by auto
      then have "(M3 * (Matrix.mat 8 1 (\<lambda>(i,j). [[0,0,\<phi> $$ (1,0),\<phi> $$ (0,0),0,0,0,0]]!j!i))) $$ (i,j) =
(Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>) $$ (i,j)"
        using state_def assms(1) by(auto simp add:  a0 a1 mat_of_cols_list_def times_mat_def scalar_prod_def)
      then show "bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,1,0,0]] \<Otimes> \<phi>) $$ (i,j)"
        using bob_def alice_out_def asm c1 a0 a1 mat_of_cols_list_def tensor_prod_of_id_2_x assms(1) by simp
    qed
  qed
  moreover have "q = mat_of_cols_list 8 [[0,0,0,0,\<alpha>,-\<beta>,0,0]] \<Longrightarrow> bob q (alice_out \<phi> q) =
mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>"
  proof
    assume asm:"q = Tensor.mat_of_cols_list 8 [[0,0,0,0,\<alpha>,-\<beta>,0,0]]"
    show "dim_row (bob q (alice_out \<phi> q)) = dim_row (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm tensor_prod_of_id_2_z by simp
    show "dim_col (bob q (alice_out \<phi> q)) = dim_col (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm by simp
    show "\<And>i j. i < dim_row (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>) \<Longrightarrow>
                j < dim_col (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>) \<Longrightarrow>
           bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>) $$ (i,j)"
    proof-
      fix i j assume "i < dim_row (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>)" and
                     "j < dim_col (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>)"
      then have c1:"i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def assms state_def by auto
      then have "(M5 * (Matrix.mat 8 (Suc 0) (\<lambda>(i,j). [[0,0,0,0,\<phi> $$ (0,0),-\<phi> $$ (Suc 0,0),0,0]]!j!i))) $$ (i,j) =
(Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>) $$ (i,j)"
        using state_def assms(1) by(auto simp add: a0 a1 mat_of_cols_list_def times_mat_def scalar_prod_def)
      then show "bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,0,1,0]] \<Otimes> \<phi>) $$ (i,j)"
        using bob_def alice_out_def asm c1 a0 a1 mat_of_cols_list_def tensor_prod_of_id_2_z assms(1) by simp
    qed
  qed
  moreover have "q = mat_of_cols_list 8 [[0, 0, 0, 0, 0, 0, -\<beta>, \<alpha>]] \<Longrightarrow> bob q (alice_out \<phi> q) =
mat_of_cols_list 4 [[0, 0, 0, 1]] \<Otimes> \<phi>"
  proof
    assume asm:"q = Tensor.mat_of_cols_list 8 [[0, 0, 0, 0, 0, 0, -\<beta>, \<alpha>]]"
    show "dim_row (bob q (alice_out \<phi> q)) = dim_row (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm tensor_prod_of_id_2_y by simp
    show "dim_col (bob q (alice_out \<phi> q)) = dim_col (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>)"
      using mat_of_cols_list_def a0 a1 assms(1) state_def bob_def alice_out_def asm by simp
    show "\<And>i j. i < dim_row (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>) \<Longrightarrow>
                j < dim_col (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>) \<Longrightarrow>
           bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>) $$ (i,j)"
    proof-
      fix i j assume "i < dim_row (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>)" and
                     "j < dim_col (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>)"
      then have c1:"i \<in> {0..<8} \<and> j = 0"
        using asm mat_of_cols_list_def assms state_def by auto
      then have "(M4 * (Matrix.mat 8 (Suc 0) (\<lambda>(i, j). [[0,0,0,0,0,0,-\<phi> $$ (Suc 0,0),\<phi> $$ (0,0)]]!j!i))) $$ (i,j) =
(Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>) $$ (i,j)"
        using state_def assms(1) by(auto simp add: a0 a1 mat_of_cols_list_def times_mat_def scalar_prod_def)
      then show "bob q (alice_out \<phi> q) $$ (i,j) = (Tensor.mat_of_cols_list 4 [[0,0,0,1]] \<Otimes> \<phi>) $$ (i,j)"
        using bob_def alice_out_def asm c1 a0 a1 mat_of_cols_list_def tensor_prod_of_id_2_y assms(1) by simp
    qed
  qed
  moreover have "state 2 (mat_of_cols_list 4 [[1, 0, 0, 0]])"
    using state_def mat_of_cols_list_def cpx_vec_length_def lessThan_atLeast0 by simp
  moreover have "state 2 (mat_of_cols_list 4 [[0, 1, 0, 0]])"
    using state_def mat_of_cols_list_def cpx_vec_length_def lessThan_atLeast0 by simp
  moreover have "state 2 (mat_of_cols_list 4 [[0, 0, 1, 0]])"
    using state_def mat_of_cols_list_def cpx_vec_length_def lessThan_atLeast0 by simp
  moreover have "state 2 (mat_of_cols_list 4 [[0, 0, 0, 1]])"
    using state_def mat_of_cols_list_def cpx_vec_length_def lessThan_atLeast0 by simp
  ultimately show ?thesis by auto
qed

(*
Biblio:

@inproceedings{Boender2015FormalizationOQ,
  title={Formalization of Quantum Protocols using Coq},
  author={Jaap Boender and Florian Kamm{\"u}ller and Rajagopal Nagarajan},
  booktitle={QPL},
  year={2015}
}
*)

end


section \<open>Separations\<close>

theory Separations imports Helpers Graph begin

locale Separation = v0_v1_Digraph +
  fixes S :: "'a set"
  assumes S_V: "S \<subseteq> V"
    and v0_notin_S: "v0 \<notin> S"
    and v1_notin_S: "v1 \<notin> S"
    and S_separates: "\<And>xs. v0\<leadsto>xs\<leadsto>v1 \<Longrightarrow> set xs \<inter> S \<noteq> {}"

lemma (in Separation) finite_S [simp]: "finite S" using S_V finite_subset finite_vertex_set by auto

lemma (in v0_v1_Digraph) subgraph_separation_extend:
  assumes "v \<noteq> v0" "v \<noteq> v1" "v \<in> V"
    and "Separation (remove_vertex v) v0 v1 S"
  shows "Separation G v0 v1 (insert v S)"
proof (rule Separation.intro)
  interpret G: Separation "remove_vertex v" v0 v1 S using assms(4) .
  show "v0_v1_Digraph G v0 v1" using v0_v1_Digraph_axioms .
  show "Separation_axioms G v0 v1 (insert v S)" proof
    show "insert v S \<subseteq> V" by (meson G.S_V assms(3) insert_subsetI remove_vertex_V' subset_trans)
    show "v0 \<notin> insert v S" using G.v0_notin_S assms(1) by blast
    show "v1 \<notin> insert v S" using G.v1_notin_S assms(2) by blast
  next
    fix xs assume "v0 \<leadsto>xs\<leadsto> v1"
    show "set xs \<inter> insert v S \<noteq> {}" proof (cases)
      assume "v \<notin> set xs"
      then have "v0 \<leadsto>xs\<leadsto>\<^bsub>remove_vertex v\<^esub> v1"
        using remove_vertex_path_from_to \<open>v0 \<leadsto>xs\<leadsto> v1\<close> assms(3) by blast
      then show ?thesis by (simp add: G.S_separates)
    qed simp
  qed
qed

lemma (in v0_v1_Digraph) subgraph_separation_min_size:
  assumes "v \<noteq> v0" "v \<noteq> v1" "v \<in> V"
    and no_small_separation: "\<And>S. Separation G v0 v1 S \<Longrightarrow> card S \<ge> Suc n"
    and "Separation (remove_vertex v) v0 v1 S"
  shows "card S \<ge> n"
  using subgraph_separation_extend
  by (metis Separation.finite_S Suc_leD assms card_insert_disjoint insert_absorb not_less_eq_eq)

lemma (in v0_v1_Digraph) path_exists_if_no_separation:
  assumes "S \<subseteq> V" "v0 \<notin> S" "v1 \<notin> S" "\<not>Separation G v0 v1 S"
  shows "\<exists>xs. v0\<leadsto>xs\<leadsto>v1 \<and> set xs \<inter> S = {}"
  by (meson assms Separation.intro Separation_axioms.intro v0_v1_Digraph_axioms)

end


theory ConcreteSemantics12_VCG
  imports "~~/src/HOL/IMP/Hoare"
begin

subsection "Verification Condition Generation"

subsubsection "Annotated Commands"

text\<open>Commands where loops are annotated with invariants.\<close>

datatype acom =
Askip ("SKIP")|
Aassign vname aexp ("(_ ::= _)" [1000,61] 61)|
Aseq acom acom ("(_;;/ _)" [60,61]60)|
Aif bexp acom acom ("(IF _/ THEN _/ ELSE _)" [0, 0, 61] 61)|
Awhile assn bexp acom ("({_}/ WHILE _/ DO _)" [0, 0, 61] 61)

notation com.SKIP ("SKIP")

text\<open>Weakest precondition:\<close>
(*
definition wp :: "com \<Rightarrow> assn \<Rightarrow> assn" where
"wp c Q = (\<lambda>s. \<forall>t. (c,s) \<Rightarrow> t  \<longrightarrow>  Q t)"
*)

fun pre :: "acom \<Rightarrow> assn \<Rightarrow> assn" where
"pre SKIP Q = Q" |
"pre (x ::= a) Q = (\<lambda>s. Q(s(x := aval a s)))" |
"pre (C\<^sub>1;; C\<^sub>2) Q = pre C\<^sub>1 (pre C\<^sub>2 Q)" |
"pre (IF b THEN C\<^sub>1 ELSE C\<^sub>2) Q = (\<lambda>s. if bval b s then pre C\<^sub>1 Q s else pre C\<^sub>2 Q s)" |
"pre ({I} WHILE b DO C) Q = I"

text\<open>Verification condition:\<close>

fun vc :: "acom \<Rightarrow> assn \<Rightarrow> bool" where
"vc SKIP Q = True" |
"vc (x ::= a) Q = True" |
"vc (C\<^sub>1;; C\<^sub>2) Q = (vc C\<^sub>1 (pre C\<^sub>2 Q) \<and> vc C\<^sub>2 Q)" |
"vc (IF b THEN C\<^sub>1 ELSE C\<^sub>2) Q = (vc C\<^sub>1 Q \<and> vc C\<^sub>2 Q)" |
"vc ({I} WHILE b DO C) Q =
  ((\<forall>s. (I s \<and> bval b s \<longrightarrow> pre C I s) \<and>
        (I s \<and> \<not> bval b s \<longrightarrow> Q s)) \<and>
    vc C I)"

text\<open>Strip annotations:\<close>

fun strip :: "acom \<Rightarrow> com" where
"strip SKIP = SKIP" |
"strip (x ::= a) = (x ::= a)" |
"strip (C\<^sub>1;; C\<^sub>2) = (strip C\<^sub>1;; strip C\<^sub>2)" |
"strip (IF b THEN C\<^sub>1 ELSE C\<^sub>2) = (IF b THEN strip C\<^sub>1 ELSE strip C\<^sub>2)" |
"strip ({_} WHILE b DO C) = (WHILE b DO strip C)"

subsubsection "Soundness"

(*Lemma 12.9*)
lemma vc_sound: "vc C Q \<Longrightarrow> \<turnstile> {pre C Q} strip C {Q}"
proof(induction C arbitrary: Q)
case Askip
  then show ?case
    by simp
next
  case (Aassign x1 x2)
  then show ?case by simp
next
  case (Aseq C1 C2)
  then show ?case
    by auto
next
  case (Aif x1 C1 C2)
  then show ?case
    by (auto intro: hoare.conseq)
(*    by (smt If pre.simps(4) strengthen_pre strip.simps(4) vc.simps(4))*)
next
  case (Awhile I b C)
  show ?case
  proof(simp, rule While')
    have vc: "vc C I" and IQ: "\<forall>s. I s \<and> \<not> bval b s \<longrightarrow> Q s" and
         pre: "\<forall>s. I s \<and> bval b s \<longrightarrow> pre C I s"
      using Awhile.prems by auto
    show " \<turnstile> {\<lambda>s. I s \<and> bval b s} strip C {I}"
      using Awhile.IH pre strengthen_pre vc by auto
    show "\<forall> s. I s \<and> \<not> bval b s \<longrightarrow> Q s"
      using Awhile.prems by auto
  qed
(*
  then show ?case
    by (smt While' pre.simps(5) strengthen_pre strip.simps(5) vc.simps(5))*)
qed

(*Corollary 12.8.*)
corollary vc_sound':
  "\<lbrakk> vc C Q; \<forall>s. P s \<longrightarrow> pre C Q s \<rbrakk> \<Longrightarrow> \<turnstile> {P} strip C {Q}"
  by (simp add: strengthen_pre vc_sound)

subsubsection "Completeness"

lemma pre_mono:
  "\<forall>s. P s \<longrightarrow> P' s \<Longrightarrow> pre C P s \<Longrightarrow> pre C P' s"
proof(induction C arbitrary: P P' s)
case Askip
then show ?case  by simp
next
  case (Aassign x1 x2)
  then show ?case
    by auto
next
  case (Aseq C1 C2)
  then show ?case
    by (smt pre.simps(3))
next
  case (Aif x1 C1 C2)
  then show ?case  by simp
next
  case (Awhile x1 x2 C)
  then show ?case by simp
qed

lemma vc_mono:
  "\<forall>s. P s \<longrightarrow> P' s \<Longrightarrow> vc C P \<Longrightarrow> vc C P'"
proof(induction C arbitrary: P P' )
case Askip
  then show ?case by simp
next
  case (Aassign x1 x2)
  then show ?case by simp
next
  case (Aseq C1 C2)
  then show ?case
    by (metis pre_mono vc.simps(3))
next
  case (Aif x1 C1 C2)
  then show ?case by simp
next
  case (Awhile x1 x2 C)
  then show ?case by simp
qed

(*Lemma 12.11*)
lemma vc_complete:
 "\<turnstile> {P}c{Q} \<Longrightarrow> \<exists>C. strip C = c \<and> vc C Q \<and> (\<forall>s. P s \<longrightarrow> pre C Q s)"
  (is "_ \<Longrightarrow> \<exists>C. ?G P c Q C")
proof (induction rule: hoare.induct)
  case (Skip P)
  then show ?case
    using strip.simps(1) by fastforce
next
  case (Assign P a x)
  then show ?case using strip.simps(2) by fastforce
next
  case (Seq P c\<^sub>1 Q c\<^sub>2 R)
  obtain C1 where ih1: "?G P c\<^sub>1 Q C1"
    using Seq.IH(1) by auto
  obtain C2 where ih2: "?G Q c\<^sub>2 R C2"
    using Seq.IH(2) by auto
  show ?case (is "\<exists>C. ?C C")
  proof
    show "?C(Aseq C1 C2)"
      using ih1 ih2 by (fastforce elim!: pre_mono vc_mono)
  qed
  (*show ?case using ih1 ih2
     by (smt pre.simps(3) pre_mono strip.simps(3) vc.simps(3) vc_mono)*)
next
  case (If P b c\<^sub>1 Q c\<^sub>2)
(*
 1. \<And>P b c\<^sub>1 Q c\<^sub>2.
       \<turnstile> {\<lambda>s. P s \<and> bval b s} c\<^sub>1 {Q} \<Longrightarrow>
       \<exists>C. strip C = c\<^sub>1 \<and> vc C Q \<and> (\<forall>s. P s \<and> bval b s \<longrightarrow> pre C Q s) \<Longrightarrow>
       \<turnstile> {\<lambda>s. P s \<and> \<not> bval b s} c\<^sub>2 {Q} \<Longrightarrow> \<exists>C. strip C = c\<^sub>2 \<and> vc C Q \<and> (\<forall>s. P s \<and> \<not> bval b s \<longrightarrow> pre C Q s) \<Longrightarrow> \<exists>C. strip C = IF b THEN c\<^sub>1 ELSE c\<^sub>2 \<and> vc C Q \<and> (\<forall>s. P s \<longrightarrow> pre C Q s)
*)
  obtain C1 where ih1: "?G (\<lambda>s. P s \<and> bval b s) c\<^sub>1 Q C1"
    using If.IH(1) by auto
  obtain C2 where ih2: "?G (\<lambda>s. P s \<and> \<not> bval b s) c\<^sub>2 Q C2"
    using If.IH(2) by auto
  show ?case (is "\<exists>C. ?C C")
  proof
    show "?C(Aif b C1 C2)"
      using ih1 ih2 by (fastforce elim!: pre_mono vc_mono)
  qed
next
  case (While P b c)
(*  \<And>P b c. \<turnstile> {\<lambda>s. P s \<and> bval b s} c {P} \<Longrightarrow> \<exists>C. strip C = c \<and> vc C P \<and> (\<forall>s. P s \<and> bval b s \<longrightarrow> pre C P s) \<Longrightarrow> \<exists>C. strip C = WHILE b DO c \<and> vc C (\<lambda>a. P a \<and> \<not> bval b a) \<and> (\<forall>s. P s \<longrightarrow> pre C (\<lambda>a. P a \<and> \<not> bval b a) s) *)
  obtain C1 where ih1: "?G (\<lambda>s. P s \<and> bval b s) c P C1" sledgehammer
    using While.IH by auto
  show ?case (is "\<exists>C. ?C C")
  proof
    show "?C(Awhile P b C1)"
      by (simp add: ih1)
  qed
next
  case (conseq P' P c Q Q')
  then show ?case
    using pre_mono vc_mono by auto
qed
end


section\<open>Arities of internalized formulas\<close>
theory Arities
  imports
    Discipline_Base
begin

lemmas FOL_arities [simp del, arity] = arity_And arity_Or arity_Implies arity_Iff arity_Exists

declare pred_Un_distrib[arity_aux]

context
  notes FOL_arities[simp]
begin

lemma arity_upair_fm [arity] : "\<lbrakk>  t1\<in>nat ; t2\<in>nat ; up\<in>nat  \<rbrakk> \<Longrightarrow>
  arity(upair_fm(t1,t2,up)) = \<Union> {succ(t1),succ(t2),succ(up)}"
  unfolding  upair_fm_def
  using union_abs1 union_abs2 pred_Un
  by auto

end

lemma Un_trasposition_aux1: "r \<union> s \<union> r = r \<union> s" by auto

lemma Un_trasposition_aux2:
  "r \<union> (s \<union> (r \<union> u))= r \<union> (s \<union> u)"
  "r \<union> (s \<union> (t \<union> (r \<union> u)))= r \<union> (s \<union> (t \<union> u))" by auto

text\<open>We use the previous lemmas to guide automatic arity calculations.\<close>

context
  notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
begin

arity_theorem for "pair_fm"
arity_theorem for "composition_fm"
arity_theorem for "domain_fm"
arity_theorem for "range_fm"
arity_theorem for "union_fm"
arity_theorem for "image_fm"
arity_theorem for "pre_image_fm"
arity_theorem for "big_union_fm"
arity_theorem for "fun_apply_fm"
arity_theorem for "field_fm"
arity_theorem for "empty_fm"
arity_theorem for "cons_fm"
arity_theorem for "succ_fm"
arity_theorem for "number1_fm"
arity_theorem for "function_fm"
arity_theorem for "relation_fm"
arity_theorem for "restriction_fm"
arity_theorem for "typed_function_fm"
arity_theorem for "subset_fm"
arity_theorem for "transset_fm"
arity_theorem for "ordinal_fm"
arity_theorem for "limit_ordinal_fm"
arity_theorem for "finite_ordinal_fm"
arity_theorem for "omega_fm"
arity_theorem for "cartprod_fm"
arity_theorem for "singleton_fm"
arity_theorem for "Memrel_fm"
arity_theorem for "quasinat_fm"

end \<comment> \<open>context\<close>

context
  notes FOL_arities[simp]
begin

lemma arity_is_recfun_fm [arity]:
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat;i\<in>nat\<rbrakk> \<Longrightarrow>  arity(p) = i \<Longrightarrow>
  arity(is_recfun_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> (pred^4(i))"
  unfolding is_recfun_fm_def
  using arity_upair_fm arity_pair_fm arity_pre_image_fm arity_restriction_fm
    union_abs2 pred_Un_distrib
  by auto

lemma arity_is_wfrec_fm [arity]:
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
    arity(is_wfrec_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> (pred^5(i))"
  unfolding is_wfrec_fm_def
  using arity_succ_fm  arity_is_recfun_fm
    union_abs2 pred_Un_distrib
  by auto

lemma arity_is_nat_case_fm [arity]:
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
    arity(is_nat_case_fm(v,p,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(i))"
  unfolding is_nat_case_fm_def
  using arity_succ_fm arity_empty_fm arity_quasinat_fm
    union_abs2 pred_Un_distrib
  by auto

lemma arity_iterates_MH_fm [arity]:
  assumes "isF\<in>formula" "v\<in>nat" "n\<in>nat" "g\<in>nat" "z\<in>nat" "i\<in>nat"
    "arity(isF) = i"
  shows "arity(iterates_MH_fm(isF,v,n,g,z)) =
           succ(v) \<union> succ(n) \<union> succ(g) \<union> succ(z) \<union> (pred^4(i))"
proof -
  let ?\<phi> = "(\<cdot>\<exists>\<cdot>\<cdot>g +\<^sub>\<omega> 3`2 is 0\<cdot> \<and> (\<cdot>\<forall>\<cdot>\<cdot>0 = 2\<cdot> \<rightarrow> isF\<cdot>\<cdot>)\<cdot>\<cdot>)"
  let ?ar = "(g +\<^sub>\<omega> 3) \<union> pred(pred(i))"
  from assms
  have "arity(?\<phi>) =?ar" "?\<phi>\<in>formula"
    using arity_fun_apply_fm
      union_abs1 union_abs2 pred_Un_distrib succ_Un_distrib Un_assoc[symmetric]
    by simp_all
  then
  show ?thesis
    unfolding iterates_MH_fm_def
    using arity_is_nat_case_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = ?ar\<close>] assms pred_succ_eq pred_Un_distrib
    by auto
qed

lemma arity_is_iterates_fm [arity]:
  assumes "p\<in>formula" "v\<in>nat" "n\<in>nat" "Z\<in>nat" "i\<in>nat"
    "arity(p) = i"
  shows "arity(is_iterates_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union>
          (pred^11(i))"
proof -
  let ?\<phi> = "iterates_MH_fm(p, 7+\<^sub>\<omega>v, 2, 1, 0)"
  let ?\<psi> = "is_wfrec_fm(?\<phi>, 0, n +\<^sub>\<omega> 2, Z +\<^sub>\<omega> 2)"
  from \<open>v\<in>_\<close>
  have "arity(?\<phi>) = (8+\<^sub>\<omega>v) \<union> (pred^4(i))" "?\<phi>\<in>formula"
    using assms arity_iterates_MH_fm union_abs2
    by simp_all
  then
  have "arity(?\<psi>) = n +\<^sub>\<omega> 3 \<union> (Z +\<^sub>\<omega> 3) \<union> (3+\<^sub>\<omega>v) \<union> (pred^9(i))"
    using assms arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] union_abs1 pred_Un_distrib
    by auto
  then
  show ?thesis
    unfolding is_iterates_fm_def
    using arity_Memrel_fm arity_succ_fm assms union_abs1 pred_Un_distrib
    by auto
qed

lemma arity_eclose_n_fm [arity]:
  assumes "A\<in>nat" "x\<in>nat" "t\<in>nat"
  shows "arity(eclose_n_fm(A,x,t)) = succ(A) \<union> succ(x) \<union> succ(t)"
proof -
  let ?\<phi> = "big_union_fm(1,0)"
  have "arity(?\<phi>) = 2" "?\<phi>\<in>formula"
    using arity_big_union_fm union_abs2
    by auto
  with assms
  show ?thesis
    unfolding eclose_n_fm_def
    using arity_is_iterates_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _,of _ _ _ 2]
    by auto
qed

lemma arity_mem_eclose_fm [arity]:
  assumes "x\<in>nat" "t\<in>nat"
  shows "arity(mem_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
proof -
  let ?\<phi>="eclose_n_fm(x +\<^sub>\<omega> 2, 1, 0)"
  from \<open>x\<in>nat\<close>
  have "arity(?\<phi>) = x+\<^sub>\<omega>3"
    using arity_eclose_n_fm union_abs2
    by simp
  with assms
  show ?thesis
    unfolding mem_eclose_fm_def
    using arity_finite_ordinal_fm union_abs2 pred_Un_distrib
    by simp
qed

lemma arity_is_eclose_fm [arity]:
  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(is_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
  unfolding is_eclose_fm_def
  using arity_mem_eclose_fm union_abs2 pred_Un_distrib
  by auto

lemma arity_Collect_fm [arity]:
  assumes "x \<in> nat" "y \<in> nat" "p\<in>formula"
  shows "arity(Collect_fm(x,p,y)) = succ(x) \<union> succ(y) \<union> pred(arity(p))"
  unfolding Collect_fm_def
  using assms pred_Un_distrib
  by auto

schematic_goal arity_least_fm':
  assumes
    "i \<in> nat" "q \<in> formula"
  shows
    "arity(least_fm(q,i)) \<equiv> ?ar"
  unfolding least_fm_def
  using assms pred_Un_distrib arity_And arity_Or arity_Neg arity_Implies arity_ordinal_fm
    arity_empty_fm Un_assoc[symmetric] Un_commute
  by auto

lemma arity_least_fm [arity]:
  assumes
    "i \<in> nat" "q \<in> formula"
  shows
    "arity(least_fm(q,i)) = succ(i) \<union> pred(arity(q))"
  using assms arity_least_fm'
  by auto

lemma arity_Replace_fm [arity]:
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
    arity(Replace_fm(v,p,n)) = succ(n) \<union> succ(v) \<union> pred(pred(i))"
  unfolding Replace_fm_def
  using union_abs2 pred_Un_distrib
  by auto

lemma arity_lambda_fm [arity]:
  "\<lbrakk>p\<in>formula; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow>  arity(p) = i \<Longrightarrow>
    arity(lambda_fm(p,v,n)) = succ(n) \<union> (succ(v) \<union> (pred^3(i)))"
  unfolding lambda_fm_def
  using arity_pair_fm pred_Un_distrib union_abs1 union_abs2
  by simp

lemma arity_transrec_fm [arity]:
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
     arity(is_transrec_fm(p,v,n)) = succ(v) \<union> succ(n) \<union> (pred^8(i))"
  unfolding is_transrec_fm_def
  using arity Un_assoc[symmetric] pred_Un_distrib
  by simp

lemma arity_wfrec_replacement_fm :
  "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
    arity(Exists(And(pair_fm(1,0,2),is_wfrec_fm(p,v,n,Z))))
   = 2 \<union> v \<union> n \<union> Z \<union> (pred^6(i))"
  unfolding is_wfrec_fm_def
  using arity_succ_fm  arity_is_recfun_fm union_abs2 pred_Un_distrib arity_pair_fm
  by auto

end \<comment> \<open>@{thm [source] FOL_arities}\<close>

declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]

context
  notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
begin
arity_theorem for "rtran_closure_mem_fm"
arity_theorem for "rtran_closure_fm"
arity_theorem for "tran_closure_fm"
end

context
  notes Un_assoc[simp] Un_trasposition_aux2[simp]
begin
arity_theorem for "injection_fm"
arity_theorem for "surjection_fm"
arity_theorem for "bijection_fm"
arity_theorem for "order_isomorphism_fm"
end

arity_theorem for "Inl_fm"
arity_theorem for "Inr_fm"
arity_theorem for "pred_set_fm"

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Injective\<close>
theory Binary_Relations_Injective
  imports
    Binary_Relation_Functions
    HOL_Syntax_Bundles_Lattices
begin

consts rel_injective_on :: "'a \<Rightarrow> ('b \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> bool"

overloading
  rel_injective_on_pred \<equiv> "rel_injective_on :: ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> bool"
begin
  definition "rel_injective_on_pred P R \<equiv> \<forall>x x' y. P x \<and> P x' \<and> R x y \<and> R x' y \<longrightarrow> x = x'"
end

lemma rel_injective_onI [intro]:
  assumes "\<And>x x' y. P x \<Longrightarrow> P x' \<Longrightarrow> R x y \<Longrightarrow> R x' y \<Longrightarrow> x = x'"
  shows "rel_injective_on P R"
  unfolding rel_injective_on_pred_def using assms by blast

lemma rel_injective_onD:
  assumes "rel_injective_on P R"
  and "P x" "P x'"
  and "R x y" "R x' y"
  shows "x = x'"
  using assms unfolding rel_injective_on_pred_def by blast

consts rel_injective_at :: "'a \<Rightarrow> ('b \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> bool"

overloading
  rel_injective_at_pred \<equiv> "rel_injective_at :: ('a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool"
begin
  definition "rel_injective_at_pred P R \<equiv> \<forall>x x' y. P y \<and> R x y \<and> R x' y \<longrightarrow> x = x'"
end

lemma rel_injective_atI [intro]:
  assumes "\<And>x x' y. P y \<Longrightarrow> R x y \<Longrightarrow> R x' y \<Longrightarrow> x = x'"
  shows "rel_injective_at P R"
  unfolding rel_injective_at_pred_def using assms by blast

lemma rel_injective_atD:
  assumes "rel_injective_at P R"
  and "P y"
  and "R x y" "R x' y"
  shows "x = x'"
  using assms unfolding rel_injective_at_pred_def by blast

definition "rel_injective (R :: 'a \<Rightarrow> _) \<equiv> rel_injective_on (\<top> :: 'a \<Rightarrow> bool) R"

lemma rel_injective_eq_rel_injective_on:
  "rel_injective (R :: 'a \<Rightarrow> _) = rel_injective_on (\<top> :: 'a \<Rightarrow> bool) R"
  unfolding rel_injective_def ..

lemma rel_injectiveI [intro]:
  assumes "\<And>x x' y. R x y \<Longrightarrow> R x' y \<Longrightarrow> x = x'"
  shows "rel_injective R"
  unfolding rel_injective_eq_rel_injective_on using assms by blast

lemma rel_injectiveD:
  assumes "rel_injective R"
  and "R x y" "R x' y"
  shows "x = x'"
  using assms unfolding rel_injective_eq_rel_injective_on
  by (auto dest: rel_injective_onD)

lemma rel_injective_eq_rel_injective_at:
  "rel_injective (R :: 'a \<Rightarrow> 'b \<Rightarrow> bool) = rel_injective_at (\<top> :: 'b \<Rightarrow> bool) R"
  by (intro iffI rel_injectiveI) (auto dest: rel_injective_atD rel_injectiveD)

lemma rel_injective_on_if_rel_injective:
  fixes P :: "'a \<Rightarrow> bool" and R :: "'a \<Rightarrow> _"
  assumes "rel_injective R"
  shows "rel_injective_on P R"
  using assms by (blast dest: rel_injectiveD)

lemma rel_injective_at_if_rel_injective:
  fixes P :: "'a \<Rightarrow> bool" and R :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "rel_injective R"
  shows "rel_injective_at P R"
  using assms by (blast dest: rel_injectiveD)

lemma rel_injective_if_rel_injective_on_in_dom:
  assumes "rel_injective_on (in_dom R) R"
  shows "rel_injective R"
  using assms by (blast dest: rel_injective_onD)

lemma rel_injective_if_rel_injective_at_in_codom:
  assumes "rel_injective_at (in_codom R) R"
  shows "rel_injective R"
  using assms by (blast dest: rel_injective_atD)

corollary rel_injective_on_in_dom_iff_rel_injective [simp]:
  "rel_injective_on (in_dom R) R \<longleftrightarrow> rel_injective R"
  using rel_injective_if_rel_injective_on_in_dom rel_injective_on_if_rel_injective
  by blast

corollary rel_injective_at_in_codom_iff_rel_injective [iff]:
  "rel_injective_at (in_codom R) R \<longleftrightarrow> rel_injective R"
  using rel_injective_if_rel_injective_at_in_codom rel_injective_at_if_rel_injective
  by blast

end