adapted HOL source structure to distribution layout
authorhaftmann
Mon Dec 29 14:08:08 2008 +0100 (2008-12-29)
changeset 291976d4cb27ed19c
parent 29189 ee8572f3bb57
child 29198 418ed6411847
adapted HOL source structure to distribution layout
NEWS
src/HOL/Complex/Fundamental_Theorem_Algebra.thy
src/HOL/Complex/README.html
src/HOL/Complex/document/root.tex
src/HOL/Complex_Main.thy
src/HOL/Dense_Linear_Order.thy
src/HOL/Fundamental_Theorem_Algebra.thy
src/HOL/HahnBanach/Bounds.thy
src/HOL/HahnBanach/FunctionNorm.thy
src/HOL/HahnBanach/FunctionOrder.thy
src/HOL/HahnBanach/HahnBanach.thy
src/HOL/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/HahnBanach/HahnBanachLemmas.thy
src/HOL/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/HahnBanach/Linearform.thy
src/HOL/HahnBanach/NormedSpace.thy
src/HOL/HahnBanach/README.html
src/HOL/HahnBanach/ROOT.ML
src/HOL/HahnBanach/Subspace.thy
src/HOL/HahnBanach/VectorSpace.thy
src/HOL/HahnBanach/ZornLemma.thy
src/HOL/HahnBanach/document/root.bib
src/HOL/HahnBanach/document/root.tex
src/HOL/Hyperreal/SEQ.thy
src/HOL/IsaMakefile
src/HOL/Library/Dense_Linear_Order.thy
src/HOL/Library/Library.thy
src/HOL/Lim.thy
src/HOL/PReal.thy
src/HOL/Real.thy
src/HOL/Real/HahnBanach/Bounds.thy
src/HOL/Real/HahnBanach/FunctionNorm.thy
src/HOL/Real/HahnBanach/FunctionOrder.thy
src/HOL/Real/HahnBanach/HahnBanach.thy
src/HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/Real/HahnBanach/Linearform.thy
src/HOL/Real/HahnBanach/NormedSpace.thy
src/HOL/Real/HahnBanach/README.html
src/HOL/Real/HahnBanach/ROOT.ML
src/HOL/Real/HahnBanach/Subspace.thy
src/HOL/Real/HahnBanach/VectorSpace.thy
src/HOL/Real/HahnBanach/ZornLemma.thy
src/HOL/Real/HahnBanach/document/root.bib
src/HOL/Real/HahnBanach/document/root.tex
src/HOL/Real/RealVector.thy
src/HOL/RealVector.thy
src/HOL/SEQ.thy
src/HOL/Series.thy
     1.1 --- a/NEWS	Mon Dec 29 13:23:53 2008 +0100
     1.2 +++ b/NEWS	Mon Dec 29 14:08:08 2008 +0100
     1.3 @@ -157,11 +157,12 @@
     1.4  
     1.5  *** HOL ***
     1.6  
     1.7 -* Made repository layout more coherent with logical
     1.8 -distribution structure:
     1.9 +* Made source layout more coherent with logical distribution
    1.10 +structure:
    1.11  
    1.12      src/HOL/Library/RType.thy ~> src/HOL/Typerep.thy
    1.13      src/HOL/Library/Code_Message.thy ~> src/HOL/
    1.14 +    src/HOL/Library/Dense_Linear_Order.thy ~> src/HOL/
    1.15      src/HOL/Library/GCD.thy ~> src/HOL/
    1.16      src/HOL/Library/Order_Relation.thy ~> src/HOL/
    1.17      src/HOL/Library/Parity.thy ~> src/HOL/
    1.18 @@ -177,6 +178,7 @@
    1.19      src/HOL/Complex/Complex_Main.thy ~> src/HOL/
    1.20      src/HOL/Complex/Complex.thy ~> src/HOL/
    1.21      src/HOL/Complex/FrechetDeriv.thy ~> src/HOL/
    1.22 +    src/HOL/Complex/Fundamental_Theorem_Algebra.thy ~> src/HOL/
    1.23      src/HOL/Hyperreal/Deriv.thy ~> src/HOL/
    1.24      src/HOL/Hyperreal/Fact.thy ~> src/HOL/
    1.25      src/HOL/Hyperreal/Integration.thy ~> src/HOL/
    1.26 @@ -186,9 +188,12 @@
    1.27      src/HOL/Hyperreal/MacLaurin.thy ~> src/HOL/
    1.28      src/HOL/Hyperreal/NthRoot.thy ~> src/HOL/
    1.29      src/HOL/Hyperreal/Series.thy ~> src/HOL/
    1.30 +    src/HOL/Hyperreal/SEQ.thy ~> src/HOL/
    1.31      src/HOL/Hyperreal/Taylor.thy ~> src/HOL/
    1.32      src/HOL/Hyperreal/Transcendental.thy ~> src/HOL/
    1.33      src/HOL/Real/Float ~> src/HOL/Library/
    1.34 +    src/HOL/Real/HahnBanach ~> src/HOL/HahnBanach
    1.35 +    src/HOL/Real/RealVector.thy ~> src/HOL/
    1.36  
    1.37      src/HOL/arith_data.ML ~> src/HOL/Tools
    1.38      src/HOL/hologic.ML ~> src/HOL/Tools
     2.1 --- a/src/HOL/Complex/Fundamental_Theorem_Algebra.thy	Mon Dec 29 13:23:53 2008 +0100
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,1329 +0,0 @@
     2.4 -(*  Title:       Fundamental_Theorem_Algebra.thy
     2.5 -    Author:      Amine Chaieb
     2.6 -*)
     2.7 -
     2.8 -header{*Fundamental Theorem of Algebra*}
     2.9 -
    2.10 -theory Fundamental_Theorem_Algebra
    2.11 -imports "~~/src/HOL/Univ_Poly" "~~/src/HOL/Library/Dense_Linear_Order" "~~/src/HOL/Complex"
    2.12 -begin
    2.13 -
    2.14 -subsection {* Square root of complex numbers *}
    2.15 -definition csqrt :: "complex \<Rightarrow> complex" where
    2.16 -"csqrt z = (if Im z = 0 then
    2.17 -            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
    2.18 -            else Complex 0 (sqrt(- Re z))
    2.19 -           else Complex (sqrt((cmod z + Re z) /2))
    2.20 -                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
    2.21 -
    2.22 -lemma csqrt[algebra]: "csqrt z ^ 2 = z"
    2.23 -proof-
    2.24 -  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
    2.25 -  {assume y0: "y = 0"
    2.26 -    {assume x0: "x \<ge> 0" 
    2.27 -      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
    2.28 -	by (simp add: csqrt_def power2_eq_square)}
    2.29 -    moreover
    2.30 -    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
    2.31 -      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
    2.32 -	by (simp add: csqrt_def power2_eq_square) }
    2.33 -    ultimately have ?thesis by blast}
    2.34 -  moreover
    2.35 -  {assume y0: "y\<noteq>0"
    2.36 -    {fix x y
    2.37 -      let ?z = "Complex x y"
    2.38 -      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
    2.39 -      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
    2.40 -      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
    2.41 -    note th = this
    2.42 -    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
    2.43 -      by (simp add: power2_eq_square) 
    2.44 -    from th[of x y]
    2.45 -    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
    2.46 -    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
    2.47 -      unfolding power2_eq_square by simp 
    2.48 -    have "sqrt 4 = sqrt (2^2)" by simp 
    2.49 -    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
    2.50 -    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
    2.51 -      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
    2.52 -      unfolding power2_eq_square 
    2.53 -      by (simp add: ring_simps real_sqrt_divide sqrt4)
    2.54 -     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
    2.55 -       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
    2.56 -      using th1 th2  ..}
    2.57 -  ultimately show ?thesis by blast
    2.58 -qed
    2.59 -
    2.60 -
    2.61 -subsection{* More lemmas about module of complex numbers *}
    2.62 -
    2.63 -lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
    2.64 -  by (rule of_real_power [symmetric])
    2.65 -
    2.66 -lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
    2.67 -  apply ferrack apply arith done
    2.68 -
    2.69 -text{* The triangle inequality for cmod *}
    2.70 -lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
    2.71 -  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
    2.72 -
    2.73 -subsection{* Basic lemmas about complex polynomials *}
    2.74 -
    2.75 -lemma poly_bound_exists:
    2.76 -  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
    2.77 -proof(induct p)
    2.78 -  case Nil thus ?case by (rule exI[where x=1], simp) 
    2.79 -next
    2.80 -  case (Cons c cs)
    2.81 -  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
    2.82 -    by blast
    2.83 -  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
    2.84 -  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
    2.85 -  {fix z
    2.86 -    assume H: "cmod z \<le> r"
    2.87 -    from m H have th: "cmod (poly cs z) \<le> m" by blast
    2.88 -    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
    2.89 -    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
    2.90 -      using norm_triangle_ineq[of c "z* poly cs z"] by simp
    2.91 -    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
    2.92 -    also have "\<dots> \<le> ?k" by simp
    2.93 -    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
    2.94 -  with kp show ?case by blast
    2.95 -qed
    2.96 -
    2.97 -
    2.98 -text{* Offsetting the variable in a polynomial gives another of same degree *}
    2.99 -  (* FIXME : Lemma holds also in locale --- fix it later *)
   2.100 -lemma  poly_offset_lemma:
   2.101 -  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
   2.102 -proof(induct p)
   2.103 -  case Nil thus ?case by simp
   2.104 -next
   2.105 -  case (Cons c cs)
   2.106 -  from Cons.hyps obtain b q where 
   2.107 -    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
   2.108 -    by blast
   2.109 -  let ?b = "a*c"
   2.110 -  let ?q = "(b+c)#q"
   2.111 -  have lg: "length ?q = length (c#cs)" using bq(1) by simp
   2.112 -  {fix x
   2.113 -    from bq(2)[rule_format, of x]
   2.114 -    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
   2.115 -    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
   2.116 -      by (simp add: ring_simps)}
   2.117 -  with lg  show ?case by blast 
   2.118 -qed
   2.119 -
   2.120 -    (* FIXME : This one too*)
   2.121 -lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
   2.122 -proof (induct p)
   2.123 -  case Nil thus ?case by simp
   2.124 -next
   2.125 -  case (Cons c cs)
   2.126 -  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
   2.127 -  from poly_offset_lemma[of q a] obtain b p where 
   2.128 -    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
   2.129 -    by blast
   2.130 -  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
   2.131 -qed
   2.132 -
   2.133 -text{* An alternative useful formulation of completeness of the reals *}
   2.134 -lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
   2.135 -  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
   2.136 -proof-
   2.137 -  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
   2.138 -  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
   2.139 -  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
   2.140 -    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
   2.141 -  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
   2.142 -    by blast
   2.143 -  from Y[OF x] have xY: "x < Y" .
   2.144 -  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
   2.145 -  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
   2.146 -    apply (clarsimp, atomize (full)) by auto 
   2.147 -  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
   2.148 -  {fix y
   2.149 -    {fix z assume z: "P z" "y < z"
   2.150 -      from L' z have "y < L" by auto }
   2.151 -    moreover
   2.152 -    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
   2.153 -      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
   2.154 -      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
   2.155 -      with yL(1) have False  by arith}
   2.156 -    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
   2.157 -  thus ?thesis by blast
   2.158 -qed
   2.159 -
   2.160 -
   2.161 -subsection{* Some theorems about Sequences*}
   2.162 -text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
   2.163 -
   2.164 -lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
   2.165 -  unfolding Ex1_def
   2.166 -  apply (rule_tac x="nat_rec e f" in exI)
   2.167 -  apply (rule conjI)+
   2.168 -apply (rule def_nat_rec_0, simp)
   2.169 -apply (rule allI, rule def_nat_rec_Suc, simp)
   2.170 -apply (rule allI, rule impI, rule ext)
   2.171 -apply (erule conjE)
   2.172 -apply (induct_tac x)
   2.173 -apply (simp add: nat_rec_0)
   2.174 -apply (erule_tac x="n" in allE)
   2.175 -apply (simp)
   2.176 -done
   2.177 -
   2.178 - text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
   2.179 -lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
   2.180 -unfolding mono_def
   2.181 -proof auto
   2.182 -  fix A B :: nat
   2.183 -  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
   2.184 -  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
   2.185 -    by presburger
   2.186 -  then obtain k where k: "B = A + k" by blast
   2.187 -  {fix a k
   2.188 -    have "f a \<le> f (a + k)"
   2.189 -    proof (induct k)
   2.190 -      case 0 thus ?case by simp
   2.191 -    next
   2.192 -      case (Suc k)
   2.193 -      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
   2.194 -    qed}
   2.195 -  with k show "f A \<le> f B" by blast
   2.196 -qed
   2.197 -
   2.198 -text{* for any sequence, there is a mootonic subsequence *}
   2.199 -lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
   2.200 -proof-
   2.201 -  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
   2.202 -    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
   2.203 -    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
   2.204 -    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
   2.205 -    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
   2.206 -      using H apply - 
   2.207 -      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
   2.208 -      unfolding order_le_less by blast 
   2.209 -    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
   2.210 -    {fix n
   2.211 -      have "?P (f (Suc n)) (f n)" 
   2.212 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
   2.213 -	using H apply - 
   2.214 -      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
   2.215 -      unfolding order_le_less by blast 
   2.216 -    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
   2.217 -  note fSuc = this
   2.218 -    {fix p q assume pq: "p \<ge> f q"
   2.219 -      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
   2.220 -	by (cases q, simp_all) }
   2.221 -    note pqth = this
   2.222 -    {fix q
   2.223 -      have "f (Suc q) > f q" apply (induct q) 
   2.224 -	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
   2.225 -    note fss = this
   2.226 -    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
   2.227 -    {fix a b 
   2.228 -      have "f a \<le> f (a + b)"
   2.229 -      proof(induct b)
   2.230 -	case 0 thus ?case by simp
   2.231 -      next
   2.232 -	case (Suc b)
   2.233 -	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
   2.234 -      qed}
   2.235 -    note fmon0 = this
   2.236 -    have "monoseq (\<lambda>n. s (f n))" 
   2.237 -    proof-
   2.238 -      {fix n
   2.239 -	have "s (f n) \<ge> s (f (Suc n))" 
   2.240 -	proof(cases n)
   2.241 -	  case 0
   2.242 -	  assume n0: "n = 0"
   2.243 -	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
   2.244 -	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
   2.245 -	next
   2.246 -	  case (Suc m)
   2.247 -	  assume m: "n = Suc m"
   2.248 -	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
   2.249 -	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
   2.250 -	qed}
   2.251 -      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
   2.252 -    qed
   2.253 -    with th1 have ?thesis by blast}
   2.254 -  moreover
   2.255 -  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
   2.256 -    {fix p assume p: "p \<ge> Suc N" 
   2.257 -      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
   2.258 -      have "m \<noteq> p" using m(2) by auto 
   2.259 -      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
   2.260 -    note th0 = this
   2.261 -    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
   2.262 -    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
   2.263 -    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
   2.264 -      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
   2.265 -    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
   2.266 -      using N apply - 
   2.267 -      apply (erule allE[where x="Suc N"], clarsimp)
   2.268 -      apply (rule_tac x="m" in exI)
   2.269 -      apply auto
   2.270 -      apply (subgoal_tac "Suc N \<noteq> m")
   2.271 -      apply simp
   2.272 -      apply (rule ccontr, simp)
   2.273 -      done
   2.274 -    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
   2.275 -    {fix n
   2.276 -      have "f n > N \<and> ?P (f (Suc n)) (f n)"
   2.277 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
   2.278 -      proof (induct n)
   2.279 -	case 0 thus ?case
   2.280 -	  using f0 N apply auto 
   2.281 -	  apply (erule allE[where x="f 0"], clarsimp) 
   2.282 -	  apply (rule_tac x="m" in exI, simp)
   2.283 -	  by (subgoal_tac "f 0 \<noteq> m", auto)
   2.284 -      next
   2.285 -	case (Suc n)
   2.286 -	from Suc.hyps have Nfn: "N < f n" by blast
   2.287 -	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
   2.288 -	with Nfn have mN: "m > N" by arith
   2.289 -	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
   2.290 -	
   2.291 -	from key have th0: "f (Suc n) > N" by simp
   2.292 -	from N[rule_format, OF th0]
   2.293 -	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
   2.294 -	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
   2.295 -	hence "m' > f (Suc n)" using m'(1) by simp
   2.296 -	with key m'(2) show ?case by auto
   2.297 -      qed}
   2.298 -    note fSuc = this
   2.299 -    {fix n
   2.300 -      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
   2.301 -      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
   2.302 -    note thf = this
   2.303 -    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
   2.304 -    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
   2.305 -      apply -
   2.306 -      apply (rule disjI1)
   2.307 -      apply auto
   2.308 -      apply (rule order_less_imp_le)
   2.309 -      apply blast
   2.310 -      done
   2.311 -    then have ?thesis  using sqf by blast}
   2.312 -  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
   2.313 -qed
   2.314 -
   2.315 -lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
   2.316 -proof(induct n)
   2.317 -  case 0 thus ?case by simp
   2.318 -next
   2.319 -  case (Suc n)
   2.320 -  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
   2.321 -  have "n < f (Suc n)" by arith 
   2.322 -  thus ?case by arith
   2.323 -qed
   2.324 -
   2.325 -subsection {* Fundamental theorem of algebra *}
   2.326 -lemma  unimodular_reduce_norm:
   2.327 -  assumes md: "cmod z = 1"
   2.328 -  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
   2.329 -proof-
   2.330 -  obtain x y where z: "z = Complex x y " by (cases z, auto)
   2.331 -  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
   2.332 -  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
   2.333 -    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
   2.334 -      by (simp_all add: cmod_def power2_eq_square ring_simps)
   2.335 -    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
   2.336 -    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
   2.337 -      by - (rule power_mono, simp, simp)+
   2.338 -    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
   2.339 -      by (simp_all  add: power2_abs power_mult_distrib)
   2.340 -    from add_mono[OF th0] xy have False by simp }
   2.341 -  thus ?thesis unfolding linorder_not_le[symmetric] by blast
   2.342 -qed
   2.343 -
   2.344 -text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
   2.345 -lemma reduce_poly_simple:
   2.346 - assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
   2.347 -  shows "\<exists>z. cmod (1 + b * z^n) < 1"
   2.348 -using n
   2.349 -proof(induct n rule: nat_less_induct)
   2.350 -  fix n
   2.351 -  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
   2.352 -  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
   2.353 -  {assume e: "even n"
   2.354 -    hence "\<exists>m. n = 2*m" by presburger
   2.355 -    then obtain m where m: "n = 2*m" by blast
   2.356 -    from n m have "m\<noteq>0" "m < n" by presburger+
   2.357 -    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
   2.358 -    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
   2.359 -    hence "\<exists>z. ?P z n" ..}
   2.360 -  moreover
   2.361 -  {assume o: "odd n"
   2.362 -    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
   2.363 -    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
   2.364 -    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
   2.365 -    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
   2.366 -    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
   2.367 -      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
   2.368 -      by (simp add: power2_eq_square)
   2.369 -    finally 
   2.370 -    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
   2.371 -    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
   2.372 -    1" 
   2.373 -      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
   2.374 -      using right_inverse[OF b']
   2.375 -      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
   2.376 -    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
   2.377 -      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
   2.378 -      by (simp add: real_sqrt_mult[symmetric] th0)        
   2.379 -    from o have "\<exists>m. n = Suc (2*m)" by presburger+
   2.380 -    then obtain m where m: "n = Suc (2*m)" by blast
   2.381 -    from unimodular_reduce_norm[OF th0] o
   2.382 -    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
   2.383 -      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
   2.384 -      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
   2.385 -      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
   2.386 -      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
   2.387 -      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
   2.388 -      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
   2.389 -      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
   2.390 -      done
   2.391 -    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
   2.392 -    let ?w = "v / complex_of_real (root n (cmod b))"
   2.393 -    from odd_real_root_pow[OF o, of "cmod b"]
   2.394 -    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
   2.395 -      by (simp add: power_divide complex_of_real_power)
   2.396 -    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
   2.397 -    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
   2.398 -    have th4: "cmod (complex_of_real (cmod b) / b) *
   2.399 -   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
   2.400 -   < cmod (complex_of_real (cmod b) / b) * 1"
   2.401 -      apply (simp only: norm_mult[symmetric] right_distrib)
   2.402 -      using b v by (simp add: th2)
   2.403 -
   2.404 -    from mult_less_imp_less_left[OF th4 th3]
   2.405 -    have "?P ?w n" unfolding th1 . 
   2.406 -    hence "\<exists>z. ?P z n" .. }
   2.407 -  ultimately show "\<exists>z. ?P z n" by blast
   2.408 -qed
   2.409 -
   2.410 -
   2.411 -text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
   2.412 -
   2.413 -lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
   2.414 -  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
   2.415 -  unfolding cmod_def by simp
   2.416 -
   2.417 -lemma bolzano_weierstrass_complex_disc:
   2.418 -  assumes r: "\<forall>n. cmod (s n) \<le> r"
   2.419 -  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
   2.420 -proof-
   2.421 -  from seq_monosub[of "Re o s"] 
   2.422 -  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
   2.423 -    unfolding o_def by blast
   2.424 -  from seq_monosub[of "Im o s o f"] 
   2.425 -  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
   2.426 -  let ?h = "f o g"
   2.427 -  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
   2.428 -  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
   2.429 -  proof
   2.430 -    fix n
   2.431 -    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
   2.432 -  qed
   2.433 -  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
   2.434 -    apply (rule Bseq_monoseq_convergent)
   2.435 -    apply (simp add: Bseq_def)
   2.436 -    apply (rule exI[where x= "r + 1"])
   2.437 -    using th rp apply simp
   2.438 -    using f(2) .
   2.439 -  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
   2.440 -  proof
   2.441 -    fix n
   2.442 -    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
   2.443 -  qed
   2.444 -
   2.445 -  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
   2.446 -    apply (rule Bseq_monoseq_convergent)
   2.447 -    apply (simp add: Bseq_def)
   2.448 -    apply (rule exI[where x= "r + 1"])
   2.449 -    using th rp apply simp
   2.450 -    using g(2) .
   2.451 -
   2.452 -  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
   2.453 -    by blast 
   2.454 -  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
   2.455 -    unfolding LIMSEQ_def real_norm_def .
   2.456 -
   2.457 -  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
   2.458 -    by blast 
   2.459 -  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
   2.460 -    unfolding LIMSEQ_def real_norm_def .
   2.461 -  let ?w = "Complex x y"
   2.462 -  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
   2.463 -  {fix e assume ep: "e > (0::real)"
   2.464 -    hence e2: "e/2 > 0" by simp
   2.465 -    from x[rule_format, OF e2] y[rule_format, OF e2]
   2.466 -    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
   2.467 -    {fix n assume nN12: "n \<ge> N1 + N2"
   2.468 -      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
   2.469 -      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
   2.470 -      have "cmod (s (?h n) - ?w) < e" 
   2.471 -	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
   2.472 -    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
   2.473 -  with hs show ?thesis  by blast  
   2.474 -qed
   2.475 -
   2.476 -text{* Polynomial is continuous. *}
   2.477 -
   2.478 -lemma poly_cont:
   2.479 -  assumes ep: "e > 0" 
   2.480 -  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
   2.481 -proof-
   2.482 -  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
   2.483 -  {fix w
   2.484 -    note q(2)[of "w - z", simplified]}
   2.485 -  note th = this
   2.486 -  show ?thesis unfolding th[symmetric]
   2.487 -  proof(induct q)
   2.488 -    case Nil thus ?case  using ep by auto
   2.489 -  next
   2.490 -    case (Cons c cs)
   2.491 -    from poly_bound_exists[of 1 "cs"] 
   2.492 -    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
   2.493 -    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
   2.494 -    have one0: "1 > (0::real)"  by arith
   2.495 -    from real_lbound_gt_zero[OF one0 em0] 
   2.496 -    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
   2.497 -    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
   2.498 -      by (simp_all add: field_simps real_mult_order)
   2.499 -    show ?case 
   2.500 -      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
   2.501 -	fix d w
   2.502 -	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
   2.503 -	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
   2.504 -	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
   2.505 -	from H have th: "cmod (w-z) \<le> d" by simp 
   2.506 -	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
   2.507 -	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
   2.508 -      qed  
   2.509 -    qed
   2.510 -qed
   2.511 -
   2.512 -text{* Hence a polynomial attains minimum on a closed disc 
   2.513 -  in the complex plane. *}
   2.514 -lemma  poly_minimum_modulus_disc:
   2.515 -  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
   2.516 -proof-
   2.517 -  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
   2.518 -      apply -
   2.519 -      apply (rule exI[where x=0]) 
   2.520 -      apply auto
   2.521 -      apply (subgoal_tac "cmod w < 0")
   2.522 -      apply simp
   2.523 -      apply arith
   2.524 -      done }
   2.525 -  moreover
   2.526 -  {assume rp: "r \<ge> 0"
   2.527 -    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
   2.528 -    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
   2.529 -    {fix x z
   2.530 -      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
   2.531 -      hence "- x < 0 " by arith
   2.532 -      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
   2.533 -    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
   2.534 -    from real_sup_exists[OF mth1 mth2] obtain s where 
   2.535 -      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
   2.536 -    let ?m = "-s"
   2.537 -    {fix y
   2.538 -      from s[rule_format, of "-y"] have 
   2.539 -    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
   2.540 -	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
   2.541 -    note s1 = this[unfolded minus_minus]
   2.542 -    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
   2.543 -      by auto
   2.544 -    {fix n::nat
   2.545 -      from s1[rule_format, of "?m + 1/real (Suc n)"] 
   2.546 -      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
   2.547 -	by simp}
   2.548 -    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
   2.549 -    from choice[OF th] obtain g where 
   2.550 -      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
   2.551 -      by blast
   2.552 -    from bolzano_weierstrass_complex_disc[OF g(1)] 
   2.553 -    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
   2.554 -      by blast    
   2.555 -    {fix w 
   2.556 -      assume wr: "cmod w \<le> r"
   2.557 -      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
   2.558 -      {assume e: "?e > 0"
   2.559 -	hence e2: "?e/2 > 0" by simp
   2.560 -	from poly_cont[OF e2, of z p] obtain d where
   2.561 -	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
   2.562 -	{fix w assume w: "cmod (w - z) < d"
   2.563 -	  have "cmod(poly p w - poly p z) < ?e / 2"
   2.564 -	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
   2.565 -	note th1 = this
   2.566 -	
   2.567 -	from fz(2)[rule_format, OF d(1)] obtain N1 where 
   2.568 -	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
   2.569 -	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
   2.570 -	  N2: "2/?e < real N2" by blast
   2.571 -	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
   2.572 -	  using N1[rule_format, of "N1 + N2"] th1 by simp
   2.573 -	{fix a b e2 m :: real
   2.574 -	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
   2.575 -          ==> False" by arith}
   2.576 -      note th0 = this
   2.577 -      have ath: 
   2.578 -	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
   2.579 -      from s1m[OF g(1)[rule_format]]
   2.580 -      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
   2.581 -      from seq_suble[OF fz(1), of "N1+N2"]
   2.582 -      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
   2.583 -      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
   2.584 -	using N2 by auto
   2.585 -      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
   2.586 -      from g(2)[rule_format, of "f (N1 + N2)"]
   2.587 -      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
   2.588 -      from order_less_le_trans[OF th01 th00]
   2.589 -      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
   2.590 -      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
   2.591 -      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
   2.592 -      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
   2.593 -      with ath[OF th31 th32]
   2.594 -      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
   2.595 -      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
   2.596 -	by arith
   2.597 -      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
   2.598 -\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
   2.599 -	by (simp add: norm_triangle_ineq3)
   2.600 -      from ath2[OF th22, of ?m]
   2.601 -      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
   2.602 -      from th0[OF th2 thc1 thc2] have False .}
   2.603 -      hence "?e = 0" by auto
   2.604 -      then have "cmod (poly p z) = ?m" by simp  
   2.605 -      with s1m[OF wr]
   2.606 -      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
   2.607 -    hence ?thesis by blast}
   2.608 -  ultimately show ?thesis by blast
   2.609 -qed
   2.610 -
   2.611 -lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
   2.612 -  unfolding power2_eq_square
   2.613 -  apply (simp add: rcis_mult)
   2.614 -  apply (simp add: power2_eq_square[symmetric])
   2.615 -  done
   2.616 -
   2.617 -lemma cispi: "cis pi = -1" 
   2.618 -  unfolding cis_def
   2.619 -  by simp
   2.620 -
   2.621 -lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
   2.622 -  unfolding power2_eq_square
   2.623 -  apply (simp add: rcis_mult add_divide_distrib)
   2.624 -  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
   2.625 -  done
   2.626 -
   2.627 -text {* Nonzero polynomial in z goes to infinity as z does. *}
   2.628 -
   2.629 -instance complex::idom_char_0 by (intro_classes)
   2.630 -instance complex :: recpower_idom_char_0 by intro_classes
   2.631 -
   2.632 -lemma poly_infinity:
   2.633 -  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
   2.634 -  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
   2.635 -using ex
   2.636 -proof(induct p arbitrary: a d)
   2.637 -  case (Cons c cs a d) 
   2.638 -  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
   2.639 -    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
   2.640 -    let ?r = "1 + \<bar>r\<bar>"
   2.641 -    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
   2.642 -      have r0: "r \<le> cmod z" using h by arith
   2.643 -      from r[rule_format, OF r0]
   2.644 -      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
   2.645 -      from h have z1: "cmod z \<ge> 1" by arith
   2.646 -      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
   2.647 -      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
   2.648 -	unfolding norm_mult by (simp add: ring_simps)
   2.649 -      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
   2.650 -      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
   2.651 -	by (simp add: diff_le_eq ring_simps) 
   2.652 -      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
   2.653 -    hence ?case by blast}
   2.654 -  moreover
   2.655 -  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
   2.656 -    with Cons.prems have c0: "c \<noteq> 0" by simp
   2.657 -    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
   2.658 -      by (auto simp add: list_all_iff list_ex_iff)
   2.659 -    {fix z
   2.660 -      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
   2.661 -      from c0 have "cmod c > 0" by simp
   2.662 -      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
   2.663 -	by (simp add: field_simps norm_mult)
   2.664 -      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
   2.665 -      from complex_mod_triangle_sub[of "z*c" a ]
   2.666 -      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
   2.667 -	by (simp add: ring_simps)
   2.668 -      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
   2.669 -	using poly_0[OF cs0'] by simp}
   2.670 -    then have ?case  by blast}
   2.671 -  ultimately show ?case by blast
   2.672 -qed simp
   2.673 -
   2.674 -text {* Hence polynomial's modulus attains its minimum somewhere. *}
   2.675 -lemma poly_minimum_modulus:
   2.676 -  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
   2.677 -proof(induct p)
   2.678 -  case (Cons c cs) 
   2.679 -  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
   2.680 -    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
   2.681 -    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
   2.682 -    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
   2.683 -    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
   2.684 -    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
   2.685 -    {fix z assume z: "r \<le> cmod z"
   2.686 -      from v[of 0] r[OF z] 
   2.687 -      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
   2.688 -	by simp }
   2.689 -    note v0 = this
   2.690 -    from v0 v ath[of r] have ?case by blast}
   2.691 -  moreover
   2.692 -  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
   2.693 -    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
   2.694 -    from poly_0[OF th] Cons.hyps have ?case by simp}
   2.695 -  ultimately show ?case by blast
   2.696 -qed simp
   2.697 -
   2.698 -text{* Constant function (non-syntactic characterization). *}
   2.699 -definition "constant f = (\<forall>x y. f x = f y)"
   2.700 -
   2.701 -lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
   2.702 -  unfolding constant_def
   2.703 -  apply (induct p, auto)
   2.704 -  apply (unfold not_less[symmetric])
   2.705 -  apply simp
   2.706 -  apply (rule ccontr)
   2.707 -  apply auto
   2.708 -  done
   2.709 - 
   2.710 -lemma poly_replicate_append:
   2.711 -  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
   2.712 -  by(induct n, auto simp add: power_Suc ring_simps)
   2.713 -
   2.714 -text {* Decomposition of polynomial, skipping zero coefficients 
   2.715 -  after the first.  *}
   2.716 -
   2.717 -lemma poly_decompose_lemma:
   2.718 - assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
   2.719 -  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
   2.720 -                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
   2.721 -using nz
   2.722 -proof(induct p)
   2.723 -  case Nil thus ?case by simp
   2.724 -next
   2.725 -  case (Cons c cs)
   2.726 -  {assume c0: "c = 0"
   2.727 -    
   2.728 -    from Cons.hyps Cons.prems c0 have ?case apply auto
   2.729 -      apply (rule_tac x="k+1" in exI)
   2.730 -      apply (rule_tac x="a" in exI, clarsimp)
   2.731 -      apply (rule_tac x="q" in exI)
   2.732 -      by (auto simp add: power_Suc)}
   2.733 -  moreover
   2.734 -  {assume c0: "c\<noteq>0"
   2.735 -    hence ?case apply-
   2.736 -      apply (rule exI[where x=0])
   2.737 -      apply (rule exI[where x=c], clarsimp)
   2.738 -      apply (rule exI[where x=cs])
   2.739 -      apply auto
   2.740 -      done}
   2.741 -  ultimately show ?case by blast
   2.742 -qed
   2.743 -
   2.744 -lemma poly_decompose:
   2.745 -  assumes nc: "~constant(poly p)"
   2.746 -  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
   2.747 -               length q + k + 1 = length p \<and> 
   2.748 -              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
   2.749 -using nc 
   2.750 -proof(induct p)
   2.751 -  case Nil thus ?case by (simp add: constant_def)
   2.752 -next
   2.753 -  case (Cons c cs)
   2.754 -  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
   2.755 -    {fix x y
   2.756 -      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
   2.757 -    with Cons.prems have False by (auto simp add: constant_def)}
   2.758 -  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
   2.759 -  from poly_decompose_lemma[OF th] 
   2.760 -  show ?case 
   2.761 -    apply clarsimp    
   2.762 -    apply (rule_tac x="k+1" in exI)
   2.763 -    apply (rule_tac x="a" in exI)
   2.764 -    apply simp
   2.765 -    apply (rule_tac x="q" in exI)
   2.766 -    apply (auto simp add: power_Suc)
   2.767 -    done
   2.768 -qed
   2.769 -
   2.770 -text{* Fundamental theorem of algebral *}
   2.771 -
   2.772 -lemma fundamental_theorem_of_algebra:
   2.773 -  assumes nc: "~constant(poly p)"
   2.774 -  shows "\<exists>z::complex. poly p z = 0"
   2.775 -using nc
   2.776 -proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
   2.777 -  fix n fix p :: "complex list"
   2.778 -  let ?p = "poly p"
   2.779 -  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
   2.780 -  let ?ths = "\<exists>z. ?p z = 0"
   2.781 -
   2.782 -  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
   2.783 -  from poly_minimum_modulus obtain c where 
   2.784 -    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
   2.785 -  {assume pc: "?p c = 0" hence ?ths by blast}
   2.786 -  moreover
   2.787 -  {assume pc0: "?p c \<noteq> 0"
   2.788 -    from poly_offset[of p c] obtain q where
   2.789 -      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
   2.790 -    {assume h: "constant (poly q)"
   2.791 -      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
   2.792 -      {fix x y
   2.793 -	from th have "?p x = poly q (x - c)" by auto 
   2.794 -	also have "\<dots> = poly q (y - c)" 
   2.795 -	  using h unfolding constant_def by blast
   2.796 -	also have "\<dots> = ?p y" using th by auto
   2.797 -	finally have "?p x = ?p y" .}
   2.798 -      with nc have False unfolding constant_def by blast }
   2.799 -    hence qnc: "\<not> constant (poly q)" by blast
   2.800 -    from q(2) have pqc0: "?p c = poly q 0" by simp
   2.801 -    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
   2.802 -    let ?a0 = "poly q 0"
   2.803 -    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
   2.804 -    from a00 
   2.805 -    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
   2.806 -      by (simp add: poly_cmult_map)
   2.807 -    let ?r = "map (op * (inverse ?a0)) q"
   2.808 -    have lgqr: "length q = length ?r" by simp 
   2.809 -    {assume h: "\<And>x y. poly ?r x = poly ?r y"
   2.810 -      {fix x y
   2.811 -	from qr[rule_format, of x] 
   2.812 -	have "poly q x = poly ?r x * ?a0" by auto
   2.813 -	also have "\<dots> = poly ?r y * ?a0" using h by simp
   2.814 -	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
   2.815 -	finally have "poly q x = poly q y" .} 
   2.816 -      with qnc have False unfolding constant_def by blast}
   2.817 -    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
   2.818 -    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
   2.819 -    {fix w 
   2.820 -      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
   2.821 -	using qr[rule_format, of w] a00 by simp
   2.822 -      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
   2.823 -	using a00 unfolding norm_divide by (simp add: field_simps)
   2.824 -      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
   2.825 -    note mrmq_eq = this
   2.826 -    from poly_decompose[OF rnc] obtain k a s where 
   2.827 -      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
   2.828 -      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
   2.829 -    {assume "k + 1 = n"
   2.830 -      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
   2.831 -      {fix w
   2.832 -	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
   2.833 -	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
   2.834 -      note hth = this [symmetric]
   2.835 -	from reduce_poly_simple[OF kas(1,2)] 
   2.836 -      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
   2.837 -    moreover
   2.838 -    {assume kn: "k+1 \<noteq> n"
   2.839 -      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
   2.840 -      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
   2.841 -	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
   2.842 -	using kas(1) apply simp 
   2.843 -	by (rule exI[where x=0], rule exI[where x=1], simp)
   2.844 -      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
   2.845 -	by simp
   2.846 -      from H[rule_format, OF k1n th01 th02]
   2.847 -      obtain w where w: "1 + w^k * a = 0"
   2.848 -	unfolding poly_Nil poly_Cons poly_replicate_append
   2.849 -	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
   2.850 -	  mult_assoc[of _ _ a, symmetric])
   2.851 -      from poly_bound_exists[of "cmod w" s] obtain m where 
   2.852 -	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
   2.853 -      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
   2.854 -      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
   2.855 -      then have wm1: "w^k * a = - 1" by simp
   2.856 -      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
   2.857 -	using norm_ge_zero[of w] w0 m(1)
   2.858 -	  by (simp add: inverse_eq_divide zero_less_mult_iff)
   2.859 -      with real_down2[OF zero_less_one] obtain t where
   2.860 -	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
   2.861 -      let ?ct = "complex_of_real t"
   2.862 -      let ?w = "?ct * w"
   2.863 -      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: ring_simps power_mult_distrib)
   2.864 -      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
   2.865 -	unfolding wm1 by (simp)
   2.866 -      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
   2.867 -	apply -
   2.868 -	apply (rule cong[OF refl[of cmod]])
   2.869 -	apply assumption
   2.870 -	done
   2.871 -      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
   2.872 -      have th11: "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 
   2.873 -      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
   2.874 -      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
   2.875 -      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
   2.876 -      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
   2.877 -	by (simp add: inverse_eq_divide field_simps)
   2.878 -      with zero_less_power[OF t(1), of k] 
   2.879 -      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
   2.880 -	apply - apply (rule mult_strict_left_mono) by simp_all
   2.881 -      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
   2.882 -	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
   2.883 -      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
   2.884 -	using t(1,2) m(2)[rule_format, OF tw] w0
   2.885 -	apply (simp only: )
   2.886 -	apply auto
   2.887 -	apply (rule mult_mono, simp_all add: norm_ge_zero)+
   2.888 -	apply (simp add: zero_le_mult_iff zero_le_power)
   2.889 -	done
   2.890 -      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
   2.891 -      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
   2.892 -	by auto
   2.893 -      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
   2.894 -      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
   2.895 -      from th11 th12
   2.896 -      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
   2.897 -      then have "cmod (poly ?r ?w) < 1" 
   2.898 -	unfolding kas(4)[rule_format, of ?w] r01 by simp 
   2.899 -      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
   2.900 -    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
   2.901 -    from cr0_contr cq0 q(2)
   2.902 -    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
   2.903 -  ultimately show ?ths by blast
   2.904 -qed
   2.905 -
   2.906 -text {* Alternative version with a syntactic notion of constant polynomial. *}
   2.907 -
   2.908 -lemma fundamental_theorem_of_algebra_alt:
   2.909 -  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
   2.910 -  shows "\<exists>z. poly p z = (0::complex)"
   2.911 -using nc
   2.912 -proof(induct p)
   2.913 -  case (Cons c cs)
   2.914 -  {assume "c=0" hence ?case by auto}
   2.915 -  moreover
   2.916 -  {assume c0: "c\<noteq>0"
   2.917 -    {assume nc: "constant (poly (c#cs))"
   2.918 -      from nc[unfolded constant_def, rule_format, of 0] 
   2.919 -      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
   2.920 -      hence "list_all (\<lambda>c. c=0) cs"
   2.921 -	proof(induct cs)
   2.922 -	  case (Cons d ds)
   2.923 -	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
   2.924 -	  moreover
   2.925 -	  {assume d0: "d\<noteq>0"
   2.926 -	    from poly_bound_exists[of 1 ds] obtain m where 
   2.927 -	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
   2.928 -	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
   2.929 -	    from real_down2[OF dm zero_less_one] obtain x where 
   2.930 -	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
   2.931 -	    let ?x = "complex_of_real x"
   2.932 -	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
   2.933 -	    from Cons.prems[rule_format, OF cx(1)]
   2.934 -	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
   2.935 -	    from m(2)[rule_format, OF cx(2)] x(1)
   2.936 -	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
   2.937 -	      by (simp add: norm_mult)
   2.938 -	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
   2.939 -	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
   2.940 -	    with cth  have ?case by blast}
   2.941 -	  ultimately show ?case by blast 
   2.942 -	qed simp}
   2.943 -      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
   2.944 -	by blast
   2.945 -      from fundamental_theorem_of_algebra[OF nc] have ?case .}
   2.946 -  ultimately show ?case by blast  
   2.947 -qed simp
   2.948 -
   2.949 -subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
   2.950 -
   2.951 -lemma nullstellensatz_lemma:
   2.952 -  fixes p :: "complex list"
   2.953 -  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
   2.954 -  and "degree p = n" and "n \<noteq> 0"
   2.955 -  shows "p divides (pexp q n)"
   2.956 -using prems
   2.957 -proof(induct n arbitrary: p q rule: nat_less_induct)
   2.958 -  fix n::nat fix p q :: "complex list"
   2.959 -  assume IH: "\<forall>m<n. \<forall>p q.
   2.960 -                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
   2.961 -                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
   2.962 -    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
   2.963 -    and dpn: "degree p = n" and n0: "n \<noteq> 0"
   2.964 -  let ?ths = "p divides (q %^ n)"
   2.965 -  {fix a assume a: "poly p a = 0"
   2.966 -    {assume p0: "poly p = poly []" 
   2.967 -      hence ?ths unfolding divides_def  using pq0 n0
   2.968 -	apply - apply (rule exI[where x="[]"], rule ext)
   2.969 -	by (auto simp add: poly_mult poly_exp)}
   2.970 -    moreover
   2.971 -    {assume p0: "poly p \<noteq> poly []" 
   2.972 -      and oa: "order  a p \<noteq> 0"
   2.973 -      from p0 have pne: "p \<noteq> []" by auto
   2.974 -      let ?op = "order a p"
   2.975 -      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
   2.976 -	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
   2.977 -      note oop = order_degree[OF p0, unfolded dpn]
   2.978 -      {assume q0: "q = []"
   2.979 -	hence ?ths using n0 unfolding divides_def 
   2.980 -	  apply simp
   2.981 -	  apply (rule exI[where x="[]"], rule ext)
   2.982 -	  by (simp add: divides_def poly_exp poly_mult)}
   2.983 -      moreover
   2.984 -      {assume q0: "q\<noteq>[]"
   2.985 -	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
   2.986 -	obtain r where r: "q = pmult [- a, 1] r" by blast
   2.987 -	from ap[unfolded divides_def] obtain s where
   2.988 -	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
   2.989 -	have s0: "poly s \<noteq> poly []"
   2.990 -	  using s p0 by (simp add: poly_entire)
   2.991 -	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
   2.992 -	{assume ds0: "degree s = 0"
   2.993 -	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
   2.994 -	    by (cases "pnormalize s", auto)
   2.995 -	  then obtain k where kpn: "pnormalize s = [k]" by blast
   2.996 -	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
   2.997 -	    using poly_normalize[of s] by simp_all
   2.998 -	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
   2.999 -	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
  2.1000 -	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
  2.1001 -	  hence ?ths unfolding divides_def by blast}
  2.1002 -	moreover
  2.1003 -	{assume ds0: "degree s \<noteq> 0"
  2.1004 -	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
  2.1005 -	    have dsn: "degree s < n" by auto 
  2.1006 -	    {fix x assume h: "poly s x = 0"
  2.1007 -	      {assume xa: "x = a"
  2.1008 -		from h[unfolded xa poly_linear_divides] sne obtain u where
  2.1009 -		  u: "s = pmult [- a, 1] u" by blast
  2.1010 -		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
  2.1011 -		  unfolding s u
  2.1012 -		  apply (rule ext)
  2.1013 -		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
  2.1014 -		with ap(2)[unfolded divides_def] have False by blast}
  2.1015 -	      note xa = this
  2.1016 -	      from h s have "poly p x = 0" by (simp add: poly_mult)
  2.1017 -	      with pq0 have "poly q x = 0" by blast
  2.1018 -	      with r xa have "poly r x = 0"
  2.1019 -		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
  2.1020 -	    note impth = this
  2.1021 -	    from IH[rule_format, OF dsn, of s r] impth ds0
  2.1022 -	    have "s divides (pexp r (degree s))" by blast
  2.1023 -	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
  2.1024 -	      unfolding divides_def by blast
  2.1025 -	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
  2.1026 -	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
  2.1027 -	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
  2.1028 -	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
  2.1029 -	      apply - apply (rule ext)
  2.1030 -	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
  2.1031 -	      
  2.1032 -	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
  2.1033 -	      done
  2.1034 -	    hence ?ths unfolding divides_def by blast}
  2.1035 -      ultimately have ?ths by blast }
  2.1036 -      ultimately have ?ths by blast}
  2.1037 -    ultimately have ?ths using a order_root by blast}
  2.1038 -  moreover
  2.1039 -  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
  2.1040 -    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
  2.1041 -      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
  2.1042 -    
  2.1043 -    from poly_0[OF ccs(2)] ccs(3) 
  2.1044 -    have pp: "\<And>x. poly p x =  c" by simp
  2.1045 -    let ?w = "pmult [1/c] (pexp q n)"
  2.1046 -    from pp ccs(1) 
  2.1047 -    have "poly (pexp q n) = poly (pmult p ?w) "
  2.1048 -      apply - apply (rule ext)
  2.1049 -      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
  2.1050 -    hence ?ths unfolding divides_def by blast}
  2.1051 -  ultimately show ?ths by blast
  2.1052 -qed
  2.1053 -
  2.1054 -lemma nullstellensatz_univariate:
  2.1055 -  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
  2.1056 -    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
  2.1057 -proof-
  2.1058 -  {assume pe: "poly p = poly []"
  2.1059 -    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
  2.1060 -      apply auto
  2.1061 -      by (rule ext, simp)
  2.1062 -    {assume "p divides (pexp q (degree p))"
  2.1063 -      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
  2.1064 -	unfolding divides_def by blast
  2.1065 -      from cong[OF r refl] pe degree_unique[OF pe]
  2.1066 -      have False by (simp add: poly_mult degree_def)}
  2.1067 -    with eq pe have ?thesis by blast}
  2.1068 -  moreover
  2.1069 -  {assume pe: "poly p \<noteq> poly []"
  2.1070 -    have p0: "poly [0] = poly []" by (rule ext, simp)
  2.1071 -    {assume dp: "degree p = 0"
  2.1072 -      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
  2.1073 -	unfolding degree_def by (cases "pnormalize p", auto)
  2.1074 -      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
  2.1075 -	using pe poly_normalize[of p] by (auto simp add: p0)
  2.1076 -      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
  2.1077 -      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
  2.1078 -	by - (rule ext, simp add: poly_mult poly_exp)
  2.1079 -      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
  2.1080 -      from th1 th2 pe have ?thesis by blast}
  2.1081 -    moreover
  2.1082 -    {assume dp: "degree p \<noteq> 0"
  2.1083 -      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
  2.1084 -      {assume "p divides (pexp q (Suc n))"
  2.1085 -	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
  2.1086 -	  unfolding divides_def by blast
  2.1087 -	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
  2.1088 -	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
  2.1089 -	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
  2.1090 -	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
  2.1091 -	with n nullstellensatz_lemma[of p q "degree p"] dp 
  2.1092 -	have ?thesis by auto}
  2.1093 -    ultimately have ?thesis by blast}
  2.1094 -  ultimately show ?thesis by blast
  2.1095 -qed
  2.1096 -
  2.1097 -text{* Useful lemma *}
  2.1098 -
  2.1099 -lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
  2.1100 -proof
  2.1101 -  assume l: ?lhs
  2.1102 -  from l[unfolded constant_def, rule_format, of _ "zero"]
  2.1103 -  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
  2.1104 -  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
  2.1105 -next
  2.1106 -  assume r: ?rhs
  2.1107 -  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
  2.1108 -    unfolding degree_def by (cases "pnormalize p", auto)
  2.1109 -  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
  2.1110 -    by (auto simp del: poly_normalize)
  2.1111 -qed
  2.1112 -
  2.1113 -(* It would be nicer to prove this without using algebraic closure...        *)
  2.1114 -
  2.1115 -lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
  2.1116 -  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
  2.1117 -  using dpn
  2.1118 -proof(induct n arbitrary: p q)
  2.1119 -  case 0 thus ?case by simp
  2.1120 -next
  2.1121 -  case (Suc n p q)
  2.1122 -  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
  2.1123 -  obtain a where a: "poly p a = 0" by auto
  2.1124 -  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
  2.1125 -    using Suc.prems by (auto simp add: degree_def)
  2.1126 -  {assume h: "poly (pmult r q) = poly []"
  2.1127 -    hence "poly (pmult p q) = poly []" using r
  2.1128 -      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
  2.1129 -  moreover
  2.1130 -  {assume h: "poly (pmult r q) \<noteq> poly []" 
  2.1131 -    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
  2.1132 -      by (auto simp add: poly_entire)
  2.1133 -    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
  2.1134 -      apply - apply (rule ext)
  2.1135 -      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
  2.1136 -    from linear_mul_degree[OF h, of "- a"]
  2.1137 -    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
  2.1138 -      unfolding degree_unique[OF eq] .
  2.1139 -    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
  2.1140 -    have dr: "degree r = n" by auto
  2.1141 -    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
  2.1142 -      unfolding dqe using h by (auto simp del: poly.simps) 
  2.1143 -    hence ?case by blast}
  2.1144 -  ultimately show ?case by blast
  2.1145 -qed
  2.1146 -
  2.1147 -lemma divides_degree: assumes pq: "p divides (q:: complex list)"
  2.1148 -  shows "degree p \<le> degree q \<or> poly q = poly []"
  2.1149 -using pq  divides_degree_lemma[OF refl, of p]
  2.1150 -apply (auto simp add: divides_def poly_entire)
  2.1151 -apply atomize
  2.1152 -apply (erule_tac x="qa" in allE, auto)
  2.1153 -apply (subgoal_tac "degree q = degree (p *** qa)", simp)
  2.1154 -apply (rule degree_unique, simp)
  2.1155 -done
  2.1156 -
  2.1157 -(* Arithmetic operations on multivariate polynomials.                        *)
  2.1158 -
  2.1159 -lemma mpoly_base_conv: 
  2.1160 -  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
  2.1161 -
  2.1162 -lemma mpoly_norm_conv: 
  2.1163 -  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
  2.1164 -
  2.1165 -lemma mpoly_sub_conv: 
  2.1166 -  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
  2.1167 -  by (simp add: diff_def)
  2.1168 -
  2.1169 -lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
  2.1170 -
  2.1171 -lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
  2.1172 -
  2.1173 -lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
  2.1174 -lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
  2.1175 -  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
  2.1176 -lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
  2.1177 -
  2.1178 -lemma poly_divides_pad_rule: 
  2.1179 -  fixes p q :: "complex list"
  2.1180 -  assumes pq: "p divides q"
  2.1181 -  shows "p divides ((0::complex)#q)"
  2.1182 -proof-
  2.1183 -  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
  2.1184 -  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
  2.1185 -    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
  2.1186 -  thus ?thesis unfolding divides_def by blast
  2.1187 -qed
  2.1188 -
  2.1189 -lemma poly_divides_pad_const_rule: 
  2.1190 -  fixes p q :: "complex list"
  2.1191 -  assumes pq: "p divides q"
  2.1192 -  shows "p divides (a %* q)"
  2.1193 -proof-
  2.1194 -  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
  2.1195 -  hence "poly (a %* q) = poly (p *** (a %* r))" 
  2.1196 -    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
  2.1197 -  thus ?thesis unfolding divides_def by blast
  2.1198 -qed
  2.1199 -
  2.1200 -
  2.1201 -lemma poly_divides_conv0:  
  2.1202 -  fixes p :: "complex list"
  2.1203 -  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
  2.1204 -  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
  2.1205 -proof-
  2.1206 -  {assume r: ?rhs 
  2.1207 -    hence eq: "poly q = poly []" unfolding poly_zero 
  2.1208 -      by (simp add: list_all_iff list_ex_iff)
  2.1209 -    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
  2.1210 -    hence ?lhs unfolding divides_def  by blast}
  2.1211 -  moreover
  2.1212 -  {assume l: ?lhs
  2.1213 -    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
  2.1214 -      by arith
  2.1215 -    {assume q0: "length q = 0"
  2.1216 -      hence "q = []" by simp
  2.1217 -      hence ?rhs by simp}
  2.1218 -    moreover
  2.1219 -    {assume lgq0: "length q \<noteq> 0"
  2.1220 -      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
  2.1221 -	unfolding degree_def by simp
  2.1222 -      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
  2.1223 -      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
  2.1224 -    ultimately have ?rhs by blast }
  2.1225 -  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
  2.1226 -qed
  2.1227 -
  2.1228 -lemma poly_divides_conv1: 
  2.1229 -  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
  2.1230 -  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
  2.1231 -  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
  2.1232 -proof-
  2.1233 -  {
  2.1234 -  from pp' obtain t where t: "poly p' = poly (p *** t)" 
  2.1235 -    unfolding divides_def by blast
  2.1236 -  {assume l: ?lhs
  2.1237 -    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
  2.1238 -     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
  2.1239 -       using u qrp' t
  2.1240 -       by - (rule ext, 
  2.1241 -	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
  2.1242 -     then have ?rhs unfolding divides_def by blast}
  2.1243 -  moreover
  2.1244 -  {assume r: ?rhs
  2.1245 -    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
  2.1246 -    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
  2.1247 -      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
  2.1248 -    hence ?lhs  unfolding divides_def by blast}
  2.1249 -  ultimately have "?lhs = ?rhs" by blast }
  2.1250 -thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
  2.1251 -qed
  2.1252 -
  2.1253 -lemma basic_cqe_conv1:
  2.1254 -  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
  2.1255 -  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
  2.1256 -  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
  2.1257 -  "(\<exists>x. poly [] x = 0) \<equiv> True"
  2.1258 -  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
  2.1259 -
  2.1260 -lemma basic_cqe_conv2: 
  2.1261 -  assumes l:"last (a#b#p) \<noteq> 0" 
  2.1262 -  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
  2.1263 -proof-
  2.1264 -  {fix h t
  2.1265 -    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
  2.1266 -    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
  2.1267 -    moreover have "last (b#p) \<in> set (b#p)" by simp
  2.1268 -    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
  2.1269 -    with l have False by simp}
  2.1270 -  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
  2.1271 -    by blast
  2.1272 -  from fundamental_theorem_of_algebra_alt[OF th] 
  2.1273 -  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
  2.1274 -qed
  2.1275 -
  2.1276 -lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
  2.1277 -proof-
  2.1278 -  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
  2.1279 -    by (simp add: poly_zero list_all_iff list_ex_iff)
  2.1280 -  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
  2.1281 -  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
  2.1282 -    by - (atomize (full), blast)
  2.1283 -qed
  2.1284 -
  2.1285 -lemma basic_cqe_conv3:
  2.1286 -  fixes p q :: "complex list"
  2.1287 -  assumes l: "last (a#p) \<noteq> 0" 
  2.1288 -  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
  2.1289 -proof-
  2.1290 -  note np = pnormalize_eq[OF l]
  2.1291 -  {assume "poly (a#p) = poly []" hence False using l
  2.1292 -      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
  2.1293 -      apply (cases p, simp_all) done}
  2.1294 -  then have p0: "poly (a#p) \<noteq> poly []"  by blast
  2.1295 -  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
  2.1296 -  from nullstellensatz_univariate[of "a#p" q] p0 dp
  2.1297 -  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
  2.1298 -    by - (atomize (full), auto)
  2.1299 -qed
  2.1300 -
  2.1301 -lemma basic_cqe_conv4:
  2.1302 -  fixes p q :: "complex list"
  2.1303 -  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
  2.1304 -  shows "p divides (q %^ n) \<equiv> p divides r"
  2.1305 -proof-
  2.1306 -  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
  2.1307 -  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
  2.1308 -qed
  2.1309 -
  2.1310 -lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
  2.1311 -  by simp
  2.1312 -
  2.1313 -lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
  2.1314 -lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
  2.1315 -lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
  2.1316 -lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
  2.1317 -lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
  2.1318 -
  2.1319 -lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
  2.1320 -lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
  2.1321 -  by (atomize (full)) simp_all
  2.1322 -lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
  2.1323 -lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
  2.1324 -proof
  2.1325 -  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
  2.1326 -next
  2.1327 -  assume "p \<and> q \<equiv> p \<and> r" "p"
  2.1328 -  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
  2.1329 -qed
  2.1330 -lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
  2.1331 -
  2.1332 -end
  2.1333 \ No newline at end of file
     3.1 --- a/src/HOL/Complex/README.html	Mon Dec 29 13:23:53 2008 +0100
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,67 +0,0 @@
     3.4 -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
     3.5 -
     3.6 -<!-- $Id$ -->
     3.7 -
     3.8 -<HTML>
     3.9 -
    3.10 -<HEAD>
    3.11 -  <meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
    3.12 -  <TITLE>HOL/Complex/README</TITLE>
    3.13 -</HEAD>
    3.14 -
    3.15 -<BODY>
    3.16 -
    3.17 -<H1>Complex: The Complex Numbers</H1>
    3.18 -		<P>This directory defines the type <KBD>complex</KBD> of the complex numbers,
    3.19 -with numeric constants and some complex analysis.  The development includes
    3.20 -nonstandard analysis for the complex numbers.  Note that the image
    3.21 -<KBD>HOL-Complex</KBD> includes theories from the directories 
    3.22 -<KBD><a href="#Anchor-Real">HOL/Real</a></KBD>  and <KBD><a href="#Anchor-Hyperreal">HOL/Hyperreal</a></KBD>. They define other types including <kbd>real</kbd> (the real numbers) and <kbd>hypreal</kbd> (the hyperreal or non-standard reals).
    3.23 -
    3.24 -<ul>
    3.25 -<li><a href="CLim.html">CLim</a> Limits, continuous functions, and derivatives for the complex numbers
    3.26 -<li><a href="CSeries.html">CSeries</a> Finite summation and infinite series for the complex numbers
    3.27 -<li><a href="CStar.html">CStar</a> Star-transforms for the complex numbers, to form non-standard extensions of sets and functions
    3.28 -<li><a href="Complex.html">Complex</a> The complex numbers
    3.29 -<li><a href="NSCA.html">NSCA</a> Nonstandard complex analysis
    3.30 -<li><a href="NSComplex.html">NSComplex</a> Ultrapower construction of the nonstandard complex numbers
    3.31 -</ul>
    3.32 -
    3.33 -<h2><a name="Anchor-Real" id="Anchor-Real"></a>Real: Dedekind Cut Construction of the Real Line</h2>
    3.34 -
    3.35 -<ul>
    3.36 -<li><a href="Lubs.html">Lubs</a> Definition of upper bounds, lubs and so on, to support completeness proofs.
    3.37 -<li><a href="PReal.html">PReal</a> The positive reals constructed using Dedekind cuts
    3.38 -<li><a href="Rational.html">Rational</a> The rational numbers constructed as equivalence classes of integers
    3.39 -<li><a href="RComplete.html">RComplete</a> The reals are complete: they satisfy the supremum property. They also have the Archimedean property.
    3.40 -<li><a href="RealDef.html">RealDef</a> The real numbers, their ordering properties, and embedding of the integers and the natural numbers
    3.41 -<li><a href="RealPow.html">RealPow</a> Real numbers raised to natural number powers
    3.42 -</ul>
    3.43 -<h2><a name="Anchor-Hyperreal" id="Anchor-Hyperreal"></a>Hyperreal: Ultrafilter Construction of the Non-Standard Reals</h2>
    3.44 -See J. D. Fleuriot and L. C. Paulson. Mechanizing Nonstandard Real Analysis. LMS J. Computation and Mathematics 3 (2000), 140-190.
    3.45 -<ul>
    3.46 -<li><a href="Filter.html">Filter</a> Theory of Filters and Ultrafilters. Main result is a version of the Ultrafilter Theorem proved using Zorn's Lemma.
    3.47 -<li><a href="HLog.html">HLog</a> Non-standard logarithms
    3.48 -<li><a href="HSeries.html">HSeries</a> Non-standard theory of finite summation and infinite series
    3.49 -<li><a href="HTranscendental.html">HTranscendental</a> Non-standard extensions of transcendental functions
    3.50 -<li><a href="HyperDef.html">HyperDef</a> Ultrapower construction of the hyperreals
    3.51 -<li><a href="HyperNat.html">HyperNat</a> Ultrapower construction of the hypernaturals
    3.52 -<li><a href="HyperPow.html">HyperPow</a> Powers theory for the hyperreals
    3.53 -<!-- <li><a href="IntFloor.html">IntFloor</a> Floor and Ceiling functions relating the reals and integers -->
    3.54 -<li><a href="Integration.html">Integration</a> Gage integrals
    3.55 -<li><a href="Lim.html">Lim</a> Theory of limits, continuous functions, and derivatives
    3.56 -<li><a href="Log.html">Log</a> Logarithms for the reals
    3.57 -<li><a href="MacLaurin.html">MacLaurin</a> MacLaurin series
    3.58 -<li><a href="NatStar.html">NatStar</a> Star-transforms for the hypernaturals, to form non-standard extensions of sets and functions involving the naturals or reals
    3.59 -<li><a href="NthRoot.html">NthRoot</a> Existence of n-th roots of real numbers
    3.60 -<li><a href="NSA.html">NSA</a> Theory defining sets of infinite numbers, infinitesimals, the infinitely close relation, and their various algebraic properties.
    3.61 -<li><a href="Poly.html">Poly</a> Univariate real polynomials
    3.62 -<li><a href="SEQ.html">SEQ</a> Convergence of sequences and series using standard and nonstandard analysis
    3.63 -<li><a href="Series.html">Series</a> Finite summation and infinite series for the reals
    3.64 -<li><a href="Star.html">Star</a> Nonstandard extensions of real sets and real functions
    3.65 -<li><a href="Transcendental.html">Transcendental</a> Power series and transcendental functions
    3.66 -</ul>
    3.67 -<HR>
    3.68 -<P>Last modified $Date$
    3.69 -</BODY>
    3.70 -</HTML>
     4.1 --- a/src/HOL/Complex/document/root.tex	Mon Dec 29 13:23:53 2008 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,32 +0,0 @@
     4.4 -
     4.5 -% $Id$
     4.6 -
     4.7 -\documentclass[11pt,a4paper]{article}
     4.8 -\usepackage{graphicx,isabelle,isabellesym,latexsym}
     4.9 -\usepackage[latin1]{inputenc}
    4.10 -\usepackage{pdfsetup}
    4.11 -
    4.12 -\urlstyle{rm}
    4.13 -\isabellestyle{it}
    4.14 -\pagestyle{myheadings}
    4.15 -
    4.16 -\begin{document}
    4.17 -
    4.18 -\title{Isabelle/HOL-Complex --- Higher-Order Logic with Complex Numbers}
    4.19 -\maketitle
    4.20 -
    4.21 -\tableofcontents
    4.22 -
    4.23 -\begin{center}
    4.24 -  \includegraphics[width=\textwidth,height=\textheight,keepaspectratio]{session_graph}
    4.25 -\end{center}
    4.26 -
    4.27 -\newpage
    4.28 -
    4.29 -\renewcommand{\isamarkupheader}[1]%
    4.30 -{\section{\isabellecontext: #1}\markright{THEORY~``\isabellecontext''}}
    4.31 -
    4.32 -\parindent 0pt\parskip 0.5ex
    4.33 -\input{session}
    4.34 -
    4.35 -\end{document}
     5.1 --- a/src/HOL/Complex_Main.thy	Mon Dec 29 13:23:53 2008 +0100
     5.2 +++ b/src/HOL/Complex_Main.thy	Mon Dec 29 14:08:08 2008 +0100
     5.3 @@ -9,7 +9,7 @@
     5.4  imports
     5.5    Main
     5.6    Real
     5.7 -  "~~/src/HOL/Complex/Fundamental_Theorem_Algebra"
     5.8 +  Fundamental_Theorem_Algebra
     5.9    Log
    5.10    Ln
    5.11    Taylor
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/Dense_Linear_Order.thy	Mon Dec 29 14:08:08 2008 +0100
     6.3 @@ -0,0 +1,877 @@
     6.4 +(* Author: Amine Chaieb, TU Muenchen *)
     6.5 +
     6.6 +header {* Dense linear order without endpoints
     6.7 +  and a quantifier elimination procedure in Ferrante and Rackoff style *}
     6.8 +
     6.9 +theory Dense_Linear_Order
    6.10 +imports Plain Groebner_Basis
    6.11 +uses
    6.12 +  "~~/src/HOL/Tools/Qelim/langford_data.ML"
    6.13 +  "~~/src/HOL/Tools/Qelim/ferrante_rackoff_data.ML"
    6.14 +  ("~~/src/HOL/Tools/Qelim/langford.ML")
    6.15 +  ("~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML")
    6.16 +begin
    6.17 +
    6.18 +setup {* Langford_Data.setup #> Ferrante_Rackoff_Data.setup *}
    6.19 +
    6.20 +context linorder
    6.21 +begin
    6.22 +
    6.23 +lemma less_not_permute: "\<not> (x < y \<and> y < x)" by (simp add: not_less linear)
    6.24 +
    6.25 +lemma gather_simps: 
    6.26 +  shows 
    6.27 +  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y) \<and> P x)"
    6.28 +  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y) \<and> P x)"
    6.29 +  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y))"
    6.30 +  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y))"  by auto
    6.31 +
    6.32 +lemma 
    6.33 +  gather_start: "(\<exists>x. P x) \<equiv> (\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y\<in> {}. x < y) \<and> P x)" 
    6.34 +  by simp
    6.35 +
    6.36 +text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"}*}
    6.37 +lemma minf_lt:  "\<exists>z . \<forall>x. x < z \<longrightarrow> (x < t \<longleftrightarrow> True)" by auto
    6.38 +lemma minf_gt: "\<exists>z . \<forall>x. x < z \<longrightarrow>  (t < x \<longleftrightarrow>  False)"
    6.39 +  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
    6.40 +
    6.41 +lemma minf_le: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<le> t \<longleftrightarrow> True)" by (auto simp add: less_le)
    6.42 +lemma minf_ge: "\<exists>z. \<forall>x. x < z \<longrightarrow> (t \<le> x \<longleftrightarrow> False)"
    6.43 +  by (auto simp add: less_le not_less not_le)
    6.44 +lemma minf_eq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
    6.45 +lemma minf_neq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
    6.46 +lemma minf_P: "\<exists>z. \<forall>x. x < z \<longrightarrow> (P \<longleftrightarrow> P)" by blast
    6.47 +
    6.48 +text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"}*}
    6.49 +lemma pinf_gt:  "\<exists>z . \<forall>x. z < x \<longrightarrow> (t < x \<longleftrightarrow> True)" by auto
    6.50 +lemma pinf_lt: "\<exists>z . \<forall>x. z < x \<longrightarrow>  (x < t \<longleftrightarrow>  False)"
    6.51 +  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
    6.52 +
    6.53 +lemma pinf_ge: "\<exists>z. \<forall>x. z < x \<longrightarrow> (t \<le> x \<longleftrightarrow> True)" by (auto simp add: less_le)
    6.54 +lemma pinf_le: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<le> t \<longleftrightarrow> False)"
    6.55 +  by (auto simp add: less_le not_less not_le)
    6.56 +lemma pinf_eq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
    6.57 +lemma pinf_neq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
    6.58 +lemma pinf_P: "\<exists>z. \<forall>x. z < x \<longrightarrow> (P \<longleftrightarrow> P)" by blast
    6.59 +
    6.60 +lemma nmi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x < t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.61 +lemma nmi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)"
    6.62 +  by (auto simp add: le_less)
    6.63 +lemma  nmi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x\<le> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.64 +lemma  nmi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t\<le> x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.65 +lemma  nmi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.66 +lemma  nmi_neq: "t \<in> U \<Longrightarrow>\<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.67 +lemma  nmi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.68 +lemma  nmi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
    6.69 +  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
    6.70 +  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.71 +lemma  nmi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
    6.72 +  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
    6.73 +  \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
    6.74 +
    6.75 +lemma  npi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x < t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by (auto simp add: le_less)
    6.76 +lemma  npi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.77 +lemma  npi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x \<le> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.78 +lemma  npi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t \<le> x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.79 +lemma  npi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.80 +lemma  npi_neq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u )" by auto
    6.81 +lemma  npi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.82 +lemma  npi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ;  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
    6.83 +  \<Longrightarrow>  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.84 +lemma  npi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ; \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
    6.85 +  \<Longrightarrow> \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
    6.86 +
    6.87 +lemma lin_dense_lt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t < u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x < t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y < t)"
    6.88 +proof(clarsimp)
    6.89 +  fix x l u y  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x"
    6.90 +    and xu: "x<u"  and px: "x < t" and ly: "l<y" and yu:"y < u"
    6.91 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
    6.92 +  {assume H: "t < y"
    6.93 +    from less_trans[OF lx px] less_trans[OF H yu]
    6.94 +    have "l < t \<and> t < u"  by simp
    6.95 +    with tU noU have "False" by auto}
    6.96 +  hence "\<not> t < y"  by auto hence "y \<le> t" by (simp add: not_less)
    6.97 +  thus "y < t" using tny by (simp add: less_le)
    6.98 +qed
    6.99 +
   6.100 +lemma lin_dense_gt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l < x \<and> x < u \<and> t < x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t < y)"
   6.101 +proof(clarsimp)
   6.102 +  fix x l u y
   6.103 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
   6.104 +  and px: "t < x" and ly: "l<y" and yu:"y < u"
   6.105 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
   6.106 +  {assume H: "y< t"
   6.107 +    from less_trans[OF ly H] less_trans[OF px xu] have "l < t \<and> t < u" by simp
   6.108 +    with tU noU have "False" by auto}
   6.109 +  hence "\<not> y<t"  by auto hence "t \<le> y" by (auto simp add: not_less)
   6.110 +  thus "t < y" using tny by (simp add:less_le)
   6.111 +qed
   6.112 +
   6.113 +lemma lin_dense_le: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<le> t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<le> t)"
   6.114 +proof(clarsimp)
   6.115 +  fix x l u y
   6.116 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
   6.117 +  and px: "x \<le> t" and ly: "l<y" and yu:"y < u"
   6.118 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
   6.119 +  {assume H: "t < y"
   6.120 +    from less_le_trans[OF lx px] less_trans[OF H yu]
   6.121 +    have "l < t \<and> t < u" by simp
   6.122 +    with tU noU have "False" by auto}
   6.123 +  hence "\<not> t < y"  by auto thus "y \<le> t" by (simp add: not_less)
   6.124 +qed
   6.125 +
   6.126 +lemma lin_dense_ge: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> t \<le> x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t \<le> y)"
   6.127 +proof(clarsimp)
   6.128 +  fix x l u y
   6.129 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
   6.130 +  and px: "t \<le> x" and ly: "l<y" and yu:"y < u"
   6.131 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
   6.132 +  {assume H: "y< t"
   6.133 +    from less_trans[OF ly H] le_less_trans[OF px xu]
   6.134 +    have "l < t \<and> t < u" by simp
   6.135 +    with tU noU have "False" by auto}
   6.136 +  hence "\<not> y<t"  by auto thus "t \<le> y" by (simp add: not_less)
   6.137 +qed
   6.138 +lemma lin_dense_eq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x = t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y= t)"  by auto
   6.139 +lemma lin_dense_neq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<noteq> t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<noteq> t)"  by auto
   6.140 +lemma lin_dense_P: "\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P)"  by auto
   6.141 +
   6.142 +lemma lin_dense_conj:
   6.143 +  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
   6.144 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
   6.145 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
   6.146 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
   6.147 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<and> P2 x)
   6.148 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<and> P2 y))"
   6.149 +  by blast
   6.150 +lemma lin_dense_disj:
   6.151 +  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
   6.152 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
   6.153 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
   6.154 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
   6.155 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<or> P2 x)
   6.156 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<or> P2 y))"
   6.157 +  by blast
   6.158 +
   6.159 +lemma npmibnd: "\<lbrakk>\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<le> x); \<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<le> u)\<rbrakk>
   6.160 +  \<Longrightarrow> \<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<le> x \<and> x \<le> u')"
   6.161 +by auto
   6.162 +
   6.163 +lemma finite_set_intervals:
   6.164 +  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
   6.165 +  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
   6.166 +  shows "\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a \<le> x \<and> x \<le> b \<and> P x"
   6.167 +proof-
   6.168 +  let ?Mx = "{y. y\<in> S \<and> y \<le> x}"
   6.169 +  let ?xM = "{y. y\<in> S \<and> x \<le> y}"
   6.170 +  let ?a = "Max ?Mx"
   6.171 +  let ?b = "Min ?xM"
   6.172 +  have MxS: "?Mx \<subseteq> S" by blast
   6.173 +  hence fMx: "finite ?Mx" using fS finite_subset by auto
   6.174 +  from lx linS have linMx: "l \<in> ?Mx" by blast
   6.175 +  hence Mxne: "?Mx \<noteq> {}" by blast
   6.176 +  have xMS: "?xM \<subseteq> S" by blast
   6.177 +  hence fxM: "finite ?xM" using fS finite_subset by auto
   6.178 +  from xu uinS have linxM: "u \<in> ?xM" by blast
   6.179 +  hence xMne: "?xM \<noteq> {}" by blast
   6.180 +  have ax:"?a \<le> x" using Mxne fMx by auto
   6.181 +  have xb:"x \<le> ?b" using xMne fxM by auto
   6.182 +  have "?a \<in> ?Mx" using Max_in[OF fMx Mxne] by simp hence ainS: "?a \<in> S" using MxS by blast
   6.183 +  have "?b \<in> ?xM" using Min_in[OF fxM xMne] by simp hence binS: "?b \<in> S" using xMS by blast
   6.184 +  have noy:"\<forall> y. ?a < y \<and> y < ?b \<longrightarrow> y \<notin> S"
   6.185 +  proof(clarsimp)
   6.186 +    fix y   assume ay: "?a < y" and yb: "y < ?b" and yS: "y \<in> S"
   6.187 +    from yS have "y\<in> ?Mx \<or> y\<in> ?xM" by (auto simp add: linear)
   6.188 +    moreover {assume "y \<in> ?Mx" hence "y \<le> ?a" using Mxne fMx by auto with ay have "False" by (simp add: not_le[symmetric])}
   6.189 +    moreover {assume "y \<in> ?xM" hence "?b \<le> y" using xMne fxM by auto with yb have "False" by (simp add: not_le[symmetric])}
   6.190 +    ultimately show "False" by blast
   6.191 +  qed
   6.192 +  from ainS binS noy ax xb px show ?thesis by blast
   6.193 +qed
   6.194 +
   6.195 +lemma finite_set_intervals2:
   6.196 +  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
   6.197 +  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
   6.198 +  shows "(\<exists> s\<in> S. P s) \<or> (\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a < x \<and> x < b \<and> P x)"
   6.199 +proof-
   6.200 +  from finite_set_intervals[where P="P", OF px lx xu linS uinS fS lS Su]
   6.201 +  obtain a and b where
   6.202 +    as: "a\<in> S" and bs: "b\<in> S" and noS:"\<forall>y. a < y \<and> y < b \<longrightarrow> y \<notin> S"
   6.203 +    and axb: "a \<le> x \<and> x \<le> b \<and> P x"  by auto
   6.204 +  from axb have "x= a \<or> x= b \<or> (a < x \<and> x < b)" by (auto simp add: le_less)
   6.205 +  thus ?thesis using px as bs noS by blast
   6.206 +qed
   6.207 +
   6.208 +end
   6.209 +
   6.210 +section {* The classical QE after Langford for dense linear orders *}
   6.211 +
   6.212 +context dense_linear_order
   6.213 +begin
   6.214 +
   6.215 +lemma interval_empty_iff:
   6.216 +  "{y. x < y \<and> y < z} = {} \<longleftrightarrow> \<not> x < z"
   6.217 +  by (auto dest: dense)
   6.218 +
   6.219 +lemma dlo_qe_bnds: 
   6.220 +  assumes ne: "L \<noteq> {}" and neU: "U \<noteq> {}" and fL: "finite L" and fU: "finite U"
   6.221 +  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> (\<forall> l \<in> L. \<forall>u \<in> U. l < u)"
   6.222 +proof (simp only: atomize_eq, rule iffI)
   6.223 +  assume H: "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)"
   6.224 +  then obtain x where xL: "\<forall>y\<in>L. y < x" and xU: "\<forall>y\<in>U. x < y" by blast
   6.225 +  {fix l u assume l: "l \<in> L" and u: "u \<in> U"
   6.226 +    have "l < x" using xL l by blast
   6.227 +    also have "x < u" using xU u by blast
   6.228 +    finally (less_trans) have "l < u" .}
   6.229 +  thus "\<forall>l\<in>L. \<forall>u\<in>U. l < u" by blast
   6.230 +next
   6.231 +  assume H: "\<forall>l\<in>L. \<forall>u\<in>U. l < u"
   6.232 +  let ?ML = "Max L"
   6.233 +  let ?MU = "Min U"  
   6.234 +  from fL ne have th1: "?ML \<in> L" and th1': "\<forall>l\<in>L. l \<le> ?ML" by auto
   6.235 +  from fU neU have th2: "?MU \<in> U" and th2': "\<forall>u\<in>U. ?MU \<le> u" by auto
   6.236 +  from th1 th2 H have "?ML < ?MU" by auto
   6.237 +  with dense obtain w where th3: "?ML < w" and th4: "w < ?MU" by blast
   6.238 +  from th3 th1' have "\<forall>l \<in> L. l < w" by auto
   6.239 +  moreover from th4 th2' have "\<forall>u \<in> U. w < u" by auto
   6.240 +  ultimately show "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)" by auto
   6.241 +qed
   6.242 +
   6.243 +lemma dlo_qe_noub: 
   6.244 +  assumes ne: "L \<noteq> {}" and fL: "finite L"
   6.245 +  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> {}. x < y)) \<equiv> True"
   6.246 +proof(simp add: atomize_eq)
   6.247 +  from gt_ex[of "Max L"] obtain M where M: "Max L < M" by blast
   6.248 +  from ne fL have "\<forall>x \<in> L. x \<le> Max L" by simp
   6.249 +  with M have "\<forall>x\<in>L. x < M" by (auto intro: le_less_trans)
   6.250 +  thus "\<exists>x. \<forall>y\<in>L. y < x" by blast
   6.251 +qed
   6.252 +
   6.253 +lemma dlo_qe_nolb: 
   6.254 +  assumes ne: "U \<noteq> {}" and fU: "finite U"
   6.255 +  shows "(\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> True"
   6.256 +proof(simp add: atomize_eq)
   6.257 +  from lt_ex[of "Min U"] obtain M where M: "M < Min U" by blast
   6.258 +  from ne fU have "\<forall>x \<in> U. Min U \<le> x" by simp
   6.259 +  with M have "\<forall>x\<in>U. M < x" by (auto intro: less_le_trans)
   6.260 +  thus "\<exists>x. \<forall>y\<in>U. x < y" by blast
   6.261 +qed
   6.262 +
   6.263 +lemma exists_neq: "\<exists>(x::'a). x \<noteq> t" "\<exists>(x::'a). t \<noteq> x" 
   6.264 +  using gt_ex[of t] by auto
   6.265 +
   6.266 +lemmas dlo_simps = order_refl less_irrefl not_less not_le exists_neq 
   6.267 +  le_less neq_iff linear less_not_permute
   6.268 +
   6.269 +lemma axiom: "dense_linear_order (op \<le>) (op <)" by (rule dense_linear_order_axioms)
   6.270 +lemma atoms:
   6.271 +  shows "TERM (less :: 'a \<Rightarrow> _)"
   6.272 +    and "TERM (less_eq :: 'a \<Rightarrow> _)"
   6.273 +    and "TERM (op = :: 'a \<Rightarrow> _)" .
   6.274 +
   6.275 +declare axiom[langford qe: dlo_qe_bnds dlo_qe_nolb dlo_qe_noub gather: gather_start gather_simps atoms: atoms]
   6.276 +declare dlo_simps[langfordsimp]
   6.277 +
   6.278 +end
   6.279 +
   6.280 +(* FIXME: Move to HOL -- together with the conj_aci_rule in langford.ML *)
   6.281 +lemma dnf:
   6.282 +  "(P & (Q | R)) = ((P&Q) | (P&R))" 
   6.283 +  "((Q | R) & P) = ((Q&P) | (R&P))"
   6.284 +  by blast+
   6.285 +
   6.286 +lemmas weak_dnf_simps = simp_thms dnf
   6.287 +
   6.288 +lemma nnf_simps:
   6.289 +    "(\<not>(P \<and> Q)) = (\<not>P \<or> \<not>Q)" "(\<not>(P \<or> Q)) = (\<not>P \<and> \<not>Q)" "(P \<longrightarrow> Q) = (\<not>P \<or> Q)"
   6.290 +    "(P = Q) = ((P \<and> Q) \<or> (\<not>P \<and> \<not> Q))" "(\<not> \<not>(P)) = P"
   6.291 +  by blast+
   6.292 +
   6.293 +lemma ex_distrib: "(\<exists>x. P x \<or> Q x) \<longleftrightarrow> ((\<exists>x. P x) \<or> (\<exists>x. Q x))" by blast
   6.294 +
   6.295 +lemmas dnf_simps = weak_dnf_simps nnf_simps ex_distrib
   6.296 +
   6.297 +use "~~/src/HOL/Tools/Qelim/langford.ML"
   6.298 +method_setup dlo = {*
   6.299 +  Method.ctxt_args (Method.SIMPLE_METHOD' o LangfordQE.dlo_tac)
   6.300 +*} "Langford's algorithm for quantifier elimination in dense linear orders"
   6.301 +
   6.302 +
   6.303 +section {* Contructive dense linear orders yield QE for linear arithmetic over ordered Fields -- see @{text "Arith_Tools.thy"} *}
   6.304 +
   6.305 +text {* Linear order without upper bounds *}
   6.306 +
   6.307 +locale linorder_stupid_syntax = linorder
   6.308 +begin
   6.309 +notation
   6.310 +  less_eq  ("op \<sqsubseteq>") and
   6.311 +  less_eq  ("(_/ \<sqsubseteq> _)" [51, 51] 50) and
   6.312 +  less  ("op \<sqsubset>") and
   6.313 +  less  ("(_/ \<sqsubset> _)"  [51, 51] 50)
   6.314 +
   6.315 +end
   6.316 +
   6.317 +locale linorder_no_ub = linorder_stupid_syntax +
   6.318 +  assumes gt_ex: "\<exists>y. less x y"
   6.319 +begin
   6.320 +lemma ge_ex: "\<exists>y. x \<sqsubseteq> y" using gt_ex by auto
   6.321 +
   6.322 +text {* Theorems for @{text "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"} *}
   6.323 +lemma pinf_conj:
   6.324 +  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.325 +  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
   6.326 +  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
   6.327 +proof-
   6.328 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.329 +     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
   6.330 +  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
   6.331 +  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
   6.332 +  {fix x assume H: "z \<sqsubset> x"
   6.333 +    from less_trans[OF zz1 H] less_trans[OF zz2 H]
   6.334 +    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
   6.335 +  }
   6.336 +  thus ?thesis by blast
   6.337 +qed
   6.338 +
   6.339 +lemma pinf_disj:
   6.340 +  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.341 +  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
   6.342 +  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
   6.343 +proof-
   6.344 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.345 +     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
   6.346 +  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
   6.347 +  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
   6.348 +  {fix x assume H: "z \<sqsubset> x"
   6.349 +    from less_trans[OF zz1 H] less_trans[OF zz2 H]
   6.350 +    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
   6.351 +  }
   6.352 +  thus ?thesis by blast
   6.353 +qed
   6.354 +
   6.355 +lemma pinf_ex: assumes ex:"\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
   6.356 +proof-
   6.357 +  from ex obtain z where z: "\<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
   6.358 +  from gt_ex obtain x where x: "z \<sqsubset> x" by blast
   6.359 +  from z x p1 show ?thesis by blast
   6.360 +qed
   6.361 +
   6.362 +end
   6.363 +
   6.364 +text {* Linear order without upper bounds *}
   6.365 +
   6.366 +locale linorder_no_lb = linorder_stupid_syntax +
   6.367 +  assumes lt_ex: "\<exists>y. less y x"
   6.368 +begin
   6.369 +lemma le_ex: "\<exists>y. y \<sqsubseteq> x" using lt_ex by auto
   6.370 +
   6.371 +
   6.372 +text {* Theorems for @{text "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"} *}
   6.373 +lemma minf_conj:
   6.374 +  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.375 +  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
   6.376 +  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
   6.377 +proof-
   6.378 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
   6.379 +  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
   6.380 +  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
   6.381 +  {fix x assume H: "x \<sqsubset> z"
   6.382 +    from less_trans[OF H zz1] less_trans[OF H zz2]
   6.383 +    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
   6.384 +  }
   6.385 +  thus ?thesis by blast
   6.386 +qed
   6.387 +
   6.388 +lemma minf_disj:
   6.389 +  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
   6.390 +  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
   6.391 +  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
   6.392 +proof-
   6.393 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
   6.394 +  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
   6.395 +  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
   6.396 +  {fix x assume H: "x \<sqsubset> z"
   6.397 +    from less_trans[OF H zz1] less_trans[OF H zz2]
   6.398 +    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
   6.399 +  }
   6.400 +  thus ?thesis by blast
   6.401 +qed
   6.402 +
   6.403 +lemma minf_ex: assumes ex:"\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
   6.404 +proof-
   6.405 +  from ex obtain z where z: "\<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
   6.406 +  from lt_ex obtain x where x: "x \<sqsubset> z" by blast
   6.407 +  from z x p1 show ?thesis by blast
   6.408 +qed
   6.409 +
   6.410 +end
   6.411 +
   6.412 +
   6.413 +locale constr_dense_linear_order = linorder_no_lb + linorder_no_ub +
   6.414 +  fixes between
   6.415 +  assumes between_less: "less x y \<Longrightarrow> less x (between x y) \<and> less (between x y) y"
   6.416 +     and  between_same: "between x x = x"
   6.417 +
   6.418 +interpretation  constr_dense_linear_order < dense_linear_order 
   6.419 +  apply unfold_locales
   6.420 +  using gt_ex lt_ex between_less
   6.421 +    by (auto, rule_tac x="between x y" in exI, simp)
   6.422 +
   6.423 +context  constr_dense_linear_order
   6.424 +begin
   6.425 +
   6.426 +lemma rinf_U:
   6.427 +  assumes fU: "finite U"
   6.428 +  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
   6.429 +  \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
   6.430 +  and nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')"
   6.431 +  and nmi: "\<not> MP"  and npi: "\<not> PP"  and ex: "\<exists> x.  P x"
   6.432 +  shows "\<exists> u\<in> U. \<exists> u' \<in> U. P (between u u')"
   6.433 +proof-
   6.434 +  from ex obtain x where px: "P x" by blast
   6.435 +  from px nmi npi nmpiU have "\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u'" by auto
   6.436 +  then obtain u and u' where uU:"u\<in> U" and uU': "u' \<in> U" and ux:"u \<sqsubseteq> x" and xu':"x \<sqsubseteq> u'" by auto
   6.437 +  from uU have Une: "U \<noteq> {}" by auto
   6.438 +  term "linorder.Min less_eq"
   6.439 +  let ?l = "linorder.Min less_eq U"
   6.440 +  let ?u = "linorder.Max less_eq U"
   6.441 +  have linM: "?l \<in> U" using fU Une by simp
   6.442 +  have uinM: "?u \<in> U" using fU Une by simp
   6.443 +  have lM: "\<forall> t\<in> U. ?l \<sqsubseteq> t" using Une fU by auto
   6.444 +  have Mu: "\<forall> t\<in> U. t \<sqsubseteq> ?u" using Une fU by auto
   6.445 +  have th:"?l \<sqsubseteq> u" using uU Une lM by auto
   6.446 +  from order_trans[OF th ux] have lx: "?l \<sqsubseteq> x" .
   6.447 +  have th: "u' \<sqsubseteq> ?u" using uU' Une Mu by simp
   6.448 +  from order_trans[OF xu' th] have xu: "x \<sqsubseteq> ?u" .
   6.449 +  from finite_set_intervals2[where P="P",OF px lx xu linM uinM fU lM Mu]
   6.450 +  have "(\<exists> s\<in> U. P s) \<or>
   6.451 +      (\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x)" .
   6.452 +  moreover { fix u assume um: "u\<in>U" and pu: "P u"
   6.453 +    have "between u u = u" by (simp add: between_same)
   6.454 +    with um pu have "P (between u u)" by simp
   6.455 +    with um have ?thesis by blast}
   6.456 +  moreover{
   6.457 +    assume "\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x"
   6.458 +      then obtain t1 and t2 where t1M: "t1 \<in> U" and t2M: "t2\<in> U"
   6.459 +        and noM: "\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U" and t1x: "t1 \<sqsubset> x" and xt2: "x \<sqsubset> t2" and px: "P x"
   6.460 +        by blast
   6.461 +      from less_trans[OF t1x xt2] have t1t2: "t1 \<sqsubset> t2" .
   6.462 +      let ?u = "between t1 t2"
   6.463 +      from between_less t1t2 have t1lu: "t1 \<sqsubset> ?u" and ut2: "?u \<sqsubset> t2" by auto
   6.464 +      from lin_dense noM t1x xt2 px t1lu ut2 have "P ?u" by blast
   6.465 +      with t1M t2M have ?thesis by blast}
   6.466 +    ultimately show ?thesis by blast
   6.467 +  qed
   6.468 +
   6.469 +theorem fr_eq:
   6.470 +  assumes fU: "finite U"
   6.471 +  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
   6.472 +   \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
   6.473 +  and nmibnd: "\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<sqsubseteq> x)"
   6.474 +  and npibnd: "\<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<sqsubseteq> u)"
   6.475 +  and mi: "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x = MP)"  and pi: "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x = PP)"
   6.476 +  shows "(\<exists> x. P x) \<equiv> (MP \<or> PP \<or> (\<exists> u \<in> U. \<exists> u'\<in> U. P (between u u')))"
   6.477 +  (is "_ \<equiv> (_ \<or> _ \<or> ?F)" is "?E \<equiv> ?D")
   6.478 +proof-
   6.479 + {
   6.480 +   assume px: "\<exists> x. P x"
   6.481 +   have "MP \<or> PP \<or> (\<not> MP \<and> \<not> PP)" by blast
   6.482 +   moreover {assume "MP \<or> PP" hence "?D" by blast}
   6.483 +   moreover {assume nmi: "\<not> MP" and npi: "\<not> PP"
   6.484 +     from npmibnd[OF nmibnd npibnd]
   6.485 +     have nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')" .
   6.486 +     from rinf_U[OF fU lin_dense nmpiU nmi npi px] have "?D" by blast}
   6.487 +   ultimately have "?D" by blast}
   6.488 + moreover
   6.489 + { assume "?D"
   6.490 +   moreover {assume m:"MP" from minf_ex[OF mi m] have "?E" .}
   6.491 +   moreover {assume p: "PP" from pinf_ex[OF pi p] have "?E" . }
   6.492 +   moreover {assume f:"?F" hence "?E" by blast}
   6.493 +   ultimately have "?E" by blast}
   6.494 + ultimately have "?E = ?D" by blast thus "?E \<equiv> ?D" by simp
   6.495 +qed
   6.496 +
   6.497 +lemmas minf_thms = minf_conj minf_disj minf_eq minf_neq minf_lt minf_le minf_gt minf_ge minf_P
   6.498 +lemmas pinf_thms = pinf_conj pinf_disj pinf_eq pinf_neq pinf_lt pinf_le pinf_gt pinf_ge pinf_P
   6.499 +
   6.500 +lemmas nmi_thms = nmi_conj nmi_disj nmi_eq nmi_neq nmi_lt nmi_le nmi_gt nmi_ge nmi_P
   6.501 +lemmas npi_thms = npi_conj npi_disj npi_eq npi_neq npi_lt npi_le npi_gt npi_ge npi_P
   6.502 +lemmas lin_dense_thms = lin_dense_conj lin_dense_disj lin_dense_eq lin_dense_neq lin_dense_lt lin_dense_le lin_dense_gt lin_dense_ge lin_dense_P
   6.503 +
   6.504 +lemma ferrack_axiom: "constr_dense_linear_order less_eq less between"
   6.505 +  by (rule constr_dense_linear_order_axioms)
   6.506 +lemma atoms:
   6.507 +  shows "TERM (less :: 'a \<Rightarrow> _)"
   6.508 +    and "TERM (less_eq :: 'a \<Rightarrow> _)"
   6.509 +    and "TERM (op = :: 'a \<Rightarrow> _)" .
   6.510 +
   6.511 +declare ferrack_axiom [ferrack minf: minf_thms pinf: pinf_thms
   6.512 +    nmi: nmi_thms npi: npi_thms lindense:
   6.513 +    lin_dense_thms qe: fr_eq atoms: atoms]
   6.514 +
   6.515 +declaration {*
   6.516 +let
   6.517 +fun simps phi = map (Morphism.thm phi) [@{thm "not_less"}, @{thm "not_le"}]
   6.518 +fun generic_whatis phi =
   6.519 + let
   6.520 +  val [lt, le] = map (Morphism.term phi) [@{term "op \<sqsubset>"}, @{term "op \<sqsubseteq>"}]
   6.521 +  fun h x t =
   6.522 +   case term_of t of
   6.523 +     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
   6.524 +                            else Ferrante_Rackoff_Data.Nox
   6.525 +   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   6.526 +                            else Ferrante_Rackoff_Data.Nox
   6.527 +   | b$y$z => if Term.could_unify (b, lt) then
   6.528 +                 if term_of x aconv y then Ferrante_Rackoff_Data.Lt
   6.529 +                 else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
   6.530 +                 else Ferrante_Rackoff_Data.Nox
   6.531 +             else if Term.could_unify (b, le) then
   6.532 +                 if term_of x aconv y then Ferrante_Rackoff_Data.Le
   6.533 +                 else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
   6.534 +                 else Ferrante_Rackoff_Data.Nox
   6.535 +             else Ferrante_Rackoff_Data.Nox
   6.536 +   | _ => Ferrante_Rackoff_Data.Nox
   6.537 + in h end
   6.538 + fun ss phi = HOL_ss addsimps (simps phi)
   6.539 +in
   6.540 + Ferrante_Rackoff_Data.funs  @{thm "ferrack_axiom"}
   6.541 +  {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss}
   6.542 +end
   6.543 +*}
   6.544 +
   6.545 +end
   6.546 +
   6.547 +use "~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML"
   6.548 +
   6.549 +method_setup ferrack = {*
   6.550 +  Method.ctxt_args (Method.SIMPLE_METHOD' o FerranteRackoff.dlo_tac)
   6.551 +*} "Ferrante and Rackoff's algorithm for quantifier elimination in dense linear orders"
   6.552 +
   6.553 +subsection {* Ferrante and Rackoff algorithm over ordered fields *}
   6.554 +
   6.555 +lemma neg_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x < 0) == (x > 0))"
   6.556 +proof-
   6.557 +  assume H: "c < 0"
   6.558 +  have "c*x < 0 = (0/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
   6.559 +  also have "\<dots> = (0 < x)" by simp
   6.560 +  finally show  "(c*x < 0) == (x > 0)" by simp
   6.561 +qed
   6.562 +
   6.563 +lemma pos_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x < 0) == (x < 0))"
   6.564 +proof-
   6.565 +  assume H: "c > 0"
   6.566 +  hence "c*x < 0 = (0/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
   6.567 +  also have "\<dots> = (0 > x)" by simp
   6.568 +  finally show  "(c*x < 0) == (x < 0)" by simp
   6.569 +qed
   6.570 +
   6.571 +lemma neg_prod_sum_lt: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t< 0) == (x > (- 1/c)*t))"
   6.572 +proof-
   6.573 +  assume H: "c < 0"
   6.574 +  have "c*x + t< 0 = (c*x < -t)" by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
   6.575 +  also have "\<dots> = (-t/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
   6.576 +  also have "\<dots> = ((- 1/c)*t < x)" by simp
   6.577 +  finally show  "(c*x + t < 0) == (x > (- 1/c)*t)" by simp
   6.578 +qed
   6.579 +
   6.580 +lemma pos_prod_sum_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t < 0) == (x < (- 1/c)*t))"
   6.581 +proof-
   6.582 +  assume H: "c > 0"
   6.583 +  have "c*x + t< 0 = (c*x < -t)"  by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
   6.584 +  also have "\<dots> = (-t/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
   6.585 +  also have "\<dots> = ((- 1/c)*t > x)" by simp
   6.586 +  finally show  "(c*x + t < 0) == (x < (- 1/c)*t)" by simp
   6.587 +qed
   6.588 +
   6.589 +lemma sum_lt:"((x::'a::pordered_ab_group_add) + t < 0) == (x < - t)"
   6.590 +  using less_diff_eq[where a= x and b=t and c=0] by simp
   6.591 +
   6.592 +lemma neg_prod_le:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x <= 0) == (x >= 0))"
   6.593 +proof-
   6.594 +  assume H: "c < 0"
   6.595 +  have "c*x <= 0 = (0/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
   6.596 +  also have "\<dots> = (0 <= x)" by simp
   6.597 +  finally show  "(c*x <= 0) == (x >= 0)" by simp
   6.598 +qed
   6.599 +
   6.600 +lemma pos_prod_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x <= 0) == (x <= 0))"
   6.601 +proof-
   6.602 +  assume H: "c > 0"
   6.603 +  hence "c*x <= 0 = (0/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
   6.604 +  also have "\<dots> = (0 >= x)" by simp
   6.605 +  finally show  "(c*x <= 0) == (x <= 0)" by simp
   6.606 +qed
   6.607 +
   6.608 +lemma neg_prod_sum_le: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t <= 0) == (x >= (- 1/c)*t))"
   6.609 +proof-
   6.610 +  assume H: "c < 0"
   6.611 +  have "c*x + t <= 0 = (c*x <= -t)"  by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
   6.612 +  also have "\<dots> = (-t/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
   6.613 +  also have "\<dots> = ((- 1/c)*t <= x)" by simp
   6.614 +  finally show  "(c*x + t <= 0) == (x >= (- 1/c)*t)" by simp
   6.615 +qed
   6.616 +
   6.617 +lemma pos_prod_sum_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t <= 0) == (x <= (- 1/c)*t))"
   6.618 +proof-
   6.619 +  assume H: "c > 0"
   6.620 +  have "c*x + t <= 0 = (c*x <= -t)" by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
   6.621 +  also have "\<dots> = (-t/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
   6.622 +  also have "\<dots> = ((- 1/c)*t >= x)" by simp
   6.623 +  finally show  "(c*x + t <= 0) == (x <= (- 1/c)*t)" by simp
   6.624 +qed
   6.625 +
   6.626 +lemma sum_le:"((x::'a::pordered_ab_group_add) + t <= 0) == (x <= - t)"
   6.627 +  using le_diff_eq[where a= x and b=t and c=0] by simp
   6.628 +
   6.629 +lemma nz_prod_eq:"(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x = 0) == (x = 0))" by simp
   6.630 +lemma nz_prod_sum_eq: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x + t = 0) == (x = (- 1/c)*t))"
   6.631 +proof-
   6.632 +  assume H: "c \<noteq> 0"
   6.633 +  have "c*x + t = 0 = (c*x = -t)" by (subst eq_iff_diff_eq_0 [of "c*x" "-t"], simp)
   6.634 +  also have "\<dots> = (x = -t/c)" by (simp only: nonzero_eq_divide_eq[OF H] ring_simps)
   6.635 +  finally show  "(c*x + t = 0) == (x = (- 1/c)*t)" by simp
   6.636 +qed
   6.637 +lemma sum_eq:"((x::'a::pordered_ab_group_add) + t = 0) == (x = - t)"
   6.638 +  using eq_diff_eq[where a= x and b=t and c=0] by simp
   6.639 +
   6.640 +
   6.641 +interpretation class_ordered_field_dense_linear_order: constr_dense_linear_order
   6.642 + ["op <=" "op <"
   6.643 +   "\<lambda> x y. 1/2 * ((x::'a::{ordered_field,recpower,number_ring}) + y)"]
   6.644 +proof (unfold_locales, dlo, dlo, auto)
   6.645 +  fix x y::'a assume lt: "x < y"
   6.646 +  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
   6.647 +next
   6.648 +  fix x y::'a assume lt: "x < y"
   6.649 +  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
   6.650 +qed
   6.651 +
   6.652 +declaration{*
   6.653 +let
   6.654 +fun earlier [] x y = false
   6.655 +        | earlier (h::t) x y =
   6.656 +    if h aconvc y then false else if h aconvc x then true else earlier t x y;
   6.657 +
   6.658 +fun dest_frac ct = case term_of ct of
   6.659 +   Const (@{const_name "HOL.divide"},_) $ a $ b=>
   6.660 +    Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b))
   6.661 + | t => Rat.rat_of_int (snd (HOLogic.dest_number t))
   6.662 +
   6.663 +fun mk_frac phi cT x =
   6.664 + let val (a, b) = Rat.quotient_of_rat x
   6.665 + in if b = 1 then Numeral.mk_cnumber cT a
   6.666 +    else Thm.capply
   6.667 +         (Thm.capply (Drule.cterm_rule (instantiate' [SOME cT] []) @{cpat "op /"})
   6.668 +                     (Numeral.mk_cnumber cT a))
   6.669 +         (Numeral.mk_cnumber cT b)
   6.670 + end
   6.671 +
   6.672 +fun whatis x ct = case term_of ct of
   6.673 +  Const(@{const_name "HOL.plus"}, _)$(Const(@{const_name "HOL.times"},_)$_$y)$_ =>
   6.674 +     if y aconv term_of x then ("c*x+t",[(funpow 2 Thm.dest_arg1) ct, Thm.dest_arg ct])
   6.675 +     else ("Nox",[])
   6.676 +| Const(@{const_name "HOL.plus"}, _)$y$_ =>
   6.677 +     if y aconv term_of x then ("x+t",[Thm.dest_arg ct])
   6.678 +     else ("Nox",[])
   6.679 +| Const(@{const_name "HOL.times"}, _)$_$y =>
   6.680 +     if y aconv term_of x then ("c*x",[Thm.dest_arg1 ct])
   6.681 +     else ("Nox",[])
   6.682 +| t => if t aconv term_of x then ("x",[]) else ("Nox",[]);
   6.683 +
   6.684 +fun xnormalize_conv ctxt [] ct = reflexive ct
   6.685 +| xnormalize_conv ctxt (vs as (x::_)) ct =
   6.686 +   case term_of ct of
   6.687 +   Const(@{const_name HOL.less},_)$_$Const(@{const_name "HOL.zero"},_) =>
   6.688 +    (case whatis x (Thm.dest_arg1 ct) of
   6.689 +    ("c*x+t",[c,t]) =>
   6.690 +       let
   6.691 +        val cr = dest_frac c
   6.692 +        val clt = Thm.dest_fun2 ct
   6.693 +        val cz = Thm.dest_arg ct
   6.694 +        val neg = cr </ Rat.zero
   6.695 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.696 +               (Thm.capply @{cterm "Trueprop"}
   6.697 +                  (if neg then Thm.capply (Thm.capply clt c) cz
   6.698 +                    else Thm.capply (Thm.capply clt cz) c))
   6.699 +        val cth = equal_elim (symmetric cthp) TrueI
   6.700 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x,t])
   6.701 +             (if neg then @{thm neg_prod_sum_lt} else @{thm pos_prod_sum_lt})) cth
   6.702 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.703 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.704 +      in rth end
   6.705 +    | ("x+t",[t]) =>
   6.706 +       let
   6.707 +        val T = ctyp_of_term x
   6.708 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_lt"}
   6.709 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.710 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.711 +       in  rth end
   6.712 +    | ("c*x",[c]) =>
   6.713 +       let
   6.714 +        val cr = dest_frac c
   6.715 +        val clt = Thm.dest_fun2 ct
   6.716 +        val cz = Thm.dest_arg ct
   6.717 +        val neg = cr </ Rat.zero
   6.718 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.719 +               (Thm.capply @{cterm "Trueprop"}
   6.720 +                  (if neg then Thm.capply (Thm.capply clt c) cz
   6.721 +                    else Thm.capply (Thm.capply clt cz) c))
   6.722 +        val cth = equal_elim (symmetric cthp) TrueI
   6.723 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
   6.724 +             (if neg then @{thm neg_prod_lt} else @{thm pos_prod_lt})) cth
   6.725 +        val rth = th
   6.726 +      in rth end
   6.727 +    | _ => reflexive ct)
   6.728 +
   6.729 +
   6.730 +|  Const(@{const_name HOL.less_eq},_)$_$Const(@{const_name "HOL.zero"},_) =>
   6.731 +   (case whatis x (Thm.dest_arg1 ct) of
   6.732 +    ("c*x+t",[c,t]) =>
   6.733 +       let
   6.734 +        val T = ctyp_of_term x
   6.735 +        val cr = dest_frac c
   6.736 +        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
   6.737 +        val cz = Thm.dest_arg ct
   6.738 +        val neg = cr </ Rat.zero
   6.739 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.740 +               (Thm.capply @{cterm "Trueprop"}
   6.741 +                  (if neg then Thm.capply (Thm.capply clt c) cz
   6.742 +                    else Thm.capply (Thm.capply clt cz) c))
   6.743 +        val cth = equal_elim (symmetric cthp) TrueI
   6.744 +        val th = implies_elim (instantiate' [SOME T] (map SOME [c,x,t])
   6.745 +             (if neg then @{thm neg_prod_sum_le} else @{thm pos_prod_sum_le})) cth
   6.746 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.747 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.748 +      in rth end
   6.749 +    | ("x+t",[t]) =>
   6.750 +       let
   6.751 +        val T = ctyp_of_term x
   6.752 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_le"}
   6.753 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.754 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.755 +       in  rth end
   6.756 +    | ("c*x",[c]) =>
   6.757 +       let
   6.758 +        val T = ctyp_of_term x
   6.759 +        val cr = dest_frac c
   6.760 +        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
   6.761 +        val cz = Thm.dest_arg ct
   6.762 +        val neg = cr </ Rat.zero
   6.763 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.764 +               (Thm.capply @{cterm "Trueprop"}
   6.765 +                  (if neg then Thm.capply (Thm.capply clt c) cz
   6.766 +                    else Thm.capply (Thm.capply clt cz) c))
   6.767 +        val cth = equal_elim (symmetric cthp) TrueI
   6.768 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
   6.769 +             (if neg then @{thm neg_prod_le} else @{thm pos_prod_le})) cth
   6.770 +        val rth = th
   6.771 +      in rth end
   6.772 +    | _ => reflexive ct)
   6.773 +
   6.774 +|  Const("op =",_)$_$Const(@{const_name "HOL.zero"},_) =>
   6.775 +   (case whatis x (Thm.dest_arg1 ct) of
   6.776 +    ("c*x+t",[c,t]) =>
   6.777 +       let
   6.778 +        val T = ctyp_of_term x
   6.779 +        val cr = dest_frac c
   6.780 +        val ceq = Thm.dest_fun2 ct
   6.781 +        val cz = Thm.dest_arg ct
   6.782 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.783 +            (Thm.capply @{cterm "Trueprop"}
   6.784 +             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
   6.785 +        val cth = equal_elim (symmetric cthp) TrueI
   6.786 +        val th = implies_elim
   6.787 +                 (instantiate' [SOME T] (map SOME [c,x,t]) @{thm nz_prod_sum_eq}) cth
   6.788 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.789 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.790 +      in rth end
   6.791 +    | ("x+t",[t]) =>
   6.792 +       let
   6.793 +        val T = ctyp_of_term x
   6.794 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_eq"}
   6.795 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
   6.796 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
   6.797 +       in  rth end
   6.798 +    | ("c*x",[c]) =>
   6.799 +       let
   6.800 +        val T = ctyp_of_term x
   6.801 +        val cr = dest_frac c
   6.802 +        val ceq = Thm.dest_fun2 ct
   6.803 +        val cz = Thm.dest_arg ct
   6.804 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
   6.805 +            (Thm.capply @{cterm "Trueprop"}
   6.806 +             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
   6.807 +        val cth = equal_elim (symmetric cthp) TrueI
   6.808 +        val rth = implies_elim
   6.809 +                 (instantiate' [SOME T] (map SOME [c,x]) @{thm nz_prod_eq}) cth
   6.810 +      in rth end
   6.811 +    | _ => reflexive ct);
   6.812 +
   6.813 +local
   6.814 +  val less_iff_diff_less_0 = mk_meta_eq @{thm "less_iff_diff_less_0"}
   6.815 +  val le_iff_diff_le_0 = mk_meta_eq @{thm "le_iff_diff_le_0"}
   6.816 +  val eq_iff_diff_eq_0 = mk_meta_eq @{thm "eq_iff_diff_eq_0"}
   6.817 +in
   6.818 +fun field_isolate_conv phi ctxt vs ct = case term_of ct of
   6.819 +  Const(@{const_name HOL.less},_)$a$b =>
   6.820 +   let val (ca,cb) = Thm.dest_binop ct
   6.821 +       val T = ctyp_of_term ca
   6.822 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] less_iff_diff_less_0
   6.823 +       val nth = Conv.fconv_rule
   6.824 +         (Conv.arg_conv (Conv.arg1_conv
   6.825 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
   6.826 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
   6.827 +   in rth end
   6.828 +| Const(@{const_name HOL.less_eq},_)$a$b =>
   6.829 +   let val (ca,cb) = Thm.dest_binop ct
   6.830 +       val T = ctyp_of_term ca
   6.831 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] le_iff_diff_le_0
   6.832 +       val nth = Conv.fconv_rule
   6.833 +         (Conv.arg_conv (Conv.arg1_conv
   6.834 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
   6.835 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
   6.836 +   in rth end
   6.837 +
   6.838 +| Const("op =",_)$a$b =>
   6.839 +   let val (ca,cb) = Thm.dest_binop ct
   6.840 +       val T = ctyp_of_term ca
   6.841 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] eq_iff_diff_eq_0
   6.842 +       val nth = Conv.fconv_rule
   6.843 +         (Conv.arg_conv (Conv.arg1_conv
   6.844 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
   6.845 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
   6.846 +   in rth end
   6.847 +| @{term "Not"} $(Const("op =",_)$a$b) => Conv.arg_conv (field_isolate_conv phi ctxt vs) ct
   6.848 +| _ => reflexive ct
   6.849 +end;
   6.850 +
   6.851 +fun classfield_whatis phi =
   6.852 + let
   6.853 +  fun h x t =
   6.854 +   case term_of t of
   6.855 +     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
   6.856 +                            else Ferrante_Rackoff_Data.Nox
   6.857 +   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   6.858 +                            else Ferrante_Rackoff_Data.Nox
   6.859 +   | Const(@{const_name HOL.less},_)$y$z =>
   6.860 +       if term_of x aconv y then Ferrante_Rackoff_Data.Lt
   6.861 +        else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
   6.862 +        else Ferrante_Rackoff_Data.Nox
   6.863 +   | Const (@{const_name HOL.less_eq},_)$y$z =>
   6.864 +         if term_of x aconv y then Ferrante_Rackoff_Data.Le
   6.865 +         else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
   6.866 +         else Ferrante_Rackoff_Data.Nox
   6.867 +   | _ => Ferrante_Rackoff_Data.Nox
   6.868 + in h end;
   6.869 +fun class_field_ss phi =
   6.870 +   HOL_basic_ss addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
   6.871 +   addsplits [@{thm "abs_split"},@{thm "split_max"}, @{thm "split_min"}]
   6.872 +
   6.873 +in
   6.874 +Ferrante_Rackoff_Data.funs @{thm "class_ordered_field_dense_linear_order.ferrack_axiom"}
   6.875 +  {isolate_conv = field_isolate_conv, whatis = classfield_whatis, simpset = class_field_ss}
   6.876 +end
   6.877 +*}
   6.878 +
   6.879 +
   6.880 +end 
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/Fundamental_Theorem_Algebra.thy	Mon Dec 29 14:08:08 2008 +0100
     7.3 @@ -0,0 +1,1327 @@
     7.4 +(* Author: Amine Chaieb, TU Muenchen *)
     7.5 +
     7.6 +header{*Fundamental Theorem of Algebra*}
     7.7 +
     7.8 +theory Fundamental_Theorem_Algebra
     7.9 +imports Univ_Poly Dense_Linear_Order Complex
    7.10 +begin
    7.11 +
    7.12 +subsection {* Square root of complex numbers *}
    7.13 +definition csqrt :: "complex \<Rightarrow> complex" where
    7.14 +"csqrt z = (if Im z = 0 then
    7.15 +            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
    7.16 +            else Complex 0 (sqrt(- Re z))
    7.17 +           else Complex (sqrt((cmod z + Re z) /2))
    7.18 +                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
    7.19 +
    7.20 +lemma csqrt[algebra]: "csqrt z ^ 2 = z"
    7.21 +proof-
    7.22 +  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
    7.23 +  {assume y0: "y = 0"
    7.24 +    {assume x0: "x \<ge> 0" 
    7.25 +      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
    7.26 +	by (simp add: csqrt_def power2_eq_square)}
    7.27 +    moreover
    7.28 +    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
    7.29 +      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
    7.30 +	by (simp add: csqrt_def power2_eq_square) }
    7.31 +    ultimately have ?thesis by blast}
    7.32 +  moreover
    7.33 +  {assume y0: "y\<noteq>0"
    7.34 +    {fix x y
    7.35 +      let ?z = "Complex x y"
    7.36 +      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
    7.37 +      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
    7.38 +      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
    7.39 +    note th = this
    7.40 +    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
    7.41 +      by (simp add: power2_eq_square) 
    7.42 +    from th[of x y]
    7.43 +    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
    7.44 +    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
    7.45 +      unfolding power2_eq_square by simp 
    7.46 +    have "sqrt 4 = sqrt (2^2)" by simp 
    7.47 +    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
    7.48 +    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
    7.49 +      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
    7.50 +      unfolding power2_eq_square 
    7.51 +      by (simp add: ring_simps real_sqrt_divide sqrt4)
    7.52 +     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
    7.53 +       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
    7.54 +      using th1 th2  ..}
    7.55 +  ultimately show ?thesis by blast
    7.56 +qed
    7.57 +
    7.58 +
    7.59 +subsection{* More lemmas about module of complex numbers *}
    7.60 +
    7.61 +lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
    7.62 +  by (rule of_real_power [symmetric])
    7.63 +
    7.64 +lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
    7.65 +  apply ferrack apply arith done
    7.66 +
    7.67 +text{* The triangle inequality for cmod *}
    7.68 +lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
    7.69 +  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
    7.70 +
    7.71 +subsection{* Basic lemmas about complex polynomials *}
    7.72 +
    7.73 +lemma poly_bound_exists:
    7.74 +  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
    7.75 +proof(induct p)
    7.76 +  case Nil thus ?case by (rule exI[where x=1], simp) 
    7.77 +next
    7.78 +  case (Cons c cs)
    7.79 +  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
    7.80 +    by blast
    7.81 +  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
    7.82 +  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
    7.83 +  {fix z
    7.84 +    assume H: "cmod z \<le> r"
    7.85 +    from m H have th: "cmod (poly cs z) \<le> m" by blast
    7.86 +    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
    7.87 +    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
    7.88 +      using norm_triangle_ineq[of c "z* poly cs z"] by simp
    7.89 +    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
    7.90 +    also have "\<dots> \<le> ?k" by simp
    7.91 +    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
    7.92 +  with kp show ?case by blast
    7.93 +qed
    7.94 +
    7.95 +
    7.96 +text{* Offsetting the variable in a polynomial gives another of same degree *}
    7.97 +  (* FIXME : Lemma holds also in locale --- fix it later *)
    7.98 +lemma  poly_offset_lemma:
    7.99 +  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
   7.100 +proof(induct p)
   7.101 +  case Nil thus ?case by simp
   7.102 +next
   7.103 +  case (Cons c cs)
   7.104 +  from Cons.hyps obtain b q where 
   7.105 +    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
   7.106 +    by blast
   7.107 +  let ?b = "a*c"
   7.108 +  let ?q = "(b+c)#q"
   7.109 +  have lg: "length ?q = length (c#cs)" using bq(1) by simp
   7.110 +  {fix x
   7.111 +    from bq(2)[rule_format, of x]
   7.112 +    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
   7.113 +    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
   7.114 +      by (simp add: ring_simps)}
   7.115 +  with lg  show ?case by blast 
   7.116 +qed
   7.117 +
   7.118 +    (* FIXME : This one too*)
   7.119 +lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
   7.120 +proof (induct p)
   7.121 +  case Nil thus ?case by simp
   7.122 +next
   7.123 +  case (Cons c cs)
   7.124 +  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
   7.125 +  from poly_offset_lemma[of q a] obtain b p where 
   7.126 +    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
   7.127 +    by blast
   7.128 +  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
   7.129 +qed
   7.130 +
   7.131 +text{* An alternative useful formulation of completeness of the reals *}
   7.132 +lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
   7.133 +  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
   7.134 +proof-
   7.135 +  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
   7.136 +  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
   7.137 +  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
   7.138 +    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
   7.139 +  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
   7.140 +    by blast
   7.141 +  from Y[OF x] have xY: "x < Y" .
   7.142 +  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
   7.143 +  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
   7.144 +    apply (clarsimp, atomize (full)) by auto 
   7.145 +  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
   7.146 +  {fix y
   7.147 +    {fix z assume z: "P z" "y < z"
   7.148 +      from L' z have "y < L" by auto }
   7.149 +    moreover
   7.150 +    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
   7.151 +      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
   7.152 +      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
   7.153 +      with yL(1) have False  by arith}
   7.154 +    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
   7.155 +  thus ?thesis by blast
   7.156 +qed
   7.157 +
   7.158 +
   7.159 +subsection{* Some theorems about Sequences*}
   7.160 +text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
   7.161 +
   7.162 +lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
   7.163 +  unfolding Ex1_def
   7.164 +  apply (rule_tac x="nat_rec e f" in exI)
   7.165 +  apply (rule conjI)+
   7.166 +apply (rule def_nat_rec_0, simp)
   7.167 +apply (rule allI, rule def_nat_rec_Suc, simp)
   7.168 +apply (rule allI, rule impI, rule ext)
   7.169 +apply (erule conjE)
   7.170 +apply (induct_tac x)
   7.171 +apply (simp add: nat_rec_0)
   7.172 +apply (erule_tac x="n" in allE)
   7.173 +apply (simp)
   7.174 +done
   7.175 +
   7.176 + text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
   7.177 +lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
   7.178 +unfolding mono_def
   7.179 +proof auto
   7.180 +  fix A B :: nat
   7.181 +  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
   7.182 +  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
   7.183 +    by presburger
   7.184 +  then obtain k where k: "B = A + k" by blast
   7.185 +  {fix a k
   7.186 +    have "f a \<le> f (a + k)"
   7.187 +    proof (induct k)
   7.188 +      case 0 thus ?case by simp
   7.189 +    next
   7.190 +      case (Suc k)
   7.191 +      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
   7.192 +    qed}
   7.193 +  with k show "f A \<le> f B" by blast
   7.194 +qed
   7.195 +
   7.196 +text{* for any sequence, there is a mootonic subsequence *}
   7.197 +lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
   7.198 +proof-
   7.199 +  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
   7.200 +    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
   7.201 +    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
   7.202 +    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
   7.203 +    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
   7.204 +      using H apply - 
   7.205 +      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
   7.206 +      unfolding order_le_less by blast 
   7.207 +    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
   7.208 +    {fix n
   7.209 +      have "?P (f (Suc n)) (f n)" 
   7.210 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
   7.211 +	using H apply - 
   7.212 +      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
   7.213 +      unfolding order_le_less by blast 
   7.214 +    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
   7.215 +  note fSuc = this
   7.216 +    {fix p q assume pq: "p \<ge> f q"
   7.217 +      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
   7.218 +	by (cases q, simp_all) }
   7.219 +    note pqth = this
   7.220 +    {fix q
   7.221 +      have "f (Suc q) > f q" apply (induct q) 
   7.222 +	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
   7.223 +    note fss = this
   7.224 +    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
   7.225 +    {fix a b 
   7.226 +      have "f a \<le> f (a + b)"
   7.227 +      proof(induct b)
   7.228 +	case 0 thus ?case by simp
   7.229 +      next
   7.230 +	case (Suc b)
   7.231 +	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
   7.232 +      qed}
   7.233 +    note fmon0 = this
   7.234 +    have "monoseq (\<lambda>n. s (f n))" 
   7.235 +    proof-
   7.236 +      {fix n
   7.237 +	have "s (f n) \<ge> s (f (Suc n))" 
   7.238 +	proof(cases n)
   7.239 +	  case 0
   7.240 +	  assume n0: "n = 0"
   7.241 +	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
   7.242 +	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
   7.243 +	next
   7.244 +	  case (Suc m)
   7.245 +	  assume m: "n = Suc m"
   7.246 +	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
   7.247 +	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
   7.248 +	qed}
   7.249 +      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
   7.250 +    qed
   7.251 +    with th1 have ?thesis by blast}
   7.252 +  moreover
   7.253 +  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
   7.254 +    {fix p assume p: "p \<ge> Suc N" 
   7.255 +      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
   7.256 +      have "m \<noteq> p" using m(2) by auto 
   7.257 +      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
   7.258 +    note th0 = this
   7.259 +    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
   7.260 +    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
   7.261 +    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
   7.262 +      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
   7.263 +    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
   7.264 +      using N apply - 
   7.265 +      apply (erule allE[where x="Suc N"], clarsimp)
   7.266 +      apply (rule_tac x="m" in exI)
   7.267 +      apply auto
   7.268 +      apply (subgoal_tac "Suc N \<noteq> m")
   7.269 +      apply simp
   7.270 +      apply (rule ccontr, simp)
   7.271 +      done
   7.272 +    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
   7.273 +    {fix n
   7.274 +      have "f n > N \<and> ?P (f (Suc n)) (f n)"
   7.275 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
   7.276 +      proof (induct n)
   7.277 +	case 0 thus ?case
   7.278 +	  using f0 N apply auto 
   7.279 +	  apply (erule allE[where x="f 0"], clarsimp) 
   7.280 +	  apply (rule_tac x="m" in exI, simp)
   7.281 +	  by (subgoal_tac "f 0 \<noteq> m", auto)
   7.282 +      next
   7.283 +	case (Suc n)
   7.284 +	from Suc.hyps have Nfn: "N < f n" by blast
   7.285 +	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
   7.286 +	with Nfn have mN: "m > N" by arith
   7.287 +	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
   7.288 +	
   7.289 +	from key have th0: "f (Suc n) > N" by simp
   7.290 +	from N[rule_format, OF th0]
   7.291 +	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
   7.292 +	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
   7.293 +	hence "m' > f (Suc n)" using m'(1) by simp
   7.294 +	with key m'(2) show ?case by auto
   7.295 +      qed}
   7.296 +    note fSuc = this
   7.297 +    {fix n
   7.298 +      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
   7.299 +      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
   7.300 +    note thf = this
   7.301 +    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
   7.302 +    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
   7.303 +      apply -
   7.304 +      apply (rule disjI1)
   7.305 +      apply auto
   7.306 +      apply (rule order_less_imp_le)
   7.307 +      apply blast
   7.308 +      done
   7.309 +    then have ?thesis  using sqf by blast}
   7.310 +  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
   7.311 +qed
   7.312 +
   7.313 +lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
   7.314 +proof(induct n)
   7.315 +  case 0 thus ?case by simp
   7.316 +next
   7.317 +  case (Suc n)
   7.318 +  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
   7.319 +  have "n < f (Suc n)" by arith 
   7.320 +  thus ?case by arith
   7.321 +qed
   7.322 +
   7.323 +subsection {* Fundamental theorem of algebra *}
   7.324 +lemma  unimodular_reduce_norm:
   7.325 +  assumes md: "cmod z = 1"
   7.326 +  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
   7.327 +proof-
   7.328 +  obtain x y where z: "z = Complex x y " by (cases z, auto)
   7.329 +  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
   7.330 +  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
   7.331 +    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
   7.332 +      by (simp_all add: cmod_def power2_eq_square ring_simps)
   7.333 +    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
   7.334 +    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
   7.335 +      by - (rule power_mono, simp, simp)+
   7.336 +    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
   7.337 +      by (simp_all  add: power2_abs power_mult_distrib)
   7.338 +    from add_mono[OF th0] xy have False by simp }
   7.339 +  thus ?thesis unfolding linorder_not_le[symmetric] by blast
   7.340 +qed
   7.341 +
   7.342 +text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
   7.343 +lemma reduce_poly_simple:
   7.344 + assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
   7.345 +  shows "\<exists>z. cmod (1 + b * z^n) < 1"
   7.346 +using n
   7.347 +proof(induct n rule: nat_less_induct)
   7.348 +  fix n
   7.349 +  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
   7.350 +  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
   7.351 +  {assume e: "even n"
   7.352 +    hence "\<exists>m. n = 2*m" by presburger
   7.353 +    then obtain m where m: "n = 2*m" by blast
   7.354 +    from n m have "m\<noteq>0" "m < n" by presburger+
   7.355 +    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
   7.356 +    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
   7.357 +    hence "\<exists>z. ?P z n" ..}
   7.358 +  moreover
   7.359 +  {assume o: "odd n"
   7.360 +    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
   7.361 +    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
   7.362 +    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
   7.363 +    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
   7.364 +    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
   7.365 +      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
   7.366 +      by (simp add: power2_eq_square)
   7.367 +    finally 
   7.368 +    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
   7.369 +    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
   7.370 +    1" 
   7.371 +      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
   7.372 +      using right_inverse[OF b']
   7.373 +      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
   7.374 +    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
   7.375 +      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
   7.376 +      by (simp add: real_sqrt_mult[symmetric] th0)        
   7.377 +    from o have "\<exists>m. n = Suc (2*m)" by presburger+
   7.378 +    then obtain m where m: "n = Suc (2*m)" by blast
   7.379 +    from unimodular_reduce_norm[OF th0] o
   7.380 +    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
   7.381 +      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
   7.382 +      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
   7.383 +      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
   7.384 +      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
   7.385 +      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
   7.386 +      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
   7.387 +      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
   7.388 +      done
   7.389 +    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
   7.390 +    let ?w = "v / complex_of_real (root n (cmod b))"
   7.391 +    from odd_real_root_pow[OF o, of "cmod b"]
   7.392 +    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
   7.393 +      by (simp add: power_divide complex_of_real_power)
   7.394 +    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
   7.395 +    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
   7.396 +    have th4: "cmod (complex_of_real (cmod b) / b) *
   7.397 +   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
   7.398 +   < cmod (complex_of_real (cmod b) / b) * 1"
   7.399 +      apply (simp only: norm_mult[symmetric] right_distrib)
   7.400 +      using b v by (simp add: th2)
   7.401 +
   7.402 +    from mult_less_imp_less_left[OF th4 th3]
   7.403 +    have "?P ?w n" unfolding th1 . 
   7.404 +    hence "\<exists>z. ?P z n" .. }
   7.405 +  ultimately show "\<exists>z. ?P z n" by blast
   7.406 +qed
   7.407 +
   7.408 +
   7.409 +text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
   7.410 +
   7.411 +lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
   7.412 +  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
   7.413 +  unfolding cmod_def by simp
   7.414 +
   7.415 +lemma bolzano_weierstrass_complex_disc:
   7.416 +  assumes r: "\<forall>n. cmod (s n) \<le> r"
   7.417 +  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
   7.418 +proof-
   7.419 +  from seq_monosub[of "Re o s"] 
   7.420 +  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
   7.421 +    unfolding o_def by blast
   7.422 +  from seq_monosub[of "Im o s o f"] 
   7.423 +  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
   7.424 +  let ?h = "f o g"
   7.425 +  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
   7.426 +  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
   7.427 +  proof
   7.428 +    fix n
   7.429 +    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
   7.430 +  qed
   7.431 +  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
   7.432 +    apply (rule Bseq_monoseq_convergent)
   7.433 +    apply (simp add: Bseq_def)
   7.434 +    apply (rule exI[where x= "r + 1"])
   7.435 +    using th rp apply simp
   7.436 +    using f(2) .
   7.437 +  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
   7.438 +  proof
   7.439 +    fix n
   7.440 +    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
   7.441 +  qed
   7.442 +
   7.443 +  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
   7.444 +    apply (rule Bseq_monoseq_convergent)
   7.445 +    apply (simp add: Bseq_def)
   7.446 +    apply (rule exI[where x= "r + 1"])
   7.447 +    using th rp apply simp
   7.448 +    using g(2) .
   7.449 +
   7.450 +  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
   7.451 +    by blast 
   7.452 +  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
   7.453 +    unfolding LIMSEQ_def real_norm_def .
   7.454 +
   7.455 +  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
   7.456 +    by blast 
   7.457 +  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
   7.458 +    unfolding LIMSEQ_def real_norm_def .
   7.459 +  let ?w = "Complex x y"
   7.460 +  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
   7.461 +  {fix e assume ep: "e > (0::real)"
   7.462 +    hence e2: "e/2 > 0" by simp
   7.463 +    from x[rule_format, OF e2] y[rule_format, OF e2]
   7.464 +    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
   7.465 +    {fix n assume nN12: "n \<ge> N1 + N2"
   7.466 +      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
   7.467 +      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
   7.468 +      have "cmod (s (?h n) - ?w) < e" 
   7.469 +	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
   7.470 +    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
   7.471 +  with hs show ?thesis  by blast  
   7.472 +qed
   7.473 +
   7.474 +text{* Polynomial is continuous. *}
   7.475 +
   7.476 +lemma poly_cont:
   7.477 +  assumes ep: "e > 0" 
   7.478 +  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
   7.479 +proof-
   7.480 +  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
   7.481 +  {fix w
   7.482 +    note q(2)[of "w - z", simplified]}
   7.483 +  note th = this
   7.484 +  show ?thesis unfolding th[symmetric]
   7.485 +  proof(induct q)
   7.486 +    case Nil thus ?case  using ep by auto
   7.487 +  next
   7.488 +    case (Cons c cs)
   7.489 +    from poly_bound_exists[of 1 "cs"] 
   7.490 +    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
   7.491 +    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
   7.492 +    have one0: "1 > (0::real)"  by arith
   7.493 +    from real_lbound_gt_zero[OF one0 em0] 
   7.494 +    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
   7.495 +    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
   7.496 +      by (simp_all add: field_simps real_mult_order)
   7.497 +    show ?case 
   7.498 +      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
   7.499 +	fix d w
   7.500 +	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
   7.501 +	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
   7.502 +	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
   7.503 +	from H have th: "cmod (w-z) \<le> d" by simp 
   7.504 +	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
   7.505 +	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
   7.506 +      qed  
   7.507 +    qed
   7.508 +qed
   7.509 +
   7.510 +text{* Hence a polynomial attains minimum on a closed disc 
   7.511 +  in the complex plane. *}
   7.512 +lemma  poly_minimum_modulus_disc:
   7.513 +  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
   7.514 +proof-
   7.515 +  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
   7.516 +      apply -
   7.517 +      apply (rule exI[where x=0]) 
   7.518 +      apply auto
   7.519 +      apply (subgoal_tac "cmod w < 0")
   7.520 +      apply simp
   7.521 +      apply arith
   7.522 +      done }
   7.523 +  moreover
   7.524 +  {assume rp: "r \<ge> 0"
   7.525 +    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
   7.526 +    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
   7.527 +    {fix x z
   7.528 +      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
   7.529 +      hence "- x < 0 " by arith
   7.530 +      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
   7.531 +    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
   7.532 +    from real_sup_exists[OF mth1 mth2] obtain s where 
   7.533 +      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
   7.534 +    let ?m = "-s"
   7.535 +    {fix y
   7.536 +      from s[rule_format, of "-y"] have 
   7.537 +    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
   7.538 +	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
   7.539 +    note s1 = this[unfolded minus_minus]
   7.540 +    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
   7.541 +      by auto
   7.542 +    {fix n::nat
   7.543 +      from s1[rule_format, of "?m + 1/real (Suc n)"] 
   7.544 +      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
   7.545 +	by simp}
   7.546 +    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
   7.547 +    from choice[OF th] obtain g where 
   7.548 +      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
   7.549 +      by blast
   7.550 +    from bolzano_weierstrass_complex_disc[OF g(1)] 
   7.551 +    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
   7.552 +      by blast    
   7.553 +    {fix w 
   7.554 +      assume wr: "cmod w \<le> r"
   7.555 +      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
   7.556 +      {assume e: "?e > 0"
   7.557 +	hence e2: "?e/2 > 0" by simp
   7.558 +	from poly_cont[OF e2, of z p] obtain d where
   7.559 +	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
   7.560 +	{fix w assume w: "cmod (w - z) < d"
   7.561 +	  have "cmod(poly p w - poly p z) < ?e / 2"
   7.562 +	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
   7.563 +	note th1 = this
   7.564 +	
   7.565 +	from fz(2)[rule_format, OF d(1)] obtain N1 where 
   7.566 +	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
   7.567 +	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
   7.568 +	  N2: "2/?e < real N2" by blast
   7.569 +	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
   7.570 +	  using N1[rule_format, of "N1 + N2"] th1 by simp
   7.571 +	{fix a b e2 m :: real
   7.572 +	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
   7.573 +          ==> False" by arith}
   7.574 +      note th0 = this
   7.575 +      have ath: 
   7.576 +	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
   7.577 +      from s1m[OF g(1)[rule_format]]
   7.578 +      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
   7.579 +      from seq_suble[OF fz(1), of "N1+N2"]
   7.580 +      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
   7.581 +      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
   7.582 +	using N2 by auto
   7.583 +      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
   7.584 +      from g(2)[rule_format, of "f (N1 + N2)"]
   7.585 +      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
   7.586 +      from order_less_le_trans[OF th01 th00]
   7.587 +      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
   7.588 +      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
   7.589 +      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
   7.590 +      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
   7.591 +      with ath[OF th31 th32]
   7.592 +      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
   7.593 +      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
   7.594 +	by arith
   7.595 +      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
   7.596 +\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
   7.597 +	by (simp add: norm_triangle_ineq3)
   7.598 +      from ath2[OF th22, of ?m]
   7.599 +      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
   7.600 +      from th0[OF th2 thc1 thc2] have False .}
   7.601 +      hence "?e = 0" by auto
   7.602 +      then have "cmod (poly p z) = ?m" by simp  
   7.603 +      with s1m[OF wr]
   7.604 +      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
   7.605 +    hence ?thesis by blast}
   7.606 +  ultimately show ?thesis by blast
   7.607 +qed
   7.608 +
   7.609 +lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
   7.610 +  unfolding power2_eq_square
   7.611 +  apply (simp add: rcis_mult)
   7.612 +  apply (simp add: power2_eq_square[symmetric])
   7.613 +  done
   7.614 +
   7.615 +lemma cispi: "cis pi = -1" 
   7.616 +  unfolding cis_def
   7.617 +  by simp
   7.618 +
   7.619 +lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
   7.620 +  unfolding power2_eq_square
   7.621 +  apply (simp add: rcis_mult add_divide_distrib)
   7.622 +  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
   7.623 +  done
   7.624 +
   7.625 +text {* Nonzero polynomial in z goes to infinity as z does. *}
   7.626 +
   7.627 +instance complex::idom_char_0 by (intro_classes)
   7.628 +instance complex :: recpower_idom_char_0 by intro_classes
   7.629 +
   7.630 +lemma poly_infinity:
   7.631 +  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
   7.632 +  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
   7.633 +using ex
   7.634 +proof(induct p arbitrary: a d)
   7.635 +  case (Cons c cs a d) 
   7.636 +  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
   7.637 +    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
   7.638 +    let ?r = "1 + \<bar>r\<bar>"
   7.639 +    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
   7.640 +      have r0: "r \<le> cmod z" using h by arith
   7.641 +      from r[rule_format, OF r0]
   7.642 +      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
   7.643 +      from h have z1: "cmod z \<ge> 1" by arith
   7.644 +      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
   7.645 +      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
   7.646 +	unfolding norm_mult by (simp add: ring_simps)
   7.647 +      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
   7.648 +      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
   7.649 +	by (simp add: diff_le_eq ring_simps) 
   7.650 +      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
   7.651 +    hence ?case by blast}
   7.652 +  moreover
   7.653 +  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
   7.654 +    with Cons.prems have c0: "c \<noteq> 0" by simp
   7.655 +    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
   7.656 +      by (auto simp add: list_all_iff list_ex_iff)
   7.657 +    {fix z
   7.658 +      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
   7.659 +      from c0 have "cmod c > 0" by simp
   7.660 +      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
   7.661 +	by (simp add: field_simps norm_mult)
   7.662 +      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
   7.663 +      from complex_mod_triangle_sub[of "z*c" a ]
   7.664 +      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
   7.665 +	by (simp add: ring_simps)
   7.666 +      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
   7.667 +	using poly_0[OF cs0'] by simp}
   7.668 +    then have ?case  by blast}
   7.669 +  ultimately show ?case by blast
   7.670 +qed simp
   7.671 +
   7.672 +text {* Hence polynomial's modulus attains its minimum somewhere. *}
   7.673 +lemma poly_minimum_modulus:
   7.674 +  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
   7.675 +proof(induct p)
   7.676 +  case (Cons c cs) 
   7.677 +  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
   7.678 +    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
   7.679 +    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
   7.680 +    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
   7.681 +    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
   7.682 +    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
   7.683 +    {fix z assume z: "r \<le> cmod z"
   7.684 +      from v[of 0] r[OF z] 
   7.685 +      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
   7.686 +	by simp }
   7.687 +    note v0 = this
   7.688 +    from v0 v ath[of r] have ?case by blast}
   7.689 +  moreover
   7.690 +  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
   7.691 +    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
   7.692 +    from poly_0[OF th] Cons.hyps have ?case by simp}
   7.693 +  ultimately show ?case by blast
   7.694 +qed simp
   7.695 +
   7.696 +text{* Constant function (non-syntactic characterization). *}
   7.697 +definition "constant f = (\<forall>x y. f x = f y)"
   7.698 +
   7.699 +lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
   7.700 +  unfolding constant_def
   7.701 +  apply (induct p, auto)
   7.702 +  apply (unfold not_less[symmetric])
   7.703 +  apply simp
   7.704 +  apply (rule ccontr)
   7.705 +  apply auto
   7.706 +  done
   7.707 + 
   7.708 +lemma poly_replicate_append:
   7.709 +  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
   7.710 +  by(induct n, auto simp add: power_Suc ring_simps)
   7.711 +
   7.712 +text {* Decomposition of polynomial, skipping zero coefficients 
   7.713 +  after the first.  *}
   7.714 +
   7.715 +lemma poly_decompose_lemma:
   7.716 + assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
   7.717 +  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
   7.718 +                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
   7.719 +using nz
   7.720 +proof(induct p)
   7.721 +  case Nil thus ?case by simp
   7.722 +next
   7.723 +  case (Cons c cs)
   7.724 +  {assume c0: "c = 0"
   7.725 +    
   7.726 +    from Cons.hyps Cons.prems c0 have ?case apply auto
   7.727 +      apply (rule_tac x="k+1" in exI)
   7.728 +      apply (rule_tac x="a" in exI, clarsimp)
   7.729 +      apply (rule_tac x="q" in exI)
   7.730 +      by (auto simp add: power_Suc)}
   7.731 +  moreover
   7.732 +  {assume c0: "c\<noteq>0"
   7.733 +    hence ?case apply-
   7.734 +      apply (rule exI[where x=0])
   7.735 +      apply (rule exI[where x=c], clarsimp)
   7.736 +      apply (rule exI[where x=cs])
   7.737 +      apply auto
   7.738 +      done}
   7.739 +  ultimately show ?case by blast
   7.740 +qed
   7.741 +
   7.742 +lemma poly_decompose:
   7.743 +  assumes nc: "~constant(poly p)"
   7.744 +  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
   7.745 +               length q + k + 1 = length p \<and> 
   7.746 +              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
   7.747 +using nc 
   7.748 +proof(induct p)
   7.749 +  case Nil thus ?case by (simp add: constant_def)
   7.750 +next
   7.751 +  case (Cons c cs)
   7.752 +  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
   7.753 +    {fix x y
   7.754 +      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
   7.755 +    with Cons.prems have False by (auto simp add: constant_def)}
   7.756 +  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
   7.757 +  from poly_decompose_lemma[OF th] 
   7.758 +  show ?case 
   7.759 +    apply clarsimp    
   7.760 +    apply (rule_tac x="k+1" in exI)
   7.761 +    apply (rule_tac x="a" in exI)
   7.762 +    apply simp
   7.763 +    apply (rule_tac x="q" in exI)
   7.764 +    apply (auto simp add: power_Suc)
   7.765 +    done
   7.766 +qed
   7.767 +
   7.768 +text{* Fundamental theorem of algebral *}
   7.769 +
   7.770 +lemma fundamental_theorem_of_algebra:
   7.771 +  assumes nc: "~constant(poly p)"
   7.772 +  shows "\<exists>z::complex. poly p z = 0"
   7.773 +using nc
   7.774 +proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
   7.775 +  fix n fix p :: "complex list"
   7.776 +  let ?p = "poly p"
   7.777 +  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
   7.778 +  let ?ths = "\<exists>z. ?p z = 0"
   7.779 +
   7.780 +  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
   7.781 +  from poly_minimum_modulus obtain c where 
   7.782 +    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
   7.783 +  {assume pc: "?p c = 0" hence ?ths by blast}
   7.784 +  moreover
   7.785 +  {assume pc0: "?p c \<noteq> 0"
   7.786 +    from poly_offset[of p c] obtain q where
   7.787 +      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
   7.788 +    {assume h: "constant (poly q)"
   7.789 +      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
   7.790 +      {fix x y
   7.791 +	from th have "?p x = poly q (x - c)" by auto 
   7.792 +	also have "\<dots> = poly q (y - c)" 
   7.793 +	  using h unfolding constant_def by blast
   7.794 +	also have "\<dots> = ?p y" using th by auto
   7.795 +	finally have "?p x = ?p y" .}
   7.796 +      with nc have False unfolding constant_def by blast }
   7.797 +    hence qnc: "\<not> constant (poly q)" by blast
   7.798 +    from q(2) have pqc0: "?p c = poly q 0" by simp
   7.799 +    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
   7.800 +    let ?a0 = "poly q 0"
   7.801 +    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
   7.802 +    from a00 
   7.803 +    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
   7.804 +      by (simp add: poly_cmult_map)
   7.805 +    let ?r = "map (op * (inverse ?a0)) q"
   7.806 +    have lgqr: "length q = length ?r" by simp 
   7.807 +    {assume h: "\<And>x y. poly ?r x = poly ?r y"
   7.808 +      {fix x y
   7.809 +	from qr[rule_format, of x] 
   7.810 +	have "poly q x = poly ?r x * ?a0" by auto
   7.811 +	also have "\<dots> = poly ?r y * ?a0" using h by simp
   7.812 +	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
   7.813 +	finally have "poly q x = poly q y" .} 
   7.814 +      with qnc have False unfolding constant_def by blast}
   7.815 +    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
   7.816 +    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
   7.817 +    {fix w 
   7.818 +      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
   7.819 +	using qr[rule_format, of w] a00 by simp
   7.820 +      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
   7.821 +	using a00 unfolding norm_divide by (simp add: field_simps)
   7.822 +      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
   7.823 +    note mrmq_eq = this
   7.824 +    from poly_decompose[OF rnc] obtain k a s where 
   7.825 +      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
   7.826 +      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
   7.827 +    {assume "k + 1 = n"
   7.828 +      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
   7.829 +      {fix w
   7.830 +	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
   7.831 +	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
   7.832 +      note hth = this [symmetric]
   7.833 +	from reduce_poly_simple[OF kas(1,2)] 
   7.834 +      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
   7.835 +    moreover
   7.836 +    {assume kn: "k+1 \<noteq> n"
   7.837 +      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
   7.838 +      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
   7.839 +	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
   7.840 +	using kas(1) apply simp 
   7.841 +	by (rule exI[where x=0], rule exI[where x=1], simp)
   7.842 +      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
   7.843 +	by simp
   7.844 +      from H[rule_format, OF k1n th01 th02]
   7.845 +      obtain w where w: "1 + w^k * a = 0"
   7.846 +	unfolding poly_Nil poly_Cons poly_replicate_append
   7.847 +	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
   7.848 +	  mult_assoc[of _ _ a, symmetric])
   7.849 +      from poly_bound_exists[of "cmod w" s] obtain m where 
   7.850 +	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
   7.851 +      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
   7.852 +      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
   7.853 +      then have wm1: "w^k * a = - 1" by simp
   7.854 +      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
   7.855 +	using norm_ge_zero[of w] w0 m(1)
   7.856 +	  by (simp add: inverse_eq_divide zero_less_mult_iff)
   7.857 +      with real_down2[OF zero_less_one] obtain t where
   7.858 +	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
   7.859 +      let ?ct = "complex_of_real t"
   7.860 +      let ?w = "?ct * w"
   7.861 +      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: ring_simps power_mult_distrib)
   7.862 +      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
   7.863 +	unfolding wm1 by (simp)
   7.864 +      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
   7.865 +	apply -
   7.866 +	apply (rule cong[OF refl[of cmod]])
   7.867 +	apply assumption
   7.868 +	done
   7.869 +      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
   7.870 +      have th11: "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 
   7.871 +      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
   7.872 +      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
   7.873 +      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
   7.874 +      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
   7.875 +	by (simp add: inverse_eq_divide field_simps)
   7.876 +      with zero_less_power[OF t(1), of k] 
   7.877 +      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
   7.878 +	apply - apply (rule mult_strict_left_mono) by simp_all
   7.879 +      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
   7.880 +	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
   7.881 +      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
   7.882 +	using t(1,2) m(2)[rule_format, OF tw] w0
   7.883 +	apply (simp only: )
   7.884 +	apply auto
   7.885 +	apply (rule mult_mono, simp_all add: norm_ge_zero)+
   7.886 +	apply (simp add: zero_le_mult_iff zero_le_power)
   7.887 +	done
   7.888 +      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
   7.889 +      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
   7.890 +	by auto
   7.891 +      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
   7.892 +      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
   7.893 +      from th11 th12
   7.894 +      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
   7.895 +      then have "cmod (poly ?r ?w) < 1" 
   7.896 +	unfolding kas(4)[rule_format, of ?w] r01 by simp 
   7.897 +      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
   7.898 +    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
   7.899 +    from cr0_contr cq0 q(2)
   7.900 +    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
   7.901 +  ultimately show ?ths by blast
   7.902 +qed
   7.903 +
   7.904 +text {* Alternative version with a syntactic notion of constant polynomial. *}
   7.905 +
   7.906 +lemma fundamental_theorem_of_algebra_alt:
   7.907 +  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
   7.908 +  shows "\<exists>z. poly p z = (0::complex)"
   7.909 +using nc
   7.910 +proof(induct p)
   7.911 +  case (Cons c cs)
   7.912 +  {assume "c=0" hence ?case by auto}
   7.913 +  moreover
   7.914 +  {assume c0: "c\<noteq>0"
   7.915 +    {assume nc: "constant (poly (c#cs))"
   7.916 +      from nc[unfolded constant_def, rule_format, of 0] 
   7.917 +      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
   7.918 +      hence "list_all (\<lambda>c. c=0) cs"
   7.919 +	proof(induct cs)
   7.920 +	  case (Cons d ds)
   7.921 +	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
   7.922 +	  moreover
   7.923 +	  {assume d0: "d\<noteq>0"
   7.924 +	    from poly_bound_exists[of 1 ds] obtain m where 
   7.925 +	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
   7.926 +	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
   7.927 +	    from real_down2[OF dm zero_less_one] obtain x where 
   7.928 +	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
   7.929 +	    let ?x = "complex_of_real x"
   7.930 +	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
   7.931 +	    from Cons.prems[rule_format, OF cx(1)]
   7.932 +	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
   7.933 +	    from m(2)[rule_format, OF cx(2)] x(1)
   7.934 +	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
   7.935 +	      by (simp add: norm_mult)
   7.936 +	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
   7.937 +	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
   7.938 +	    with cth  have ?case by blast}
   7.939 +	  ultimately show ?case by blast 
   7.940 +	qed simp}
   7.941 +      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
   7.942 +	by blast
   7.943 +      from fundamental_theorem_of_algebra[OF nc] have ?case .}
   7.944 +  ultimately show ?case by blast  
   7.945 +qed simp
   7.946 +
   7.947 +subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
   7.948 +
   7.949 +lemma nullstellensatz_lemma:
   7.950 +  fixes p :: "complex list"
   7.951 +  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
   7.952 +  and "degree p = n" and "n \<noteq> 0"
   7.953 +  shows "p divides (pexp q n)"
   7.954 +using prems
   7.955 +proof(induct n arbitrary: p q rule: nat_less_induct)
   7.956 +  fix n::nat fix p q :: "complex list"
   7.957 +  assume IH: "\<forall>m<n. \<forall>p q.
   7.958 +                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
   7.959 +                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
   7.960 +    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
   7.961 +    and dpn: "degree p = n" and n0: "n \<noteq> 0"
   7.962 +  let ?ths = "p divides (q %^ n)"
   7.963 +  {fix a assume a: "poly p a = 0"
   7.964 +    {assume p0: "poly p = poly []" 
   7.965 +      hence ?ths unfolding divides_def  using pq0 n0
   7.966 +	apply - apply (rule exI[where x="[]"], rule ext)
   7.967 +	by (auto simp add: poly_mult poly_exp)}
   7.968 +    moreover
   7.969 +    {assume p0: "poly p \<noteq> poly []" 
   7.970 +      and oa: "order  a p \<noteq> 0"
   7.971 +      from p0 have pne: "p \<noteq> []" by auto
   7.972 +      let ?op = "order a p"
   7.973 +      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
   7.974 +	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
   7.975 +      note oop = order_degree[OF p0, unfolded dpn]
   7.976 +      {assume q0: "q = []"
   7.977 +	hence ?ths using n0 unfolding divides_def 
   7.978 +	  apply simp
   7.979 +	  apply (rule exI[where x="[]"], rule ext)
   7.980 +	  by (simp add: divides_def poly_exp poly_mult)}
   7.981 +      moreover
   7.982 +      {assume q0: "q\<noteq>[]"
   7.983 +	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
   7.984 +	obtain r where r: "q = pmult [- a, 1] r" by blast
   7.985 +	from ap[unfolded divides_def] obtain s where
   7.986 +	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
   7.987 +	have s0: "poly s \<noteq> poly []"
   7.988 +	  using s p0 by (simp add: poly_entire)
   7.989 +	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
   7.990 +	{assume ds0: "degree s = 0"
   7.991 +	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
   7.992 +	    by (cases "pnormalize s", auto)
   7.993 +	  then obtain k where kpn: "pnormalize s = [k]" by blast
   7.994 +	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
   7.995 +	    using poly_normalize[of s] by simp_all
   7.996 +	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
   7.997 +	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
   7.998 +	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
   7.999 +	  hence ?ths unfolding divides_def by blast}
  7.1000 +	moreover
  7.1001 +	{assume ds0: "degree s \<noteq> 0"
  7.1002 +	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
  7.1003 +	    have dsn: "degree s < n" by auto 
  7.1004 +	    {fix x assume h: "poly s x = 0"
  7.1005 +	      {assume xa: "x = a"
  7.1006 +		from h[unfolded xa poly_linear_divides] sne obtain u where
  7.1007 +		  u: "s = pmult [- a, 1] u" by blast
  7.1008 +		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
  7.1009 +		  unfolding s u
  7.1010 +		  apply (rule ext)
  7.1011 +		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
  7.1012 +		with ap(2)[unfolded divides_def] have False by blast}
  7.1013 +	      note xa = this
  7.1014 +	      from h s have "poly p x = 0" by (simp add: poly_mult)
  7.1015 +	      with pq0 have "poly q x = 0" by blast
  7.1016 +	      with r xa have "poly r x = 0"
  7.1017 +		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
  7.1018 +	    note impth = this
  7.1019 +	    from IH[rule_format, OF dsn, of s r] impth ds0
  7.1020 +	    have "s divides (pexp r (degree s))" by blast
  7.1021 +	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
  7.1022 +	      unfolding divides_def by blast
  7.1023 +	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
  7.1024 +	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
  7.1025 +	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
  7.1026 +	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
  7.1027 +	      apply - apply (rule ext)
  7.1028 +	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
  7.1029 +	      
  7.1030 +	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
  7.1031 +	      done
  7.1032 +	    hence ?ths unfolding divides_def by blast}
  7.1033 +      ultimately have ?ths by blast }
  7.1034 +      ultimately have ?ths by blast}
  7.1035 +    ultimately have ?ths using a order_root by blast}
  7.1036 +  moreover
  7.1037 +  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
  7.1038 +    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
  7.1039 +      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
  7.1040 +    
  7.1041 +    from poly_0[OF ccs(2)] ccs(3) 
  7.1042 +    have pp: "\<And>x. poly p x =  c" by simp
  7.1043 +    let ?w = "pmult [1/c] (pexp q n)"
  7.1044 +    from pp ccs(1) 
  7.1045 +    have "poly (pexp q n) = poly (pmult p ?w) "
  7.1046 +      apply - apply (rule ext)
  7.1047 +      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
  7.1048 +    hence ?ths unfolding divides_def by blast}
  7.1049 +  ultimately show ?ths by blast
  7.1050 +qed
  7.1051 +
  7.1052 +lemma nullstellensatz_univariate:
  7.1053 +  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
  7.1054 +    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
  7.1055 +proof-
  7.1056 +  {assume pe: "poly p = poly []"
  7.1057 +    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
  7.1058 +      apply auto
  7.1059 +      by (rule ext, simp)
  7.1060 +    {assume "p divides (pexp q (degree p))"
  7.1061 +      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
  7.1062 +	unfolding divides_def by blast
  7.1063 +      from cong[OF r refl] pe degree_unique[OF pe]
  7.1064 +      have False by (simp add: poly_mult degree_def)}
  7.1065 +    with eq pe have ?thesis by blast}
  7.1066 +  moreover
  7.1067 +  {assume pe: "poly p \<noteq> poly []"
  7.1068 +    have p0: "poly [0] = poly []" by (rule ext, simp)
  7.1069 +    {assume dp: "degree p = 0"
  7.1070 +      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
  7.1071 +	unfolding degree_def by (cases "pnormalize p", auto)
  7.1072 +      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
  7.1073 +	using pe poly_normalize[of p] by (auto simp add: p0)
  7.1074 +      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
  7.1075 +      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
  7.1076 +	by - (rule ext, simp add: poly_mult poly_exp)
  7.1077 +      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
  7.1078 +      from th1 th2 pe have ?thesis by blast}
  7.1079 +    moreover
  7.1080 +    {assume dp: "degree p \<noteq> 0"
  7.1081 +      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
  7.1082 +      {assume "p divides (pexp q (Suc n))"
  7.1083 +	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
  7.1084 +	  unfolding divides_def by blast
  7.1085 +	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
  7.1086 +	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
  7.1087 +	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
  7.1088 +	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
  7.1089 +	with n nullstellensatz_lemma[of p q "degree p"] dp 
  7.1090 +	have ?thesis by auto}
  7.1091 +    ultimately have ?thesis by blast}
  7.1092 +  ultimately show ?thesis by blast
  7.1093 +qed
  7.1094 +
  7.1095 +text{* Useful lemma *}
  7.1096 +
  7.1097 +lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
  7.1098 +proof
  7.1099 +  assume l: ?lhs
  7.1100 +  from l[unfolded constant_def, rule_format, of _ "zero"]
  7.1101 +  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
  7.1102 +  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
  7.1103 +next
  7.1104 +  assume r: ?rhs
  7.1105 +  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
  7.1106 +    unfolding degree_def by (cases "pnormalize p", auto)
  7.1107 +  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
  7.1108 +    by (auto simp del: poly_normalize)
  7.1109 +qed
  7.1110 +
  7.1111 +(* It would be nicer to prove this without using algebraic closure...        *)
  7.1112 +
  7.1113 +lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
  7.1114 +  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
  7.1115 +  using dpn
  7.1116 +proof(induct n arbitrary: p q)
  7.1117 +  case 0 thus ?case by simp
  7.1118 +next
  7.1119 +  case (Suc n p q)
  7.1120 +  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
  7.1121 +  obtain a where a: "poly p a = 0" by auto
  7.1122 +  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
  7.1123 +    using Suc.prems by (auto simp add: degree_def)
  7.1124 +  {assume h: "poly (pmult r q) = poly []"
  7.1125 +    hence "poly (pmult p q) = poly []" using r
  7.1126 +      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
  7.1127 +  moreover
  7.1128 +  {assume h: "poly (pmult r q) \<noteq> poly []" 
  7.1129 +    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
  7.1130 +      by (auto simp add: poly_entire)
  7.1131 +    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
  7.1132 +      apply - apply (rule ext)
  7.1133 +      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
  7.1134 +    from linear_mul_degree[OF h, of "- a"]
  7.1135 +    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
  7.1136 +      unfolding degree_unique[OF eq] .
  7.1137 +    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
  7.1138 +    have dr: "degree r = n" by auto
  7.1139 +    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
  7.1140 +      unfolding dqe using h by (auto simp del: poly.simps) 
  7.1141 +    hence ?case by blast}
  7.1142 +  ultimately show ?case by blast
  7.1143 +qed
  7.1144 +
  7.1145 +lemma divides_degree: assumes pq: "p divides (q:: complex list)"
  7.1146 +  shows "degree p \<le> degree q \<or> poly q = poly []"
  7.1147 +using pq  divides_degree_lemma[OF refl, of p]
  7.1148 +apply (auto simp add: divides_def poly_entire)
  7.1149 +apply atomize
  7.1150 +apply (erule_tac x="qa" in allE, auto)
  7.1151 +apply (subgoal_tac "degree q = degree (p *** qa)", simp)
  7.1152 +apply (rule degree_unique, simp)
  7.1153 +done
  7.1154 +
  7.1155 +(* Arithmetic operations on multivariate polynomials.                        *)
  7.1156 +
  7.1157 +lemma mpoly_base_conv: 
  7.1158 +  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
  7.1159 +
  7.1160 +lemma mpoly_norm_conv: 
  7.1161 +  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
  7.1162 +
  7.1163 +lemma mpoly_sub_conv: 
  7.1164 +  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
  7.1165 +  by (simp add: diff_def)
  7.1166 +
  7.1167 +lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
  7.1168 +
  7.1169 +lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
  7.1170 +
  7.1171 +lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
  7.1172 +lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
  7.1173 +  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
  7.1174 +lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
  7.1175 +
  7.1176 +lemma poly_divides_pad_rule: 
  7.1177 +  fixes p q :: "complex list"
  7.1178 +  assumes pq: "p divides q"
  7.1179 +  shows "p divides ((0::complex)#q)"
  7.1180 +proof-
  7.1181 +  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
  7.1182 +  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
  7.1183 +    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
  7.1184 +  thus ?thesis unfolding divides_def by blast
  7.1185 +qed
  7.1186 +
  7.1187 +lemma poly_divides_pad_const_rule: 
  7.1188 +  fixes p q :: "complex list"
  7.1189 +  assumes pq: "p divides q"
  7.1190 +  shows "p divides (a %* q)"
  7.1191 +proof-
  7.1192 +  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
  7.1193 +  hence "poly (a %* q) = poly (p *** (a %* r))" 
  7.1194 +    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
  7.1195 +  thus ?thesis unfolding divides_def by blast
  7.1196 +qed
  7.1197 +
  7.1198 +
  7.1199 +lemma poly_divides_conv0:  
  7.1200 +  fixes p :: "complex list"
  7.1201 +  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
  7.1202 +  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
  7.1203 +proof-
  7.1204 +  {assume r: ?rhs 
  7.1205 +    hence eq: "poly q = poly []" unfolding poly_zero 
  7.1206 +      by (simp add: list_all_iff list_ex_iff)
  7.1207 +    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
  7.1208 +    hence ?lhs unfolding divides_def  by blast}
  7.1209 +  moreover
  7.1210 +  {assume l: ?lhs
  7.1211 +    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
  7.1212 +      by arith
  7.1213 +    {assume q0: "length q = 0"
  7.1214 +      hence "q = []" by simp
  7.1215 +      hence ?rhs by simp}
  7.1216 +    moreover
  7.1217 +    {assume lgq0: "length q \<noteq> 0"
  7.1218 +      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
  7.1219 +	unfolding degree_def by simp
  7.1220 +      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
  7.1221 +      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
  7.1222 +    ultimately have ?rhs by blast }
  7.1223 +  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
  7.1224 +qed
  7.1225 +
  7.1226 +lemma poly_divides_conv1: 
  7.1227 +  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
  7.1228 +  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
  7.1229 +  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
  7.1230 +proof-
  7.1231 +  {
  7.1232 +  from pp' obtain t where t: "poly p' = poly (p *** t)" 
  7.1233 +    unfolding divides_def by blast
  7.1234 +  {assume l: ?lhs
  7.1235 +    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
  7.1236 +     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
  7.1237 +       using u qrp' t
  7.1238 +       by - (rule ext, 
  7.1239 +	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
  7.1240 +     then have ?rhs unfolding divides_def by blast}
  7.1241 +  moreover
  7.1242 +  {assume r: ?rhs
  7.1243 +    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
  7.1244 +    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
  7.1245 +      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
  7.1246 +    hence ?lhs  unfolding divides_def by blast}
  7.1247 +  ultimately have "?lhs = ?rhs" by blast }
  7.1248 +thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
  7.1249 +qed
  7.1250 +
  7.1251 +lemma basic_cqe_conv1:
  7.1252 +  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
  7.1253 +  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
  7.1254 +  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
  7.1255 +  "(\<exists>x. poly [] x = 0) \<equiv> True"
  7.1256 +  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
  7.1257 +
  7.1258 +lemma basic_cqe_conv2: 
  7.1259 +  assumes l:"last (a#b#p) \<noteq> 0" 
  7.1260 +  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
  7.1261 +proof-
  7.1262 +  {fix h t
  7.1263 +    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
  7.1264 +    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
  7.1265 +    moreover have "last (b#p) \<in> set (b#p)" by simp
  7.1266 +    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
  7.1267 +    with l have False by simp}
  7.1268 +  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
  7.1269 +    by blast
  7.1270 +  from fundamental_theorem_of_algebra_alt[OF th] 
  7.1271 +  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
  7.1272 +qed
  7.1273 +
  7.1274 +lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
  7.1275 +proof-
  7.1276 +  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
  7.1277 +    by (simp add: poly_zero list_all_iff list_ex_iff)
  7.1278 +  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
  7.1279 +  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
  7.1280 +    by - (atomize (full), blast)
  7.1281 +qed
  7.1282 +
  7.1283 +lemma basic_cqe_conv3:
  7.1284 +  fixes p q :: "complex list"
  7.1285 +  assumes l: "last (a#p) \<noteq> 0" 
  7.1286 +  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
  7.1287 +proof-
  7.1288 +  note np = pnormalize_eq[OF l]
  7.1289 +  {assume "poly (a#p) = poly []" hence False using l
  7.1290 +      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
  7.1291 +      apply (cases p, simp_all) done}
  7.1292 +  then have p0: "poly (a#p) \<noteq> poly []"  by blast
  7.1293 +  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
  7.1294 +  from nullstellensatz_univariate[of "a#p" q] p0 dp
  7.1295 +  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
  7.1296 +    by - (atomize (full), auto)
  7.1297 +qed
  7.1298 +
  7.1299 +lemma basic_cqe_conv4:
  7.1300 +  fixes p q :: "complex list"
  7.1301 +  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
  7.1302 +  shows "p divides (q %^ n) \<equiv> p divides r"
  7.1303 +proof-
  7.1304 +  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
  7.1305 +  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
  7.1306 +qed
  7.1307 +
  7.1308 +lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
  7.1309 +  by simp
  7.1310 +
  7.1311 +lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
  7.1312 +lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
  7.1313 +lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
  7.1314 +lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
  7.1315 +lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
  7.1316 +
  7.1317 +lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
  7.1318 +lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
  7.1319 +  by (atomize (full)) simp_all
  7.1320 +lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
  7.1321 +lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
  7.1322 +proof
  7.1323 +  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
  7.1324 +next
  7.1325 +  assume "p \<and> q \<equiv> p \<and> r" "p"
  7.1326 +  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
  7.1327 +qed
  7.1328 +lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
  7.1329 +
  7.1330 +end
  7.1331 \ No newline at end of file
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/HahnBanach/Bounds.thy	Mon Dec 29 14:08:08 2008 +0100
     8.3 @@ -0,0 +1,83 @@
     8.4 +(*  Title:      HOL/Real/HahnBanach/Bounds.thy
     8.5 +    ID:         $Id$
     8.6 +    Author:     Gertrud Bauer, TU Munich
     8.7 +*)
     8.8 +
     8.9 +header {* Bounds *}
    8.10 +
    8.11 +theory Bounds
    8.12 +imports Main ContNotDenum
    8.13 +begin
    8.14 +
    8.15 +locale lub =
    8.16 +  fixes A and x
    8.17 +  assumes least [intro?]: "(\<And>a. a \<in> A \<Longrightarrow> a \<le> b) \<Longrightarrow> x \<le> b"
    8.18 +    and upper [intro?]: "a \<in> A \<Longrightarrow> a \<le> x"
    8.19 +
    8.20 +lemmas [elim?] = lub.least lub.upper
    8.21 +
    8.22 +definition
    8.23 +  the_lub :: "'a::order set \<Rightarrow> 'a" where
    8.24 +  "the_lub A = The (lub A)"
    8.25 +
    8.26 +notation (xsymbols)
    8.27 +  the_lub  ("\<Squnion>_" [90] 90)
    8.28 +
    8.29 +lemma the_lub_equality [elim?]:
    8.30 +  assumes "lub A x"
    8.31 +  shows "\<Squnion>A = (x::'a::order)"
    8.32 +proof -
    8.33 +  interpret lub [A x] by fact
    8.34 +  show ?thesis
    8.35 +  proof (unfold the_lub_def)
    8.36 +    from `lub A x` show "The (lub A) = x"
    8.37 +    proof
    8.38 +      fix x' assume lub': "lub A x'"
    8.39 +      show "x' = x"
    8.40 +      proof (rule order_antisym)
    8.41 +	from lub' show "x' \<le> x"
    8.42 +	proof
    8.43 +          fix a assume "a \<in> A"
    8.44 +          then show "a \<le> x" ..
    8.45 +	qed
    8.46 +	show "x \<le> x'"
    8.47 +	proof
    8.48 +          fix a assume "a \<in> A"
    8.49 +          with lub' show "a \<le> x'" ..
    8.50 +	qed
    8.51 +      qed
    8.52 +    qed
    8.53 +  qed
    8.54 +qed
    8.55 +
    8.56 +lemma the_lubI_ex:
    8.57 +  assumes ex: "\<exists>x. lub A x"
    8.58 +  shows "lub A (\<Squnion>A)"
    8.59 +proof -
    8.60 +  from ex obtain x where x: "lub A x" ..
    8.61 +  also from x have [symmetric]: "\<Squnion>A = x" ..
    8.62 +  finally show ?thesis .
    8.63 +qed
    8.64 +
    8.65 +lemma lub_compat: "lub A x = isLub UNIV A x"
    8.66 +proof -
    8.67 +  have "isUb UNIV A = (\<lambda>x. A *<= x \<and> x \<in> UNIV)"
    8.68 +    by (rule ext) (simp only: isUb_def)
    8.69 +  then show ?thesis
    8.70 +    by (simp only: lub_def isLub_def leastP_def setge_def setle_def) blast
    8.71 +qed
    8.72 +
    8.73 +lemma real_complete:
    8.74 +  fixes A :: "real set"
    8.75 +  assumes nonempty: "\<exists>a. a \<in> A"
    8.76 +    and ex_upper: "\<exists>y. \<forall>a \<in> A. a \<le> y"
    8.77 +  shows "\<exists>x. lub A x"
    8.78 +proof -
    8.79 +  from ex_upper have "\<exists>y. isUb UNIV A y"
    8.80 +    unfolding isUb_def setle_def by blast
    8.81 +  with nonempty have "\<exists>x. isLub UNIV A x"
    8.82 +    by (rule reals_complete)
    8.83 +  then show ?thesis by (simp only: lub_compat)
    8.84 +qed
    8.85 +
    8.86 +end
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/HahnBanach/FunctionNorm.thy	Mon Dec 29 14:08:08 2008 +0100
     9.3 @@ -0,0 +1,279 @@
     9.4 +(*  Title:      HOL/Real/HahnBanach/FunctionNorm.thy
     9.5 +    ID:         $Id$
     9.6 +    Author:     Gertrud Bauer, TU Munich
     9.7 +*)
     9.8 +
     9.9 +header {* The norm of a function *}
    9.10 +
    9.11 +theory FunctionNorm
    9.12 +imports NormedSpace FunctionOrder
    9.13 +begin
    9.14 +
    9.15 +subsection {* Continuous linear forms*}
    9.16 +
    9.17 +text {*
    9.18 +  A linear form @{text f} on a normed vector space @{text "(V, \<parallel>\<cdot>\<parallel>)"}
    9.19 +  is \emph{continuous}, iff it is bounded, i.e.
    9.20 +  \begin{center}
    9.21 +  @{text "\<exists>c \<in> R. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
    9.22 +  \end{center}
    9.23 +  In our application no other functions than linear forms are
    9.24 +  considered, so we can define continuous linear forms as bounded
    9.25 +  linear forms:
    9.26 +*}
    9.27 +
    9.28 +locale continuous = var V + norm_syntax + linearform +
    9.29 +  assumes bounded: "\<exists>c. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
    9.30 +
    9.31 +declare continuous.intro [intro?] continuous_axioms.intro [intro?]
    9.32 +
    9.33 +lemma continuousI [intro]:
    9.34 +  fixes norm :: "_ \<Rightarrow> real"  ("\<parallel>_\<parallel>")
    9.35 +  assumes "linearform V f"
    9.36 +  assumes r: "\<And>x. x \<in> V \<Longrightarrow> \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
    9.37 +  shows "continuous V norm f"
    9.38 +proof
    9.39 +  show "linearform V f" by fact
    9.40 +  from r have "\<exists>c. \<forall>x\<in>V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" by blast
    9.41 +  then show "continuous_axioms V norm f" ..
    9.42 +qed
    9.43 +
    9.44 +
    9.45 +subsection {* The norm of a linear form *}
    9.46 +
    9.47 +text {*
    9.48 +  The least real number @{text c} for which holds
    9.49 +  \begin{center}
    9.50 +  @{text "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
    9.51 +  \end{center}
    9.52 +  is called the \emph{norm} of @{text f}.
    9.53 +
    9.54 +  For non-trivial vector spaces @{text "V \<noteq> {0}"} the norm can be
    9.55 +  defined as
    9.56 +  \begin{center}
    9.57 +  @{text "\<parallel>f\<parallel> = \<sup>x \<noteq> 0. \<bar>f x\<bar> / \<parallel>x\<parallel>"}
    9.58 +  \end{center}
    9.59 +
    9.60 +  For the case @{text "V = {0}"} the supremum would be taken from an
    9.61 +  empty set. Since @{text \<real>} is unbounded, there would be no supremum.
    9.62 +  To avoid this situation it must be guaranteed that there is an
    9.63 +  element in this set. This element must be @{text "{} \<ge> 0"} so that
    9.64 +  @{text fn_norm} has the norm properties. Furthermore it does not
    9.65 +  have to change the norm in all other cases, so it must be @{text 0},
    9.66 +  as all other elements are @{text "{} \<ge> 0"}.
    9.67 +
    9.68 +  Thus we define the set @{text B} where the supremum is taken from as
    9.69 +  follows:
    9.70 +  \begin{center}
    9.71 +  @{text "{0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel>. x \<noteq> 0 \<and> x \<in> F}"}
    9.72 +  \end{center}
    9.73 +
    9.74 +  @{text fn_norm} is equal to the supremum of @{text B}, if the
    9.75 +  supremum exists (otherwise it is undefined).
    9.76 +*}
    9.77 +
    9.78 +locale fn_norm = norm_syntax +
    9.79 +  fixes B defines "B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
    9.80 +  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
    9.81 +  defines "\<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
    9.82 +
    9.83 +locale normed_vectorspace_with_fn_norm = normed_vectorspace + fn_norm
    9.84 +
    9.85 +lemma (in fn_norm) B_not_empty [intro]: "0 \<in> B V f"
    9.86 +  by (simp add: B_def)
    9.87 +
    9.88 +text {*
    9.89 +  The following lemma states that every continuous linear form on a
    9.90 +  normed space @{text "(V, \<parallel>\<cdot>\<parallel>)"} has a function norm.
    9.91 +*}
    9.92 +
    9.93 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_works:
    9.94 +  assumes "continuous V norm f"
    9.95 +  shows "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
    9.96 +proof -
    9.97 +  interpret continuous [V norm f] by fact
    9.98 +  txt {* The existence of the supremum is shown using the
    9.99 +    completeness of the reals. Completeness means, that every
   9.100 +    non-empty bounded set of reals has a supremum. *}
   9.101 +  have "\<exists>a. lub (B V f) a"
   9.102 +  proof (rule real_complete)
   9.103 +    txt {* First we have to show that @{text B} is non-empty: *}
   9.104 +    have "0 \<in> B V f" ..
   9.105 +    then show "\<exists>x. x \<in> B V f" ..
   9.106 +
   9.107 +    txt {* Then we have to show that @{text B} is bounded: *}
   9.108 +    show "\<exists>c. \<forall>y \<in> B V f. y \<le> c"
   9.109 +    proof -
   9.110 +      txt {* We know that @{text f} is bounded by some value @{text c}. *}
   9.111 +      from bounded obtain c where c: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
   9.112 +
   9.113 +      txt {* To prove the thesis, we have to show that there is some
   9.114 +        @{text b}, such that @{text "y \<le> b"} for all @{text "y \<in>
   9.115 +        B"}. Due to the definition of @{text B} there are two cases. *}
   9.116 +
   9.117 +      def b \<equiv> "max c 0"
   9.118 +      have "\<forall>y \<in> B V f. y \<le> b"
   9.119 +      proof
   9.120 +        fix y assume y: "y \<in> B V f"
   9.121 +        show "y \<le> b"
   9.122 +        proof cases
   9.123 +          assume "y = 0"
   9.124 +          then show ?thesis unfolding b_def by arith
   9.125 +        next
   9.126 +          txt {* The second case is @{text "y = \<bar>f x\<bar> / \<parallel>x\<parallel>"} for some
   9.127 +            @{text "x \<in> V"} with @{text "x \<noteq> 0"}. *}
   9.128 +          assume "y \<noteq> 0"
   9.129 +          with y obtain x where y_rep: "y = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
   9.130 +              and x: "x \<in> V" and neq: "x \<noteq> 0"
   9.131 +            by (auto simp add: B_def real_divide_def)
   9.132 +          from x neq have gt: "0 < \<parallel>x\<parallel>" ..
   9.133 +
   9.134 +          txt {* The thesis follows by a short calculation using the
   9.135 +            fact that @{text f} is bounded. *}
   9.136 +
   9.137 +          note y_rep
   9.138 +          also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
   9.139 +          proof (rule mult_right_mono)
   9.140 +            from c x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
   9.141 +            from gt have "0 < inverse \<parallel>x\<parallel>" 
   9.142 +              by (rule positive_imp_inverse_positive)
   9.143 +            then show "0 \<le> inverse \<parallel>x\<parallel>" by (rule order_less_imp_le)
   9.144 +          qed
   9.145 +          also have "\<dots> = c * (\<parallel>x\<parallel> * inverse \<parallel>x\<parallel>)"
   9.146 +            by (rule real_mult_assoc)
   9.147 +          also
   9.148 +          from gt have "\<parallel>x\<parallel> \<noteq> 0" by simp
   9.149 +          then have "\<parallel>x\<parallel> * inverse \<parallel>x\<parallel> = 1" by simp 
   9.150 +          also have "c * 1 \<le> b" by (simp add: b_def le_maxI1)
   9.151 +          finally show "y \<le> b" .
   9.152 +        qed
   9.153 +      qed
   9.154 +      then show ?thesis ..
   9.155 +    qed
   9.156 +  qed
   9.157 +  then show ?thesis unfolding fn_norm_def by (rule the_lubI_ex)
   9.158 +qed
   9.159 +
   9.160 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_ub [iff?]:
   9.161 +  assumes "continuous V norm f"
   9.162 +  assumes b: "b \<in> B V f"
   9.163 +  shows "b \<le> \<parallel>f\<parallel>\<hyphen>V"
   9.164 +proof -
   9.165 +  interpret continuous [V norm f] by fact
   9.166 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
   9.167 +    using `continuous V norm f` by (rule fn_norm_works)
   9.168 +  from this and b show ?thesis ..
   9.169 +qed
   9.170 +
   9.171 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_leastB:
   9.172 +  assumes "continuous V norm f"
   9.173 +  assumes b: "\<And>b. b \<in> B V f \<Longrightarrow> b \<le> y"
   9.174 +  shows "\<parallel>f\<parallel>\<hyphen>V \<le> y"
   9.175 +proof -
   9.176 +  interpret continuous [V norm f] by fact
   9.177 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
   9.178 +    using `continuous V norm f` by (rule fn_norm_works)
   9.179 +  from this and b show ?thesis ..
   9.180 +qed
   9.181 +
   9.182 +text {* The norm of a continuous function is always @{text "\<ge> 0"}. *}
   9.183 +
   9.184 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_ge_zero [iff]:
   9.185 +  assumes "continuous V norm f"
   9.186 +  shows "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
   9.187 +proof -
   9.188 +  interpret continuous [V norm f] by fact
   9.189 +  txt {* The function norm is defined as the supremum of @{text B}.
   9.190 +    So it is @{text "\<ge> 0"} if all elements in @{text B} are @{text "\<ge>
   9.191 +    0"}, provided the supremum exists and @{text B} is not empty. *}
   9.192 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
   9.193 +    using `continuous V norm f` by (rule fn_norm_works)
   9.194 +  moreover have "0 \<in> B V f" ..
   9.195 +  ultimately show ?thesis ..
   9.196 +qed
   9.197 +
   9.198 +text {*
   9.199 +  \medskip The fundamental property of function norms is:
   9.200 +  \begin{center}
   9.201 +  @{text "\<bar>f x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
   9.202 +  \end{center}
   9.203 +*}
   9.204 +
   9.205 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_le_cong:
   9.206 +  assumes "continuous V norm f" "linearform V f"
   9.207 +  assumes x: "x \<in> V"
   9.208 +  shows "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
   9.209 +proof -
   9.210 +  interpret continuous [V norm f] by fact
   9.211 +  interpret linearform [V f] .
   9.212 +  show ?thesis
   9.213 +  proof cases
   9.214 +    assume "x = 0"
   9.215 +    then have "\<bar>f x\<bar> = \<bar>f 0\<bar>" by simp
   9.216 +    also have "f 0 = 0" by rule unfold_locales
   9.217 +    also have "\<bar>\<dots>\<bar> = 0" by simp
   9.218 +    also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
   9.219 +      using `continuous V norm f` by (rule fn_norm_ge_zero)
   9.220 +    from x have "0 \<le> norm x" ..
   9.221 +    with a have "0 \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" by (simp add: zero_le_mult_iff)
   9.222 +    finally show "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" .
   9.223 +  next
   9.224 +    assume "x \<noteq> 0"
   9.225 +    with x have neq: "\<parallel>x\<parallel> \<noteq> 0" by simp
   9.226 +    then have "\<bar>f x\<bar> = (\<bar>f x\<bar> * inverse \<parallel>x\<parallel>) * \<parallel>x\<parallel>" by simp
   9.227 +    also have "\<dots> \<le>  \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
   9.228 +    proof (rule mult_right_mono)
   9.229 +      from x show "0 \<le> \<parallel>x\<parallel>" ..
   9.230 +      from x and neq have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<in> B V f"
   9.231 +	by (auto simp add: B_def real_divide_def)
   9.232 +      with `continuous V norm f` show "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>V"
   9.233 +	by (rule fn_norm_ub)
   9.234 +    qed
   9.235 +    finally show ?thesis .
   9.236 +  qed
   9.237 +qed
   9.238 +
   9.239 +text {*
   9.240 +  \medskip The function norm is the least positive real number for
   9.241 +  which the following inequation holds:
   9.242 +  \begin{center}
   9.243 +    @{text "\<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
   9.244 +  \end{center}
   9.245 +*}
   9.246 +
   9.247 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_least [intro?]:
   9.248 +  assumes "continuous V norm f"
   9.249 +  assumes ineq: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" and ge: "0 \<le> c"
   9.250 +  shows "\<parallel>f\<parallel>\<hyphen>V \<le> c"
   9.251 +proof -
   9.252 +  interpret continuous [V norm f] by fact
   9.253 +  show ?thesis
   9.254 +  proof (rule fn_norm_leastB [folded B_def fn_norm_def])
   9.255 +    fix b assume b: "b \<in> B V f"
   9.256 +    show "b \<le> c"
   9.257 +    proof cases
   9.258 +      assume "b = 0"
   9.259 +      with ge show ?thesis by simp
   9.260 +    next
   9.261 +      assume "b \<noteq> 0"
   9.262 +      with b obtain x where b_rep: "b = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
   9.263 +        and x_neq: "x \<noteq> 0" and x: "x \<in> V"
   9.264 +	by (auto simp add: B_def real_divide_def)
   9.265 +      note b_rep
   9.266 +      also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
   9.267 +      proof (rule mult_right_mono)
   9.268 +	have "0 < \<parallel>x\<parallel>" using x x_neq ..
   9.269 +	then show "0 \<le> inverse \<parallel>x\<parallel>" by simp
   9.270 +	from ineq and x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
   9.271 +      qed
   9.272 +      also have "\<dots> = c"
   9.273 +      proof -
   9.274 +	from x_neq and x have "\<parallel>x\<parallel> \<noteq> 0" by simp
   9.275 +	then show ?thesis by simp
   9.276 +      qed
   9.277 +      finally show ?thesis .
   9.278 +    qed
   9.279 +  qed (insert `continuous V norm f`, simp_all add: continuous_def)
   9.280 +qed
   9.281 +
   9.282 +end
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/HahnBanach/FunctionOrder.thy	Mon Dec 29 14:08:08 2008 +0100
    10.3 @@ -0,0 +1,142 @@
    10.4 +(*  Title:      HOL/Real/HahnBanach/FunctionOrder.thy
    10.5 +    ID:         $Id$
    10.6 +    Author:     Gertrud Bauer, TU Munich
    10.7 +*)
    10.8 +
    10.9 +header {* An order on functions *}
   10.10 +
   10.11 +theory FunctionOrder
   10.12 +imports Subspace Linearform
   10.13 +begin
   10.14 +
   10.15 +subsection {* The graph of a function *}
   10.16 +
   10.17 +text {*
   10.18 +  We define the \emph{graph} of a (real) function @{text f} with
   10.19 +  domain @{text F} as the set
   10.20 +  \begin{center}
   10.21 +  @{text "{(x, f x). x \<in> F}"}
   10.22 +  \end{center}
   10.23 +  So we are modeling partial functions by specifying the domain and
   10.24 +  the mapping function. We use the term ``function'' also for its
   10.25 +  graph.
   10.26 +*}
   10.27 +
   10.28 +types 'a graph = "('a \<times> real) set"
   10.29 +
   10.30 +definition
   10.31 +  graph :: "'a set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a graph" where
   10.32 +  "graph F f = {(x, f x) | x. x \<in> F}"
   10.33 +
   10.34 +lemma graphI [intro]: "x \<in> F \<Longrightarrow> (x, f x) \<in> graph F f"
   10.35 +  unfolding graph_def by blast
   10.36 +
   10.37 +lemma graphI2 [intro?]: "x \<in> F \<Longrightarrow> \<exists>t \<in> graph F f. t = (x, f x)"
   10.38 +  unfolding graph_def by blast
   10.39 +
   10.40 +lemma graphE [elim?]:
   10.41 +    "(x, y) \<in> graph F f \<Longrightarrow> (x \<in> F \<Longrightarrow> y = f x \<Longrightarrow> C) \<Longrightarrow> C"
   10.42 +  unfolding graph_def by blast
   10.43 +
   10.44 +
   10.45 +subsection {* Functions ordered by domain extension *}
   10.46 +
   10.47 +text {*
   10.48 +  A function @{text h'} is an extension of @{text h}, iff the graph of
   10.49 +  @{text h} is a subset of the graph of @{text h'}.
   10.50 +*}
   10.51 +
   10.52 +lemma graph_extI:
   10.53 +  "(\<And>x. x \<in> H \<Longrightarrow> h x = h' x) \<Longrightarrow> H \<subseteq> H'
   10.54 +    \<Longrightarrow> graph H h \<subseteq> graph H' h'"
   10.55 +  unfolding graph_def by blast
   10.56 +
   10.57 +lemma graph_extD1 [dest?]:
   10.58 +  "graph H h \<subseteq> graph H' h' \<Longrightarrow> x \<in> H \<Longrightarrow> h x = h' x"
   10.59 +  unfolding graph_def by blast
   10.60 +
   10.61 +lemma graph_extD2 [dest?]:
   10.62 +  "graph H h \<subseteq> graph H' h' \<Longrightarrow> H \<subseteq> H'"
   10.63 +  unfolding graph_def by blast
   10.64 +
   10.65 +
   10.66 +subsection {* Domain and function of a graph *}
   10.67 +
   10.68 +text {*
   10.69 +  The inverse functions to @{text graph} are @{text domain} and @{text
   10.70 +  funct}.
   10.71 +*}
   10.72 +
   10.73 +definition
   10.74 +  "domain" :: "'a graph \<Rightarrow> 'a set" where
   10.75 +  "domain g = {x. \<exists>y. (x, y) \<in> g}"
   10.76 +
   10.77 +definition
   10.78 +  funct :: "'a graph \<Rightarrow> ('a \<Rightarrow> real)" where
   10.79 +  "funct g = (\<lambda>x. (SOME y. (x, y) \<in> g))"
   10.80 +
   10.81 +text {*
   10.82 +  The following lemma states that @{text g} is the graph of a function
   10.83 +  if the relation induced by @{text g} is unique.
   10.84 +*}
   10.85 +
   10.86 +lemma graph_domain_funct:
   10.87 +  assumes uniq: "\<And>x y z. (x, y) \<in> g \<Longrightarrow> (x, z) \<in> g \<Longrightarrow> z = y"
   10.88 +  shows "graph (domain g) (funct g) = g"
   10.89 +  unfolding domain_def funct_def graph_def
   10.90 +proof auto  (* FIXME !? *)
   10.91 +  fix a b assume g: "(a, b) \<in> g"
   10.92 +  from g show "(a, SOME y. (a, y) \<in> g) \<in> g" by (rule someI2)
   10.93 +  from g show "\<exists>y. (a, y) \<in> g" ..
   10.94 +  from g show "b = (SOME y. (a, y) \<in> g)"
   10.95 +  proof (rule some_equality [symmetric])
   10.96 +    fix y assume "(a, y) \<in> g"
   10.97 +    with g show "y = b" by (rule uniq)
   10.98 +  qed
   10.99 +qed
  10.100 +
  10.101 +
  10.102 +subsection {* Norm-preserving extensions of a function *}
  10.103 +
  10.104 +text {*
  10.105 +  Given a linear form @{text f} on the space @{text F} and a seminorm
  10.106 +  @{text p} on @{text E}. The set of all linear extensions of @{text
  10.107 +  f}, to superspaces @{text H} of @{text F}, which are bounded by
  10.108 +  @{text p}, is defined as follows.
  10.109 +*}
  10.110 +
  10.111 +definition
  10.112 +  norm_pres_extensions ::
  10.113 +    "'a::{plus, minus, uminus, zero} set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> real)
  10.114 +      \<Rightarrow> 'a graph set" where
  10.115 +    "norm_pres_extensions E p F f
  10.116 +      = {g. \<exists>H h. g = graph H h
  10.117 +          \<and> linearform H h
  10.118 +          \<and> H \<unlhd> E
  10.119 +          \<and> F \<unlhd> H
  10.120 +          \<and> graph F f \<subseteq> graph H h
  10.121 +          \<and> (\<forall>x \<in> H. h x \<le> p x)}"
  10.122 +
  10.123 +lemma norm_pres_extensionE [elim]:
  10.124 +  "g \<in> norm_pres_extensions E p F f
  10.125 +  \<Longrightarrow> (\<And>H h. g = graph H h \<Longrightarrow> linearform H h
  10.126 +        \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H \<Longrightarrow> graph F f \<subseteq> graph H h
  10.127 +        \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x \<Longrightarrow> C) \<Longrightarrow> C"
  10.128 +  unfolding norm_pres_extensions_def by blast
  10.129 +
  10.130 +lemma norm_pres_extensionI2 [intro]:
  10.131 +  "linearform H h \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H
  10.132 +    \<Longrightarrow> graph F f \<subseteq> graph H h \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x
  10.133 +    \<Longrightarrow> graph H h \<in> norm_pres_extensions E p F f"
  10.134 +  unfolding norm_pres_extensions_def by blast
  10.135 +
  10.136 +lemma norm_pres_extensionI:  (* FIXME ? *)
  10.137 +  "\<exists>H h. g = graph H h
  10.138 +    \<and> linearform H h
  10.139 +    \<and> H \<unlhd> E
  10.140 +    \<and> F \<unlhd> H
  10.141 +    \<and> graph F f \<subseteq> graph H h
  10.142 +    \<and> (\<forall>x \<in> H. h x \<le> p x) \<Longrightarrow> g \<in> norm_pres_extensions E p F f"
  10.143 +  unfolding norm_pres_extensions_def by blast
  10.144 +
  10.145 +end
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/HahnBanach/HahnBanach.thy	Mon Dec 29 14:08:08 2008 +0100
    11.3 @@ -0,0 +1,510 @@
    11.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanach.thy
    11.5 +    ID:         $Id$
    11.6 +    Author:     Gertrud Bauer, TU Munich
    11.7 +*)
    11.8 +
    11.9 +header {* The Hahn-Banach Theorem *}
   11.10 +
   11.11 +theory HahnBanach
   11.12 +imports HahnBanachLemmas
   11.13 +begin
   11.14 +
   11.15 +text {*
   11.16 +  We present the proof of two different versions of the Hahn-Banach
   11.17 +  Theorem, closely following \cite[\S36]{Heuser:1986}.
   11.18 +*}
   11.19 +
   11.20 +subsection {* The Hahn-Banach Theorem for vector spaces *}
   11.21 +
   11.22 +text {*
   11.23 +  \textbf{Hahn-Banach Theorem.} Let @{text F} be a subspace of a real
   11.24 +  vector space @{text E}, let @{text p} be a semi-norm on @{text E},
   11.25 +  and @{text f} be a linear form defined on @{text F} such that @{text
   11.26 +  f} is bounded by @{text p}, i.e.  @{text "\<forall>x \<in> F. f x \<le> p x"}.  Then
   11.27 +  @{text f} can be extended to a linear form @{text h} on @{text E}
   11.28 +  such that @{text h} is norm-preserving, i.e. @{text h} is also
   11.29 +  bounded by @{text p}.
   11.30 +
   11.31 +  \bigskip
   11.32 +  \textbf{Proof Sketch.}
   11.33 +  \begin{enumerate}
   11.34 +
   11.35 +  \item Define @{text M} as the set of norm-preserving extensions of
   11.36 +  @{text f} to subspaces of @{text E}. The linear forms in @{text M}
   11.37 +  are ordered by domain extension.
   11.38 +
   11.39 +  \item We show that every non-empty chain in @{text M} has an upper
   11.40 +  bound in @{text M}.
   11.41 +
   11.42 +  \item With Zorn's Lemma we conclude that there is a maximal function
   11.43 +  @{text g} in @{text M}.
   11.44 +
   11.45 +  \item The domain @{text H} of @{text g} is the whole space @{text
   11.46 +  E}, as shown by classical contradiction:
   11.47 +
   11.48 +  \begin{itemize}
   11.49 +
   11.50 +  \item Assuming @{text g} is not defined on whole @{text E}, it can
   11.51 +  still be extended in a norm-preserving way to a super-space @{text
   11.52 +  H'} of @{text H}.
   11.53 +
   11.54 +  \item Thus @{text g} can not be maximal. Contradiction!
   11.55 +
   11.56 +  \end{itemize}
   11.57 +  \end{enumerate}
   11.58 +*}
   11.59 +
   11.60 +theorem HahnBanach:
   11.61 +  assumes E: "vectorspace E" and "subspace F E"
   11.62 +    and "seminorm E p" and "linearform F f"
   11.63 +  assumes fp: "\<forall>x \<in> F. f x \<le> p x"
   11.64 +  shows "\<exists>h. linearform E h \<and> (\<forall>x \<in> F. h x = f x) \<and> (\<forall>x \<in> E. h x \<le> p x)"
   11.65 +    -- {* Let @{text E} be a vector space, @{text F} a subspace of @{text E}, @{text p} a seminorm on @{text E}, *}
   11.66 +    -- {* and @{text f} a linear form on @{text F} such that @{text f} is bounded by @{text p}, *}
   11.67 +    -- {* then @{text f} can be extended to a linear form @{text h} on @{text E} in a norm-preserving way. \skp *}
   11.68 +proof -
   11.69 +  interpret vectorspace [E] by fact
   11.70 +  interpret subspace [F E] by fact
   11.71 +  interpret seminorm [E p] by fact
   11.72 +  interpret linearform [F f] by fact
   11.73 +  def M \<equiv> "norm_pres_extensions E p F f"
   11.74 +  then have M: "M = \<dots>" by (simp only:)
   11.75 +  from E have F: "vectorspace F" ..
   11.76 +  note FE = `F \<unlhd> E`
   11.77 +  {
   11.78 +    fix c assume cM: "c \<in> chain M" and ex: "\<exists>x. x \<in> c"
   11.79 +    have "\<Union>c \<in> M"
   11.80 +      -- {* Show that every non-empty chain @{text c} of @{text M} has an upper bound in @{text M}: *}
   11.81 +      -- {* @{text "\<Union>c"} is greater than any element of the chain @{text c}, so it suffices to show @{text "\<Union>c \<in> M"}. *}
   11.82 +      unfolding M_def
   11.83 +    proof (rule norm_pres_extensionI)
   11.84 +      let ?H = "domain (\<Union>c)"
   11.85 +      let ?h = "funct (\<Union>c)"
   11.86 +
   11.87 +      have a: "graph ?H ?h = \<Union>c"
   11.88 +      proof (rule graph_domain_funct)
   11.89 +        fix x y z assume "(x, y) \<in> \<Union>c" and "(x, z) \<in> \<Union>c"
   11.90 +        with M_def cM show "z = y" by (rule sup_definite)
   11.91 +      qed
   11.92 +      moreover from M cM a have "linearform ?H ?h"
   11.93 +        by (rule sup_lf)
   11.94 +      moreover from a M cM ex FE E have "?H \<unlhd> E"
   11.95 +        by (rule sup_subE)
   11.96 +      moreover from a M cM ex FE have "F \<unlhd> ?H"
   11.97 +        by (rule sup_supF)
   11.98 +      moreover from a M cM ex have "graph F f \<subseteq> graph ?H ?h"
   11.99 +        by (rule sup_ext)
  11.100 +      moreover from a M cM have "\<forall>x \<in> ?H. ?h x \<le> p x"
  11.101 +        by (rule sup_norm_pres)
  11.102 +      ultimately show "\<exists>H h. \<Union>c = graph H h
  11.103 +          \<and> linearform H h
  11.104 +          \<and> H \<unlhd> E
  11.105 +          \<and> F \<unlhd> H
  11.106 +          \<and> graph F f \<subseteq> graph H h
  11.107 +          \<and> (\<forall>x \<in> H. h x \<le> p x)" by blast
  11.108 +    qed
  11.109 +  }
  11.110 +  then have "\<exists>g \<in> M. \<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
  11.111 +  -- {* With Zorn's Lemma we can conclude that there is a maximal element in @{text M}. \skp *}
  11.112 +  proof (rule Zorn's_Lemma)
  11.113 +      -- {* We show that @{text M} is non-empty: *}
  11.114 +    show "graph F f \<in> M"
  11.115 +      unfolding M_def
  11.116 +    proof (rule norm_pres_extensionI2)
  11.117 +      show "linearform F f" by fact
  11.118 +      show "F \<unlhd> E" by fact
  11.119 +      from F show "F \<unlhd> F" by (rule vectorspace.subspace_refl)
  11.120 +      show "graph F f \<subseteq> graph F f" ..
  11.121 +      show "\<forall>x\<in>F. f x \<le> p x" by fact
  11.122 +    qed
  11.123 +  qed
  11.124 +  then obtain g where gM: "g \<in> M" and gx: "\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
  11.125 +    by blast
  11.126 +  from gM obtain H h where
  11.127 +      g_rep: "g = graph H h"
  11.128 +    and linearform: "linearform H h"
  11.129 +    and HE: "H \<unlhd> E" and FH: "F \<unlhd> H"
  11.130 +    and graphs: "graph F f \<subseteq> graph H h"
  11.131 +    and hp: "\<forall>x \<in> H. h x \<le> p x" unfolding M_def ..
  11.132 +      -- {* @{text g} is a norm-preserving extension of @{text f}, in other words: *}
  11.133 +      -- {* @{text g} is the graph of some linear form @{text h} defined on a subspace @{text H} of @{text E}, *}
  11.134 +      -- {* and @{text h} is an extension of @{text f} that is again bounded by @{text p}. \skp *}
  11.135 +  from HE E have H: "vectorspace H"
  11.136 +    by (rule subspace.vectorspace)
  11.137 +
  11.138 +  have HE_eq: "H = E"
  11.139 +    -- {* We show that @{text h} is defined on whole @{text E} by classical contradiction. \skp *}
  11.140 +  proof (rule classical)
  11.141 +    assume neq: "H \<noteq> E"
  11.142 +      -- {* Assume @{text h} is not defined on whole @{text E}. Then show that @{text h} can be extended *}
  11.143 +      -- {* in a norm-preserving way to a function @{text h'} with the graph @{text g'}. \skp *}
  11.144 +    have "\<exists>g' \<in> M. g \<subseteq> g' \<and> g \<noteq> g'"
  11.145 +    proof -
  11.146 +      from HE have "H \<subseteq> E" ..
  11.147 +      with neq obtain x' where x'E: "x' \<in> E" and "x' \<notin> H" by blast
  11.148 +      obtain x': "x' \<noteq> 0"
  11.149 +      proof
  11.150 +        show "x' \<noteq> 0"
  11.151 +        proof
  11.152 +          assume "x' = 0"
  11.153 +          with H have "x' \<in> H" by (simp only: vectorspace.zero)
  11.154 +          with `x' \<notin> H` show False by contradiction
  11.155 +        qed
  11.156 +      qed
  11.157 +
  11.158 +      def H' \<equiv> "H + lin x'"
  11.159 +        -- {* Define @{text H'} as the direct sum of @{text H} and the linear closure of @{text x'}. \skp *}
  11.160 +      have HH': "H \<unlhd> H'"
  11.161 +      proof (unfold H'_def)
  11.162 +        from x'E have "vectorspace (lin x')" ..
  11.163 +        with H show "H \<unlhd> H + lin x'" ..
  11.164 +      qed
  11.165 +
  11.166 +      obtain xi where
  11.167 +        xi: "\<forall>y \<in> H. - p (y + x') - h y \<le> xi
  11.168 +          \<and> xi \<le> p (y + x') - h y"
  11.169 +        -- {* Pick a real number @{text \<xi>} that fulfills certain inequations; this will *}
  11.170 +        -- {* be used to establish that @{text h'} is a norm-preserving extension of @{text h}.
  11.171 +           \label{ex-xi-use}\skp *}
  11.172 +      proof -
  11.173 +        from H have "\<exists>xi. \<forall>y \<in> H. - p (y + x') - h y \<le> xi
  11.174 +            \<and> xi \<le> p (y + x') - h y"
  11.175 +        proof (rule ex_xi)
  11.176 +          fix u v assume u: "u \<in> H" and v: "v \<in> H"
  11.177 +          with HE have uE: "u \<in> E" and vE: "v \<in> E" by auto
  11.178 +          from H u v linearform have "h v - h u = h (v - u)"
  11.179 +            by (simp add: linearform.diff)
  11.180 +          also from hp and H u v have "\<dots> \<le> p (v - u)"
  11.181 +            by (simp only: vectorspace.diff_closed)
  11.182 +          also from x'E uE vE have "v - u = x' + - x' + v + - u"
  11.183 +            by (simp add: diff_eq1)
  11.184 +          also from x'E uE vE have "\<dots> = v + x' + - (u + x')"
  11.185 +            by (simp add: add_ac)
  11.186 +          also from x'E uE vE have "\<dots> = (v + x') - (u + x')"
  11.187 +            by (simp add: diff_eq1)
  11.188 +          also from x'E uE vE E have "p \<dots> \<le> p (v + x') + p (u + x')"
  11.189 +            by (simp add: diff_subadditive)
  11.190 +          finally have "h v - h u \<le> p (v + x') + p (u + x')" .
  11.191 +          then show "- p (u + x') - h u \<le> p (v + x') - h v" by simp
  11.192 +        qed
  11.193 +        then show thesis by (blast intro: that)
  11.194 +      qed
  11.195 +
  11.196 +      def h' \<equiv> "\<lambda>x. let (y, a) =
  11.197 +          SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H in h y + a * xi"
  11.198 +        -- {* Define the extension @{text h'} of @{text h} to @{text H'} using @{text \<xi>}. \skp *}
  11.199 +
  11.200 +      have "g \<subseteq> graph H' h' \<and> g \<noteq> graph H' h'"
  11.201 +        -- {* @{text h'} is an extension of @{text h} \dots \skp *}
  11.202 +      proof
  11.203 +        show "g \<subseteq> graph H' h'"
  11.204 +        proof -
  11.205 +          have  "graph H h \<subseteq> graph H' h'"
  11.206 +          proof (rule graph_extI)
  11.207 +            fix t assume t: "t \<in> H"
  11.208 +            from E HE t have "(SOME (y, a). t = y + a \<cdot> x' \<and> y \<in> H) = (t, 0)"
  11.209 +	      using `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` by (rule decomp_H'_H)
  11.210 +            with h'_def show "h t = h' t" by (simp add: Let_def)
  11.211 +          next
  11.212 +            from HH' show "H \<subseteq> H'" ..
  11.213 +          qed
  11.214 +          with g_rep show ?thesis by (simp only:)
  11.215 +        qed
  11.216 +
  11.217 +        show "g \<noteq> graph H' h'"
  11.218 +        proof -
  11.219 +          have "graph H h \<noteq> graph H' h'"
  11.220 +          proof
  11.221 +            assume eq: "graph H h = graph H' h'"
  11.222 +            have "x' \<in> H'"
  11.223 +	      unfolding H'_def
  11.224 +            proof
  11.225 +              from H show "0 \<in> H" by (rule vectorspace.zero)
  11.226 +              from x'E show "x' \<in> lin x'" by (rule x_lin_x)
  11.227 +              from x'E show "x' = 0 + x'" by simp
  11.228 +            qed
  11.229 +            then have "(x', h' x') \<in> graph H' h'" ..
  11.230 +            with eq have "(x', h' x') \<in> graph H h" by (simp only:)
  11.231 +            then have "x' \<in> H" ..
  11.232 +            with `x' \<notin> H` show False by contradiction
  11.233 +          qed
  11.234 +          with g_rep show ?thesis by simp
  11.235 +        qed
  11.236 +      qed
  11.237 +      moreover have "graph H' h' \<in> M"
  11.238 +        -- {* and @{text h'} is norm-preserving. \skp *}
  11.239 +      proof (unfold M_def)
  11.240 +        show "graph H' h' \<in> norm_pres_extensions E p F f"
  11.241 +        proof (rule norm_pres_extensionI2)
  11.242 +          show "linearform H' h'"
  11.243 +	    using h'_def H'_def HE linearform `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E
  11.244 +	    by (rule h'_lf)
  11.245 +          show "H' \<unlhd> E"
  11.246 +	  unfolding H'_def
  11.247 +          proof
  11.248 +            show "H \<unlhd> E" by fact
  11.249 +            show "vectorspace E" by fact
  11.250 +            from x'E show "lin x' \<unlhd> E" ..
  11.251 +          qed
  11.252 +          from H `F \<unlhd> H` HH' show FH': "F \<unlhd> H'"
  11.253 +            by (rule vectorspace.subspace_trans)
  11.254 +          show "graph F f \<subseteq> graph H' h'"
  11.255 +          proof (rule graph_extI)
  11.256 +            fix x assume x: "x \<in> F"
  11.257 +            with graphs have "f x = h x" ..
  11.258 +            also have "\<dots> = h x + 0 * xi" by simp
  11.259 +            also have "\<dots> = (let (y, a) = (x, 0) in h y + a * xi)"
  11.260 +              by (simp add: Let_def)
  11.261 +            also have "(x, 0) =
  11.262 +                (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)"
  11.263 +	      using E HE
  11.264 +            proof (rule decomp_H'_H [symmetric])
  11.265 +              from FH x show "x \<in> H" ..
  11.266 +              from x' show "x' \<noteq> 0" .
  11.267 +	      show "x' \<notin> H" by fact
  11.268 +	      show "x' \<in> E" by fact
  11.269 +            qed
  11.270 +            also have
  11.271 +              "(let (y, a) = (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)
  11.272 +              in h y + a * xi) = h' x" by (simp only: h'_def)
  11.273 +            finally show "f x = h' x" .
  11.274 +          next
  11.275 +            from FH' show "F \<subseteq> H'" ..
  11.276 +          qed
  11.277 +          show "\<forall>x \<in> H'. h' x \<le> p x"
  11.278 +	    using h'_def H'_def `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E HE
  11.279 +	      `seminorm E p` linearform and hp xi
  11.280 +	    by (rule h'_norm_pres)
  11.281 +        qed
  11.282 +      qed
  11.283 +      ultimately show ?thesis ..
  11.284 +    qed
  11.285 +    then have "\<not> (\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x)" by simp
  11.286 +      -- {* So the graph @{text g} of @{text h} cannot be maximal. Contradiction! \skp *}
  11.287 +    with gx show "H = E" by contradiction
  11.288 +  qed
  11.289 +
  11.290 +  from HE_eq and linearform have "linearform E h"
  11.291 +    by (simp only:)
  11.292 +  moreover have "\<forall>x \<in> F. h x = f x"
  11.293 +  proof
  11.294 +    fix x assume "x \<in> F"
  11.295 +    with graphs have "f x = h x" ..
  11.296 +    then show "h x = f x" ..
  11.297 +  qed
  11.298 +  moreover from HE_eq and hp have "\<forall>x \<in> E. h x \<le> p x"
  11.299 +    by (simp only:)
  11.300 +  ultimately show ?thesis by blast
  11.301 +qed
  11.302 +
  11.303 +
  11.304 +subsection  {* Alternative formulation *}
  11.305 +
  11.306 +text {*
  11.307 +  The following alternative formulation of the Hahn-Banach
  11.308 +  Theorem\label{abs-HahnBanach} uses the fact that for a real linear
  11.309 +  form @{text f} and a seminorm @{text p} the following inequations
  11.310 +  are equivalent:\footnote{This was shown in lemma @{thm [source]
  11.311 +  abs_ineq_iff} (see page \pageref{abs-ineq-iff}).}
  11.312 +  \begin{center}
  11.313 +  \begin{tabular}{lll}
  11.314 +  @{text "\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x"} & and &
  11.315 +  @{text "\<forall>x \<in> H. h x \<le> p x"} \\
  11.316 +  \end{tabular}
  11.317 +  \end{center}
  11.318 +*}
  11.319 +
  11.320 +theorem abs_HahnBanach:
  11.321 +  assumes E: "vectorspace E" and FE: "subspace F E"
  11.322 +    and lf: "linearform F f" and sn: "seminorm E p"
  11.323 +  assumes fp: "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
  11.324 +  shows "\<exists>g. linearform E g
  11.325 +    \<and> (\<forall>x \<in> F. g x = f x)
  11.326 +    \<and> (\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x)"
  11.327 +proof -
  11.328 +  interpret vectorspace [E] by fact
  11.329 +  interpret subspace [F E] by fact
  11.330 +  interpret linearform [F f] by fact
  11.331 +  interpret seminorm [E p] by fact
  11.332 +  have "\<exists>g. linearform E g \<and> (\<forall>x \<in> F. g x = f x) \<and> (\<forall>x \<in> E. g x \<le> p x)"
  11.333 +    using E FE sn lf
  11.334 +  proof (rule HahnBanach)
  11.335 +    show "\<forall>x \<in> F. f x \<le> p x"
  11.336 +      using FE E sn lf and fp by (rule abs_ineq_iff [THEN iffD1])
  11.337 +  qed
  11.338 +  then obtain g where lg: "linearform E g" and *: "\<forall>x \<in> F. g x = f x"
  11.339 +      and **: "\<forall>x \<in> E. g x \<le> p x" by blast
  11.340 +  have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
  11.341 +    using _ E sn lg **
  11.342 +  proof (rule abs_ineq_iff [THEN iffD2])
  11.343 +    show "E \<unlhd> E" ..
  11.344 +  qed
  11.345 +  with lg * show ?thesis by blast
  11.346 +qed
  11.347 +
  11.348 +
  11.349 +subsection {* The Hahn-Banach Theorem for normed spaces *}
  11.350 +
  11.351 +text {*
  11.352 +  Every continuous linear form @{text f} on a subspace @{text F} of a
  11.353 +  norm space @{text E}, can be extended to a continuous linear form
  11.354 +  @{text g} on @{text E} such that @{text "\<parallel>f\<parallel> = \<parallel>g\<parallel>"}.
  11.355 +*}
  11.356 +
  11.357 +theorem norm_HahnBanach:
  11.358 +  fixes V and norm ("\<parallel>_\<parallel>")
  11.359 +  fixes B defines "\<And>V f. B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
  11.360 +  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
  11.361 +  defines "\<And>V f. \<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
  11.362 +  assumes E_norm: "normed_vectorspace E norm" and FE: "subspace F E"
  11.363 +    and linearform: "linearform F f" and "continuous F norm f"
  11.364 +  shows "\<exists>g. linearform E g
  11.365 +     \<and> continuous E norm g
  11.366 +     \<and> (\<forall>x \<in> F. g x = f x)
  11.367 +     \<and> \<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
  11.368 +proof -
  11.369 +  interpret normed_vectorspace [E norm] by fact
  11.370 +  interpret normed_vectorspace_with_fn_norm [E norm B fn_norm]
  11.371 +    by (auto simp: B_def fn_norm_def) intro_locales
  11.372 +  interpret subspace [F E] by fact
  11.373 +  interpret linearform [F f] by fact
  11.374 +  interpret continuous [F norm f] by fact
  11.375 +  have E: "vectorspace E" by intro_locales
  11.376 +  have F: "vectorspace F" by rule intro_locales
  11.377 +  have F_norm: "normed_vectorspace F norm"
  11.378 +    using FE E_norm by (rule subspace_normed_vs)
  11.379 +  have ge_zero: "0 \<le> \<parallel>f\<parallel>\<hyphen>F"
  11.380 +    by (rule normed_vectorspace_with_fn_norm.fn_norm_ge_zero
  11.381 +      [OF normed_vectorspace_with_fn_norm.intro,
  11.382 +       OF F_norm `continuous F norm f` , folded B_def fn_norm_def])
  11.383 +  txt {* We define a function @{text p} on @{text E} as follows:
  11.384 +    @{text "p x = \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"} *}
  11.385 +  def p \<equiv> "\<lambda>x. \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  11.386 +
  11.387 +  txt {* @{text p} is a seminorm on @{text E}: *}
  11.388 +  have q: "seminorm E p"
  11.389 +  proof
  11.390 +    fix x y a assume x: "x \<in> E" and y: "y \<in> E"
  11.391 +    
  11.392 +    txt {* @{text p} is positive definite: *}
  11.393 +    have "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
  11.394 +    moreover from x have "0 \<le> \<parallel>x\<parallel>" ..
  11.395 +    ultimately show "0 \<le> p x"  
  11.396 +      by (simp add: p_def zero_le_mult_iff)
  11.397 +
  11.398 +    txt {* @{text p} is absolutely homogenous: *}
  11.399 +
  11.400 +    show "p (a \<cdot> x) = \<bar>a\<bar> * p x"
  11.401 +    proof -
  11.402 +      have "p (a \<cdot> x) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>a \<cdot> x\<parallel>" by (simp only: p_def)
  11.403 +      also from x have "\<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>" by (rule abs_homogenous)
  11.404 +      also have "\<parallel>f\<parallel>\<hyphen>F * (\<bar>a\<bar> * \<parallel>x\<parallel>) = \<bar>a\<bar> * (\<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>)" by simp
  11.405 +      also have "\<dots> = \<bar>a\<bar> * p x" by (simp only: p_def)
  11.406 +      finally show ?thesis .
  11.407 +    qed
  11.408 +
  11.409 +    txt {* Furthermore, @{text p} is subadditive: *}
  11.410 +
  11.411 +    show "p (x + y) \<le> p x + p y"
  11.412 +    proof -
  11.413 +      have "p (x + y) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel>" by (simp only: p_def)
  11.414 +      also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
  11.415 +      from x y have "\<parallel>x + y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>" ..
  11.416 +      with a have " \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>F * (\<parallel>x\<parallel> + \<parallel>y\<parallel>)"
  11.417 +        by (simp add: mult_left_mono)
  11.418 +      also have "\<dots> = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel> + \<parallel>f\<parallel>\<hyphen>F * \<parallel>y\<parallel>" by (simp only: right_distrib)
  11.419 +      also have "\<dots> = p x + p y" by (simp only: p_def)
  11.420 +      finally show ?thesis .
  11.421 +    qed
  11.422 +  qed
  11.423 +
  11.424 +  txt {* @{text f} is bounded by @{text p}. *}
  11.425 +
  11.426 +  have "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
  11.427 +  proof
  11.428 +    fix x assume "x \<in> F"
  11.429 +    with `continuous F norm f` and linearform
  11.430 +    show "\<bar>f x\<bar> \<le> p x"
  11.431 +      unfolding p_def by (rule normed_vectorspace_with_fn_norm.fn_norm_le_cong
  11.432 +        [OF normed_vectorspace_with_fn_norm.intro,
  11.433 +         OF F_norm, folded B_def fn_norm_def])
  11.434 +  qed
  11.435 +
  11.436 +  txt {* Using the fact that @{text p} is a seminorm and @{text f} is bounded
  11.437 +    by @{text p} we can apply the Hahn-Banach Theorem for real vector
  11.438 +    spaces. So @{text f} can be extended in a norm-preserving way to
  11.439 +    some function @{text g} on the whole vector space @{text E}. *}
  11.440 +
  11.441 +  with E FE linearform q obtain g where
  11.442 +      linearformE: "linearform E g"
  11.443 +    and a: "\<forall>x \<in> F. g x = f x"
  11.444 +    and b: "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
  11.445 +    by (rule abs_HahnBanach [elim_format]) iprover
  11.446 +
  11.447 +  txt {* We furthermore have to show that @{text g} is also continuous: *}
  11.448 +
  11.449 +  have g_cont: "continuous E norm g" using linearformE
  11.450 +  proof
  11.451 +    fix x assume "x \<in> E"
  11.452 +    with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  11.453 +      by (simp only: p_def)
  11.454 +  qed
  11.455 +
  11.456 +  txt {* To complete the proof, we show that @{text "\<parallel>g\<parallel> = \<parallel>f\<parallel>"}. *}
  11.457 +
  11.458 +  have "\<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
  11.459 +  proof (rule order_antisym)
  11.460 +    txt {*
  11.461 +      First we show @{text "\<parallel>g\<parallel> \<le> \<parallel>f\<parallel>"}.  The function norm @{text
  11.462 +      "\<parallel>g\<parallel>"} is defined as the smallest @{text "c \<in> \<real>"} such that
  11.463 +      \begin{center}
  11.464 +      \begin{tabular}{l}
  11.465 +      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
  11.466 +      \end{tabular}
  11.467 +      \end{center}
  11.468 +      \noindent Furthermore holds
  11.469 +      \begin{center}
  11.470 +      \begin{tabular}{l}
  11.471 +      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
  11.472 +      \end{tabular}
  11.473 +      \end{center}
  11.474 +    *}
  11.475 +
  11.476 +    have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  11.477 +    proof
  11.478 +      fix x assume "x \<in> E"
  11.479 +      with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  11.480 +        by (simp only: p_def)
  11.481 +    qed
  11.482 +    from g_cont this ge_zero
  11.483 +    show "\<parallel>g\<parallel>\<hyphen>E \<le> \<parallel>f\<parallel>\<hyphen>F"
  11.484 +      by (rule fn_norm_least [of g, folded B_def fn_norm_def])
  11.485 +
  11.486 +    txt {* The other direction is achieved by a similar argument. *}
  11.487 +
  11.488 +    show "\<parallel>f\<parallel>\<hyphen>F \<le> \<parallel>g\<parallel>\<hyphen>E"
  11.489 +    proof (rule normed_vectorspace_with_fn_norm.fn_norm_least
  11.490 +	[OF normed_vectorspace_with_fn_norm.intro,
  11.491 +	 OF F_norm, folded B_def fn_norm_def])
  11.492 +      show "\<forall>x \<in> F. \<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
  11.493 +      proof
  11.494 +	fix x assume x: "x \<in> F"
  11.495 +	from a x have "g x = f x" ..
  11.496 +	then have "\<bar>f x\<bar> = \<bar>g x\<bar>" by (simp only:)
  11.497 +	also from g_cont
  11.498 +	have "\<dots> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
  11.499 +	proof (rule fn_norm_le_cong [of g, folded B_def fn_norm_def])
  11.500 +	  from FE x show "x \<in> E" ..
  11.501 +	qed
  11.502 +	finally show "\<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>" .
  11.503 +      qed
  11.504 +      show "0 \<le> \<parallel>g\<parallel>\<hyphen>E"
  11.505 +	using g_cont
  11.506 +	by (rule fn_norm_ge_zero [of g, folded B_def fn_norm_def])
  11.507 +      show "continuous F norm f" by fact
  11.508 +    qed
  11.509 +  qed
  11.510 +  with linearformE a g_cont show ?thesis by blast
  11.511 +qed
  11.512 +
  11.513 +end
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOL/HahnBanach/HahnBanachExtLemmas.thy	Mon Dec 29 14:08:08 2008 +0100
    12.3 @@ -0,0 +1,281 @@
    12.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
    12.5 +    ID:         $Id$
    12.6 +    Author:     Gertrud Bauer, TU Munich
    12.7 +*)
    12.8 +
    12.9 +header {* Extending non-maximal functions *}
   12.10 +
   12.11 +theory HahnBanachExtLemmas
   12.12 +imports FunctionNorm
   12.13 +begin
   12.14 +
   12.15 +text {*
   12.16 +  In this section the following context is presumed.  Let @{text E} be
   12.17 +  a real vector space with a seminorm @{text q} on @{text E}. @{text
   12.18 +  F} is a subspace of @{text E} and @{text f} a linear function on
   12.19 +  @{text F}. We consider a subspace @{text H} of @{text E} that is a
   12.20 +  superspace of @{text F} and a linear form @{text h} on @{text
   12.21 +  H}. @{text H} is a not equal to @{text E} and @{text "x\<^sub>0"} is
   12.22 +  an element in @{text "E - H"}.  @{text H} is extended to the direct
   12.23 +  sum @{text "H' = H + lin x\<^sub>0"}, so for any @{text "x \<in> H'"}
   12.24 +  the decomposition of @{text "x = y + a \<cdot> x"} with @{text "y \<in> H"} is
   12.25 +  unique. @{text h'} is defined on @{text H'} by @{text "h' x = h y +
   12.26 +  a \<cdot> \<xi>"} for a certain @{text \<xi>}.
   12.27 +
   12.28 +  Subsequently we show some properties of this extension @{text h'} of
   12.29 +  @{text h}.
   12.30 +
   12.31 +  \medskip This lemma will be used to show the existence of a linear
   12.32 +  extension of @{text f} (see page \pageref{ex-xi-use}). It is a
   12.33 +  consequence of the completeness of @{text \<real>}. To show
   12.34 +  \begin{center}
   12.35 +  \begin{tabular}{l}
   12.36 +  @{text "\<exists>\<xi>. \<forall>y \<in> F. a y \<le> \<xi> \<and> \<xi> \<le> b y"}
   12.37 +  \end{tabular}
   12.38 +  \end{center}
   12.39 +  \noindent it suffices to show that
   12.40 +  \begin{center}
   12.41 +  \begin{tabular}{l}
   12.42 +  @{text "\<forall>u \<in> F. \<forall>v \<in> F. a u \<le> b v"}
   12.43 +  \end{tabular}
   12.44 +  \end{center}
   12.45 +*}
   12.46 +
   12.47 +lemma ex_xi:
   12.48 +  assumes "vectorspace F"
   12.49 +  assumes r: "\<And>u v. u \<in> F \<Longrightarrow> v \<in> F \<Longrightarrow> a u \<le> b v"
   12.50 +  shows "\<exists>xi::real. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y"
   12.51 +proof -
   12.52 +  interpret vectorspace [F] by fact
   12.53 +  txt {* From the completeness of the reals follows:
   12.54 +    The set @{text "S = {a u. u \<in> F}"} has a supremum, if it is
   12.55 +    non-empty and has an upper bound. *}
   12.56 +
   12.57 +  let ?S = "{a u | u. u \<in> F}"
   12.58 +  have "\<exists>xi. lub ?S xi"
   12.59 +  proof (rule real_complete)
   12.60 +    have "a 0 \<in> ?S" by blast
   12.61 +    then show "\<exists>X. X \<in> ?S" ..
   12.62 +    have "\<forall>y \<in> ?S. y \<le> b 0"
   12.63 +    proof
   12.64 +      fix y assume y: "y \<in> ?S"
   12.65 +      then obtain u where u: "u \<in> F" and y: "y = a u" by blast
   12.66 +      from u and zero have "a u \<le> b 0" by (rule r)
   12.67 +      with y show "y \<le> b 0" by (simp only:)
   12.68 +    qed
   12.69 +    then show "\<exists>u. \<forall>y \<in> ?S. y \<le> u" ..
   12.70 +  qed
   12.71 +  then obtain xi where xi: "lub ?S xi" ..
   12.72 +  {
   12.73 +    fix y assume "y \<in> F"
   12.74 +    then have "a y \<in> ?S" by blast
   12.75 +    with xi have "a y \<le> xi" by (rule lub.upper)
   12.76 +  } moreover {
   12.77 +    fix y assume y: "y \<in> F"
   12.78 +    from xi have "xi \<le> b y"
   12.79 +    proof (rule lub.least)
   12.80 +      fix au assume "au \<in> ?S"
   12.81 +      then obtain u where u: "u \<in> F" and au: "au = a u" by blast
   12.82 +      from u y have "a u \<le> b y" by (rule r)
   12.83 +      with au show "au \<le> b y" by (simp only:)
   12.84 +    qed
   12.85 +  } ultimately show "\<exists>xi. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y" by blast
   12.86 +qed
   12.87 +
   12.88 +text {*
   12.89 +  \medskip The function @{text h'} is defined as a @{text "h' x = h y
   12.90 +  + a \<cdot> \<xi>"} where @{text "x = y + a \<cdot> \<xi>"} is a linear extension of
   12.91 +  @{text h} to @{text H'}.
   12.92 +*}
   12.93 +
   12.94 +lemma h'_lf:
   12.95 +  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
   12.96 +      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
   12.97 +    and H'_def: "H' \<equiv> H + lin x0"
   12.98 +    and HE: "H \<unlhd> E"
   12.99 +  assumes "linearform H h"
  12.100 +  assumes x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
  12.101 +  assumes E: "vectorspace E"
  12.102 +  shows "linearform H' h'"
  12.103 +proof -
  12.104 +  interpret linearform [H h] by fact
  12.105 +  interpret vectorspace [E] by fact
  12.106 +  show ?thesis
  12.107 +  proof
  12.108 +    note E = `vectorspace E`
  12.109 +    have H': "vectorspace H'"
  12.110 +    proof (unfold H'_def)
  12.111 +      from `x0 \<in> E`
  12.112 +      have "lin x0 \<unlhd> E" ..
  12.113 +      with HE show "vectorspace (H + lin x0)" using E ..
  12.114 +    qed
  12.115 +    {
  12.116 +      fix x1 x2 assume x1: "x1 \<in> H'" and x2: "x2 \<in> H'"
  12.117 +      show "h' (x1 + x2) = h' x1 + h' x2"
  12.118 +      proof -
  12.119 +	from H' x1 x2 have "x1 + x2 \<in> H'"
  12.120 +          by (rule vectorspace.add_closed)
  12.121 +	with x1 x2 obtain y y1 y2 a a1 a2 where
  12.122 +          x1x2: "x1 + x2 = y + a \<cdot> x0" and y: "y \<in> H"
  12.123 +          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
  12.124 +          and x2_rep: "x2 = y2 + a2 \<cdot> x0" and y2: "y2 \<in> H"
  12.125 +          unfolding H'_def sum_def lin_def by blast
  12.126 +	
  12.127 +	have ya: "y1 + y2 = y \<and> a1 + a2 = a" using E HE _ y x0
  12.128 +	proof (rule decomp_H') txt_raw {* \label{decomp-H-use} *}
  12.129 +          from HE y1 y2 show "y1 + y2 \<in> H"
  12.130 +            by (rule subspace.add_closed)
  12.131 +          from x0 and HE y y1 y2
  12.132 +          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E"  "y2 \<in> E" by auto
  12.133 +          with x1_rep x2_rep have "(y1 + y2) + (a1 + a2) \<cdot> x0 = x1 + x2"
  12.134 +            by (simp add: add_ac add_mult_distrib2)
  12.135 +          also note x1x2
  12.136 +          finally show "(y1 + y2) + (a1 + a2) \<cdot> x0 = y + a \<cdot> x0" .
  12.137 +	qed
  12.138 +	
  12.139 +	from h'_def x1x2 E HE y x0
  12.140 +	have "h' (x1 + x2) = h y + a * xi"
  12.141 +          by (rule h'_definite)
  12.142 +	also have "\<dots> = h (y1 + y2) + (a1 + a2) * xi"
  12.143 +          by (simp only: ya)
  12.144 +	also from y1 y2 have "h (y1 + y2) = h y1 + h y2"
  12.145 +          by simp
  12.146 +	also have "\<dots> + (a1 + a2) * xi = (h y1 + a1 * xi) + (h y2 + a2 * xi)"
  12.147 +          by (simp add: left_distrib)
  12.148 +	also from h'_def x1_rep E HE y1 x0
  12.149 +	have "h y1 + a1 * xi = h' x1"
  12.150 +          by (rule h'_definite [symmetric])
  12.151 +	also from h'_def x2_rep E HE y2 x0
  12.152 +	have "h y2 + a2 * xi = h' x2"
  12.153 +          by (rule h'_definite [symmetric])
  12.154 +	finally show ?thesis .
  12.155 +      qed
  12.156 +    next
  12.157 +      fix x1 c assume x1: "x1 \<in> H'"
  12.158 +      show "h' (c \<cdot> x1) = c * (h' x1)"
  12.159 +      proof -
  12.160 +	from H' x1 have ax1: "c \<cdot> x1 \<in> H'"
  12.161 +          by (rule vectorspace.mult_closed)
  12.162 +	with x1 obtain y a y1 a1 where
  12.163 +            cx1_rep: "c \<cdot> x1 = y + a \<cdot> x0" and y: "y \<in> H"
  12.164 +          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
  12.165 +          unfolding H'_def sum_def lin_def by blast
  12.166 +	
  12.167 +	have ya: "c \<cdot> y1 = y \<and> c * a1 = a" using E HE _ y x0
  12.168 +	proof (rule decomp_H')
  12.169 +          from HE y1 show "c \<cdot> y1 \<in> H"
  12.170 +            by (rule subspace.mult_closed)
  12.171 +          from x0 and HE y y1
  12.172 +          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E" by auto
  12.173 +          with x1_rep have "c \<cdot> y1 + (c * a1) \<cdot> x0 = c \<cdot> x1"
  12.174 +            by (simp add: mult_assoc add_mult_distrib1)
  12.175 +          also note cx1_rep
  12.176 +          finally show "c \<cdot> y1 + (c * a1) \<cdot> x0 = y + a \<cdot> x0" .
  12.177 +	qed
  12.178 +	
  12.179 +	from h'_def cx1_rep E HE y x0 have "h' (c \<cdot> x1) = h y + a * xi"
  12.180 +          by (rule h'_definite)
  12.181 +	also have "\<dots> = h (c \<cdot> y1) + (c * a1) * xi"
  12.182 +          by (simp only: ya)
  12.183 +	also from y1 have "h (c \<cdot> y1) = c * h y1"
  12.184 +          by simp
  12.185 +	also have "\<dots> + (c * a1) * xi = c * (h y1 + a1 * xi)"
  12.186 +          by (simp only: right_distrib)
  12.187 +	also from h'_def x1_rep E HE y1 x0 have "h y1 + a1 * xi = h' x1"
  12.188 +          by (rule h'_definite [symmetric])
  12.189 +	finally show ?thesis .
  12.190 +      qed
  12.191 +    }
  12.192 +  qed
  12.193 +qed
  12.194 +
  12.195 +text {* \medskip The linear extension @{text h'} of @{text h}
  12.196 +  is bounded by the seminorm @{text p}. *}
  12.197 +
  12.198 +lemma h'_norm_pres:
  12.199 +  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
  12.200 +      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
  12.201 +    and H'_def: "H' \<equiv> H + lin x0"
  12.202 +    and x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
  12.203 +  assumes E: "vectorspace E" and HE: "subspace H E"
  12.204 +    and "seminorm E p" and "linearform H h"
  12.205 +  assumes a: "\<forall>y \<in> H. h y \<le> p y"
  12.206 +    and a': "\<forall>y \<in> H. - p (y + x0) - h y \<le> xi \<and> xi \<le> p (y + x0) - h y"
  12.207 +  shows "\<forall>x \<in> H'. h' x \<le> p x"
  12.208 +proof -
  12.209 +  interpret vectorspace [E] by fact
  12.210 +  interpret subspace [H E] by fact
  12.211 +  interpret seminorm [E p] by fact
  12.212 +  interpret linearform [H h] by fact
  12.213 +  show ?thesis
  12.214 +  proof
  12.215 +    fix x assume x': "x \<in> H'"
  12.216 +    show "h' x \<le> p x"
  12.217 +    proof -
  12.218 +      from a' have a1: "\<forall>ya \<in> H. - p (ya + x0) - h ya \<le> xi"
  12.219 +	and a2: "\<forall>ya \<in> H. xi \<le> p (ya + x0) - h ya" by auto
  12.220 +      from x' obtain y a where
  12.221 +          x_rep: "x = y + a \<cdot> x0" and y: "y \<in> H"
  12.222 +	unfolding H'_def sum_def lin_def by blast
  12.223 +      from y have y': "y \<in> E" ..
  12.224 +      from y have ay: "inverse a \<cdot> y \<in> H" by simp
  12.225 +      
  12.226 +      from h'_def x_rep E HE y x0 have "h' x = h y + a * xi"
  12.227 +	by (rule h'_definite)
  12.228 +      also have "\<dots> \<le> p (y + a \<cdot> x0)"
  12.229 +      proof (rule linorder_cases)
  12.230 +	assume z: "a = 0"
  12.231 +	then have "h y + a * xi = h y" by simp
  12.232 +	also from a y have "\<dots> \<le> p y" ..
  12.233 +	also from x0 y' z have "p y = p (y + a \<cdot> x0)" by simp
  12.234 +	finally show ?thesis .
  12.235 +      next
  12.236 +	txt {* In the case @{text "a < 0"}, we use @{text "a\<^sub>1"}
  12.237 +          with @{text ya} taken as @{text "y / a"}: *}
  12.238 +	assume lz: "a < 0" then have nz: "a \<noteq> 0" by simp
  12.239 +	from a1 ay
  12.240 +	have "- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y) \<le> xi" ..
  12.241 +	with lz have "a * xi \<le>
  12.242 +          a * (- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
  12.243 +          by (simp add: mult_left_mono_neg order_less_imp_le)
  12.244 +	
  12.245 +	also have "\<dots> =
  12.246 +          - a * (p (inverse a \<cdot> y + x0)) - a * (h (inverse a \<cdot> y))"
  12.247 +	  by (simp add: right_diff_distrib)
  12.248 +	also from lz x0 y' have "- a * (p (inverse a \<cdot> y + x0)) =
  12.249 +          p (a \<cdot> (inverse a \<cdot> y + x0))"
  12.250 +          by (simp add: abs_homogenous)
  12.251 +	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
  12.252 +          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
  12.253 +	also from nz y have "a * (h (inverse a \<cdot> y)) =  h y"
  12.254 +          by simp
  12.255 +	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
  12.256 +	then show ?thesis by simp
  12.257 +      next
  12.258 +	txt {* In the case @{text "a > 0"}, we use @{text "a\<^sub>2"}
  12.259 +          with @{text ya} taken as @{text "y / a"}: *}
  12.260 +	assume gz: "0 < a" then have nz: "a \<noteq> 0" by simp
  12.261 +	from a2 ay
  12.262 +	have "xi \<le> p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y)" ..
  12.263 +	with gz have "a * xi \<le>
  12.264 +          a * (p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
  12.265 +          by simp
  12.266 +	also have "\<dots> = a * p (inverse a \<cdot> y + x0) - a * h (inverse a \<cdot> y)"
  12.267 +	  by (simp add: right_diff_distrib)
  12.268 +	also from gz x0 y'
  12.269 +	have "a * p (inverse a \<cdot> y + x0) = p (a \<cdot> (inverse a \<cdot> y + x0))"
  12.270 +          by (simp add: abs_homogenous)
  12.271 +	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
  12.272 +          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
  12.273 +	also from nz y have "a * h (inverse a \<cdot> y) = h y"
  12.274 +          by simp
  12.275 +	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
  12.276 +	then show ?thesis by simp
  12.277 +      qed
  12.278 +      also from x_rep have "\<dots> = p x" by (simp only:)
  12.279 +      finally show ?thesis .
  12.280 +    qed
  12.281 +  qed
  12.282 +qed
  12.283 +
  12.284 +end
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/HahnBanach/HahnBanachLemmas.thy	Mon Dec 29 14:08:08 2008 +0100
    13.3 @@ -0,0 +1,4 @@
    13.4 +(*<*)
    13.5 +theory HahnBanachLemmas imports HahnBanachSupLemmas HahnBanachExtLemmas begin
    13.6 +end
    13.7 +(*>*)
    13.8 \ No newline at end of file
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOL/HahnBanach/HahnBanachSupLemmas.thy	Mon Dec 29 14:08:08 2008 +0100
    14.3 @@ -0,0 +1,446 @@
    14.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
    14.5 +    ID:         $Id$
    14.6 +    Author:     Gertrud Bauer, TU Munich
    14.7 +*)
    14.8 +
    14.9 +header {* The supremum w.r.t.~the function order *}
   14.10 +
   14.11 +theory HahnBanachSupLemmas
   14.12 +imports FunctionNorm ZornLemma
   14.13 +begin
   14.14 +
   14.15 +text {*
   14.16 +  This section contains some lemmas that will be used in the proof of
   14.17 +  the Hahn-Banach Theorem.  In this section the following context is
   14.18 +  presumed.  Let @{text E} be a real vector space with a seminorm
   14.19 +  @{text p} on @{text E}.  @{text F} is a subspace of @{text E} and
   14.20 +  @{text f} a linear form on @{text F}. We consider a chain @{text c}
   14.21 +  of norm-preserving extensions of @{text f}, such that @{text "\<Union>c =
   14.22 +  graph H h"}.  We will show some properties about the limit function
   14.23 +  @{text h}, i.e.\ the supremum of the chain @{text c}.
   14.24 +
   14.25 +  \medskip Let @{text c} be a chain of norm-preserving extensions of
   14.26 +  the function @{text f} and let @{text "graph H h"} be the supremum
   14.27 +  of @{text c}.  Every element in @{text H} is member of one of the
   14.28 +  elements of the chain.
   14.29 +*}
   14.30 +lemmas [dest?] = chainD
   14.31 +lemmas chainE2 [elim?] = chainD2 [elim_format, standard]
   14.32 +
   14.33 +lemma some_H'h't:
   14.34 +  assumes M: "M = norm_pres_extensions E p F f"
   14.35 +    and cM: "c \<in> chain M"
   14.36 +    and u: "graph H h = \<Union>c"
   14.37 +    and x: "x \<in> H"
   14.38 +  shows "\<exists>H' h'. graph H' h' \<in> c
   14.39 +    \<and> (x, h x) \<in> graph H' h'
   14.40 +    \<and> linearform H' h' \<and> H' \<unlhd> E
   14.41 +    \<and> F \<unlhd> H' \<and> graph F f \<subseteq> graph H' h'
   14.42 +    \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
   14.43 +proof -
   14.44 +  from x have "(x, h x) \<in> graph H h" ..
   14.45 +  also from u have "\<dots> = \<Union>c" .
   14.46 +  finally obtain g where gc: "g \<in> c" and gh: "(x, h x) \<in> g" by blast
   14.47 +
   14.48 +  from cM have "c \<subseteq> M" ..
   14.49 +  with gc have "g \<in> M" ..
   14.50 +  also from M have "\<dots> = norm_pres_extensions E p F f" .
   14.51 +  finally obtain H' and h' where g: "g = graph H' h'"
   14.52 +    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
   14.53 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x" ..
   14.54 +
   14.55 +  from gc and g have "graph H' h' \<in> c" by (simp only:)
   14.56 +  moreover from gh and g have "(x, h x) \<in> graph H' h'" by (simp only:)
   14.57 +  ultimately show ?thesis using * by blast
   14.58 +qed
   14.59 +
   14.60 +text {*
   14.61 +  \medskip Let @{text c} be a chain of norm-preserving extensions of
   14.62 +  the function @{text f} and let @{text "graph H h"} be the supremum
   14.63 +  of @{text c}.  Every element in the domain @{text H} of the supremum
   14.64 +  function is member of the domain @{text H'} of some function @{text
   14.65 +  h'}, such that @{text h} extends @{text h'}.
   14.66 +*}
   14.67 +
   14.68 +lemma some_H'h':
   14.69 +  assumes M: "M = norm_pres_extensions E p F f"
   14.70 +    and cM: "c \<in> chain M"
   14.71 +    and u: "graph H h = \<Union>c"
   14.72 +    and x: "x \<in> H"
   14.73 +  shows "\<exists>H' h'. x \<in> H' \<and> graph H' h' \<subseteq> graph H h
   14.74 +    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
   14.75 +    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
   14.76 +proof -
   14.77 +  from M cM u x obtain H' h' where
   14.78 +      x_hx: "(x, h x) \<in> graph H' h'"
   14.79 +    and c: "graph H' h' \<in> c"
   14.80 +    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
   14.81 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
   14.82 +    by (rule some_H'h't [elim_format]) blast
   14.83 +  from x_hx have "x \<in> H'" ..
   14.84 +  moreover from cM u c have "graph H' h' \<subseteq> graph H h"
   14.85 +    by (simp only: chain_ball_Union_upper)
   14.86 +  ultimately show ?thesis using * by blast
   14.87 +qed
   14.88 +
   14.89 +text {*
   14.90 +  \medskip Any two elements @{text x} and @{text y} in the domain
   14.91 +  @{text H} of the supremum function @{text h} are both in the domain
   14.92 +  @{text H'} of some function @{text h'}, such that @{text h} extends
   14.93 +  @{text h'}.
   14.94 +*}
   14.95 +
   14.96 +lemma some_H'h'2:
   14.97 +  assumes M: "M = norm_pres_extensions E p F f"
   14.98 +    and cM: "c \<in> chain M"
   14.99 +    and u: "graph H h = \<Union>c"
  14.100 +    and x: "x \<in> H"
  14.101 +    and y: "y \<in> H"
  14.102 +  shows "\<exists>H' h'. x \<in> H' \<and> y \<in> H'
  14.103 +    \<and> graph H' h' \<subseteq> graph H h
  14.104 +    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
  14.105 +    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
  14.106 +proof -
  14.107 +  txt {* @{text y} is in the domain @{text H''} of some function @{text h''},
  14.108 +  such that @{text h} extends @{text h''}. *}
  14.109 +
  14.110 +  from M cM u and y obtain H' h' where
  14.111 +      y_hy: "(y, h y) \<in> graph H' h'"
  14.112 +    and c': "graph H' h' \<in> c"
  14.113 +    and * :
  14.114 +      "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
  14.115 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
  14.116 +    by (rule some_H'h't [elim_format]) blast
  14.117 +
  14.118 +  txt {* @{text x} is in the domain @{text H'} of some function @{text h'},
  14.119 +    such that @{text h} extends @{text h'}. *}
  14.120 +
  14.121 +  from M cM u and x obtain H'' h'' where
  14.122 +      x_hx: "(x, h x) \<in> graph H'' h''"
  14.123 +    and c'': "graph H'' h'' \<in> c"
  14.124 +    and ** :
  14.125 +      "linearform H'' h''"  "H'' \<unlhd> E"  "F \<unlhd> H''"
  14.126 +      "graph F f \<subseteq> graph H'' h''"  "\<forall>x \<in> H''. h'' x \<le> p x"
  14.127 +    by (rule some_H'h't [elim_format]) blast
  14.128 +
  14.129 +  txt {* Since both @{text h'} and @{text h''} are elements of the chain,
  14.130 +    @{text h''} is an extension of @{text h'} or vice versa. Thus both
  14.131 +    @{text x} and @{text y} are contained in the greater
  14.132 +    one. \label{cases1}*}
  14.133 +
  14.134 +  from cM c'' c' have "graph H'' h'' \<subseteq> graph H' h' \<or> graph H' h' \<subseteq> graph H'' h''"
  14.135 +    (is "?case1 \<or> ?case2") ..
  14.136 +  then show ?thesis
  14.137 +  proof
  14.138 +    assume ?case1
  14.139 +    have "(x, h x) \<in> graph H'' h''" by fact
  14.140 +    also have "\<dots> \<subseteq> graph H' h'" by fact
  14.141 +    finally have xh:"(x, h x) \<in> graph H' h'" .
  14.142 +    then have "x \<in> H'" ..
  14.143 +    moreover from y_hy have "y \<in> H'" ..
  14.144 +    moreover from cM u and c' have "graph H' h' \<subseteq> graph H h"
  14.145 +      by (simp only: chain_ball_Union_upper)
  14.146 +    ultimately show ?thesis using * by blast
  14.147 +  next
  14.148 +    assume ?case2
  14.149 +    from x_hx have "x \<in> H''" ..
  14.150 +    moreover {
  14.151 +      have "(y, h y) \<in> graph H' h'" by (rule y_hy)
  14.152 +      also have "\<dots> \<subseteq> graph H'' h''" by fact
  14.153 +      finally have "(y, h y) \<in> graph H'' h''" .
  14.154 +    } then have "y \<in> H''" ..
  14.155 +    moreover from cM u and c'' have "graph H'' h'' \<subseteq> graph H h"
  14.156 +      by (simp only: chain_ball_Union_upper)
  14.157 +    ultimately show ?thesis using ** by blast
  14.158 +  qed
  14.159 +qed
  14.160 +
  14.161 +text {*
  14.162 +  \medskip The relation induced by the graph of the supremum of a
  14.163 +  chain @{text c} is definite, i.~e.~t is the graph of a function.
  14.164 +*}
  14.165 +
  14.166 +lemma sup_definite:
  14.167 +  assumes M_def: "M \<equiv> norm_pres_extensions E p F f"
  14.168 +    and cM: "c \<in> chain M"
  14.169 +    and xy: "(x, y) \<in> \<Union>c"
  14.170 +    and xz: "(x, z) \<in> \<Union>c"
  14.171 +  shows "z = y"
  14.172 +proof -
  14.173 +  from cM have c: "c \<subseteq> M" ..
  14.174 +  from xy obtain G1 where xy': "(x, y) \<in> G1" and G1: "G1 \<in> c" ..
  14.175 +  from xz obtain G2 where xz': "(x, z) \<in> G2" and G2: "G2 \<in> c" ..
  14.176 +
  14.177 +  from G1 c have "G1 \<in> M" ..
  14.178 +  then obtain H1 h1 where G1_rep: "G1 = graph H1 h1"
  14.179 +    unfolding M_def by blast
  14.180 +
  14.181 +  from G2 c have "G2 \<in> M" ..
  14.182 +  then obtain H2 h2 where G2_rep: "G2 = graph H2 h2"
  14.183 +    unfolding M_def by blast
  14.184 +
  14.185 +  txt {* @{text "G\<^sub>1"} is contained in @{text "G\<^sub>2"}
  14.186 +    or vice versa, since both @{text "G\<^sub>1"} and @{text
  14.187 +    "G\<^sub>2"} are members of @{text c}. \label{cases2}*}
  14.188 +
  14.189 +  from cM G1 G2 have "G1 \<subseteq> G2 \<or> G2 \<subseteq> G1" (is "?case1 \<or> ?case2") ..
  14.190 +  then show ?thesis
  14.191 +  proof
  14.192 +    assume ?case1
  14.193 +    with xy' G2_rep have "(x, y) \<in> graph H2 h2" by blast
  14.194 +    then have "y = h2 x" ..
  14.195 +    also
  14.196 +    from xz' G2_rep have "(x, z) \<in> graph H2 h2" by (simp only:)
  14.197 +    then have "z = h2 x" ..
  14.198 +    finally show ?thesis .
  14.199 +  next
  14.200 +    assume ?case2
  14.201 +    with xz' G1_rep have "(x, z) \<in> graph H1 h1" by blast
  14.202 +    then have "z = h1 x" ..
  14.203 +    also
  14.204 +    from xy' G1_rep have "(x, y) \<in> graph H1 h1" by (simp only:)
  14.205 +    then have "y = h1 x" ..
  14.206 +    finally show ?thesis ..
  14.207 +  qed
  14.208 +qed
  14.209 +
  14.210 +text {*
  14.211 +  \medskip The limit function @{text h} is linear. Every element
  14.212 +  @{text x} in the domain of @{text h} is in the domain of a function
  14.213 +  @{text h'} in the chain of norm preserving extensions.  Furthermore,
  14.214 +  @{text h} is an extension of @{text h'} so the function values of
  14.215 +  @{text x} are identical for @{text h'} and @{text h}.  Finally, the
  14.216 +  function @{text h'} is linear by construction of @{text M}.
  14.217 +*}
  14.218 +
  14.219 +lemma sup_lf:
  14.220 +  assumes M: "M = norm_pres_extensions E p F f"
  14.221 +    and cM: "c \<in> chain M"
  14.222 +    and u: "graph H h = \<Union>c"
  14.223 +  shows "linearform H h"
  14.224 +proof
  14.225 +  fix x y assume x: "x \<in> H" and y: "y \<in> H"
  14.226 +  with M cM u obtain H' h' where
  14.227 +        x': "x \<in> H'" and y': "y \<in> H'"
  14.228 +      and b: "graph H' h' \<subseteq> graph H h"
  14.229 +      and linearform: "linearform H' h'"
  14.230 +      and subspace: "H' \<unlhd> E"
  14.231 +    by (rule some_H'h'2 [elim_format]) blast
  14.232 +
  14.233 +  show "h (x + y) = h x + h y"
  14.234 +  proof -
  14.235 +    from linearform x' y' have "h' (x + y) = h' x + h' y"
  14.236 +      by (rule linearform.add)
  14.237 +    also from b x' have "h' x = h x" ..
  14.238 +    also from b y' have "h' y = h y" ..
  14.239 +    also from subspace x' y' have "x + y \<in> H'"
  14.240 +      by (rule subspace.add_closed)
  14.241 +    with b have "h' (x + y) = h (x + y)" ..
  14.242 +    finally show ?thesis .
  14.243 +  qed
  14.244 +next
  14.245 +  fix x a assume x: "x \<in> H"
  14.246 +  with M cM u obtain H' h' where
  14.247 +        x': "x \<in> H'"
  14.248 +      and b: "graph H' h' \<subseteq> graph H h"
  14.249 +      and linearform: "linearform H' h'"
  14.250 +      and subspace: "H' \<unlhd> E"
  14.251 +    by (rule some_H'h' [elim_format]) blast
  14.252 +
  14.253 +  show "h (a \<cdot> x) = a * h x"
  14.254 +  proof -
  14.255 +    from linearform x' have "h' (a \<cdot> x) = a * h' x"
  14.256 +      by (rule linearform.mult)
  14.257 +    also from b x' have "h' x = h x" ..
  14.258 +    also from subspace x' have "a \<cdot> x \<in> H'"
  14.259 +      by (rule subspace.mult_closed)
  14.260 +    with b have "h' (a \<cdot> x) = h (a \<cdot> x)" ..
  14.261 +    finally show ?thesis .
  14.262 +  qed
  14.263 +qed
  14.264 +
  14.265 +text {*
  14.266 +  \medskip The limit of a non-empty chain of norm preserving
  14.267 +  extensions of @{text f} is an extension of @{text f}, since every
  14.268 +  element of the chain is an extension of @{text f} and the supremum
  14.269 +  is an extension for every element of the chain.
  14.270 +*}
  14.271 +
  14.272 +lemma sup_ext:
  14.273 +  assumes graph: "graph H h = \<Union>c"
  14.274 +    and M: "M = norm_pres_extensions E p F f"
  14.275 +    and cM: "c \<in> chain M"
  14.276 +    and ex: "\<exists>x. x \<in> c"
  14.277 +  shows "graph F f \<subseteq> graph H h"
  14.278 +proof -
  14.279 +  from ex obtain x where xc: "x \<in> c" ..
  14.280 +  from cM have "c \<subseteq> M" ..
  14.281 +  with xc have "x \<in> M" ..
  14.282 +  with M have "x \<in> norm_pres_extensions E p F f"
  14.283 +    by (simp only:)
  14.284 +  then obtain G g where "x = graph G g" and "graph F f \<subseteq> graph G g" ..
  14.285 +  then have "graph F f \<subseteq> x" by (simp only:)
  14.286 +  also from xc have "\<dots> \<subseteq> \<Union>c" by blast
  14.287 +  also from graph have "\<dots> = graph H h" ..
  14.288 +  finally show ?thesis .
  14.289 +qed
  14.290 +
  14.291 +text {*
  14.292 +  \medskip The domain @{text H} of the limit function is a superspace
  14.293 +  of @{text F}, since @{text F} is a subset of @{text H}. The
  14.294 +  existence of the @{text 0} element in @{text F} and the closure
  14.295 +  properties follow from the fact that @{text F} is a vector space.
  14.296 +*}
  14.297 +
  14.298 +lemma sup_supF:
  14.299 +  assumes graph: "graph H h = \<Union>c"
  14.300 +    and M: "M = norm_pres_extensions E p F f"
  14.301 +    and cM: "c \<in> chain M"
  14.302 +    and ex: "\<exists>x. x \<in> c"
  14.303 +    and FE: "F \<unlhd> E"
  14.304 +  shows "F \<unlhd> H"
  14.305 +proof
  14.306 +  from FE show "F \<noteq> {}" by (rule subspace.non_empty)
  14.307 +  from graph M cM ex have "graph F f \<subseteq> graph H h" by (rule sup_ext)
  14.308 +  then show "F \<subseteq> H" ..
  14.309 +  fix x y assume "x \<in> F" and "y \<in> F"
  14.310 +  with FE show "x + y \<in> F" by (rule subspace.add_closed)
  14.311 +next
  14.312 +  fix x a assume "x \<in> F"
  14.313 +  with FE show "a \<cdot> x \<in> F" by (rule subspace.mult_closed)
  14.314 +qed
  14.315 +
  14.316 +text {*
  14.317 +  \medskip The domain @{text H} of the limit function is a subspace of
  14.318 +  @{text E}.
  14.319 +*}
  14.320 +
  14.321 +lemma sup_subE:
  14.322 +  assumes graph: "graph H h = \<Union>c"
  14.323 +    and M: "M = norm_pres_extensions E p F f"
  14.324 +    and cM: "c \<in> chain M"
  14.325 +    and ex: "\<exists>x. x \<in> c"
  14.326 +    and FE: "F \<unlhd> E"
  14.327 +    and E: "vectorspace E"
  14.328 +  shows "H \<unlhd> E"
  14.329 +proof
  14.330 +  show "H \<noteq> {}"
  14.331 +  proof -
  14.332 +    from FE E have "0 \<in> F" by (rule subspace.zero)
  14.333 +    also from graph M cM ex FE have "F \<unlhd> H" by (rule sup_supF)
  14.334 +    then have "F \<subseteq> H" ..
  14.335 +    finally show ?thesis by blast
  14.336 +  qed
  14.337 +  show "H \<subseteq> E"
  14.338 +  proof
  14.339 +    fix x assume "x \<in> H"
  14.340 +    with M cM graph
  14.341 +    obtain H' h' where x: "x \<in> H'" and H'E: "H' \<unlhd> E"
  14.342 +      by (rule some_H'h' [elim_format]) blast
  14.343 +    from H'E have "H' \<subseteq> E" ..
  14.344 +    with x show "x \<in> E" ..
  14.345 +  qed
  14.346 +  fix x y assume x: "x \<in> H" and y: "y \<in> H"
  14.347 +  show "x + y \<in> H"
  14.348 +  proof -
  14.349 +    from M cM graph x y obtain H' h' where
  14.350 +          x': "x \<in> H'" and y': "y \<in> H'" and H'E: "H' \<unlhd> E"
  14.351 +        and graphs: "graph H' h' \<subseteq> graph H h"
  14.352 +      by (rule some_H'h'2 [elim_format]) blast
  14.353 +    from H'E x' y' have "x + y \<in> H'"
  14.354 +      by (rule subspace.add_closed)
  14.355 +    also from graphs have "H' \<subseteq> H" ..
  14.356 +    finally show ?thesis .
  14.357 +  qed
  14.358 +next
  14.359 +  fix x a assume x: "x \<in> H"
  14.360 +  show "a \<cdot> x \<in> H"
  14.361 +  proof -
  14.362 +    from M cM graph x
  14.363 +    obtain H' h' where x': "x \<in> H'" and H'E: "H' \<unlhd> E"
  14.364 +        and graphs: "graph H' h' \<subseteq> graph H h"
  14.365 +      by (rule some_H'h' [elim_format]) blast
  14.366 +    from H'E x' have "a \<cdot> x \<in> H'" by (rule subspace.mult_closed)
  14.367 +    also from graphs have "H' \<subseteq> H" ..
  14.368 +    finally show ?thesis .
  14.369 +  qed
  14.370 +qed
  14.371 +
  14.372 +text {*
  14.373 +  \medskip The limit function is bounded by the norm @{text p} as
  14.374 +  well, since all elements in the chain are bounded by @{text p}.
  14.375 +*}
  14.376 +
  14.377 +lemma sup_norm_pres:
  14.378 +  assumes graph: "graph H h = \<Union>c"
  14.379 +    and M: "M = norm_pres_extensions E p F f"
  14.380 +    and cM: "c \<in> chain M"
  14.381 +  shows "\<forall>x \<in> H. h x \<le> p x"
  14.382 +proof
  14.383 +  fix x assume "x \<in> H"
  14.384 +  with M cM graph obtain H' h' where x': "x \<in> H'"
  14.385 +      and graphs: "graph H' h' \<subseteq> graph H h"
  14.386 +      and a: "\<forall>x \<in> H'. h' x \<le> p x"
  14.387 +    by (rule some_H'h' [elim_format]) blast
  14.388 +  from graphs x' have [symmetric]: "h' x = h x" ..
  14.389 +  also from a x' have "h' x \<le> p x " ..
  14.390 +  finally show "h x \<le> p x" .
  14.391 +qed
  14.392 +
  14.393 +text {*
  14.394 +  \medskip The following lemma is a property of linear forms on real
  14.395 +  vector spaces. It will be used for the lemma @{text abs_HahnBanach}
  14.396 +  (see page \pageref{abs-HahnBanach}). \label{abs-ineq-iff} For real
  14.397 +  vector spaces the following inequations are equivalent:
  14.398 +  \begin{center}
  14.399 +  \begin{tabular}{lll}
  14.400 +  @{text "\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x"} & and &
  14.401 +  @{text "\<forall>x \<in> H. h x \<le> p x"} \\
  14.402 +  \end{tabular}
  14.403 +  \end{center}
  14.404 +*}
  14.405 +
  14.406 +lemma abs_ineq_iff:
  14.407 +  assumes "subspace H E" and "vectorspace E" and "seminorm E p"
  14.408 +    and "linearform H h"
  14.409 +  shows "(\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x) = (\<forall>x \<in> H. h x \<le> p x)" (is "?L = ?R")
  14.410 +proof
  14.411 +  interpret subspace [H E] by fact
  14.412 +  interpret vectorspace [E] by fact
  14.413 +  interpret seminorm [E p] by fact
  14.414 +  interpret linearform [H h] by fact
  14.415 +  have H: "vectorspace H" using `vectorspace E` ..
  14.416 +  {
  14.417 +    assume l: ?L
  14.418 +    show ?R
  14.419 +    proof
  14.420 +      fix x assume x: "x \<in> H"
  14.421 +      have "h x \<le> \<bar>h x\<bar>" by arith
  14.422 +      also from l x have "\<dots> \<le> p x" ..
  14.423 +      finally show "h x \<le> p x" .
  14.424 +    qed
  14.425 +  next
  14.426 +    assume r: ?R
  14.427 +    show ?L
  14.428 +    proof
  14.429 +      fix x assume x: "x \<in> H"
  14.430 +      show "\<And>a b :: real. - a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> \<bar>b\<bar> \<le> a"
  14.431 +        by arith
  14.432 +      from `linearform H h` and H x
  14.433 +      have "- h x = h (- x)" by (rule linearform.neg [symmetric])
  14.434 +      also
  14.435 +      from H x have "- x \<in> H" by (rule vectorspace.neg_closed)
  14.436 +      with r have "h (- x) \<le> p (- x)" ..
  14.437 +      also have "\<dots> = p x"
  14.438 +	using `seminorm E p` `vectorspace E`
  14.439 +      proof (rule seminorm.minus)
  14.440 +        from x show "x \<in> E" ..
  14.441 +      qed
  14.442 +      finally have "- h x \<le> p x" .
  14.443 +      then show "- p x \<le> h x" by simp
  14.444 +      from r x show "h x \<le> p x" ..
  14.445 +    qed
  14.446 +  }
  14.447 +qed
  14.448 +
  14.449 +end
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/HahnBanach/Linearform.thy	Mon Dec 29 14:08:08 2008 +0100
    15.3 @@ -0,0 +1,61 @@
    15.4 +(*  Title:      HOL/Real/HahnBanach/Linearform.thy
    15.5 +    ID:         $Id$
    15.6 +    Author:     Gertrud Bauer, TU Munich
    15.7 +*)
    15.8 +
    15.9 +header {* Linearforms *}
   15.10 +
   15.11 +theory Linearform
   15.12 +imports VectorSpace
   15.13 +begin
   15.14 +
   15.15 +text {*
   15.16 +  A \emph{linear form} is a function on a vector space into the reals
   15.17 +  that is additive and multiplicative.
   15.18 +*}
   15.19 +
   15.20 +locale linearform = var V + var f +
   15.21 +  constrains V :: "'a\<Colon>{minus, plus, zero, uminus} set"
   15.22 +  assumes add [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> f (x + y) = f x + f y"
   15.23 +    and mult [iff]: "x \<in> V \<Longrightarrow> f (a \<cdot> x) = a * f x"
   15.24 +
   15.25 +declare linearform.intro [intro?]
   15.26 +
   15.27 +lemma (in linearform) neg [iff]:
   15.28 +  assumes "vectorspace V"
   15.29 +  shows "x \<in> V \<Longrightarrow> f (- x) = - f x"
   15.30 +proof -
   15.31 +  interpret vectorspace [V] by fact
   15.32 +  assume x: "x \<in> V"
   15.33 +  then have "f (- x) = f ((- 1) \<cdot> x)" by (simp add: negate_eq1)
   15.34 +  also from x have "\<dots> = (- 1) * (f x)" by (rule mult)
   15.35 +  also from x have "\<dots> = - (f x)" by simp
   15.36 +  finally show ?thesis .
   15.37 +qed
   15.38 +
   15.39 +lemma (in linearform) diff [iff]:
   15.40 +  assumes "vectorspace V"
   15.41 +  shows "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> f (x - y) = f x - f y"
   15.42 +proof -
   15.43 +  interpret vectorspace [V] by fact
   15.44 +  assume x: "x \<in> V" and y: "y \<in> V"
   15.45 +  then have "x - y = x + - y" by (rule diff_eq1)
   15.46 +  also have "f \<dots> = f x + f (- y)" by (rule add) (simp_all add: x y)
   15.47 +  also have "f (- y) = - f y" using `vectorspace V` y by (rule neg)
   15.48 +  finally show ?thesis by simp
   15.49 +qed
   15.50 +
   15.51 +text {* Every linear form yields @{text 0} for the @{text 0} vector. *}
   15.52 +
   15.53 +lemma (in linearform) zero [iff]:
   15.54 +  assumes "vectorspace V"
   15.55 +  shows "f 0 = 0"
   15.56 +proof -
   15.57 +  interpret vectorspace [V] by fact
   15.58 +  have "f 0 = f (0 - 0)" by simp
   15.59 +  also have "\<dots> = f 0 - f 0" using `vectorspace V` by (rule diff) simp_all
   15.60 +  also have "\<dots> = 0" by simp
   15.61 +  finally show ?thesis .
   15.62 +qed
   15.63 +
   15.64 +end
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOL/HahnBanach/NormedSpace.thy	Mon Dec 29 14:08:08 2008 +0100
    16.3 @@ -0,0 +1,118 @@
    16.4 +(*  Title:      HOL/Real/HahnBanach/NormedSpace.thy
    16.5 +    ID:         $Id$
    16.6 +    Author:     Gertrud Bauer, TU Munich
    16.7 +*)
    16.8 +
    16.9 +header {* Normed vector spaces *}
   16.10 +
   16.11 +theory NormedSpace
   16.12 +imports Subspace
   16.13 +begin
   16.14 +
   16.15 +subsection {* Quasinorms *}
   16.16 +
   16.17 +text {*
   16.18 +  A \emph{seminorm} @{text "\<parallel>\<cdot>\<parallel>"} is a function on a real vector space
   16.19 +  into the reals that has the following properties: it is positive
   16.20 +  definite, absolute homogenous and subadditive.
   16.21 +*}
   16.22 +
   16.23 +locale norm_syntax =
   16.24 +  fixes norm :: "'a \<Rightarrow> real"    ("\<parallel>_\<parallel>")
   16.25 +
   16.26 +locale seminorm = var V + norm_syntax +
   16.27 +  constrains V :: "'a\<Colon>{minus, plus, zero, uminus} set"
   16.28 +  assumes ge_zero [iff?]: "x \<in> V \<Longrightarrow> 0 \<le> \<parallel>x\<parallel>"
   16.29 +    and abs_homogenous [iff?]: "x \<in> V \<Longrightarrow> \<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>"
   16.30 +    and subadditive [iff?]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> \<parallel>x + y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>"
   16.31 +
   16.32 +declare seminorm.intro [intro?]
   16.33 +
   16.34 +lemma (in seminorm) diff_subadditive:
   16.35 +  assumes "vectorspace V"
   16.36 +  shows "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> \<parallel>x - y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>"
   16.37 +proof -
   16.38 +  interpret vectorspace [V] by fact
   16.39 +  assume x: "x \<in> V" and y: "y \<in> V"
   16.40 +  then have "x - y = x + - 1 \<cdot> y"
   16.41 +    by (simp add: diff_eq2 negate_eq2a)
   16.42 +  also from x y have "\<parallel>\<dots>\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>- 1 \<cdot> y\<parallel>"
   16.43 +    by (simp add: subadditive)
   16.44 +  also from y have "\<parallel>- 1 \<cdot> y\<parallel> = \<bar>- 1\<bar> * \<parallel>y\<parallel>"
   16.45 +    by (rule abs_homogenous)
   16.46 +  also have "\<dots> = \<parallel>y\<parallel>" by simp
   16.47 +  finally show ?thesis .
   16.48 +qed
   16.49 +
   16.50 +lemma (in seminorm) minus:
   16.51 +  assumes "vectorspace V"
   16.52 +  shows "x \<in> V \<Longrightarrow> \<parallel>- x\<parallel> = \<parallel>x\<parallel>"
   16.53 +proof -
   16.54 +  interpret vectorspace [V] by fact
   16.55 +  assume x: "x \<in> V"
   16.56 +  then have "- x = - 1 \<cdot> x" by (simp only: negate_eq1)
   16.57 +  also from x have "\<parallel>\<dots>\<parallel> = \<bar>- 1\<bar> * \<parallel>x\<parallel>"
   16.58 +    by (rule abs_homogenous)
   16.59 +  also have "\<dots> = \<parallel>x\<parallel>" by simp
   16.60 +  finally show ?thesis .
   16.61 +qed
   16.62 +
   16.63 +
   16.64 +subsection {* Norms *}
   16.65 +
   16.66 +text {*
   16.67 +  A \emph{norm} @{text "\<parallel>\<cdot>\<parallel>"} is a seminorm that maps only the
   16.68 +  @{text 0} vector to @{text 0}.
   16.69 +*}
   16.70 +
   16.71 +locale norm = seminorm +
   16.72 +  assumes zero_iff [iff]: "x \<in> V \<Longrightarrow> (\<parallel>x\<parallel> = 0) = (x = 0)"
   16.73 +
   16.74 +
   16.75 +subsection {* Normed vector spaces *}
   16.76 +
   16.77 +text {*
   16.78 +  A vector space together with a norm is called a \emph{normed
   16.79 +  space}.
   16.80 +*}
   16.81 +
   16.82 +locale normed_vectorspace = vectorspace + norm
   16.83 +
   16.84 +declare normed_vectorspace.intro [intro?]
   16.85 +
   16.86 +lemma (in normed_vectorspace) gt_zero [intro?]:
   16.87 +  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> 0 < \<parallel>x\<parallel>"
   16.88 +proof -
   16.89 +  assume x: "x \<in> V" and neq: "x \<noteq> 0"
   16.90 +  from x have "0 \<le> \<parallel>x\<parallel>" ..
   16.91 +  also have [symmetric]: "\<dots> \<noteq> 0"
   16.92 +  proof
   16.93 +    assume "\<parallel>x\<parallel> = 0"
   16.94 +    with x have "x = 0" by simp
   16.95 +    with neq show False by contradiction
   16.96 +  qed
   16.97 +  finally show ?thesis .
   16.98 +qed
   16.99 +
  16.100 +text {*
  16.101 +  Any subspace of a normed vector space is again a normed vectorspace.
  16.102 +*}
  16.103 +
  16.104 +lemma subspace_normed_vs [intro?]:
  16.105 +  fixes F E norm
  16.106 +  assumes "subspace F E" "normed_vectorspace E norm"
  16.107 +  shows "normed_vectorspace F norm"
  16.108 +proof -
  16.109 +  interpret subspace [F E] by fact
  16.110 +  interpret normed_vectorspace [E norm] by fact
  16.111 +  show ?thesis
  16.112 +  proof
  16.113 +    show "vectorspace F" by (rule vectorspace) unfold_locales
  16.114 +  next
  16.115 +    have "NormedSpace.norm E norm" ..
  16.116 +    with subset show "NormedSpace.norm F norm"
  16.117 +      by (simp add: norm_def seminorm_def norm_axioms_def)
  16.118 +  qed
  16.119 +qed
  16.120 +
  16.121 +end
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOL/HahnBanach/README.html	Mon Dec 29 14:08:08 2008 +0100
    17.3 @@ -0,0 +1,38 @@
    17.4 +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
    17.5 +
    17.6 +<!-- $Id$ -->
    17.7 +
    17.8 +<HTML>
    17.9 +
   17.10 +<HEAD>
   17.11 +  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
   17.12 +  <TITLE>HOL/Real/HahnBanach/README</TITLE>
   17.13 +</HEAD>
   17.14 +
   17.15 +<BODY>
   17.16 +
   17.17 +<H3>The Hahn-Banach Theorem for Real Vector Spaces (Isabelle/Isar)</H3>
   17.18 +
   17.19 +Author: Gertrud Bauer, Technische Universit&auml;t M&uuml;nchen<P>
   17.20 +
   17.21 +This directory contains the proof of the Hahn-Banach theorem for real vectorspaces,
   17.22 +following H. Heuser, Funktionalanalysis, p. 228 -232.
   17.23 +The Hahn-Banach theorem is one of the fundamental theorems of functioal analysis.
   17.24 +It is a conclusion of Zorn's lemma.<P>
   17.25 +
   17.26 +Two different formaulations of the theorem are presented, one for general real vectorspaces
   17.27 +and its application to normed vectorspaces. <P>
   17.28 +
   17.29 +The theorem says, that every continous linearform, defined on arbitrary subspaces
   17.30 +(not only one-dimensional subspaces), can be extended to a continous linearform on
   17.31 +the whole vectorspace.
   17.32 +
   17.33 +
   17.34 +<HR>
   17.35 +
   17.36 +<ADDRESS>
   17.37 +<A NAME="bauerg@in.tum.de" HREF="mailto:bauerg@in.tum.de">bauerg@in.tum.de</A>
   17.38 +</ADDRESS>
   17.39 +
   17.40 +</BODY>
   17.41 +</HTML>
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/HOL/HahnBanach/ROOT.ML	Mon Dec 29 14:08:08 2008 +0100
    18.3 @@ -0,0 +1,8 @@
    18.4 +(*  Title:      HOL/Real/HahnBanach/ROOT.ML
    18.5 +    ID:         $Id$
    18.6 +    Author:     Gertrud Bauer, TU Munich
    18.7 +
    18.8 +The Hahn-Banach theorem for real vector spaces (Isabelle/Isar).
    18.9 +*)
   18.10 +
   18.11 +time_use_thy "HahnBanach";
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/HOL/HahnBanach/Subspace.thy	Mon Dec 29 14:08:08 2008 +0100
    19.3 @@ -0,0 +1,514 @@
    19.4 +(*  Title:      HOL/Real/HahnBanach/Subspace.thy
    19.5 +    ID:         $Id$
    19.6 +    Author:     Gertrud Bauer, TU Munich
    19.7 +*)
    19.8 +
    19.9 +header {* Subspaces *}
   19.10 +
   19.11 +theory Subspace
   19.12 +imports VectorSpace
   19.13 +begin
   19.14 +
   19.15 +subsection {* Definition *}
   19.16 +
   19.17 +text {*
   19.18 +  A non-empty subset @{text U} of a vector space @{text V} is a
   19.19 +  \emph{subspace} of @{text V}, iff @{text U} is closed under addition
   19.20 +  and scalar multiplication.
   19.21 +*}
   19.22 +
   19.23 +locale subspace = var U + var V +
   19.24 +  constrains U :: "'a\<Colon>{minus, plus, zero, uminus} set"
   19.25 +  assumes non_empty [iff, intro]: "U \<noteq> {}"
   19.26 +    and subset [iff]: "U \<subseteq> V"
   19.27 +    and add_closed [iff]: "x \<in> U \<Longrightarrow> y \<in> U \<Longrightarrow> x + y \<in> U"
   19.28 +    and mult_closed [iff]: "x \<in> U \<Longrightarrow> a \<cdot> x \<in> U"
   19.29 +
   19.30 +notation (symbols)
   19.31 +  subspace  (infix "\<unlhd>" 50)
   19.32 +
   19.33 +declare vectorspace.intro [intro?] subspace.intro [intro?]
   19.34 +
   19.35 +lemma subspace_subset [elim]: "U \<unlhd> V \<Longrightarrow> U \<subseteq> V"
   19.36 +  by (rule subspace.subset)
   19.37 +
   19.38 +lemma (in subspace) subsetD [iff]: "x \<in> U \<Longrightarrow> x \<in> V"
   19.39 +  using subset by blast
   19.40 +
   19.41 +lemma subspaceD [elim]: "U \<unlhd> V \<Longrightarrow> x \<in> U \<Longrightarrow> x \<in> V"
   19.42 +  by (rule subspace.subsetD)
   19.43 +
   19.44 +lemma rev_subspaceD [elim?]: "x \<in> U \<Longrightarrow> U \<unlhd> V \<Longrightarrow> x \<in> V"
   19.45 +  by (rule subspace.subsetD)
   19.46 +
   19.47 +lemma (in subspace) diff_closed [iff]:
   19.48 +  assumes "vectorspace V"
   19.49 +  assumes x: "x \<in> U" and y: "y \<in> U"
   19.50 +  shows "x - y \<in> U"
   19.51 +proof -
   19.52 +  interpret vectorspace [V] by fact
   19.53 +  from x y show ?thesis by (simp add: diff_eq1 negate_eq1)
   19.54 +qed
   19.55 +
   19.56 +text {*
   19.57 +  \medskip Similar as for linear spaces, the existence of the zero
   19.58 +  element in every subspace follows from the non-emptiness of the
   19.59 +  carrier set and by vector space laws.
   19.60 +*}
   19.61 +
   19.62 +lemma (in subspace) zero [intro]:
   19.63 +  assumes "vectorspace V"
   19.64 +  shows "0 \<in> U"
   19.65 +proof -
   19.66 +  interpret vectorspace [V] by fact
   19.67 +  have "U \<noteq> {}" by (rule U_V.non_empty)
   19.68 +  then obtain x where x: "x \<in> U" by blast
   19.69 +  then have "x \<in> V" .. then have "0 = x - x" by simp
   19.70 +  also from `vectorspace V` x x have "\<dots> \<in> U" by (rule U_V.diff_closed)
   19.71 +  finally show ?thesis .
   19.72 +qed
   19.73 +
   19.74 +lemma (in subspace) neg_closed [iff]:
   19.75 +  assumes "vectorspace V"
   19.76 +  assumes x: "x \<in> U"
   19.77 +  shows "- x \<in> U"
   19.78 +proof -
   19.79 +  interpret vectorspace [V] by fact
   19.80 +  from x show ?thesis by (simp add: negate_eq1)
   19.81 +qed
   19.82 +
   19.83 +text {* \medskip Further derived laws: every subspace is a vector space. *}
   19.84 +
   19.85 +lemma (in subspace) vectorspace [iff]:
   19.86 +  assumes "vectorspace V"
   19.87 +  shows "vectorspace U"
   19.88 +proof -
   19.89 +  interpret vectorspace [V] by fact
   19.90 +  show ?thesis
   19.91 +  proof
   19.92 +    show "U \<noteq> {}" ..
   19.93 +    fix x y z assume x: "x \<in> U" and y: "y \<in> U" and z: "z \<in> U"
   19.94 +    fix a b :: real
   19.95 +    from x y show "x + y \<in> U" by simp
   19.96 +    from x show "a \<cdot> x \<in> U" by simp
   19.97 +    from x y z show "(x + y) + z = x + (y + z)" by (simp add: add_ac)
   19.98 +    from x y show "x + y = y + x" by (simp add: add_ac)
   19.99 +    from x show "x - x = 0" by simp
  19.100 +    from x show "0 + x = x" by simp
  19.101 +    from x y show "a \<cdot> (x + y) = a \<cdot> x + a \<cdot> y" by (simp add: distrib)
  19.102 +    from x show "(a + b) \<cdot> x = a \<cdot> x + b \<cdot> x" by (simp add: distrib)
  19.103 +    from x show "(a * b) \<cdot> x = a \<cdot> b \<cdot> x" by (simp add: mult_assoc)
  19.104 +    from x show "1 \<cdot> x = x" by simp
  19.105 +    from x show "- x = - 1 \<cdot> x" by (simp add: negate_eq1)
  19.106 +    from x y show "x - y = x + - y" by (simp add: diff_eq1)
  19.107 +  qed
  19.108 +qed
  19.109 +
  19.110 +
  19.111 +text {* The subspace relation is reflexive. *}
  19.112 +
  19.113 +lemma (in vectorspace) subspace_refl [intro]: "V \<unlhd> V"
  19.114 +proof
  19.115 +  show "V \<noteq> {}" ..
  19.116 +  show "V \<subseteq> V" ..
  19.117 +  fix x y assume x: "x \<in> V" and y: "y \<in> V"
  19.118 +  fix a :: real
  19.119 +  from x y show "x + y \<in> V" by simp
  19.120 +  from x show "a \<cdot> x \<in> V" by simp
  19.121 +qed
  19.122 +
  19.123 +text {* The subspace relation is transitive. *}
  19.124 +
  19.125 +lemma (in vectorspace) subspace_trans [trans]:
  19.126 +  "U \<unlhd> V \<Longrightarrow> V \<unlhd> W \<Longrightarrow> U \<unlhd> W"
  19.127 +proof
  19.128 +  assume uv: "U \<unlhd> V" and vw: "V \<unlhd> W"
  19.129 +  from uv show "U \<noteq> {}" by (rule subspace.non_empty)
  19.130 +  show "U \<subseteq> W"
  19.131 +  proof -
  19.132 +    from uv have "U \<subseteq> V" by (rule subspace.subset)
  19.133 +    also from vw have "V \<subseteq> W" by (rule subspace.subset)
  19.134 +    finally show ?thesis .
  19.135 +  qed
  19.136 +  fix x y assume x: "x \<in> U" and y: "y \<in> U"
  19.137 +  from uv and x y show "x + y \<in> U" by (rule subspace.add_closed)
  19.138 +  from uv and x show "\<And>a. a \<cdot> x \<in> U" by (rule subspace.mult_closed)
  19.139 +qed
  19.140 +
  19.141 +
  19.142 +subsection {* Linear closure *}
  19.143 +
  19.144 +text {*
  19.145 +  The \emph{linear closure} of a vector @{text x} is the set of all
  19.146 +  scalar multiples of @{text x}.
  19.147 +*}
  19.148 +
  19.149 +definition
  19.150 +  lin :: "('a::{minus, plus, zero}) \<Rightarrow> 'a set" where
  19.151 +  "lin x = {a \<cdot> x | a. True}"
  19.152 +
  19.153 +lemma linI [intro]: "y = a \<cdot> x \<Longrightarrow> y \<in> lin x"
  19.154 +  unfolding lin_def by blast
  19.155 +
  19.156 +lemma linI' [iff]: "a \<cdot> x \<in> lin x"
  19.157 +  unfolding lin_def by blast
  19.158 +
  19.159 +lemma linE [elim]: "x \<in> lin v \<Longrightarrow> (\<And>a::real. x = a \<cdot> v \<Longrightarrow> C) \<Longrightarrow> C"
  19.160 +  unfolding lin_def by blast
  19.161 +
  19.162 +
  19.163 +text {* Every vector is contained in its linear closure. *}
  19.164 +
  19.165 +lemma (in vectorspace) x_lin_x [iff]: "x \<in> V \<Longrightarrow> x \<in> lin x"
  19.166 +proof -
  19.167 +  assume "x \<in> V"
  19.168 +  then have "x = 1 \<cdot> x" by simp
  19.169 +  also have "\<dots> \<in> lin x" ..
  19.170 +  finally show ?thesis .
  19.171 +qed
  19.172 +
  19.173 +lemma (in vectorspace) "0_lin_x" [iff]: "x \<in> V \<Longrightarrow> 0 \<in> lin x"
  19.174 +proof
  19.175 +  assume "x \<in> V"
  19.176 +  then show "0 = 0 \<cdot> x" by simp
  19.177 +qed
  19.178 +
  19.179 +text {* Any linear closure is a subspace. *}
  19.180 +
  19.181 +lemma (in vectorspace) lin_subspace [intro]:
  19.182 +  "x \<in> V \<Longrightarrow> lin x \<unlhd> V"
  19.183 +proof
  19.184 +  assume x: "x \<in> V"
  19.185 +  then show "lin x \<noteq> {}" by (auto simp add: x_lin_x)
  19.186 +  show "lin x \<subseteq> V"
  19.187 +  proof
  19.188 +    fix x' assume "x' \<in> lin x"
  19.189 +    then obtain a where "x' = a \<cdot> x" ..
  19.190 +    with x show "x' \<in> V" by simp
  19.191 +  qed
  19.192 +  fix x' x'' assume x': "x' \<in> lin x" and x'': "x'' \<in> lin x"
  19.193 +  show "x' + x'' \<in> lin x"
  19.194 +  proof -
  19.195 +    from x' obtain a' where "x' = a' \<cdot> x" ..
  19.196 +    moreover from x'' obtain a'' where "x'' = a'' \<cdot> x" ..
  19.197 +    ultimately have "x' + x'' = (a' + a'') \<cdot> x"
  19.198 +      using x by (simp add: distrib)
  19.199 +    also have "\<dots> \<in> lin x" ..
  19.200 +    finally show ?thesis .
  19.201 +  qed
  19.202 +  fix a :: real
  19.203 +  show "a \<cdot> x' \<in> lin x"
  19.204 +  proof -
  19.205 +    from x' obtain a' where "x' = a' \<cdot> x" ..
  19.206 +    with x have "a \<cdot> x' = (a * a') \<cdot> x" by (simp add: mult_assoc)
  19.207 +    also have "\<dots> \<in> lin x" ..
  19.208 +    finally show ?thesis .
  19.209 +  qed
  19.210 +qed
  19.211 +
  19.212 +
  19.213 +text {* Any linear closure is a vector space. *}
  19.214 +
  19.215 +lemma (in vectorspace) lin_vectorspace [intro]:
  19.216 +  assumes "x \<in> V"
  19.217 +  shows "vectorspace (lin x)"
  19.218 +proof -
  19.219 +  from `x \<in> V` have "subspace (lin x) V"
  19.220 +    by (rule lin_subspace)
  19.221 +  from this and vectorspace_axioms show ?thesis
  19.222 +    by (rule subspace.vectorspace)
  19.223 +qed
  19.224 +
  19.225 +
  19.226 +subsection {* Sum of two vectorspaces *}
  19.227 +
  19.228 +text {*
  19.229 +  The \emph{sum} of two vectorspaces @{text U} and @{text V} is the
  19.230 +  set of all sums of elements from @{text U} and @{text V}.
  19.231 +*}
  19.232 +
  19.233 +instantiation "fun" :: (type, type) plus
  19.234 +begin
  19.235 +
  19.236 +definition
  19.237 +  sum_def: "plus_fun U V = {u + v | u v. u \<in> U \<and> v \<in> V}"  (* FIXME not fully general!? *)
  19.238 +
  19.239 +instance ..
  19.240 +
  19.241 +end
  19.242 +
  19.243 +lemma sumE [elim]:
  19.244 +    "x \<in> U + V \<Longrightarrow> (\<And>u v. x = u + v \<Longrightarrow> u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> C) \<Longrightarrow> C"
  19.245 +  unfolding sum_def by blast
  19.246 +
  19.247 +lemma sumI [intro]:
  19.248 +    "u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> x = u + v \<Longrightarrow> x \<in> U + V"
  19.249 +  unfolding sum_def by blast
  19.250 +
  19.251 +lemma sumI' [intro]:
  19.252 +    "u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> u + v \<in> U + V"
  19.253 +  unfolding sum_def by blast
  19.254 +
  19.255 +text {* @{text U} is a subspace of @{text "U + V"}. *}
  19.256 +
  19.257 +lemma subspace_sum1 [iff]:
  19.258 +  assumes "vectorspace U" "vectorspace V"
  19.259 +  shows "U \<unlhd> U + V"
  19.260 +proof -
  19.261 +  interpret vectorspace [U] by fact
  19.262 +  interpret vectorspace [V] by fact
  19.263 +  show ?thesis
  19.264 +  proof
  19.265 +    show "U \<noteq> {}" ..
  19.266 +    show "U \<subseteq> U + V"
  19.267 +    proof
  19.268 +      fix x assume x: "x \<in> U"
  19.269 +      moreover have "0 \<in> V" ..
  19.270 +      ultimately have "x + 0 \<in> U + V" ..
  19.271 +      with x show "x \<in> U + V" by simp
  19.272 +    qed
  19.273 +    fix x y assume x: "x \<in> U" and "y \<in> U"
  19.274 +    then show "x + y \<in> U" by simp
  19.275 +    from x show "\<And>a. a \<cdot> x \<in> U" by simp
  19.276 +  qed
  19.277 +qed
  19.278 +
  19.279 +text {* The sum of two subspaces is again a subspace. *}
  19.280 +
  19.281 +lemma sum_subspace [intro?]:
  19.282 +  assumes "subspace U E" "vectorspace E" "subspace V E"
  19.283 +  shows "U + V \<unlhd> E"
  19.284 +proof -
  19.285 +  interpret subspace [U E] by fact
  19.286 +  interpret vectorspace [E] by fact
  19.287 +  interpret subspace [V E] by fact
  19.288 +  show ?thesis
  19.289 +  proof
  19.290 +    have "0 \<in> U + V"
  19.291 +    proof
  19.292 +      show "0 \<in> U" using `vectorspace E` ..
  19.293 +      show "0 \<in> V" using `vectorspace E` ..
  19.294 +      show "(0::'a) = 0 + 0" by simp
  19.295 +    qed
  19.296 +    then show "U + V \<noteq> {}" by blast
  19.297 +    show "U + V \<subseteq> E"
  19.298 +    proof
  19.299 +      fix x assume "x \<in> U + V"
  19.300 +      then obtain u v where "x = u + v" and
  19.301 +	"u \<in> U" and "v \<in> V" ..
  19.302 +      then show "x \<in> E" by simp
  19.303 +    qed
  19.304 +    fix x y assume x: "x \<in> U + V" and y: "y \<in> U + V"
  19.305 +    show "x + y \<in> U + V"
  19.306 +    proof -
  19.307 +      from x obtain ux vx where "x = ux + vx" and "ux \<in> U" and "vx \<in> V" ..
  19.308 +      moreover
  19.309 +      from y obtain uy vy where "y = uy + vy" and "uy \<in> U" and "vy \<in> V" ..
  19.310 +      ultimately
  19.311 +      have "ux + uy \<in> U"
  19.312 +	and "vx + vy \<in> V"
  19.313 +	and "x + y = (ux + uy) + (vx + vy)"
  19.314 +	using x y by (simp_all add: add_ac)
  19.315 +      then show ?thesis ..
  19.316 +    qed
  19.317 +    fix a show "a \<cdot> x \<in> U + V"
  19.318 +    proof -
  19.319 +      from x obtain u v where "x = u + v" and "u \<in> U" and "v \<in> V" ..
  19.320 +      then have "a \<cdot> u \<in> U" and "a \<cdot> v \<in> V"
  19.321 +	and "a \<cdot> x = (a \<cdot> u) + (a \<cdot> v)" by (simp_all add: distrib)
  19.322 +      then show ?thesis ..
  19.323 +    qed
  19.324 +  qed
  19.325 +qed
  19.326 +
  19.327 +text{* The sum of two subspaces is a vectorspace. *}
  19.328 +
  19.329 +lemma sum_vs [intro?]:
  19.330 +    "U \<unlhd> E \<Longrightarrow> V \<unlhd> E \<Longrightarrow> vectorspace E \<Longrightarrow> vectorspace (U + V)"
  19.331 +  by (rule subspace.vectorspace) (rule sum_subspace)
  19.332 +
  19.333 +
  19.334 +subsection {* Direct sums *}
  19.335 +
  19.336 +text {*
  19.337 +  The sum of @{text U} and @{text V} is called \emph{direct}, iff the
  19.338 +  zero element is the only common element of @{text U} and @{text
  19.339 +  V}. For every element @{text x} of the direct sum of @{text U} and
  19.340 +  @{text V} the decomposition in @{text "x = u + v"} with
  19.341 +  @{text "u \<in> U"} and @{text "v \<in> V"} is unique.
  19.342 +*}
  19.343 +
  19.344 +lemma decomp:
  19.345 +  assumes "vectorspace E" "subspace U E" "subspace V E"
  19.346 +  assumes direct: "U \<inter> V = {0}"
  19.347 +    and u1: "u1 \<in> U" and u2: "u2 \<in> U"
  19.348 +    and v1: "v1 \<in> V" and v2: "v2 \<in> V"
  19.349 +    and sum: "u1 + v1 = u2 + v2"
  19.350 +  shows "u1 = u2 \<and> v1 = v2"
  19.351 +proof -
  19.352 +  interpret vectorspace [E] by fact
  19.353 +  interpret subspace [U E] by fact
  19.354 +  interpret subspace [V E] by fact
  19.355 +  show ?thesis
  19.356 +  proof
  19.357 +    have U: "vectorspace U"  (* FIXME: use interpret *)
  19.358 +      using `subspace U E` `vectorspace E` by (rule subspace.vectorspace)
  19.359 +    have V: "vectorspace V"
  19.360 +      using `subspace V E` `vectorspace E` by (rule subspace.vectorspace)
  19.361 +    from u1 u2 v1 v2 and sum have eq: "u1 - u2 = v2 - v1"
  19.362 +      by (simp add: add_diff_swap)
  19.363 +    from u1 u2 have u: "u1 - u2 \<in> U"
  19.364 +      by (rule vectorspace.diff_closed [OF U])
  19.365 +    with eq have v': "v2 - v1 \<in> U" by (simp only:)
  19.366 +    from v2 v1 have v: "v2 - v1 \<in> V"
  19.367 +      by (rule vectorspace.diff_closed [OF V])
  19.368 +    with eq have u': " u1 - u2 \<in> V" by (simp only:)
  19.369 +    
  19.370 +    show "u1 = u2"
  19.371 +    proof (rule add_minus_eq)
  19.372 +      from u1 show "u1 \<in> E" ..
  19.373 +      from u2 show "u2 \<in> E" ..
  19.374 +      from u u' and direct show "u1 - u2 = 0" by blast
  19.375 +    qed
  19.376 +    show "v1 = v2"
  19.377 +    proof (rule add_minus_eq [symmetric])
  19.378 +      from v1 show "v1 \<in> E" ..
  19.379 +      from v2 show "v2 \<in> E" ..
  19.380 +      from v v' and direct show "v2 - v1 = 0" by blast
  19.381 +    qed
  19.382 +  qed
  19.383 +qed
  19.384 +
  19.385 +text {*
  19.386 +  An application of the previous lemma will be used in the proof of
  19.387 +  the Hahn-Banach Theorem (see page \pageref{decomp-H-use}): for any
  19.388 +  element @{text "y + a \<cdot> x\<^sub>0"} of the direct sum of a
  19.389 +  vectorspace @{text H} and the linear closure of @{text "x\<^sub>0"}
  19.390 +  the components @{text "y \<in> H"} and @{text a} are uniquely
  19.391 +  determined.
  19.392 +*}
  19.393 +
  19.394 +lemma decomp_H':
  19.395 +  assumes "vectorspace E" "subspace H E"
  19.396 +  assumes y1: "y1 \<in> H" and y2: "y2 \<in> H"
  19.397 +    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
  19.398 +    and eq: "y1 + a1 \<cdot> x' = y2 + a2 \<cdot> x'"
  19.399 +  shows "y1 = y2 \<and> a1 = a2"
  19.400 +proof -
  19.401 +  interpret vectorspace [E] by fact
  19.402 +  interpret subspace [H E] by fact
  19.403 +  show ?thesis
  19.404 +  proof
  19.405 +    have c: "y1 = y2 \<and> a1 \<cdot> x' = a2 \<cdot> x'"
  19.406 +    proof (rule decomp)
  19.407 +      show "a1 \<cdot> x' \<in> lin x'" ..
  19.408 +      show "a2 \<cdot> x' \<in> lin x'" ..
  19.409 +      show "H \<inter> lin x' = {0}"
  19.410 +      proof
  19.411 +	show "H \<inter> lin x' \<subseteq> {0}"
  19.412 +	proof
  19.413 +          fix x assume x: "x \<in> H \<inter> lin x'"
  19.414 +          then obtain a where xx': "x = a \<cdot> x'"
  19.415 +            by blast
  19.416 +          have "x = 0"
  19.417 +          proof cases
  19.418 +            assume "a = 0"
  19.419 +            with xx' and x' show ?thesis by simp
  19.420 +          next
  19.421 +            assume a: "a \<noteq> 0"
  19.422 +            from x have "x \<in> H" ..
  19.423 +            with xx' have "inverse a \<cdot> a \<cdot> x' \<in> H" by simp
  19.424 +            with a and x' have "x' \<in> H" by (simp add: mult_assoc2)
  19.425 +            with `x' \<notin> H` show ?thesis by contradiction
  19.426 +          qed
  19.427 +          then show "x \<in> {0}" ..
  19.428 +	qed
  19.429 +	show "{0} \<subseteq> H \<inter> lin x'"
  19.430 +	proof -
  19.431 +          have "0 \<in> H" using `vectorspace E` ..
  19.432 +          moreover have "0 \<in> lin x'" using `x' \<in> E` ..
  19.433 +          ultimately show ?thesis by blast
  19.434 +	qed
  19.435 +      qed
  19.436 +      show "lin x' \<unlhd> E" using `x' \<in> E` ..
  19.437 +    qed (rule `vectorspace E`, rule `subspace H E`, rule y1, rule y2, rule eq)
  19.438 +    then show "y1 = y2" ..
  19.439 +    from c have "a1 \<cdot> x' = a2 \<cdot> x'" ..
  19.440 +    with x' show "a1 = a2" by (simp add: mult_right_cancel)
  19.441 +  qed
  19.442 +qed
  19.443 +
  19.444 +text {*
  19.445 +  Since for any element @{text "y + a \<cdot> x'"} of the direct sum of a
  19.446 +  vectorspace @{text H} and the linear closure of @{text x'} the
  19.447 +  components @{text "y \<in> H"} and @{text a} are unique, it follows from
  19.448 +  @{text "y \<in> H"} that @{text "a = 0"}.
  19.449 +*}
  19.450 +
  19.451 +lemma decomp_H'_H:
  19.452 +  assumes "vectorspace E" "subspace H E"
  19.453 +  assumes t: "t \<in> H"
  19.454 +    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
  19.455 +  shows "(SOME (y, a). t = y + a \<cdot> x' \<and> y \<in> H) = (t, 0)"
  19.456 +proof -
  19.457 +  interpret vectorspace [E] by fact
  19.458 +  interpret subspace [H E] by fact
  19.459 +  show ?thesis
  19.460 +  proof (rule, simp_all only: split_paired_all split_conv)
  19.461 +    from t x' show "t = t + 0 \<cdot> x' \<and> t \<in> H" by simp
  19.462 +    fix y and a assume ya: "t = y + a \<cdot> x' \<and> y \<in> H"
  19.463 +    have "y = t \<and> a = 0"
  19.464 +    proof (rule decomp_H')
  19.465 +      from ya x' show "y + a \<cdot> x' = t + 0 \<cdot> x'" by simp
  19.466 +      from ya show "y \<in> H" ..
  19.467 +    qed (rule `vectorspace E`, rule `subspace H E`, rule t, (rule x')+)
  19.468 +    with t x' show "(y, a) = (y + a \<cdot> x', 0)" by simp
  19.469 +  qed
  19.470 +qed
  19.471 +
  19.472 +text {*
  19.473 +  The components @{text "y \<in> H"} and @{text a} in @{text "y + a \<cdot> x'"}
  19.474 +  are unique, so the function @{text h'} defined by
  19.475 +  @{text "h' (y + a \<cdot> x') = h y + a \<cdot> \<xi>"} is definite.
  19.476 +*}
  19.477 +
  19.478 +lemma h'_definite:
  19.479 +  fixes H
  19.480 +  assumes h'_def:
  19.481 +    "h' \<equiv> (\<lambda>x. let (y, a) = SOME (y, a). (x = y + a \<cdot> x' \<and> y \<in> H)
  19.482 +                in (h y) + a * xi)"
  19.483 +    and x: "x = y + a \<cdot> x'"
  19.484 +  assumes "vectorspace E" "subspace H E"
  19.485 +  assumes y: "y \<in> H"
  19.486 +    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
  19.487 +  shows "h' x = h y + a * xi"
  19.488 +proof -
  19.489 +  interpret vectorspace [E] by fact
  19.490 +  interpret subspace [H E] by fact
  19.491 +  from x y x' have "x \<in> H + lin x'" by auto
  19.492 +  have "\<exists>!p. (\<lambda>(y, a). x = y + a \<cdot> x' \<and> y \<in> H) p" (is "\<exists>!p. ?P p")
  19.493 +  proof (rule ex_ex1I)
  19.494 +    from x y show "\<exists>p. ?P p" by blast
  19.495 +    fix p q assume p: "?P p" and q: "?P q"
  19.496 +    show "p = q"
  19.497 +    proof -
  19.498 +      from p have xp: "x = fst p + snd p \<cdot> x' \<and> fst p \<in> H"
  19.499 +        by (cases p) simp
  19.500 +      from q have xq: "x = fst q + snd q \<cdot> x' \<and> fst q \<in> H"
  19.501 +        by (cases q) simp
  19.502 +      have "fst p = fst q \<and> snd p = snd q"
  19.503 +      proof (rule decomp_H')
  19.504 +        from xp show "fst p \<in> H" ..
  19.505 +        from xq show "fst q \<in> H" ..
  19.506 +        from xp and xq show "fst p + snd p \<cdot> x' = fst q + snd q \<cdot> x'"
  19.507 +          by simp
  19.508 +      qed (rule `vectorspace E`, rule `subspace H E`, (rule x')+)
  19.509 +      then show ?thesis by (cases p, cases q) simp
  19.510 +    qed
  19.511 +  qed
  19.512 +  then have eq: "(SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H) = (y, a)"
  19.513 +    by (rule some1_equality) (simp add: x y)
  19.514 +  with h'_def show "h' x = h y + a * xi" by (simp add: Let_def)
  19.515 +qed
  19.516 +
  19.517 +end
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOL/HahnBanach/VectorSpace.thy	Mon Dec 29 14:08:08 2008 +0100
    20.3 @@ -0,0 +1,417 @@
    20.4 +(*  Title:      HOL/Real/HahnBanach/VectorSpace.thy
    20.5 +    ID:         $Id$
    20.6 +    Author:     Gertrud Bauer, TU Munich
    20.7 +*)
    20.8 +
    20.9 +header {* Vector spaces *}
   20.10 +
   20.11 +theory VectorSpace
   20.12 +imports Real Bounds Zorn
   20.13 +begin
   20.14 +
   20.15 +subsection {* Signature *}
   20.16 +
   20.17 +text {*
   20.18 +  For the definition of real vector spaces a type @{typ 'a} of the
   20.19 +  sort @{text "{plus, minus, zero}"} is considered, on which a real
   20.20 +  scalar multiplication @{text \<cdot>} is declared.
   20.21 +*}
   20.22 +
   20.23 +consts
   20.24 +  prod  :: "real \<Rightarrow> 'a::{plus, minus, zero} \<Rightarrow> 'a"     (infixr "'(*')" 70)
   20.25 +
   20.26 +notation (xsymbols)
   20.27 +  prod  (infixr "\<cdot>" 70)
   20.28 +notation (HTML output)
   20.29 +  prod  (infixr "\<cdot>" 70)
   20.30 +
   20.31 +
   20.32 +subsection {* Vector space laws *}
   20.33 +
   20.34 +text {*
   20.35 +  A \emph{vector space} is a non-empty set @{text V} of elements from
   20.36 +  @{typ 'a} with the following vector space laws: The set @{text V} is
   20.37 +  closed under addition and scalar multiplication, addition is
   20.38 +  associative and commutative; @{text "- x"} is the inverse of @{text
   20.39 +  x} w.~r.~t.~addition and @{text 0} is the neutral element of
   20.40 +  addition.  Addition and multiplication are distributive; scalar
   20.41 +  multiplication is associative and the real number @{text "1"} is
   20.42 +  the neutral element of scalar multiplication.
   20.43 +*}
   20.44 +
   20.45 +locale vectorspace = var V +
   20.46 +  assumes non_empty [iff, intro?]: "V \<noteq> {}"
   20.47 +    and add_closed [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y \<in> V"
   20.48 +    and mult_closed [iff]: "x \<in> V \<Longrightarrow> a \<cdot> x \<in> V"
   20.49 +    and add_assoc: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + y) + z = x + (y + z)"
   20.50 +    and add_commute: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y = y + x"
   20.51 +    and diff_self [simp]: "x \<in> V \<Longrightarrow> x - x = 0"
   20.52 +    and add_zero_left [simp]: "x \<in> V \<Longrightarrow> 0 + x = x"
   20.53 +    and add_mult_distrib1: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<cdot> (x + y) = a \<cdot> x + a \<cdot> y"
   20.54 +    and add_mult_distrib2: "x \<in> V \<Longrightarrow> (a + b) \<cdot> x = a \<cdot> x + b \<cdot> x"
   20.55 +    and mult_assoc: "x \<in> V \<Longrightarrow> (a * b) \<cdot> x = a \<cdot> (b \<cdot> x)"
   20.56 +    and mult_1 [simp]: "x \<in> V \<Longrightarrow> 1 \<cdot> x = x"
   20.57 +    and negate_eq1: "x \<in> V \<Longrightarrow> - x = (- 1) \<cdot> x"
   20.58 +    and diff_eq1: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y = x + - y"
   20.59 +
   20.60 +lemma (in vectorspace) negate_eq2: "x \<in> V \<Longrightarrow> (- 1) \<cdot> x = - x"
   20.61 +  by (rule negate_eq1 [symmetric])
   20.62 +
   20.63 +lemma (in vectorspace) negate_eq2a: "x \<in> V \<Longrightarrow> -1 \<cdot> x = - x"
   20.64 +  by (simp add: negate_eq1)
   20.65 +
   20.66 +lemma (in vectorspace) diff_eq2: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + - y = x - y"
   20.67 +  by (rule diff_eq1 [symmetric])
   20.68 +
   20.69 +lemma (in vectorspace) diff_closed [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y \<in> V"
   20.70 +  by (simp add: diff_eq1 negate_eq1)
   20.71 +
   20.72 +lemma (in vectorspace) neg_closed [iff]: "x \<in> V \<Longrightarrow> - x \<in> V"
   20.73 +  by (simp add: negate_eq1)
   20.74 +
   20.75 +lemma (in vectorspace) add_left_commute:
   20.76 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> x + (y + z) = y + (x + z)"
   20.77 +proof -
   20.78 +  assume xyz: "x \<in> V"  "y \<in> V"  "z \<in> V"
   20.79 +  then have "x + (y + z) = (x + y) + z"
   20.80 +    by (simp only: add_assoc)
   20.81 +  also from xyz have "\<dots> = (y + x) + z" by (simp only: add_commute)
   20.82 +  also from xyz have "\<dots> = y + (x + z)" by (simp only: add_assoc)
   20.83 +  finally show ?thesis .
   20.84 +qed
   20.85 +
   20.86 +theorems (in vectorspace) add_ac =
   20.87 +  add_assoc add_commute add_left_commute
   20.88 +
   20.89 +
   20.90 +text {* The existence of the zero element of a vector space
   20.91 +  follows from the non-emptiness of carrier set. *}
   20.92 +
   20.93 +lemma (in vectorspace) zero [iff]: "0 \<in> V"
   20.94 +proof -
   20.95 +  from non_empty obtain x where x: "x \<in> V" by blast
   20.96 +  then have "0 = x - x" by (rule diff_self [symmetric])
   20.97 +  also from x x have "\<dots> \<in> V" by (rule diff_closed)
   20.98 +  finally show ?thesis .
   20.99 +qed
  20.100 +
  20.101 +lemma (in vectorspace) add_zero_right [simp]:
  20.102 +  "x \<in> V \<Longrightarrow>  x + 0 = x"
  20.103 +proof -
  20.104 +  assume x: "x \<in> V"
  20.105 +  from this and zero have "x + 0 = 0 + x" by (rule add_commute)
  20.106 +  also from x have "\<dots> = x" by (rule add_zero_left)
  20.107 +  finally show ?thesis .
  20.108 +qed
  20.109 +
  20.110 +lemma (in vectorspace) mult_assoc2:
  20.111 +    "x \<in> V \<Longrightarrow> a \<cdot> b \<cdot> x = (a * b) \<cdot> x"
  20.112 +  by (simp only: mult_assoc)
  20.113 +
  20.114 +lemma (in vectorspace) diff_mult_distrib1:
  20.115 +    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<cdot> (x - y) = a \<cdot> x - a \<cdot> y"
  20.116 +  by (simp add: diff_eq1 negate_eq1 add_mult_distrib1 mult_assoc2)
  20.117 +
  20.118 +lemma (in vectorspace) diff_mult_distrib2:
  20.119 +  "x \<in> V \<Longrightarrow> (a - b) \<cdot> x = a \<cdot> x - (b \<cdot> x)"
  20.120 +proof -
  20.121 +  assume x: "x \<in> V"
  20.122 +  have " (a - b) \<cdot> x = (a + - b) \<cdot> x"
  20.123 +    by (simp add: real_diff_def)
  20.124 +  also from x have "\<dots> = a \<cdot> x + (- b) \<cdot> x"
  20.125 +    by (rule add_mult_distrib2)
  20.126 +  also from x have "\<dots> = a \<cdot> x + - (b \<cdot> x)"
  20.127 +    by (simp add: negate_eq1 mult_assoc2)
  20.128 +  also from x have "\<dots> = a \<cdot> x - (b \<cdot> x)"
  20.129 +    by (simp add: diff_eq1)
  20.130 +  finally show ?thesis .
  20.131 +qed
  20.132 +
  20.133 +lemmas (in vectorspace) distrib =
  20.134 +  add_mult_distrib1 add_mult_distrib2
  20.135 +  diff_mult_distrib1 diff_mult_distrib2
  20.136 +
  20.137 +
  20.138 +text {* \medskip Further derived laws: *}
  20.139 +
  20.140 +lemma (in vectorspace) mult_zero_left [simp]:
  20.141 +  "x \<in> V \<Longrightarrow> 0 \<cdot> x = 0"
  20.142 +proof -
  20.143 +  assume x: "x \<in> V"
  20.144 +  have "0 \<cdot> x = (1 - 1) \<cdot> x" by simp
  20.145 +  also have "\<dots> = (1 + - 1) \<cdot> x" by simp
  20.146 +  also from x have "\<dots> =  1 \<cdot> x + (- 1) \<cdot> x"
  20.147 +    by (rule add_mult_distrib2)
  20.148 +  also from x have "\<dots> = x + (- 1) \<cdot> x" by simp
  20.149 +  also from x have "\<dots> = x + - x" by (simp add: negate_eq2a)
  20.150 +  also from x have "\<dots> = x - x" by (simp add: diff_eq2)
  20.151 +  also from x have "\<dots> = 0" by simp
  20.152 +  finally show ?thesis .
  20.153 +qed
  20.154 +
  20.155 +lemma (in vectorspace) mult_zero_right [simp]:
  20.156 +  "a \<cdot> 0 = (0::'a)"
  20.157 +proof -
  20.158 +  have "a \<cdot> 0 = a \<cdot> (0 - (0::'a))" by simp
  20.159 +  also have "\<dots> =  a \<cdot> 0 - a \<cdot> 0"
  20.160 +    by (rule diff_mult_distrib1) simp_all
  20.161 +  also have "\<dots> = 0" by simp
  20.162 +  finally show ?thesis .
  20.163 +qed
  20.164 +
  20.165 +lemma (in vectorspace) minus_mult_cancel [simp]:
  20.166 +    "x \<in> V \<Longrightarrow> (- a) \<cdot> - x = a \<cdot> x"
  20.167 +  by (simp add: negate_eq1 mult_assoc2)
  20.168 +
  20.169 +lemma (in vectorspace) add_minus_left_eq_diff:
  20.170 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - x + y = y - x"
  20.171 +proof -
  20.172 +  assume xy: "x \<in> V"  "y \<in> V"
  20.173 +  then have "- x + y = y + - x" by (simp add: add_commute)
  20.174 +  also from xy have "\<dots> = y - x" by (simp add: diff_eq1)
  20.175 +  finally show ?thesis .
  20.176 +qed
  20.177 +
  20.178 +lemma (in vectorspace) add_minus [simp]:
  20.179 +    "x \<in> V \<Longrightarrow> x + - x = 0"
  20.180 +  by (simp add: diff_eq2)
  20.181 +
  20.182 +lemma (in vectorspace) add_minus_left [simp]:
  20.183 +    "x \<in> V \<Longrightarrow> - x + x = 0"
  20.184 +  by (simp add: diff_eq2 add_commute)
  20.185 +
  20.186 +lemma (in vectorspace) minus_minus [simp]:
  20.187 +    "x \<in> V \<Longrightarrow> - (- x) = x"
  20.188 +  by (simp add: negate_eq1 mult_assoc2)
  20.189 +
  20.190 +lemma (in vectorspace) minus_zero [simp]:
  20.191 +    "- (0::'a) = 0"
  20.192 +  by (simp add: negate_eq1)
  20.193 +
  20.194 +lemma (in vectorspace) minus_zero_iff [simp]:
  20.195 +  "x \<in> V \<Longrightarrow> (- x = 0) = (x = 0)"
  20.196 +proof
  20.197 +  assume x: "x \<in> V"
  20.198 +  {
  20.199 +    from x have "x = - (- x)" by (simp add: minus_minus)
  20.200 +    also assume "- x = 0"
  20.201 +    also have "- \<dots> = 0" by (rule minus_zero)
  20.202 +    finally show "x = 0" .
  20.203 +  next
  20.204 +    assume "x = 0"
  20.205 +    then show "- x = 0" by simp
  20.206 +  }
  20.207 +qed
  20.208 +
  20.209 +lemma (in vectorspace) add_minus_cancel [simp]:
  20.210 +    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + (- x + y) = y"
  20.211 +  by (simp add: add_assoc [symmetric] del: add_commute)
  20.212 +
  20.213 +lemma (in vectorspace) minus_add_cancel [simp]:
  20.214 +    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - x + (x + y) = y"
  20.215 +  by (simp add: add_assoc [symmetric] del: add_commute)
  20.216 +
  20.217 +lemma (in vectorspace) minus_add_distrib [simp]:
  20.218 +    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - (x + y) = - x + - y"
  20.219 +  by (simp add: negate_eq1 add_mult_distrib1)
  20.220 +
  20.221 +lemma (in vectorspace) diff_zero [simp]:
  20.222 +    "x \<in> V \<Longrightarrow> x - 0 = x"
  20.223 +  by (simp add: diff_eq1)
  20.224 +
  20.225 +lemma (in vectorspace) diff_zero_right [simp]:
  20.226 +    "x \<in> V \<Longrightarrow> 0 - x = - x"
  20.227 +  by (simp add: diff_eq1)
  20.228 +
  20.229 +lemma (in vectorspace) add_left_cancel:
  20.230 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + y = x + z) = (y = z)"
  20.231 +proof
  20.232 +  assume x: "x \<in> V" and y: "y \<in> V" and z: "z \<in> V"
  20.233 +  {
  20.234 +    from y have "y = 0 + y" by simp
  20.235 +    also from x y have "\<dots> = (- x + x) + y" by simp
  20.236 +    also from x y have "\<dots> = - x + (x + y)"
  20.237 +      by (simp add: add_assoc neg_closed)
  20.238 +    also assume "x + y = x + z"
  20.239 +    also from x z have "- x + (x + z) = - x + x + z"
  20.240 +      by (simp add: add_assoc [symmetric] neg_closed)
  20.241 +    also from x z have "\<dots> = z" by simp
  20.242 +    finally show "y = z" .
  20.243 +  next
  20.244 +    assume "y = z"
  20.245 +    then show "x + y = x + z" by (simp only:)
  20.246 +  }
  20.247 +qed
  20.248 +
  20.249 +lemma (in vectorspace) add_right_cancel:
  20.250 +    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (y + x = z + x) = (y = z)"
  20.251 +  by (simp only: add_commute add_left_cancel)
  20.252 +
  20.253 +lemma (in vectorspace) add_assoc_cong:
  20.254 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x' \<in> V \<Longrightarrow> y' \<in> V \<Longrightarrow> z \<in> V
  20.255 +    \<Longrightarrow> x + y = x' + y' \<Longrightarrow> x + (y + z) = x' + (y' + z)"
  20.256 +  by (simp only: add_assoc [symmetric])
  20.257 +
  20.258 +lemma (in vectorspace) mult_left_commute:
  20.259 +    "x \<in> V \<Longrightarrow> a \<cdot> b \<cdot> x = b \<cdot> a \<cdot> x"
  20.260 +  by (simp add: real_mult_commute mult_assoc2)
  20.261 +
  20.262 +lemma (in vectorspace) mult_zero_uniq:
  20.263 +  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> a \<cdot> x = 0 \<Longrightarrow> a = 0"
  20.264 +proof (rule classical)
  20.265 +  assume a: "a \<noteq> 0"
  20.266 +  assume x: "x \<in> V"  "x \<noteq> 0" and ax: "a \<cdot> x = 0"
  20.267 +  from x a have "x = (inverse a * a) \<cdot> x" by simp
  20.268 +  also from `x \<in> V` have "\<dots> = inverse a \<cdot> (a \<cdot> x)" by (rule mult_assoc)
  20.269 +  also from ax have "\<dots> = inverse a \<cdot> 0" by simp
  20.270 +  also have "\<dots> = 0" by simp
  20.271 +  finally have "x = 0" .
  20.272 +  with `x \<noteq> 0` show "a = 0" by contradiction
  20.273 +qed
  20.274 +
  20.275 +lemma (in vectorspace) mult_left_cancel:
  20.276 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (a \<cdot> x = a \<cdot> y) = (x = y)"
  20.277 +proof
  20.278 +  assume x: "x \<in> V" and y: "y \<in> V" and a: "a \<noteq> 0"
  20.279 +  from x have "x = 1 \<cdot> x" by simp
  20.280 +  also from a have "\<dots> = (inverse a * a) \<cdot> x" by simp
  20.281 +  also from x have "\<dots> = inverse a \<cdot> (a \<cdot> x)"
  20.282 +    by (simp only: mult_assoc)
  20.283 +  also assume "a \<cdot> x = a \<cdot> y"
  20.284 +  also from a y have "inverse a \<cdot> \<dots> = y"
  20.285 +    by (simp add: mult_assoc2)
  20.286 +  finally show "x = y" .
  20.287 +next
  20.288 +  assume "x = y"
  20.289 +  then show "a \<cdot> x = a \<cdot> y" by (simp only:)
  20.290 +qed
  20.291 +
  20.292 +lemma (in vectorspace) mult_right_cancel:
  20.293 +  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> (a \<cdot> x = b \<cdot> x) = (a = b)"
  20.294 +proof
  20.295 +  assume x: "x \<in> V" and neq: "x \<noteq> 0"
  20.296 +  {
  20.297 +    from x have "(a - b) \<cdot> x = a \<cdot> x - b \<cdot> x"
  20.298 +      by (simp add: diff_mult_distrib2)
  20.299 +    also assume "a \<cdot> x = b \<cdot> x"
  20.300 +    with x have "a \<cdot> x - b \<cdot> x = 0" by simp
  20.301 +    finally have "(a - b) \<cdot> x = 0" .
  20.302 +    with x neq have "a - b = 0" by (rule mult_zero_uniq)
  20.303 +    then show "a = b" by simp
  20.304 +  next
  20.305 +    assume "a = b"
  20.306 +    then show "a \<cdot> x = b \<cdot> x" by (simp only:)
  20.307 +  }
  20.308 +qed
  20.309 +
  20.310 +lemma (in vectorspace) eq_diff_eq:
  20.311 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x = z - y) = (x + y = z)"
  20.312 +proof
  20.313 +  assume x: "x \<in> V" and y: "y \<in> V" and z: "z \<in> V"
  20.314 +  {
  20.315 +    assume "x = z - y"
  20.316 +    then have "x + y = z - y + y" by simp
  20.317 +    also from y z have "\<dots> = z + - y + y"
  20.318 +      by (simp add: diff_eq1)
  20.319 +    also have "\<dots> = z + (- y + y)"
  20.320 +      by (rule add_assoc) (simp_all add: y z)
  20.321 +    also from y z have "\<dots> = z + 0"
  20.322 +      by (simp only: add_minus_left)
  20.323 +    also from z have "\<dots> = z"
  20.324 +      by (simp only: add_zero_right)
  20.325 +    finally show "x + y = z" .
  20.326 +  next
  20.327 +    assume "x + y = z"
  20.328 +    then have "z - y = (x + y) - y" by simp
  20.329 +    also from x y have "\<dots> = x + y + - y"
  20.330 +      by (simp add: diff_eq1)
  20.331 +    also have "\<dots> = x + (y + - y)"
  20.332 +      by (rule add_assoc) (simp_all add: x y)
  20.333 +    also from x y have "\<dots> = x" by simp
  20.334 +    finally show "x = z - y" ..
  20.335 +  }
  20.336 +qed
  20.337 +
  20.338 +lemma (in vectorspace) add_minus_eq_minus:
  20.339 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y = 0 \<Longrightarrow> x = - y"
  20.340 +proof -
  20.341 +  assume x: "x \<in> V" and y: "y \<in> V"
  20.342 +  from x y have "x = (- y + y) + x" by simp
  20.343 +  also from x y have "\<dots> = - y + (x + y)" by (simp add: add_ac)
  20.344 +  also assume "x + y = 0"
  20.345 +  also from y have "- y + 0 = - y" by simp
  20.346 +  finally show "x = - y" .
  20.347 +qed
  20.348 +
  20.349 +lemma (in vectorspace) add_minus_eq:
  20.350 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y = 0 \<Longrightarrow> x = y"
  20.351 +proof -
  20.352 +  assume x: "x \<in> V" and y: "y \<in> V"
  20.353 +  assume "x - y = 0"
  20.354 +  with x y have eq: "x + - y = 0" by (simp add: diff_eq1)
  20.355 +  with _ _ have "x = - (- y)"
  20.356 +    by (rule add_minus_eq_minus) (simp_all add: x y)
  20.357 +  with x y show "x = y" by simp
  20.358 +qed
  20.359 +
  20.360 +lemma (in vectorspace) add_diff_swap:
  20.361 +  "a \<in> V \<Longrightarrow> b \<in> V \<Longrightarrow> c \<in> V \<Longrightarrow> d \<in> V \<Longrightarrow> a + b = c + d
  20.362 +    \<Longrightarrow> a - c = d - b"
  20.363 +proof -
  20.364 +  assume vs: "a \<in> V"  "b \<in> V"  "c \<in> V"  "d \<in> V"
  20.365 +    and eq: "a + b = c + d"
  20.366 +  then have "- c + (a + b) = - c + (c + d)"
  20.367 +    by (simp add: add_left_cancel)
  20.368 +  also have "\<dots> = d" using `c \<in> V` `d \<in> V` by (rule minus_add_cancel)
  20.369 +  finally have eq: "- c + (a + b) = d" .
  20.370 +  from vs have "a - c = (- c + (a + b)) + - b"
  20.371 +    by (simp add: add_ac diff_eq1)
  20.372 +  also from vs eq have "\<dots>  = d + - b"
  20.373 +    by (simp add: add_right_cancel)
  20.374 +  also from vs have "\<dots> = d - b" by (simp add: diff_eq2)
  20.375 +  finally show "a - c = d - b" .
  20.376 +qed
  20.377 +
  20.378 +lemma (in vectorspace) vs_add_cancel_21:
  20.379 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> u \<in> V
  20.380 +    \<Longrightarrow> (x + (y + z) = y + u) = (x + z = u)"
  20.381 +proof
  20.382 +  assume vs: "x \<in> V"  "y \<in> V"  "z \<in> V"  "u \<in> V"
  20.383 +  {
  20.384 +    from vs have "x + z = - y + y + (x + z)" by simp
  20.385 +    also have "\<dots> = - y + (y + (x + z))"
  20.386 +      by (rule add_assoc) (simp_all add: vs)
  20.387 +    also from vs have "y + (x + z) = x + (y + z)"
  20.388 +      by (simp add: add_ac)
  20.389 +    also assume "x + (y + z) = y + u"
  20.390 +    also from vs have "- y + (y + u) = u" by simp
  20.391 +    finally show "x + z = u" .
  20.392 +  next
  20.393 +    assume "x + z = u"
  20.394 +    with vs show "x + (y + z) = y + u"
  20.395 +      by (simp only: add_left_commute [of x])
  20.396 +  }
  20.397 +qed
  20.398 +
  20.399 +lemma (in vectorspace) add_cancel_end:
  20.400 +  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + (y + z) = y) = (x = - z)"
  20.401 +proof
  20.402 +  assume vs: "x \<in> V"  "y \<in> V"  "z \<in> V"
  20.403 +  {
  20.404 +    assume "x + (y + z) = y"
  20.405 +    with vs have "(x + z) + y = 0 + y"
  20.406 +      by (simp add: add_ac)
  20.407 +    with vs have "x + z = 0"
  20.408 +      by (simp only: add_right_cancel add_closed zero)
  20.409 +    with vs show "x = - z" by (simp add: add_minus_eq_minus)
  20.410 +  next
  20.411 +    assume eq: "x = - z"
  20.412 +    then have "x + (y + z) = - z + (y + z)" by simp
  20.413 +    also have "\<dots> = y + (- z + z)"
  20.414 +      by (rule add_left_commute) (simp_all add: vs)
  20.415 +    also from vs have "\<dots> = y"  by simp
  20.416 +    finally show "x + (y + z) = y" .
  20.417 +  }
  20.418 +qed
  20.419 +
  20.420 +end
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/HOL/HahnBanach/ZornLemma.thy	Mon Dec 29 14:08:08 2008 +0100
    21.3 @@ -0,0 +1,58 @@
    21.4 +(*  Title:      HOL/Real/HahnBanach/ZornLemma.thy
    21.5 +    ID:         $Id$
    21.6 +    Author:     Gertrud Bauer, TU Munich
    21.7 +*)
    21.8 +
    21.9 +header {* Zorn's Lemma *}
   21.10 +
   21.11 +theory ZornLemma
   21.12 +imports Zorn
   21.13 +begin
   21.14 +
   21.15 +text {*
   21.16 +  Zorn's Lemmas states: if every linear ordered subset of an ordered
   21.17 +  set @{text S} has an upper bound in @{text S}, then there exists a
   21.18 +  maximal element in @{text S}.  In our application, @{text S} is a
   21.19 +  set of sets ordered by set inclusion. Since the union of a chain of
   21.20 +  sets is an upper bound for all elements of the chain, the conditions
   21.21 +  of Zorn's lemma can be modified: if @{text S} is non-empty, it
   21.22 +  suffices to show that for every non-empty chain @{text c} in @{text
   21.23 +  S} the union of @{text c} also lies in @{text S}.
   21.24 +*}
   21.25 +
   21.26 +theorem Zorn's_Lemma:
   21.27 +  assumes r: "\<And>c. c \<in> chain S \<Longrightarrow> \<exists>x. x \<in> c \<Longrightarrow> \<Union>c \<in> S"
   21.28 +    and aS: "a \<in> S"
   21.29 +  shows "\<exists>y \<in> S. \<forall>z \<in> S. y \<subseteq> z \<longrightarrow> y = z"
   21.30 +proof (rule Zorn_Lemma2)
   21.31 +  show "\<forall>c \<in> chain S. \<exists>y \<in> S. \<forall>z \<in> c. z \<subseteq> y"
   21.32 +  proof
   21.33 +    fix c assume "c \<in> chain S"
   21.34 +    show "\<exists>y \<in> S. \<forall>z \<in> c. z \<subseteq> y"
   21.35 +    proof cases
   21.36 +
   21.37 +      txt {* If @{text c} is an empty chain, then every element in
   21.38 +	@{text S} is an upper bound of @{text c}. *}
   21.39 +
   21.40 +      assume "c = {}"
   21.41 +      with aS show ?thesis by fast
   21.42 +
   21.43 +      txt {* If @{text c} is non-empty, then @{text "\<Union>c"} is an upper
   21.44 +	bound of @{text c}, lying in @{text S}. *}
   21.45 +
   21.46 +    next
   21.47 +      assume "c \<noteq> {}"
   21.48 +      show ?thesis
   21.49 +      proof
   21.50 +        show "\<forall>z \<in> c. z \<subseteq> \<Union>c" by fast
   21.51 +        show "\<Union>c \<in> S"
   21.52 +        proof (rule r)
   21.53 +          from `c \<noteq> {}` show "\<exists>x. x \<in> c" by fast
   21.54 +	  show "c \<in> chain S" by fact
   21.55 +        qed
   21.56 +      qed
   21.57 +    qed
   21.58 +  qed
   21.59 +qed
   21.60 +
   21.61 +end
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/HOL/HahnBanach/document/root.bib	Mon Dec 29 14:08:08 2008 +0100
    22.3 @@ -0,0 +1,27 @@
    22.4 +
    22.5 +@Book{Heuser:1986,
    22.6 +  author = 	 {H. Heuser},
    22.7 +  title = 	 {Funktionalanalysis: Theorie und Anwendung},
    22.8 +  publisher = 	 {Teubner},
    22.9 +  year = 	 1986
   22.10 +}
   22.11 +
   22.12 +@InCollection{Narici:1996,
   22.13 +  author = 	 {L. Narici and E. Beckenstein},
   22.14 +  title = 	 {The {Hahn-Banach Theorem}: The Life and Times},
   22.15 +  booktitle = 	 {Topology Atlas},
   22.16 +  publisher =	 {York University, Toronto, Ontario, Canada},
   22.17 +  year =	 1996,
   22.18 +  note =	 {\url{http://at.yorku.ca/topology/preprint.htm} and
   22.19 +                  \url{http://at.yorku.ca/p/a/a/a/16.htm}}
   22.20 +}
   22.21 +
   22.22 +@Article{Nowak:1993,
   22.23 +  author =       {B. Nowak and A. Trybulec},
   22.24 +  title =	 {{Hahn-Banach} Theorem},
   22.25 +  journal =      {Journal of Formalized Mathematics},
   22.26 +  year =         {1993},
   22.27 +  volume =       {5},
   22.28 +  institution =  {University of Bialystok},
   22.29 +  note =         {\url{http://mizar.uwb.edu.pl/JFM/Vol5/hahnban.html}}
   22.30 +}
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/HOL/HahnBanach/document/root.tex	Mon Dec 29 14:08:08 2008 +0100
    23.3 @@ -0,0 +1,83 @@
    23.4 +\documentclass[10pt,a4paper,twoside]{article}
    23.5 +\usepackage{graphicx}
    23.6 +\usepackage{latexsym,theorem}
    23.7 +\usepackage{isabelle,isabellesym}
    23.8 +\usepackage{pdfsetup} %last one!
    23.9 +
   23.10 +\isabellestyle{it}
   23.11 +\urlstyle{rm}
   23.12 +
   23.13 +\newcommand{\isasymsup}{\isamath{\sup\,}}
   23.14 +\newcommand{\skp}{\smallskip}
   23.15 +
   23.16 +
   23.17 +\begin{document}
   23.18 +
   23.19 +\pagestyle{headings}
   23.20 +\pagenumbering{arabic}
   23.21 +
   23.22 +\title{The Hahn-Banach Theorem \\ for Real Vector Spaces}
   23.23 +\author{Gertrud Bauer \\ \url{http://www.in.tum.de/~bauerg/}}
   23.24 +\maketitle
   23.25 +
   23.26 +\begin{abstract}
   23.27 +  The Hahn-Banach Theorem is one of the most fundamental results in functional
   23.28 +  analysis. We present a fully formal proof of two versions of the theorem,
   23.29 +  one for general linear spaces and another for normed spaces.  This
   23.30 +  development is based on simply-typed classical set-theory, as provided by
   23.31 +  Isabelle/HOL.
   23.32 +\end{abstract}
   23.33 +
   23.34 +
   23.35 +\tableofcontents
   23.36 +\parindent 0pt \parskip 0.5ex
   23.37 +
   23.38 +\clearpage
   23.39 +\section{Preface}
   23.40 +
   23.41 +This is a fully formal proof of the Hahn-Banach Theorem. It closely follows
   23.42 +the informal presentation given in Heuser's textbook \cite[{\S} 36]{Heuser:1986}.
   23.43 +Another formal proof of the same theorem has been done in Mizar
   23.44 +\cite{Nowak:1993}.  A general overview of the relevance and history of the
   23.45 +Hahn-Banach Theorem is given by Narici and Beckenstein \cite{Narici:1996}.
   23.46 +
   23.47 +\medskip The document is structured as follows.  The first part contains
   23.48 +definitions of basic notions of linear algebra: vector spaces, subspaces,
   23.49 +normed spaces, continuous linear-forms, norm of functions and an order on
   23.50 +functions by domain extension.  The second part contains some lemmas about the
   23.51 +supremum (w.r.t.\ the function order) and extension of non-maximal functions.
   23.52 +With these preliminaries, the main proof of the theorem (in its two versions)
   23.53 +is conducted in the third part.  The dependencies of individual theories are
   23.54 +as follows.
   23.55 +
   23.56 +\begin{center}
   23.57 +  \includegraphics[scale=0.5]{session_graph}  
   23.58 +\end{center}
   23.59 +
   23.60 +\clearpage
   23.61 +\part {Basic Notions}
   23.62 +
   23.63 +\input{Bounds}
   23.64 +\input{VectorSpace}
   23.65 +\input{Subspace}
   23.66 +\input{NormedSpace}
   23.67 +\input{Linearform}
   23.68 +\input{FunctionOrder}
   23.69 +\input{FunctionNorm}
   23.70 +\input{ZornLemma}
   23.71 +
   23.72 +\clearpage
   23.73 +\part {Lemmas for the Proof}
   23.74 +
   23.75 +\input{HahnBanachSupLemmas}
   23.76 +\input{HahnBanachExtLemmas}
   23.77 +\input{HahnBanachLemmas}
   23.78 +
   23.79 +\clearpage
   23.80 +\part {The Main Proof}
   23.81 +
   23.82 +\input{HahnBanach}
   23.83 +\bibliographystyle{abbrv}
   23.84 +\bibliography{root}
   23.85 +
   23.86 +\end{document}
    24.1 --- a/src/HOL/Hyperreal/SEQ.thy	Mon Dec 29 13:23:53 2008 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,1136 +0,0 @@
    24.4 -(*  Title       : SEQ.thy
    24.5 -    Author      : Jacques D. Fleuriot
    24.6 -    Copyright   : 1998  University of Cambridge
    24.7 -    Description : Convergence of sequences and series
    24.8 -    Conversion to Isar and new proofs by Lawrence C Paulson, 2004
    24.9 -    Additional contributions by Jeremy Avigad and Brian Huffman
   24.10 -*)
   24.11 -
   24.12 -header {* Sequences and Convergence *}
   24.13 -
   24.14 -theory SEQ
   24.15 -imports "../Real/RealVector" "../RComplete"
   24.16 -begin
   24.17 -
   24.18 -definition
   24.19 -  Zseq :: "[nat \<Rightarrow> 'a::real_normed_vector] \<Rightarrow> bool" where
   24.20 -    --{*Standard definition of sequence converging to zero*}
   24.21 -  [code del]: "Zseq X = (\<forall>r>0. \<exists>no. \<forall>n\<ge>no. norm (X n) < r)"
   24.22 -
   24.23 -definition
   24.24 -  LIMSEQ :: "[nat => 'a::real_normed_vector, 'a] => bool"
   24.25 -    ("((_)/ ----> (_))" [60, 60] 60) where
   24.26 -    --{*Standard definition of convergence of sequence*}
   24.27 -  [code del]: "X ----> L = (\<forall>r. 0 < r --> (\<exists>no. \<forall>n. no \<le> n --> norm (X n - L) < r))"
   24.28 -
   24.29 -definition
   24.30 -  lim :: "(nat => 'a::real_normed_vector) => 'a" where
   24.31 -    --{*Standard definition of limit using choice operator*}
   24.32 -  "lim X = (THE L. X ----> L)"
   24.33 -
   24.34 -definition
   24.35 -  convergent :: "(nat => 'a::real_normed_vector) => bool" where
   24.36 -    --{*Standard definition of convergence*}
   24.37 -  "convergent X = (\<exists>L. X ----> L)"
   24.38 -
   24.39 -definition
   24.40 -  Bseq :: "(nat => 'a::real_normed_vector) => bool" where
   24.41 -    --{*Standard definition for bounded sequence*}
   24.42 -  [code del]: "Bseq X = (\<exists>K>0.\<forall>n. norm (X n) \<le> K)"
   24.43 -
   24.44 -definition
   24.45 -  monoseq :: "(nat=>real)=>bool" where
   24.46 -    --{*Definition for monotonicity*}
   24.47 -  [code del]: "monoseq X = ((\<forall>m. \<forall>n\<ge>m. X m \<le> X n) | (\<forall>m. \<forall>n\<ge>m. X n \<le> X m))"
   24.48 -
   24.49 -definition
   24.50 -  subseq :: "(nat => nat) => bool" where
   24.51 -    --{*Definition of subsequence*}
   24.52 -  [code del]:   "subseq f = (\<forall>m. \<forall>n>m. (f m) < (f n))"
   24.53 -
   24.54 -definition
   24.55 -  Cauchy :: "(nat => 'a::real_normed_vector) => bool" where
   24.56 -    --{*Standard definition of the Cauchy condition*}
   24.57 -  [code del]: "Cauchy X = (\<forall>e>0. \<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. norm (X m - X n) < e)"
   24.58 -
   24.59 -
   24.60 -subsection {* Bounded Sequences *}
   24.61 -
   24.62 -lemma BseqI': assumes K: "\<And>n. norm (X n) \<le> K" shows "Bseq X"
   24.63 -unfolding Bseq_def
   24.64 -proof (intro exI conjI allI)
   24.65 -  show "0 < max K 1" by simp
   24.66 -next
   24.67 -  fix n::nat
   24.68 -  have "norm (X n) \<le> K" by (rule K)
   24.69 -  thus "norm (X n) \<le> max K 1" by simp
   24.70 -qed
   24.71 -
   24.72 -lemma BseqE: "\<lbrakk>Bseq X; \<And>K. \<lbrakk>0 < K; \<forall>n. norm (X n) \<le> K\<rbrakk> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
   24.73 -unfolding Bseq_def by auto
   24.74 -
   24.75 -lemma BseqI2': assumes K: "\<forall>n\<ge>N. norm (X n) \<le> K" shows "Bseq X"
   24.76 -proof (rule BseqI')
   24.77 -  let ?A = "norm ` X ` {..N}"
   24.78 -  have 1: "finite ?A" by simp
   24.79 -  fix n::nat
   24.80 -  show "norm (X n) \<le> max K (Max ?A)"
   24.81 -  proof (cases rule: linorder_le_cases)
   24.82 -    assume "n \<ge> N"
   24.83 -    hence "norm (X n) \<le> K" using K by simp
   24.84 -    thus "norm (X n) \<le> max K (Max ?A)" by simp
   24.85 -  next
   24.86 -    assume "n \<le> N"
   24.87 -    hence "norm (X n) \<in> ?A" by simp
   24.88 -    with 1 have "norm (X n) \<le> Max ?A" by (rule Max_ge)
   24.89 -    thus "norm (X n) \<le> max K (Max ?A)" by simp
   24.90 -  qed
   24.91 -qed
   24.92 -
   24.93 -lemma Bseq_ignore_initial_segment: "Bseq X \<Longrightarrow> Bseq (\<lambda>n. X (n + k))"
   24.94 -unfolding Bseq_def by auto
   24.95 -
   24.96 -lemma Bseq_offset: "Bseq (\<lambda>n. X (n + k)) \<Longrightarrow> Bseq X"
   24.97 -apply (erule BseqE)
   24.98 -apply (rule_tac N="k" and K="K" in BseqI2')
   24.99 -apply clarify
  24.100 -apply (drule_tac x="n - k" in spec, simp)
  24.101 -done
  24.102 -
  24.103 -
  24.104 -subsection {* Sequences That Converge to Zero *}
  24.105 -
  24.106 -lemma ZseqI:
  24.107 -  "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n) < r) \<Longrightarrow> Zseq X"
  24.108 -unfolding Zseq_def by simp
  24.109 -
  24.110 -lemma ZseqD:
  24.111 -  "\<lbrakk>Zseq X; 0 < r\<rbrakk> \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n) < r"
  24.112 -unfolding Zseq_def by simp
  24.113 -
  24.114 -lemma Zseq_zero: "Zseq (\<lambda>n. 0)"
  24.115 -unfolding Zseq_def by simp
  24.116 -
  24.117 -lemma Zseq_const_iff: "Zseq (\<lambda>n. k) = (k = 0)"
  24.118 -unfolding Zseq_def by force
  24.119 -
  24.120 -lemma Zseq_norm_iff: "Zseq (\<lambda>n. norm (X n)) = Zseq (\<lambda>n. X n)"
  24.121 -unfolding Zseq_def by simp
  24.122 -
  24.123 -lemma Zseq_imp_Zseq:
  24.124 -  assumes X: "Zseq X"
  24.125 -  assumes Y: "\<And>n. norm (Y n) \<le> norm (X n) * K"
  24.126 -  shows "Zseq (\<lambda>n. Y n)"
  24.127 -proof (cases)
  24.128 -  assume K: "0 < K"
  24.129 -  show ?thesis
  24.130 -  proof (rule ZseqI)
  24.131 -    fix r::real assume "0 < r"
  24.132 -    hence "0 < r / K"
  24.133 -      using K by (rule divide_pos_pos)
  24.134 -    then obtain N where "\<forall>n\<ge>N. norm (X n) < r / K"
  24.135 -      using ZseqD [OF X] by fast
  24.136 -    hence "\<forall>n\<ge>N. norm (X n) * K < r"
  24.137 -      by (simp add: pos_less_divide_eq K)
  24.138 -    hence "\<forall>n\<ge>N. norm (Y n) < r"
<