(*  Title:      HOL/Library/Lub_Glb.thy
    Author:     Jacques D. Fleuriot, University of Cambridge
    Author:     Amine Chaieb, University of Cambridge *)

section {* Definitions of Least Upper Bounds and Greatest Lower Bounds *}

theory Lub_Glb
imports Complex_Main
begin

text {* Thanks to suggestions by James Margetson *}

definition setle :: "'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"  (infixl "*<=" 70)
  where "S *<= x = (ALL y: S. y \<le> x)"

definition setge :: "'a::ord \<Rightarrow> 'a set \<Rightarrow> bool"  (infixl "<=*" 70)
  where "x <=* S = (ALL y: S. x \<le> y)"

subsection {* Rules for the Relations @{text "*<="} and @{text "<=*"} *}

lemma setleI: "ALL y: S. y \<le> x \<Longrightarrow> S *<= x"
  by (simp add: setle_def)

lemma setleD: "S *<= x \<Longrightarrow> y: S \<Longrightarrow> y \<le> x"
  by (simp add: setle_def)

lemma setgeI: "ALL y: S. x \<le> y \<Longrightarrow> x <=* S"
  by (simp add: setge_def)

lemma setgeD: "x <=* S \<Longrightarrow> y: S \<Longrightarrow> x \<le> y"
  by (simp add: setge_def)

definition leastP :: "('a \<Rightarrow> bool) \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "leastP P x = (P x \<and> x <=* Collect P)"

definition isUb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isUb R S x = (S *<= x \<and> x: R)"

definition isLub :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isLub R S x = leastP (isUb R S) x"

definition ubs :: "'a set \<Rightarrow> 'a::ord set \<Rightarrow> 'a set"
  where "ubs R S = Collect (isUb R S)"

subsection {* Rules about the Operators @{term leastP}, @{term ub} and @{term lub} *}

lemma leastPD1: "leastP P x \<Longrightarrow> P x"
  by (simp add: leastP_def)

lemma leastPD2: "leastP P x \<Longrightarrow> x <=* Collect P"
  by (simp add: leastP_def)

lemma leastPD3: "leastP P x \<Longrightarrow> y: Collect P \<Longrightarrow> x \<le> y"
  by (blast dest!: leastPD2 setgeD)

lemma isLubD1: "isLub R S x \<Longrightarrow> S *<= x"
  by (simp add: isLub_def isUb_def leastP_def)

lemma isLubD1a: "isLub R S x \<Longrightarrow> x: R"
  by (simp add: isLub_def isUb_def leastP_def)

lemma isLub_isUb: "isLub R S x \<Longrightarrow> isUb R S x"
  unfolding isUb_def by (blast dest: isLubD1 isLubD1a)

lemma isLubD2: "isLub R S x \<Longrightarrow> y : S \<Longrightarrow> y \<le> x"
  by (blast dest!: isLubD1 setleD)

lemma isLubD3: "isLub R S x \<Longrightarrow> leastP (isUb R S) x"
  by (simp add: isLub_def)

lemma isLubI1: "leastP(isUb R S) x \<Longrightarrow> isLub R S x"
  by (simp add: isLub_def)

lemma isLubI2: "isUb R S x \<Longrightarrow> x <=* Collect (isUb R S) \<Longrightarrow> isLub R S x"
  by (simp add: isLub_def leastP_def)

lemma isUbD: "isUb R S x \<Longrightarrow> y : S \<Longrightarrow> y \<le> x"
  by (simp add: isUb_def setle_def)

lemma isUbD2: "isUb R S x \<Longrightarrow> S *<= x"
  by (simp add: isUb_def)

lemma isUbD2a: "isUb R S x \<Longrightarrow> x: R"
  by (simp add: isUb_def)

lemma isUbI: "S *<= x \<Longrightarrow> x: R \<Longrightarrow> isUb R S x"
  by (simp add: isUb_def)

lemma isLub_le_isUb: "isLub R S x \<Longrightarrow> isUb R S y \<Longrightarrow> x \<le> y"
  unfolding isLub_def by (blast intro!: leastPD3)

lemma isLub_ubs: "isLub R S x \<Longrightarrow> x <=* ubs R S"
  unfolding ubs_def isLub_def by (rule leastPD2)

lemma isLub_unique: "[| isLub R S x; isLub R S y |] ==> x = (y::'a::linorder)"
  apply (frule isLub_isUb)
  apply (frule_tac x = y in isLub_isUb)
  apply (blast intro!: order_antisym dest!: isLub_le_isUb)
  done

lemma isUb_UNIV_I: "(\<And>y. y \<in> S \<Longrightarrow> y \<le> u) \<Longrightarrow> isUb UNIV S u"
  by (simp add: isUbI setleI)

definition greatestP :: "('a \<Rightarrow> bool) \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "greatestP P x = (P x \<and> Collect P *<=  x)"

definition isLb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isLb R S x = (x <=* S \<and> x: R)"

definition isGlb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isGlb R S x = greatestP (isLb R S) x"

definition lbs :: "'a set \<Rightarrow> 'a::ord set \<Rightarrow> 'a set"
  where "lbs R S = Collect (isLb R S)"

subsection {* Rules about the Operators @{term greatestP}, @{term isLb} and @{term isGlb} *}

lemma greatestPD1: "greatestP P x \<Longrightarrow> P x"
  by (simp add: greatestP_def)

lemma greatestPD2: "greatestP P x \<Longrightarrow> Collect P *<= x"
  by (simp add: greatestP_def)

lemma greatestPD3: "greatestP P x \<Longrightarrow> y: Collect P \<Longrightarrow> x \<ge> y"
  by (blast dest!: greatestPD2 setleD)

lemma isGlbD1: "isGlb R S x \<Longrightarrow> x <=* S"
  by (simp add: isGlb_def isLb_def greatestP_def)

lemma isGlbD1a: "isGlb R S x \<Longrightarrow> x: R"
  by (simp add: isGlb_def isLb_def greatestP_def)

lemma isGlb_isLb: "isGlb R S x \<Longrightarrow> isLb R S x"
  unfolding isLb_def by (blast dest: isGlbD1 isGlbD1a)

lemma isGlbD2: "isGlb R S x \<Longrightarrow> y : S \<Longrightarrow> y \<ge> x"
  by (blast dest!: isGlbD1 setgeD)

lemma isGlbD3: "isGlb R S x \<Longrightarrow> greatestP (isLb R S) x"
  by (simp add: isGlb_def)

lemma isGlbI1: "greatestP (isLb R S) x \<Longrightarrow> isGlb R S x"
  by (simp add: isGlb_def)

lemma isGlbI2: "isLb R S x \<Longrightarrow> Collect (isLb R S) *<= x \<Longrightarrow> isGlb R S x"
  by (simp add: isGlb_def greatestP_def)

lemma isLbD: "isLb R S x \<Longrightarrow> y : S \<Longrightarrow> y \<ge> x"
  by (simp add: isLb_def setge_def)

lemma isLbD2: "isLb R S x \<Longrightarrow> x <=* S "
  by (simp add: isLb_def)

lemma isLbD2a: "isLb R S x \<Longrightarrow> x: R"
  by (simp add: isLb_def)

lemma isLbI: "x <=* S \<Longrightarrow> x: R \<Longrightarrow> isLb R S x"
  by (simp add: isLb_def)

lemma isGlb_le_isLb: "isGlb R S x \<Longrightarrow> isLb R S y \<Longrightarrow> x \<ge> y"
  unfolding isGlb_def by (blast intro!: greatestPD3)

lemma isGlb_ubs: "isGlb R S x \<Longrightarrow> lbs R S *<= x"
  unfolding lbs_def isGlb_def by (rule greatestPD2)

lemma isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::'a::linorder)"
  apply (frule isGlb_isLb)
  apply (frule_tac x = y in isGlb_isLb)
  apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
  done

lemma bdd_above_setle: "bdd_above A \<longleftrightarrow> (\<exists>a. A *<= a)"
  by (auto simp: bdd_above_def setle_def)

lemma bdd_below_setge: "bdd_below A \<longleftrightarrow> (\<exists>a. a <=* A)"
  by (auto simp: bdd_below_def setge_def)

lemma isLub_cSup:
  "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> (\<exists>b. S *<= b) \<Longrightarrow> isLub UNIV S (Sup S)"
  by  (auto simp add: isLub_def setle_def leastP_def isUb_def
            intro!: setgeI cSup_upper cSup_least)

lemma isGlb_cInf:
  "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> (\<exists>b. b <=* S) \<Longrightarrow> isGlb UNIV S (Inf S)"
  by  (auto simp add: isGlb_def setge_def greatestP_def isLb_def
            intro!: setleI cInf_lower cInf_greatest)

lemma cSup_le: "(S::'a::conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> S *<= b \<Longrightarrow> Sup S \<le> b"
  by (metis cSup_least setle_def)

lemma cInf_ge: "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> b <=* S \<Longrightarrow> Inf S \<ge> b"
  by (metis cInf_greatest setge_def)

lemma cSup_bounds:
  fixes S :: "'a :: conditionally_complete_lattice set"
  shows "S \<noteq> {} \<Longrightarrow> a <=* S \<Longrightarrow> S *<= b \<Longrightarrow> a \<le> Sup S \<and> Sup S \<le> b"
  using cSup_least[of S b] cSup_upper2[of _ S a]
  by (auto simp: bdd_above_setle setge_def setle_def)

lemma cSup_unique: "(S::'a :: {conditionally_complete_linorder, no_bot} set) *<= b \<Longrightarrow> (\<forall>b'<b. \<exists>x\<in>S. b' < x) \<Longrightarrow> Sup S = b"
  by (rule cSup_eq) (auto simp: not_le[symmetric] setle_def)

lemma cInf_unique: "b <=* (S::'a :: {conditionally_complete_linorder, no_top} set) \<Longrightarrow> (\<forall>b'>b. \<exists>x\<in>S. b' > x) \<Longrightarrow> Inf S = b"
  by (rule cInf_eq) (auto simp: not_le[symmetric] setge_def)

text{* Use completeness of reals (supremum property) to show that any bounded sequence has a least upper bound*}

lemma reals_complete: "\<exists>X. X \<in> S \<Longrightarrow> \<exists>Y. isUb (UNIV::real set) S Y \<Longrightarrow> \<exists>t. isLub (UNIV :: real set) S t"
  by (intro exI[of _ "Sup S"] isLub_cSup) (auto simp: setle_def isUb_def intro!: cSup_upper)

lemma Bseq_isUb: "\<And>X :: nat \<Rightarrow> real. Bseq X \<Longrightarrow> \<exists>U. isUb (UNIV::real set) {x. \<exists>n. X n = x} U"
  by (auto intro: isUbI setleI simp add: Bseq_def abs_le_iff)

lemma Bseq_isLub: "\<And>X :: nat \<Rightarrow> real. Bseq X \<Longrightarrow> \<exists>U. isLub (UNIV::real set) {x. \<exists>n. X n = x} U"
  by (blast intro: reals_complete Bseq_isUb)

lemma isLub_mono_imp_LIMSEQ:
  fixes X :: "nat \<Rightarrow> real"
  assumes u: "isLub UNIV {x. \<exists>n. X n = x} u" (* FIXME: use 'range X' *)
  assumes X: "\<forall>m n. m \<le> n \<longrightarrow> X m \<le> X n"
  shows "X ----> u"
proof -
  have "X ----> (SUP i. X i)"
    using u[THEN isLubD1] X
    by (intro LIMSEQ_incseq_SUP) (auto simp: incseq_def image_def eq_commute bdd_above_setle)
  also have "(SUP i. X i) = u"
    using isLub_cSup[of "range X"] u[THEN isLubD1]
    by (intro isLub_unique[OF _ u]) (auto simp add: SUP_def image_def eq_commute)
  finally show ?thesis .
qed

lemmas real_isGlb_unique = isGlb_unique[where 'a=real]

lemma real_le_inf_subset: "t \<noteq> {} \<Longrightarrow> t \<subseteq> s \<Longrightarrow> \<exists>b. b <=* s \<Longrightarrow> Inf s \<le> Inf (t::real set)"
  by (rule cInf_superset_mono) (auto simp: bdd_below_setge)

lemma real_ge_sup_subset: "t \<noteq> {} \<Longrightarrow> t \<subseteq> s \<Longrightarrow> \<exists>b. s *<= b \<Longrightarrow> Sup s \<ge> Sup (t::real set)"
  by (rule cSup_subset_mono) (auto simp: bdd_above_setle)

end


section "Arithmetic and Boolean Expressions"

subsection "Arithmetic Expressions"

theory ModifiedAexpForEx4
  imports Main
begin

type_synonym vname = string
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

text_raw\<open>\snip{AExpaexpdef}{2}{1}{%\<close>
datatype aexp = N int | V vname | Plus aexp aexp | Times aexp aexp
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{AExpavaldef}{1}{2}{%\<close>
fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
"aval (N n) s = n" |
"aval (V x) s = s x" |
"aval (Plus a\<^sub>1 a\<^sub>2) s = aval a\<^sub>1 s + aval a\<^sub>2 s" |
"aval (Times a1 a2) s = aval a1 s * aval a2 s"
text_raw\<open>}%endsnip\<close>

value "aval (Plus (V ''x'') (N 5)) (\<lambda>x. if x = ''x'' then 7 else 0)"

text \<open>The same state more concisely:\<close>
value "aval (Plus (V ''x'') (N 5)) ((\<lambda>x. 0) (''x'':= 7))"

text \<open>A little syntax magic to write larger states compactly:\<close>

definition null_state ("<>") where
  "null_state \<equiv> \<lambda>x. 0"
syntax
  "_State" :: "updbinds => 'a" ("<_>")
translations
  "_State ms" == "_Update <> ms"
  "_State (_updbinds b bs)" <= "_Update (_State b) bs"

text \<open>\noindent
  We can now write a series of updates to the function \<open>\<lambda>x. 0\<close> compactly:
\<close>
lemma "<a := 1, b := 2> = (<> (a := 1)) (b := (2::int))"
  by (rule refl)

value "aval (Plus (V ''x'') (N 5)) <''x'' := 7>"

text \<open>In  the @{term[source] "<a := b>"} syntax, variables that are not mentioned are 0 by default:
\<close>
value "aval (Plus (V ''x'') (N 5)) <''y'' := 7>"

text\<open>Note that this \<open><\<dots>>\<close> syntax works for any function space
\<open>\<tau>\<^sub>1 \<Rightarrow> \<tau>\<^sub>2\<close> where \<open>\<tau>\<^sub>2\<close> has a \<open>0\<close>.\<close>

subsection "Constant Folding"

text\<open>Evaluate constant subsexpressions:\<close>

text_raw\<open>\snip{AExpasimpconstdef}{0}{2}{%\<close>
(* fun asimp_const :: "aexp \<Rightarrow> aexp" where
"asimp_const (N n) = N n" |
"asimp_const (V x) = V x" |
"asimp_const (Plus a\<^sub>1 a\<^sub>2) =
  (case (asimp_const a\<^sub>1, asimp_const a\<^sub>2) of
    (N n\<^sub>1, N n\<^sub>2) \<Rightarrow> N(n\<^sub>1+n\<^sub>2) |
    (b\<^sub>1,b\<^sub>2) \<Rightarrow> Plus b\<^sub>1 b\<^sub>2)"
text_raw\<open>}%endsnip\<close>

theorem aval_asimp_const:
  "aval (asimp_const a) s = aval a s"
apply(induction a)
apply (auto split: aexp.split)
done *)

text\<open>Now we also eliminate all occurrences 0 in additions. The standard
method: optimized versions of the constructors:\<close>

text_raw\<open>\snip{AExpplusdef}{0}{2}{%\<close>
fun plus :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"plus (N i\<^sub>1) (N i\<^sub>2) = N(i\<^sub>1+i\<^sub>2)" |
"plus (N i) a = (if i=0 then a else Plus (N i) a)" |
"plus a (N i) = (if i=0 then a else Plus a (N i))" |
"plus a\<^sub>1 a\<^sub>2 = Plus a\<^sub>1 a\<^sub>2"
text_raw\<open>}%endsnip\<close>

lemma aval_plus[simp]:
  "aval (plus a1 a2) s = aval a1 s + aval a2 s"
apply(induction a1 a2 rule: plus.induct)
apply simp_all (* just for a change from auto *)
done

fun times :: "aexp => aexp => aexp" where
"times (N i) (N j) = N (i * j)" |
"times (N i) a = (if i=1 then a else Times (N i) a)" |
"times a (N i) = (if i=1 then a else Times a (N i))" |
"times a b = Times a b"

lemma aval_times[simp]:
  "aval (times a1 a2) s = aval a1 s * aval a2 s"
apply(induction a1 a2 rule: plus.induct)
apply simp_all (* just for a change from auto *)
done

text_raw\<open>\snip{AExpasimpdef}{2}{0}{%\<close>
fun asimp :: "aexp \<Rightarrow> aexp" where
"asimp (N n) = N n" |
"asimp (V x) = V x" |
"asimp (Plus a\<^sub>1 a\<^sub>2) = plus (asimp a\<^sub>1) (asimp a\<^sub>2)" |
"asimp (Times a1 a2) = times (asimp a1) (asimp a2)"
text_raw\<open>}%endsnip\<close>

value "asimp (Plus (Plus (N 0) (N 0)) (Plus (V ''x'') (N 0)))"

theorem aval_asimp[simp]:
  "aval (asimp a) s = aval a s"
apply(induction a)
apply simp_all
done
end


(*  Title:      HOL/Computational_Algebra/Fundamental_Theorem_Algebra.thy
    Author:     Amine Chaieb, TU Muenchen
*)

section \<open>Fundamental Theorem of Algebra\<close>

theory Fundamental_Theorem_Algebra
imports Polynomial Complex_Main
begin

subsection \<open>More lemmas about module of complex numbers\<close>

text \<open>The triangle inequality for cmod\<close>

lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
  by (metis add_diff_cancel norm_triangle_ineq4)

subsection \<open>Basic lemmas about polynomials\<close>

lemma poly_bound_exists:
  fixes p :: "'a::{comm_semiring_0,real_normed_div_algebra} poly"
  shows "\<exists>m. m > 0 \<and> (\<forall>z. norm z \<le> r \<longrightarrow> norm (poly p z) \<le> m)"
proof (induct p)
  case 0
  then show ?case by (rule exI[where x=1]) simp
next
  case (pCons c cs)
  from pCons.hyps obtain m where m: "\<forall>z. norm z \<le> r \<longrightarrow> norm (poly cs z) \<le> m"
    by blast
  let ?k = " 1 + norm c + \<bar>r * m\<bar>"
  have kp: "?k > 0"
    using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
  have "norm (poly (pCons c cs) z) \<le> ?k" if H: "norm z \<le> r" for z
  proof -
    from m H have th: "norm (poly cs z) \<le> m"
      by blast
    from H have rp: "r \<ge> 0"
      using norm_ge_zero[of z] by arith
    have "norm (poly (pCons c cs) z) \<le> norm c + norm (z * poly cs z)"
      using norm_triangle_ineq[of c "z* poly cs z"] by simp
    also have "\<dots> \<le> ?k"
      using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]]
      by (simp add: norm_mult)
    finally show ?thesis .
  qed
  with kp show ?case by blast
qed

text \<open>Offsetting the variable in a polynomial gives another of same degree\<close>

definition offset_poly :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly"
  where "offset_poly p h = fold_coeffs (\<lambda>a q. smult h q + pCons a q) p 0"

lemma offset_poly_0: "offset_poly 0 h = 0"
  by (simp add: offset_poly_def)

lemma offset_poly_pCons:
  "offset_poly (pCons a p) h =
    smult h (offset_poly p h) + pCons a (offset_poly p h)"
  by (cases "p = 0 \<and> a = 0") (auto simp add: offset_poly_def)

lemma offset_poly_single [simp]: "offset_poly [:a:] h = [:a:]"
  by (simp add: offset_poly_pCons offset_poly_0)

lemma poly_offset_poly: "poly (offset_poly p h) x = poly p (h + x)"
  by (induct p) (auto simp add: offset_poly_0 offset_poly_pCons algebra_simps)

lemma offset_poly_eq_0_lemma: "smult c p + pCons a p = 0 \<Longrightarrow> p = 0"
  by (induct p arbitrary: a) (simp, force)

lemma offset_poly_eq_0_iff [simp]: "offset_poly p h = 0 \<longleftrightarrow> p = 0"
proof
  show "offset_poly p h = 0 \<Longrightarrow> p = 0"
  proof(induction p)
    case 0
    then show ?case by blast
  next
    case (pCons a p)
    then show ?case
      by (metis offset_poly_eq_0_lemma offset_poly_pCons offset_poly_single)
  qed
qed (simp add: offset_poly_0)

lemma degree_offset_poly [simp]: "degree (offset_poly p h) = degree p"
proof(induction p)
  case 0
  then show ?case
    by (simp add: offset_poly_0)
next
  case (pCons a p)
  have "p \<noteq> 0 \<Longrightarrow> degree (offset_poly (pCons a p) h) = Suc (degree p)"
    by (metis degree_add_eq_right degree_pCons_eq degree_smult_le le_imp_less_Suc offset_poly_eq_0_iff offset_poly_pCons pCons.IH)
  then show ?case
    by simp
qed

definition "psize p = (if p = 0 then 0 else Suc (degree p))"

lemma psize_eq_0_iff [simp]: "psize p = 0 \<longleftrightarrow> p = 0"
  unfolding psize_def by simp

lemma poly_offset:
  fixes p :: "'a::comm_ring_1 poly"
  shows "\<exists>q. psize q = psize p \<and> (\<forall>x. poly q x = poly p (a + x))"
  by (metis degree_offset_poly offset_poly_eq_0_iff poly_offset_poly psize_def)

text \<open>An alternative useful formulation of completeness of the reals\<close>
lemma real_sup_exists:
  assumes ex: "\<exists>x. P x"
    and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
  shows "\<exists>s::real. \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
proof
  from bz have "bdd_above (Collect P)"
    by (force intro: less_imp_le)
  then show "\<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < Sup (Collect P)"
    using ex bz by (subst less_cSup_iff) auto
qed

subsection \<open>Fundamental theorem of algebra\<close>

lemma unimodular_reduce_norm:
  assumes md: "cmod z = 1"
  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + \<i>) < 1 \<or> cmod (z - \<i>) < 1"
proof -
  obtain x y where z: "z = Complex x y "
    by (cases z) auto
  from md z have xy: "x\<^sup>2 + y\<^sup>2 = 1"
    by (simp add: cmod_def)
  have False if "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + \<i>) \<ge> 1" "cmod (z - \<i>) \<ge> 1"
  proof -
    from that z xy have *: "2 * x \<le> 1" "2 * x \<ge> -1" "2 * y \<le> 1" "2 * y \<ge> -1"
      by (simp_all add: cmod_def power2_eq_square algebra_simps)
    then have "\<bar>2 * x\<bar> \<le> 1" "\<bar>2 * y\<bar> \<le> 1"
      by simp_all
    then have "\<bar>2 * x\<bar>\<^sup>2 \<le> 1\<^sup>2" "\<bar>2 * y\<bar>\<^sup>2 \<le> 1\<^sup>2"
      by (metis abs_square_le_1 one_power2 power2_abs)+
    with xy * show ?thesis
      by (smt (verit, best) four_x_squared square_le_1)
  qed
  then show ?thesis
    by force
qed

text \<open>Hence we can always reduce modulus of \<open>1 + b z^n\<close> if nonzero\<close>
lemma reduce_poly_simple:
  assumes b: "b \<noteq> 0"
    and n: "n \<noteq> 0"
  shows "\<exists>z. cmod (1 + b * z^n) < 1"
  using n
proof (induct n rule: nat_less_induct)
  fix n
  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)"
  assume n: "n \<noteq> 0"
  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
  show "\<exists>z. ?P z n"
  proof cases
    assume "even n"
    then obtain m where m: "n = 2 * m" and "m \<noteq> 0" "m < n"
      using n by auto
    with IH obtain z where z: "?P z m"
      by blast
    from z have "?P (csqrt z) n"
      by (simp add: m power_mult)
    then show ?thesis ..
  next
    assume "odd n"
    then have "\<exists>m. n = Suc (2 * m)"
      by presburger+
    then obtain m where m: "n = Suc (2 * m)"
      by blast
    have 0: "cmod (complex_of_real (cmod b) / b) = 1"
      using b by (simp add: norm_divide)
    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
    proof (cases "cmod (complex_of_real (cmod b) / b + 1) < 1")
      case True
      then show ?thesis
        by (metis power_one)
    next
      case F1: False
      show ?thesis
      proof (cases "cmod (complex_of_real (cmod b) / b - 1) < 1")
        case True
        with \<open>odd n\<close> show ?thesis
          by (metis add_uminus_conv_diff neg_one_odd_power)
      next
        case F2: False
        show ?thesis
        proof (cases "cmod (complex_of_real (cmod b) / b + \<i>) < 1")
          case T1: True
          show ?thesis
          proof (cases "even m")
            case True
            with T1 show ?thesis
              by (rule_tac x="\<i>" in exI) (simp add: m power_mult)
          next
            case False
            with T1 show ?thesis
              by (rule_tac x="- \<i>" in exI) (simp add: m power_mult)
          qed
        next
          case False
          then have lt1: "cmod (of_real (cmod b) / b - \<i>) < 1"
            using "0" F1 F2 unimodular_reduce_norm by blast
          show ?thesis
          proof (cases "even m")
            case True
            with m lt1 show ?thesis
              by (rule_tac x="- \<i>" in exI) (simp add: power_mult)
          next
            case False
            with m lt1 show ?thesis
              by (rule_tac x="\<i>" in exI) (simp add: power_mult)
          qed
        qed
      qed
    qed
    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1"
      by blast
    let ?w = "v / complex_of_real (root n (cmod b))"
    from odd_real_root_pow[OF \<open>odd n\<close>, of "cmod b"]
    have 1: "?w ^ n = v^n / complex_of_real (cmod b)"
      by (simp add: power_divide of_real_power[symmetric])
    have 2:"cmod (complex_of_real (cmod b) / b) = 1"
      using b by (simp add: norm_divide)
    then have 3: "cmod (complex_of_real (cmod b) / b) \<ge> 0"
      by simp
    have 4: "cmod (complex_of_real (cmod b) / b) *
        cmod (1 + b * (v ^ n / complex_of_real (cmod b))) <
        cmod (complex_of_real (cmod b) / b) * 1"
      apply (simp only: norm_mult[symmetric] distrib_left)
      using b v
      apply (simp add: 2)
      done
    show ?thesis
      by (metis 1 mult_left_less_imp_less[OF 4 3])
  qed
qed

text \<open>Bolzano-Weierstrass type property for closed disc in complex plane.\<close>

lemma metric_bound_lemma: "cmod (x - y) \<le> \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y"]
  unfolding cmod_def by simp

lemma Bolzano_Weierstrass_complex_disc:
  assumes r: "\<forall>n. cmod (s n) \<le> r"
  shows "\<exists>f z. strict_mono (f :: nat \<Rightarrow> nat) \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
proof -
  from seq_monosub[of "Re \<circ> s"]
  obtain f where f: "strict_mono f" "monoseq (\<lambda>n. Re (s (f n)))"
    unfolding o_def by blast
  from seq_monosub[of "Im \<circ> s \<circ> f"]
  obtain g where g: "strict_mono g" "monoseq (\<lambda>n. Im (s (f (g n))))"
    unfolding o_def by blast
  let ?h = "f \<circ> g"
  have "r \<ge> 0"
    by (meson norm_ge_zero order_trans r)
  have "\<forall>n. r + 1 \<ge> \<bar>Re (s n)\<bar>"
    by (smt (verit, ccfv_threshold) abs_Re_le_cmod r)
  then have conv1: "convergent (\<lambda>n. Re (s (f n)))"
    by (metis Bseq_monoseq_convergent f(2) BseqI' real_norm_def)
  have "\<forall>n. r + 1 \<ge> \<bar>Im (s n)\<bar>"
    by (smt (verit) abs_Im_le_cmod r)
  then have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
    by (metis Bseq_monoseq_convergent g(2) BseqI' real_norm_def)

  obtain x where  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar>Re (s (f n)) - x\<bar> < r"
    using conv1[unfolded convergent_def] LIMSEQ_iff real_norm_def by metis
  obtain y where  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar>Im (s (f (g n))) - y\<bar> < r"
    using conv2[unfolded convergent_def] LIMSEQ_iff real_norm_def by metis
  let ?w = "Complex x y"
  from f(1) g(1) have hs: "strict_mono ?h"
    unfolding strict_mono_def by auto
  have "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" if "e > 0" for e
  proof -
    from that have e2: "e/2 > 0"
      by simp
    from x y e2
    obtain N1 N2 where N1: "\<forall>n\<ge>N1. \<bar>Re (s (f n)) - x\<bar> < e / 2"
      and N2: "\<forall>n\<ge>N2. \<bar>Im (s (f (g n))) - y\<bar> < e / 2"
      by blast
    have "cmod (s (?h n) - ?w) < e" if "n \<ge> N1 + N2" for n
    proof -
      from that have nN1: "g n \<ge> N1" and nN2: "n \<ge> N2"
        using seq_suble[OF g(1), of n] by arith+
      show ?thesis
        using metric_bound_lemma[of "s (f (g n))" ?w] N1 N2 nN1 nN2 by fastforce
    qed
    then show ?thesis by blast
  qed
  with hs show ?thesis by blast
qed

text \<open>Polynomial is continuous.\<close>

lemma poly_cont:
  fixes p :: "'a::{comm_semiring_0,real_normed_div_algebra} poly"
  assumes ep: "e > 0"
  shows "\<exists>d >0. \<forall>w. 0 < norm (w - z) \<and> norm (w - z) < d \<longrightarrow> norm (poly p w - poly p z) < e"
proof -
  obtain q where "degree q = degree p" and q: "\<And>w. poly p w = poly q (w - z)"
    by (metis add.commute degree_offset_poly diff_add_cancel poly_offset_poly)
  show ?thesis unfolding q
  proof (induct q)
    case 0
    then show ?case
      using ep by auto
  next
    case (pCons c cs)
    obtain m where m: "m > 0" "norm z \<le> 1 \<Longrightarrow> norm (poly cs z) \<le> m" for z
      using poly_bound_exists[of 1 "cs"] by blast
    with ep have em0: "e/m > 0"
      by (simp add: field_simps)
    obtain d where d: "d > 0" "d < 1" "d < e / m"
      by (meson em0 field_lbound_gt_zero zero_less_one)
    then have "\<And>w. norm (w - z) < d \<Longrightarrow> norm (w - z) * norm (poly cs (w - z)) < e"
      by (smt (verit, del_insts) m mult_left_mono norm_ge_zero pos_less_divide_eq)
    with d show ?case
      by (force simp add: norm_mult)
  qed
qed

text \<open>Hence a polynomial attains minimum on a closed disc
  in the complex plane.\<close>
lemma poly_minimum_modulus_disc: "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
proof -
  show ?thesis
  proof (cases "r \<ge> 0")
    case False
    then show ?thesis
      by (metis norm_ge_zero order.trans)
  next
    case True
    then have mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"
      by (metis add.inverse_inverse norm_zero)
    obtain s where s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow> y < s"
      by (smt (verit, del_insts) real_sup_exists[OF mth1] norm_zero zero_less_norm_iff)

    let ?m = "- s"
    have s1: "(\<exists>z. cmod z \<le> r \<and> - (- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" for y
      by (metis add.inverse_inverse minus_less_iff s)
    then have s1m: "\<And>z. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m"
      by force
    have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" for n
      using s1[of "?m + 1/real (Suc n)"] by simp
    then obtain g where g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m + 1 /real(Suc n)"
      by metis
    from Bolzano_Weierstrass_complex_disc[OF g(1)]
    obtain f::"nat \<Rightarrow> nat" and z where fz: "strict_mono f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
      by blast
    {
      fix w
      assume wr: "cmod w \<le> r"
      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
      {
        assume e: "?e > 0"
        then have e2: "?e/2 > 0"
          by simp
        with poly_cont obtain d
          where "d > 0" and d: "\<And>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2"
          by blast
        have 1: "cmod(poly p w - poly p z) < ?e / 2" if w: "cmod (w - z) < d" for w
          using d[of w] w e by (cases "w = z") simp_all
        from fz(2) \<open>d > 0\<close> obtain N1 where N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d"
          by blast
        from reals_Archimedean2 obtain N2 :: nat where N2: "2/?e < real N2"
          by blast
        have 2: "cmod (poly p (g (f (N1 + N2))) - poly p z) < ?e/2"
          using N1 1 by auto
        have 0: "a < e2 \<Longrightarrow> \<bar>b - m\<bar> < e2 \<Longrightarrow> 2 * e2 \<le> \<bar>b - m\<bar> + a \<Longrightarrow> False"
          for a b e2 m :: real
          by arith
        from seq_suble[OF fz(1), of "N1 + N2"]
        have 00: "?m + 1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))"
          by (simp add: frac_le)
        from N2 e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
        have "?e/2 > 1/ real (Suc (N1 + N2))"
          by (simp add: inverse_eq_divide)
        with  order_less_le_trans[OF _ 00]
        have 1: "\<bar>cmod (poly p (g (f (N1 + N2)))) - ?m\<bar> < ?e/2"
          using g s1 by (smt (verit))
        with 0[OF 2] have False
          by (smt (verit) field_sum_of_halves norm_triangle_ineq3)
      }
      then have "?e = 0"
        by auto
      with s1m[OF wr] have "cmod (poly p z) \<le> cmod (poly p w)"
        by simp
    }
    then show ?thesis by blast
  qed
qed

text \<open>Nonzero polynomial in z goes to infinity as z does.\<close>

lemma poly_infinity:
  fixes p:: "'a::{comm_semiring_0,real_normed_div_algebra} poly"
  assumes ex: "p \<noteq> 0"
  shows "\<exists>r. \<forall>z. r \<le> norm z \<longrightarrow> d \<le> norm (poly (pCons a p) z)"
  using ex
proof (induct p arbitrary: a d)
  case 0
  then show ?case by simp
next
  case (pCons c cs a d)
  show ?case
  proof (cases "cs = 0")
    case False
    with pCons.hyps obtain r where r: "\<forall>z. r \<le> norm z \<longrightarrow> d + norm a \<le> norm (poly (pCons c cs) z)"
      by blast
    let ?r = "1 + \<bar>r\<bar>"
    have "d \<le> norm (poly (pCons a (pCons c cs)) z)" if "1 + \<bar>r\<bar> \<le> norm z" for z
    proof -
      have "d \<le> norm(z * poly (pCons c cs) z) - norm a"
        by (smt (verit, best) norm_ge_zero mult_less_cancel_right2 norm_mult r that)
      with norm_diff_ineq add.commute
      show ?thesis
        by (metis order.trans poly_pCons)
    qed
    then show ?thesis by blast
  next
    case True
    have "d \<le> norm (poly (pCons a (pCons c cs)) z)"
      if "(\<bar>d\<bar> + norm a) / norm c \<le> norm z" for z :: 'a
    proof -
      have "\<bar>d\<bar> + norm a \<le> norm (z * c)"
        by (metis that True norm_mult pCons.hyps(1) pos_divide_le_eq zero_less_norm_iff)
      also have "\<dots> \<le> norm (a + z * c) + norm a"
        by (simp add: add.commute norm_add_leD)
      finally show ?thesis
        using True by auto
    qed
    then show ?thesis by blast
  qed
qed

text \<open>Hence polynomial's modulus attains its minimum somewhere.\<close>
lemma poly_minimum_modulus: "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
proof (induct p)
  case 0
  then show ?case by simp
next
  case (pCons c cs)
  show ?case
  proof (cases "cs = 0")
    case False
    from poly_infinity[OF False, of "cmod (poly (pCons c cs) 0)" c]
    obtain r where r: "cmod (poly (pCons c cs) 0) \<le> cmod (poly (pCons c cs) z)"
      if "r \<le> cmod z" for z
      by blast
    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "pCons c cs"] show ?thesis
      by (smt (verit, del_insts) order.trans linorder_linear r)
  qed (use pCons.hyps in auto)
qed

text \<open>Constant function (non-syntactic characterization).\<close>
definition "constant f \<longleftrightarrow> (\<forall>x y. f x = f y)"

lemma nonconstant_length: "\<not> constant (poly p) \<Longrightarrow> psize p \<ge> 2"
  by (induct p) (auto simp: constant_def psize_def)

lemma poly_replicate_append: "poly (monom 1 n * p) (x::'a::comm_ring_1) = x^n * poly p x"
  by (simp add: poly_monom)

text \<open>Decomposition of polynomial, skipping zero coefficients after the first.\<close>

lemma poly_decompose_lemma:
  assumes nz: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly p z = (0::'a::idom))"
  shows "\<exists>k a q. a \<noteq> 0 \<and> Suc (psize q + k) = psize p \<and> (\<forall>z. poly p z = z^k * poly (pCons a q) z)"
  unfolding psize_def
  using nz
proof (induct p)
  case 0
  then show ?case by simp
next
  case (pCons c cs)
  show ?case
  proof (cases "c = 0")
    case True
    from pCons.hyps pCons.prems True show ?thesis
      apply auto
      apply (rule_tac x="k+1" in exI)
      apply (rule_tac x="a" in exI)
      apply clarsimp
      apply (rule_tac x="q" in exI)
      apply auto
      done
  qed force
qed

lemma poly_decompose:
  fixes p :: "'a::idom poly"
  assumes nc: "\<not> constant (poly p)"
  shows "\<exists>k a q. a \<noteq> 0 \<and> k \<noteq> 0 \<and>
               psize q + k + 1 = psize p \<and>
              (\<forall>z. poly p z = poly p 0 + z^k * poly (pCons a q) z)"
  using nc
proof (induct p)
  case 0
  then show ?case
    by (simp add: constant_def)
next
  case (pCons c cs)
  have "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)"
    by (smt (verit) constant_def mult_eq_0_iff pCons.prems poly_pCons)
  from poly_decompose_lemma[OF this]
  obtain k a q where *: "a \<noteq> 0 \<and>
     Suc (psize q + k) = psize cs \<and> (\<forall>z. poly cs z = z ^ k * poly (pCons a q) z)"
    by blast
  then have "psize q + k + 2 = psize (pCons c cs)"
    by (auto simp add: psize_def split: if_splits)
  then show ?case
    using "*" by force
qed

text \<open>Fundamental theorem of algebra\<close>

lemma fundamental_theorem_of_algebra:
  assumes nc: "\<not> constant (poly p)"
  shows "\<exists>z::complex. poly p z = 0"
  using nc
proof (induct "psize p" arbitrary: p rule: less_induct)
  case less
  let ?p = "poly p"
  let ?ths = "\<exists>z. ?p z = 0"

  from nonconstant_length[OF less(2)] have n2: "psize p \<ge> 2" .
  from poly_minimum_modulus obtain c where c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)"
    by blast

  show ?ths
  proof (cases "?p c = 0")
    case True
    then show ?thesis by blast
  next
    case False
    obtain q where q: "psize q = psize p" "\<forall>x. poly q x = ?p (c + x)"
      using poly_offset[of p c] by blast
    then have qnc: "\<not> constant (poly q)"
      by (metis (no_types, opaque_lifting) add.commute constant_def diff_add_cancel less.prems)
    from q(2) have pqc0: "?p c = poly q 0"
      by simp
    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)"
      by simp
    let ?a0 = "poly q 0"
    from False pqc0 have a00: "?a0 \<noteq> 0"
      by simp
    from a00 have qr: "\<forall>z. poly q z = poly (smult (inverse ?a0) q) z * ?a0"
      by simp
    let ?r = "smult (inverse ?a0) q"
    have lgqr: "psize q = psize ?r"
      by (simp add: a00 psize_def)
    have rnc: "\<not> constant (poly ?r)"
      using constant_def qnc qr by fastforce
    have r01: "poly ?r 0 = 1"
      by (simp add: a00)
    have mrmq_eq: "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" for w
      by (smt (verit, del_insts) a00 mult_less_cancel_right2 norm_mult qr zero_less_norm_iff)
    from poly_decompose[OF rnc] obtain k a s where
      kas: "a \<noteq> 0" "k \<noteq> 0" "psize s + k + 1 = psize ?r"
        "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (pCons a s) z" by blast
    have "\<exists>w. cmod (poly ?r w) < 1"
    proof (cases "psize p = k + 1")
      case True
      with kas q have s0: "s = 0"
        by (simp add: lgqr)
      with reduce_poly_simple kas show ?thesis
        by (metis mult.commute mult.right_neutral poly_1 poly_smult r01 smult_one)
    next
      case False note kn = this
      from kn kas(3) q(1) lgqr have k1n: "k + 1 < psize p"
        by simp
      have 01: "\<not> constant (poly (pCons 1 (monom a (k - 1))))"
        unfolding constant_def poly_pCons poly_monom
        by (metis add_cancel_left_right kas(1) mult.commute mult_cancel_right2 power_one)
      have 02: "k + 1 = psize (pCons 1 (monom a (k - 1)))"
        using kas by (simp add: psize_def degree_monom_eq)
      from less(1) [OF _ 01] k1n 02
      obtain w where w: "1 + w^k * a = 0"
        by (metis kas(2) mult.commute mult.left_commute poly_monom poly_pCons power_eq_if)
      from poly_bound_exists[of "cmod w" s] obtain m where
        m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
      have "w \<noteq> 0"
        using kas(2) w by (auto simp add: power_0_left)
      from w have wm1: "w^k * a = - 1"
        by (simp add: add_eq_0_iff)
      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)"
        by (simp add: \<open>w \<noteq> 0\<close> m(1))
      with field_lbound_gt_zero[OF zero_less_one] obtain t where
        t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
      let ?ct = "complex_of_real t"
      let ?w = "?ct * w"
      have "1 + ?w^k * (a + ?w * poly s ?w) = 1 + ?ct^k * (w^k * a) + ?w^k * ?w * poly s ?w"
        using kas(1) by (simp add: algebra_simps power_mult_distrib)
      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
        unfolding wm1 by simp
      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) =
        cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)"
        by metis
      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"]
      have 11: "cmod (1 + ?w^k * (a + ?w * poly s ?w)) \<le> \<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w)"
        unfolding norm_of_real by simp
      have ath: "\<And>x t::real. 0 \<le> x \<Longrightarrow> x < t \<Longrightarrow> t \<le> 1 \<Longrightarrow> \<bar>1 - t\<bar> + x < 1"
        by arith
      have tw: "cmod ?w \<le> cmod w"
        by (smt (verit) mult_le_cancel_right2 norm_ge_zero norm_mult norm_of_real t)
      have "t * (cmod w ^ (k + 1) * m) < 1"
        by (smt (verit, best) inv0 inverse_positive_iff_positive left_inverse mult_strict_right_mono t(3))
      with zero_less_power[OF t(1), of k] have 30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k"
        by simp
      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k + 1) * cmod (poly s ?w)))"
        using \<open>w \<noteq> 0\<close> t(1) by (simp add: algebra_simps norm_power norm_mult)
      with 30 have 120: "cmod (?w^k * ?w * poly s ?w) < t^k"
        by (smt (verit, ccfv_SIG) m(2) mult_left_mono norm_ge_zero t(1) tw zero_le_power)
      from power_strict_mono[OF t(2), of k] t(1) kas(2) have 121: "t^k \<le> 1"
        by auto
      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] 120 121]
      show ?thesis
        by (smt (verit) "11" kas(4) poly_pCons r01)
    qed
    with cq0 q(2) show ?thesis
      by (smt (verit) mrmq_eq)
  qed
qed

text \<open>Alternative version with a syntactic notion of constant polynomial.\<close>

lemma fundamental_theorem_of_algebra_alt:
  assumes nc: "\<not> (\<exists>a l. a \<noteq> 0 \<and> l = 0 \<and> p = pCons a l)"
  shows "\<exists>z. poly p z = (0::complex)"
proof (rule ccontr)
  assume N: "\<nexists>z. poly p z = 0"
  then have "\<not> constant (poly p)"
    unfolding constant_def
    by (metis (no_types, opaque_lifting) nc poly_pcompose pcompose_0' pcompose_const poly_0_coeff_0
        poly_all_0_iff_0 poly_diff right_minus_eq)
  then show False
    using N fundamental_theorem_of_algebra by blast
qed

subsection \<open>Nullstellensatz, degrees and divisibility of polynomials\<close>

lemma nullstellensatz_lemma:
  fixes p :: "complex poly"
  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
    and "degree p = n"
    and "n \<noteq> 0"
  shows "p dvd (q ^ n)"
  using assms
proof (induct n arbitrary: p q rule: nat_less_induct)
  fix n :: nat
  fix p q :: "complex poly"
  assume IH: "\<forall>m<n. \<forall>p q.
                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p dvd (q ^ m)"
    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
    and dpn: "degree p = n"
    and n0: "n \<noteq> 0"
  from dpn n0 have pne: "p \<noteq> 0" by auto
  show "p dvd (q ^ n)"
  proof (cases "\<exists>a. poly p a = 0")
    case True
    then obtain a where a: "poly p a = 0" ..
    have ?thesis if oa: "order a p \<noteq> 0"
    proof -
      let ?op = "order a p"
      from pne have ap: "([:- a, 1:] ^ ?op) dvd p" "\<not> [:- a, 1:] ^ (Suc ?op) dvd p"
        using order by blast+
      note oop = order_degree[OF pne, unfolded dpn]
      show ?thesis
      proof (cases "q = 0")
        case True
        with n0 show ?thesis by (simp add: power_0_left)
      next
        case False
        from pq0[rule_format, OF a, unfolded poly_eq_0_iff_dvd]
        obtain r where r: "q = [:- a, 1:] * r" by (rule dvdE)
        from ap(1) obtain s where s: "p = [:- a, 1:] ^ ?op * s"
          by (rule dvdE)
        have sne: "s \<noteq> 0"
          using s pne by auto
        show ?thesis
        proof (cases "degree s = 0")
          case True
          then obtain k where kpn: "s = [:k:]"
            by (cases s) (auto split: if_splits)
          from sne kpn have k: "k \<noteq> 0" by simp
          let ?w = "([:1/k:] * ([:-a,1:] ^ (n - ?op))) * (r ^ n)"
          have "q^n = [:- a, 1:] ^ n * r ^ n"
            using power_mult_distrib r by blast
          also have "... = [:- a, 1:] ^ order a p * [:k:] * ([:1 / k:] * [:- a, 1:] ^ (n - order a p) * r ^ n)"
            using k oop [of a] by (simp flip: power_add)
          also have "... = p * ?w"
            by (metis s kpn)
          finally show ?thesis
            unfolding dvd_def by blast
        next
          case False
          with sne dpn s oa have dsn: "degree s < n"
            by (metis add_diff_cancel_right' degree_0 degree_linear_power degree_mult_eq gr0I zero_less_diff)
          have "poly r x = 0" if h: "poly s x = 0" for x
          proof -
            have "x \<noteq> a"
              by (metis ap(2) dvd_refl mult_dvd_mono poly_eq_0_iff_dvd power_Suc power_commutes s that)
            moreover have "poly p x = 0"
              by (metis (no_types) mult_eq_0_iff poly_mult s that)
            ultimately show ?thesis
              using pq0 r by auto
          qed
          with False IH dsn obtain u where u: "r ^ (degree s) = s * u"
            by blast
          then have u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
            by (simp only: poly_mult[symmetric] poly_power[symmetric])
          have "q^n = [:- a, 1:] ^ n * r ^ n"
            using power_mult_distrib r by blast
          also have "... = [:- a, 1:] ^ order a p * (s * u * ([:- a, 1:] ^ (n - order a p) * r ^ (n - degree s)))"
            by (smt (verit, del_insts) s u mult_ac power_add add_diff_cancel_right' degree_linear_power degree_mult_eq dpn mult_zero_left)
          also have "... = p * (u * ([:-a,1:] ^ (n - ?op))) * (r ^ (n - degree s))"
            using s by force
          finally show ?thesis
            unfolding dvd_def by auto
        qed
      qed
    qed
    then show ?thesis
      using a order_root pne by blast
  next
    case False
    then show ?thesis
      using dpn n0 fundamental_theorem_of_algebra_alt[of p]
      by fastforce
  qed
qed

lemma nullstellensatz_univariate:
  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow>
    p dvd (q ^ (degree p)) \<or> (p = 0 \<and> q = 0)"
proof -
  consider "p = 0" | "p \<noteq> 0" "degree p = 0" | n where "p \<noteq> 0" "degree p = Suc n"
    by (cases "degree p") auto
  then show ?thesis
  proof cases
    case p: 1
    then have "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> q = 0"
      by (auto simp add: poly_all_0_iff_0)
    with p show ?thesis
      by force
  next
    case dp: 2
    then show ?thesis
      by (meson dvd_trans is_unit_iff_degree poly_eq_0_iff_dvd unit_imp_dvd)
  next
    case dp: 3
    have False if "p dvd (q ^ (Suc n))" "poly p x = 0" "poly q x \<noteq> 0" for x
      by (metis dvd_trans poly_eq_0_iff_dvd poly_power power_eq_0_iff that)
    with dp nullstellensatz_lemma[of p q "degree p"] show ?thesis
      by auto
  qed
qed

text \<open>Useful lemma\<close>
lemma constant_degree:
  fixes p :: "'a::{idom,ring_char_0} poly"
  shows "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
proof
  show ?rhs if ?lhs
  proof -
    from that[unfolded constant_def, rule_format, of _ "0"]
    have "poly p = poly [:poly p 0:]"
      by auto
    then show ?thesis
      by (metis degree_pCons_0 poly_eq_poly_eq_iff)
  qed
  show ?lhs if ?rhs
    unfolding constant_def
    by (metis degree_eq_zeroE pcompose_const poly_0 poly_pcompose that)
qed

text \<open>Arithmetic operations on multivariate polynomials.\<close>

lemma mpoly_base_conv:
  fixes x :: "'a::comm_ring_1"
  shows "0 = poly 0 x" "c = poly [:c:] x" "x = poly [:0,1:] x"
  by simp_all

lemma mpoly_norm_conv:
  fixes x :: "'a::comm_ring_1"
  shows "poly [:0:] x = poly 0 x" "poly [:poly 0 y:] x = poly 0 x"
  by simp_all

lemma mpoly_sub_conv:
  fixes x :: "'a::comm_ring_1"
  shows "poly p x - poly q x = poly p x + -1 * poly q x"
  by simp

lemma poly_pad_rule: "poly p x = 0 \<Longrightarrow> poly (pCons 0 p) x = 0"
  by simp

lemma poly_cancel_eq_conv:
  fixes x :: "'a::field"
  shows "x = 0 \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> y = 0 \<longleftrightarrow> a * y - b * x = 0"
  by auto

lemma poly_divides_pad_rule:
  fixes p:: "('a::comm_ring_1) poly"
  assumes pq: "p dvd q"
  shows "p dvd (pCons 0 q)"
  by (metis add_0 dvd_def mult_pCons_right pq smult_0_left)

lemma poly_divides_conv0:
  fixes p:: "'a::field poly"
  assumes lgpq: "degree q < degree p" and lq: "p \<noteq> 0"
  shows "p dvd q \<longleftrightarrow> q = 0"
  using lgpq mod_poly_less by fastforce

lemma poly_divides_conv1:
  fixes p :: "'a::field poly"
  assumes a0: "a \<noteq> 0"
    and pp': "p dvd p'"
    and qrp': "smult a q - p' = r"
  shows "p dvd q \<longleftrightarrow> p dvd r"
  by (metis a0 diff_add_cancel dvd_add_left_iff dvd_smult_iff pp' qrp')

lemma basic_cqe_conv1:
  "(\<exists>x. poly p x = 0 \<and> poly 0 x \<noteq> 0) \<longleftrightarrow> False"
  "(\<exists>x. poly 0 x \<noteq> 0) \<longleftrightarrow> False"
  "(\<exists>x. poly [:c:] x \<noteq> 0) \<longleftrightarrow> c \<noteq> 0"
  "(\<exists>x. poly 0 x = 0) \<longleftrightarrow> True"
  "(\<exists>x. poly [:c:] x = 0) \<longleftrightarrow> c = 0"
  by simp_all

lemma basic_cqe_conv2:
  assumes l: "p \<noteq> 0"
  shows "\<exists>x. poly (pCons a (pCons b p)) x = (0::complex)"
  by (meson fundamental_theorem_of_algebra_alt l pCons_eq_0_iff pCons_eq_iff)

lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<longleftrightarrow> p \<noteq> 0"
  by (metis poly_all_0_iff_0)

lemma basic_cqe_conv3:
  fixes p q :: "complex poly"
  assumes l: "p \<noteq> 0"
  shows "(\<exists>x. poly (pCons a p) x = 0 \<and> poly q x \<noteq> 0) \<longleftrightarrow> \<not> (pCons a p) dvd (q ^ psize p)"
  by (metis degree_pCons_eq_if l nullstellensatz_univariate pCons_eq_0_iff psize_def)

lemma basic_cqe_conv4:
  fixes p q :: "complex poly"
  assumes h: "\<And>x. poly (q ^ n) x = poly r x"
  shows "p dvd (q ^ n) \<longleftrightarrow> p dvd r"
  by (metis (no_types) basic_cqe_conv_2b h poly_diff right_minus_eq)

lemma poly_const_conv:
  fixes x :: "'a::comm_ring_1"
  shows "poly [:c:] x = y \<longleftrightarrow> c = y"
  by simp

end


theory P6 imports Main begin

fun occurs :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
"occurs x Nil = 0" |
"occurs x (y # xs) = (if x=y then (Suc (occurs x xs)) else (occurs x xs))"

theorem "occurs a xs = occurs a (rev xs)"
  apply (induct xs)
   apply auto
  done

theorem "occurs a xs <= length xs"
  apply (induct xs)
  apply auto
  done

lemma "occurs a (map f xs) = occurs (f a) xs"
  nitpick
  oops

theorem "occurs a (filter P xs) = (occurs True (map (\<lambda>x. (P x \<and> (x=a))) xs))"
  apply (induct xs)
   apply auto
  done

fun remDups :: "'a list \<Rightarrow> 'a list" where
"remDups Nil = Nil" |
"remDups (x # xs) = (if (occurs x xs > 0) then (remDups xs) else (x # (remDups xs)))"

theorem [simp]: "occurs x (remDups xs) = (if (occurs x xs > 0) then 1 else 0)"
  apply (induct xs)
   apply auto
  done

fun unique :: "'a list \<Rightarrow> bool" where
"unique Nil = True" |
"unique (x # xs) = (if (occurs x xs > 0) then False else (unique xs))"

theorem "unique (remDups xs)"
  apply (induct xs)
   apply auto
  done

end


(*<*)theory Even imports Main begin
ML_file \<open>../../antiquote_setup.ML\<close>
(*>*)

section\<open>The Set of Even Numbers\<close>

text \<open>
\index{even numbers!defining inductively|(}%
The set of even numbers can be inductively defined as the least set
containing 0 and closed under the operation $+2$.  Obviously,
\emph{even} can also be expressed using the divides relation (\<open>dvd\<close>).
We shall prove below that the two formulations coincide.  On the way we
shall examine the primary means of reasoning about inductively defined
sets: rule induction.
\<close>

subsection\<open>Making an Inductive Definition\<close>

text \<open>
Using \commdx{inductive\protect\_set}, we declare the constant \<open>even\<close> to be
a set of natural numbers with the desired properties.
\<close>

inductive_set even :: "nat set" where
zero[intro!]: "0 \<in> even" |
step[intro!]: "n \<in> even \<Longrightarrow> (Suc (Suc n)) \<in> even"

text \<open>
An inductive definition consists of introduction rules.  The first one
above states that 0 is even; the second states that if $n$ is even, then so
is~$n+2$.  Given this declaration, Isabelle generates a fixed point
definition for \<^term>\<open>even\<close> and proves theorems about it,
thus following the definitional approach (see {\S}\ref{sec:definitional}).
These theorems
include the introduction rules specified in the declaration, an elimination
rule for case analysis and an induction rule.  We can refer to these
theorems by automatically-generated names.  Here are two examples:
@{named_thms[display,indent=0] even.zero[no_vars] (even.zero) even.step[no_vars] (even.step)}

The introduction rules can be given attributes.  Here
both rules are specified as \isa{intro!},%
\index{intro"!@\isa {intro"!} (attribute)}
directing the classical reasoner to
apply them aggressively. Obviously, regarding 0 as even is safe.  The
\<open>step\<close> rule is also safe because $n+2$ is even if and only if $n$ is
even.  We prove this equivalence later.
\<close>

subsection\<open>Using Introduction Rules\<close>

text \<open>
Our first lemma states that numbers of the form $2\times k$ are even.
Introduction rules are used to show that specific values belong to the
inductive set.  Such proofs typically involve
induction, perhaps over some other inductive set.
\<close>

lemma two_times_even[intro!]: "2*k \<in> even"
apply (induct_tac k)
 apply auto
done
(*<*)
lemma "2*k \<in> even"
apply (induct_tac k)
(*>*)
txt \<open>
\noindent
The first step is induction on the natural number \<open>k\<close>, which leaves
two subgoals:
@{subgoals[display,indent=0,margin=65]}
Here \<open>auto\<close> simplifies both subgoals so that they match the introduction
rules, which are then applied automatically.

Our ultimate goal is to prove the equivalence between the traditional
definition of \<open>even\<close> (using the divides relation) and our inductive
definition.  One direction of this equivalence is immediate by the lemma
just proved, whose \<open>intro!\<close> attribute ensures it is applied automatically.
\<close>
(*<*)oops(*>*)
lemma dvd_imp_even: "2 dvd n \<Longrightarrow> n \<in> even"
by (auto simp add: dvd_def)

subsection\<open>Rule Induction \label{sec:rule-induction}\<close>

text \<open>
\index{rule induction|(}%
From the definition of the set
\<^term>\<open>even\<close>, Isabelle has
generated an induction rule:
@{named_thms [display,indent=0,margin=40] even.induct [no_vars] (even.induct)}
A property \<^term>\<open>P\<close> holds for every even number provided it
holds for~\<open>0\<close> and is closed under the operation
\isa{Suc(Suc \(\cdot\))}.  Then \<^term>\<open>P\<close> is closed under the introduction
rules for \<^term>\<open>even\<close>, which is the least set closed under those rules.
This type of inductive argument is called \textbf{rule induction}.

Apart from the double application of \<^term>\<open>Suc\<close>, the induction rule above
resembles the familiar mathematical induction, which indeed is an instance
of rule induction; the natural numbers can be defined inductively to be
the least set containing \<open>0\<close> and closed under~\<^term>\<open>Suc\<close>.

Induction is the usual way of proving a property of the elements of an
inductively defined set.  Let us prove that all members of the set
\<^term>\<open>even\<close> are multiples of two.
\<close>

lemma even_imp_dvd: "n \<in> even \<Longrightarrow> 2 dvd n"
txt \<open>
We begin by applying induction.  Note that \<open>even.induct\<close> has the form
of an elimination rule, so we use the method \<open>erule\<close>.  We get two
subgoals:
\<close>
apply (erule even.induct)
txt \<open>
@{subgoals[display,indent=0]}
We unfold the definition of \<open>dvd\<close> in both subgoals, proving the first
one and simplifying the second:
\<close>
apply (simp_all add: dvd_def)
txt \<open>
@{subgoals[display,indent=0]}
The next command eliminates the existential quantifier from the assumption
and replaces \<open>n\<close> by \<open>2 * k\<close>.
\<close>
apply clarify
txt \<open>
@{subgoals[display,indent=0]}
To conclude, we tell Isabelle that the desired value is
\<^term>\<open>Suc k\<close>.  With this hint, the subgoal falls to \<open>simp\<close>.
\<close>
apply (rule_tac x = "Suc k" in exI, simp)
(*<*)done(*>*)

text \<open>
Combining the previous two results yields our objective, the
equivalence relating \<^term>\<open>even\<close> and \<open>dvd\<close>.
%
%we don't want [iff]: discuss?
\<close>

theorem even_iff_dvd: "(n \<in> even) = (2 dvd n)"
by (blast intro: dvd_imp_even even_imp_dvd)

subsection\<open>Generalization and Rule Induction \label{sec:gen-rule-induction}\<close>

text \<open>
\index{generalizing for induction}%
Before applying induction, we typically must generalize
the induction formula.  With rule induction, the required generalization
can be hard to find and sometimes requires a complete reformulation of the
problem.  In this  example, our first attempt uses the obvious statement of
the result.  It fails:
\<close>

lemma "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
apply (erule even.induct)
oops
(*<*)
lemma "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
apply (erule even.induct)
(*>*)
txt \<open>
Rule induction finds no occurrences of \<^term>\<open>Suc(Suc n)\<close> in the
conclusion, which it therefore leaves unchanged.  (Look at
\<open>even.induct\<close> to see why this happens.)  We have these subgoals:
@{subgoals[display,indent=0]}
The first one is hopeless.  Rule induction on
a non-variable term discards information, and usually fails.
How to deal with such situations
in general is described in {\S}\ref{sec:ind-var-in-prems} below.
In the current case the solution is easy because
we have the necessary inverse, subtraction:
\<close>
(*<*)oops(*>*)
lemma even_imp_even_minus_2: "n \<in> even \<Longrightarrow> n - 2 \<in> even"
apply (erule even.induct)
 apply auto
done
(*<*)
lemma "n \<in>  even \<Longrightarrow> n - 2 \<in> even"
apply (erule even.induct)
(*>*)
txt \<open>
This lemma is trivially inductive.  Here are the subgoals:
@{subgoals[display,indent=0]}
The first is trivial because \<open>0 - 2\<close> simplifies to \<open>0\<close>, which is
even.  The second is trivial too: \<^term>\<open>Suc (Suc n) - 2\<close> simplifies to
\<^term>\<open>n\<close>, matching the assumption.%
\index{rule induction|)}  %the sequel isn't really about induction

\medskip
Using our lemma, we can easily prove the result we originally wanted:
\<close>
(*<*)oops(*>*)
lemma Suc_Suc_even_imp_even: "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
by (drule even_imp_even_minus_2, simp)

text \<open>
We have just proved the converse of the introduction rule \<open>even.step\<close>.
This suggests proving the following equivalence.  We give it the
\attrdx{iff} attribute because of its obvious value for simplification.
\<close>

subsection\<open>Rule Inversion \label{sec:rule-inversion}\<close>

text \<open>
\index{rule inversion|(}%
Case analysis on an inductive definition is called \textbf{rule
inversion}.  It is frequently used in proofs about operational
semantics.  It can be highly effective when it is applied
automatically.  Let us look at how rule inversion is done in
Isabelle/HOL\@.

Recall that \<^term>\<open>even\<close> is the minimal set closed under these two rules:
@{thm [display,indent=0] even.intros [no_vars]}
Minimality means that \<^term>\<open>even\<close> contains only the elements that these
rules force it to contain.  If we are told that \<^term>\<open>a\<close>
belongs to
\<^term>\<open>even\<close> then there are only two possibilities.  Either \<^term>\<open>a\<close> is \<open>0\<close>
or else \<^term>\<open>a\<close> has the form \<^term>\<open>Suc(Suc n)\<close>, for some suitable \<^term>\<open>n\<close>
that belongs to
\<^term>\<open>even\<close>.  That is the gist of the \<^term>\<open>cases\<close> rule, which Isabelle proves
for us when it accepts an inductive definition:
@{named_thms [display,indent=0,margin=40] even.cases [no_vars] (even.cases)}
This general rule is less useful than instances of it for
specific patterns.  For example, if \<^term>\<open>a\<close> has the form
\<^term>\<open>Suc(Suc n)\<close> then the first case becomes irrelevant, while the second
case tells us that \<^term>\<open>n\<close> belongs to \<^term>\<open>even\<close>.  Isabelle will generate
this instance for us:
\<close>

inductive_cases Suc_Suc_cases [elim!]: "Suc(Suc n) \<in> even"

text \<open>
The \commdx{inductive\protect\_cases} command generates an instance of
the \<open>cases\<close> rule for the supplied pattern and gives it the supplied name:
@{named_thms [display,indent=0] Suc_Suc_cases [no_vars] (Suc_Suc_cases)}
Applying this as an elimination rule yields one case where \<open>even.cases\<close>
would yield two.  Rule inversion works well when the conclusions of the
introduction rules involve datatype constructors like \<^term>\<open>Suc\<close> and \<open>#\<close>
(list ``cons''); freeness reasoning discards all but one or two cases.

In the \isacommand{inductive\_cases} command we supplied an
attribute, \<open>elim!\<close>,
\index{elim"!@\isa {elim"!} (attribute)}%
indicating that this elimination rule can be
applied aggressively.  The original
\<^term>\<open>cases\<close> rule would loop if used in that manner because the
pattern~\<^term>\<open>a\<close> matches everything.

The rule \<open>Suc_Suc_cases\<close> is equivalent to the following implication:
@{term [display,indent=0] "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"}
Just above we devoted some effort to reaching precisely
this result.  Yet we could have obtained it by a one-line declaration,
dispensing with the lemma \<open>even_imp_even_minus_2\<close>.
This example also justifies the terminology
\textbf{rule inversion}: the new rule inverts the introduction rule
\<open>even.step\<close>.  In general, a rule can be inverted when the set of elements
it introduces is disjoint from those of the other introduction rules.

For one-off applications of rule inversion, use the \methdx{ind_cases} method.
Here is an example:
\<close>

(*<*)lemma "Suc(Suc n) \<in> even \<Longrightarrow> P"(*>*)
apply (ind_cases "Suc(Suc n) \<in> even")
(*<*)oops(*>*)

text \<open>
The specified instance of the \<open>cases\<close> rule is generated, then applied
as an elimination rule.

To summarize, every inductive definition produces a \<open>cases\<close> rule.  The
\commdx{inductive\protect\_cases} command stores an instance of the
\<open>cases\<close> rule for a given pattern.  Within a proof, the
\<open>ind_cases\<close> method applies an instance of the \<open>cases\<close>
rule.

The even numbers example has shown how inductive definitions can be
used.  Later examples will show that they are actually worth using.%
\index{rule inversion|)}%
\index{even numbers!defining inductively|)}
\<close>

(*<*)end(*>*)


theory Exercises2_06
  imports Main
begin

(*---------------- Exercise 2.6----------------*)
(* tree datatype *)
datatype 'a tree = None | Node "'a tree" 'a "'a tree"

(* collect function *)
fun contents :: "'a tree \<Rightarrow> 'a list" where
"contents None = []" |
"contents (Node l a r) = (Cons a (contents l))@(contents r)"

(* function to sum tree *)
fun sum_tree :: "nat tree \<Rightarrow> nat" where
"sum_tree None = 0" |
"sum_tree (Node l a r) = (sum_tree l) + a + (sum_tree r)"

theorem sum : "sum_tree t = sum_list (contents t)"
  apply(induction t)
   apply(auto)
  done

end


theory Chapter2
imports Main
begin

text{*
\section*{Chapter 2}

\exercise
Use the \textbf{value} command to evaluate the following expressions:
*}

 "1 + (2::nat)"
 "1 + (2::int)"
 "1 - (2::nat)"
 "1 - (2::int)"
 "[a,b] @ [c,d]"

text{*
\endexercise

\exercise
Recall the definition of our own addition function on @{typ nat}:
*}

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"add 0 n = n" |
"add (Suc m) n = Suc(add m n)"

text{*
Prove that @{const add} is associative and commutative.
You will need additional lemmas.
*}

lemma add_comm: "add m n = add n m"
(* your definition/proof here *)

text{* Define a recursive function *}

fun double :: "nat \<Rightarrow> nat" where
(* your definition/proof here *)

text{* and prove that *}

lemma double_add: "double m = add m m"
(* your definition/proof here *)
text{*
\endexercise

\exercise
Define a function that counts the number of occurrences of
an element in a list:
*}

fun count :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
(* your definition/proof here *)
text {*
Test your definition of @{term count} on some examples.
Prove the following inequality:
*}

theorem "count xs x \<le> length xs"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Define a function @{text snoc} that appends an element to the end of a list.
Do not use the existing append operator @{text "@"} for lists.
*}

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
(* your definition/proof here *)

text {*
Convince yourself on some test cases that your definition
of @{term snoc} behaves as expected.
With the help of @{text snoc} define a recursive function @{text reverse}
that reverses a list. Do not use the predefined function @{const rev}.
*}

fun reverse :: "'a list \<Rightarrow> 'a list" where
(* your definition/proof here *)

text {*
Prove the following theorem. You will need an additional lemma.
*}
theorem "reverse (reverse xs) = xs"
(* your definition/proof here *)

text{*
\endexercise

\exercise
The aim of this exercise is to prove the summation formula
\[ \sum_{i=0}^{n}i = \frac{n(n+1)}{2} \]
Define a recursive function @{text "sum_upto n = 0 + ... + n"}:
*}

fun sum_upto :: "nat \<Rightarrow> nat" where
(* your definition/proof here *)

text {*
Now prove the summation formula by induction on @{text "n"}.
First, write a clear but informal proof by hand following the examples
in the main text. Then prove the same property in Isabelle:
*}

lemma "sum_upto n = n * (n+1) div 2"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Starting from the type @{text "'a tree"} defined in the text, define
a function that collects all values in a tree in a list, in any order,
without removing duplicates.
*}
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

fun contents :: "'a tree \<Rightarrow> 'a list" where
(* your definition/proof here *)

text{*
Then define a function that sums up all values in a tree of natural numbers
*}

fun sum_tree :: "nat tree \<Rightarrow> nat" where
(* your definition/proof here *)

text{* and prove *}

lemma "sum_tree t = sum_list(contents t)"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Define a new type @{text "'a tree2"} of binary trees where values are also
stored in the leaves of the tree.  Also reformulate the
@{text mirror} function accordingly. Define two functions *}

fun pre_order :: "'a tree2 \<Rightarrow> 'a list" where
(* your definition/proof here *)

fun post_order :: "'a tree2 \<Rightarrow> 'a list" where
(* your definition/proof here *)

text{*
that traverse a tree and collect all stored values in the respective order in
a list. Prove *}

lemma "pre_order (mirror t) = rev (post_order t)"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Define a recursive function
*}

fun intersperse :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
(* your definition/proof here *)

text{*
such that @{text "intersperse a [x\<^sub>1, ..., x\<^sub>n] = [x\<^sub>1, a, x\<^sub>2, a, ..., a, x\<^sub>n]"}.
Prove
*}

lemma "map f (intersperse a xs) = intersperse (f a) (map f xs)"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Write a tail-recursive variant of the @{text add} function on @{typ nat}:
*}

fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
(* your definition/proof here *)

text{*
Tail-recursive means that in the recursive case, @{const itadd} needs to call
itself directly: \mbox{@{term"itadd (Suc m) n"}} @{text"= itadd \<dots>"}.
Prove
*}

lemma "itadd m n = add m n"
(* your definition/proof here *)

text{*
\endexercise

\exercise\label{exe:tree0}
Define a datatype @{text tree0} of binary tree skeletons which do not store
any information, neither in the inner nodes nor in the leaves.
Define a function that counts the number of all nodes (inner nodes and leaves)
in such a tree:
*}

fun nodes :: "tree0 \<Rightarrow> nat" where
(* your definition/proof here *)

text {*
Consider the following recursive function:
*}

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"

text {*
Experiment how @{text explode} influences the size of a binary tree
and find an equation expressing the size of a tree after exploding it
(\noquotes{@{term [source] "nodes (explode n t)"}}) as a function
of @{term "nodes t"} and @{text n}. Prove your equation.
You may use the usual arithmetic operations including the exponentiation
operator ``@{text"^"}''. For example, \noquotes{@{prop [source] "2 ^ 2 = 4"}}.

Hint: simplifying with the list of theorems @{thm[source] algebra_simps}
takes care of common algebraic properties of the arithmetic operators.
\endexercise
*}

text{*

\exercise
Define arithmetic expressions in one variable over integers (type @{typ int})
as a data type:
*}

datatype exp = Var | Const int | Add exp exp | Mult exp exp

text{*
Define a function @{text eval} that evaluates an expression at some value:
*}

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
(* your definition/proof here *)

text{*
For example, @{prop"eval (Add (Mult (Const 2) Var) (Const 3)) i = 2*i+3"}.

A polynomial can be represented as a list of coefficients, starting with
the constant. For example, @{term "[4, 2, -1, 3::int]"} represents the
polynomial $4 + 2x - x^2 + 3x^3$.
Define a function @{text evalp} that evaluates a polynomial at a given value:
*}

fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
(* your definition/proof here *)

text{*
Define a function @{text coeffs} that transforms an expression into a polynomial.
This will require auxiliary functions.
*}

fun coeffs :: "exp \<Rightarrow> int list" where
(* your definition/proof here *)

text{*
Prove that @{text coeffs} preserves the value of the expression:
*}

theorem evalp_coeffs: "evalp (coeffs e) x = eval e x"
(* your definition/proof here *)

text{*
Hint: consider the hint in Exercise~\ref{exe:tree0}.
\endexercise
*}

end


(*
  File:     Fermat_Test.thy
  Authors:  Daniel Stüwe, Manuel Eberl

  The probabilistic prime test known as Fermat's test
*)
section \<open>Fermat's Test\<close>
theory Fermat_Test
imports
  Fermat_Witness
  Generalized_Primality_Test
begin

definition "fermat_test = primality_test (\<lambda>n a. fermat_liar a n)"

text \<open>
  The Fermat test is a good probabilistic primality test on non-Carmichael numbers.
\<close>
locale fermat_test_not_Carmichael_number =
  fixes n :: nat
  assumes not_Carmichael_number: "\<not>Carmichael_number n \<or> n < 3"
begin

sublocale fermat_test: good_prob_primality_test "\<lambda>a n. fermat_liar n a" n "1 / 2"
  rewrites "primality_test (\<lambda> a n. fermat_liar n a) = fermat_test"
proof -
  show "good_prob_primality_test (\<lambda>a n. fermat_liar n a) n (1 / 2)"
    using not_Carmichael_number not_Carmichael_number_imp_card_fermat_witness_bound(3)[of n]
          prime_imp_fermat_liar[of n]
    by unfold_locales auto
qed (auto simp: fermat_test_def)

end

lemma not_coprime_imp_fermat_witness:
  fixes n :: nat
  assumes "n > 1" "\<not>coprime a n"
  shows   "fermat_witness a n"
  using assms lucas_coprime_lemma[of "n - 1" a n]
  by (auto simp: fermat_witness_def)

theorem fermat_test_prime:
  assumes "prime n"
  shows   "fermat_test n = return_pmf True"
proof -
  interpret fermat_test_not_Carmichael_number n
    using assms Carmichael_number_not_prime by unfold_locales auto
  from assms show ?thesis by (rule fermat_test.prime)
qed

theorem fermat_test_composite:
  assumes "\<not>prime n" "\<not>Carmichael_number n \<or> n < 3"
  shows   "pmf (fermat_test n) True < 1 / 2"
proof -
  interpret fermat_test_not_Carmichael_number n by unfold_locales fact+
  from assms(1) show ?thesis by (rule fermat_test.composite)
qed

text \<open>
  For a Carmichael number $n$, Fermat's test as defined above mistakenly returns `True'
  with probability $(\varphi(n)-1) / (n - 2)$. This probability is close to 1 if \<open>n\<close>
  has few and big prime factors; it is not quite as bad if it has many and/or small factors,
  but in that case, simple trial division can also detect compositeness.

  Moreover, Fermat's test only succeeds for a Carmichael number if it happens to guess a
  number that is not coprime to \<open>n\<close>. In that case, the fact that we have found
  a number between 2 and \<open>n\<close> that is not coprime to \<open>n\<close> alone is
  proof that \<open>n\<close> is composite, and indeed we can even find a non-trivial factor
  by computing the GCD. This means that for Carmichael numbers, Fermat's test is essentially
  no better than the very crude method of attempting to guess numbers coprime to \<open>n\<close>.

  This means that, in general, Fermat's test is not very helpful for Carmichael numbers.
\<close>
theorem fermat_test_Carmichael_number:
  assumes "Carmichael_number n"
  shows   "fermat_test n = bernoulli_pmf (real (totient n - 1) / real (n - 2))"
proof (rule eq_bernoulli_pmfI)
  from assms have n: "n > 3" "odd n"
    using Carmichael_number_odd Carmichael_number_gt_3 by auto
  from n have "fermat_test n = pmf_of_set {2..<n} \<bind> (\<lambda>a. return_pmf (fermat_liar a n))"
    by (simp add: fermat_test_def primality_test_def)
  also have "\<dots> = pmf_of_set {2..<n} \<bind> (\<lambda>a. return_pmf (coprime a n))"
    using n assms lucas_coprime_lemma[of "n - 1" _ n]
    by (intro bind_pmf_cong refl) (auto simp: Carmichael_number_def fermat_liar_def)
  also have "pmf \<dots> True = (\<Sum>a=2..<n. indicat_real {True} (coprime a n)) / real (n - 2)"
    using n by (auto simp: pmf_bind_pmf_of_set)
  also have "(\<Sum>a=2..<n. indicat_real {True} (coprime a n)) =
               (\<Sum>a | a \<in> {2..<n} \<and> coprime a n. 1)"
    by (intro sum.mono_neutral_cong_right) auto
  also have "\<dots> = card {a\<in>{2..<n}. coprime a n}"
    by simp
  also have "{a\<in>{2..<n}. coprime a n} = totatives n - {1}"
    using n by (auto simp: totatives_def order.strict_iff_order[of _ n])
  also have "card \<dots> = totient n - 1"
    using n by (subst card_Diff_subset) (auto simp: totient_def)
  finally show "pmf (fermat_test n) True = real (totient n - 1) / real (n - 2)"
    using n by simp
qed

end