(*
  Title: Sup-Lattices and Other Simplifications
  Author: Georg Struth
  Maintainer: Georg Struth <g.struth@sheffield.ac.uk>
*)

section \<open>Sup-Lattices and Other Simplifications\<close>

theory Sup_Lattice
  imports Main
begin

unbundle lattice_syntax

text \<open>Some definitions for orderings and lattices in Isabelle could be simpler. The strict order in
in ord could be defined instead of being axiomatised. The function mono could have been defined on ord
and not on order---even on a general (di)graph it serves as a morphism. In complete lattices, the
supremum---and dually the infimum---suffices to define the other operations (in the Isabelle/HOL-definition
infimum, binary supremum and infimum, bottom and top element are axiomatised). This not only increases
the number of proof obligations in subclass or sublocale statements, instantiations or interpretations,
it also complicates situations where suprema are presented faithfully, e.g. mapped onto suprema in
some subalgebra, whereas infima in the subalgebra are different from those in the super-structure.\<close>

text \<open>It would be even nicer to use a class less-eq which dispenses with the strict order symbol
in ord. Then one would not have to redefine this symbol in all instantiations or interpretations.
At least, it does not carry any proof obligations.\<close>

context ord
begin

text \<open>ub-set yields the set of all upper bounds of a set; lb-set the set of all lower bounds.\<close>

definition ub_set :: "'a set \<Rightarrow> 'a set" where
  "ub_set X = {y. \<forall>x \<in> X. x \<le> y}"

definition lb_set :: "'a set \<Rightarrow> 'a set" where
  "lb_set X = {y. \<forall>x \<in> X. y \<le> x}"

end

definition ord_pres :: "('a::ord \<Rightarrow> 'b::ord) \<Rightarrow> bool" where
 "ord_pres f = (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"

lemma ord_pres_mono:
  fixes f :: "'a::order \<Rightarrow> 'b::order"
  shows "mono f = ord_pres f"
  by (simp add: mono_def ord_pres_def)

class preorder_lean = ord +
  assumes preorder_refl: "x \<le> x"
  and preorder_trans: "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"

begin

definition le :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
  "le x y = (x \<le> y \<and> \<not> (x \<ge> y))"

end

sublocale preorder_lean \<subseteq> prel: preorder "(\<le>)" le
  by (unfold_locales, auto simp add: le_def preorder_refl preorder_trans)

class order_lean = preorder_lean +
  assumes order_antisym: "x \<le> y \<Longrightarrow> x \<ge> y \<Longrightarrow> x = y"

sublocale order_lean \<subseteq> posl: order "(\<le>)" le
  by (unfold_locales, simp add: order_antisym)

class Sup_lattice = order_lean + Sup +
  assumes Sups_upper: "x \<in> X \<Longrightarrow> x \<le> \<Squnion>X"
  and Sups_least: "(\<And>x. x \<in> X \<Longrightarrow> x \<le> z) \<Longrightarrow> \<Squnion>X \<le> z"

begin

definition Infs :: "'a set \<Rightarrow> 'a" where
  "Infs X =  \<Squnion>{y. \<forall>x \<in> X. y \<le> x}"

definition sups :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  "sups x y = \<Squnion>{x,y}"

definition infs :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  "infs x y = Infs{x,y}"

definition bots :: 'a where
  "bots = \<Squnion>{}"

definition tops :: 'a where
  "tops = Infs{}"

lemma Infs_prop: "Infs = Sup \<circ> lb_set"
  unfolding fun_eq_iff by (simp add: Infs_def prel.lb_set_def)

end

class Inf_lattice = order_lean + Inf +
  assumes Infi_lower: "x \<in> X \<Longrightarrow> \<Sqinter>X \<le> x"
  and Infi_greatest: "(\<And>x. x \<in> X \<Longrightarrow> z \<le> x) \<Longrightarrow> z \<le> \<Sqinter>X"

begin

definition Supi :: "'a set \<Rightarrow> 'a" where
  "Supi X = \<Sqinter>{y. \<forall>x \<in> X. x \<le> y}"

definition supi :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  "supi x y = Supi{x,y}"

definition infi :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  "infi x y = \<Sqinter>{x,y}"

definition boti :: 'a where
  "boti = Supi{}"

definition topi :: 'a where
  "topi = \<Sqinter>{}"

lemma Supi_prop: "Supi = Inf \<circ> ub_set"
  unfolding fun_eq_iff by (simp add: Supi_def prel.ub_set_def)

end

sublocale Inf_lattice \<subseteq> ldual: Sup_lattice Inf "(\<ge>)"
  rewrites "ldual.Infs = Supi"
  and "ldual.infs = supi"
  and "ldual.sups = infi"
  and "ldual.tops = boti"
  and "ldual.bots = topi"
proof-
  show "class.Sup_lattice Inf (\<ge>)"
    by (unfold_locales, simp_all add: Infi_lower Infi_greatest preorder_trans)
  then interpret ldual: Sup_lattice Inf "(\<ge>)".
  show a: "ldual.Infs = Supi"
    unfolding fun_eq_iff by (simp add: ldual.Infs_def Supi_def)
  show "ldual.infs = supi"
    unfolding fun_eq_iff by (simp add: a ldual.infs_def supi_def)
  show "ldual.sups = infi"
    unfolding fun_eq_iff by (simp add: ldual.sups_def infi_def)
  show "ldual.tops = boti"
    by (simp add: a ldual.tops_def boti_def)
  show "ldual.bots = topi"
    by (simp add: ldual.bots_def topi_def)
qed

sublocale Sup_lattice \<subseteq> supclat: complete_lattice Infs Sup_class.Sup infs "(\<le>)" le sups bots tops
  apply unfold_locales
  unfolding Infs_def infs_def sups_def bots_def tops_def
  by (simp_all, auto intro: Sups_least, simp_all add: Sups_upper)

 sublocale Inf_lattice \<subseteq> infclat: complete_lattice Inf_class.Inf Supi infi "(\<le>)" le supi boti topi
  by (unfold_locales, simp_all add: ldual.Sups_upper ldual.Sups_least ldual.supclat.Inf_lower ldual.supclat.Inf_greatest)

end


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

theory Measurement
imports
  Quantum

begin

section \<open>Measurement\<close>

text \<open>
Given an element v  such that @{text "state n v"}, its components @{text "v $ i"} (when v is seen as
a vector, v being a matrix column) for @{text "0 \<le> i < n"} have to be understood as the coefficients
of the representation of v in the basis given by the unit vectors of dimension $2^n$, unless stated otherwise.
Such a vector v is a state for a quantum system of n qubits.
In the literature on quantum computing, for $n = 1$, i.e. for a quantum system of 1 qubit, the elements
of the so-called computational basis are denoted $|0\rangle$,$|1\rangle$, and these last elements might be understood
for instance as $(1,0)$,$(0,1)$, i.e. as the zeroth and the first elements of a given basis ; for $n = 2$,
i.e. for a quantum system of 2 qubits, the elements of the computational basis are denoted $|00\rangle$,
$|01\rangle$, $|10\rangle$,$|11\rangle$, and they might be understood for instance as $(1,0,0,0)$,
$(0,1,0,0)$, $(0,0,1,0)$, $(0,0,0,1)$; and so on for higher values of $n$.
The idea behind these standard notations is that the labels on the vectors of the
computational basis are the binary expressions of the natural numbers indexing the elements
in a given ordered basis interpreting the computational basis in a specific context, another point of
view is that the order of the basis corresponds to the lexicographic order for the labels.
Those labels also represent the possible outcomes of a measurement of the $n$ qubits of the system,
while the squared modules of the corresponding coefficients represent the probabilities for those
outcomes. The fact that the vector v has to be normalized expresses precisely the fact that the squared
modules of the coefficients represent some probabilities and hence their sum should be $1$.
Note that in the case of a system with multiple qubits, i.e. $n \geq 2$, one can model the simultaneous
measurement of multiple qubits by sequential measurements of single qubits. Indeed, this last process
leads to the same probabilities for the various possible outcomes.
Given a system with n-qubits and i the index of one qubit among the $n$ qubits of the system, where
$0 \leq i \leq n-1$ (i.e. we start the indexing from $0$), we want to find the indices of the states of the
computational basis whose labels have a $1$ at the ith spot (counting from $0$). For instance,
if $n=3$ and $i=2$ then $1$,$3$,$5$,$7$ are the indices of the elements of the computational basis
with a $1$ at the 2nd spot, namely $|001\rangle$,$|011\rangle$,$|101\rangle$,$|111\rangle$. To achieve that we define the
predicate @{term "select_index"} below.
\<close>

definition select_index ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"select_index n i j \<equiv> (i\<le>n-1) \<and> (j\<le>2^n - 1) \<and> (j mod 2^(n-i) \<ge> 2^(n-1-i))"

lemma select_index_union:
  "{k| k::nat. select_index n i k} \<union> {k| k::nat. (k<2^n) \<and> \<not> select_index n i k} = {0..<2^n::nat}"
proof
  have "{k |k. select_index n i k} \<subseteq> {0..<2 ^ n}"
  proof
    fix x::nat assume "x \<in> {k |k. select_index n i k}"
    then show "x \<in> {0..<2^n}"
      using select_index_def
      by (metis (no_types, lifting) atLeastLessThan_iff diff_diff_cancel diff_is_0_eq' diff_le_mono2
le_less_linear le_numeral_extra(2) mem_Collect_eq one_le_numeral one_le_power select_index_def zero_order(1))
  qed
  moreover have "{k |k. k<2 ^ n \<and> \<not> select_index n i k} \<subseteq> {0..<2 ^ n}" by auto
  ultimately show "{k |k. select_index n i k} \<union> {k |k. k<2 ^ n \<and> \<not> select_index n i k} \<subseteq> {0..<2 ^ n}" by simp
next
  show "{0..<2 ^ n} \<subseteq> {k |k. select_index n i k} \<union> {k |k. k<2 ^ n \<and> \<not> select_index n i k}" by auto
qed

lemma select_index_inter:
  "{k| k::nat. select_index n i k} \<inter> {k| k::nat. (k<2^n) \<and> \<not> select_index n i k} = {}" by auto

lemma outcomes_sum [simp]:
  fixes f :: "nat \<Rightarrow> real"
  shows
  "(\<Sum>j\<in>{k| k::nat. select_index n i k}. (f j)) +
   (\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (f j)) =
   (\<Sum>j\<in>{0..<2^n::nat}. (f j))"
proof -
  have "{k| k::nat. select_index n i k} \<subseteq> {0..<2^n::nat}"
    using select_index_union by blast
  then have "finite {k| k::nat. select_index n i k}"
    using rev_finite_subset by blast
  moreover have "{k| k::nat. (k<2^n) \<and> \<not> select_index n i k} \<subseteq> {0..<2^n::nat}"
    using select_index_union by blast
  then have "finite {k| k::nat. (k<2^n) \<and> \<not> select_index n i k}"
    using rev_finite_subset by blast
  ultimately have "(\<Sum>j\<in>{k| k::nat. select_index n i k}\<union>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (f j)) =
           (\<Sum>j\<in>{k| k::nat. select_index n i k}. (f j)) +
           (\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (f j)) -
           (\<Sum>j\<in>{k| k::nat. select_index n i k}\<inter>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (f j))"
    using sum_Un by blast
  then have "(\<Sum>j\<in>{0..<2^n::nat}. (f j)) =
                (\<Sum>j\<in>{k| k::nat. select_index n i k}. (f j)) +
                (\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (f j)) -
                (\<Sum>j\<in>{}. (f j))"
    using select_index_union select_index_inter by simp
  thus ?thesis by simp
qed

text \<open>
Given a state v of a n-qbit system, we compute the probability that a measure
of qubit i has the outcome 1.
\<close>

definition prob1 ::"nat \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> real" where
"prob1 n v i \<equiv> \<Sum>j\<in>{k| k::nat. select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2"

definition prob0 ::"nat \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> real" where
"prob0 n v i \<equiv> \<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2"

lemma
  shows prob1_geq_zero:"prob1 n v i \<ge> 0" and prob0_geq_zero:"prob0 n v i \<ge> 0"
proof -
  have "(\<Sum>j\<in>{k| k::nat. select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2) \<ge>
           (\<Sum>j\<in>{k| k::nat. select_index n i k}. (0::real))"
    by (simp add: sum_nonneg)
  then have "(\<Sum>j\<in>{k| k::nat. select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2) \<ge> 0" by simp
  thus "prob1 n v i \<ge> 0"
    using prob1_def by simp
next
  have "(\<Sum>j\<in>{k| k::nat. (k < 2 ^ n) \<and> \<not> select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2) \<ge>
           (\<Sum>j\<in>{k| k::nat. (k < 2 ^ n) \<and> \<not> select_index n i k}. (0::real))"
    by (simp add: sum_nonneg)
  then have "(\<Sum>j\<in>{k| k::nat. (k < 2 ^ n) \<and> \<not> select_index n i k}. (cmod(v $$ (j,0)))\<^sup>2) \<ge> 0" by simp
  thus "prob0 n v i \<ge> 0"
    using prob0_def by simp
qed

lemma prob_sum_is_one [simp]:
  assumes "state n v"
  shows "prob1 n v i + prob0 n v i = 1"
proof-
  have "prob1 n v i + prob0 n v i = (\<Sum>j\<in>{0..<2^n::nat}. (cmod(v $$ (j,0)))\<^sup>2)"
    using prob1_def prob0_def outcomes_sum by simp
  also have "\<dots> = \<parallel>col v 0\<parallel>\<^sup>2"
    using cpx_vec_length_def assms state_def atLeast0LessThan by fastforce
  finally show ?thesis
    using assms state_def by simp
qed

lemma
  assumes "state n v"
  shows prob1_leq_one:"prob1 n v i \<le> 1" and prob0_leq_one:"prob0 n v i \<le> 1"
   apply(metis assms le_add_same_cancel1 prob0_geq_zero prob_sum_is_one)
  apply(metis assms le_add_same_cancel2 prob1_geq_zero prob_sum_is_one)
  done

lemma prob0_is_prob:
  assumes "state n v"
  shows "prob0 n v i \<ge> 0 \<and> prob0 n v i \<le> 1"
  by (simp add: assms prob0_geq_zero prob0_leq_one)

text \<open>Below we give the new state of a n-qubits system after a measurement of the ith qubit gave 0.\<close>

definition post_meas0 ::"nat \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> complex mat" where
"post_meas0 n v i \<equiv>
  of_real(1/sqrt(prob0 n v i)) \<cdot>\<^sub>m |vec (2^n) (\<lambda>j. if \<not> select_index n i j then v $$ (j,0) else 0)\<rangle>"

text \<open>
Note that a division by 0 never occurs. Indeed, if @{text "sqrt(prob0 n v i)"} would be 0 then
@{text "prob0 n v i"} would be 0 and it would mean that the measurement of the ith qubit gave 1.
\<close>

lemma post_meas0_is_state [simp]:
  assumes "state n v" and "prob0 n v i \<noteq> 0"
  shows "state n (post_meas0 n v i)"
proof -
  have "(\<Sum>j\<in>{0..<2^n::nat}. (cmod (if \<not> select_index n i j then v $$ (j,0) else 0))\<^sup>2) =
           (\<Sum>j\<in>{k| k::nat. select_index n i k}. (cmod (if \<not> select_index n i j then v $$ (j,0) else 0))\<^sup>2) +
           (\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (cmod (if \<not> select_index n i j then v $$ (j,0) else 0))\<^sup>2)"
    using outcomes_sum[of "\<lambda>j. (cmod (if \<not> select_index n i j then v $$ (j,0) else 0))\<^sup>2" n i] by simp
  moreover have "(\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (cmod (if \<not> select_index n i j then v $$ (j,0) else 0))\<^sup>2) =
           prob0 n v i"
    by(simp add: prob0_def)
  ultimately have "\<parallel>vec (2 ^ n) (\<lambda>j. if \<not> select_index n i j then v $$ (j,0) else 0)\<parallel> = sqrt(prob0 n v i)"
    using lessThan_atLeast0 by (simp add: cpx_vec_length_def)
  moreover have "\<parallel>col (complex_of_real (1/sqrt (prob0 n v i)) \<cdot>\<^sub>m |vec (2^n) (\<lambda>j. if \<not> select_index n i j then v $$ (j,0) else 0)\<rangle>) 0\<parallel> =
           (1/sqrt (prob0 n v i)) * \<parallel>vec (2^n) (\<lambda>j. if \<not> select_index n i j then v $$ (j,0) else 0)\<parallel>"
    using prob0_geq_zero smult_vec_length_bis by(metis (no_types, lifting) real_sqrt_ge_0_iff zero_le_divide_1_iff)
  ultimately show ?thesis
    using state_def post_meas0_def by (simp add: ket_vec_def post_meas0_def assms(2))
qed

text \<open>Below we give the new state of a n-qubits system after a measurement of the ith qubit gave 1.\<close>

definition post_meas1 ::"nat \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> complex mat" where
"post_meas1 n v i \<equiv>
  of_real(1/sqrt(prob1 n v i)) \<cdot>\<^sub>m |vec (2^n) (\<lambda>j. if select_index n i j then v $$ (j,0) else 0)\<rangle>"

text \<open>
Note that a division by 0 never occurs. Indeed, if @{text "sqrt(prob1 n v i)"} would be 0 then
@{text "prob1 n v i"} would be 0 and it would mean that the measurement of the ith qubit gave 0.
\<close>

lemma post_meas_1_is_state [simp]:
  assumes "state n v" and "prob1 n v i \<noteq> 0"
  shows "state n (post_meas1 n v i)"
proof -
  have "(\<Sum>j\<in>{0..<2^n::nat}. (cmod (if select_index n i j then v $$ (j,0) else 0))\<^sup>2) =
           (\<Sum>j\<in>{k| k::nat. select_index n i k}. (cmod (if select_index n i j then v $$ (j,0) else 0))\<^sup>2) +
           (\<Sum>j\<in>{k| k::nat. (k<2^n) \<and> \<not> select_index n i k}. (cmod (if select_index n i j then v $$ (j,0) else 0))\<^sup>2)"
    using outcomes_sum[of "\<lambda>j. (cmod (if select_index n i j then v $$ (j,0) else 0))\<^sup>2" n i] by simp
  then have "\<parallel>vec (2^n) (\<lambda>j. if select_index n i j then v $$ (j,0) else 0)\<parallel> = sqrt(prob1 n v i)"
    using lessThan_atLeast0 by (simp add: cpx_vec_length_def prob1_def)
  moreover have "\<parallel>col(complex_of_real (1/sqrt (prob1 n v i)) \<cdot>\<^sub>m |vec (2^n) (\<lambda>j. if select_index n i j then v $$ (j,0) else 0)\<rangle>) 0\<parallel> =
           (1/sqrt(prob1 n v i)) * \<parallel>vec (2^n) (\<lambda>j. if select_index n i j then v $$ (j,0) else 0)\<parallel>"
    using prob1_geq_zero smult_vec_length_bis
    by (metis (no_types, lifting) real_sqrt_ge_0_iff zero_le_divide_1_iff)
  ultimately have "\<parallel>col(complex_of_real (1/sqrt (prob1 n v i)) \<cdot>\<^sub>m |vec (2^n) (\<lambda>j. if select_index n i j then v $$ (j,0) else 0)\<rangle>) 0\<parallel>
= (1/sqrt(prob1 n v i)) * sqrt(prob1 n v i)" by simp
  thus ?thesis
    using state_def post_meas1_def by (simp add: ket_vec_def post_meas1_def assms(2))
qed

text \<open>
The measurement operator below takes a number of qubits n, a state v of a n-qubits system, a number
i corresponding to the index (starting from 0) of one qubit among the n-qubits, and it computes a list
whose first (resp. second) element is the pair made of the probability that the outcome of the measurement
of the ith qubit is 0 (resp. 1) and the corresponding post-measurement state of the system.
Of course, note that i should be strictly less than n and v should be a state of dimension n, i.e.
state n v should hold".
\<close>

definition meas ::"nat \<Rightarrow> complex mat \<Rightarrow> nat \<Rightarrow> _list" where
"meas n v i \<equiv> [(prob0 n v i, post_meas0 n v i), (prob1 n v i, post_meas1 n v i)]"

text \<open>
We want to determine the probability that the first n qubits of an n+1 qubit system are 0.
For this we need to find the indices of the states of the computational basis whose labels do
not have a 1 at spot $i=0,...,n$.
\<close>

definition prob0_fst_qubits:: "nat \<Rightarrow> complex Matrix.mat \<Rightarrow> real" where
"prob0_fst_qubits n v \<equiv>
\<Sum>j\<in>{k| k::nat. (k<2^(n+1)) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i k)}. (cmod(v $$ (j,0)))\<^sup>2"

lemma select_index_div_2:
  fixes n i j::"nat"
  assumes "i < 2^(n+1)" and "j<n"
  shows "select_index n j (i div 2) = select_index (n+1) j i"
proof-
  have "2^(n-Suc j) \<le> i div 2 mod 2^(n-j) \<Longrightarrow> 2^(n-j) \<le> i mod 2^(n+1-j)"
  proof-
    define a::nat where a0:"a = i div 2 mod 2^(n-j)"
    assume "2^(n-Suc j) \<le> a"
    then have "2*a + i mod 2 \<ge> 2^(n-(Suc j)+1)" by simp
    then have f0:"2*a + i mod 2 \<ge> 2^(n-j)"
      by (metis Suc_diff_Suc Suc_eq_plus1 assms(2))
    have "a < 2^(n-j)" using a0 by simp
    then have "2*a + i mod 2 < 2*2^(n-j)" by linarith
    then have "2*a + i mod 2 < 2^(n-j+1)" by simp
    then have f1:"2*a + i mod 2 < 2^(n+1-j)"
      by (metis Nat.add_diff_assoc2 Suc_leD Suc_leI assms(2))
    have "i = 2*(a + 2^(n-j)*(i div 2 div 2^(n-j))) + i mod 2" using a0 by simp
    then have "i = 2*a + i mod 2 + 2^(n-j+1)*(i div 2 div 2^(n-j))" by simp
    then have "i = 2*a + i mod 2 + 2^(n+1-j)*(i div 2 div 2^(n-j))"
      by (metis Nat.add_diff_assoc2 Suc_leD Suc_leI assms(2))
    then have "i mod 2^(n+1-j) = 2*a + i mod 2"
      using f1 by (metis mod_if mod_mult_self2)
    then show "2^(n-j) \<le> i mod 2^(n+1-j)"
      using f0 by simp
  qed
  moreover have "2^(n-j) \<le> i mod 2^(n+1-j) \<Longrightarrow> 2^(n-Suc j) \<le> i div 2 mod 2^(n-j)"
  proof-
    define a::nat where a0:"a = i div 2 mod 2^(n-j)"
    assume a1:"2^(n-j) \<le> i mod 2^(n+1-j)"
    have f0:"2^(n-j) = 2^(n-Suc j+1)"
      by (metis Suc_diff_Suc Suc_eq_plus1 assms(2))
    have "a < 2^(n-j)" using a0 by simp
    then have "2*a + i mod 2 < 2*2^(n-j)" by linarith
    then have "2*a + i mod 2 < 2^(n-j+1)" by simp
    then have f1:"2*a + i mod 2 < 2^(n+1-j)"
      by (metis Nat.add_diff_assoc2 Suc_leD Suc_leI assms(2))
    have "i = 2*(a + 2^(n-j)*(i div 2 div 2^(n-j))) + i mod 2" using a0 by simp
    then have "i = 2*a + i mod 2 + 2^(n-j+1)*(i div 2 div 2^(n-j))" by simp
    then have "i = 2*a + i mod 2 + 2^(n+1-j)*(i div 2 div 2^(n-j))"
      by (metis Nat.add_diff_assoc2 Suc_leD Suc_leI assms(2))
    then have "i mod 2^(n+1-j) = 2*a + i mod 2"
      using f1 by (metis mod_if mod_mult_self2)
    then have "2*a + i mod 2 \<ge> 2^(n-j)"
      using a1 by simp
    then have "(2*a + i mod 2) div 2 \<ge> (2^(n-j)) div 2"
      using div_le_mono by blast
    then show "2^(n-Suc j) \<le> a" by (simp add: f0)
  qed
  ultimately show ?thesis
    using select_index_def assms by auto
qed

lemma select_index_suc_even:
  fixes n k i:: nat
  assumes "k < 2^n" and "select_index n i k"
  shows "select_index (Suc n) i (2*k)"
proof-
  have "select_index n i k = select_index n i (2*k div 2)" by simp
  moreover have "\<dots> = select_index (Suc n) i (2*k)"
  proof-
    have "i < n" using assms(2) select_index_def
      by (metis (no_types, hide_lams) Suc_eq_plus1 assms(1) calculation diff_diff_left diff_le_self
diff_self_eq_0 div_by_1 le_0_eq le_eq_less_or_eq less_imp_diff_less mod_div_trivial mult.left_neutral mult_eq_0_iff mult_le_mono1 not_less plus_1_eq_Suc power_0 semiring_normalization_rules(7))
    thus ?thesis
      using select_index_div_2 assms(1) select_index_def by(metis Suc_1 Suc_eq_plus1 Suc_mult_less_cancel1 power_Suc)
  qed
  ultimately show "select_index (Suc n) i (2*k)"
    using assms(2) by simp
qed

lemma select_index_suc_odd:
  fixes n k i:: nat
  assumes "k \<le> 2^n -1" and "select_index n i k"
  shows "select_index (Suc n) i (2*k+1)"
proof-
  have "((2*k+1) mod 2^(Suc n - i) \<ge> 2^(n - i)) =
(((2*k+1) div 2) mod 2^(n - i) \<ge> 2^(n-1-i))"
  proof-
    have "2*k+1 < 2^(n + 1)"
      using assms(1)
      by (smt Suc_1 Suc_eq_plus1 Suc_le_lessD Suc_le_mono add_Suc_right distrib_left_numeral le_add_diff_inverse mult_le_mono2 nat_mult_1_right one_le_numeral one_le_power plus_1_eq_Suc power_add power_one_right)
    moreover have "i < n"
      using assms(2) select_index_def
      by (metis (no_types, hide_lams) add_cancel_left_left add_diff_inverse_nat diff_le_self div_by_1 le_antisym less_le_trans less_one mod_div_trivial not_le power_0)
    ultimately show ?thesis
      using select_index_div_2[of "2*k+1" "n" i] select_index_def
      by (metis Nat.le_diff_conv2 Suc_eq_plus1 Suc_leI assms(2) diff_Suc_1 less_imp_le less_power_add_imp_div_less one_le_numeral one_le_power power_one_right)
  qed
  moreover have "\<dots> = (k mod 2^(n - i) \<ge> 2^(n-1-i))" by simp
  ultimately show ?thesis
  proof-
    have "i \<le> Suc n -1" using assms(2) select_index_def by auto
    moreover have "2*k+1 \<le> 2^(Suc n)-1"
      using assms(1) by (smt Suc_diff_1 Suc_eq_plus1 add_diff_cancel_right' diff_Suc_diff_eq2 diff_diff_left diff_is_0_eq diff_mult_distrib2 le_add2 mult_2 mult_Suc_right plus_1_eq_Suc pos2 power_Suc zero_less_power)
    ultimately show ?thesis
      using select_index_def
      by (metis \<open>(2 ^ (n - 1 - i) \<le> (2 * k + 1) div 2 mod 2 ^ (n - i)) = (2 ^ (n - 1 - i) \<le> k mod 2 ^ (n - i))\<close> \<open>(2 ^ (n - i) \<le> (2 * k + 1) mod 2 ^ (Suc n - i)) = (2 ^ (n - 1 - i) \<le> (2 * k + 1) div 2 mod 2 ^ (n - i))\<close> assms(2) diff_Suc_1)
  qed
qed

lemma aux_range:
  fixes k:: nat
  assumes "k < 2^(Suc n + 1)" and "k \<ge> 2"
  shows "k = 2 \<or> k = 3 \<or> (\<exists>l. l\<ge>2 \<and> l\<le>2^(n+1)-1 \<and> (k = 2*l \<or> k = 2*l + 1))"
proof(rule disjCI)
  assume "\<not> (k = 3 \<or> (\<exists>l\<ge>2. l \<le> 2^(n + 1) - 1 \<and> (k = 2 * l \<or> k = 2 * l + 1)))"
  have "k > 3 \<longrightarrow> (\<exists>l\<ge>2. l \<le> 2^(n + 1) - 1 \<and> (k = 2 * l \<or> k = 2 * l + 1))"
  proof
    assume asm:"k > 3"
    have "even k \<or> odd k" by simp
    then obtain l where "k = 2*l \<or> k = 2*l+1" by (meson evenE oddE)
    moreover have "l \<ge> 2"
      using asm calculation by linarith
    moreover have "l \<le> 2^(n+1) - 1"
      using assms(1) by (metis Suc_diff_1 Suc_eq_plus1 calculation(1) dvd_triv_left even_Suc_div_two less_Suc_eq_le less_power_add_imp_div_less nonzero_mult_div_cancel_left pos2 power_one_right zero_less_power zero_neq_numeral)
    ultimately show "\<exists>l\<ge>2. l \<le> 2^(n + 1) - 1 \<and> (k = 2 * l \<or> k = 2 * l + 1)" by auto
  qed
  then have "k \<le> 2"
    using \<open>\<not> (k = 3 \<or> (\<exists>l\<ge>2. l \<le> 2 ^ (n + 1) - 1 \<and> (k = 2 * l \<or> k = 2 * l + 1)))\<close> less_Suc_eq_le by auto
  thus "k = 2"
    using assms(2) by simp
qed

lemma select_index_with_1:
  fixes n:: nat
  assumes "n \<ge> 1"
  shows "\<forall>k. k < 2^(n+1) \<longrightarrow> k \<ge> 2 \<longrightarrow> (\<exists>i<n. select_index (n+1) i k)"
  using assms
proof(rule nat_induct_at_least)
  show "\<forall>k< 2^(1+1). 2 \<le> k \<longrightarrow> (\<exists>i<1. select_index (1+1) i k)"
  proof-
    have "select_index 2 0 2 = True"
      using select_index_def by simp
    moreover have "select_index 2 0 3"
      using select_index_def by simp
    ultimately show ?thesis
      by (metis Suc_leI add_Suc_shift le_eq_less_or_eq mult_2 not_less one_add_one one_plus_numeral
plus_1_eq_Suc power.simps(2) power_one_right semiring_norm(3) zero_less_one_class.zero_less_one)
  qed
next
  show "\<And>n. 1 \<le> n \<Longrightarrow>
         \<forall>k < 2^(n+1). 2 \<le> k \<longrightarrow> (\<exists>i<n. select_index (n+1) i k) \<Longrightarrow>
         \<forall>k < 2^(Suc n + 1). 2 \<le> k \<longrightarrow> (\<exists>i<Suc n. select_index (Suc n +1) i k)"
  proof-
    fix n:: nat
    assume asm:"n \<ge> 1" and IH:"\<forall>k < 2^(n+1). 2 \<le> k \<longrightarrow> (\<exists>i<n. select_index (n+1) i k)"
    have "select_index (Suc n + 1) n 2"
    proof-
      have "select_index (Suc n) n 1"
        using select_index_def by(smt Suc_1 Suc_diff_Suc Suc_lessI add_diff_cancel_right' diff_Suc_1
diff_commute diff_zero le_eq_less_or_eq less_Suc_eq_le nat.simps(3) nat_power_eq_Suc_0_iff
one_mod_two_eq_one plus_1_eq_Suc power_one_right zero_less_power)
      thus ?thesis
        using select_index_suc_even by (metis Suc_eq_plus1 less_numeral_extra(4) mult_2 not_less_less_Suc_eq one_add_one one_less_power zero_less_Suc)
    qed
    moreover have "select_index (Suc n + 1) n 3"
    proof-
      have "select_index (Suc n) n 1"
        using select_index_def by(smt Suc_1 Suc_diff_Suc Suc_lessI add_diff_cancel_right' diff_Suc_1
diff_commute diff_zero le_eq_less_or_eq less_Suc_eq_le nat.simps(3) nat_power_eq_Suc_0_iff
one_mod_two_eq_one plus_1_eq_Suc power_one_right zero_less_power)
      thus ?thesis
        using select_index_suc_odd by (metis One_nat_def Suc_eq_plus1 mult_2 numeral_3_eq_3 select_index_def)
    qed
    moreover have "\<exists>i<Suc n. select_index (Suc n +1) i (2*k)" if "k \<ge> 2" and "k \<le> 2^(n + 1)-1" for k:: nat
    proof-
      obtain i where "i<n" and "select_index (n+1) i k"
        using IH by(metis One_nat_def Suc_diff_Suc \<open>2 \<le> k\<close> \<open>k \<le> 2 ^ (n + 1) - 1\<close> diff_zero le_imp_less_Suc pos2 zero_less_power)
      then have "select_index (Suc n +1) i (2*k)"
        using select_index_suc_even
        by (metis One_nat_def Suc_diff_Suc add.commute diff_zero le_imp_less_Suc plus_1_eq_Suc pos2 that(2) zero_less_power)
      thus ?thesis
        using \<open>i < n\<close> less_SucI by blast
    qed
    moreover have "\<exists>i<Suc n. select_index (Suc n +1) i (2*k +1)" if "k \<ge> 2" and "k \<le> 2^(n + 1)-1" for k:: nat
    proof-
      obtain i where "i<n" and "select_index (n+1) i k"
        using IH by(metis One_nat_def Suc_diff_Suc \<open>2 \<le> k\<close> \<open>k \<le> 2 ^ (n + 1) - 1\<close> diff_zero le_imp_less_Suc pos2 zero_less_power)
      then have "select_index (Suc n +1) i (2*k+1)"
        using select_index_suc_odd that(2) by simp
      thus ?thesis
        using \<open>i < n\<close> less_SucI by blast
    qed
    ultimately show "\<forall>k< 2^(Suc n + 1). 2 \<le> k \<longrightarrow> (\<exists>i<Suc n. select_index (Suc n +1) i k)"
      using aux_range by (metis lessI)
  qed
qed

lemma prob0_fst_qubits_index:
  fixes n:: nat and v:: "complex Matrix.mat"
  shows "{k| k::nat. (k<2^(n+1)) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i k)} = {0,1}"
proof(induct n)
  case 0
  show "{k |k. k < 2^(0+1) \<and> (\<forall>i\<in>{0..<0}. \<not> select_index (0+1) i k)} = {0,1}" by auto
next
  case (Suc n)
  show "\<And>n. {k |k. k < 2^(n+1) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i k)} = {0,1} \<Longrightarrow>
         {k |k. k < 2^(Suc n + 1) \<and> (\<forall>i\<in>{0..<Suc n}. \<not> select_index (Suc n + 1) i k)} =
         {0, 1}"
  proof-
    fix n
    assume IH: "{k |k. k < 2^(n+1) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i k)} = {0,1}"
    then have "{0,1} \<subseteq> {k |k. k < 2^(Suc n + 1) \<and> (\<forall>i\<in>{0..<Suc n}. \<not> select_index (Suc n + 1) i k)}"
    proof-
      have "k < 2^(n+1) \<longrightarrow> k < 2^(Suc n + 1)" for k::nat by simp
      moreover have "(\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i 0) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i 1)"
        using IH by auto
      then have "(\<forall>i\<in>{0..<n}. \<not> select_index (Suc n +1) i 0) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (Suc n +1) i 1)"
        using select_index_suc_odd[of 0 "n+1"] Suc_eq_plus1
        by (smt One_nat_def Suc_1 add_Suc_shift add_diff_cancel_right' atLeastLessThan_iff diff_diff_cancel
le_eq_less_or_eq less_Suc_eq linorder_not_le mod_less nat_power_eq_Suc_0_iff select_index_def zero_less_power)
      moreover have "select_index (Suc n + 1) n 0 = False" using select_index_def by simp
      moreover have "select_index (Suc n + 1) n 1 = False" using select_index_def by simp
      ultimately show ?thesis
        by (smt One_nat_def Suc_1 Suc_eq_plus1 Suc_lessI atLeast0_lessThan_Suc empty_iff insertE
mem_Collect_eq nat.simps(1) nat_power_eq_Suc_0_iff pos2 subsetI zero_less_power)
    qed
    moreover have "{k |k. k < 2^(Suc n + 1) \<and> (\<forall>i\<in>{0..<Suc n}. \<not> select_index (Suc n + 1) i k)} \<subseteq> {0,1}"
    proof-
      have "\<forall>k<2^(Suc n +1). k \<ge> 2 \<longrightarrow> (\<exists>i<Suc n. \<not> select_index (Suc n +1) i k = False)"
        using select_index_with_1[of "Suc n"] by (metis Suc_eq_plus1 add.commute le_add1)
      thus ?thesis by auto
    qed
    ultimately show "{k |k. k<2^(Suc n + 1) \<and> (\<forall>i\<in>{0..<Suc n}. \<not> select_index (Suc n +1) i k)} = {0,1}" by auto
  qed
qed

lemma prob0_fst_qubits_eq:
  fixes n:: nat
  shows "prob0_fst_qubits n v = (cmod(v $$ (0,0)))\<^sup>2 + (cmod(v $$ (1,0)))\<^sup>2"
proof-
  have "prob0_fst_qubits n v = (\<Sum>j\<in>{k| k::nat. (k<2^(n+1)) \<and> (\<forall>i\<in>{0..<n}. \<not> select_index (n+1) i k)}. (cmod(v $$ (j,0)))\<^sup>2)"
    using prob0_fst_qubits_def by simp
  moreover have "\<dots> = (\<Sum>j\<in>{0,1}. (cmod(v $$ (j,0)))\<^sup>2)"
    using prob0_fst_qubits_index by simp
  finally show ?thesis by simp
qed

(* Below in iter_post_meas0, the first argument n corresponds to the number of qubits of the system
, and the second argument m corresponds to the number of qubits that have been measured. *)

primrec iter_post_meas0:: "nat \<Rightarrow> nat \<Rightarrow> complex Matrix.mat \<Rightarrow> complex Matrix.mat" where
  "iter_post_meas0 n 0 v = v"
| "iter_post_meas0 n (Suc m) v = post_meas0 n (iter_post_meas0 n m v) m"

(* iter_prob0 outputs the probability that successive measurements of the first m qubits
(out of n qubits in the system) give m zeros. *)

definition iter_prob0:: "nat \<Rightarrow> nat \<Rightarrow> complex Matrix.mat \<Rightarrow> real" where
  "iter_prob0 n m v = (\<Prod>i<m. prob0 n (iter_post_meas0 n i v) i)"

(* To do:
lemma iter_prob0_eq:
  fixes n:: nat and v:: "complex Matrix.mat"
  assumes "n \<ge> 1"
  shows "iter_prob0 (Suc n) n v = prob0_fst_qubits n v"
*)

section \<open>Measurements with Bell States\<close>

text \<open>
A Bell state is a remarkable state. Indeed, if one makes one measure, either of the first or the second
qubit, then one gets either $0$ with probability $1/2$ or $1$ with probability $1/2$. Moreover, in the case of
two successive measurements of the first and second qubit, the outcomes are correlated.
Indeed, in the case of @{text "|\<beta>\<^sub>0\<^sub>0\<rangle>"} or @{text "|\<beta>\<^sub>1\<^sub>0\<rangle>"} (resp. @{text "|\<beta>\<^sub>0\<^sub>1\<rangle>"} or @{text "|\<beta>\<^sub>1\<^sub>1\<rangle>"}) if
one measures the second qubit after a measurement of the first qubit (or the other way around) then
one gets the same outcomes (resp. opposite outcomes), i.e. for instance the probability of measuring
$0$ for the second qubit after a measure with outcome $0$ for the first qubit is $1$ (resp. $0$).
\<close>

lemma prob0_bell_fst [simp]:
  assumes "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
  shows "prob0 2 v 0 = 1/2"
proof -
  have set_0 [simp]:"{k| k::nat. (k<4) \<and> \<not> select_index 2 0 k} = {0,1}"
    using select_index_def by auto
  have "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<Longrightarrow> prob0 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>0\<rangle>"
    show "prob0 2 v 0 = 1/2"
    proof -
      have "prob0 2 v 0 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 0 k}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,1}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell00_def ket_vec_def).
      finally show  ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<Longrightarrow> prob0 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>1\<rangle>"
    show "prob0 2 v 0 = 1/2"
    proof -
      have "prob0 2 v 0 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 0 k}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,1}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell01_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<Longrightarrow> prob0 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>0\<rangle>"
    show "prob0 2 v 0 = 1/2"
    proof -
      have "prob0 2 v 0 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 0 k}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,1}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell10_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>1\<rangle> \<Longrightarrow> prob0 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
    show "prob0 2 v 0 = 1/2"
    proof -
      have "prob0 2 v 0 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 0 k}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,1}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell11_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  ultimately show ?thesis using assms by auto
qed

lemma prob_1_bell_fst [simp]:
  assumes "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
  shows "prob1 2 v 0 = 1/2"
proof -
  have set_0 [simp]:"{k| k::nat. select_index 2 0 k} = {2,3}"
    using select_index_def by auto
  have "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<Longrightarrow> prob1 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>0\<rangle>"
    show "prob1 2 v 0 = 1/2"
    proof -
      have "prob1 2 v 0 = (\<Sum>j\<in>{k| k::nat. select_index 2 0 k}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{2,3}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell00_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<Longrightarrow> prob1 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>1\<rangle>"
    show "prob1 2 v 0 = 1/2"
    proof -
      have "prob1 2 v 0 = (\<Sum>j\<in>{k| k::nat. select_index 2 0 k}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{2,3}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell01_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<Longrightarrow> prob1 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>0\<rangle>"
    show "prob1 2 v 0 = 1/2"
    proof -
      have "prob1 2 v 0 = (\<Sum>j\<in>{k| k::nat. select_index 2 0 k}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{2,3}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell10_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>1\<rangle> \<Longrightarrow> prob1 2 v 0 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
    show "prob1 2 v 0 = 1/2"
    proof -
      have "prob1 2 v 0 = (\<Sum>j\<in>{k| k::nat. select_index 2 0 k}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{2,3}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell11_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  ultimately show ?thesis using assms by auto
qed

lemma prob0_bell_snd [simp]:
  assumes "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
  shows "prob0 2 v 1 = 1/2"
proof -
  have set_0 [simp]:"{k| k::nat. (k<4) \<and> \<not> select_index 2 1 k} = {0,2}"
    apply (auto simp: select_index_def)
    by (metis Suc_le_mono add_Suc add_Suc_right le_numeral_extra(3) less_antisym mod_Suc_eq mod_less
neq0_conv not_mod2_eq_Suc_0_eq_0 numeral_2_eq_2 numeral_Bit0 one_add_one one_mod_two_eq_one one_neq_zero)
  have "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<Longrightarrow> prob0 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>0\<rangle>"
    show "prob0 2 v 1 = 1/2"
    proof -
      have "prob0 2 v 1 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 1 k}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,2}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell00_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<Longrightarrow> prob0 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>1\<rangle>"
    show "prob0 2 v 1 = 1/2"
    proof -
      have "prob0 2 v 1 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 1 k}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,2}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell01_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<Longrightarrow> prob0 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>0\<rangle>"
    show "prob0 2 v 1 = 1/2"
    proof -
      have "prob0 2 v 1 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 1 k}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,2}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell10_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>1\<rangle> \<Longrightarrow> prob0 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
    show "prob0 2 v 1 = 1/2"
    proof -
      have "prob0 2 v 1 = (\<Sum>j\<in>{k| k::nat. (k<4) \<and> \<not> select_index 2 1 k}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob0_def asm).
      also have "\<dots> = (\<Sum>j\<in>{0,2}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell11_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  ultimately show ?thesis using assms by auto
qed

lemma prob_1_bell_snd [simp]:
  assumes "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<or> v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
  shows "prob1 2 v 1 = 1/2"
proof -
  have set_0:"{k| k::nat. select_index 2 1 k} = {1,3}"
    apply (auto simp: select_index_def)
    by (metis Suc_le_lessD le_SucE le_less mod2_gr_0 mod_less mod_self numeral_2_eq_2 numeral_3_eq_3)
  have "v = |\<beta>\<^sub>0\<^sub>0\<rangle> \<Longrightarrow> prob1 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>0\<rangle>"
    show "prob1 2 v 1 = 1/2"
    proof -
      have "prob1 2 v 1 = (\<Sum>j\<in>{k| k::nat. select_index 2 1 k}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{1,3}. (cmod(bell00 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell00_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>0\<^sub>1\<rangle> \<Longrightarrow> prob1 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>0\<^sub>1\<rangle>"
    show "prob1 2 v 1 = 1/2"
    proof -
      have "prob1 2 v 1 = (\<Sum>j\<in>{k| k::nat. select_index 2 1 k}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{1,3}. (cmod(bell01 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell01_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>0\<rangle> \<Longrightarrow> prob1 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>0\<rangle>"
    show "prob1 2 v 1 = 1/2"
    proof -
      have "prob1 2 v 1 = (\<Sum>j\<in>{k| k::nat. select_index 2 1 k}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{1,3}. (cmod(bell10 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(1/sqrt(2)))\<^sup>2 + (cmod(0))\<^sup>2"
        apply (auto simp: bell10_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  moreover have "v = |\<beta>\<^sub>1\<^sub>1\<rangle> \<Longrightarrow> prob1 2 v 1 = 1/2"
  proof -
    fix v assume asm:"v = |\<beta>\<^sub>1\<^sub>1\<rangle>"
    show "prob1 2 v 1 = 1/2"
    proof -
      have "prob1 2 v 1 = (\<Sum>j\<in>{k| k::nat. select_index 2 1 k}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        apply (auto simp: prob1_def asm).
      also have "\<dots> = (\<Sum>j\<in>{1,3}. (cmod(bell11 $$ (j,0)))\<^sup>2)"
        using set_0 by simp
      also have "\<dots> = (cmod(0))\<^sup>2 + (cmod(1/sqrt(2)))\<^sup>2"
        apply (auto simp: bell11_def ket_vec_def).
      finally show ?thesis by(simp add: cmod_def power_divide)
    qed
  qed
  ultimately show ?thesis using assms by auto
qed

lemma post_meas0_bell00_fst [simp]:
  "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 = |unit_vec 4 0\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 0\<rangle>" and "j < dim_col |unit_vec 4 0\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (0,0) = |unit_vec 4 0\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (1,0) = |unit_vec 4 0\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (2,0) = |unit_vec 4 0\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (3,0) = |unit_vec 4 0\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (i,j) = |unit_vec 4 0\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0) = dim_row |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0) = dim_col |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell00_snd [simp]:
  "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 = |unit_vec 4 0\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 0\<rangle>" and "j < dim_col |unit_vec 4 0\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (0,0) = |unit_vec 4 0\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide del:One_nat_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (1,0) = |unit_vec 4 0\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (2,0) = |unit_vec 4 0\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (3,0) = |unit_vec 4 0\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (i,j) = |unit_vec 4 0\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1) = dim_row |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1) = dim_col |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell01_fst [simp]:
  "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 = |unit_vec 4 1\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 1\<rangle>" and "j < dim_col |unit_vec 4 1\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (0,0) = |unit_vec 4 1\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (1,0) = |unit_vec 4 1\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (2,0) = |unit_vec 4 1\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (3,0) = |unit_vec 4 1\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (i,j) = |unit_vec 4 1\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0) = dim_row |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0) = dim_col |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell01_snd [simp]:
  "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 = |unit_vec 4 2\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 2\<rangle>" and "j < dim_col |unit_vec 4 2\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (0,0) = |unit_vec 4 2\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (1,0) = |unit_vec 4 2\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (2,0) = |unit_vec 4 2\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide del:One_nat_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (3,0) = |unit_vec 4 2\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (i,j) = |unit_vec 4 2\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1) = dim_row |unit_vec 4 2\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1) = dim_col |unit_vec 4 2\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell10_fst [simp]:
  "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 = |unit_vec 4 0\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 0\<rangle>" and "j < dim_col |unit_vec 4 0\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (0,0) = |unit_vec 4 0\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (1,0) = |unit_vec 4 0\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (2,0) = |unit_vec 4 0\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (3,0) = |unit_vec 4 0\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (i,j) = |unit_vec 4 0\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0) = dim_row |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0) = dim_col |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell10_snd [simp]:
  "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 = |unit_vec 4 0\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 0\<rangle>" and "j < dim_col |unit_vec 4 0\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (0,0) = |unit_vec 4 0\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide del:One_nat_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (1,0) = |unit_vec 4 0\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (2,0) = |unit_vec 4 0\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (3,0) = |unit_vec 4 0\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (i,j) = |unit_vec 4 0\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1) = dim_row |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1) = dim_col |unit_vec 4 0\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell11_fst [simp]:
  "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 = |unit_vec 4 1\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 1\<rangle>" and "j < dim_col |unit_vec 4 1\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (0,0) = |unit_vec 4 1\<rangle> $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (1,0) = |unit_vec 4 1\<rangle> $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (2,0) = |unit_vec 4 1\<rangle> $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (3,0) = |unit_vec 4 1\<rangle> $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (i,j) = |unit_vec 4 1\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0) = dim_row |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0) = dim_col |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas0_bell11_snd [simp]:
  "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 = - |unit_vec 4 2\<rangle>"
proof
  fix i j::nat assume "i < dim_row (- |unit_vec 4 2\<rangle>)" and "j < dim_col (- |unit_vec 4 2\<rangle>)"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (0,0) = (- |unit_vec 4 2\<rangle>) $$ (0,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (1,0) = (- |unit_vec 4 2\<rangle>) $$ (1,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (2,0) = (- |unit_vec 4 2\<rangle>) $$ (2,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide del:One_nat_def)
  moreover have "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (3,0) = (- |unit_vec 4 2\<rangle>) $$ (3,0)"
    by(simp add: post_meas0_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (i,j) = (- |unit_vec 4 2\<rangle>) $$ (i,j)" by auto
next
  show "dim_row (post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1) = dim_row (- |unit_vec 4 2\<rangle>)"
    by(auto simp add: post_meas0_def ket_vec_def)
  show "dim_col (post_meas0 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1) = dim_col (- |unit_vec 4 2\<rangle>)"
    by(auto simp add: post_meas0_def ket_vec_def)
qed

lemma post_meas1_bell00_fst [simp]:
  "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 = |unit_vec 4 3\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 3\<rangle>" and "j < dim_col |unit_vec 4 3\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (0,0) = |unit_vec 4 3\<rangle> $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (1,0) = |unit_vec 4 3\<rangle> $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (2,0) = |unit_vec 4 3\<rangle> $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (3,0) = |unit_vec 4 3\<rangle> $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0 $$ (i,j) = |unit_vec 4 3\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0) = dim_row |unit_vec 4 3\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 0) = dim_col |unit_vec 4 3\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell00_snd [simp]:
  "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 = |unit_vec 4 3\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 3\<rangle>" and "j < dim_col |unit_vec 4 3\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (0,0) = |unit_vec 4 3\<rangle> $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (1,0) = |unit_vec 4 3\<rangle> $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (2,0) = |unit_vec 4 3\<rangle> $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (3,0) = |unit_vec 4 3\<rangle> $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell00_def ket_vec_def real_sqrt_divide del: One_nat_def)
  ultimately show "post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1 $$ (i,j) = |unit_vec 4 3\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1) = dim_row |unit_vec 4 3\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>0\<^sub>0\<rangle> 1) = dim_col |unit_vec 4 3\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell01_fst [simp]:
  "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 = |unit_vec 4 2\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 2\<rangle>" and "j < dim_col |unit_vec 4 2\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (0,0) = |unit_vec 4 2\<rangle> $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (1,0) = |unit_vec 4 2\<rangle> $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (2,0) = |unit_vec 4 2\<rangle> $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (3,0) = |unit_vec 4 2\<rangle> $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0 $$ (i,j) = |unit_vec 4 2\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0) = dim_row |unit_vec 4 2\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 0) = dim_col |unit_vec 4 2\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell01_snd [simp]:
  "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 = |unit_vec 4 1\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 1\<rangle>" and "j < dim_col |unit_vec 4 1\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (0,0) = |unit_vec 4 1\<rangle> $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (1,0) = |unit_vec 4 1\<rangle> $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide del: One_nat_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (2,0) = |unit_vec 4 1\<rangle> $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (3,0) = |unit_vec 4 1\<rangle> $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell01_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1 $$ (i,j) = |unit_vec 4 1\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1) = dim_row |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>0\<^sub>1\<rangle> 1) = dim_col |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell10_fst [simp]:
  "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 = - |unit_vec 4 3\<rangle>"
proof
  fix i j::nat assume "i < dim_row (- |unit_vec 4 3\<rangle>)" and "j < dim_col (- |unit_vec 4 3\<rangle>)"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (0,0) = (- |unit_vec 4 3\<rangle>) $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (1,0) = (- |unit_vec 4 3\<rangle>) $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (2,0) = (- |unit_vec 4 3\<rangle>) $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (3,0) = (- |unit_vec 4 3\<rangle>) $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0 $$ (i,j) = (- |unit_vec 4 3\<rangle>) $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0) = dim_row (- |unit_vec 4 3\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 0) = dim_col (- |unit_vec 4 3\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell10_snd [simp]:
  "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 = - |unit_vec 4 3\<rangle>"
proof
  fix i j::nat assume "i < dim_row (- |unit_vec 4 3\<rangle>)" and "j < dim_col (- |unit_vec 4 3\<rangle>)"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (0,0) = (- |unit_vec 4 3\<rangle>) $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (1,0) = (- |unit_vec 4 3\<rangle>) $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (2,0) = (- |unit_vec 4 3\<rangle>) $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (3,0) = (- |unit_vec 4 3\<rangle>) $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell10_def ket_vec_def real_sqrt_divide del: One_nat_def)
  ultimately show "post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1 $$ (i,j) = (- |unit_vec 4 3\<rangle>) $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1) = dim_row (- |unit_vec 4 3\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>1\<^sub>0\<rangle> 1) = dim_col (- |unit_vec 4 3\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell11_fst [simp]:
  "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 = - |unit_vec 4 2\<rangle>"
proof
  fix i j::nat assume "i < dim_row (- |unit_vec 4 2\<rangle>)" and "j < dim_col (- |unit_vec 4 2\<rangle>)"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (0,0) = (- |unit_vec 4 2\<rangle>) $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (1,0) = (- |unit_vec 4 2\<rangle>) $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (2,0) = (- |unit_vec 4 2\<rangle>) $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (3,0) = (- |unit_vec 4 2\<rangle>) $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0 $$ (i,j) = (- |unit_vec 4 2\<rangle>) $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0) = dim_row (- |unit_vec 4 2\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 0) = dim_col (- |unit_vec 4 2\<rangle>)"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

lemma post_meas1_bell11_snd [simp]:
  "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 = |unit_vec 4 1\<rangle>"
proof
  fix i j::nat assume "i < dim_row |unit_vec 4 1\<rangle>" and "j < dim_col |unit_vec 4 1\<rangle>"
  then have "i \<in> {0,1,2,3}" and "j = 0"
    by(auto simp add: ket_vec_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (0,0) = |unit_vec 4 1\<rangle> $$ (0,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (1,0) = |unit_vec 4 1\<rangle> $$ (1,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide del: One_nat_def)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (2,0) = |unit_vec 4 1\<rangle> $$ (2,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  moreover have "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (3,0) = |unit_vec 4 1\<rangle> $$ (3,0)"
    by(simp add: post_meas1_def unit_vec_def select_index_def bell11_def ket_vec_def real_sqrt_divide)
  ultimately show "post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1 $$ (i,j) = |unit_vec 4 1\<rangle> $$ (i,j)" by auto
next
  show "dim_row (post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1) = dim_row |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
  show "dim_col (post_meas1 2 |\<beta>\<^sub>1\<^sub>1\<rangle> 1) = dim_col |unit_vec 4 1\<rangle>"
    by(auto simp add: post_meas1_def ket_vec_def)
qed

end


(*  Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com> *)

section \<open>Number Partitions\<close>

theory Number_Partition
imports Additions_to_Main
begin

subsection \<open>Number Partitions as @{typ "nat => nat"} Functions\<close>

definition partitions :: "(nat \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> bool" (infix "partitions" 50)
where
  "p partitions n = ((\<forall>i. p i \<noteq> 0 \<longrightarrow> 1 \<le> i \<and> i \<le> n) \<and> (\<Sum>i\<le>n. p i * i) = n)"

lemma partitionsI:
  assumes "\<And>i. p i \<noteq> 0 \<Longrightarrow> 1 \<le> i \<and> i \<le> n"
  assumes "(\<Sum>i\<le>n. p i * i) = n"
  shows "p partitions n"
using assms unfolding partitions_def by auto

lemma partitionsE:
  assumes "p partitions n"
  obtains "\<And>i. p i \<noteq> 0 \<Longrightarrow> 1 \<le> i \<and> i \<le> n" "(\<Sum>i\<le>n. p i * i) = n"
using assms unfolding partitions_def by auto

lemma partitions_zero:
  "p partitions 0 \<longleftrightarrow> p = (\<lambda>i. 0)"
unfolding partitions_def by auto

lemma partitions_one:
  "p partitions (Suc 0) \<longleftrightarrow> p = (\<lambda>i. 0)(1 := 1)"
unfolding partitions_def
by (auto split: if_split_asm) (auto simp add: fun_eq_iff)

subsection \<open>Bounds and Finiteness of Number Partitions\<close>

lemma partitions_imp_finite_elements:
  assumes "p partitions n"
  shows "finite {i. 0 < p i}"
proof -
  from assms have "{i. 0 < p i} \<subseteq> {..n}" by (auto elim: partitionsE)
  from this show ?thesis
    using rev_finite_subset by blast
qed

lemma partitions_imp_multiset:
  assumes "p partitions n"
  shows "p \<in> multiset"
using assms partitions_imp_finite_elements multiset_def by auto

lemma partitions_bounds:
  assumes "p partitions n"
  shows "p i \<le> n"
proof -
  from assms have index_bounds: "(\<forall>i. p i \<noteq> 0 \<longrightarrow> 1 \<le> i \<and> i \<le> n)"
    and sum: "(\<Sum>i\<le>n. p i * i) = n"
    unfolding partitions_def by auto
  show ?thesis
  proof (cases "1 \<le> i \<and> i \<le> n")
    case True
    from True have "{..n} = insert i {i'. i' \<le> n \<and> i' \<noteq> i}" by blast
    from sum[unfolded this] have "p i * i + (\<Sum>i\<in>{i'. i' \<le> n \<and> i' \<noteq> i}. p i * i) = n" by auto
    from this have "p i * i \<le> n" by linarith
    from this True show ?thesis using dual_order.trans by fastforce
  next
    case False
    from this index_bounds show ?thesis by fastforce
  qed
qed

lemma partitions_parts_bounded:
  assumes "p partitions n"
  shows "sum p {..n} \<le> n"
proof -
  {
    fix i
    assume "i \<le> n"
    from assms have "p i \<le> p i * i"
      by (auto elim!: partitionsE)
  }
  from this have "sum p {..n} \<le> (\<Sum>i\<le>n. p i * i)"
    by (auto intro: sum_mono)
  also from assms have n: "(\<Sum>i\<le>n. p i * i) = n"
    by (auto elim!: partitionsE)
  finally show ?thesis .
qed

lemma finite_partitions:
  "finite {p. p partitions n}"
proof -
  have "{p. p partitions n} \<subseteq> {f. (\<forall>i. f i \<le> n) \<and> (\<forall>i. n + 1 \<le> i \<longrightarrow> f i = 0)}"
    by (auto elim: partitions_bounds) (auto simp add: partitions_def)
  from this bound_domain_and_range_impl_finitely_many_functions[of n "n + 1"] show ?thesis
    by (simp add: finite_subset)
qed

lemma finite_partitions_k_parts:
  "finite {p. p partitions n \<and> sum p {..n} = k}"
by (simp add: finite_partitions)

lemma partitions_remaining_Max_part:
  assumes "p partitions n"
  assumes "0 < p k"
  shows "\<forall>i. n - k < i \<and> i \<noteq> k \<longrightarrow> p i = 0"
proof (clarify)
  fix i
  assume "n - k < i" "i \<noteq> k"
  show "p i = 0"
  proof (cases "i \<le> n")
    assume "i \<le> n"
    from assms have n: "(\<Sum>i\<le>n. p i * i) = n" and "k \<le> n"
      by (auto elim: partitionsE)
    have "(\<Sum>i\<le>n. p i * i) = p k * k + (\<Sum>i\<in>{..n}-{k}. p i * i)"
      using \<open>k \<le> n\<close> sum_atMost_remove_nat by blast
    also have "... = p i * i + p k * k + (\<Sum>i\<in>{..n}-{i, k}. p i * i)"
      using \<open>i \<le> n\<close> \<open>i \<noteq> k\<close>
      by (auto simp add: sum.remove[where x="i"]) (metis Diff_insert)
    finally have eq: "(\<Sum>i\<le>n. p i * i) = p i * i + p k * k + (\<Sum>i\<in>{..n} - {i, k}. p i * i)" .
    show "p i = 0"
    proof (rule ccontr)
      assume "p i \<noteq> 0"
      have upper_bound: "p i * i + p k * k \<le> n"
        using eq n by auto
      have lower_bound: "p i * i + p k * k > n"
        using \<open>n - k < i\<close> \<open>0 < p k\<close> \<open>k \<le> n\<close> \<open>p i \<noteq> 0\<close> mult_eq_if not_less by auto
      from upper_bound lower_bound show False by simp
    qed
  next
    assume "\<not> (i \<le> n)"
    from this show "p i = 0"
      using assms(1) by (auto elim: partitionsE)
  qed
qed

subsection \<open>Operations of Number Partitions\<close>

lemma partitions_remove1_bounds:
  assumes partitions: "p partitions n"
  assumes gr0: "0 < p k"
  assumes neq: "(p(k := p k - 1)) i \<noteq> 0"
  shows "1 \<le> i \<and> i \<le> n - k"
proof
    from partitions neq show "1 \<le> i"
      by (auto elim!: partitionsE split: if_split_asm)
next
  from partitions gr0 have n: "(\<Sum>i\<le>n. p i * i) = n" and "k \<le> n"
    by (auto elim: partitionsE)
  show "i \<le> n - k"
  proof cases
    assume "k \<le> n - k"
    from \<open>k \<le> n - k\<close> neq show ?thesis
      using  partitions_remaining_Max_part[OF partitions gr0] not_le by force
  next
    assume "\<not> k \<le> n - k"
    from this have "2 * k > n" by auto
    have "p k = 1"
    proof (rule ccontr)
      assume "p k \<noteq> 1"
      with gr0 have "p k \<ge> 2" by auto
      from this have "p k * k \<ge> 2 * k" by simp
      with \<open>2 * k > n\<close> have "p k * k > n" by linarith
      from \<open>k \<le> n\<close> this have "(\<Sum>i\<le>n. p i * i) > n"
        by (simp add: sum_atMost_remove_nat[of k])
      from this n show "False" by auto
    qed
    from neq this show ?thesis
      using partitions_remaining_Max_part[OF partitions gr0] leI
      by (auto split: if_split_asm) force
  qed
qed

lemma partitions_remove1:
  assumes partitions: "p partitions n"
  assumes gr0: "0 < p k"
  shows "p(k := p k - 1) partitions (n - k)"
proof (rule partitionsI)
  fix i
  assume "(p(k := p k - 1)) i \<noteq> 0"
  from this show "1 \<le> i \<and> i \<le> n - k" using partitions_remove1_bounds partitions gr0 by blast
next
  from partitions gr0 have "k \<le> n" by (auto elim: partitionsE)
  have "(\<Sum>i\<le>n - k. (p(k := p k - 1)) i * i) = (\<Sum>i\<le>n. (p(k := p k - 1)) i * i)"
    using partitions_remove1_bounds partitions gr0 by (auto intro!: sum.mono_neutral_left)
  also have "... = (p k - 1) * k + (\<Sum>i\<in>{..n} - {k}. (p(k := p k - 1)) i * i)"
    using \<open>k \<le> n\<close> by (simp add: sum_atMost_remove_nat[where k="k"])
  also have "... = p k * k + (\<Sum>i\<in>{..n} - {k}. p i * i) - k"
    using gr0 by (simp add: diff_mult_distrib)
  also have "... = (\<Sum>i\<le>n. p i * i) - k"
    using \<open>k \<le> n\<close> by (simp add: sum_atMost_remove_nat[of k])
  also from partitions have "... = n - k"
    by (auto elim: partitionsE)
  finally show "(\<Sum>i\<le>n - k. (p(k := p k - 1)) i * i) = n - k" .
qed

lemma partitions_insert1:
  assumes p: "p partitions n"
  assumes "k > 0"
  shows "(p(k := p k + 1)) partitions (n + k)"
proof (rule partitionsI)
  fix i
  assume "(p(k := p k + 1)) i \<noteq> 0"
  from p this \<open>k > 0\<close> show "1 \<le> i \<and> i \<le> n + k"
    by (auto elim!: partitionsE)
next
  have "(\<Sum>i\<le>n + k. (p(k := p k + 1)) i * i) = p k * k + (\<Sum>i\<in>{..n + k} - {k}. p i * i) + k"
    by (simp add: sum_atMost_remove_nat[of k])
  also have "... = p k * k + (\<Sum>i\<in>{..n} - {k}. p i * i) + k"
    using p by (auto intro!: sum.mono_neutral_right elim!: partitionsE)
  also have "... = (\<Sum>i\<le>n. p i * i) + k"
    using p by (cases "k \<le> n") (auto simp add: sum_atMost_remove_nat[of k] elim: partitionsE)
  also have "... = n + k"
    using p by (auto elim: partitionsE)
  finally show "(\<Sum>i\<le>n + k. (p(k := p k + 1)) i * i) = n + k" .
qed

lemma count_remove1:
  assumes "p partitions n"
  assumes "0 < p k"
  shows "(\<Sum>i\<le>n - k. (p(k := p k - 1)) i) = (\<Sum>i\<le>n. p i) - 1"
proof -
  have "k \<le> n" using assms by (auto elim: partitionsE)
  have "(\<Sum>i\<le>n - k. (p(k := p k - 1)) i) = (\<Sum>i\<le>n. (p(k := p k - 1)) i)"
    using partitions_remove1_bounds assms by (auto intro!: sum.mono_neutral_left)
  also have "(\<Sum>i\<le>n. (p(k := p k - 1)) i) = p k + (\<Sum>i\<in>{..n} - {k}. p i) - 1"
    using \<open>0 < p k\<close> \<open>k \<le> n\<close> by (simp add: sum_atMost_remove_nat[of k])
  also have "... = (\<Sum>i\<in>{..n}. p i) - 1"
    using \<open>k \<le> n\<close> by (simp add: sum_atMost_remove_nat[of k])
  finally show ?thesis .
qed

lemma count_insert1:
  assumes "p partitions n"
  shows "sum (p(k := p k + 1)) {..n + k} = (\<Sum>i\<le>n. p i) + 1"
proof -
  have "(\<Sum>i\<le>n + k. (p(k := p k + 1)) i) = p k + (\<Sum>i\<in>{..n + k} - {k}. p i) + 1"
    by (simp add: sum_atMost_remove_nat[of k])
  also have "... = p k + (\<Sum>i\<in>{..n} - {k}. p i) + 1"
    using assms by (auto intro!: sum.mono_neutral_right elim!: partitionsE)
  also have "... = (\<Sum>i\<le>n. p i) + 1"
    using assms by (cases "k \<le> n") (auto simp add: sum_atMost_remove_nat[of k] elim: partitionsE)
  finally show ?thesis .
qed

lemma partitions_decrease1:
  assumes p: "p partitions m"
  assumes sum: "sum p {..m} = k"
  assumes "p 1 = 0"
  shows "(\<lambda>i. p (i + 1)) partitions m - k"
proof -
  from p have "p 0 = 0" by (auto elim!: partitionsE)
  {
    fix i
    assume neq: "p (i + 1) \<noteq> 0"
    from p this \<open>p 1 = 0\<close> have "1 \<le> i"
      by (fastforce elim!: partitionsE simp add: le_Suc_eq)
    moreover have "i \<le> m - k"
    proof (rule ccontr)
      assume i_greater: "\<not> i \<le> m - k"
      from p have s: "(\<Sum>i\<le>m. p i * i) = m"
        by (auto elim!: partitionsE)
      from p sum have "k \<le> m"
        using partitions_parts_bounded by fastforce
      from neq p have "i + 1 \<le> m" by (auto elim!: partitionsE)
      from i_greater have "i > m - k" by simp
      have ineq1: "i + 1 > (m - k) + 1"
        using i_greater by simp
      have ineq21: "(\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j * j) \<ge> (\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j)"
        using \<open>p 0 = 0\<close> not_less by (fastforce intro!: sum_mono)
      have ineq22a: "(\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j) = (\<Sum>j\<le>m. p j) - 1"
        using \<open>i + 1 \<le> m\<close> neq by (simp add: sum.remove[where x="i + 1"])
      have ineq22: "(\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j) \<ge> k - 1"
        using sum neq ineq22a by auto
      have ineq2: "(\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j * j) \<ge> k - 1"
        using ineq21 ineq22 by auto
      have "(\<Sum>i\<le>m. p i * i) = p (i + 1) * (i + 1) + (\<Sum>i\<in>{..m} - {i + 1}. p i * i)"
        using \<open>i + 1 \<le> m\<close> neq
        by (subst sum.remove[where x="i + 1"]) auto
      also have "... = (i + 1) + (\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j * j)"
        using \<open>i + 1 \<le> m\<close> neq
        by (subst sum.remove[where x="i + 1" and g="\<lambda>j. (p(i + 1 := p (i + 1) - 1)) j * j"])
          (auto simp add: mult_eq_if)
      finally have "(\<Sum>i\<le>m. p i * i) = i + 1 + (\<Sum>j\<le>m. (p(i + 1 := p (i + 1) - 1)) j * j)" .
      moreover have "... > m" using ineq1 ineq2 \<open>k \<le> m\<close> \<open>p (i + 1) \<noteq> 0\<close> by linarith
      ultimately have "(\<Sum>i\<le>m. p i * i) > m" by simp
      from s this show False by simp
    qed
    ultimately have "1 \<le> i \<and> i \<le> m - k" ..
  } note bounds = this
  show "(\<lambda>i. p (i + 1)) partitions m - k"
  proof (rule partitionsI)
    fix i
    assume "p (i + 1) \<noteq> 0"
    from bounds this show "1 \<le> i \<and> i \<le> m - k" .
  next
    have geq: "\<forall>i. p i * i \<ge> p i"
      using \<open>p 0 = 0\<close> not_less by fastforce
    have "(\<Sum>i\<le>m - k. p (i + 1) * i) = (\<Sum>i\<le>m. p (i + 1) * i)"
      using bounds by (auto intro: sum.mono_neutral_left)
    also have "... = (\<Sum>i\<in>Suc ` {..m}. p i * (i - 1))"
      by (auto simp add: sum.reindex)
    also have "... = (\<Sum>i\<le>Suc m. p i * (i - 1))"
      using \<open>p 0 = 0\<close> by (simp add: atMost_Suc_eq_insert_0 zero_notin_Suc_image)
    also have "... = (\<Sum>i\<le>m. p i * (i - 1))"
      using p by (auto elim!: partitionsE)
    also have "... = (\<Sum>i\<le>m. p i * i - p i)"
      by (simp add: diff_mult_distrib2)
    also have "... = (\<Sum>i\<le>m. p i * i) - (\<Sum>i\<le>m. p i)"
      using geq by (simp only: sum_subtractf_nat)
    also have "... = m - k" using sum p by (auto elim!: partitionsE)
    finally show "(\<Sum>i\<le>m - k. p (i + 1) * i) = m - k" .
  qed
qed

lemma partitions_increase1:
  assumes partitions: "p partitions m - k"
  assumes k: "sum p {..m - k} = k"
  shows "(\<lambda>i. p (i - 1)) partitions m"
proof (rule partitionsI)
  fix i
  assume "p (i - 1) \<noteq> 0"
  from partitions this k show "1 \<le> i \<and> i \<le> m"
    by (cases k) (auto elim!: partitionsE)
next
  from k partitions have "k \<le> m"
    using linear partitions_zero by force
  have eq_0: "\<forall>i>m - k. p i = 0" using partitions by (auto elim!: partitionsE)
  from partitions have s: "(\<Sum>i\<le>m - k. p i * i) = m - k" by (auto elim!: partitionsE)
  have "(\<Sum>i\<le>m. p (i - 1) * i) = (\<Sum>i\<le>Suc m. p (i - 1) * i)"
    using partitions k by (cases k) (auto elim!: partitionsE)
  also have "(\<Sum>i\<le>Suc m. p (i - 1) * i) = (\<Sum>i\<le>m. p i * (i + 1))"
    by (subst sum.atMost_Suc_shift) simp
  also have "... = (\<Sum>i\<le>m - k. p i * (i + 1))"
    using eq_0 by (auto intro: sum.mono_neutral_right)
  also have "... = (\<Sum>i\<le>m - k. p i * i) + (\<Sum>i\<le>m - k. p i)" by (simp add: sum.distrib)
  also have "... = m - k + k" using s k by simp
  also have "... = m" using \<open>k \<le> m\<close> by simp
  finally show "(\<Sum>i\<le>m. p (i - 1) * i) = m" .
qed

lemma count_decrease1:
  assumes p: "p partitions m"
  assumes sum: "sum p {..m} = k"
  assumes "p 1 = 0"
  shows "sum (\<lambda>i. p (i + 1)) {..m - k} = k"
proof -
  from p have "p 0 = 0" by (auto elim!: partitionsE)
  have "sum (\<lambda>i. p (i + 1)) {..m - k} = sum (\<lambda>i. p (i + 1)) {..m}"
    using partitions_decrease1[OF assms]
    by (auto intro: sum.mono_neutral_left elim!: partitionsE)
  also have "\<dots> = sum (\<lambda>i. p (i + 1)) {0..m}" by (simp add: atLeast0AtMost)
  also have "\<dots> = sum (\<lambda>i. p i) {Suc 0.. Suc m}"
    by (simp only: One_nat_def add_Suc_right add_0_right sum.shift_bounds_cl_Suc_ivl)
  also have "\<dots> = sum (\<lambda>i. p i) {.. Suc m}"
    using \<open>p 0 = 0\<close> by (simp add: atLeast0AtMost sum_shift_lb_Suc0_0)
  also have "\<dots> = sum (\<lambda>i. p i) {.. m}"
    using p by (auto elim!: partitionsE)
  also have "\<dots> = k"
    using sum by simp
  finally show ?thesis .
qed

lemma count_increase1:
  assumes partitions: "p partitions m - k"
  assumes k: "sum p {..m - k} = k"
  shows "(\<Sum>i\<le>m. p (i - 1)) = k"
proof -
  have "p 0 = 0" using partitions by (auto elim!: partitionsE)
  have "(\<Sum>i\<le>m. p (i - 1)) = (\<Sum>i\<in>{1..m}. p (i - 1))"
    using \<open>p 0 = 0\<close> by (auto intro: sum.mono_neutral_cong_right)
  also have "(\<Sum>i\<in>{1..m}. p (i - 1)) = (\<Sum>i\<le>m - 1. p i)"
  proof (cases m)
    case 0
    from this show ?thesis using \<open>p 0 = 0\<close> by simp
  next
    case (Suc m')
    {
      fix x assume "Suc 0 \<le> x" "x \<le> m"
      from this Suc have "x \<in> Suc ` {..m'}"
        by (auto intro!: image_eqI[where x="x - 1"])
    }
    from this Suc show ?thesis
      by (intro sum.reindex_cong[of Suc]) auto
  qed
  also have "(\<Sum>i\<le>m - 1. p i) = (\<Sum>i\<le>m. p i)"
  proof -
    {
      fix i
      assume "0 < p i" "i \<le> m"
      from assms this have "i \<le> m - 1"
        using \<open>p 0 = 0\<close> partitions_increase1 by (cases k) (auto elim!: partitionsE)
    }
    from this show ?thesis
      by (auto intro: sum.mono_neutral_cong_left)
  qed
  also have "... = (\<Sum>i\<le>m - k. p i)"
    using partitions by (auto intro: sum.mono_neutral_right elim!: partitionsE)
  also have "... = k" using k by auto
  finally show ?thesis .
qed

subsection \<open>Number Partitions as Multisets on Natural Numbers\<close>

definition number_partition :: "nat \<Rightarrow> nat multiset \<Rightarrow> bool"
where
  "number_partition n N = (sum_mset N = n \<and> 0 \<notin># N)"

subsubsection \<open>Relationship to Definition on Functions\<close>

lemma count_partitions_iff:
  "count N partitions n \<longleftrightarrow> number_partition n N"
proof
  assume "count N partitions n"
  from this have "(\<forall>i. count N i \<noteq> 0 \<longrightarrow> 1 \<le> i \<and> i \<le> n)" "(\<Sum>i\<le>n. count N i * i) = n"
    unfolding Number_Partition.partitions_def by auto
  moreover from this have "set_mset N \<subseteq> {..n}" by auto
  moreover have "finite {..n}" by auto
  ultimately have "sum_mset N = n"
    using sum_mset_sum_count sum_mset_eq_sum_on_supersets by presburger
  moreover have "0 \<notin># N"
    using \<open>\<forall>i. count N i \<noteq> 0 \<longrightarrow> 1 \<le> i \<and> i \<le> n\<close> by auto
  ultimately show "number_partition n N"
    unfolding number_partition_def by auto
next
  assume "number_partition n N"
  from this have "sum_mset N = n" and "0 \<notin># N"
    unfolding number_partition_def by auto
  {
    fix i
    assume "count N i \<noteq> 0"
    have "1 \<le> i \<and> i \<le> n"
    proof
      from \<open>0 \<notin># N\<close> \<open>count N i \<noteq> 0\<close> show "1 \<le> i"
        using Suc_le_eq by auto
      from \<open>sum_mset N = n\<close> \<open>count N i \<noteq> 0\<close> show "i \<le> n"
        using multi_member_split by fastforce
    qed
  }
  moreover from \<open>sum_mset N = n\<close> have "(\<Sum>i\<le>n. count N i * i) = n"
    by (metis atMost_iff calculation finite_atMost not_in_iff subsetI sum_mset_eq_sum_on_supersets sum_mset_sum_count)
  ultimately show "count N partitions n"
    by (rule partitionsI) auto
qed

lemma partitions_iff_Abs_multiset:
  "p partitions n \<longleftrightarrow> finite {x. 0 < p x} \<and> number_partition n (Abs_multiset p)"
proof
  assume "p partitions n"
  from this have bounds: "(\<forall>i. p i \<noteq> 0 \<longrightarrow> 1 \<le> i \<and> i \<le> n)"
    and sum: "(\<Sum>i\<le>n. p i * i) = n"
  unfolding partitions_def by auto
  from \<open>p partitions n\<close> have "p \<in> multiset" by (rule partitions_imp_multiset)
  from \<open>p partitions n\<close> have "finite {x. 0 < p x}"
    by (rule partitions_imp_finite_elements)
  moreover from \<open>p \<in> multiset\<close> bounds have "\<not> 0 \<in># Abs_multiset p"
    using count_eq_zero_iff by force
  moreover from \<open>p \<in> multiset\<close> this sum have "sum_mset (Abs_multiset p) = n"
  proof -
    have "(\<Sum>i\<in>{x. 0 < p x}. p i * i) = (\<Sum>i\<le>n. p i * i)"
      using bounds by (auto intro: sum.mono_neutral_cong_left)
    from \<open>p \<in> multiset\<close> this sum show "sum_mset (Abs_multiset p) = n"
      by (simp add: sum_mset_sum_count set_mset_Abs_multiset)
  qed
  ultimately show "finite {x. 0 < p x} \<and> number_partition n (Abs_multiset p)"
    unfolding number_partition_def by auto
next
  assume "finite {x. 0 < p x} \<and> number_partition n (Abs_multiset p)"
  from this have "finite {x. 0 < p x}" "0 \<notin># Abs_multiset p" "sum_mset (Abs_multiset p) = n"
    unfolding number_partition_def by auto
  from \<open>finite {x. 0 < p x}\<close> have "p \<in> multiset" by (simp add: multiset_def)
  from \<open>p \<in> multiset\<close> have "(\<Sum>i\<in>{x. 0 < p x}. p i * i) = n"
    using \<open> sum_mset (Abs_multiset p) = n\<close>
    by (simp add: sum_mset_sum_count set_mset_Abs_multiset)
  have bounds: "\<And>i. p i \<noteq> 0 \<Longrightarrow> 1 \<le> i \<and> i \<le> n"
  proof
    fix i
    assume "p i \<noteq> 0"
    from \<open>\<not> 0 \<in># Abs_multiset p\<close> \<open>p \<in> multiset\<close> have "p 0 = 0"
      using count_inI by force
    from this \<open>p i \<noteq> 0\<close> show "1 \<le> i"
      by (metis One_nat_def leI less_Suc0)
    show "i \<le> n"
    proof (rule ccontr)
      assume "\<not> i \<le> n"
      from this have "i > n"
        using le_less_linear by blast
      from this \<open>p i \<noteq> 0\<close> have "p i * i > n"
        by (auto simp add: less_le_trans)
      from \<open>p i \<noteq> 0\<close> have "(\<Sum>i\<in>{x. 0 < p x}. p i * i) = p i * i + (\<Sum>i\<in>{x. 0 < p x} - {i}. p i * i)"
        using \<open>finite {x. 0 < p x}\<close>
        by (subst sum.insert_remove[symmetric]) (auto simp add: insert_absorb)
      also from \<open>p i * i > n\<close> have "\<dots> > n" by auto
      finally show False using \<open>(\<Sum>i\<in>{x. 0 < p x}. p i * i) = n\<close> by blast
    qed
  qed
  moreover have "(\<Sum>i\<le>n. p i * i) = n"
  proof -
    have "(\<Sum>i\<le>n. p i * i) = (\<Sum>i\<in>{x. 0 < p x}. p i * i)"
      using bounds by (auto intro: sum.mono_neutral_cong_right)
    from this show ?thesis
      using \<open>(\<Sum>i\<in>{x. 0 < p x}. p i * i) = n\<close> by simp
  qed
  ultimately show "p partitions n" by (auto intro: partitionsI)
qed

lemma size_nat_multiset_eq:
  fixes N :: "nat multiset"
  assumes "number_partition n N"
  shows "size N = sum (count N) {..n}"
proof -
  have "set_mset N \<subseteq> {..sum_mset N}"
    by (auto dest: multi_member_split)
  have "size N = sum (count N) (set_mset N)"
    by (rule size_multiset_overloaded_eq)
  also have "\<dots> = sum (count N) {..sum_mset N}"
    using \<open>set_mset N \<subseteq> {..sum_mset N}\<close>
    by (auto intro: sum.mono_neutral_cong_left count_inI)
  finally show ?thesis
    using \<open>number_partition n N\<close>
    unfolding number_partition_def by auto
qed

end


(*
  File:    Liouville_Numbers_Misc.thy
  Author:  Manuel Eberl <manuel@pruvisto.org>

*)

section \<open>Liouville Numbers\<close>
subsection \<open>Preliminary lemmas\<close>
theory Liouville_Numbers_Misc
imports
  Complex_Main
  "HOL-Computational_Algebra.Polynomial"
begin

text \<open>
  We will require these inequalities on factorials to show properties of the standard
  construction later.
\<close>

lemma fact_ineq: "n \<ge> 1 \<Longrightarrow> fact n + k \<le> fact (n + k)"
proof (induction k)
  case (Suc k)
  from Suc have "fact n + Suc k \<le> fact (n + k) + 1" by simp
  also from Suc have "\<dots> \<le> fact (n + Suc k)" by simp
  finally show ?case .
qed simp_all

lemma Ints_sum:
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<int>"
  shows   "sum f A \<in> \<int>"
  by (cases "finite A", insert assms, induction A rule: finite_induct)
     (auto intro!: Ints_add)

lemma suminf_split_initial_segment':
  "summable (f :: nat \<Rightarrow> 'a::real_normed_vector) \<Longrightarrow>
       suminf f = (\<Sum>n. f (n + k + 1)) + sum f {..k}"
  by (subst suminf_split_initial_segment[of _ "Suc k"], assumption, subst lessThan_Suc_atMost)
     simp_all

lemma Rats_eq_int_div_int': "(\<rat> :: real set) = {of_int p / of_int q |p q. q > 0}"
proof safe
  fix x :: real assume "x \<in> \<rat>"
  then obtain p q where pq: "x = of_int p / of_int q" "q \<noteq> 0"
    by (subst (asm) Rats_eq_int_div_int) auto
  show "\<exists>p q. x = real_of_int p / real_of_int q \<and> 0 < q"
  proof (cases "q > 0")
    case False
    show ?thesis by (rule exI[of _ "-p"], rule exI[of _ "-q"]) (insert False pq, auto)
  qed (insert pq, force)
qed auto

lemma Rats_cases':
  assumes "(x :: real) \<in> \<rat>"
  obtains p q where "q > 0" "x = of_int p / of_int q"
  using assms by (subst (asm) Rats_eq_int_div_int') auto

text \<open>
  The following inequality gives a lower bound for the absolute value of an
  integer polynomial at a rational point that is not a root.
\<close>
lemma int_poly_rat_no_root_ge:
  fixes p :: "real poly" and a b :: int
  assumes "\<And>n. coeff p n \<in> \<int>"
  assumes "b > 0" "poly p (a / b) \<noteq> 0"
  defines "n \<equiv> degree p"
  shows   "abs (poly p (a / b)) \<ge> 1 / of_int b ^ n"
proof -
  let ?S = "(\<Sum>i\<le>n. coeff p i * of_int a ^ i * (of_int b ^ (n - i)))"
  from \<open>b > 0\<close> have eq: "?S = of_int b ^ n * poly p (a / b)"
    by (simp add: poly_altdef power_divide mult_ac n_def sum_distrib_left power_diff)
  have "?S \<in> \<int>" by (intro Ints_sum Ints_mult assms Ints_power) simp_all
  moreover from assms have "?S \<noteq> 0" by (subst eq) auto
  ultimately have "abs ?S \<ge> 1" by (elim Ints_cases) simp
  with eq \<open>b > 0\<close> show ?thesis by (simp add: field_simps abs_mult)
qed

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_sort_nat_HSortPermutes
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

datatype Heap = Node "Heap" "Nat" "Heap" | Nil

fun toHeap :: "Nat list => Heap list" where
  "toHeap (nil2) = nil2"
| "toHeap (cons2 y z) = cons2 (Node Nil y Nil) (toHeap z)"

fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

fun hmerge :: "Heap => Heap => Heap" where
  "hmerge (Node z x2 x3) (Node x4 x5 x6) =
   (if le x2 x5 then Node (hmerge x3 (Node x4 x5 x6)) x2 z else
      Node (hmerge (Node z x2 x3) x6) x5 x4)"
| "hmerge (Node z x2 x3) (Nil) = Node z x2 x3"
| "hmerge (Nil) y = y"

fun hpairwise :: "Heap list => Heap list" where
  "hpairwise (nil2) = nil2"
| "hpairwise (cons2 q (nil2)) = cons2 q (nil2)"
| "hpairwise (cons2 q (cons2 r qs)) =
     cons2 (hmerge q r) (hpairwise qs)"

(*fun did not finish the proof*)
function hmerging :: "Heap list => Heap" where
  "hmerging (nil2) = Nil"
| "hmerging (cons2 q (nil2)) = q"
| "hmerging (cons2 q (cons2 z x2)) =
     hmerging (hpairwise (cons2 q (cons2 z x2)))"
  by pat_completeness auto

fun toHeap2 :: "Nat list => Heap" where
  "toHeap2 x = hmerging (toHeap x)"

(*fun did not finish the proof*)
function toList :: "Heap => Nat list" where
  "toList (Node q y r) = cons2 y (toList (hmerge q r))"
| "toList (Nil) = nil2"
  by pat_completeness auto

fun hsort :: "Nat list => Nat list" where
  "hsort x = toList (toHeap2 x)"

fun elem :: "'a => 'a list => bool" where
  "elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

fun isPermutation :: "'a list => 'a list => bool" where
  "isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z x2) = False"
| "isPermutation (cons2 x3 xs) y =
     ((elem x3 y) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 y)))"

theorem property0 :
  "isPermutation (hsort xs) xs"
  oops

end