(*  Title:      HOL/Algebra/Indexed_Polynomials.thy
    Author:     Paulo Emílio de Vilhena
*)

theory Indexed_Polynomials
  imports Weak_Morphisms "HOL-Library.Multiset" Polynomial_Divisibility

begin

section \<open>Indexed Polynomials\<close>

text \<open>In this theory, we build a basic framework to the study of polynomials on letters
      indexed by a set. The main interest is to then apply these concepts to the construction
      of the algebraic closure of a field. \<close>

subsection \<open>Definitions\<close>

text \<open>We formalize indexed monomials as multisets with its support a subset of the index set.
      On top of those, we build indexed polynomials which are simply functions mapping a monomial
      to its coefficient. \<close>

definition (in ring) indexed_const :: "'a \<Rightarrow> ('c multiset \<Rightarrow> 'a)"
  where "indexed_const k = (\<lambda>m. if m = {#} then k else \<zero>)"

definition (in ring) indexed_pmult :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)" (infixl "\<Otimes>" 65)
  where "indexed_pmult P i = (\<lambda>m. if i \<in># m then P (m - {# i #}) else \<zero>)"

definition (in ring) indexed_padd :: "_ \<Rightarrow> _ \<Rightarrow> ('c multiset \<Rightarrow> 'a)" (infixl "\<Oplus>" 65)
  where "indexed_padd P Q = (\<lambda>m. (P m) \<oplus> (Q m))"

definition (in ring) indexed_var :: "'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)" ("\<X>\<index>")
  where "indexed_var i = (indexed_const \<one>) \<Otimes> i"

definition (in ring) index_free :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> 'c \<Rightarrow> bool"
  where "index_free P i \<longleftrightarrow> (\<forall>m. i \<in># m \<longrightarrow> P m = \<zero>)"

definition (in ring) carrier_coeff :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> bool"
  where "carrier_coeff P \<longleftrightarrow> (\<forall>m. P m \<in> carrier R)"

inductive_set (in ring) indexed_pset :: "'c set \<Rightarrow> 'a set \<Rightarrow> ('c multiset \<Rightarrow> 'a) set" ("_ [\<X>\<index>]" 80)
  for I and K where
    indexed_const:  "k \<in> K \<Longrightarrow> indexed_const k \<in> (K[\<X>\<^bsub>I\<^esub>])"
  | indexed_padd:  "\<lbrakk> P \<in> (K[\<X>\<^bsub>I\<^esub>]); Q \<in> (K[\<X>\<^bsub>I\<^esub>]) \<rbrakk> \<Longrightarrow> P \<Oplus> Q \<in> (K[\<X>\<^bsub>I\<^esub>])"
  | indexed_pmult: "\<lbrakk> P \<in> (K[\<X>\<^bsub>I\<^esub>]); i \<in> I \<rbrakk> \<Longrightarrow> P \<Otimes> i \<in> (K[\<X>\<^bsub>I\<^esub>])"

fun (in ring) indexed_eval_aux :: "('c multiset \<Rightarrow> 'a) list \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)"
  where "indexed_eval_aux Ps i = foldr (\<lambda>P Q. (Q \<Otimes> i) \<Oplus> P) Ps (indexed_const \<zero>)"

fun (in ring) indexed_eval :: "('c multiset \<Rightarrow> 'a) list \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)"
  where "indexed_eval Ps i = indexed_eval_aux (rev Ps) i"

subsection \<open>Basic Properties\<close>

lemma (in ring) carrier_coeffE:
  assumes "carrier_coeff P" shows "P m \<in> carrier R"
  using assms unfolding carrier_coeff_def by simp

lemma (in ring) indexed_zero_def: "indexed_const \<zero> = (\<lambda>_. \<zero>)"
  unfolding indexed_const_def by simp

lemma (in ring) indexed_const_index_free: "index_free (indexed_const k) i"
  unfolding index_free_def indexed_const_def by auto

lemma (in domain) indexed_var_not_index_free: "\<not> index_free \<X>\<^bsub>i\<^esub> i"
proof -
  have "\<X>\<^bsub>i\<^esub> {# i #} = \<one>"
    unfolding indexed_var_def indexed_pmult_def indexed_const_def by simp
  thus ?thesis
    using one_not_zero unfolding index_free_def by fastforce
qed

lemma (in ring) indexed_pmult_zero [simp]:
  shows "indexed_pmult (indexed_const \<zero>) i = indexed_const \<zero>"
  unfolding indexed_zero_def indexed_pmult_def by auto

lemma (in ring) indexed_padd_zero:
  assumes "carrier_coeff P" shows "P \<Oplus> (indexed_const \<zero>) = P" and "(indexed_const \<zero>) \<Oplus> P = P"
  using assms unfolding carrier_coeff_def indexed_zero_def indexed_padd_def by auto

lemma (in ring) indexed_padd_const:
  shows "(indexed_const k1) \<Oplus> (indexed_const k2) = indexed_const (k1 \<oplus> k2)"
  unfolding indexed_padd_def indexed_const_def by auto

lemma (in ring) indexed_const_in_carrier:
  assumes "K \<subseteq> carrier R" and "k \<in> K" shows "\<And>m. (indexed_const k) m \<in> carrier R"
  using assms unfolding indexed_const_def by auto

lemma (in ring) indexed_padd_in_carrier:
  assumes "carrier_coeff P" and "carrier_coeff Q" shows "carrier_coeff (indexed_padd P Q)"
  using assms unfolding carrier_coeff_def indexed_padd_def by simp

lemma (in ring) indexed_pmult_in_carrier:
  assumes "carrier_coeff P" shows "carrier_coeff (P \<Otimes> i)"
  using assms unfolding carrier_coeff_def indexed_pmult_def by simp

lemma (in ring) indexed_eval_aux_in_carrier:
  assumes "list_all carrier_coeff Ps" shows "carrier_coeff (indexed_eval_aux Ps i)"
  using assms unfolding carrier_coeff_def
  by (induct Ps) (auto simp add: indexed_zero_def indexed_padd_def indexed_pmult_def)

lemma (in ring) indexed_eval_in_carrier:
  assumes "list_all carrier_coeff Ps" shows "carrier_coeff (indexed_eval Ps i)"
  using assms indexed_eval_aux_in_carrier[of "rev Ps"] by auto

lemma (in ring) indexed_pset_in_carrier:
  assumes "K \<subseteq> carrier R" and "P \<in> (K[\<X>\<^bsub>I\<^esub>])" shows "carrier_coeff P"
  using assms(2,1) indexed_const_in_carrier unfolding carrier_coeff_def
  by (induction) (auto simp add: indexed_zero_def indexed_padd_def indexed_pmult_def)

subsection \<open>Indexed Eval\<close>

lemma (in ring) exists_indexed_eval_aux_monomial:
  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
    and "count n i = k" and "P n \<noteq> \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
  obtains m where "count m i = length Qs + k" and "(indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
proof -
  from assms(2,5) have "\<exists>m. count m i = length Qs + k \<and> (indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
  proof (induct Qs)
    case Nil thus ?case
      using indexed_padd_zero(2)[OF assms(1)] assms(3-4) by auto
  next
    case (Cons Q Qs)
    then obtain m where m: "count m i = length Qs + k" "(indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
      by auto
    define m' where "m' = m + {# i #}"
    hence "Q m' = \<zero>"
      using Cons(3) unfolding index_free_def by simp
    moreover have "(indexed_eval_aux (Qs @ [ P ]) i) m \<in> carrier R"
      using indexed_eval_aux_in_carrier[of "Qs @ [ P ]" i] Cons(2) assms(1) carrier_coeffE by auto
    hence "((indexed_eval_aux (Qs @ [ P ]) i) \<Otimes> i) m' \<in> carrier R - { \<zero> }"
      using m unfolding indexed_pmult_def m'_def by simp
    ultimately have "(indexed_eval_aux (Q # (Qs @ [ P ])) i) m' \<noteq> \<zero>"
      by (auto simp add: indexed_padd_def)
    moreover from \<open>count m i = length Qs + k\<close> have "count m' i = length (Q # Qs) + k"
      unfolding m'_def by simp
    ultimately show ?case
      by auto
  qed
  thus thesis
    using that by blast
qed

lemma (in ring) indexed_eval_aux_monomial_degree_le:
  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
    and "(indexed_eval_aux Ps i) m \<noteq> \<zero>" shows "count m i \<le> length Ps - 1"
  using assms(1-3)
proof (induct Ps arbitrary: m, simp add: indexed_zero_def)
  case (Cons P Ps) show ?case
  proof (cases "count m i = 0", simp)
    assume "count m i \<noteq> 0"
    hence "P m = \<zero>"
      using Cons(3) unfolding index_free_def by simp
    moreover have "(indexed_eval_aux Ps i) m \<in> carrier R"
      using carrier_coeffE[OF indexed_eval_aux_in_carrier[of Ps i]] Cons(2) by simp
    ultimately have "((indexed_eval_aux Ps i) \<Otimes> i) m \<noteq> \<zero>"
      using Cons(4) by (auto simp add: indexed_padd_def)
    with \<open>count m i \<noteq> 0\<close> have "(indexed_eval_aux Ps i) (m - {# i #}) \<noteq> \<zero>"
      unfolding indexed_pmult_def by (auto simp del: indexed_eval_aux.simps)
    hence "count m i - 1 \<le> length Ps - 1"
      using Cons(1)[of "m - {# i #}"] Cons(2-3) by auto
    moreover from \<open>(indexed_eval_aux Ps i) (m - {# i #}) \<noteq> \<zero>\<close> have "length Ps > 0"
      by (auto simp add: indexed_zero_def)
    moreover from \<open>count m i \<noteq> 0\<close> have "count m i > 0"
      by simp
    ultimately show ?thesis
      by (simp add: Suc_leI le_diff_iff)
  qed
qed

lemma (in ring) indexed_eval_aux_is_inj:
  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
    and "indexed_eval_aux Ps i = indexed_eval_aux Qs i" and "length Ps = length Qs"
  shows "Ps = Qs"
  using assms
proof (induct Ps arbitrary: Qs, simp)
  case (Cons P Ps)
  from \<open>length (P # Ps) = length Qs\<close> obtain Q' Qs' where Qs: "Qs = Q' # Qs'" and "length Ps = length Qs'"
    by (metis Suc_length_conv)

  have in_carrier:
    "((indexed_eval_aux Ps  i) \<Otimes> i) m \<in> carrier R" "P  m \<in> carrier R"
    "((indexed_eval_aux Qs' i) \<Otimes> i) m \<in> carrier R" "Q' m \<in> carrier R" for m
    using indexed_eval_aux_in_carrier[of Ps  i]
          indexed_eval_aux_in_carrier[of Qs' i] Cons(2,4) carrier_coeffE
    unfolding Qs indexed_pmult_def by auto

  have "(indexed_eval_aux (P # Ps) i) m = (indexed_eval_aux (Q' # Qs') i) m" for m
    using Cons(6) unfolding Qs by simp
  hence eq: "((indexed_eval_aux Ps i) \<Otimes> i) m \<oplus> P m = ((indexed_eval_aux Qs' i) \<Otimes> i) m \<oplus> Q' m" for m
    by (simp add: indexed_padd_def)

  have "P m = Q' m" if "i \<in># m" for m
    using that Cons(3,5) unfolding index_free_def Qs by auto
  moreover have "P m = Q' m" if "i \<notin># m" for m
    using in_carrier(2,4) eq[of m] that by (auto simp add: indexed_pmult_def)
  ultimately have "P = Q'"
    by auto

  hence "(indexed_eval_aux Ps i) m = (indexed_eval_aux Qs' i) m" for m
    using eq[of "m + {# i #}"] in_carrier[of "m + {# i #}"] unfolding indexed_pmult_def by auto
  with \<open>length Ps = length Qs'\<close> have "Ps = Qs'"
    using Cons(1)[of Qs'] Cons(2-5) unfolding Qs by auto
  with \<open>P = Q'\<close> show ?case
    unfolding Qs by simp
qed

lemma (in ring) indexed_eval_aux_is_inj':
  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
      and "carrier_coeff P" and "index_free P i" "P \<noteq> indexed_const \<zero>"
      and "carrier_coeff Q" and "index_free Q i" "Q \<noteq> indexed_const \<zero>"
    and "indexed_eval_aux (Ps @ [ P ]) i = indexed_eval_aux (Qs @ [ Q ]) i"
  shows "Ps = Qs" and "P = Q"
proof -
  obtain m n where "P m \<noteq> \<zero>" and "Q n \<noteq> \<zero>"
    using assms(7,10) unfolding indexed_zero_def by blast
  hence "count m i = 0" and "count n i = 0"
    using assms(6,9) unfolding index_free_def by (meson count_inI)+
  with \<open>P m \<noteq> \<zero>\<close> and \<open>Q n \<noteq> \<zero>\<close> obtain m' n'
    where m': "count m' i = length Ps" "(indexed_eval_aux (Ps @ [ P ]) i) m' \<noteq> \<zero>"
      and n': "count n' i = length Qs" "(indexed_eval_aux (Qs @ [ Q ]) i) n' \<noteq> \<zero>"
    using exists_indexed_eval_aux_monomial[of P Ps m i 0]
          exists_indexed_eval_aux_monomial[of Q Qs n i 0] assms(1-5,8)
    by (metis (no_types, lifting) add.right_neutral)
  have "(indexed_eval_aux (Qs @ [ Q ]) i) m' \<noteq> \<zero>"
    using m'(2) assms(11) by simp
  with \<open>count m' i = length Ps\<close> have "length Ps \<le> length Qs"
    using indexed_eval_aux_monomial_degree_le[of "Qs @ [ Q ]" i m'] assms(3-4,8-9) by auto
  moreover have "(indexed_eval_aux (Ps @ [ P ]) i) n' \<noteq> \<zero>"
    using n'(2) assms(11) by simp
  with \<open>count n' i = length Qs\<close> have "length Qs \<le> length Ps"
    using indexed_eval_aux_monomial_degree_le[of "Ps @ [ P ]" i n'] assms(1-2,5-6) by auto
  ultimately have same_len: "length (Ps @ [ P ]) = length (Qs @ [ Q ])"
    by simp
  thus "Ps = Qs" and "P = Q"
    using indexed_eval_aux_is_inj[of "Ps @ [ P ]" i "Qs @ [ Q ]"] assms(1-6,8-9,11) by auto
qed

lemma (in ring) exists_indexed_eval_monomial:
  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
    and "P n \<noteq> \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
  obtains m where "count m i = length Qs + (count n i)" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
  using exists_indexed_eval_aux_monomial[OF assms(1) _ _ assms(3), of "rev Qs"] assms(2,4) by auto

corollary (in ring) exists_indexed_eval_monomial':
  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
    and "P \<noteq> indexed_const \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
  obtains m where "count m i \<ge> length Qs" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
proof -
  from \<open>P \<noteq> indexed_const \<zero>\<close> obtain n where "P n \<noteq> \<zero>"
    unfolding indexed_const_def by auto
  then obtain m where "count m i = length Qs + (count n i)" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
    using exists_indexed_eval_monomial[OF assms(1-2) _ assms(4)] by auto
  thus thesis
    using that by force
qed

lemma (in ring) indexed_eval_monomial_degree_le:
  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
    and "(indexed_eval Ps i) m \<noteq> \<zero>" shows "count m i \<le> length Ps - 1"
  using indexed_eval_aux_monomial_degree_le[of "rev Ps"] assms by auto

lemma (in ring) indexed_eval_is_inj:
  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
      and "carrier_coeff P" and "index_free P i" "P \<noteq> indexed_const \<zero>"
      and "carrier_coeff Q" and "index_free Q i" "Q \<noteq> indexed_const \<zero>"
    and "indexed_eval (P # Ps) i = indexed_eval (Q # Qs) i"
  shows "Ps = Qs" and "P = Q"
proof -
  have rev_cond:
    "list_all carrier_coeff (rev Ps)" "list_all (\<lambda>P. index_free P i) (rev Ps)"
    "list_all carrier_coeff (rev Qs)" "list_all (\<lambda>Q. index_free Q i) (rev Qs)"
    using assms(1-4) by auto
  show "Ps = Qs" and "P = Q"
    using indexed_eval_aux_is_inj'[OF rev_cond assms(5-10)] assms(11) by auto
qed

lemma (in ring) indexed_eval_inj_on_carrier:
  assumes "\<And>P. P \<in> carrier L \<Longrightarrow> carrier_coeff P" and "\<And>P. P \<in> carrier L \<Longrightarrow> index_free P i" and "\<zero>\<^bsub>L\<^esub> = indexed_const \<zero>"
  shows "inj_on (\<lambda>Ps. indexed_eval Ps i) (carrier (poly_ring L))"
proof -
  { fix Ps
    assume "Ps \<in> carrier (poly_ring L)" and "indexed_eval Ps i = indexed_const \<zero>"
    have "Ps = []"
    proof (rule ccontr)
      assume "Ps \<noteq> []"
      then obtain P' Ps' where Ps: "Ps = P' # Ps'"
        using list.exhaust by blast
      with \<open>Ps \<in> carrier (poly_ring L)\<close>
      have "P' \<noteq> indexed_const \<zero>" and "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
        by (simp add: list.pred_set subset_code(1))+
      then obtain m where "(indexed_eval Ps i) m \<noteq> \<zero>"
        using exists_indexed_eval_monomial'[of P' Ps'] unfolding Ps by auto
      hence "indexed_eval Ps i \<noteq> indexed_const \<zero>"
        unfolding indexed_const_def by auto
      with \<open>indexed_eval Ps i = indexed_const \<zero>\<close> show False by simp
    qed } note aux_lemma = this

  show ?thesis
  proof (rule inj_onI)
    fix Ps Qs
    assume "Ps \<in> carrier (poly_ring L)" and "Qs \<in> carrier (poly_ring L)"
    show "indexed_eval Ps i = indexed_eval Qs i \<Longrightarrow> Ps = Qs"
    proof (cases)
      assume "Qs = []" and "indexed_eval Ps i = indexed_eval Qs i"
      with \<open>Ps \<in> carrier (poly_ring L)\<close> show "Ps = Qs"
        using aux_lemma by simp
    next
      assume "Qs \<noteq> []" and eq: "indexed_eval Ps i = indexed_eval Qs i"
      with \<open>Qs \<in> carrier (poly_ring L)\<close> have "Ps \<noteq> []"
        using aux_lemma by auto
      from \<open>Ps \<noteq> []\<close> and \<open>Qs \<noteq> []\<close> obtain P' Ps' Q' Qs' where Ps: "Ps = P' # Ps'" and Qs: "Qs = Q' # Qs'"
        using list.exhaust by metis

      from \<open>Ps \<in> carrier (poly_ring L)\<close> and \<open>Ps = P' # Ps'\<close>
      have "carrier_coeff P'" and "index_free P' i" "P' \<noteq> indexed_const \<zero>"
       and "list_all carrier_coeff Ps'" and "list_all (\<lambda>P. index_free P i) Ps'"
        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
        by (simp add: list.pred_set subset_code(1))+
      moreover
      from \<open>Qs \<in> carrier (poly_ring L)\<close> and \<open>Qs = Q' # Qs'\<close>
      have "carrier_coeff Q'" and "index_free Q' i" "Q' \<noteq> indexed_const \<zero>"
       and "list_all carrier_coeff Qs'" and "list_all (\<lambda>P. index_free P i) Qs'"
        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
        by (simp add: list.pred_set subset_code(1))+
      ultimately show ?thesis
        using indexed_eval_is_inj[of Ps' i Qs' P' Q'] eq unfolding Ps Qs by auto
    qed
  qed
qed

subsection \<open>Link with Weak Morphisms\<close>

text \<open>We study some elements of the contradiction needed in the algebraic closure existence proof. \<close>

context ring
begin

lemma (in ring) indexed_padd_index_free:
  assumes "index_free P i" and "index_free Q i" shows "index_free (P \<Oplus> Q) i"
  using assms unfolding indexed_padd_def index_free_def by auto

lemma (in ring) indexed_pmult_index_free:
  assumes "index_free P j" and "i \<noteq> j" shows "index_free (P \<Otimes> i) j"
  using assms unfolding index_free_def indexed_pmult_def
  by (metis insert_DiffM insert_noteq_member)

lemma (in ring) indexed_eval_index_free:
  assumes "list_all (\<lambda>P. index_free P j) Ps" and "i \<noteq> j" shows "index_free (indexed_eval Ps i) j"
proof -
  { fix Ps assume "list_all (\<lambda>P. index_free P j) Ps" hence "index_free (indexed_eval_aux Ps i) j"
      using indexed_padd_index_free[OF indexed_pmult_index_free[OF _ assms(2)]]
      by (induct Ps) (auto simp add: indexed_zero_def index_free_def) }
  thus ?thesis
    using assms(1) by auto
qed

context
  fixes L :: "(('c multiset) \<Rightarrow> 'a) ring" and i :: 'c
  assumes hyps:
    \<comment> \<open>i\<close>   "field L"
    \<comment> \<open>ii\<close>  "\<And>P. P \<in> carrier L \<Longrightarrow> carrier_coeff P"
    \<comment> \<open>iii\<close> "\<And>P. P \<in> carrier L \<Longrightarrow> index_free P i"
    \<comment> \<open>iv\<close>  "\<zero>\<^bsub>L\<^esub> = indexed_const \<zero>"
begin

interpretation L: field L
  using \<open>field L\<close> .

interpretation UP: principal_domain "poly_ring L"
  using L.univ_poly_is_principal[OF L.carrier_is_subfield] .

abbreviation eval_pmod
  where "eval_pmod q \<equiv> (\<lambda>p. indexed_eval (L.pmod p q) i)"

abbreviation image_poly
  where "image_poly q \<equiv> image_ring (eval_pmod q) (poly_ring L)"

lemma indexed_eval_is_weak_ring_morphism:
  assumes "q \<in> carrier (poly_ring L)" shows "weak_ring_morphism (eval_pmod q) (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
proof (rule weak_ring_morphismI)
  show "ideal (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
    using UP.cgenideal_ideal[OF assms] .
next
  fix a b assume in_carrier: "a \<in> carrier (poly_ring L)" "b \<in> carrier (poly_ring L)"
  note ldiv_closed = in_carrier[THEN L.long_division_closed(2)[OF L.carrier_is_subfield _ assms]]

  have "(eval_pmod q) a = (eval_pmod q) b \<longleftrightarrow> L.pmod a q = L.pmod b q"
    using inj_onD[OF indexed_eval_inj_on_carrier[OF hyps(2-4)] _ ldiv_closed] by fastforce
  also have " ... \<longleftrightarrow> q pdivides\<^bsub>L\<^esub> (a \<ominus>\<^bsub>poly_ring L\<^esub> b)"
    unfolding L.same_pmod_iff_pdivides[OF L.carrier_is_subfield in_carrier assms] ..
  also have " ... \<longleftrightarrow> PIdl\<^bsub>poly_ring L\<^esub> (a \<ominus>\<^bsub>poly_ring L\<^esub> b) \<subseteq> PIdl\<^bsub>poly_ring L\<^esub> q"
    unfolding UP.to_contain_is_to_divide[OF assms UP.minus_closed[OF in_carrier]] pdivides_def ..
  also have " ... \<longleftrightarrow> a \<ominus>\<^bsub>poly_ring L\<^esub> b \<in> PIdl\<^bsub>poly_ring L\<^esub> q"
    unfolding UP.cgenideal_eq_genideal[OF assms] UP.cgenideal_eq_genideal[OF UP.minus_closed[OF in_carrier]]
              UP.Idl_subset_ideal'[OF UP.minus_closed[OF in_carrier] assms] ..
  finally show "(eval_pmod q) a = (eval_pmod q) b \<longleftrightarrow> a \<ominus>\<^bsub>poly_ring L\<^esub> b \<in> PIdl\<^bsub>poly_ring L\<^esub> q" .
qed

lemma eval_norm_eq_id:
  assumes "q \<in> carrier (poly_ring L)" and "degree q > 0" and "a \<in> carrier L"
  shows "((eval_pmod q) \<circ> (ring.poly_of_const L)) a = a"
proof (cases)
  assume "a = \<zero>\<^bsub>L\<^esub>" thus ?thesis
    using L.long_division_zero(2)[OF L.carrier_is_subfield assms(1)] hyps(4)
    unfolding ring.poly_of_const_def[OF L.ring_axioms] by auto
next
  assume "a \<noteq> \<zero>\<^bsub>L\<^esub>" then have in_carrier: "[ a ] \<in> carrier (poly_ring L)"
    using assms(3) unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def by simp
  from \<open>a \<noteq> \<zero>\<^bsub>L\<^esub>\<close> show ?thesis
    using L.pmod_const(2)[OF L.carrier_is_subfield in_carrier assms(1)] assms(2)
          indexed_padd_zero(2)[OF hyps(2)[OF assms(3)]]
    unfolding ring.poly_of_const_def[OF L.ring_axioms] by auto
qed

lemma image_poly_iso_incl:
  assumes "q \<in> carrier (poly_ring L)" and "degree q > 0" shows "id \<in> ring_hom L (image_poly q)"
proof -
  have "((eval_pmod q) \<circ> L.poly_of_const) \<in> ring_hom L (image_poly q)"
    using ring_hom_trans[OF L.canonical_embedding_is_hom[OF L.carrier_is_subring]
          UP.weak_ring_morphism_is_hom[OF indexed_eval_is_weak_ring_morphism[OF assms(1)]]]
    by simp
  thus ?thesis
    using eval_norm_eq_id[OF assms(1-2)] L.ring_hom_restrict[of _ "image_poly q" id] by auto
qed

lemma image_poly_is_field:
  assumes "q \<in> carrier (poly_ring L)" and "pirreducible\<^bsub>L\<^esub> (carrier L) q" shows "field (image_poly q)"
  using UP.image_ring_is_field[OF indexed_eval_is_weak_ring_morphism[OF assms(1)]] assms(2)
  unfolding sym[OF L.rupture_is_field_iff_pirreducible[OF L.carrier_is_subfield assms(1)]] rupture_def
  by simp

lemma image_poly_index_free:
  assumes "q \<in> carrier (poly_ring L)" and "P \<in> carrier (image_poly q)" and "\<not> index_free P j" "i \<noteq> j"
  obtains Q where "Q \<in> carrier L" and "\<not> index_free Q j"
proof -
  from \<open>P \<in> carrier (image_poly q)\<close> obtain p where p: "p \<in> carrier (poly_ring L)" and P: "P = (eval_pmod q) p"
    unfolding image_ring_carrier by blast
  from \<open>\<not> index_free P j\<close> have "\<not> list_all (\<lambda>P. index_free P j) (L.pmod p q)"
    using indexed_eval_index_free[OF _ assms(4), of "L.pmod p q"] unfolding sym[OF P] by auto
  then obtain Q where "Q \<in> set (L.pmod p q)" and "\<not> index_free Q j"
    unfolding list_all_iff by auto
  thus ?thesis
    using L.long_division_closed(2)[OF L.carrier_is_subfield p assms(1)] that
    unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
    by auto
qed

lemma eval_pmod_var:
  assumes "indexed_const \<in> ring_hom R L" and "q \<in> carrier (poly_ring L)" and "degree q > 1"
  shows "(eval_pmod q) X\<^bsub>L\<^esub> = \<X>\<^bsub>i\<^esub>" and "\<X>\<^bsub>i\<^esub> \<in> carrier (image_poly q)"
proof -
  have "X\<^bsub>L\<^esub> = [ indexed_const \<one>, indexed_const \<zero> ]" and "X\<^bsub>L\<^esub> \<in> carrier (poly_ring L)"
    using ring_hom_one[OF assms(1)] hyps(4) L.var_closed(1) L.carrier_is_subring unfolding var_def by auto
  thus "(eval_pmod q) X\<^bsub>L\<^esub> = \<X>\<^bsub>i\<^esub>"
    using L.pmod_const(2)[OF L.carrier_is_subfield _ assms(2), of "X\<^bsub>L\<^esub>"] assms(3)
    by (auto simp add: indexed_pmult_def indexed_padd_def indexed_const_def indexed_var_def)
  with \<open>X\<^bsub>L\<^esub> \<in> carrier (poly_ring L)\<close> show "\<X>\<^bsub>i\<^esub> \<in> carrier (image_poly q)"
    using image_iff unfolding image_ring_carrier by fastforce
qed

lemma image_poly_eval_indexed_var:
  assumes "indexed_const \<in> ring_hom R L"
    and "q \<in> carrier (poly_ring L)" and "degree q > 1" and "pirreducible\<^bsub>L\<^esub> (carrier L) q"
  shows "(ring.eval (image_poly q)) q \<X>\<^bsub>i\<^esub> = \<zero>\<^bsub>image_poly q\<^esub>"
proof -
  let ?surj = "L.rupture_surj (carrier L) q"
  let ?Rupt = "Rupt\<^bsub>L\<^esub> (carrier L) q"
  let ?f = "eval_pmod q"

  interpret UP: ring "poly_ring L"
    using L.univ_poly_is_ring[OF L.carrier_is_subring] .
  from \<open>pirreducible\<^bsub>L\<^esub> (carrier L) q\<close> interpret Rupt: field ?Rupt
    using L.rupture_is_field_iff_pirreducible[OF L.carrier_is_subfield assms(2)] by simp

  have weak_morphism: "weak_ring_morphism ?f (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
    using indexed_eval_is_weak_ring_morphism[OF assms(2)] .
  then interpret I: ideal "PIdl\<^bsub>poly_ring L\<^esub> q" "poly_ring L"
    using weak_ring_morphism.axioms(1) by auto
  interpret Hom: ring_hom_ring ?Rupt "image_poly q" "\<lambda>x. the_elem (?f ` x)"
    using ring_hom_ring.intro[OF I.quotient_is_ring UP.image_ring_is_ring[OF weak_morphism]]
          UP.weak_ring_morphism_is_iso[OF weak_morphism]
    unfolding ring_iso_def symmetric[OF ring_hom_ring_axioms_def] rupture_def
    by auto

  have "set q \<subseteq> carrier L" and lc: "q \<noteq> [] \<Longrightarrow> lead_coeff q \<in> carrier L - { \<zero>\<^bsub>L\<^esub> }"
    using assms(2) unfolding sym[OF univ_poly_carrier] polynomial_def by auto

  have map_surj: "set (map (?surj \<circ> L.poly_of_const) q) \<subseteq> carrier ?Rupt"
  proof -
    have "L.poly_of_const a \<in> carrier (poly_ring L)" if "a \<in> carrier L" for a
      using that L.normalize_gives_polynomial[of "[ a ]"]
      unfolding univ_poly_carrier ring.poly_of_const_def[OF L.ring_axioms] by simp
    hence "(?surj \<circ> L.poly_of_const) a \<in> carrier ?Rupt" if "a \<in> carrier L" for a
      using ring_hom_memE(1)[OF L.rupture_surj_hom(1)[OF L.carrier_is_subring assms(2)]] that by simp
    with \<open>set q \<subseteq> carrier L\<close> show ?thesis
      by (induct q) (auto)
  qed

  have "?surj X\<^bsub>L\<^esub> \<in> carrier ?Rupt"
    using ring_hom_memE(1)[OF L.rupture_surj_hom(1)[OF _ assms(2)] L.var_closed(1)] L.carrier_is_subring by simp
  moreover have "map (\<lambda>x. the_elem (?f ` x)) (map (?surj \<circ> L.poly_of_const) q) = q"
  proof -
    define g where "g = (?surj \<circ> L.poly_of_const)"
    define f where "f = (\<lambda>x. the_elem (?f ` x))"

    have "the_elem (?f ` ((?surj \<circ> L.poly_of_const) a)) = ((eval_pmod q) \<circ> L.poly_of_const) a"
      if "a \<in> carrier L" for a
      using that L.normalize_gives_polynomial[of "[ a ]"] UP.weak_ring_morphism_range[OF weak_morphism]
      unfolding univ_poly_carrier ring.poly_of_const_def[OF L.ring_axioms] by auto
    hence "the_elem (?f ` ((?surj \<circ> L.poly_of_const) a)) = a" if "a \<in> carrier L" for a
      using eval_norm_eq_id[OF assms(2)] that assms(3) by simp
    hence "f (g a) = a" if "a \<in> carrier L" for a
      using that unfolding f_def g_def by simp
    with \<open>set q \<subseteq> carrier L\<close> have "map f (map g q) = q"
      by (induct q) (auto)
    thus ?thesis
      unfolding f_def g_def by simp
  qed
  moreover have "(\<lambda>x. the_elem (?f ` x)) (?surj X\<^bsub>L\<^esub>) = \<X>\<^bsub>i\<^esub>"
    using UP.weak_ring_morphism_range[OF weak_morphism L.var_closed(1)[OF L.carrier_is_subring]]
    unfolding eval_pmod_var(1)[OF assms(1-3)] by simp
  ultimately have "Hom.S.eval q \<X>\<^bsub>i\<^esub> = (\<lambda>x. the_elem (?f ` x)) (Rupt.eval (map (?surj \<circ> L.poly_of_const) q) (?surj X\<^bsub>L\<^esub>))"
    using Hom.eval_hom'[OF _ map_surj] by auto
  moreover have "\<zero>\<^bsub>?Rupt\<^esub> = ?surj \<zero>\<^bsub>poly_ring L\<^esub>"
    unfolding rupture_def FactRing_def by (simp add: I.a_rcos_const)
  hence "the_elem (?f ` \<zero>\<^bsub>?Rupt\<^esub>) = \<zero>\<^bsub>image_poly q\<^esub>"
    using UP.weak_ring_morphism_range[OF weak_morphism UP.zero_closed]
    unfolding image_ring_zero by simp
  hence "(\<lambda>x. the_elem (?f ` x)) (Rupt.eval (map (?surj \<circ> L.poly_of_const) q) (?surj X\<^bsub>L\<^esub>)) = \<zero>\<^bsub>image_poly q\<^esub>"
    using L.polynomial_rupture[OF L.carrier_is_subring assms(2)] by simp
  ultimately show ?thesis
    by simp
qed

end (* of fixed L context. *)

end (* of ring context. *)

end


(* -------------------------------------------------------------------------- *)
subsection \<open>Library Additions for Complex Numbers\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Some additional lemmas about complex numbers.\<close>

theory More_Complex
  imports Complex_Main More_Transcendental Canonical_Angle
begin

text \<open>Conjugation and @{term cis}\<close>

declare cis_cnj[simp]

lemmas complex_cnj = complex_cnj_diff complex_cnj_mult complex_cnj_add complex_cnj_divide complex_cnj_minus

text \<open>Some properties for @{term complex_of_real}. Also, since it is often used in our
formalization we abbreviate it to @{term cor}.\<close>

abbreviation cor :: "real \<Rightarrow> complex" where
  "cor \<equiv> complex_of_real"

lemma cmod_cis [simp]:
  assumes "a \<noteq> 0"
  shows "of_real (cmod a) * cis (Arg a) = a"
  using assms
  by (metis rcis_cmod_Arg rcis_def)

lemma cis_cmod [simp]:
  assumes "a \<noteq> 0"
  shows "cis (Arg a) * of_real (cmod a) = a"
  by (metis assms cmod_cis mult.commute)

lemma cor_squared:
  shows "(cor x)\<^sup>2 = cor (x\<^sup>2)"
  by (simp add: power2_eq_square)

lemma cor_sqrt_mult_cor_sqrt [simp]:
  shows "cor (sqrt A) * cor (sqrt A) = cor \<bar>A\<bar>"
  by (metis of_real_mult real_sqrt_mult_self)

lemma cor_eq_0: "cor x + \<i> * cor y = 0 \<longleftrightarrow> x = 0 \<and> y = 0"
 by (metis Complex_eq Im_complex_of_real Im_i_times Re_complex_of_real add_cancel_left_left of_real_eq_0_iff plus_complex.sel(2) zero_complex.code)

lemma one_plus_square_neq_zero [simp]:
  shows "1 + (cor x)\<^sup>2 \<noteq> 0"
  by (metis (opaque_lifting, no_types) of_real_1 of_real_add of_real_eq_0_iff of_real_power power_one sum_power2_eq_zero_iff zero_neq_one)

text \<open>Additional lemmas about @{term Complex} constructor. Following newer versions of Isabelle,
these should be deprecated.\<close>

lemma complex_real_two [simp]:
  shows "Complex 2 0 = 2"
  by (simp add: Complex_eq)

lemma complex_double [simp]:
  shows "(Complex a b) * 2 = Complex (2*a) (2*b)"
  by (simp add: Complex_eq)

lemma complex_half [simp]:
  shows "(Complex a b) / 2 = Complex (a/2) (b/2)"
  by (subst complex_eq_iff) auto

lemma Complex_scale1:
  shows "Complex (a * b) (a * c) = cor a * Complex b c"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_scale2:
  shows "Complex (a * c) (b * c) = Complex a b * cor c"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_scale3:
  shows "Complex (a / b) (a / c) = cor a * Complex (1 / b) (1 / c)"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_Re_express_cnj:
  shows "Complex (Re z) 0 = (z + cnj z) / 2"
  by (cases z) (simp add: Complex_eq)

lemma Complex_Im_express_cnj:
  shows "Complex 0 (Im z) = (z - cnj z)/2"
  by (cases z) (simp add: Complex_eq)

text \<open>Additional properties of @{term cmod}.\<close>

lemma complex_mult_cnj_cmod:
  shows "z * cnj z = cor ((cmod z)\<^sup>2)"
  using complex_norm_square
  by auto

lemma cmod_square:
  shows "(cmod z)\<^sup>2 = Re (z * cnj z)"
  using complex_mult_cnj_cmod[of z]
  by (simp add: power2_eq_square)

lemma cor_cmod_power_4 [simp]:
  shows "cor (cmod z) ^ 4 = (z * cnj z)\<^sup>2"
  by (simp add: complex_mult_cnj_cmod)

lemma cnjE:
  assumes "x \<noteq> 0"
  shows "cnj x = cor ((cmod x)\<^sup>2) / x"
  using complex_mult_cnj_cmod[of x] assms
  by (auto simp add: field_simps)

lemma cmod_cor_divide [simp]:
  shows "cmod (z / cor k) = cmod z / \<bar>k\<bar>"
  by (simp add: norm_divide)

lemma cmod_mult_minus_left_distrib [simp]:
  shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)"
  by (metis norm_mult right_diff_distrib)

lemma cmod_eqI:
  assumes "z1 * cnj z1 = z2 * cnj z2"
  shows "cmod z1 = cmod z2"
  using assms
  by (subst complex_mod_sqrt_Re_mult_cnj)+ auto

lemma cmod_eq_one [simp]:
  shows "cmod a = 1 \<longleftrightarrow> a*cnj a = 1"
  by (metis cmod_eqE cmod_eqI complex_cnj_one monoid_mult_class.mult.left_neutral norm_one)

text \<open>We introduce @{term is_real} (the imaginary part of complex number is zero) and @{term is_imag}
(real part of complex number is zero) operators and prove some of their properties.\<close>

abbreviation is_real where
  "is_real z \<equiv> Im z = 0"

abbreviation is_imag where
  "is_imag z \<equiv> Re z = 0"

lemma complex_eq_if_Re_eq:
  assumes "is_real z1" and "is_real z2"
  shows "z1 = z2 \<longleftrightarrow> Re z1 = Re z2"
  using assms
  by (cases z1, cases z2) auto

lemma mult_reals [simp]:
  assumes "is_real a" and "is_real b"
  shows "is_real (a * b)"
  using assms
  by auto

lemma div_reals [simp]:
  assumes "is_real a" and "is_real b"
  shows "is_real (a / b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma complex_of_real_Re [simp]:
  assumes "is_real k"
  shows "cor (Re k) = k"
  using assms
  by (cases k) (auto simp add: complex_of_real_def)

lemma cor_cmod_real:
  assumes "is_real a"
  shows "cor (cmod a) = a \<or> cor (cmod a) = -a"
  using assms
  unfolding cmod_def
  by (cases "Re a > 0") auto

lemma eq_cnj_iff_real:
  shows "cnj z = z \<longleftrightarrow> is_real z"
  by (cases z) (simp add: Complex_eq)

lemma eq_minus_cnj_iff_imag:
  shows "cnj z = -z \<longleftrightarrow> is_imag z"
  by (cases z) (simp add: Complex_eq)

lemma Re_divide_real:
  assumes "is_real b" and "b \<noteq> 0"
  shows "Re (a / b) = (Re a) / (Re b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma Re_mult_real:
  assumes "is_real a"
  shows "Re (a * b) = (Re a) * (Re b)"
  using assms
  by simp

lemma Im_mult_real:
  assumes "is_real a"
  shows "Im (a * b) = (Re a) * (Im b)"
  using assms
  by simp

lemma Im_divide_real:
  assumes "is_real b" and "b \<noteq> 0"
  shows "Im (a / b) = (Im a) / (Re b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma is_real_div:
  assumes "b \<noteq> 0"
  shows "is_real (a / b) \<longleftrightarrow> a*cnj b = b*cnj a"
  using assms
  by (metis complex_cnj_divide complex_cnj_zero_iff eq_cnj_iff_real frac_eq_eq mult.commute)

lemma is_real_mult_real:
  assumes "is_real a" and "a \<noteq> 0"
  shows "is_real b \<longleftrightarrow> is_real (a * b)"
  using assms
  by (cases a, auto simp add: Complex_eq)

lemma Im_express_cnj:
  shows "Im z = (z - cnj z) / (2 * \<i>)"
  by (simp add: complex_diff_cnj field_simps)

lemma Re_express_cnj:
  shows "Re z = (z + cnj z) / 2"
  by (simp add: complex_add_cnj)

text \<open>Rotation of complex number for 90 degrees in the positive direction.\<close>

abbreviation rot90 where
  "rot90 z \<equiv> Complex (-Im z) (Re z)"

lemma rot90_ii:
  shows "rot90 z = z * \<i>"
  by (metis Complex_mult_i complex_surj)

text \<open>With @{term cnj_mix} we introduce scalar product between complex vectors. This operation shows
to be useful to succinctly express some conditions.\<close>

abbreviation cnj_mix where
  "cnj_mix z1 z2 \<equiv> cnj z1 * z2 + z1 * cnj z2"

abbreviation scalprod where
  "scalprod z1 z2 \<equiv> cnj_mix z1 z2 / 2"

lemma cnj_mix_minus:
  shows "cnj z1*z2 - z1*cnj z2 = \<i> * cnj_mix (rot90 z1) z2"
  by (cases z1, cases z2) (simp add: Complex_eq field_simps)

lemma cnj_mix_minus':
  shows "cnj z1*z2 - z1*cnj z2 = rot90 (cnj_mix (rot90 z1) z2)"
  by (cases z1, cases z2) (simp add: Complex_eq field_simps)

lemma cnj_mix_real [simp]:
  shows "is_real (cnj_mix z1 z2)"
  by (cases z1, cases z2) simp

lemma scalprod_real [simp]:
  shows "is_real (scalprod z1 z2)"
  using cnj_mix_real
  by simp

text \<open>Additional properties of @{term cis} function.\<close>

lemma cis_minus_pi2 [simp]:
  shows "cis (-pi/2) = -\<i>"
  by (simp add: cis_inverse[symmetric])

lemma cis_pi2_minus_x [simp]:
  shows "cis (pi/2 - x) = \<i> * cis(-x)"
  using cis_divide[of "pi/2" x, symmetric]
  using cis_divide[of 0 x, symmetric]
  by simp

lemma cis_pm_pi [simp]:
  shows "cis (x - pi) = - cis x" and  "cis (x + pi) = - cis x"
  by (simp add: cis.ctr complex_minus)+

lemma cis_times_cis_opposite [simp]:
  shows "cis \<phi> * cis (- \<phi>) = 1"
  by (simp add: cis_mult)

text \<open>@{term cis} repeats only after $2k\pi$\<close>
lemma cis_eq:
  assumes "cis a = cis b"
  shows "\<exists> k::int. a - b = 2 * k * pi"
  using assms sin_cos_eq[of a b]
  using cis.sel[of a] cis.sel[of b]
  by (cases "cis a", cases "cis b") auto

text \<open>@{term cis} is injective on $(-\pi, \pi]$.\<close>
lemma cis_inj:
  assumes "-pi < \<alpha>" and "\<alpha> \<le> pi" and "-pi < \<alpha>'" and "\<alpha>' \<le> pi"
  assumes "cis \<alpha> = cis \<alpha>'"
  shows "\<alpha> = \<alpha>'"
  using assms
  by (metis cis_Arg_unique sgn_cis)

text \<open>@{term cis} of an angle combined with @{term cis} of the opposite angle\<close>

lemma cis_diff_cis_opposite [simp]:
  shows "cis \<phi> - cis (- \<phi>) = 2 * \<i> * sin \<phi>"
  using Im_express_cnj[of "cis \<phi>"]
  by simp

lemma cis_opposite_diff_cis [simp]:
  shows "cis (-\<phi>) - cis (\<phi>) = - 2 * \<i> * sin \<phi>"
  using cis_diff_cis_opposite[of "-\<phi>"]
  by simp

lemma cis_add_cis_opposite [simp]:
  shows "cis \<phi> + cis (-\<phi>) = 2 * cos \<phi>"
  by (metis cis.sel(1) cis_cnj complex_add_cnj)

text \<open>@{term cis} equal to 1 or -1\<close>
lemma cis_one [simp]:
  assumes "sin \<phi> = 0" and "cos \<phi> = 1"
  shows "cis \<phi> = 1"
  using assms
  by (auto simp add: cis.ctr one_complex.code)

lemma cis_minus_one [simp]:
  assumes "sin \<phi> = 0" and "cos \<phi> = -1"
  shows "cis \<phi> = -1"
  using assms
  by (auto simp add: cis.ctr Complex_eq_neg_1)

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Additional properties of complex number argument\<close>
(* -------------------------------------------------------------------------- *)

text \<open>@{term Arg} of real numbers\<close>

lemma is_real_arg1:
  assumes "Arg z = 0 \<or> Arg z = pi"
  shows "is_real z"
  using assms
  using rcis_cmod_Arg[of z] Im_rcis[of "cmod z" "Arg z"]
  by auto

lemma is_real_arg2:
  assumes "is_real z"
  shows "Arg z = 0 \<or> Arg z = pi"
proof (cases "z = 0")
  case False
  thus ?thesis
    using Arg_bounded[of z]
    by (smt (verit, best) Im_sgn assms cis.simps(2) cis_Arg div_0 sin_zero_pi_iff)
qed (auto simp add: Arg_zero)

lemma arg_complex_of_real_positive [simp]:
  assumes "k > 0"
  shows "Arg (cor k) = 0"
proof-
  have "cos (Arg (Complex k 0)) > 0"
    using assms
    using rcis_cmod_Arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "Arg (Complex k 0)"]
    using cmod_eq_Re by force
  thus ?thesis
    using assms is_real_arg2[of "cor k"]
    unfolding complex_of_real_def
    by auto
qed

lemma arg_complex_of_real_negative [simp]:
  assumes "k < 0"
  shows "Arg (cor k) = pi"
proof-
  have "cos (Arg (Complex k 0)) < 0"
    using \<open>k < 0\<close> rcis_cmod_Arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "Arg (Complex k 0)"]
    by (metis complex.sel(1) mult_less_0_iff norm_not_less_zero)
  thus ?thesis
    using assms is_real_arg2[of "cor k"]
    unfolding complex_of_real_def
    by auto
qed

lemma arg_0_iff:
  shows "z \<noteq> 0 \<and> Arg z = 0 \<longleftrightarrow> is_real z \<and> Re z > 0"
  by (smt arg_complex_of_real_negative arg_complex_of_real_positive Arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)

lemma arg_pi_iff:
  shows "Arg z = pi \<longleftrightarrow> is_real z \<and> Re z < 0"
  by (smt arg_complex_of_real_negative arg_complex_of_real_positive Arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)

text \<open>@{term Arg} of imaginary numbers\<close>

lemma is_imag_arg1:
  assumes "Arg z = pi/2 \<or> Arg z = -pi/2"
  shows "is_imag z"
  using assms
  using rcis_cmod_Arg[of z] Re_rcis[of "cmod z" "Arg z"]
  by (metis cos_minus cos_pi_half minus_divide_left mult_eq_0_iff)

lemma is_imag_arg2:
  assumes "is_imag z" and "z \<noteq> 0"
  shows "Arg z = pi/2 \<or> Arg z = -pi/2"
  using Arg_bounded assms cos_0_iff_canon cos_Arg_i_mult_zero by presburger

lemma arg_complex_of_real_times_i_positive [simp]:
  assumes "k > 0"
  shows "Arg (cor k * \<i>) = pi / 2"
proof-
  have "sin (Arg (Complex 0 k)) > 0"
    using \<open>k > 0\<close> rcis_cmod_Arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "Arg (Complex 0 k)"]
    by (smt complex.sel(2) mult_nonneg_nonpos norm_ge_zero)
  thus ?thesis
    using assms is_imag_arg2[of "cor k * \<i>"]
    using Arg_zero complex_of_real_i
    by force
qed

lemma arg_complex_of_real_times_i_negative [simp]:
  assumes "k < 0"
  shows "Arg (cor k * \<i>) = - pi / 2"
proof-
  have "sin (Arg (Complex 0 k)) < 0"
    using \<open>k < 0\<close> rcis_cmod_Arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "Arg (Complex 0 k)"]
    by (metis complex.sel(2) mult_less_0_iff norm_not_less_zero)
  thus ?thesis
    using assms is_imag_arg2[of "cor k * \<i>"]
    using Arg_zero complex_of_real_i[of k]
    by (smt complex.sel(1) sin_pi_half sin_zero)
qed

lemma arg_pi2_iff:
  shows "z \<noteq> 0 \<and> Arg z = pi / 2 \<longleftrightarrow> is_imag z \<and> Im z > 0"
  by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_Arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff)

lemma arg_minus_pi2_iff:
  shows "z \<noteq> 0 \<and> Arg z = - pi / 2 \<longleftrightarrow> is_imag z \<and> Im z < 0"
  by (smt arg_pi2_iff complex.expand divide_cancel_right pi_neq_zero is_imag_arg1 is_imag_arg2 zero_complex.simps(1) zero_complex.simps(2))

text \<open>Argument is a canonical angle\<close>

lemma canon_ang_arg:
  shows "\<downharpoonright>Arg z\<downharpoonleft> = Arg z"
  using canon_ang_id[of "Arg z"] Arg_bounded
  by simp

lemma arg_cis:
  shows "Arg (cis \<phi>) = \<downharpoonright>\<phi>\<downharpoonleft>"
  using cis_Arg_unique canon_ang canon_ang_cos canon_ang_sin cis.ctr sgn_cis by presburger

text \<open>Cosine and sine of @{term Arg}\<close>

lemma cos_arg:
  assumes "z \<noteq> 0"
  shows "cos (Arg z) = Re z / cmod z"
  by (metis Complex.Re_sgn cis.simps(1) assms cis_Arg)

lemma sin_arg:
  assumes "z \<noteq> 0"
  shows "sin (Arg z) = Im z / cmod z"
  by (metis Complex.Im_sgn cis.simps(2) assms cis_Arg)

text \<open>Argument of product\<close>

lemma cis_arg_mult:
  assumes "z1 * z2 \<noteq> 0"
  shows "cis (Arg (z1 * z2)) = cis (Arg z1 + Arg z2)"
  by (metis assms cis_Arg cis_mult mult_eq_0_iff sgn_mult)

lemma arg_mult_2kpi:
  assumes "z1 * z2 \<noteq> 0"
  shows "\<exists> k::int. Arg (z1 * z2) = Arg z1 + Arg z2 + 2*k*pi"
proof-
  have "cis (Arg (z1*z2)) = cis (Arg z1 + Arg z2)"
    by (rule cis_arg_mult[OF assms])
  thus ?thesis
    using cis_eq[of "Arg (z1*z2)" "Arg z1 + Arg z2"]
    by (auto simp add: field_simps)
qed

lemma arg_mult:
  assumes "z1 * z2 \<noteq> 0"
  shows "Arg(z1 * z2) = \<downharpoonright>Arg z1 + Arg z2\<downharpoonleft>"
proof-
  obtain k::int where "Arg(z1 * z2) = Arg z1 + Arg z2 + 2*k*pi"
    using arg_mult_2kpi[of z1 z2]
    using assms
    by auto
  hence "\<downharpoonright>Arg(z1 * z2)\<downharpoonleft> = \<downharpoonright>Arg z1 + Arg z2\<downharpoonleft>"
    using canon_ang_eq
    by(simp add:field_simps)
  thus ?thesis
    using canon_ang_arg[of "z1*z2"]
    by auto
qed

lemma arg_mult_real_positive [simp]:
  assumes "k > 0"
  shows "Arg (cor k * z) = Arg z"
proof (cases "z = 0")
  case False
  thus ?thesis
    using arg_mult assms canon_ang_arg by force
qed (auto simp: Arg_zero)

lemma arg_mult_real_negative [simp]:
  assumes "k < 0"
  shows "Arg (cor k * z) = Arg (-z)"
proof (cases "z = 0")
  case False
  thus ?thesis
    using assms
    by (metis arg_mult_real_positive minus_mult_commute neg_0_less_iff_less of_real_minus minus_minus)
qed (auto simp: Arg_zero)

lemma arg_div_real_positive [simp]:
  assumes "k > 0"
  shows "Arg (z / cor k) = Arg z"
proof(cases "z = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    using assms
    using arg_mult_real_positive[of "1/k" z]
    by auto
qed

lemma arg_div_real_negative [simp]:
  assumes "k < 0"
  shows "Arg (z / cor k) = Arg (-z)"
proof(cases "z = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    using assms
    using arg_mult_real_negative[of "1/k" z]
    by auto
qed

lemma arg_mult_eq:
  assumes "z * z1 \<noteq> 0" and "z * z2 \<noteq> 0"
  assumes "Arg (z * z1) = Arg (z * z2)"
  shows "Arg z1 = Arg z2"
  by (metis (no_types, lifting) arg_cis assms canon_ang_arg cis_Arg mult_eq_0_iff nonzero_mult_div_cancel_left sgn_divide)

text \<open>Argument of conjugate\<close>

lemma arg_cnj_pi:
  assumes "Arg z = pi"
  shows "Arg (cnj z) = pi"
  using arg_pi_iff assms by auto

lemma arg_cnj_not_pi:
  assumes "Arg z \<noteq> pi"
  shows "Arg (cnj z) = -Arg z"
proof(cases "Arg z = 0")
  case True
  thus ?thesis
    using eq_cnj_iff_real[of z] is_real_arg1[of z] by force
next
  case False
  have "Arg (cnj z) = Arg z \<or> Arg(cnj z) = -Arg z"
    using Arg_bounded[of z] Arg_bounded[of "cnj z"]
    by (smt (verit, best) arccos_cos arccos_cos2 cnj.sel(1) complex_cnj_zero_iff complex_mod_cnj cos_arg)
  moreover
  have "Arg (cnj z) \<noteq> Arg z"
    using sin_0_iff_canon[of "Arg (cnj z)"] Arg_bounded False assms
    by (metis complex_mod_cnj eq_cnj_iff_real is_real_arg2 rcis_cmod_Arg)
  ultimately
  show ?thesis
    by auto
qed

text \<open>Argument of reciprocal\<close>

lemma arg_inv_not_pi:
  assumes "z \<noteq> 0" and "Arg z \<noteq> pi"
  shows "Arg (1 / z) = - Arg z"
proof-
  have "1/z = cnj z / cor ((cmod z)\<^sup>2 )"
    using \<open>z \<noteq> 0\<close> complex_mult_cnj_cmod[of z]
    by (auto simp add:field_simps)
  thus ?thesis
    using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \<open>z \<noteq> 0\<close>
    using arg_cnj_not_pi[of z] \<open>Arg z \<noteq> pi\<close>
    by auto
qed

lemma arg_inv_pi:
  assumes "z \<noteq> 0" and "Arg z = pi"
  shows "Arg (1 / z) = pi"
proof-
  have "1/z = cnj z / cor ((cmod z)\<^sup>2 )"
    using \<open>z \<noteq> 0\<close> complex_mult_cnj_cmod[of z]
    by (auto simp add:field_simps)
  thus ?thesis
    using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \<open>z \<noteq> 0\<close>
    using arg_cnj_pi[of z] \<open>Arg z = pi\<close>
    by auto
qed

lemma arg_inv_2kpi:
  assumes "z \<noteq> 0"
  shows "\<exists> k::int. Arg (1 / z) = - Arg z + 2*k*pi"
  using arg_inv_pi[OF assms]
  using arg_inv_not_pi[OF assms]
  by (cases "Arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp)

lemma arg_inv:
  assumes "z \<noteq> 0"
  shows "Arg (1 / z) = \<downharpoonright>- Arg z\<downharpoonleft>"
  by (metis arg_inv_not_pi arg_inv_pi assms canon_ang_arg canon_ang_uminus_pi)

text \<open>Argument of quotient\<close>

lemma arg_div_2kpi:
  assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
  shows "\<exists> k::int. Arg (z1 / z2) = Arg z1 - Arg z2 + 2*k*pi"
proof-
  obtain x1 where "Arg (z1 * (1 / z2)) = Arg z1 + Arg (1 / z2) + 2 * real_of_int x1 * pi"
    using assms arg_mult_2kpi[of z1 "1/z2"]
    by auto
  moreover
  obtain x2 where "Arg (1 / z2) = - Arg z2 + 2 * real_of_int x2 * pi"
    using assms arg_inv_2kpi[of z2]
    by auto
  ultimately
  show ?thesis
    by (rule_tac x="x1 + x2" in exI, simp add: field_simps)
qed

lemma arg_div:
  assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
  shows "Arg(z1 / z2) = \<downharpoonright>Arg z1 - Arg z2\<downharpoonleft>"
proof-
  obtain k::int where "Arg(z1 / z2) = Arg z1 - Arg z2 + 2*k*pi"
    using arg_div_2kpi[of z1 z2]
    using assms
    by auto
  hence "canon_ang(Arg(z1 / z2)) = canon_ang(Arg z1 - Arg z2)"
    using canon_ang_eq
    by(simp add:field_simps)
  thus ?thesis
    using canon_ang_arg[of "z1/z2"]
    by auto
qed

text \<open>Argument of opposite\<close>

lemma arg_uminus:
  assumes "z \<noteq> 0"
  shows "Arg (-z) = \<downharpoonright>Arg z + pi\<downharpoonleft>"
  using assms
  using arg_mult[of "-1" z]
  using arg_complex_of_real_negative[of "-1"]
  by (auto simp add: field_simps)

lemma arg_uminus_opposite_sign:
  assumes "z \<noteq> 0"
  shows "Arg z > 0 \<longleftrightarrow> \<not> Arg (-z) > 0"
proof (cases "Arg z = 0")
  case True
  thus ?thesis
    using assms
    by (simp add: arg_uminus)
next
  case False
  show ?thesis
  proof (cases "Arg z > 0")
    case True
    thus ?thesis
      using assms
      using Arg_bounded[of z]
      using canon_ang_plus_pi1[of "Arg z"]
      by (simp add: arg_uminus)
  next
    case False
    thus ?thesis
      using \<open>Arg z \<noteq> 0\<close>
      using assms
      using Arg_bounded[of z]
      using canon_ang_plus_pi2[of "Arg z"]
      by (simp add: arg_uminus)
  qed
qed

text \<open>Sign of argument is the same as the sign of the Imaginary part\<close>

lemma arg_Im_sgn:
  assumes "\<not> is_real z"
  shows "sgn (Arg z) = sgn (Im z)"
proof-
  have "z \<noteq> 0"
    using assms
    by auto
  then obtain r \<phi> where polar: "z = cor r * cis \<phi>" "\<phi> = Arg z" "r > 0"
    by (smt cmod_cis mult_eq_0_iff norm_ge_zero of_real_0)
  hence "Im z = r * sin \<phi>"
    by (metis Im_mult_real Re_complex_of_real cis.simps(2) Im_complex_of_real)
  hence  "Im z > 0 \<longleftrightarrow> sin \<phi> > 0" "Im z < 0 \<longleftrightarrow> sin \<phi> < 0"
    using \<open>r > 0\<close>
    using mult_pos_pos mult_nonneg_nonneg zero_less_mult_pos mult_less_cancel_left
    by smt+
  moreover
  have "\<phi> \<noteq> pi" "\<phi> \<noteq> 0"
    using \<open>\<not> is_real z\<close> polar cis_pi
    by force+
  hence "sin \<phi> > 0 \<longleftrightarrow> \<phi> > 0" "\<phi> < 0 \<longleftrightarrow> sin \<phi> < 0"
    using \<open>\<phi> = Arg z\<close> \<open>\<phi> \<noteq> 0\<close> \<open>\<phi> \<noteq> pi\<close>
    using Arg_bounded[of z]
    by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
  ultimately
  show ?thesis
    using \<open>\<phi> = Arg z\<close>
    by auto
qed

subsubsection \<open>Complex square root\<close>

definition
  "ccsqrt z = rcis (sqrt (cmod z)) (Arg z / 2)"

lemma square_ccsqrt [simp]:
  shows "(ccsqrt x)\<^sup>2 = x"
  unfolding ccsqrt_def
  by (subst DeMoivre2) (simp add: rcis_cmod_Arg)

lemma ex_complex_sqrt:
  shows "\<exists> s::complex. s*s = z"
  unfolding power2_eq_square[symmetric]
  by (rule_tac x="csqrt z" in exI) simp

lemma ccsqrt:
  assumes "s * s = z"
  shows "s = ccsqrt z \<or> s = -ccsqrt z"
proof (cases "s = 0")
  case True
  thus ?thesis
    using assms
    unfolding ccsqrt_def
    by simp
next
  case False
  then obtain k::int where "cmod s * cmod s = cmod z" "2 * Arg s - Arg z = 2*k*pi"
    using assms
    using rcis_cmod_Arg[of z] rcis_cmod_Arg[of s]
    using arg_mult[of s s]
    using canon_ang(3)[of "2*Arg s"]
    by (auto simp add: norm_mult arg_mult)
  have *: "sqrt (cmod z) = cmod s"
    using \<open>cmod s * cmod s = cmod z\<close>
    by (smt norm_not_less_zero real_sqrt_abs2)

  have **: "Arg z / 2 = Arg s - k*pi"
    using \<open>2 * Arg s - Arg z = 2*k*pi\<close>
    by simp

  have "cis (Arg s - k*pi) = cis (Arg s) \<or> cis (Arg s - k*pi) = -cis (Arg s)"
  proof (cases "even k")
    case True
    hence "cis (Arg s - k*pi) = cis (Arg s)"
      by (simp add: cis_def complex.corec cos_diff sin_diff)
    thus ?thesis
      by simp
  next
    case False
    hence "cis (Arg s - k*pi) = -cis (Arg s)"
      by (simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
    thus ?thesis
      by simp
  qed
  thus ?thesis
  proof
    assume ***: "cis (Arg s - k * pi) = cis (Arg s)"
    hence "s = ccsqrt z"
      using rcis_cmod_Arg[of s]
      unfolding ccsqrt_def rcis_def
      by (subst *, subst **, subst ***, simp)
    thus ?thesis
      by simp
  next
    assume ***: "cis (Arg s - k * pi) = -cis (Arg s)"
    hence "s = - ccsqrt z"
      using rcis_cmod_Arg[of s]
      unfolding ccsqrt_def rcis_def
      by (subst *, subst **, subst ***, simp)
    thus ?thesis
      by simp
  qed
qed

lemma null_ccsqrt [simp]:
  shows "ccsqrt x = 0 \<longleftrightarrow> x = 0"
  unfolding ccsqrt_def
  by auto

lemma ccsqrt_mult:
  shows "ccsqrt (a * b) = ccsqrt a * ccsqrt b \<or>
         ccsqrt (a * b) = - ccsqrt a * ccsqrt b"
proof (cases "a = 0 \<or> b = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  obtain k::int where "Arg a + Arg b - \<downharpoonright>Arg a + Arg b\<downharpoonleft> = 2 * real_of_int k * pi"
    using canon_ang(3)[of "Arg a + Arg b"]
    by auto
  hence *: "\<downharpoonright>Arg a + Arg b\<downharpoonleft> = Arg a + Arg b - 2 * (real_of_int k) * pi"
    by (auto simp add: field_simps)

  have "cis (\<downharpoonright>Arg a + Arg b\<downharpoonleft> / 2) = cis (Arg a / 2 + Arg b / 2) \<or> cis (\<downharpoonright>Arg a + Arg b\<downharpoonleft> / 2) = - cis (Arg a / 2 + Arg b / 2)"
    using cos_even_kpi[of k] cos_odd_kpi[of k]
    by ((subst *)+, (subst diff_divide_distrib)+, (subst add_divide_distrib)+)
       (cases "even k", auto simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
  thus ?thesis
    using False
    unfolding ccsqrt_def
    by (smt (verit, best) arg_mult mult_minus_left mult_minus_right no_zero_divisors norm_mult rcis_def rcis_mult real_sqrt_mult)
qed

lemma csqrt_real:
  assumes "is_real x"
  shows "(Re x \<ge> 0 \<and> ccsqrt x = cor (sqrt (Re x))) \<or>
         (Re x < 0 \<and> ccsqrt x = \<i> * cor (sqrt (- (Re x))))"
proof (cases "x = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  show ?thesis
  proof (cases "Re x > 0")
    case True
    hence "Arg x = 0"
      using \<open>is_real x\<close>
      by (metis arg_complex_of_real_positive complex_of_real_Re)
    thus ?thesis
      using \<open>Re x > 0\<close> \<open>is_real x\<close>
      unfolding ccsqrt_def
      by (simp add: cmod_eq_Re)
  next
    case False
    hence "Re x < 0"
      using \<open>x \<noteq> 0\<close> \<open>is_real x\<close>
      using complex_eq_if_Re_eq by auto
    hence "Arg x = pi"
      using \<open>is_real x\<close>
      by (metis arg_complex_of_real_negative complex_of_real_Re)
    thus ?thesis
      using \<open>Re x < 0\<close> \<open>is_real x\<close>
      unfolding ccsqrt_def rcis_def
      by (simp add: cis_def complex.corec Complex_eq cmod_eq_Re)
  qed
qed

text \<open>Rotation of complex vector to x-axis.\<close>

lemma is_real_rot_to_x_axis:
  assumes "z \<noteq> 0"
  shows "is_real (cis (-Arg z) * z)"
proof (cases "Arg z = pi")
  case True
  thus ?thesis
    using is_real_arg1[of z]
    by auto
next
  case False
  hence "\<downharpoonright>- Arg z\<downharpoonleft> = - Arg z"
    using canon_ang_eqI[of "- Arg z" "-Arg z"]
    using Arg_bounded[of z]
    by (auto simp add: field_simps)
  hence "Arg (cis (- (Arg z)) * z) = 0"
    using arg_mult[of "cis (- (Arg z))" z] \<open>z \<noteq> 0\<close>
    using arg_cis[of "- Arg z"]
    by simp
  thus ?thesis
    using is_real_arg1[of "cis (- Arg z) * z"]
    by auto
qed

lemma positive_rot_to_x_axis:
  assumes "z \<noteq> 0"
  shows "Re (cis (-Arg z) * z) > 0"
  using assms
  by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_Arg rcis_mult rcis_zero_arg zero_less_norm_iff)

text \<open>Inequalities involving @{term cmod}.\<close>

lemma cmod_1_plus_mult_le:
  shows "cmod (1 + z*w) \<le> sqrt((1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2))"
proof-
  have "Re ((1+z*w)*(1+cnj z*cnj w)) \<le> Re (1+z*cnj z)* Re (1+w*cnj w)"
  proof-
    have "Re ((w - cnj z)*cnj(w - cnj z)) \<ge> 0"
      by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
    hence "Re (z*w + cnj z * cnj w) \<le> Re (w*cnj w) + Re(z*cnj z)"
      by (simp add: field_simps)
    thus ?thesis
      by (simp add: field_simps)
  qed
  hence "(cmod (1 + z * w))\<^sup>2 \<le> (1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2)"
    by (subst cmod_square)+ simp
  thus ?thesis
    by (metis abs_norm_cancel real_sqrt_abs real_sqrt_le_iff)
qed

lemma cmod_diff_ge:
  shows "cmod (b - c) \<ge> sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)"
proof-
  have "(cmod (b - c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \<ge> 0"
    by simp
  hence "(cmod (b - c))\<^sup>2 \<ge> - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2"
    by simp
  hence "(cmod (b - c))\<^sup>2 \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) "
    by (auto simp add: power2_eq_square field_simps)
  hence "Re ((b - c)*(cnj b - cnj c)) \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)"
    by (subst (asm) cmod_square) simp
  moreover
  have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
    by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
  moreover
  have "(1 + Re (scalprod b c))\<^sup>2 = 1 + 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)"
    by (subst power2_sum) simp
  hence "(1 + Re (scalprod b c))\<^sup>2 = 1 + Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2"
    by simp
  ultimately
  have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \<ge> (1 + Re (scalprod b c))\<^sup>2"
    by (simp add: field_simps)
  moreover
  have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 0"
    by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
  ultimately
  have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 1 + Re (scalprod b c)"
    by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
  hence "Re ((b - c) * (cnj b - cnj c)) \<ge> 1 + Re (c*cnj c) + 1 + Re (b*cnj b) - 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))"
    by (simp add: field_simps)
  hence *: "(cmod (b - c))\<^sup>2 \<ge> (sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2))\<^sup>2"
    apply (subst cmod_square)+
    apply (subst (asm) cmod_square)+
    apply (subst power2_diff)
    apply (subst real_sqrt_pow2, simp)
    apply (subst real_sqrt_pow2, simp)
    apply (simp add: real_sqrt_mult)
    done
  thus ?thesis
  proof (cases "sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2) > 0")
    case True
    thus ?thesis
      using power2_le_imp_le[OF *]
      by simp
  next
    case False
    hence "0 \<ge> sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)"
      by (metis less_eq_real_def linorder_neqE_linordered_idom)
    moreover
    have "cmod (b - c) \<ge> 0"
      by simp
    ultimately
    show ?thesis
      by (metis add_increasing monoid_add_class.add.right_neutral)
  qed
qed

lemma cmod_diff_le:
  shows "cmod (b - c) \<le> sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2)"
proof-
  have "(cmod (b + c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \<ge> 0"
    by simp
  hence "(cmod (b + c))\<^sup>2 \<ge> - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2"
    by simp
  hence "(cmod (b + c))\<^sup>2 \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) "
    by (auto simp add: power2_eq_square field_simps)
  hence "Re ((b + c)*(cnj b + cnj c)) \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)"
    by (subst (asm) cmod_square) simp
  moreover
  have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
    by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
  moreover
  have ++: "2*Re(scalprod b c) = Re(b*cnj c + c*cnj b)"
    by simp
  have "(1 - Re (scalprod b c))\<^sup>2 = 1 - 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)"
    by (subst power2_diff) simp
  hence "(1 - Re (scalprod b c))\<^sup>2 = 1 - Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2"
    by (subst ++[symmetric]) simp
  ultimately
  have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \<ge> (1 - Re (scalprod b c))\<^sup>2"
    by (simp add: field_simps)
  moreover
  have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 0"
    by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
  ultimately
  have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 1 - Re (scalprod b c)"
    by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
  hence "Re ((b - c) * (cnj b - cnj c)) \<le> 1 + Re (c*cnj c) + 1 + Re (b*cnj b) + 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))"
    by (simp add: field_simps)
  hence *: "(cmod (b - c))\<^sup>2 \<le> (sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2))\<^sup>2"
    apply (subst cmod_square)+
    apply (subst (asm) cmod_square)+
    apply (subst power2_sum)
    apply (subst real_sqrt_pow2, simp)
    apply (subst real_sqrt_pow2, simp)
    apply (simp add: real_sqrt_mult)
    done
  thus ?thesis
    using power2_le_imp_le[OF *]
    by simp
qed

text \<open>Definition of Euclidean distance between two complex numbers.\<close>

definition cdist where
  [simp]: "cdist z1 z2 \<equiv> cmod (z2 - z1)"

text \<open>Misc. properties of complex numbers.\<close>

lemma ex_complex_to_complex [simp]:
  fixes z1 z2 :: complex
  assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
  shows "\<exists>k. k \<noteq> 0 \<and> z2 = k * z1"
  using assms
  by (rule_tac x="z2/z1" in exI) simp

lemma ex_complex_to_one [simp]:
  fixes z::complex
  assumes "z \<noteq> 0"
  shows "\<exists>k. k \<noteq> 0 \<and> k * z = 1"
  using assms
  by (rule_tac x="1/z" in exI) simp

lemma ex_complex_to_complex2 [simp]:
  fixes z::complex
  shows "\<exists>k. k \<noteq> 0 \<and> k * z = z"
  by (rule_tac x="1" in exI) simp

lemma complex_sqrt_1:
  fixes z::complex
  assumes "z \<noteq> 0"
  shows "z = 1 / z \<longleftrightarrow> z = 1 \<or> z = -1"
  using assms
  using nonzero_eq_divide_eq square_eq_iff
  by fastforce

end