(*
    Authors:    Jose Divasón
                Sebastiaan Joosten
                René Thiemann
                Akihisa Yamada
    License:    BSD
*)

section \<open>Factor bound\<close>

text \<open>This theory extends the work about factor bounds which was carried out
  in the Berlekamp-Zassenhaus development.\<close>

theory Factor_Bound_2
imports Berlekamp_Zassenhaus.Factor_Bound
   LLL_Basis_Reduction.Norms
begin

lemma norm_1_bound_mignotte: "norm1 f \<le> 2^(degree f) * mahler_measure f"
proof (cases "f = 0")
  case f0: False
  have cf: "coeffs f = map (\<lambda> i. coeff f i) [0 ..< Suc( degree f)]" unfolding coeffs_def
    using f0 by auto
  have "real_of_int (sum_list (map abs (coeffs f)))
    = (\<Sum>i\<le>degree f. real_of_int \<bar>poly.coeff f i\<bar>)"
    unfolding cf of_int_hom.hom_sum_list unfolding sum_list_sum_nth
    by (rule sum.cong, force, auto simp: o_def nth_append)
  also have "\<dots> \<le> (\<Sum>i\<le>degree f. real (degree f choose i) * mahler_measure f)"
    by (rule sum_mono, rule Mignotte_bound)
  also have "\<dots> = real (sum (\<lambda> i. (degree f choose i)) {..degree f}) * mahler_measure f"
    unfolding sum_distrib_right[symmetric] by auto
  also have "\<dots> = 2^(degree f) * mahler_measure f" unfolding choose_row_sum by auto
  finally show ?thesis unfolding norm1_def .
qed (auto simp: mahler_measure_ge_0 norm1_def)

lemma mahler_measure_l2norm: "mahler_measure f \<le> sqrt (of_int \<parallel>f\<parallel>\<^sup>2)"
  using Landau_inequality_mahler_measure[of f] unfolding sq_norm_poly_def
  by (auto simp: power2_eq_square)

lemma sq_norm_factor_bound:
  fixes f h :: "int poly"
  assumes dvd: "h dvd f" and f0: "f \<noteq> 0"
  shows "\<parallel>h\<parallel>\<^sup>2 \<le> 2 ^ (2 * degree h) * \<parallel>f\<parallel>\<^sup>2"
proof -
  let ?r = real_of_int
  have h21: "?r \<parallel>h\<parallel>\<^sup>2 \<le> (?r (norm1 h))^2" using norm2_le_norm1_int[of h]
    by (metis of_int_le_iff of_int_power)
  also have "\<dots> \<le> (2^(degree h) * mahler_measure h)^2"
    using power_mono[OF norm_1_bound_mignotte[of h], of 2]
    by (auto simp: norm1_ge_0)
  also have "\<dots> = 2^(2 * degree h) * (mahler_measure h)^2"
    by (simp add: power_even_eq power_mult_distrib)
  also have "\<dots> \<le> 2^(2 * degree h) * (mahler_measure f)^2"
    by (rule mult_left_mono[OF power_mono], auto simp: mahler_measure_ge_0
    mahler_measure_dvd[OF f0 dvd])
  also have "\<dots> \<le> 2^(2 * degree h) * ?r (\<parallel>f\<parallel>\<^sup>2)"
  proof (rule mult_left_mono)
    have "?r (\<parallel>f\<parallel>\<^sup>2) \<ge> 0" by auto
    from real_sqrt_pow2[OF this]
    show "(mahler_measure f)\<^sup>2 \<le> ?r (\<parallel>f\<parallel>\<^sup>2)"
      using power_mono[OF mahler_measure_l2norm[of f], of 2]
      by (auto simp: mahler_measure_ge_0)
  qed auto
  also have "\<dots> = ?r (2^(2*degree h) * \<parallel>f\<parallel>\<^sup>2)"
    by (simp add: ac_simps)
  finally show "\<parallel>h\<parallel>\<^sup>2 \<le> 2 ^ (2 * degree h) * \<parallel>f\<parallel>\<^sup>2" unfolding of_int_le_iff .
qed

end


section\<open>Boolean functions\<close>
theory Bool_Func
imports Main
begin
text\<open>
  The end result of our implementation is verified against these functions:
\<close>
type_synonym 'a boolfunc = "('a \<Rightarrow> bool) \<Rightarrow> bool"

text\<open>if-then-else on boolean functions.\<close>
definition "bf_ite i t e \<equiv> (\<lambda>l. if i l then t l else e l)"
text\<open>if-then-else is interesting because we can, together with constant true and false, represent all binary boolean functions using maximally two applications of it.\<close>
abbreviation "bf_True \<equiv> (\<lambda>l. True)"
abbreviation "bf_False \<equiv> (\<lambda>l. False)"
text\<open>A quick demonstration:\<close>
definition "bf_and a b \<equiv> bf_ite a b bf_False"
lemma "(bf_and a b) as \<longleftrightarrow> a as \<and> b as" unfolding bf_and_def  bf_ite_def  by meson
definition "bf_not b \<equiv> bf_ite b bf_False bf_True"
lemma bf_not_alt: "bf_not a as \<longleftrightarrow> \<not>a as" unfolding bf_not_def bf_ite_def by meson
text\<open>For convenience, we want a few functions more:\<close>
definition "bf_or a b \<equiv> bf_ite a bf_True b"
definition "bf_lit v \<equiv> (\<lambda>l. l v)"
definition "bf_if v t e \<equiv> bf_ite (bf_lit v) t e"
lemma bf_if_alt: "bf_if v t e = (\<lambda>l. if l v then t l else e l)" unfolding bf_if_def bf_ite_def bf_lit_def ..
definition "bf_nand a b = bf_not (bf_and a b)"
definition "bf_nor a b = bf_not (bf_or a b)"
definition "bf_biimp a b = (bf_ite a b (bf_not b))"
lemma bf_biimp_alt: "bf_biimp a b = (\<lambda>l. a l \<longleftrightarrow> b l)" unfolding bf_biimp_def bf_not_def bf_ite_def by(simp add: fun_eq_iff)
definition "bf_xor a b = bf_not (bf_biimp a b)"
lemma bf_xor_alt: "bf_xor a b = (bf_ite a (bf_not b) b)" (* two application version *)
  unfolding bf_xor_def bf_biimp_def bf_not_def
  unfolding bf_ite_def
  by simp
text\<open>All of these are implemented and had their implementation verified.\<close>

definition "bf_imp a b = bf_ite a b bf_True"
definition "bf_minus a b = bf_ite b bf_False a"
lemma bf_minus_alt: "bf_minus a b = bf_and a (bf_not b)" unfolding bf_and_def bf_not_def bf_minus_def unfolding bf_ite_def unfolding fun_eq_iff by simp
lemma bf_imp_alt: "bf_imp a b = bf_or (bf_not a) b" unfolding bf_or_def bf_not_def bf_imp_def unfolding bf_ite_def unfolding fun_eq_iff by simp

lemma [dest!,elim!]: "bf_False = bf_True \<Longrightarrow> False" "bf_True = bf_False \<Longrightarrow> False" unfolding fun_eq_iff by simp_all (* Occurs here and there as goal for sep_auto *)

lemmas [simp] = bf_and_def bf_or_def bf_nand_def bf_biimp_def bf_xor_alt bf_nor_def bf_not_def

subsection\<open>Shannon decomposition\<close>
text\<open>
  A restriction of a boolean function on a variable is creating the boolean function that evaluates as if that variable was set to a fixed value:
\<close>
definition "bf_restrict (i::'a) (val::bool) (f::'a boolfunc) \<equiv> (\<lambda>v. f (v(i:=val)))"

text \<open>
  Restrictions are useful, because they remove variables from the set of significant variables:
\<close>
definition "bf_vars bf = {v. \<exists>as. bf_restrict v True bf as \<noteq> bf_restrict v False bf as}"
lemma "var \<notin> bf_vars (bf_restrict var val ex)"
unfolding bf_vars_def bf_restrict_def by(simp)

text\<open>
  We can decompose calculating if-then-else into computing if-then-else of two triples of functions with one variable restricted to true / false.
  Given that the functions have finite arity, we can use this to construct a recursive definition.
\<close>
lemma brace90shannon: "bf_ite F G H ass =
  bf_ite (\<lambda>l. l i)
         (bf_ite (bf_restrict i True F) (bf_restrict i True G) (bf_restrict i True H))
         (bf_ite (bf_restrict i False F) (bf_restrict i False G) (bf_restrict i False H)) ass"
unfolding bf_ite_def bf_restrict_def by (auto simp add: fun_upd_idem)

end


(*  Title:      HOL/ex/ThreeDivides.thy
    Author:     Benjamin Porter, 2005
*)

section {* Three Divides Theorem *}

theory ThreeDivides
imports Main "~~/src/HOL/Library/LaTeXsugar"
begin

subsection {* Abstract *}

text {*
The following document presents a proof of the Three Divides N theorem
formalised in the Isabelle/Isar theorem proving system.

{\em Theorem}: $3$ divides $n$ if and only if $3$ divides the sum of all
digits in $n$.

{\em Informal Proof}:
Take $n = \sum{n_j * 10^j}$ where $n_j$ is the $j$'th least
significant digit of the decimal denotation of the number n and the
sum ranges over all digits. Then $$ (n - \sum{n_j}) = \sum{n_j * (10^j
- 1)} $$ We know $\forall j\; 3|(10^j - 1) $ and hence $3|LHS$,
therefore $$\forall n\; 3|n \Longleftrightarrow 3|\sum{n_j}$$
@{text "\<box>"}
*}

subsection {* Formal proof *}

subsubsection {* Miscellaneous summation lemmas *}

text {* If $a$ divides @{text "A x"} for all x then $a$ divides any
sum over terms of the form @{text "(A x)*(P x)"} for arbitrary $P$. *}

lemma div_sum:
  fixes a::nat and n::nat
  shows "\<forall>x. a dvd A x \<Longrightarrow> a dvd (\<Sum>x<n. A x * D x)"
proof (induct n)
  case 0 show ?case by simp
next
  case (Suc n)
  from Suc
  have "a dvd (A n * D n)" by (simp add: dvd_mult2)
  with Suc
  have "a dvd ((\<Sum>x<n. A x * D x) + (A n * D n))" by (simp add: dvd_add)
  thus ?case by simp
qed

subsubsection {* Generalised Three Divides *}

text {* This section solves a generalised form of the three divides
problem. Here we show that for any sequence of numbers the theorem
holds. In the next section we specialise this theorem to apply
directly to the decimal expansion of the natural numbers. *}

text {* Here we show that the first statement in the informal proof is
true for all natural numbers. Note we are using @{term "D i"} to
denote the $i$'th element in a sequence of numbers. *}

lemma digit_diff_split:
  fixes n::nat and nd::nat and x::nat
  shows "n = (\<Sum>x\<in>{..<nd}. (D x)*((10::nat)^x)) \<Longrightarrow>
             (n - (\<Sum>x<nd. (D x))) = (\<Sum>x<nd. (D x)*(10^x - 1))"
by (simp add: sum_diff_distrib diff_mult_distrib2)

text {* Now we prove that 3 always divides numbers of the form $10^x - 1$. *}
lemma three_divs_0:
  shows "(3::nat) dvd (10^x - 1)"
proof (induct x)
  case 0 show ?case by simp
next
  case (Suc n)
  let ?thr = "(3::nat)"
  have "?thr dvd 9" by simp
  moreover
  have "?thr dvd (10*(10^n - 1))" by (rule dvd_mult) (rule Suc)
  hence "?thr dvd (10^(n+1) - 10)" by (simp add: nat_distrib)
  ultimately
  have"?thr dvd ((10^(n+1) - 10) + 9)"
    by (simp only: ac_simps) (rule dvd_add)
  thus ?case by simp
qed

text {* Expanding on the previous lemma and lemma @{text "div_sum"}. *}
lemma three_divs_1:
  fixes D :: "nat \<Rightarrow> nat"
  shows "3 dvd (\<Sum>x<nd. D x * (10^x - 1))"
  by (subst mult.commute, rule div_sum) (simp add: three_divs_0 [simplified])

text {* Using lemmas @{text "digit_diff_split"} and
@{text "three_divs_1"} we now prove the following lemma.
*}
lemma three_divs_2:
  fixes nd::nat and D::"nat\<Rightarrow>nat"
  shows "3 dvd ((\<Sum>x<nd. (D x)*(10^x)) - (\<Sum>x<nd. (D x)))"
proof -
  from three_divs_1 have "3 dvd (\<Sum>x<nd. D x * (10 ^ x - 1))" .
  thus ?thesis by (simp only: digit_diff_split)
qed

text {*
We now present the final theorem of this section. For any
sequence of numbers (defined by a function @{term "D :: (nat\<Rightarrow>nat)"}),
we show that 3 divides the expansive sum $\sum{(D\;x)*10^x}$ over $x$
if and only if 3 divides the sum of the individual numbers
$\sum{D\;x}$.
*}
lemma three_div_general:
  fixes D :: "nat \<Rightarrow> nat"
  shows "(3 dvd (\<Sum>x<nd. D x * 10^x)) = (3 dvd (\<Sum>x<nd. D x))"
proof
  have mono: "(\<Sum>x<nd. D x) \<le> (\<Sum>x<nd. D x * 10^x)"
    by (rule setsum_mono) simp
  txt {* This lets us form the term
         @{term "(\<Sum>x<nd. D x * 10^x) - (\<Sum>x<nd. D x)"} *}

  {
    assume "3 dvd (\<Sum>x<nd. D x)"
    with three_divs_2 mono
    show "3 dvd (\<Sum>x<nd. D x * 10^x)"
      by (blast intro: dvd_diffD)
  }
  {
    assume "3 dvd (\<Sum>x<nd. D x * 10^x)"
    with three_divs_2 mono
    show "3 dvd (\<Sum>x<nd. D x)"
      by (blast intro: dvd_diffD1)
  }
qed

subsubsection {* Three Divides Natural *}

text {* This section shows that for all natural numbers we can
generate a sequence of digits less than ten that represent the decimal
expansion of the number. We then use the lemma @{text
"three_div_general"} to prove our final theorem. *}

text {* \medskip Definitions of length and digit sum. *}

text {* This section introduces some functions to calculate the
required properties of natural numbers. We then proceed to prove some
properties of these functions.

The function @{text "nlen"} returns the number of digits in a natural
number n. *}

fun nlen :: "nat \<Rightarrow> nat"
where
  "nlen 0 = 0"
| "nlen x = 1 + nlen (x div 10)"

text {* The function @{text "sumdig"} returns the sum of all digits in
some number n. *}

definition
  sumdig :: "nat \<Rightarrow> nat" where
  "sumdig n = (\<Sum>x < nlen n. n div 10^x mod 10)"

text {* Some properties of these functions follow. *}

lemma nlen_zero:
  "0 = nlen x \<Longrightarrow> x = 0"
  by (induct x rule: nlen.induct) auto

lemma nlen_suc:
  "Suc m = nlen n \<Longrightarrow> m = nlen (n div 10)"
  by (induct n rule: nlen.induct) simp_all

text {* The following lemma is the principle lemma required to prove
our theorem. It states that an expansion of some natural number $n$
into a sequence of its individual digits is always possible. *}

lemma exp_exists:
  "m = (\<Sum>x<nlen m. (m div (10::nat)^x mod 10) * 10^x)"
proof (induct "nlen m" arbitrary: m)
  case 0 thus ?case by (simp add: nlen_zero)
next
  case (Suc nd)
  obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10"
    and cdef: "c = m mod 10" by simp
  show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)"
  proof -
    from `Suc nd = nlen m`
    have "nd = nlen (m div 10)" by (rule nlen_suc)
    with Suc have
      "m div 10 = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x)" by simp
    with mexp have
      "m = 10*(\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x) + c" by simp
    also have
      "\<dots> = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^(x+1)) + c"
      by (subst setsum_right_distrib) (simp add: ac_simps)
    also have
      "\<dots> = (\<Sum>x<nd. m div 10^(Suc x) mod 10 * 10^(Suc x)) + c"
      by (simp add: div_mult2_eq[symmetric])
    also have
      "\<dots> = (\<Sum>x\<in>{Suc 0..<Suc nd}. m div 10^x  mod 10 * 10^x) + c"
      by (simp only: setsum_shift_bounds_Suc_ivl)
         (simp add: atLeast0LessThan)
    also have
      "\<dots> = (\<Sum>x<Suc nd. m div 10^x mod 10 * 10^x)"
      by (simp add: atLeast0LessThan[symmetric] setsum_head_upt_Suc cdef)
    also note `Suc nd = nlen m`
    finally
    show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)" .
  qed
qed

text {* \medskip Final theorem. *}

text {* We now combine the general theorem @{text "three_div_general"}
and existence result of @{text "exp_exists"} to prove our final
theorem. *}

theorem three_divides_nat:
  shows "(3 dvd n) = (3 dvd sumdig n)"
proof (unfold sumdig_def)
  have "n = (\<Sum>x<nlen n. (n div (10::nat)^x mod 10) * 10^x)"
    by (rule exp_exists)
  moreover
  have "3 dvd (\<Sum>x<nlen n. (n div (10::nat)^x mod 10) * 10^x) =
        (3 dvd (\<Sum>x<nlen n. n div 10^x mod 10))"
    by (rule three_div_general)
  ultimately
  show "3 dvd n = (3 dvd (\<Sum>x<nlen n. n div 10^x mod 10))" by simp
qed

end


theory P15 imports Main begin

lemma "(\<exists> x. \<forall> y. P x y) \<longrightarrow>  (\<forall> y. \<exists> x. P x y)"
  apply (rule impI)
  apply (erule exE)
  apply (rule allI)
  apply (erule allE)
  apply (rule exI)
  apply assumption
  done

lemma "(\<forall> x. P x \<longrightarrow> Q) = ((\<exists> x. P x) \<longrightarrow> Q)"
  apply (rule iffI)

   apply (rule impI)
   apply (erule exE)
   apply (erule allE)
   apply (erule impE)
  apply assumption+

  apply (rule allI)
  apply (rule impI)
  apply (erule impE)
  apply (rule exI)
   apply assumption+
  done

lemma "((\<forall> x. P x) \<and> (\<forall> x. Q x)) = (\<forall> x. (P x \<and> Q x))"
  apply (rule iffI)

   apply (erule conjE)
   apply (rule allI)
   apply (rule conjI)
    apply (erule allE)
    apply assumption
   apply (erule allE)+
   apply assumption

  apply (rule conjI)
   apply (rule allI)
   apply (erule allE)
   apply (erule conjE)
   apply assumption
   apply (rule allI)
   apply (erule allE)
   apply (erule conjE)
   apply assumption
  done

lemma "((\<forall> x. P x) \<or> (\<forall> x. Q x)) = (\<forall> x. (P x \<or> Q x))"
  nitpick
  oops

lemma "((\<exists> x. P x) \<or> (\<exists> x. Q x)) = (\<exists> x. (P x \<or> Q x))"
  apply (rule iffI)

   apply (erule disjE)
    apply (erule exE)
    apply (rule exI)
    apply (rule disjI1)
    apply assumption
   apply (erule exE)
   apply (rule exI)
   apply (rule disjI2)
   apply assumption

  apply (erule exE)
  apply (erule disjE)
   apply (rule disjI1)
   apply (rule exI)
   apply assumption

  apply (rule disjI2)
   apply (rule exI)
  apply assumption
  done

lemma "(\<forall> x. \<exists> y. P x y) \<longrightarrow> (\<exists> y. \<forall> x. P x y)"
  nitpick
  oops

lemma "(\<not> (\<forall> x. P x)) = (\<exists> x. \<not> P x)"
  apply (rule iffI)
  apply (rule classical)
   apply (erule notE)
   apply (rule allI)
   apply (rule classical)
   apply (erule notE)
   apply (rule exI)
   apply assumption

  apply (erule exE)
  apply (rule notI)
  apply (erule notE)
  apply (erule allE)
  apply assumption
  done

end


theory Inductiv
  imports Main
begin

inductive ev :: "nat \<Rightarrow> bool" where
ev0:  "ev 0" |
evSS: "ev n \<Longrightarrow> ev (Suc (Suc n))"

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc (Suc n)) = evn n"

lemma "ev (Suc (Suc (Suc (Suc 0))))"
  apply(rule evSS)
  apply(rule evSS)
  apply(rule ev0)
  done

lemma "ev m \<Longrightarrow> evn m"
  apply(induction rule: ev.induct)
   apply(simp_all)
  done

lemma "evn n \<Longrightarrow> ev n"
  apply(induction n rule: evn.induct)
    apply(simp_all add: ev0 evSS)
  done

inductive star :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" for r where
refl:   "star r x x" |
step:   "r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"

lemma star_trans: "star r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"
  apply(induction rule:star.induct)
   apply(assumption)
  by (simp add: star.step)

end


(*  Title:       The Cauchy-Schwarz Inequality
    Author:      Benjamin Porter <Benjamin.Porter at gmail.com>, 2006
    Maintainer:  Benjamin Porter <Benjamin.Porter at gmail.com>
*)

header {* The Cauchy-Schwarz Inequality *}

theory CauchySchwarz
imports Complex_Main
begin

(*<*)

(* Some basic results that don't need to be in the final doc ..*)

lemmas real_sq = power2_eq_square [where 'a = real, symmetric]

lemmas real_sq_exp = power_mult_distrib [where 'a = real and ?n = 2]

lemma double_sum_equiv:
  fixes f::"nat \<Rightarrow> real"
  shows
  "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
   (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f j * g k))"
  by (rule setsum.commute)

(*>*)

section {* Abstract *}

text {* The following document presents a formalised proof of the
Cauchy-Schwarz Inequality for the specific case of $R^n$. The system
used is Isabelle/Isar.

{\em Theorem:} Take $V$ to be some vector space possessing a norm and
inner product, then for all $a,b \in V$ the following inequality
holds: @{text "\<bar>a\<cdot>b\<bar> \<le> \<parallel>a\<parallel>*\<parallel>b\<parallel>"}. Specifically, in the Real case, the
norm is the Euclidean length and the inner product is the standard dot
product. *}

section {* Formal Proof *}

subsection {* Vector, Dot and Norm definitions. *}

text {* This section presents definitions for a real vector type, a
dot product function and a norm function. *}

subsubsection {* Vector *}

text {* We now define a vector type to be a tuple of (function,
length). Where the function is of type @{typ "nat\<Rightarrow>real"}. We also
define some accessor functions and appropriate notation. *}

type_synonym vector = "(nat\<Rightarrow>real) * nat";

definition
  ith :: "vector \<Rightarrow> nat \<Rightarrow> real" ("((_)\<^bsub>_\<^esub>)" [80,100] 100) where
  "ith v i = fst v i"

definition
  vlen :: "vector \<Rightarrow> nat" where
  "vlen v = snd v"

text {* Now to access the second element of some vector $v$ the syntax
is $v_2$. *}

subsubsection {* Dot and Norm *}

text {* We now define the dot product and norm operations. *}

definition
  dot :: "vector \<Rightarrow> vector \<Rightarrow> real" (infixr "\<cdot>" 60) where
  "dot a b = (\<Sum>j\<in>{1..(vlen a)}. a\<^bsub>j\<^esub>*b\<^bsub>j\<^esub>)"

definition
  norm :: "vector \<Rightarrow> real"                  ("\<parallel>_\<parallel>" 100) where
  "norm v = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2)"

notation (HTML output)
  "norm"  ("||_||" 100)

text {* Another definition of the norm is @{term "\<parallel>v\<parallel> = sqrt
(v\<cdot>v)"}. We show that our definition leads to this one. *}

lemma norm_dot:
 "\<parallel>v\<parallel> = sqrt (v\<cdot>v)"
proof -
  have "sqrt (v\<cdot>v) = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>*v\<^bsub>j\<^esub>)" unfolding dot_def by simp
  also with real_sq have "\<dots> = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2)" by simp
  also have "\<dots> = \<parallel>v\<parallel>" unfolding norm_def by simp
  finally show ?thesis ..
qed

text {* A further important property is that the norm is never negative. *}

lemma norm_pos:
  "\<parallel>v\<parallel> \<ge> 0"
proof -
  have "\<forall>j. v\<^bsub>j\<^esub>^2 \<ge> 0" unfolding ith_def by auto
  hence "\<forall>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2 \<ge> 0" by simp
  with setsum_nonneg have "(\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2) \<ge> 0" .
  with real_sqrt_ge_zero have "sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2) \<ge> 0" .
  thus ?thesis unfolding norm_def .
qed

text {* We now prove an intermediary lemma regarding double summation. *}

lemma double_sum_aux:
  fixes f::"nat \<Rightarrow> real"
  shows
  "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
   (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k) / 2))"
proof -
  have
    "2 * (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) +
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j))"
    by simp
  also have
    "\<dots> =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) +
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f j * g k))"
    by (simp only: double_sum_equiv)
  also have
    "\<dots> =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j + f j * g k))"
    by (auto simp add: setsum.distrib)
  finally have
    "2 * (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j + f j * g k))" .
  hence
    "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
     (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k)))*(1/2)"
    by auto
  also have
    "\<dots> =
     (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k)*(1/2)))"
    by (simp add: setsum_right_distrib mult.commute)
  finally show ?thesis by (auto simp add: inverse_eq_divide)
qed

text {* The final theorem can now be proven. It is a simple forward
proof that uses properties of double summation and the preceding
lemma.  *}

theorem CauchySchwarzReal:
  fixes x::vector
  assumes "vlen x = vlen y"
  shows "\<bar>x\<cdot>y\<bar> \<le> \<parallel>x\<parallel>*\<parallel>y\<parallel>"
proof -
  have "\<bar>x\<cdot>y\<bar>^2 \<le> (\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2"
  proof -
    txt {* We can rewrite the goal in the following form ...*}
    have "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 \<ge> 0"
    proof -
      obtain n where nx: "n = vlen x" by simp
      with `vlen x = vlen y` have ny: "n = vlen y" by simp
      {
        txt {* Some preliminary simplification rules. *}
        have "\<forall>j\<in>{1..n}. x\<^bsub>j\<^esub>^2 \<ge> 0" by simp
        hence "(\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2) \<ge> 0" by (rule setsum_nonneg)
        hence xp: "(sqrt (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2))^2 = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2)"
          by (rule real_sqrt_pow2)

        have "\<forall>j\<in>{1..n}. y\<^bsub>j\<^esub>^2 \<ge> 0" by simp
        hence "(\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2) \<ge> 0" by (rule setsum_nonneg)
        hence yp: "(sqrt (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2))^2 = (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2)"
          by (rule real_sqrt_pow2)

        txt {* The main result of this section is that @{text
        "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2"} can be written as a double sum. *}
        have
          "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 = \<parallel>x\<parallel>^2 * \<parallel>y\<parallel>^2"
          by (simp add: real_sq_exp)
        also from nx ny have
          "\<dots> = (sqrt (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2))^2 * (sqrt (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2))^2"
          unfolding norm_def by auto
        also from xp yp have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2)*(\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2)"
          by simp
        also from setsum_product have
          "\<dots> = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2)))" .
        finally have
          "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2)))" .
      }
      moreover
      {
        txt {* We also show that @{text "\<bar>x\<cdot>y\<bar>^2"} can be expressed as a double sum.*}
        have
          "\<bar>x\<cdot>y\<bar>^2 = (x\<cdot>y)^2"
          by simp
        also from nx have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)^2"
          unfolding dot_def by simp
        also from real_sq have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)*(\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)"
          by simp
        also from setsum_product have
          "\<dots> = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))" .
        finally have
          "\<bar>x\<cdot>y\<bar>^2 = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))" .
      }
      txt {* We now manipulate the double sum expressions to get the
      required inequality. *}
      ultimately have
        "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 =
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2))) -
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by simp
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. ((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))/2)) -
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by (simp only: double_sum_aux)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. ((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))/2 - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by (auto simp add: setsum_subtractf)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*2*
         (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*(1/2) - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>))))"
        by auto
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*(2*
        (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*(1/2) - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (simp only: mult.assoc)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*
        ((((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*2*(inverse 2) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (auto simp add: distrib_right mult.assoc ac_simps)
      also have
        "\<dots> =
        (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*
        ((((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2)) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (simp only: mult.assoc, simp)
      also have
        "\<dots> =
         (inverse 2)*(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}.
         (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2)) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>))))"
        by (simp only: setsum_right_distrib)
      also have
        "\<dots> =
         (inverse 2)*(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2))"
        by (simp only: power2_diff real_sq_exp, auto simp add: ac_simps)
      also have "\<dots> \<ge> 0"
      proof -
        {
          fix k::nat
          have "\<forall>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2 \<ge> 0" by simp
          hence "(\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2) \<ge> 0" by (rule setsum_nonneg)
        }
        hence "\<forall>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2) \<ge> 0" by simp
        hence "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2)) \<ge> 0"
          by (rule setsum_nonneg)
        thus ?thesis by simp
      qed
      finally show "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 \<ge> 0" .
    qed
    thus ?thesis by simp
  qed
  moreover have "0 \<le> \<parallel>x\<parallel>*\<parallel>y\<parallel>"
    by (auto simp add: norm_pos)
  ultimately show ?thesis by (rule power2_le_imp_le)
qed

end


(* Title:      Kleene Algebra
   Author:     Alasdair Armstrong, Georg Struth, Tjark Weber
   Maintainer: Georg Struth <g.struth at sheffield.ac.uk>
               Tjark Weber <tjark.weber at it.uu.se>
*)

header {* Omega Algebras *}

theory Omega_Algebra
imports Kleene_Algebra
begin

text {*
\emph{Omega algebras}~\cite{cohen00omega} extend Kleene algebras by an
$\omega$-operation that axiomatizes infinite iteration (just like the
Kleene star axiomatizes finite iteration).
*}

subsection {* Left Omega Algebras *}

text {*
In this section we consider \emph{left omega algebras}, i.e., omega
algebras based on left Kleene algebras. Surprisingly, we are still
looking for statements mentioning~$\omega$ that are true in omega
algebras, but do not already hold in left omega algebras.
*}

class left_omega_algebra = left_kleene_algebra_zero + omega_op +
  assumes omega_unfold: "x\<^sup>\<omega> \<le> x \<cdot> x\<^sup>\<omega>"
  and omega_coinduct: "y \<le> z + x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
begin

text {* First we prove some variants of the coinduction axiom. *}

lemma omega_coinduct_var1: "y \<le> 1 + x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega> + x\<^sup>\<star>"
  by (metis mult_oner omega_coinduct)

lemma  omega_coinduct_var2: "y \<le> x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega>"
  by (metis add.commute add_zero_l annir omega_coinduct)

lemma omega_coinduct_eq: "y = z + x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
  by (metis eq_refl omega_coinduct)

lemma omega_coinduct_eq_var1: "y = 1 + x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega> + x\<^sup>\<star>"
  by (metis eq_refl omega_coinduct_var1)

lemma  omega_coinduct_eq_var2: "y = x \<cdot> y \<longrightarrow> y \<le> x\<^sup>\<omega>"
  by (metis eq_refl omega_coinduct_var2)

lemma "y = x \<cdot> y + z \<longrightarrow> y = x\<^sup>\<star> \<cdot> z + x\<^sup>\<omega>"
  nitpick [expect=genuine] -- "2-element counterexample"
oops

lemma "y = 1 + x \<cdot> y \<longrightarrow> y = x\<^sup>\<omega> + x\<^sup>\<star>"
  nitpick [expect=genuine] -- "3-element counterexample"
oops

lemma "y = x \<cdot> y \<longrightarrow> y = x\<^sup>\<omega>"
  nitpick [expect=genuine] -- "2-element counterexample"
oops

text {* Next we strengthen the unfold law to an equation. *}

lemma omega_unfold_eq [simp]: "x \<cdot> x\<^sup>\<omega> = x\<^sup>\<omega>"
proof (rule antisym)
  have "x \<cdot> x\<^sup>\<omega> \<le> x \<cdot> x \<cdot> x\<^sup>\<omega>"
    by (metis mult.assoc mult_isol omega_unfold)
  thus "x \<cdot> x\<^sup>\<omega> \<le> x\<^sup>\<omega>"
    by (metis mult.assoc omega_coinduct_var2)
  show  "x\<^sup>\<omega> \<le> x \<cdot> x\<^sup>\<omega>"
    by (fact omega_unfold)
qed

lemma omega_unfold_var: "z + x \<cdot> x\<^sup>\<omega> \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
  by (metis add_lub add_ub1 omega_coinduct omega_unfold_eq)

lemma "z + x \<cdot> x\<^sup>\<omega> = x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
  nitpick [expect=genuine] -- "4-element counterexample"
oops

text {* We now prove subdistributivity and isotonicity of omega. *}

lemma omega_subdist: "x\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
proof -
  have "x\<^sup>\<omega> \<le> (x + y) \<cdot> x\<^sup>\<omega>"
    by (metis add_ub1 mult_isor omega_unfold_eq)
  thus ?thesis
    by (metis omega_coinduct_var2)
qed

lemma omega_iso: "x \<le> y \<longrightarrow> x\<^sup>\<omega> \<le> y\<^sup>\<omega>"
  by (metis less_eq_def omega_subdist)

lemma omega_subdist_var: "x\<^sup>\<omega> + y\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
  by (metis add.commute add_lub omega_subdist)

lemma zero_omega [simp]: "0\<^sup>\<omega> = 0"
  by (metis annil omega_unfold_eq)

text {* The next lemma is another variant of omega unfold *}

lemma star_omega_1 [simp]: "x\<^sup>\<star> \<cdot> x\<^sup>\<omega> = x\<^sup>\<omega>"
proof (rule antisym)
  have "x \<cdot> x\<^sup>\<omega> \<le> x\<^sup>\<omega>"
    by (metis eq_refl omega_unfold_eq)
  thus "x\<^sup>\<star> \<cdot> x\<^sup>\<omega> \<le> x\<^sup>\<omega>"
    by (metis star_inductl_var)
  show "x\<^sup>\<omega> \<le> x\<^sup>\<star> \<cdot> x\<^sup>\<omega>"
    by (metis star_ref mult_isor mult_onel)
qed

text {* The next lemma says that~@{term "1\<^sup>\<omega>"} is the maximal element
of omega algebra. We therefore baptise it~$\top$. *}

lemma max_element: "x \<le> 1\<^sup>\<omega>"
  by (metis eq_refl mult_onel omega_coinduct_var2)

definition top ("\<top>")
  where "\<top> = 1\<^sup>\<omega>"

lemma star_omega_3 [simp]: "(x\<^sup>\<star>)\<^sup>\<omega> = \<top>"
proof -
  have "1 \<le> x\<^sup>\<star>"
    by (fact star_ref)
  hence "\<top> \<le> (x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis omega_iso top_def)
  thus ?thesis
    by (metis eq_iff max_element top_def)
qed

text {* The following lemma is strange since it is counterintuitive
that one should be able to append something after an infinite
iteration. *}

lemma omega_1: "x\<^sup>\<omega> \<cdot> y \<le> x\<^sup>\<omega>"
proof -
  have "x\<^sup>\<omega> \<cdot> y \<le> x \<cdot> x\<^sup>\<omega> \<cdot> y"
    by (metis eq_refl omega_unfold_eq)
  thus ?thesis
    by (metis mult.assoc omega_coinduct_var2)
qed

lemma "x\<^sup>\<omega> \<cdot> y = x\<^sup>\<omega>"
  nitpick [expect=genuine] -- "2-element counterexample"
oops

lemma omega_sup_id: "1 \<le> y \<longrightarrow> x\<^sup>\<omega> \<cdot> y = x\<^sup>\<omega>"
  by (metis eq_iff mult_isol mult_oner omega_1)

lemma omega_top [simp]: "x\<^sup>\<omega> \<cdot> \<top> = x\<^sup>\<omega>"
  by (metis max_element omega_sup_id top_def)

lemma supid_omega: "1 \<le> x \<longrightarrow> x\<^sup>\<omega> = \<top>"
  by (metis eq_iff max_element omega_iso top_def)

lemma "x\<^sup>\<omega> = \<top> \<longrightarrow> 1 \<le> x"
  nitpick [expect=genuine] -- "4-element counterexample"
oops

text {* Next we prove a simulation law for the omega operation *}

lemma omega_simulation: "z \<cdot> x \<le> y \<cdot> z \<longrightarrow> z \<cdot> x\<^sup>\<omega> \<le> y\<^sup>\<omega>"
proof
  assume "z \<cdot> x \<le> y \<cdot> z"
  also have "z \<cdot> x\<^sup>\<omega> = z \<cdot> x \<cdot> x\<^sup>\<omega>"
    by (metis mult.assoc omega_unfold_eq)
  moreover have "... \<le> y \<cdot> z \<cdot> x\<^sup>\<omega>"
    by (metis mult_isor calculation)
  thus "z \<cdot> x\<^sup>\<omega> \<le> y\<^sup>\<omega>"
    by (metis calculation mult.assoc omega_coinduct_var2)
qed

lemma "z \<cdot> x \<le> y \<cdot> z \<longrightarrow> z \<cdot> x\<^sup>\<omega> \<le> y\<^sup>\<omega> \<cdot> z"
  nitpick [expect=genuine] -- "4-element counterexample"
oops

lemma "y \<cdot> z  \<le> z \<cdot> x \<longrightarrow> y\<^sup>\<omega> \<le> z \<cdot> x\<^sup>\<omega>"
  nitpick [expect=genuine] -- "2-element counterexample"
oops

lemma "y \<cdot> z  \<le> z \<cdot> x \<longrightarrow> y\<^sup>\<omega> \<cdot> z \<le> x\<^sup>\<omega>"
  nitpick [expect=genuine] -- "4-element counterexample"
oops

text {* Next we prove transitivity of omega elements. *}

lemma omega_trans: "x\<^sup>\<omega> \<cdot> x\<^sup>\<omega> \<le> x\<^sup>\<omega>"
  by (fact omega_1)

lemma omega_omega: "(x\<^sup>\<omega>)\<^sup>\<omega> \<le> x\<^sup>\<omega>"
  by (metis omega_1 omega_unfold_eq)

(*
lemma "x\<^sup>\<omega> \<cdot> x\<^sup>\<omega> = x\<^sup>\<omega>"
nitpick -- "no proof, no counterexample"

lemma "(x\<^sup>\<omega>)\<^sup>\<omega> = x\<^sup>\<omega>"
nitpick -- "no proof, no counterexample"
*)

text {* The next lemmas are axioms of Wagner's complete axiomatisation
for omega-regular languages~\cite{Wagner77omega}, but in a slightly
different setting.  *}

lemma wagner_1 [simp]: "(x \<cdot> x\<^sup>\<star>)\<^sup>\<omega> = x\<^sup>\<omega>"
proof (rule antisym)
  have "(x \<cdot> x\<^sup>\<star>)\<^sup>\<omega> = x \<cdot> x\<^sup>\<star> \<cdot> x \<cdot> x\<^sup>\<star> \<cdot> (x \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis mult.assoc omega_unfold_eq)
  also have "... = x \<cdot> x \<cdot> x\<^sup>\<star> \<cdot> x\<^sup>\<star> \<cdot> (x \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis mult.assoc star_slide_var)
  also have "... = x \<cdot> x \<cdot> x\<^sup>\<star> \<cdot> (x \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis mult.assoc star_trans_eq)
  also have "... = x \<cdot> (x \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis mult.assoc omega_unfold_eq)
  thus "(x \<cdot> x\<^sup>\<star>)\<^sup>\<omega> \<le> x\<^sup>\<omega>"
    by (metis calculation eq_refl omega_coinduct_var2)
   show "x\<^sup>\<omega> \<le> (x \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis mult_isol mult_oner omega_iso star_ref)
qed

lemma wagner_2_var: "x \<cdot> (y \<cdot> x)\<^sup>\<omega> \<le> (x \<cdot> y)\<^sup>\<omega>"
proof -
  have "x \<cdot> y \<cdot> x \<le> x \<cdot> y \<cdot> x"
    by auto
  thus "x \<cdot> (y \<cdot> x)\<^sup>\<omega> \<le> (x \<cdot> y)\<^sup>\<omega>"
    by (metis mult.assoc omega_simulation)
qed

lemma wagner_2 [simp]: "x \<cdot> (y \<cdot> x)\<^sup>\<omega> = (x \<cdot> y)\<^sup>\<omega>"
proof (rule antisym)
  show "x \<cdot> (y \<cdot> x)\<^sup>\<omega> \<le> (x \<cdot> y)\<^sup>\<omega>"
    by (rule wagner_2_var)
  have "(x \<cdot> y)\<^sup>\<omega> = x \<cdot> y \<cdot> (x \<cdot> y)\<^sup>\<omega>"
    by (metis omega_unfold_eq)
  thus "(x \<cdot> y)\<^sup>\<omega> \<le> x \<cdot> (y \<cdot> x)\<^sup>\<omega>"
    by (metis mult.assoc mult_isol wagner_2_var)
qed

text {*
This identity is called~(A8) in Wagner's paper.
*}

lemma wagner_3:
assumes "x \<cdot> (x + y)\<^sup>\<omega> + z = (x + y)\<^sup>\<omega>"
shows "(x + y)\<^sup>\<omega> = x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
proof (rule antisym)
  show  "(x + y)\<^sup>\<omega> \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
    by (metis add.commute assms omega_coinduct_eq)
  have "x\<^sup>\<star> \<cdot> z \<le> (x + y)\<^sup>\<omega>"
    by (metis add.commute assms star_inductl_eq)
  thus "x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z \<le> (x + y)\<^sup>\<omega>"
    by (metis add_lub omega_subdist)
qed

text {*
This identity is called~(R4) in Wagner's paper.
*}

lemma wagner_1_var [simp]: "(x\<^sup>\<star> \<cdot> x)\<^sup>\<omega> = x\<^sup>\<omega>"
  by (metis star_slide_var wagner_1)

lemma star_omega_4 [simp]: "(x\<^sup>\<omega>)\<^sup>\<star> = 1 + x\<^sup>\<omega>"
proof (rule antisym)
  have "(x\<^sup>\<omega>)\<^sup>\<star> = 1 + x\<^sup>\<omega> \<cdot> (x\<^sup>\<omega>)\<^sup>\<star>"
    by simp
  also have "... \<le> 1 + x\<^sup>\<omega> \<cdot> \<top>"
    by (metis add_iso_var eq_refl omega_1 omega_top)
  thus "(x\<^sup>\<omega>)\<^sup>\<star> \<le> 1 + x\<^sup>\<omega>"
    by (metis calculation omega_top)
  show "1 + x\<^sup>\<omega> \<le> (x\<^sup>\<omega>)\<^sup>\<star>"
    by (metis star2 star_ext)
qed

lemma star_omega_5 [simp]: "x\<^sup>\<omega> \<cdot> (x\<^sup>\<omega>)\<^sup>\<star> = x\<^sup>\<omega>"
proof (rule antisym)
  show "x\<^sup>\<omega> \<cdot> (x\<^sup>\<omega>)\<^sup>\<star> \<le> x\<^sup>\<omega>"
    by (rule omega_1)
  show "x\<^sup>\<omega> \<le> x\<^sup>\<omega> \<cdot> (x\<^sup>\<omega>)\<^sup>\<star>"
    by (metis mult_oner star_ref mult_isol)
qed

text {* The next law shows how omegas below a sum can be unfolded. *}

lemma omega_sum_unfold: "x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> y \<cdot> (x + y)\<^sup>\<omega> = (x + y)\<^sup>\<omega>"
proof -
  have "(x + y)\<^sup>\<omega> = x \<cdot> (x + y)\<^sup>\<omega> + y \<cdot> (x+y)\<^sup>\<omega>"
    by (metis distrib_right omega_unfold_eq)
  thus ?thesis
    by (metis mult.assoc wagner_3)
qed

text {*
The next two lemmas apply induction and coinduction to this law.
*}

lemma omega_sum_unfold_coind: "(x + y)\<^sup>\<omega> \<le> (x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> + (x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega>"
  by (metis omega_coinduct_eq omega_sum_unfold)

lemma omega_sum_unfold_ind: "(x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
  by (metis omega_sum_unfold star_inductl_eq)

lemma wagner_1_gen: "(x \<cdot> y\<^sup>\<star>)\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
proof -
  have "(x \<cdot> y\<^sup>\<star>)\<^sup>\<omega> \<le> ((x + y) \<cdot> (x + y)\<^sup>\<star>)\<^sup>\<omega>"
    by (metis add_ub1 add_ub2 mult_isol_var omega_iso star_iso)
  thus ?thesis
    by (metis wagner_1)
qed

lemma wagner_1_var_gen: "(x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
proof -
  have "(x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> = x\<^sup>\<star> \<cdot> (y \<cdot> x\<^sup>\<star>)\<^sup>\<omega>"
    by (metis wagner_2)
  also have "... \<le> x\<^sup>\<star> \<cdot> (x + y)\<^sup>\<omega>"
    by (metis add.commute mult_isol wagner_1_gen)
  also have "... \<le> (x + y)\<^sup>\<star> \<cdot> (x + y)\<^sup>\<omega>"
    by (metis add_ub1 mult_isor star_iso)
  thus ?thesis
    by (metis calculation order_trans star_omega_1)
qed

text {* The next lemma is a variant of the denest law for the star at
the level of omega. *}

lemma omega_denest [simp]: "(x + y)\<^sup>\<omega> = (x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> + (x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega>"
proof (rule antisym)
  show "(x + y)\<^sup>\<omega> \<le> (x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> + (x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega>"
    by (rule omega_sum_unfold_coind)
  have "(x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> \<le>  (x + y)\<^sup>\<omega>"
    by (rule wagner_1_var_gen)
  hence "(x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
    by (metis omega_sum_unfold_ind)
  thus "(x\<^sup>\<star> \<cdot> y)\<^sup>\<omega> + (x\<^sup>\<star> \<cdot> y)\<^sup>\<star> \<cdot> x\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
    by (metis add_lub wagner_1_var_gen)
qed

text {* The next lemma yields a separation theorem for infinite
iteration in the presence of a quasicommutation property. A
nondeterministic loop over~@{term x} and~@{term y} can be refined into
separate infinite loops over~@{term x} and~@{term y}.  *}

lemma omega_sum_refine:
  assumes "y \<cdot> x \<le> x \<cdot> (x + y)\<^sup>\<star>"
  shows "(x + y)\<^sup>\<omega> = x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> y\<^sup>\<omega>"
proof (rule antisym)
  have "y\<^sup>\<star> \<cdot> x \<le> x \<cdot> (x + y)\<^sup>\<star>"
    by (metis assms quasicomm_var)
  also have "(x + y)\<^sup>\<omega> = y\<^sup>\<omega> + y\<^sup>\<star> \<cdot> x \<cdot> (x + y)\<^sup>\<omega>"
    by (metis add.commute omega_sum_unfold)
  moreover have "... \<le> x \<cdot> (x + y)\<^sup>\<star> \<cdot> (x + y)\<^sup>\<omega> + y\<^sup>\<omega>"
    by (metis add_iso add_lub add_ub2 calculation(1) mult_isor)
  moreover have "... \<le> x \<cdot> (x + y)\<^sup>\<omega> + y\<^sup>\<omega>"
    by (metis mult.assoc order_refl star_omega_1)
  thus "(x + y)\<^sup>\<omega> \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> y\<^sup>\<omega>"
    by (metis add.commute calculation mult.assoc omega_coinduct star_omega_1)
  have "x\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
    by (rule omega_subdist)
  moreover have "x\<^sup>\<star> \<cdot> y\<^sup>\<omega> \<le> x\<^sup>\<star> \<cdot> (x + y)\<^sup>\<omega>"
    by (metis calculation add_ub1 mult_isol)
  moreover have"... \<le> (x + y)\<^sup>\<star> \<cdot> (x + y)\<^sup>\<omega>"
    by (metis add_ub1 star_iso mult_isor)
  moreover have "... = (x + y)\<^sup>\<omega>"
     by (rule star_omega_1)
   thus "x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> y\<^sup>\<omega> \<le> (x + y)\<^sup>\<omega>"
     by (metis add.commute add_lub calculation mult_isol omega_subdist order_trans star_omega_1)
qed

text {* The following theorem by Bachmair and
Dershowitz~\cite{bachmair86commutation} is a corollary. *}

lemma bachmair_dershowitz:
  assumes "y \<cdot> x \<le> x \<cdot> (x + y)\<^sup>\<star>"
  shows "(x + y)\<^sup>\<omega> = 0 \<longleftrightarrow> x\<^sup>\<omega> + y\<^sup>\<omega> = 0"
proof
  assume "(x + y)\<^sup>\<omega> = 0"
  show "x\<^sup>\<omega> + y\<^sup>\<omega> = 0"
    by (metis `(x + y)\<^sup>\<omega> = (0\<Colon>'a)` add.commute add_zero_r annir omega_sum_unfold)
next
  assume "x\<^sup>\<omega> + y\<^sup>\<omega> = 0"
  show "(x + y)\<^sup>\<omega> = 0"
    by (metis `x\<^sup>\<omega> + y\<^sup>\<omega> = (0\<Colon>'a)` assms no_trivial_inverse omega_sum_refine distrib_left star_omega_1)
qed

text {*
The next lemmas consider an abstract variant of the empty word
property from language theory and match it with the absence of
infinite iteration~\cite{struth12regeq}.
*}

definition (in dioid_one_zero) ewp
where "ewp x \<equiv> \<not>(\<forall>y. y \<le> x \<cdot> y \<longrightarrow> y = 0)"

lemma ewp_super_id1: "0 \<noteq> 1 \<longrightarrow> 1 \<le> x \<longrightarrow> ewp x"
  by (metis ewp_def mult_oner)

lemma "0 \<noteq> 1 \<longrightarrow> 1 \<le> x \<longleftrightarrow> ewp x"
  nitpick [expect=genuine] -- "3-element counterexample"
oops

text {* The next facts relate the absence of the empty word property
with the absence of infinite iteration. *}

lemma ewp_neg_and_omega: "\<not> ewp x \<longleftrightarrow> x\<^sup>\<omega> = 0"
proof
  assume "\<not> ewp x"
  hence "\<forall> y. y \<le> x \<cdot> y \<longrightarrow> y = 0"
    by (metis ewp_def)
  thus "x\<^sup>\<omega> = 0"
    by (metis omega_unfold)
next
  assume "x\<^sup>\<omega> = 0"
  hence "\<forall> y. y \<le> x \<cdot> y \<longrightarrow> y = 0"
    by (metis omega_coinduct_var2 zero_unique)
  thus "\<not> ewp x"
    by (metis ewp_def)
qed

lemma ewp_alt1: "(\<forall>z. x\<^sup>\<omega> \<le> x\<^sup>\<star> \<cdot> z) \<longleftrightarrow> (\<forall>y z. y \<le> x \<cdot> y + z \<longrightarrow> y \<le> x\<^sup>\<star> \<cdot> z)"
  by (metis add_comm less_eq_def omega_coinduct omega_unfold_eq order_prop)

lemma ewp_alt: "x\<^sup>\<omega> = 0 \<longleftrightarrow> (\<forall>y z. y \<le> x \<cdot> y + z \<longrightarrow> y \<le> x\<^sup>\<star> \<cdot> z)"
  by (metis annir antisym ewp_alt1 zero_least)

text {* So we have obtained a condition for Arden's lemma in omega
algebra.  *}

lemma omega_super_id1: "0 \<noteq> 1 \<longrightarrow> 1 \<le> x \<longrightarrow> x\<^sup>\<omega> \<noteq> 0"
  by (metis eq_iff max_element omega_iso zero_least)

lemma omega_super_id2: "0 \<noteq> 1 \<longrightarrow> x\<^sup>\<omega> = 0 \<longrightarrow> \<not>(1 \<le> x)"
  by (metis omega_super_id1)

text {* The next lemmas are abstract versions of Arden's lemma from
language theory.  *}

lemma ardens_lemma_var:
  assumes "x\<^sup>\<omega> = 0" and  "z + x \<cdot> y = y"
  shows "x\<^sup>\<star> \<cdot> z = y"
proof -
  have "y \<le> x\<^sup>\<omega> + x\<^sup>\<star> \<cdot> z"
    by (metis assms omega_coinduct order_refl)
  hence "y \<le> x\<^sup>\<star> \<cdot> z"
    by (metis add_zero_l assms)
  thus "x\<^sup>\<star> \<cdot> z = y"
    by (metis assms eq_iff star_inductl_eq)
qed

lemma ardens_lemma: "\<not> ewp x \<longrightarrow> z + x \<cdot> y = y \<longrightarrow> x\<^sup>\<star> \<cdot> z = y"
  by (metis ardens_lemma_var ewp_neg_and_omega)

lemma ardens_lemma_equiv:
  assumes "\<not> ewp x"
  shows "z + x \<cdot> y = y \<longleftrightarrow> x\<^sup>\<star> \<cdot> z = y"
proof
  assume "z + x \<cdot> y = y"
  thus "x\<^sup>\<star> \<cdot> z = y"
    by (metis ardens_lemma assms)
next
  assume "x\<^sup>\<star> \<cdot> z = y"
  also have "z + x \<cdot> y = z + x \<cdot> x\<^sup>\<star> \<cdot> z"
    by (metis calculation mult.assoc)
  moreover have "... = (1 + x \<cdot> x\<^sup>\<star>) \<cdot> z"
    by (metis distrib_right mult_onel)
  moreover have "... = x\<^sup>\<star> \<cdot> z"
    by (metis star_unfoldl_eq)
  thus "z + x \<cdot> y = y"
    by (metis calculation)
qed

lemma ardens_lemma_var_equiv: "x\<^sup>\<omega> = 0 \<longrightarrow> (z + x \<cdot> y = y \<longleftrightarrow> x\<^sup>\<star> \<cdot> z = y)"
  by (metis ardens_lemma_equiv ewp_neg_and_omega)

lemma arden_conv1: "(\<forall>y z. z + x \<cdot> y = y \<longrightarrow> x\<^sup>\<star> \<cdot> z = y) \<longrightarrow> \<not> ewp x"
  by (metis add_zero_l annir ewp_neg_and_omega omega_unfold_eq)

lemma arden_conv2: "(\<forall>y z. z + x \<cdot> y = y \<longrightarrow> x\<^sup>\<star> \<cdot> z = y) \<longrightarrow> x\<^sup>\<omega> = 0"
  by (metis arden_conv1 ewp_neg_and_omega)

lemma arden_var3: "(\<forall>y z. z + x \<cdot> y = y \<longrightarrow> x\<^sup>\<star> \<cdot> z = y) \<longleftrightarrow> x\<^sup>\<omega> = 0"
  by (metis arden_conv2 ardens_lemma_var)

end

subsection {* Omega Algebras *}

class omega_algebra = kleene_algebra + left_omega_algebra

end


(*
Authors:

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

theory No_Cloning
imports
  Quantum
  Tensor
begin

section \<open>The Cauchy-Schwarz Inequality\<close>

lemma inner_prod_expand:
  assumes "dim_vec a = dim_vec b" and "dim_vec a = dim_vec c" and "dim_vec a = dim_vec d"
  shows "\<langle>a + b|c + d\<rangle> = \<langle>a|c\<rangle> + \<langle>a|d\<rangle> + \<langle>b|c\<rangle> + \<langle>b|d\<rangle>"
  apply (simp add: inner_prod_def)
  using assms sum.cong by (simp add: sum.distrib algebra_simps)

lemma inner_prod_distrib_left:
  assumes "dim_vec a = dim_vec b"
  shows "\<langle>c \<cdot>\<^sub>v a|b\<rangle> = cnj(c) * \<langle>a|b\<rangle>"
  using assms inner_prod_def by (simp add: algebra_simps mult_hom.hom_sum)

lemma inner_prod_distrib_right:
  assumes "dim_vec a = dim_vec b"
  shows "\<langle>a|c \<cdot>\<^sub>v b\<rangle> = c * \<langle>a|b\<rangle>"
  using assms by (simp add: algebra_simps mult_hom.hom_sum)

lemma cauchy_schwarz_ineq:
  assumes "dim_vec v = dim_vec w"
  shows "(cmod(\<langle>v|w\<rangle>))\<^sup>2 \<le> Re (\<langle>v|v\<rangle> * \<langle>w|w\<rangle>)"
proof (cases "\<langle>v|v\<rangle> = 0")
  case c0:True
  then have "\<And>i. i < dim_vec v \<Longrightarrow> v $ i = 0"
    by(metis index_zero_vec(1) inner_prod_with_itself_nonneg_reals_non0)
  then have "(cmod(\<langle>v|w\<rangle>))\<^sup>2 = 0" by (simp add: assms inner_prod_def)
  moreover have "Re (\<langle>v|v\<rangle> * \<langle>w|w\<rangle>) = 0" by (simp add: c0)
  ultimately show ?thesis by simp
next
  case c1:False
  have "dim_vec w = dim_vec (- \<langle>v|w\<rangle> / \<langle>v|v\<rangle> \<cdot>\<^sub>v v)" by (simp add: assms)
  then have "\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = \<langle>w|w\<rangle> + \<langle>w|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> +
\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w\<rangle> + \<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle>"
    using inner_prod_expand[of "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v" "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v"] by auto
  moreover have "\<langle>w|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> * \<langle>w|v\<rangle>"
    using assms inner_prod_distrib_right[of "w" "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  moreover have "\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w\<rangle> = cnj(-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * \<langle>v|w\<rangle>"
    using assms inner_prod_distrib_left[of "v" "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  moreover have "\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = cnj(-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * (-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * \<langle>v|v\<rangle>"
    using inner_prod_distrib_left[of "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"]
inner_prod_distrib_right[of "v" "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  ultimately have "\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = \<langle>w|w\<rangle> -  cmod(\<langle>v|w\<rangle>)^2 / \<langle>v|v\<rangle>"
    using assms inner_prod_cnj[of "w" "v"] inner_prod_cnj[of "v" "v"] complex_norm_square by simp
  moreover have "Re(\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle>) \<ge> 0"
    using inner_prod_with_itself_Re by blast
  ultimately have "Re(\<langle>w|w\<rangle>) \<ge> cmod(\<langle>v|w\<rangle>)^2/Re(\<langle>v|v\<rangle>)"
    using inner_prod_with_itself_real by simp
  moreover have c2:"Re(\<langle>v|v\<rangle>) > 0"
    using inner_prod_with_itself_Re_non0 inner_prod_with_itself_eq0 c1 by auto
  ultimately have "Re(\<langle>w|w\<rangle>) * Re(\<langle>v|v\<rangle>) \<ge> cmod(\<langle>v|w\<rangle>)^2/Re(\<langle>v|v\<rangle>) * Re(\<langle>v|v\<rangle>)"
    using real_mult_le_cancel_iff1 by blast
  thus ?thesis
    using inner_prod_with_itself_Im c2 by (simp add: mult.commute)
qed

lemma cauchy_schwarz_eq [simp]:
  assumes "v = (l \<cdot>\<^sub>v w)"
  shows "(cmod(\<langle>v|w\<rangle>))\<^sup>2 = Re (\<langle>v|v\<rangle> * \<langle>w|w\<rangle>)"
proof-
  have "cmod(\<langle>v|w\<rangle>) = cmod(cnj(l) * \<langle>w|w\<rangle>)"
    using assms inner_prod_distrib_left[of "w" "w" "l"] by simp
  then have "cmod(\<langle>v|w\<rangle>)^2 = cmod(l)^2 * \<langle>w|w\<rangle> * \<langle>w|w\<rangle>"
    using complex_norm_square inner_prod_cnj[of "w" "w"] by simp
  moreover have "\<langle>v|v\<rangle> = cmod(l)^2 * \<langle>w|w\<rangle>"
    using assms complex_norm_square inner_prod_distrib_left[of "w" "v" "l"]
inner_prod_distrib_right[of "w" "w" "l"] by simp
  ultimately show ?thesis by (metis Re_complex_of_real)
qed

lemma cauchy_schwarz_col [simp]:
  assumes "dim_vec v = dim_vec w" and "(cmod(\<langle>v|w\<rangle>))\<^sup>2 = Re (\<langle>v|v\<rangle> * \<langle>w|w\<rangle>)"
  shows "\<exists>l. v = (l \<cdot>\<^sub>v w) \<or> w = (l \<cdot>\<^sub>v v)"
proof (cases "\<langle>v|v\<rangle> = 0")
  case c0:True
  then have "\<And>i. i < dim_vec v \<Longrightarrow> v $ i = 0"
    by(metis index_zero_vec(1) inner_prod_with_itself_nonneg_reals_non0)
  then have "v = 0 \<cdot>\<^sub>v w" by (auto simp: assms)
  then show ?thesis by auto
next
  case c1:False
  have f0:"dim_vec w = dim_vec (- \<langle>v|w\<rangle> / \<langle>v|v\<rangle> \<cdot>\<^sub>v v)" by (simp add: assms(1))
  then have "\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = \<langle>w|w\<rangle> + \<langle>w|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> +
\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w\<rangle> + \<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle>"
    using inner_prod_expand[of "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v" "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v"] by simp
  moreover have "\<langle>w|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> * \<langle>w|v\<rangle>"
    using assms(1) inner_prod_distrib_right[of "w" "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  moreover have "\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w\<rangle> = cnj(-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * \<langle>v|w\<rangle>"
    using assms(1) inner_prod_distrib_left[of "v" "w" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  moreover have "\<langle>-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = cnj(-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * (-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>) * \<langle>v|v\<rangle>"
    using inner_prod_distrib_left[of "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"]
inner_prod_distrib_right[of "v" "v" "-\<langle>v|w\<rangle>/\<langle>v|v\<rangle>"] by simp
  ultimately have "\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = \<langle>w|w\<rangle> -  cmod(\<langle>v|w\<rangle>)^2 / \<langle>v|v\<rangle>"
    using inner_prod_cnj[of "w" "v"] inner_prod_cnj[of "v" "v"] assms(1) complex_norm_square by simp
  moreover have "\<langle>w|w\<rangle> = cmod(\<langle>v|w\<rangle>)^2 / \<langle>v|v\<rangle>"
    using assms(2) inner_prod_with_itself_real by(metis Reals_mult c1 nonzero_mult_div_cancel_left of_real_Re)
  ultimately have "\<langle>w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v|w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v\<rangle> = 0" by simp
  then have "\<And>i. i<dim_vec w \<Longrightarrow> (w + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v) $ i = 0"
    by (metis f0 index_add_vec(2) index_zero_vec(1) inner_prod_with_itself_nonneg_reals_non0)
  then have "\<And>i. i<dim_vec w \<Longrightarrow> w $ i + -\<langle>v|w\<rangle>/\<langle>v|v\<rangle> * v $ i = 0"
    by (metis assms(1) f0 index_add_vec(1) index_smult_vec(1))
  then have "\<And>i. i<dim_vec w \<Longrightarrow> w $ i = \<langle>v|w\<rangle>/\<langle>v|v\<rangle> * v $ i" by simp
  then have "w = \<langle>v|w\<rangle>/\<langle>v|v\<rangle> \<cdot>\<^sub>v v" by (auto simp add: assms(1))
  thus ?thesis by auto
qed

section \<open>The No-Cloning Theorem\<close>

lemma eq_from_inner_prod [simp]:
  assumes "dim_vec v = dim_vec w" and "\<langle>v|w\<rangle> = 1" and "\<langle>v|v\<rangle> = 1" and "\<langle>w|w\<rangle> = 1"
  shows "v = w"
proof-
  have "(cmod(\<langle>v|w\<rangle>))\<^sup>2 = Re (\<langle>v|v\<rangle> * \<langle>w|w\<rangle>)" by (simp add: assms)
  then have f0:"\<exists>l. v = (l \<cdot>\<^sub>v w) \<or> w = (l \<cdot>\<^sub>v v)" by (simp add: assms(1))
  then show ?thesis
  proof (cases "\<exists>l. v = (l \<cdot>\<^sub>v w)")
    case True
    then have "\<exists>l. v = (l \<cdot>\<^sub>v w) \<and> \<langle>v|w\<rangle> = cnj(l) * \<langle>w|w\<rangle>"
      using inner_prod_distrib_left by auto
    then show ?thesis by (simp add: assms(2,4))
  next
    case False
    then have "\<exists>l. w = (l \<cdot>\<^sub>v v) \<and> \<langle>v|w\<rangle> = l * \<langle>v|v\<rangle>"
      using f0 inner_prod_distrib_right by auto
    then show ?thesis by (simp add: assms(2,3))
  qed
qed

lemma hermite_cnj_of_tensor:
  shows "(A \<Otimes> B)\<^sup>\<dagger>  = (A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)"
proof
  show c0:"dim_row ((A \<Otimes> B)\<^sup>\<dagger>) = dim_row ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>))" by simp
  show c1:"dim_col ((A \<Otimes> B)\<^sup>\<dagger>) = dim_col ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>))" by simp
  show "\<And>i j. i < dim_row ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)) \<Longrightarrow> j < dim_col ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)) \<Longrightarrow>
((A \<Otimes> B)\<^sup>\<dagger>) $$ (i, j) = ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)) $$ (i, j)"
  proof-
    fix i j assume a0:"i < dim_row ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>))" and a1:"j < dim_col ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>))"
    then have "(A \<Otimes> B)\<^sup>\<dagger> $$ (i, j) = cnj((A \<Otimes> B) $$ (j, i))" by (simp add: dagger_def)
    also have "\<dots> = cnj(A $$ (j div dim_row(B), i div dim_col(B)) * B $$ (j mod dim_row(B), i mod dim_col(B)))"
      by (metis (mono_tags, lifting) a0 a1 c1 dim_row_tensor_mat dim_col_of_dagger dim_row_of_dagger
index_tensor_mat less_nat_zero_code mult_not_zero neq0_conv)
    moreover have "((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)) $$ (i, j) =
(A\<^sup>\<dagger>) $$ (i div dim_col(B), j div dim_row(B)) * (B\<^sup>\<dagger>) $$ (i mod dim_col(B), j mod dim_row(B))"
      by (smt a0 a1 c1 dim_row_tensor_mat dim_col_of_dagger dim_row_of_dagger index_tensor_mat
less_nat_zero_code mult_eq_0_iff neq0_conv)
    moreover have "(B\<^sup>\<dagger>) $$ (i mod dim_col(B), j mod dim_row(B)) = cnj(B $$ (j mod dim_row(B), i mod dim_col(B)))"
    proof-
      have "i mod dim_col(B) < dim_col(B)"
        using a0 gr_implies_not_zero mod_div_trivial by fastforce
      moreover have "j mod dim_row(B) < dim_row(B)"
        using a1 gr_implies_not_zero mod_div_trivial by fastforce
      ultimately show ?thesis by (simp add: dagger_def)
    qed
    moreover have "(A\<^sup>\<dagger>) $$ (i div dim_col(B), j div dim_row(B)) = cnj(A $$ (j div dim_row(B), i div dim_col(B)))"
    proof-
      have "i div dim_col(B) < dim_col(A)"
        using a0 dagger_def by (simp add: less_mult_imp_div_less)
      moreover have "j div dim_row(B) < dim_row(A)"
        using a1 dagger_def by (simp add: less_mult_imp_div_less)
      ultimately show ?thesis by (simp add: dagger_def)
    qed
    ultimately show "((A \<Otimes> B)\<^sup>\<dagger>) $$ (i, j) = ((A\<^sup>\<dagger>) \<Otimes> (B\<^sup>\<dagger>)) $$ (i, j)" by simp
  qed
qed

locale quantum_machine =
  fixes n:: nat and s:: "complex Matrix.vec" and U:: "complex Matrix.mat"
  assumes dim_vec [simp]: "dim_vec s = 2^n"
    and dim_col [simp]: "dim_col U = 2^n * 2^n"
    and square [simp]: "square_mat U" and unitary [simp]: "unitary U"

lemma inner_prod_of_unit_vec:
  fixes n i:: nat
  assumes "i < n"
  shows "\<langle>unit_vec n i| unit_vec n i\<rangle> = 1"
  apply (auto simp add: inner_prod_def unit_vec_def)
  by (simp add: assms sum.cong[of "{0..<n}" "{0..<n}"
"\<lambda>j. cnj (if j = i then 1 else 0) * (if j = i then 1 else 0)" "\<lambda>j. (if j = i then 1 else 0)"])

theorem (in quantum_machine) no_cloning:
  assumes [simp]: "dim_vec v = 2^n" and [simp]: "dim_vec w = 2^n" and
    cloning1: "\<And>s. U * ( |v\<rangle> \<Otimes> |s\<rangle>) = |v\<rangle> \<Otimes> |v\<rangle>" and
    cloning2: "\<And>s. U * ( |w\<rangle> \<Otimes> |s\<rangle>) = |w\<rangle> \<Otimes> |w\<rangle>" and
    "\<langle>v|v\<rangle> = 1" and "\<langle>w|w\<rangle> = 1"
  shows "v = w \<or> \<langle>v|w\<rangle> = 0"
proof-
  define s:: "complex Matrix.vec" where d0:"s = unit_vec (2^n) 0"
  have f0:"\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| = (( |v\<rangle> \<Otimes> |s\<rangle>)\<^sup>\<dagger>)"
    using hermite_cnj_of_tensor[of "|v\<rangle>" "|s\<rangle>"] bra_def dagger_def ket_vec_def by simp
  moreover have f1:"( |v\<rangle> \<Otimes> |v\<rangle>)\<^sup>\<dagger> * ( |w\<rangle> \<Otimes> |w\<rangle>) = (\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * ( |w\<rangle> \<Otimes> |s\<rangle>)"
  proof-
    have "(U * ( |v\<rangle> \<Otimes> |s\<rangle>))\<^sup>\<dagger> = (\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * (U\<^sup>\<dagger>)"
      using dagger_of_prod[of "U" "|v\<rangle> \<Otimes> |s\<rangle>"] f0 d0 by (simp add: ket_vec_def)
    then have "(U * ( |v\<rangle> \<Otimes> |s\<rangle>))\<^sup>\<dagger> * U * ( |w\<rangle> \<Otimes> |s\<rangle>) = (\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * (U\<^sup>\<dagger>) * U * ( |w\<rangle> \<Otimes> |s\<rangle>)" by simp
    moreover have "(U * ( |v\<rangle> \<Otimes> |s\<rangle>))\<^sup>\<dagger> * U * ( |w\<rangle> \<Otimes> |s\<rangle>) = (( |v\<rangle> \<Otimes> |v\<rangle>)\<^sup>\<dagger>) * ( |w\<rangle> \<Otimes> |w\<rangle>)"
      using assms(2-4) d0 unit_vec_def by (smt Matrix.dim_vec assoc_mult_mat carrier_mat_triv dim_row_mat(1)
dim_row_tensor_mat dim_col_of_dagger index_mult_mat(2) ket_vec_def square square_mat.elims(2))
    moreover have "(U\<^sup>\<dagger>) * U = 1\<^sub>m (2^n * 2^n)"
      using unitary_def dim_col unitary by simp
    moreover have "(\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * (U\<^sup>\<dagger>) * U = (\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * ((U\<^sup>\<dagger>) * U)"
      using d0 assms(1) unit_vec_def by (smt Matrix.dim_vec assoc_mult_mat carrier_mat_triv dim_row_mat(1)
dim_row_tensor_mat f0 dim_col_of_dagger dim_row_of_dagger ket_vec_def local.dim_col)
    moreover have "(\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| ) * 1\<^sub>m (2^n * 2^n) = (\<langle>|v\<rangle>| \<Otimes> \<langle>|s\<rangle>| )"
      using f0 ket_vec_def d0 by simp
    ultimately show ?thesis by simp
  qed
  then have f2:"(\<langle>|v\<rangle>| * |w\<rangle>) \<Otimes> (\<langle>|v\<rangle>| * |w\<rangle>) = (\<langle>|v\<rangle>| * |w\<rangle>) \<Otimes> (\<langle>|s\<rangle>| * |s\<rangle>)"
  proof-
    have "\<langle>|v\<rangle>| \<Otimes> \<langle>|v\<rangle>| = (( |v\<rangle> \<Otimes> |v\<rangle>)\<^sup>\<dagger>)"
      using hermite_cnj_of_tensor[of "|v\<rangle>" "|v\<rangle>"] bra_def dagger_def ket_vec_def by simp
    then show ?thesis
      using f1 d0 by (simp add: bra_def mult_distr_tensor ket_vec_def)
  qed
  then have "\<langle>v|w\<rangle> * \<langle>v|w\<rangle> = \<langle>v|w\<rangle> * \<langle>s|s\<rangle>"
  proof-
    have "((\<langle>|v\<rangle>| * |w\<rangle>) \<Otimes> (\<langle>|v\<rangle>| * |w\<rangle>)) $$ (0,0) = \<langle>v|w\<rangle> * \<langle>v|w\<rangle>"
      using assms inner_prod_with_times_mat[of "v" "w"] by (simp add: bra_def ket_vec_def)
    moreover have "((\<langle>|v\<rangle>| * |w\<rangle>) \<Otimes> (\<langle>|s\<rangle>| * |s\<rangle>)) $$ (0,0) = \<langle>v|w\<rangle> * \<langle>s|s\<rangle>"
      using inner_prod_with_times_mat[of "v" "w"] inner_prod_with_times_mat[of "s" "s"] by(simp add: bra_def ket_vec_def)
    ultimately show ?thesis using f2 by auto
  qed
  then have "\<langle>v|w\<rangle> = 0 \<or> \<langle>v|w\<rangle> = \<langle>s|s\<rangle>" by (simp add: mult_left_cancel)
  moreover have "\<langle>s|s\<rangle> = 1" by(simp add: d0 inner_prod_of_unit_vec)
  ultimately show ?thesis using assms(1,2,5,6) by auto
qed

end