src/HOL/Deriv.thy
author haftmann
Sun Jun 23 21:16:07 2013 +0200 (2013-06-23)
changeset 52435 6646bb548c6b
parent 51642 400ec5ae7f8f
child 53374 a14d2a854c02
permissions -rw-r--r--
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
     1 (*  Title       : Deriv.thy
     2     Author      : Jacques D. Fleuriot
     3     Copyright   : 1998  University of Cambridge
     4     Author      : Brian Huffman
     5     Conversion to Isar and new proofs by Lawrence C Paulson, 2004
     6     GMVT by Benjamin Porter, 2005
     7 *)
     8 
     9 header{* Differentiation *}
    10 
    11 theory Deriv
    12 imports Limits
    13 begin
    14 
    15 definition
    16   -- {* Frechet derivative: D is derivative of function f at x within s *}
    17   has_derivative :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a filter \<Rightarrow>  bool"
    18   (infixl "(has'_derivative)" 12)
    19 where
    20   "(f has_derivative f') F \<longleftrightarrow>
    21     (bounded_linear f' \<and>
    22      ((\<lambda>y. ((f y - f (Lim F (\<lambda>x. x))) - f' (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x))) ---> 0) F)"
    23 
    24 lemma FDERIV_eq_rhs: "(f has_derivative f') F \<Longrightarrow> f' = g' \<Longrightarrow> (f has_derivative g') F"
    25   by simp
    26 
    27 ML {*
    28 
    29 structure FDERIV_Intros = Named_Thms
    30 (
    31   val name = @{binding FDERIV_intros}
    32   val description = "introduction rules for FDERIV"
    33 )
    34 
    35 *}
    36 
    37 setup {*
    38   FDERIV_Intros.setup #>
    39   Global_Theory.add_thms_dynamic (@{binding FDERIV_eq_intros},
    40     map_filter (try (fn thm => @{thm FDERIV_eq_rhs} OF [thm])) o FDERIV_Intros.get o Context.proof_of);
    41 *}
    42 
    43 lemma FDERIV_bounded_linear: "(f has_derivative f') F \<Longrightarrow> bounded_linear f'"
    44   by (simp add: has_derivative_def)
    45 
    46 lemma FDERIV_ident[FDERIV_intros, simp]: "((\<lambda>x. x) has_derivative (\<lambda>x. x)) F"
    47   by (simp add: has_derivative_def tendsto_const)
    48 
    49 lemma FDERIV_const[FDERIV_intros, simp]: "((\<lambda>x. c) has_derivative (\<lambda>x. 0)) F"
    50   by (simp add: has_derivative_def tendsto_const)
    51 
    52 lemma (in bounded_linear) bounded_linear: "bounded_linear f" ..
    53 
    54 lemma (in bounded_linear) FDERIV:
    55   "(g has_derivative g') F \<Longrightarrow> ((\<lambda>x. f (g x)) has_derivative (\<lambda>x. f (g' x))) F"
    56   using assms unfolding has_derivative_def
    57   apply safe
    58   apply (erule bounded_linear_compose [OF local.bounded_linear])
    59   apply (drule local.tendsto)
    60   apply (simp add: local.scaleR local.diff local.add local.zero)
    61   done
    62 
    63 lemmas FDERIV_scaleR_right [FDERIV_intros] =
    64   bounded_linear.FDERIV [OF bounded_linear_scaleR_right]
    65 
    66 lemmas FDERIV_scaleR_left [FDERIV_intros] =
    67   bounded_linear.FDERIV [OF bounded_linear_scaleR_left]
    68 
    69 lemmas FDERIV_mult_right [FDERIV_intros] =
    70   bounded_linear.FDERIV [OF bounded_linear_mult_right]
    71 
    72 lemmas FDERIV_mult_left [FDERIV_intros] =
    73   bounded_linear.FDERIV [OF bounded_linear_mult_left]
    74 
    75 lemma FDERIV_add[simp, FDERIV_intros]:
    76   assumes f: "(f has_derivative f') F" and g: "(g has_derivative g') F"
    77   shows "((\<lambda>x. f x + g x) has_derivative (\<lambda>x. f' x + g' x)) F"
    78   unfolding has_derivative_def
    79 proof safe
    80   let ?x = "Lim F (\<lambda>x. x)"
    81   let ?D = "\<lambda>f f' y. ((f y - f ?x) - f' (y - ?x)) /\<^sub>R norm (y - ?x)"
    82   have "((\<lambda>x. ?D f f' x + ?D g g' x) ---> (0 + 0)) F"
    83     using f g by (intro tendsto_add) (auto simp: has_derivative_def)
    84   then show "(?D (\<lambda>x. f x + g x) (\<lambda>x. f' x + g' x) ---> 0) F"
    85     by (simp add: field_simps scaleR_add_right scaleR_diff_right)
    86 qed (blast intro: bounded_linear_add f g FDERIV_bounded_linear)
    87 
    88 lemma FDERIV_setsum[simp, FDERIV_intros]:
    89   assumes f: "\<And>i. i \<in> I \<Longrightarrow> (f i has_derivative f' i) F"
    90   shows "((\<lambda>x. \<Sum>i\<in>I. f i x) has_derivative (\<lambda>x. \<Sum>i\<in>I. f' i x)) F"
    91 proof cases
    92   assume "finite I" from this f show ?thesis
    93     by induct (simp_all add: f)
    94 qed simp
    95 
    96 lemma FDERIV_minus[simp, FDERIV_intros]: "(f has_derivative f') F \<Longrightarrow> ((\<lambda>x. - f x) has_derivative (\<lambda>x. - f' x)) F"
    97   using FDERIV_scaleR_right[of f f' F "-1"] by simp
    98 
    99 lemma FDERIV_diff[simp, FDERIV_intros]:
   100   "(f has_derivative f') F \<Longrightarrow> (g has_derivative g') F \<Longrightarrow> ((\<lambda>x. f x - g x) has_derivative (\<lambda>x. f' x - g' x)) F"
   101   by (simp only: diff_minus FDERIV_add FDERIV_minus)
   102 
   103 abbreviation
   104   -- {* Frechet derivative: D is derivative of function f at x within s *}
   105   FDERIV :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow>  ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   106   ("(FDERIV (_)/ (_)/ : (_)/ :> (_))" [1000, 1000, 1000, 60] 60)
   107 where
   108   "FDERIV f x : s :> f' \<equiv> (f has_derivative f') (at x within s)"
   109 
   110 abbreviation
   111   fderiv_at ::
   112     "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   113     ("(FDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   114 where
   115   "FDERIV f x :> D \<equiv> FDERIV f x : UNIV :> D"
   116 
   117 lemma FDERIV_def:
   118   "FDERIV f x : s :> f' \<longleftrightarrow>
   119     (bounded_linear f' \<and> ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) ---> 0) (at x within s))"
   120   by (cases "at x within s = bot") (simp_all add: has_derivative_def Lim_ident_at)
   121 
   122 lemma FDERIV_iff_norm:
   123   "FDERIV f x : s :> f' \<longleftrightarrow>
   124     (bounded_linear f' \<and> ((\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x)) ---> 0) (at x within s))"
   125   using tendsto_norm_zero_iff[of _ "at x within s", where 'b="'b", symmetric]
   126   by (simp add: FDERIV_def divide_inverse ac_simps)
   127 
   128 lemma fderiv_def:
   129   "FDERIV f x :> D = (bounded_linear D \<and> (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0)"
   130   unfolding FDERIV_iff_norm LIM_offset_zero_iff[of _ _ x] by simp
   131 
   132 lemma field_fderiv_def:
   133   fixes x :: "'a::real_normed_field"
   134   shows "FDERIV f x :> (\<lambda>h. h * D) = (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   135   apply (unfold fderiv_def)
   136   apply (simp add: bounded_linear_mult_left)
   137   apply (simp cong: LIM_cong add: nonzero_norm_divide [symmetric])
   138   apply (subst diff_divide_distrib)
   139   apply (subst times_divide_eq_left [symmetric])
   140   apply (simp cong: LIM_cong)
   141   apply (simp add: tendsto_norm_zero_iff LIM_zero_iff)
   142   done
   143 
   144 lemma FDERIV_I:
   145   "bounded_linear f' \<Longrightarrow> ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) ---> 0) (at x within s) \<Longrightarrow>
   146   FDERIV f x : s :> f'"
   147   by (simp add: FDERIV_def)
   148 
   149 lemma FDERIV_I_sandwich:
   150   assumes e: "0 < e" and bounded: "bounded_linear f'"
   151     and sandwich: "(\<And>y. y \<in> s \<Longrightarrow> y \<noteq> x \<Longrightarrow> dist y x < e \<Longrightarrow> norm ((f y - f x) - f' (y - x)) / norm (y - x) \<le> H y)"
   152     and "(H ---> 0) (at x within s)"
   153   shows "FDERIV f x : s :> f'"
   154   unfolding FDERIV_iff_norm
   155 proof safe
   156   show "((\<lambda>y. norm (f y - f x - f' (y - x)) / norm (y - x)) ---> 0) (at x within s)"
   157   proof (rule tendsto_sandwich[where f="\<lambda>x. 0"])
   158     show "(H ---> 0) (at x within s)" by fact
   159     show "eventually (\<lambda>n. norm (f n - f x - f' (n - x)) / norm (n - x) \<le> H n) (at x within s)"
   160       unfolding eventually_at using e sandwich by auto
   161   qed (auto simp: le_divide_eq tendsto_const)
   162 qed fact
   163 
   164 lemma FDERIV_subset: "FDERIV f x : s :> f' \<Longrightarrow> t \<subseteq> s \<Longrightarrow> FDERIV f x : t :> f'"
   165   by (auto simp add: FDERIV_iff_norm intro: tendsto_within_subset)
   166 
   167 subsection {* Continuity *}
   168 
   169 lemma FDERIV_continuous:
   170   assumes f: "FDERIV f x : s :> f'"
   171   shows "continuous (at x within s) f"
   172 proof -
   173   from f interpret F: bounded_linear f' by (rule FDERIV_bounded_linear)
   174   note F.tendsto[tendsto_intros]
   175   let ?L = "\<lambda>f. (f ---> 0) (at x within s)"
   176   have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x))"
   177     using f unfolding FDERIV_iff_norm by blast
   178   then have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x) * norm (y - x))" (is ?m)
   179     by (rule tendsto_mult_zero) (auto intro!: tendsto_eq_intros)
   180   also have "?m \<longleftrightarrow> ?L (\<lambda>y. norm ((f y - f x) - f' (y - x)))"
   181     by (intro filterlim_cong) (simp_all add: eventually_at_filter)
   182   finally have "?L (\<lambda>y. (f y - f x) - f' (y - x))"
   183     by (rule tendsto_norm_zero_cancel)
   184   then have "?L (\<lambda>y. ((f y - f x) - f' (y - x)) + f' (y - x))"
   185     by (rule tendsto_eq_intros) (auto intro!: tendsto_eq_intros simp: F.zero)
   186   then have "?L (\<lambda>y. f y - f x)"
   187     by simp
   188   from tendsto_add[OF this tendsto_const, of "f x"] show ?thesis
   189     by (simp add: continuous_within)
   190 qed
   191 
   192 subsection {* Composition *}
   193 
   194 lemma tendsto_at_iff_tendsto_nhds_within: "f x = y \<Longrightarrow> (f ---> y) (at x within s) \<longleftrightarrow> (f ---> y) (inf (nhds x) (principal s))"
   195   unfolding tendsto_def eventually_inf_principal eventually_at_filter
   196   by (intro ext all_cong imp_cong) (auto elim!: eventually_elim1)
   197 
   198 lemma FDERIV_in_compose:
   199   assumes f: "FDERIV f x : s :> f'"
   200   assumes g: "FDERIV g (f x) : (f`s) :> g'"
   201   shows "FDERIV (\<lambda>x. g (f x)) x : s :> (\<lambda>x. g' (f' x))"
   202 proof -
   203   from f interpret F: bounded_linear f' by (rule FDERIV_bounded_linear)
   204   from g interpret G: bounded_linear g' by (rule FDERIV_bounded_linear)
   205   from F.bounded obtain kF where kF: "\<And>x. norm (f' x) \<le> norm x * kF" by fast
   206   from G.bounded obtain kG where kG: "\<And>x. norm (g' x) \<le> norm x * kG" by fast
   207   note G.tendsto[tendsto_intros]
   208 
   209   let ?L = "\<lambda>f. (f ---> 0) (at x within s)"
   210   let ?D = "\<lambda>f f' x y. (f y - f x) - f' (y - x)"
   211   let ?N = "\<lambda>f f' x y. norm (?D f f' x y) / norm (y - x)"
   212   let ?gf = "\<lambda>x. g (f x)" and ?gf' = "\<lambda>x. g' (f' x)"
   213   def Nf \<equiv> "?N f f' x"
   214   def Ng \<equiv> "\<lambda>y. ?N g g' (f x) (f y)"
   215 
   216   show ?thesis
   217   proof (rule FDERIV_I_sandwich[of 1])
   218     show "bounded_linear (\<lambda>x. g' (f' x))"
   219       using f g by (blast intro: bounded_linear_compose FDERIV_bounded_linear)
   220   next
   221     fix y::'a assume neq: "y \<noteq> x"
   222     have "?N ?gf ?gf' x y = norm (g' (?D f f' x y) + ?D g g' (f x) (f y)) / norm (y - x)"
   223       by (simp add: G.diff G.add field_simps)
   224     also have "\<dots> \<le> norm (g' (?D f f' x y)) / norm (y - x) + Ng y * (norm (f y - f x) / norm (y - x))"
   225       by (simp add: add_divide_distrib[symmetric] divide_right_mono norm_triangle_ineq G.zero Ng_def)
   226     also have "\<dots> \<le> Nf y * kG + Ng y * (Nf y + kF)"
   227     proof (intro add_mono mult_left_mono)
   228       have "norm (f y - f x) = norm (?D f f' x y + f' (y - x))"
   229         by simp
   230       also have "\<dots> \<le> norm (?D f f' x y) + norm (f' (y - x))"
   231         by (rule norm_triangle_ineq)
   232       also have "\<dots> \<le> norm (?D f f' x y) + norm (y - x) * kF"
   233         using kF by (intro add_mono) simp
   234       finally show "norm (f y - f x) / norm (y - x) \<le> Nf y + kF"
   235         by (simp add: neq Nf_def field_simps)
   236     qed (insert kG, simp_all add: Ng_def Nf_def neq zero_le_divide_iff field_simps)
   237     finally show "?N ?gf ?gf' x y \<le> Nf y * kG + Ng y * (Nf y + kF)" .
   238   next
   239     have [tendsto_intros]: "?L Nf"
   240       using f unfolding FDERIV_iff_norm Nf_def ..
   241     from f have "(f ---> f x) (at x within s)"
   242       by (blast intro: FDERIV_continuous continuous_within[THEN iffD1])
   243     then have f': "LIM x at x within s. f x :> inf (nhds (f x)) (principal (f`s))"
   244       unfolding filterlim_def
   245       by (simp add: eventually_filtermap eventually_at_filter le_principal)
   246 
   247     have "((?N g  g' (f x)) ---> 0) (at (f x) within f`s)"
   248       using g unfolding FDERIV_iff_norm ..
   249     then have g': "((?N g  g' (f x)) ---> 0) (inf (nhds (f x)) (principal (f`s)))"
   250       by (rule tendsto_at_iff_tendsto_nhds_within[THEN iffD1, rotated]) simp
   251 
   252     have [tendsto_intros]: "?L Ng"
   253       unfolding Ng_def by (rule filterlim_compose[OF g' f'])
   254     show "((\<lambda>y. Nf y * kG + Ng y * (Nf y + kF)) ---> 0) (at x within s)"
   255       by (intro tendsto_eq_intros) auto
   256   qed simp
   257 qed
   258 
   259 lemma FDERIV_compose:
   260   "FDERIV f x : s :> f' \<Longrightarrow> FDERIV g (f x) :> g' \<Longrightarrow> FDERIV (\<lambda>x. g (f x)) x : s :> (\<lambda>x. g' (f' x))"
   261   by (blast intro: FDERIV_in_compose FDERIV_subset)
   262 
   263 lemma (in bounded_bilinear) FDERIV:
   264   assumes f: "FDERIV f x : s :> f'" and g: "FDERIV g x : s :> g'"
   265   shows "FDERIV (\<lambda>x. f x ** g x) x : s :> (\<lambda>h. f x ** g' h + f' h ** g x)"
   266 proof -
   267   from bounded_linear.bounded [OF FDERIV_bounded_linear [OF f]]
   268   obtain KF where norm_F: "\<And>x. norm (f' x) \<le> norm x * KF" by fast
   269 
   270   from pos_bounded obtain K where K: "0 < K" and norm_prod:
   271     "\<And>a b. norm (a ** b) \<le> norm a * norm b * K" by fast
   272   let ?D = "\<lambda>f f' y. f y - f x - f' (y - x)"
   273   let ?N = "\<lambda>f f' y. norm (?D f f' y) / norm (y - x)"
   274   def Ng =="?N g g'" and Nf =="?N f f'"
   275 
   276   let ?fun1 = "\<lambda>y. norm (f y ** g y - f x ** g x - (f x ** g' (y - x) + f' (y - x) ** g x)) / norm (y - x)"
   277   let ?fun2 = "\<lambda>y. norm (f x) * Ng y * K + Nf y * norm (g y) * K + KF * norm (g y - g x) * K"
   278   let ?F = "at x within s"
   279 
   280   show ?thesis
   281   proof (rule FDERIV_I_sandwich[of 1])
   282     show "bounded_linear (\<lambda>h. f x ** g' h + f' h ** g x)"
   283       by (intro bounded_linear_add
   284         bounded_linear_compose [OF bounded_linear_right] bounded_linear_compose [OF bounded_linear_left]
   285         FDERIV_bounded_linear [OF g] FDERIV_bounded_linear [OF f])
   286   next
   287     from g have "(g ---> g x) ?F"
   288       by (intro continuous_within[THEN iffD1] FDERIV_continuous)
   289     moreover from f g have "(Nf ---> 0) ?F" "(Ng ---> 0) ?F"
   290       by (simp_all add: FDERIV_iff_norm Ng_def Nf_def)
   291     ultimately have "(?fun2 ---> norm (f x) * 0 * K + 0 * norm (g x) * K + KF * norm (0::'b) * K) ?F"
   292       by (intro tendsto_intros) (simp_all add: LIM_zero_iff)
   293     then show "(?fun2 ---> 0) ?F"
   294       by simp
   295   next
   296     fix y::'d assume "y \<noteq> x"
   297     have "?fun1 y = norm (f x ** ?D g g' y + ?D f f' y ** g y + f' (y - x) ** (g y - g x)) / norm (y - x)"
   298       by (simp add: diff_left diff_right add_left add_right field_simps)
   299     also have "\<dots> \<le> (norm (f x) * norm (?D g g' y) * K + norm (?D f f' y) * norm (g y) * K +
   300         norm (y - x) * KF * norm (g y - g x) * K) / norm (y - x)"
   301       by (intro divide_right_mono mult_mono'
   302                 order_trans [OF norm_triangle_ineq add_mono]
   303                 order_trans [OF norm_prod mult_right_mono]
   304                 mult_nonneg_nonneg order_refl norm_ge_zero norm_F
   305                 K [THEN order_less_imp_le])
   306     also have "\<dots> = ?fun2 y"
   307       by (simp add: add_divide_distrib Ng_def Nf_def)
   308     finally show "?fun1 y \<le> ?fun2 y" .
   309   qed simp
   310 qed
   311 
   312 lemmas FDERIV_mult[simp, FDERIV_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_mult]
   313 lemmas FDERIV_scaleR[simp, FDERIV_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_scaleR]
   314 
   315 lemma FDERIV_setprod[simp, FDERIV_intros]:
   316   fixes f :: "'i \<Rightarrow> 'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   317   assumes f: "\<And>i. i \<in> I \<Longrightarrow> FDERIV (f i) x : s :> f' i"
   318   shows "FDERIV (\<lambda>x. \<Prod>i\<in>I. f i x) x : s :> (\<lambda>y. \<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x))"
   319 proof cases
   320   assume "finite I" from this f show ?thesis
   321   proof induct
   322     case (insert i I)
   323     let ?P = "\<lambda>y. f i x * (\<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x)) + (f' i y) * (\<Prod>i\<in>I. f i x)"
   324     have "FDERIV (\<lambda>x. f i x * (\<Prod>i\<in>I. f i x)) x : s :> ?P"
   325       using insert by (intro FDERIV_mult) auto
   326     also have "?P = (\<lambda>y. \<Sum>i'\<in>insert i I. f' i' y * (\<Prod>j\<in>insert i I - {i'}. f j x))"
   327       using insert(1,2) by (auto simp add: setsum_right_distrib insert_Diff_if intro!: ext setsum_cong)
   328     finally show ?case
   329       using insert by simp
   330   qed simp  
   331 qed simp
   332 
   333 lemma FDERIV_power[simp, FDERIV_intros]:
   334   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   335   assumes f: "FDERIV f x : s :> f'"
   336   shows "FDERIV  (\<lambda>x. f x^n) x : s :> (\<lambda>y. of_nat n * f' y * f x^(n - 1))"
   337   using FDERIV_setprod[OF f, of "{..< n}"] by (simp add: setprod_constant ac_simps)
   338 
   339 lemma FDERIV_inverse':
   340   fixes x :: "'a::real_normed_div_algebra"
   341   assumes x: "x \<noteq> 0"
   342   shows "FDERIV inverse x : s :> (\<lambda>h. - (inverse x * h * inverse x))"
   343         (is "FDERIV ?inv x : s :> ?f")
   344 proof (rule FDERIV_I_sandwich)
   345   show "bounded_linear (\<lambda>h. - (?inv x * h * ?inv x))"
   346     apply (rule bounded_linear_minus)
   347     apply (rule bounded_linear_mult_const)
   348     apply (rule bounded_linear_const_mult)
   349     apply (rule bounded_linear_ident)
   350     done
   351 next
   352   show "0 < norm x" using x by simp
   353 next
   354   show "((\<lambda>y. norm (?inv y - ?inv x) * norm (?inv x)) ---> 0) (at x within s)"
   355     apply (rule tendsto_mult_left_zero)
   356     apply (rule tendsto_norm_zero)
   357     apply (rule LIM_zero)
   358     apply (rule tendsto_inverse)
   359     apply (rule tendsto_ident_at)
   360     apply (rule x)
   361     done
   362 next
   363   fix y::'a assume h: "y \<noteq> x" "dist y x < norm x"
   364   then have "y \<noteq> 0"
   365     by (auto simp: norm_conv_dist dist_commute)
   366   have "norm (?inv y - ?inv x - ?f (y -x)) / norm (y - x) = norm ((?inv y - ?inv x) * (y - x) * ?inv x) / norm (y - x)"
   367     apply (subst inverse_diff_inverse [OF `y \<noteq> 0` x])
   368     apply (subst minus_diff_minus)
   369     apply (subst norm_minus_cancel)
   370     apply (simp add: left_diff_distrib)
   371     done
   372   also have "\<dots> \<le> norm (?inv y - ?inv x) * norm (y - x) * norm (?inv x) / norm (y - x)"
   373     apply (rule divide_right_mono [OF _ norm_ge_zero])
   374     apply (rule order_trans [OF norm_mult_ineq])
   375     apply (rule mult_right_mono [OF _ norm_ge_zero])
   376     apply (rule norm_mult_ineq)
   377     done
   378   also have "\<dots> = norm (?inv y - ?inv x) * norm (?inv x)"
   379     by simp
   380   finally show "norm (?inv y - ?inv x - ?f (y -x)) / norm (y - x) \<le>
   381       norm (?inv y - ?inv x) * norm (?inv x)" .
   382 qed
   383 
   384 lemma FDERIV_inverse[simp, FDERIV_intros]:
   385   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   386   assumes x:  "f x \<noteq> 0" and f: "FDERIV f x : s :> f'"
   387   shows "FDERIV (\<lambda>x. inverse (f x)) x : s :> (\<lambda>h. - (inverse (f x) * f' h * inverse (f x)))"
   388   using FDERIV_compose[OF f FDERIV_inverse', OF x] .
   389 
   390 lemma FDERIV_divide[simp, FDERIV_intros]:
   391   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   392   assumes g: "FDERIV g x : s :> g'"
   393   assumes x:  "f x \<noteq> 0" and f: "FDERIV f x : s :> f'"
   394   shows "FDERIV (\<lambda>x. g x / f x) x : s :> (\<lambda>h. - g x * (inverse (f x) * f' h * inverse (f x)) + g' h / f x)"
   395   using FDERIV_mult[OF g FDERIV_inverse[OF x f]]
   396   by (simp add: divide_inverse)
   397 
   398 subsection {* Uniqueness *}
   399 
   400 text {*
   401 
   402 This can not generally shown for @{const FDERIV}, as we need to approach the point from
   403 all directions. There is a proof in @{text Multivariate_Analysis} for @{text euclidean_space}.
   404 
   405 *}
   406 
   407 lemma FDERIV_zero_unique:
   408   assumes "FDERIV (\<lambda>x. 0) x :> F" shows "F = (\<lambda>h. 0)"
   409 proof -
   410   interpret F: bounded_linear F
   411     using assms by (rule FDERIV_bounded_linear)
   412   let ?r = "\<lambda>h. norm (F h) / norm h"
   413   have *: "?r -- 0 --> 0"
   414     using assms unfolding fderiv_def by simp
   415   show "F = (\<lambda>h. 0)"
   416   proof
   417     fix h show "F h = 0"
   418     proof (rule ccontr)
   419       assume "F h \<noteq> 0"
   420       moreover from this have h: "h \<noteq> 0"
   421         by (clarsimp simp add: F.zero)
   422       ultimately have "0 < ?r h"
   423         by (simp add: divide_pos_pos)
   424       from LIM_D [OF * this] obtain s where s: "0 < s"
   425         and r: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < s \<Longrightarrow> ?r x < ?r h" by auto
   426       from dense [OF s] obtain t where t: "0 < t \<and> t < s" ..
   427       let ?x = "scaleR (t / norm h) h"
   428       have "?x \<noteq> 0" and "norm ?x < s" using t h by simp_all
   429       hence "?r ?x < ?r h" by (rule r)
   430       thus "False" using t h by (simp add: F.scaleR)
   431     qed
   432   qed
   433 qed
   434 
   435 lemma FDERIV_unique:
   436   assumes "FDERIV f x :> F" and "FDERIV f x :> F'" shows "F = F'"
   437 proof -
   438   have "FDERIV (\<lambda>x. 0) x :> (\<lambda>h. F h - F' h)"
   439     using FDERIV_diff [OF assms] by simp
   440   hence "(\<lambda>h. F h - F' h) = (\<lambda>h. 0)"
   441     by (rule FDERIV_zero_unique)
   442   thus "F = F'"
   443     unfolding fun_eq_iff right_minus_eq .
   444 qed
   445 
   446 subsection {* Differentiability predicate *}
   447 
   448 definition isDiff :: "'a filter \<Rightarrow> ('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> bool" where
   449   isDiff_def: "isDiff F f \<longleftrightarrow> (\<exists>D. (f has_derivative D) F)"
   450 
   451 abbreviation differentiable_in :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> bool"
   452     ("(_) differentiable (_) in (_)"  [1000, 1000, 60] 60) where
   453   "f differentiable x in s \<equiv> isDiff (at x within s) f"
   454 
   455 abbreviation differentiable :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> bool"
   456     (infixl "differentiable" 60) where
   457   "f differentiable x \<equiv> f differentiable x in UNIV"
   458 
   459 lemma differentiable_subset: "f differentiable x in s \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f differentiable x in t"
   460   unfolding isDiff_def by (blast intro: FDERIV_subset)
   461 
   462 lemma differentiable_ident [simp]: "isDiff F (\<lambda>x. x)"
   463   unfolding isDiff_def by (blast intro: FDERIV_ident)
   464 
   465 lemma differentiable_const [simp]: "isDiff F (\<lambda>z. a)"
   466   unfolding isDiff_def by (blast intro: FDERIV_const)
   467 
   468 lemma differentiable_in_compose:
   469   "f differentiable (g x) in (g`s) \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f (g x)) differentiable x in s"
   470   unfolding isDiff_def by (blast intro: FDERIV_in_compose)
   471 
   472 lemma differentiable_compose:
   473   "f differentiable (g x) \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f (g x)) differentiable x in s"
   474   by (blast intro: differentiable_in_compose differentiable_subset)
   475 
   476 lemma differentiable_sum [simp]:
   477   "isDiff F f \<Longrightarrow> isDiff F g \<Longrightarrow> isDiff F (\<lambda>x. f x + g x)"
   478   unfolding isDiff_def by (blast intro: FDERIV_add)
   479 
   480 lemma differentiable_minus [simp]:
   481   "isDiff F f \<Longrightarrow> isDiff F (\<lambda>x. - f x)"
   482   unfolding isDiff_def by (blast intro: FDERIV_minus)
   483 
   484 lemma differentiable_diff [simp]:
   485   "isDiff F f \<Longrightarrow> isDiff F g \<Longrightarrow> isDiff F (\<lambda>x. f x - g x)"
   486   unfolding isDiff_def by (blast intro: FDERIV_diff)
   487 
   488 lemma differentiable_mult [simp]:
   489   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_algebra"
   490   shows "f differentiable x in s \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f x * g x) differentiable x in s"
   491   unfolding isDiff_def by (blast intro: FDERIV_mult)
   492 
   493 lemma differentiable_inverse [simp]:
   494   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   495   shows "f differentiable x in s \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> (\<lambda>x. inverse (f x)) differentiable x in s"
   496   unfolding isDiff_def by (blast intro: FDERIV_inverse)
   497 
   498 lemma differentiable_divide [simp]:
   499   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   500   shows "f differentiable x in s \<Longrightarrow> g differentiable x in s \<Longrightarrow> g x \<noteq> 0 \<Longrightarrow> (\<lambda>x. f x / g x) differentiable x in s"
   501   unfolding divide_inverse using assms by simp
   502 
   503 lemma differentiable_power [simp]:
   504   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   505   shows "f differentiable x in s \<Longrightarrow> (\<lambda>x. f x ^ n) differentiable x in s"
   506   unfolding isDiff_def by (blast intro: FDERIV_power)
   507 
   508 lemma differentiable_scaleR [simp]:
   509   "f differentiable x in s \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) differentiable x in s"
   510   unfolding isDiff_def by (blast intro: FDERIV_scaleR)
   511 
   512 definition 
   513   -- {*Differentiation: D is derivative of function f at x*}
   514   deriv ::
   515     "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool"
   516     ("(DERIV (_)/ (_)/ : (_)/ :> (_))" [1000, 1000, 1000, 60] 60)
   517 where
   518   deriv_fderiv: "DERIV f x : s :> D = FDERIV f x : s :> (\<lambda>x. x * D)"
   519 
   520 abbreviation
   521   -- {*Differentiation: D is derivative of function f at x*}
   522   deriv_at ::
   523     "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   524     ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   525 where
   526   "DERIV f x :> D \<equiv> DERIV f x : UNIV :> D"
   527 
   528 lemma differentiable_def: "(f::real \<Rightarrow> real) differentiable x in s \<longleftrightarrow> (\<exists>D. DERIV f x : s :> D)"
   529 proof safe
   530   assume "f differentiable x in s"
   531   then obtain f' where "FDERIV f x : s :> f'"
   532     unfolding isDiff_def by auto
   533   moreover then obtain c where "f' = (\<lambda>x. x * c)"
   534     by (metis real_bounded_linear FDERIV_bounded_linear)
   535   ultimately show "\<exists>D. DERIV f x : s :> D"
   536     unfolding deriv_fderiv by auto
   537 qed (auto simp: isDiff_def deriv_fderiv)
   538 
   539 lemma differentiableE [elim?]:
   540   fixes f :: "real \<Rightarrow> real"
   541   assumes f: "f differentiable x in s" obtains df where "DERIV f x : s :> df"
   542   using assms by (auto simp: differentiable_def)
   543 
   544 lemma differentiableD: "(f::real \<Rightarrow> real) differentiable x in s \<Longrightarrow> \<exists>D. DERIV f x : s :> D"
   545   by (auto elim: differentiableE)
   546 
   547 lemma differentiableI: "DERIV f x : s :> D \<Longrightarrow> (f::real \<Rightarrow> real) differentiable x in s"
   548   by (force simp add: differentiable_def)
   549 
   550 lemma DERIV_I_FDERIV: "FDERIV f x : s :> F \<Longrightarrow> (\<And>x. x * F' = F x) \<Longrightarrow> DERIV f x : s :> F'"
   551   by (simp add: deriv_fderiv)
   552 
   553 lemma DERIV_D_FDERIV: "DERIV f x : s :> F \<Longrightarrow> FDERIV f x : s :> (\<lambda>x. x * F)"
   554   by (simp add: deriv_fderiv)
   555 
   556 lemma deriv_def:
   557   "DERIV f x :> D \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   558   apply (simp add: deriv_fderiv fderiv_def bounded_linear_mult_left LIM_zero_iff[symmetric, of _ D])
   559   apply (subst (2) tendsto_norm_zero_iff[symmetric])
   560   apply (rule filterlim_cong)
   561   apply (simp_all add: eventually_at_filter field_simps nonzero_norm_divide)
   562   done
   563 
   564 subsection {* Derivatives *}
   565 
   566 lemma DERIV_iff: "(DERIV f x :> D) \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   567   by (simp add: deriv_def)
   568 
   569 lemma DERIV_D: "DERIV f x :> D \<Longrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   570   by (simp add: deriv_def)
   571 
   572 lemma DERIV_const [simp]: "DERIV (\<lambda>x. k) x : s :> 0"
   573   by (rule DERIV_I_FDERIV[OF FDERIV_const]) auto
   574 
   575 lemma DERIV_ident [simp]: "DERIV (\<lambda>x. x) x : s :> 1"
   576   by (rule DERIV_I_FDERIV[OF FDERIV_ident]) auto
   577 
   578 lemma DERIV_add: "DERIV f x : s :> D \<Longrightarrow> DERIV g x : s :> E \<Longrightarrow> DERIV (\<lambda>x. f x + g x) x : s :> D + E"
   579   by (rule DERIV_I_FDERIV[OF FDERIV_add]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   580 
   581 lemma DERIV_minus: "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. - f x) x : s :> - D"
   582   by (rule DERIV_I_FDERIV[OF FDERIV_minus]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   583 
   584 lemma DERIV_diff: "DERIV f x : s :> D \<Longrightarrow> DERIV g x : s :> E \<Longrightarrow> DERIV (\<lambda>x. f x - g x) x : s :> D - E"
   585   by (rule DERIV_I_FDERIV[OF FDERIV_diff]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   586 
   587 lemma DERIV_add_minus: "DERIV f x : s :> D \<Longrightarrow> DERIV g x : s :> E \<Longrightarrow> DERIV (\<lambda>x. f x + - g x) x : s :> D + - E"
   588   by (simp only: DERIV_add DERIV_minus)
   589 
   590 lemma DERIV_continuous: "DERIV f x : s :> D \<Longrightarrow> continuous (at x within s) f"
   591   by (drule FDERIV_continuous[OF DERIV_D_FDERIV]) simp
   592 
   593 lemma DERIV_isCont: "DERIV f x :> D \<Longrightarrow> isCont f x"
   594   by (auto dest!: DERIV_continuous)
   595 
   596 lemma DERIV_mult': "DERIV f x : s :> D \<Longrightarrow> DERIV g x : s :> E \<Longrightarrow> DERIV (\<lambda>x. f x * g x) x : s :> f x * E + D * g x"
   597   by (rule DERIV_I_FDERIV[OF FDERIV_mult]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   598 
   599 lemma DERIV_mult: "DERIV f x : s :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (\<lambda>x. f x * g x) x : s :> Da * g x + Db * f x"
   600   by (rule DERIV_I_FDERIV[OF FDERIV_mult]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   601 
   602 text {* Derivative of linear multiplication *}
   603 
   604 lemma DERIV_cmult:
   605   "DERIV f x : s :> D ==> DERIV (%x. c * f x) x : s :> c*D"
   606   by (drule DERIV_mult' [OF DERIV_const], simp)
   607 
   608 lemma DERIV_cmult_Id [simp]: "DERIV (op * c) x : s :> c"
   609   by (cut_tac c = c and x = x in DERIV_ident [THEN DERIV_cmult], simp)
   610 
   611 lemma DERIV_cdivide: "DERIV f x : s :> D ==> DERIV (%x. f x / c) x : s :> D / c"
   612   apply (subgoal_tac "DERIV (%x. (1 / c) * f x) x : s :> (1 / c) * D", force)
   613   apply (erule DERIV_cmult)
   614   done
   615 
   616 lemma DERIV_unique:
   617   "DERIV f x :> D \<Longrightarrow> DERIV f x :> E \<Longrightarrow> D = E"
   618   unfolding deriv_def by (rule LIM_unique) 
   619 
   620 lemma DERIV_setsum':
   621   "(\<And> n. n \<in> S \<Longrightarrow> DERIV (%x. f x n) x : s :> (f' x n)) \<Longrightarrow> DERIV (\<lambda>x. setsum (f x) S) x : s :> setsum (f' x) S"
   622   by (rule DERIV_I_FDERIV[OF FDERIV_setsum]) (auto simp: setsum_right_distrib dest: DERIV_D_FDERIV)
   623 
   624 lemma DERIV_setsum:
   625   "finite S \<Longrightarrow> (\<And> n. n \<in> S \<Longrightarrow> DERIV (%x. f x n) x : s :> (f' x n)) \<Longrightarrow> DERIV (\<lambda>x. setsum (f x) S) x : s :> setsum (f' x) S"
   626   by (rule DERIV_setsum')
   627 
   628 lemma DERIV_sumr [rule_format (no_asm)]: (* REMOVE *)
   629      "(\<forall>r. m \<le> r & r < (m + n) --> DERIV (%x. f r x) x : s :> (f' r x))
   630       --> DERIV (%x. \<Sum>n=m..<n::nat. f n x :: real) x : s :> (\<Sum>r=m..<n. f' r x)"
   631   by (auto intro: DERIV_setsum)
   632 
   633 lemma DERIV_inverse':
   634   "DERIV f x : s :> D \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse (f x)) x : s :> - (inverse (f x) * D * inverse (f x))"
   635   by (rule DERIV_I_FDERIV[OF FDERIV_inverse]) (auto dest: DERIV_D_FDERIV)
   636 
   637 text {* Power of @{text "-1"} *}
   638 
   639 lemma DERIV_inverse:
   640   "x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse(x)) x : s :> - (inverse x ^ Suc (Suc 0))"
   641   by (drule DERIV_inverse' [OF DERIV_ident]) simp
   642 
   643 text {* Derivative of inverse *}
   644 
   645 lemma DERIV_inverse_fun:
   646   "DERIV f x : s :> d \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse (f x)) x : s :> (- (d * inverse(f x ^ Suc (Suc 0))))"
   647   by (drule (1) DERIV_inverse') (simp add: mult_ac nonzero_inverse_mult_distrib)
   648 
   649 text {* Derivative of quotient *}
   650 
   651 lemma DERIV_divide:
   652   "DERIV f x : s :> D \<Longrightarrow> DERIV g x : s :> E \<Longrightarrow> g x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. f x / g x) x : s :> (D * g x - f x * E) / (g x * g x)"
   653   by (rule DERIV_I_FDERIV[OF FDERIV_divide])
   654      (auto dest: DERIV_D_FDERIV simp: field_simps nonzero_inverse_mult_distrib divide_inverse)
   655 
   656 lemma DERIV_quotient:
   657   "DERIV f x : s :> d \<Longrightarrow> DERIV g x : s :> e \<Longrightarrow> g x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>y. f y / g y) x : s :> (d * g x - (e * f x)) / (g x ^ Suc (Suc 0))"
   658   by (drule (2) DERIV_divide) (simp add: mult_commute)
   659 
   660 lemma DERIV_power_Suc:
   661   "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. f x ^ Suc n) x : s :> (1 + of_nat n) * (D * f x ^ n)"
   662   by (rule DERIV_I_FDERIV[OF FDERIV_power]) (auto simp: deriv_fderiv)
   663 
   664 lemma DERIV_power:
   665   "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. f x ^ n) x : s :> of_nat n * (D * f x ^ (n - Suc 0))"
   666   by (rule DERIV_I_FDERIV[OF FDERIV_power]) (auto simp: deriv_fderiv)
   667 
   668 lemma DERIV_pow: "DERIV (%x. x ^ n) x : s :> real n * (x ^ (n - Suc 0))"
   669   apply (cut_tac DERIV_power [OF DERIV_ident])
   670   apply (simp add: real_of_nat_def)
   671   done
   672 
   673 lemma DERIV_chain': "DERIV f x : s :> D \<Longrightarrow> DERIV g (f x) :> E \<Longrightarrow> DERIV (\<lambda>x. g (f x)) x : s :> E * D"
   674   using FDERIV_compose[of f "\<lambda>x. x * D" x s g "\<lambda>x. x * E"]
   675   by (auto simp: deriv_fderiv ac_simps dest: FDERIV_subset)
   676 
   677 text {* Standard version *}
   678 
   679 lemma DERIV_chain: "DERIV f (g x) :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (f o g) x : s :> Da * Db"
   680   by (drule (1) DERIV_chain', simp add: o_def mult_commute)
   681 
   682 lemma DERIV_chain2: "DERIV f (g x) :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (%x. f (g x)) x : s :> Da * Db"
   683   by (auto dest: DERIV_chain simp add: o_def)
   684 
   685 subsubsection {* @{text "DERIV_intros"} *}
   686 
   687 ML {*
   688 structure Deriv_Intros = Named_Thms
   689 (
   690   val name = @{binding DERIV_intros}
   691   val description = "DERIV introduction rules"
   692 )
   693 *}
   694 
   695 setup Deriv_Intros.setup
   696 
   697 lemma DERIV_cong: "DERIV f x : s :> X \<Longrightarrow> X = Y \<Longrightarrow> DERIV f x : s :> Y"
   698   by simp
   699 
   700 declare
   701   DERIV_const[THEN DERIV_cong, DERIV_intros]
   702   DERIV_ident[THEN DERIV_cong, DERIV_intros]
   703   DERIV_add[THEN DERIV_cong, DERIV_intros]
   704   DERIV_minus[THEN DERIV_cong, DERIV_intros]
   705   DERIV_mult[THEN DERIV_cong, DERIV_intros]
   706   DERIV_diff[THEN DERIV_cong, DERIV_intros]
   707   DERIV_inverse'[THEN DERIV_cong, DERIV_intros]
   708   DERIV_divide[THEN DERIV_cong, DERIV_intros]
   709   DERIV_power[where 'a=real, THEN DERIV_cong,
   710               unfolded real_of_nat_def[symmetric], DERIV_intros]
   711   DERIV_setsum[THEN DERIV_cong, DERIV_intros]
   712 
   713 text{*Alternative definition for differentiability*}
   714 
   715 lemma DERIV_LIM_iff:
   716   fixes f :: "'a::{real_normed_vector,inverse} \<Rightarrow> 'a" shows
   717      "((%h. (f(a + h) - f(a)) / h) -- 0 --> D) =
   718       ((%x. (f(x)-f(a)) / (x-a)) -- a --> D)"
   719 apply (rule iffI)
   720 apply (drule_tac k="- a" in LIM_offset)
   721 apply (simp add: diff_minus)
   722 apply (drule_tac k="a" in LIM_offset)
   723 apply (simp add: add_commute)
   724 done
   725 
   726 lemma DERIV_iff2: "(DERIV f x :> D) \<longleftrightarrow> (\<lambda>z. (f z - f x) / (z - x)) --x --> D"
   727   by (simp add: deriv_def diff_minus [symmetric] DERIV_LIM_iff)
   728 
   729 lemma DERIV_cong_ev: "x = y \<Longrightarrow> eventually (\<lambda>x. f x = g x) (nhds x) \<Longrightarrow> u = v \<Longrightarrow>
   730     DERIV f x :> u \<longleftrightarrow> DERIV g y :> v"
   731   unfolding DERIV_iff2
   732 proof (rule filterlim_cong)
   733   assume "eventually (\<lambda>x. f x = g x) (nhds x)"
   734   moreover then have "f x = g x" by (auto simp: eventually_nhds)
   735   moreover assume "x = y" "u = v"
   736   ultimately show "eventually (\<lambda>xa. (f xa - f x) / (xa - x) = (g xa - g y) / (xa - y)) (at x)"
   737     by (auto simp: eventually_at_filter elim: eventually_elim1)
   738 qed simp_all
   739 
   740 lemma DERIV_shift:
   741   "(DERIV f (x + z) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (x + z)) x :> y)"
   742   by (simp add: DERIV_iff field_simps)
   743 
   744 lemma DERIV_mirror:
   745   "(DERIV f (- x) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (- x::real) :: real) x :> - y)"
   746   by (simp add: deriv_def filterlim_at_split filterlim_at_left_to_right
   747                 tendsto_minus_cancel_left field_simps conj_commute)
   748 
   749 text {* Caratheodory formulation of derivative at a point *}
   750 
   751 lemma CARAT_DERIV:
   752   "(DERIV f x :> l) \<longleftrightarrow> (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> isCont g x \<and> g x = l)"
   753       (is "?lhs = ?rhs")
   754 proof
   755   assume der: "DERIV f x :> l"
   756   show "\<exists>g. (\<forall>z. f z - f x = g z * (z-x)) \<and> isCont g x \<and> g x = l"
   757   proof (intro exI conjI)
   758     let ?g = "(%z. if z = x then l else (f z - f x) / (z-x))"
   759     show "\<forall>z. f z - f x = ?g z * (z-x)" by simp
   760     show "isCont ?g x" using der
   761       by (simp add: isCont_iff DERIV_iff diff_minus
   762                cong: LIM_equal [rule_format])
   763     show "?g x = l" by simp
   764   qed
   765 next
   766   assume "?rhs"
   767   then obtain g where
   768     "(\<forall>z. f z - f x = g z * (z-x))" and "isCont g x" and "g x = l" by blast
   769   thus "(DERIV f x :> l)"
   770      by (auto simp add: isCont_iff DERIV_iff cong: LIM_cong)
   771 qed
   772 
   773 text {*
   774  Let's do the standard proof, though theorem
   775  @{text "LIM_mult2"} follows from a NS proof
   776 *}
   777 
   778 subsection {* Local extrema *}
   779 
   780 text{*If @{term "0 < f'(x)"} then @{term x} is Locally Strictly Increasing At The Right*}
   781 
   782 lemma DERIV_pos_inc_right:
   783   fixes f :: "real => real"
   784   assumes der: "DERIV f x :> l"
   785       and l:   "0 < l"
   786   shows "\<exists>d > 0. \<forall>h > 0. h < d --> f(x) < f(x + h)"
   787 proof -
   788   from l der [THEN DERIV_D, THEN LIM_D [where r = "l"]]
   789   have "\<exists>s > 0. (\<forall>z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < l)"
   790     by (simp add: diff_minus)
   791   then obtain s
   792         where s:   "0 < s"
   793           and all: "!!z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < l"
   794     by auto
   795   thus ?thesis
   796   proof (intro exI conjI strip)
   797     show "0<s" using s .
   798     fix h::real
   799     assume "0 < h" "h < s"
   800     with all [of h] show "f x < f (x+h)"
   801     proof (simp add: abs_if pos_less_divide_eq diff_minus [symmetric]
   802     split add: split_if_asm)
   803       assume "~ (f (x+h) - f x) / h < l" and h: "0 < h"
   804       with l
   805       have "0 < (f (x+h) - f x) / h" by arith
   806       thus "f x < f (x+h)"
   807   by (simp add: pos_less_divide_eq h)
   808     qed
   809   qed
   810 qed
   811 
   812 lemma DERIV_neg_dec_left:
   813   fixes f :: "real => real"
   814   assumes der: "DERIV f x :> l"
   815       and l:   "l < 0"
   816   shows "\<exists>d > 0. \<forall>h > 0. h < d --> f(x) < f(x-h)"
   817 proof -
   818   from l der [THEN DERIV_D, THEN LIM_D [where r = "-l"]]
   819   have "\<exists>s > 0. (\<forall>z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < -l)"
   820     by (simp add: diff_minus)
   821   then obtain s
   822         where s:   "0 < s"
   823           and all: "!!z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < -l"
   824     by auto
   825   thus ?thesis
   826   proof (intro exI conjI strip)
   827     show "0<s" using s .
   828     fix h::real
   829     assume "0 < h" "h < s"
   830     with all [of "-h"] show "f x < f (x-h)"
   831     proof (simp add: abs_if pos_less_divide_eq diff_minus [symmetric]
   832     split add: split_if_asm)
   833       assume " - ((f (x-h) - f x) / h) < l" and h: "0 < h"
   834       with l
   835       have "0 < (f (x-h) - f x) / h" by arith
   836       thus "f x < f (x-h)"
   837   by (simp add: pos_less_divide_eq h)
   838     qed
   839   qed
   840 qed
   841 
   842 lemma DERIV_pos_inc_left:
   843   fixes f :: "real => real"
   844   shows "DERIV f x :> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d --> f(x - h) < f(x)"
   845   apply (rule DERIV_neg_dec_left [of "%x. - f x" x "-l", simplified])
   846   apply (auto simp add: DERIV_minus)
   847   done
   848 
   849 lemma DERIV_neg_dec_right:
   850   fixes f :: "real => real"
   851   shows "DERIV f x :> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d --> f(x) > f(x + h)"
   852   apply (rule DERIV_pos_inc_right [of "%x. - f x" x "-l", simplified])
   853   apply (auto simp add: DERIV_minus)
   854   done
   855 
   856 lemma DERIV_local_max:
   857   fixes f :: "real => real"
   858   assumes der: "DERIV f x :> l"
   859       and d:   "0 < d"
   860       and le:  "\<forall>y. \<bar>x-y\<bar> < d --> f(y) \<le> f(x)"
   861   shows "l = 0"
   862 proof (cases rule: linorder_cases [of l 0])
   863   case equal thus ?thesis .
   864 next
   865   case less
   866   from DERIV_neg_dec_left [OF der less]
   867   obtain d' where d': "0 < d'"
   868              and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x-h)" by blast
   869   from real_lbound_gt_zero [OF d d']
   870   obtain e where "0 < e \<and> e < d \<and> e < d'" ..
   871   with lt le [THEN spec [where x="x-e"]]
   872   show ?thesis by (auto simp add: abs_if)
   873 next
   874   case greater
   875   from DERIV_pos_inc_right [OF der greater]
   876   obtain d' where d': "0 < d'"
   877              and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x + h)" by blast
   878   from real_lbound_gt_zero [OF d d']
   879   obtain e where "0 < e \<and> e < d \<and> e < d'" ..
   880   with lt le [THEN spec [where x="x+e"]]
   881   show ?thesis by (auto simp add: abs_if)
   882 qed
   883 
   884 
   885 text{*Similar theorem for a local minimum*}
   886 lemma DERIV_local_min:
   887   fixes f :: "real => real"
   888   shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) \<le> f(y) |] ==> l = 0"
   889 by (drule DERIV_minus [THEN DERIV_local_max], auto)
   890 
   891 
   892 text{*In particular, if a function is locally flat*}
   893 lemma DERIV_local_const:
   894   fixes f :: "real => real"
   895   shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) = f(y) |] ==> l = 0"
   896 by (auto dest!: DERIV_local_max)
   897 
   898 
   899 subsection {* Rolle's Theorem *}
   900 
   901 text{*Lemma about introducing open ball in open interval*}
   902 lemma lemma_interval_lt:
   903      "[| a < x;  x < b |]
   904       ==> \<exists>d::real. 0 < d & (\<forall>y. \<bar>x-y\<bar> < d --> a < y & y < b)"
   905 
   906 apply (simp add: abs_less_iff)
   907 apply (insert linorder_linear [of "x-a" "b-x"], safe)
   908 apply (rule_tac x = "x-a" in exI)
   909 apply (rule_tac [2] x = "b-x" in exI, auto)
   910 done
   911 
   912 lemma lemma_interval: "[| a < x;  x < b |] ==>
   913         \<exists>d::real. 0 < d &  (\<forall>y. \<bar>x-y\<bar> < d --> a \<le> y & y \<le> b)"
   914 apply (drule lemma_interval_lt, auto)
   915 apply force
   916 done
   917 
   918 text{*Rolle's Theorem.
   919    If @{term f} is defined and continuous on the closed interval
   920    @{text "[a,b]"} and differentiable on the open interval @{text "(a,b)"},
   921    and @{term "f(a) = f(b)"},
   922    then there exists @{text "x0 \<in> (a,b)"} such that @{term "f'(x0) = 0"}*}
   923 theorem Rolle:
   924   assumes lt: "a < b"
   925       and eq: "f(a) = f(b)"
   926       and con: "\<forall>x. a \<le> x & x \<le> b --> isCont f x"
   927       and dif [rule_format]: "\<forall>x. a < x & x < b --> f differentiable x"
   928   shows "\<exists>z::real. a < z & z < b & DERIV f z :> 0"
   929 proof -
   930   have le: "a \<le> b" using lt by simp
   931   from isCont_eq_Ub [OF le con]
   932   obtain x where x_max: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f z \<le> f x"
   933              and alex: "a \<le> x" and xleb: "x \<le> b"
   934     by blast
   935   from isCont_eq_Lb [OF le con]
   936   obtain x' where x'_min: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f x' \<le> f z"
   937               and alex': "a \<le> x'" and x'leb: "x' \<le> b"
   938     by blast
   939   show ?thesis
   940   proof cases
   941     assume axb: "a < x & x < b"
   942         --{*@{term f} attains its maximum within the interval*}
   943     hence ax: "a<x" and xb: "x<b" by arith + 
   944     from lemma_interval [OF ax xb]
   945     obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
   946       by blast
   947     hence bound': "\<forall>y. \<bar>x-y\<bar> < d \<longrightarrow> f y \<le> f x" using x_max
   948       by blast
   949     from differentiableD [OF dif [OF axb]]
   950     obtain l where der: "DERIV f x :> l" ..
   951     have "l=0" by (rule DERIV_local_max [OF der d bound'])
   952         --{*the derivative at a local maximum is zero*}
   953     thus ?thesis using ax xb der by auto
   954   next
   955     assume notaxb: "~ (a < x & x < b)"
   956     hence xeqab: "x=a | x=b" using alex xleb by arith
   957     hence fb_eq_fx: "f b = f x" by (auto simp add: eq)
   958     show ?thesis
   959     proof cases
   960       assume ax'b: "a < x' & x' < b"
   961         --{*@{term f} attains its minimum within the interval*}
   962       hence ax': "a<x'" and x'b: "x'<b" by arith+ 
   963       from lemma_interval [OF ax' x'b]
   964       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
   965   by blast
   966       hence bound': "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> f x' \<le> f y" using x'_min
   967   by blast
   968       from differentiableD [OF dif [OF ax'b]]
   969       obtain l where der: "DERIV f x' :> l" ..
   970       have "l=0" by (rule DERIV_local_min [OF der d bound'])
   971         --{*the derivative at a local minimum is zero*}
   972       thus ?thesis using ax' x'b der by auto
   973     next
   974       assume notax'b: "~ (a < x' & x' < b)"
   975         --{*@{term f} is constant througout the interval*}
   976       hence x'eqab: "x'=a | x'=b" using alex' x'leb by arith
   977       hence fb_eq_fx': "f b = f x'" by (auto simp add: eq)
   978       from dense [OF lt]
   979       obtain r where ar: "a < r" and rb: "r < b" by blast
   980       from lemma_interval [OF ar rb]
   981       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>r-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
   982   by blast
   983       have eq_fb: "\<forall>z. a \<le> z --> z \<le> b --> f z = f b"
   984       proof (clarify)
   985         fix z::real
   986         assume az: "a \<le> z" and zb: "z \<le> b"
   987         show "f z = f b"
   988         proof (rule order_antisym)
   989           show "f z \<le> f b" by (simp add: fb_eq_fx x_max az zb)
   990           show "f b \<le> f z" by (simp add: fb_eq_fx' x'_min az zb)
   991         qed
   992       qed
   993       have bound': "\<forall>y. \<bar>r-y\<bar> < d \<longrightarrow> f r = f y"
   994       proof (intro strip)
   995         fix y::real
   996         assume lt: "\<bar>r-y\<bar> < d"
   997         hence "f y = f b" by (simp add: eq_fb bound)
   998         thus "f r = f y" by (simp add: eq_fb ar rb order_less_imp_le)
   999       qed
  1000       from differentiableD [OF dif [OF conjI [OF ar rb]]]
  1001       obtain l where der: "DERIV f r :> l" ..
  1002       have "l=0" by (rule DERIV_local_const [OF der d bound'])
  1003         --{*the derivative of a constant function is zero*}
  1004       thus ?thesis using ar rb der by auto
  1005     qed
  1006   qed
  1007 qed
  1008 
  1009 
  1010 subsection{*Mean Value Theorem*}
  1011 
  1012 lemma lemma_MVT:
  1013      "f a - (f b - f a)/(b-a) * a = f b - (f b - f a)/(b-a) * (b::real)"
  1014   by (cases "a = b") (simp_all add: field_simps)
  1015 
  1016 theorem MVT:
  1017   assumes lt:  "a < b"
  1018       and con: "\<forall>x. a \<le> x & x \<le> b --> isCont f x"
  1019       and dif [rule_format]: "\<forall>x. a < x & x < b --> f differentiable x"
  1020   shows "\<exists>l z::real. a < z & z < b & DERIV f z :> l &
  1021                    (f(b) - f(a) = (b-a) * l)"
  1022 proof -
  1023   let ?F = "%x. f x - ((f b - f a) / (b-a)) * x"
  1024   have contF: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont ?F x"
  1025     using con by (fast intro: isCont_intros)
  1026   have difF: "\<forall>x. a < x \<and> x < b \<longrightarrow> ?F differentiable x"
  1027   proof (clarify)
  1028     fix x::real
  1029     assume ax: "a < x" and xb: "x < b"
  1030     from differentiableD [OF dif [OF conjI [OF ax xb]]]
  1031     obtain l where der: "DERIV f x :> l" ..
  1032     show "?F differentiable x"
  1033       by (rule differentiableI [where D = "l - (f b - f a)/(b-a)"],
  1034           blast intro: DERIV_diff DERIV_cmult_Id der)
  1035   qed
  1036   from Rolle [where f = ?F, OF lt lemma_MVT contF difF]
  1037   obtain z where az: "a < z" and zb: "z < b" and der: "DERIV ?F z :> 0"
  1038     by blast
  1039   have "DERIV (%x. ((f b - f a)/(b-a)) * x) z :> (f b - f a)/(b-a)"
  1040     by (rule DERIV_cmult_Id)
  1041   hence derF: "DERIV (\<lambda>x. ?F x + (f b - f a) / (b - a) * x) z
  1042                    :> 0 + (f b - f a) / (b - a)"
  1043     by (rule DERIV_add [OF der])
  1044   show ?thesis
  1045   proof (intro exI conjI)
  1046     show "a < z" using az .
  1047     show "z < b" using zb .
  1048     show "f b - f a = (b - a) * ((f b - f a)/(b-a))" by (simp)
  1049     show "DERIV f z :> ((f b - f a)/(b-a))"  using derF by simp
  1050   qed
  1051 qed
  1052 
  1053 lemma MVT2:
  1054      "[| a < b; \<forall>x. a \<le> x & x \<le> b --> DERIV f x :> f'(x) |]
  1055       ==> \<exists>z::real. a < z & z < b & (f b - f a = (b - a) * f'(z))"
  1056 apply (drule MVT)
  1057 apply (blast intro: DERIV_isCont)
  1058 apply (force dest: order_less_imp_le simp add: differentiable_def)
  1059 apply (blast dest: DERIV_unique order_less_imp_le)
  1060 done
  1061 
  1062 
  1063 text{*A function is constant if its derivative is 0 over an interval.*}
  1064 
  1065 lemma DERIV_isconst_end:
  1066   fixes f :: "real => real"
  1067   shows "[| a < b;
  1068          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1069          \<forall>x. a < x & x < b --> DERIV f x :> 0 |]
  1070         ==> f b = f a"
  1071 apply (drule MVT, assumption)
  1072 apply (blast intro: differentiableI)
  1073 apply (auto dest!: DERIV_unique simp add: diff_eq_eq)
  1074 done
  1075 
  1076 lemma DERIV_isconst1:
  1077   fixes f :: "real => real"
  1078   shows "[| a < b;
  1079          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1080          \<forall>x. a < x & x < b --> DERIV f x :> 0 |]
  1081         ==> \<forall>x. a \<le> x & x \<le> b --> f x = f a"
  1082 apply safe
  1083 apply (drule_tac x = a in order_le_imp_less_or_eq, safe)
  1084 apply (drule_tac b = x in DERIV_isconst_end, auto)
  1085 done
  1086 
  1087 lemma DERIV_isconst2:
  1088   fixes f :: "real => real"
  1089   shows "[| a < b;
  1090          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1091          \<forall>x. a < x & x < b --> DERIV f x :> 0;
  1092          a \<le> x; x \<le> b |]
  1093         ==> f x = f a"
  1094 apply (blast dest: DERIV_isconst1)
  1095 done
  1096 
  1097 lemma DERIV_isconst3: fixes a b x y :: real
  1098   assumes "a < b" and "x \<in> {a <..< b}" and "y \<in> {a <..< b}"
  1099   assumes derivable: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> DERIV f x :> 0"
  1100   shows "f x = f y"
  1101 proof (cases "x = y")
  1102   case False
  1103   let ?a = "min x y"
  1104   let ?b = "max x y"
  1105   
  1106   have "\<forall>z. ?a \<le> z \<and> z \<le> ?b \<longrightarrow> DERIV f z :> 0"
  1107   proof (rule allI, rule impI)
  1108     fix z :: real assume "?a \<le> z \<and> z \<le> ?b"
  1109     hence "a < z" and "z < b" using `x \<in> {a <..< b}` and `y \<in> {a <..< b}` by auto
  1110     hence "z \<in> {a<..<b}" by auto
  1111     thus "DERIV f z :> 0" by (rule derivable)
  1112   qed
  1113   hence isCont: "\<forall>z. ?a \<le> z \<and> z \<le> ?b \<longrightarrow> isCont f z"
  1114     and DERIV: "\<forall>z. ?a < z \<and> z < ?b \<longrightarrow> DERIV f z :> 0" using DERIV_isCont by auto
  1115 
  1116   have "?a < ?b" using `x \<noteq> y` by auto
  1117   from DERIV_isconst2[OF this isCont DERIV, of x] and DERIV_isconst2[OF this isCont DERIV, of y]
  1118   show ?thesis by auto
  1119 qed auto
  1120 
  1121 lemma DERIV_isconst_all:
  1122   fixes f :: "real => real"
  1123   shows "\<forall>x. DERIV f x :> 0 ==> f(x) = f(y)"
  1124 apply (rule linorder_cases [of x y])
  1125 apply (blast intro: sym DERIV_isCont DERIV_isconst_end)+
  1126 done
  1127 
  1128 lemma DERIV_const_ratio_const:
  1129   fixes f :: "real => real"
  1130   shows "[|a \<noteq> b; \<forall>x. DERIV f x :> k |] ==> (f(b) - f(a)) = (b-a) * k"
  1131 apply (rule linorder_cases [of a b], auto)
  1132 apply (drule_tac [!] f = f in MVT)
  1133 apply (auto dest: DERIV_isCont DERIV_unique simp add: differentiable_def)
  1134 apply (auto dest: DERIV_unique simp add: ring_distribs diff_minus)
  1135 done
  1136 
  1137 lemma DERIV_const_ratio_const2:
  1138   fixes f :: "real => real"
  1139   shows "[|a \<noteq> b; \<forall>x. DERIV f x :> k |] ==> (f(b) - f(a))/(b-a) = k"
  1140 apply (rule_tac c1 = "b-a" in real_mult_right_cancel [THEN iffD1])
  1141 apply (auto dest!: DERIV_const_ratio_const simp add: mult_assoc)
  1142 done
  1143 
  1144 lemma real_average_minus_first [simp]: "((a + b) /2 - a) = (b-a)/(2::real)"
  1145 by (simp)
  1146 
  1147 lemma real_average_minus_second [simp]: "((b + a)/2 - a) = (b-a)/(2::real)"
  1148 by (simp)
  1149 
  1150 text{*Gallileo's "trick": average velocity = av. of end velocities*}
  1151 
  1152 lemma DERIV_const_average:
  1153   fixes v :: "real => real"
  1154   assumes neq: "a \<noteq> (b::real)"
  1155       and der: "\<forall>x. DERIV v x :> k"
  1156   shows "v ((a + b)/2) = (v a + v b)/2"
  1157 proof (cases rule: linorder_cases [of a b])
  1158   case equal with neq show ?thesis by simp
  1159 next
  1160   case less
  1161   have "(v b - v a) / (b - a) = k"
  1162     by (rule DERIV_const_ratio_const2 [OF neq der])
  1163   hence "(b-a) * ((v b - v a) / (b-a)) = (b-a) * k" by simp
  1164   moreover have "(v ((a + b) / 2) - v a) / ((a + b) / 2 - a) = k"
  1165     by (rule DERIV_const_ratio_const2 [OF _ der], simp add: neq)
  1166   ultimately show ?thesis using neq by force
  1167 next
  1168   case greater
  1169   have "(v b - v a) / (b - a) = k"
  1170     by (rule DERIV_const_ratio_const2 [OF neq der])
  1171   hence "(b-a) * ((v b - v a) / (b-a)) = (b-a) * k" by simp
  1172   moreover have " (v ((b + a) / 2) - v a) / ((b + a) / 2 - a) = k"
  1173     by (rule DERIV_const_ratio_const2 [OF _ der], simp add: neq)
  1174   ultimately show ?thesis using neq by (force simp add: add_commute)
  1175 qed
  1176 
  1177 (* A function with positive derivative is increasing. 
  1178    A simple proof using the MVT, by Jeremy Avigad. And variants.
  1179 *)
  1180 lemma DERIV_pos_imp_increasing:
  1181   fixes a::real and b::real and f::"real => real"
  1182   assumes "a < b" and "\<forall>x. a \<le> x & x \<le> b --> (EX y. DERIV f x :> y & y > 0)"
  1183   shows "f a < f b"
  1184 proof (rule ccontr)
  1185   assume f: "~ f a < f b"
  1186   have "EX l z. a < z & z < b & DERIV f z :> l
  1187       & f b - f a = (b - a) * l"
  1188     apply (rule MVT)
  1189       using assms
  1190       apply auto
  1191       apply (metis DERIV_isCont)
  1192      apply (metis differentiableI less_le)
  1193     done
  1194   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l"
  1195       and "f b - f a = (b - a) * l"
  1196     by auto
  1197   with assms f have "~(l > 0)"
  1198     by (metis linorder_not_le mult_le_0_iff diff_le_0_iff_le)
  1199   with assms z show False
  1200     by (metis DERIV_unique less_le)
  1201 qed
  1202 
  1203 lemma DERIV_nonneg_imp_nondecreasing:
  1204   fixes a::real and b::real and f::"real => real"
  1205   assumes "a \<le> b" and
  1206     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y \<ge> 0)"
  1207   shows "f a \<le> f b"
  1208 proof (rule ccontr, cases "a = b")
  1209   assume "~ f a \<le> f b" and "a = b"
  1210   then show False by auto
  1211 next
  1212   assume A: "~ f a \<le> f b"
  1213   assume B: "a ~= b"
  1214   with assms have "EX l z. a < z & z < b & DERIV f z :> l
  1215       & f b - f a = (b - a) * l"
  1216     apply -
  1217     apply (rule MVT)
  1218       apply auto
  1219       apply (metis DERIV_isCont)
  1220      apply (metis differentiableI less_le)
  1221     done
  1222   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l"
  1223       and C: "f b - f a = (b - a) * l"
  1224     by auto
  1225   with A have "a < b" "f b < f a" by auto
  1226   with C have "\<not> l \<ge> 0" by (auto simp add: not_le algebra_simps)
  1227     (metis A add_le_cancel_right assms(1) less_eq_real_def mult_right_mono add_left_mono linear order_refl)
  1228   with assms z show False
  1229     by (metis DERIV_unique order_less_imp_le)
  1230 qed
  1231 
  1232 lemma DERIV_neg_imp_decreasing:
  1233   fixes a::real and b::real and f::"real => real"
  1234   assumes "a < b" and
  1235     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y < 0)"
  1236   shows "f a > f b"
  1237 proof -
  1238   have "(%x. -f x) a < (%x. -f x) b"
  1239     apply (rule DERIV_pos_imp_increasing [of a b "%x. -f x"])
  1240     using assms
  1241     apply auto
  1242     apply (metis DERIV_minus neg_0_less_iff_less)
  1243     done
  1244   thus ?thesis
  1245     by simp
  1246 qed
  1247 
  1248 lemma DERIV_nonpos_imp_nonincreasing:
  1249   fixes a::real and b::real and f::"real => real"
  1250   assumes "a \<le> b" and
  1251     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y \<le> 0)"
  1252   shows "f a \<ge> f b"
  1253 proof -
  1254   have "(%x. -f x) a \<le> (%x. -f x) b"
  1255     apply (rule DERIV_nonneg_imp_nondecreasing [of a b "%x. -f x"])
  1256     using assms
  1257     apply auto
  1258     apply (metis DERIV_minus neg_0_le_iff_le)
  1259     done
  1260   thus ?thesis
  1261     by simp
  1262 qed
  1263 
  1264 text {* Derivative of inverse function *}
  1265 
  1266 lemma DERIV_inverse_function:
  1267   fixes f g :: "real \<Rightarrow> real"
  1268   assumes der: "DERIV f (g x) :> D"
  1269   assumes neq: "D \<noteq> 0"
  1270   assumes a: "a < x" and b: "x < b"
  1271   assumes inj: "\<forall>y. a < y \<and> y < b \<longrightarrow> f (g y) = y"
  1272   assumes cont: "isCont g x"
  1273   shows "DERIV g x :> inverse D"
  1274 unfolding DERIV_iff2
  1275 proof (rule LIM_equal2)
  1276   show "0 < min (x - a) (b - x)"
  1277     using a b by arith 
  1278 next
  1279   fix y
  1280   assume "norm (y - x) < min (x - a) (b - x)"
  1281   hence "a < y" and "y < b" 
  1282     by (simp_all add: abs_less_iff)
  1283   thus "(g y - g x) / (y - x) =
  1284         inverse ((f (g y) - x) / (g y - g x))"
  1285     by (simp add: inj)
  1286 next
  1287   have "(\<lambda>z. (f z - f (g x)) / (z - g x)) -- g x --> D"
  1288     by (rule der [unfolded DERIV_iff2])
  1289   hence 1: "(\<lambda>z. (f z - x) / (z - g x)) -- g x --> D"
  1290     using inj a b by simp
  1291   have 2: "\<exists>d>0. \<forall>y. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow> g y \<noteq> g x"
  1292   proof (safe intro!: exI)
  1293     show "0 < min (x - a) (b - x)"
  1294       using a b by simp
  1295   next
  1296     fix y
  1297     assume "norm (y - x) < min (x - a) (b - x)"
  1298     hence y: "a < y" "y < b"
  1299       by (simp_all add: abs_less_iff)
  1300     assume "g y = g x"
  1301     hence "f (g y) = f (g x)" by simp
  1302     hence "y = x" using inj y a b by simp
  1303     also assume "y \<noteq> x"
  1304     finally show False by simp
  1305   qed
  1306   have "(\<lambda>y. (f (g y) - x) / (g y - g x)) -- x --> D"
  1307     using cont 1 2 by (rule isCont_LIM_compose2)
  1308   thus "(\<lambda>y. inverse ((f (g y) - x) / (g y - g x)))
  1309         -- x --> inverse D"
  1310     using neq by (rule tendsto_inverse)
  1311 qed
  1312 
  1313 subsection {* Generalized Mean Value Theorem *}
  1314 
  1315 theorem GMVT:
  1316   fixes a b :: real
  1317   assumes alb: "a < b"
  1318     and fc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
  1319     and fd: "\<forall>x. a < x \<and> x < b \<longrightarrow> f differentiable x"
  1320     and gc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont g x"
  1321     and gd: "\<forall>x. a < x \<and> x < b \<longrightarrow> g differentiable x"
  1322   shows "\<exists>g'c f'c c. DERIV g c :> g'c \<and> DERIV f c :> f'c \<and> a < c \<and> c < b \<and> ((f b - f a) * g'c) = ((g b - g a) * f'c)"
  1323 proof -
  1324   let ?h = "\<lambda>x. (f b - f a)*(g x) - (g b - g a)*(f x)"
  1325   from assms have "a < b" by simp
  1326   moreover have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont ?h x"
  1327     using fc gc by simp
  1328   moreover have "\<forall>x. a < x \<and> x < b \<longrightarrow> ?h differentiable x"
  1329     using fd gd by simp
  1330   ultimately have "\<exists>l z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l" by (rule MVT)
  1331   then obtain l where ldef: "\<exists>z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l" ..
  1332   then obtain c where cdef: "a < c \<and> c < b \<and> DERIV ?h c :> l \<and> ?h b - ?h a = (b - a) * l" ..
  1333 
  1334   from cdef have cint: "a < c \<and> c < b" by auto
  1335   with gd have "g differentiable c" by simp
  1336   hence "\<exists>D. DERIV g c :> D" by (rule differentiableD)
  1337   then obtain g'c where g'cdef: "DERIV g c :> g'c" ..
  1338 
  1339   from cdef have "a < c \<and> c < b" by auto
  1340   with fd have "f differentiable c" by simp
  1341   hence "\<exists>D. DERIV f c :> D" by (rule differentiableD)
  1342   then obtain f'c where f'cdef: "DERIV f c :> f'c" ..
  1343 
  1344   from cdef have "DERIV ?h c :> l" by auto
  1345   moreover have "DERIV ?h c :>  g'c * (f b - f a) - f'c * (g b - g a)"
  1346     using g'cdef f'cdef by (auto intro!: DERIV_intros)
  1347   ultimately have leq: "l =  g'c * (f b - f a) - f'c * (g b - g a)" by (rule DERIV_unique)
  1348 
  1349   {
  1350     from cdef have "?h b - ?h a = (b - a) * l" by auto
  1351     also with leq have "\<dots> = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
  1352     finally have "?h b - ?h a = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
  1353   }
  1354   moreover
  1355   {
  1356     have "?h b - ?h a =
  1357          ((f b)*(g b) - (f a)*(g b) - (g b)*(f b) + (g a)*(f b)) -
  1358           ((f b)*(g a) - (f a)*(g a) - (g b)*(f a) + (g a)*(f a))"
  1359       by (simp add: algebra_simps)
  1360     hence "?h b - ?h a = 0" by auto
  1361   }
  1362   ultimately have "(b - a) * (g'c * (f b - f a) - f'c * (g b - g a)) = 0" by auto
  1363   with alb have "g'c * (f b - f a) - f'c * (g b - g a) = 0" by simp
  1364   hence "g'c * (f b - f a) = f'c * (g b - g a)" by simp
  1365   hence "(f b - f a) * g'c = (g b - g a) * f'c" by (simp add: mult_ac)
  1366 
  1367   with g'cdef f'cdef cint show ?thesis by auto
  1368 qed
  1369 
  1370 lemma GMVT':
  1371   fixes f g :: "real \<Rightarrow> real"
  1372   assumes "a < b"
  1373   assumes isCont_f: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont f z"
  1374   assumes isCont_g: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont g z"
  1375   assumes DERIV_g: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV g z :> (g' z)"
  1376   assumes DERIV_f: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV f z :> (f' z)"
  1377   shows "\<exists>c. a < c \<and> c < b \<and> (f b - f a) * g' c = (g b - g a) * f' c"
  1378 proof -
  1379   have "\<exists>g'c f'c c. DERIV g c :> g'c \<and> DERIV f c :> f'c \<and>
  1380     a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
  1381     using assms by (intro GMVT) (force simp: differentiable_def)+
  1382   then obtain c where "a < c" "c < b" "(f b - f a) * g' c = (g b - g a) * f' c"
  1383     using DERIV_f DERIV_g by (force dest: DERIV_unique)
  1384   then show ?thesis
  1385     by auto
  1386 qed
  1387 
  1388 
  1389 subsection {* L'Hopitals rule *}
  1390 
  1391 lemma isCont_If_ge:
  1392   fixes a :: "'a :: linorder_topology"
  1393   shows "continuous (at_left a) g \<Longrightarrow> (f ---> g a) (at_right a) \<Longrightarrow> isCont (\<lambda>x. if x \<le> a then g x else f x) a"
  1394   unfolding isCont_def continuous_within
  1395   apply (intro filterlim_split_at)
  1396   apply (subst filterlim_cong[OF refl refl, where g=g])
  1397   apply (simp_all add: eventually_at_filter less_le)
  1398   apply (subst filterlim_cong[OF refl refl, where g=f])
  1399   apply (simp_all add: eventually_at_filter less_le)
  1400   done
  1401 
  1402 lemma lhopital_right_0:
  1403   fixes f0 g0 :: "real \<Rightarrow> real"
  1404   assumes f_0: "(f0 ---> 0) (at_right 0)"
  1405   assumes g_0: "(g0 ---> 0) (at_right 0)"
  1406   assumes ev:
  1407     "eventually (\<lambda>x. g0 x \<noteq> 0) (at_right 0)"
  1408     "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
  1409     "eventually (\<lambda>x. DERIV f0 x :> f' x) (at_right 0)"
  1410     "eventually (\<lambda>x. DERIV g0 x :> g' x) (at_right 0)"
  1411   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) (at_right 0)"
  1412   shows "((\<lambda> x. f0 x / g0 x) ---> x) (at_right 0)"
  1413 proof -
  1414   def f \<equiv> "\<lambda>x. if x \<le> 0 then 0 else f0 x"
  1415   then have "f 0 = 0" by simp
  1416 
  1417   def g \<equiv> "\<lambda>x. if x \<le> 0 then 0 else g0 x"
  1418   then have "g 0 = 0" by simp
  1419 
  1420   have "eventually (\<lambda>x. g0 x \<noteq> 0 \<and> g' x \<noteq> 0 \<and>
  1421       DERIV f0 x :> (f' x) \<and> DERIV g0 x :> (g' x)) (at_right 0)"
  1422     using ev by eventually_elim auto
  1423   then obtain a where [arith]: "0 < a"
  1424     and g0_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g0 x \<noteq> 0"
  1425     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
  1426     and f0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV f0 x :> (f' x)"
  1427     and g0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV g0 x :> (g' x)"
  1428     unfolding eventually_at eventually_at by (auto simp: dist_real_def)
  1429 
  1430   have g_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g x \<noteq> 0"
  1431     using g0_neq_0 by (simp add: g_def)
  1432 
  1433   { fix x assume x: "0 < x" "x < a" then have "DERIV f x :> (f' x)"
  1434       by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ f0[OF x]])
  1435          (auto simp: f_def eventually_nhds_metric dist_real_def intro!: exI[of _ x]) }
  1436   note f = this
  1437 
  1438   { fix x assume x: "0 < x" "x < a" then have "DERIV g x :> (g' x)"
  1439       by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ g0[OF x]])
  1440          (auto simp: g_def eventually_nhds_metric dist_real_def intro!: exI[of _ x]) }
  1441   note g = this
  1442 
  1443   have "isCont f 0"
  1444     unfolding f_def by (intro isCont_If_ge f_0 continuous_const)
  1445 
  1446   have "isCont g 0"
  1447     unfolding g_def by (intro isCont_If_ge g_0 continuous_const)
  1448 
  1449   have "\<exists>\<zeta>. \<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)"
  1450   proof (rule bchoice, rule)
  1451     fix x assume "x \<in> {0 <..< a}"
  1452     then have x[arith]: "0 < x" "x < a" by auto
  1453     with g'_neq_0 g_neq_0 `g 0 = 0` have g': "\<And>x. 0 < x \<Longrightarrow> x < a  \<Longrightarrow> 0 \<noteq> g' x" "g 0 \<noteq> g x"
  1454       by auto
  1455     have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont f x"
  1456       using `isCont f 0` f by (auto intro: DERIV_isCont simp: le_less)
  1457     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont g x"
  1458       using `isCont g 0` g by (auto intro: DERIV_isCont simp: le_less)
  1459     ultimately have "\<exists>c. 0 < c \<and> c < x \<and> (f x - f 0) * g' c = (g x - g 0) * f' c"
  1460       using f g `x < a` by (intro GMVT') auto
  1461     then guess c ..
  1462     moreover
  1463     with g'(1)[of c] g'(2) have "(f x - f 0)  / (g x - g 0) = f' c / g' c"
  1464       by (simp add: field_simps)
  1465     ultimately show "\<exists>y. 0 < y \<and> y < x \<and> f x / g x = f' y / g' y"
  1466       using `f 0 = 0` `g 0 = 0` by (auto intro!: exI[of _ c])
  1467   qed
  1468   then guess \<zeta> ..
  1469   then have \<zeta>: "eventually (\<lambda>x. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)) (at_right 0)"
  1470     unfolding eventually_at by (intro exI[of _ a]) (auto simp: dist_real_def)
  1471   moreover
  1472   from \<zeta> have "eventually (\<lambda>x. norm (\<zeta> x) \<le> x) (at_right 0)"
  1473     by eventually_elim auto
  1474   then have "((\<lambda>x. norm (\<zeta> x)) ---> 0) (at_right 0)"
  1475     by (rule_tac real_tendsto_sandwich[where f="\<lambda>x. 0" and h="\<lambda>x. x"])
  1476        (auto intro: tendsto_const tendsto_ident_at)
  1477   then have "(\<zeta> ---> 0) (at_right 0)"
  1478     by (rule tendsto_norm_zero_cancel)
  1479   with \<zeta> have "filterlim \<zeta> (at_right 0) (at_right 0)"
  1480     by (auto elim!: eventually_elim1 simp: filterlim_at)
  1481   from this lim have "((\<lambda>t. f' (\<zeta> t) / g' (\<zeta> t)) ---> x) (at_right 0)"
  1482     by (rule_tac filterlim_compose[of _ _ _ \<zeta>])
  1483   ultimately have "((\<lambda>t. f t / g t) ---> x) (at_right 0)" (is ?P)
  1484     by (rule_tac filterlim_cong[THEN iffD1, OF refl refl])
  1485        (auto elim: eventually_elim1)
  1486   also have "?P \<longleftrightarrow> ?thesis"
  1487     by (rule filterlim_cong) (auto simp: f_def g_def eventually_at_filter)
  1488   finally show ?thesis .
  1489 qed
  1490 
  1491 lemma lhopital_right:
  1492   "((f::real \<Rightarrow> real) ---> 0) (at_right x) \<Longrightarrow> (g ---> 0) (at_right x) \<Longrightarrow>
  1493     eventually (\<lambda>x. g x \<noteq> 0) (at_right x) \<Longrightarrow>
  1494     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
  1495     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
  1496     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
  1497     ((\<lambda> x. (f' x / g' x)) ---> y) (at_right x) \<Longrightarrow>
  1498   ((\<lambda> x. f x / g x) ---> y) (at_right x)"
  1499   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
  1500   by (rule lhopital_right_0)
  1501 
  1502 lemma lhopital_left:
  1503   "((f::real \<Rightarrow> real) ---> 0) (at_left x) \<Longrightarrow> (g ---> 0) (at_left x) \<Longrightarrow>
  1504     eventually (\<lambda>x. g x \<noteq> 0) (at_left x) \<Longrightarrow>
  1505     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
  1506     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
  1507     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
  1508     ((\<lambda> x. (f' x / g' x)) ---> y) (at_left x) \<Longrightarrow>
  1509   ((\<lambda> x. f x / g x) ---> y) (at_left x)"
  1510   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
  1511   by (rule lhopital_right[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
  1512 
  1513 lemma lhopital:
  1514   "((f::real \<Rightarrow> real) ---> 0) (at x) \<Longrightarrow> (g ---> 0) (at x) \<Longrightarrow>
  1515     eventually (\<lambda>x. g x \<noteq> 0) (at x) \<Longrightarrow>
  1516     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
  1517     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
  1518     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
  1519     ((\<lambda> x. (f' x / g' x)) ---> y) (at x) \<Longrightarrow>
  1520   ((\<lambda> x. f x / g x) ---> y) (at x)"
  1521   unfolding eventually_at_split filterlim_at_split
  1522   by (auto intro!: lhopital_right[of f x g g' f'] lhopital_left[of f x g g' f'])
  1523 
  1524 lemma lhopital_right_0_at_top:
  1525   fixes f g :: "real \<Rightarrow> real"
  1526   assumes g_0: "LIM x at_right 0. g x :> at_top"
  1527   assumes ev:
  1528     "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
  1529     "eventually (\<lambda>x. DERIV f x :> f' x) (at_right 0)"
  1530     "eventually (\<lambda>x. DERIV g x :> g' x) (at_right 0)"
  1531   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) (at_right 0)"
  1532   shows "((\<lambda> x. f x / g x) ---> x) (at_right 0)"
  1533   unfolding tendsto_iff
  1534 proof safe
  1535   fix e :: real assume "0 < e"
  1536 
  1537   with lim[unfolded tendsto_iff, rule_format, of "e / 4"]
  1538   have "eventually (\<lambda>t. dist (f' t / g' t) x < e / 4) (at_right 0)" by simp
  1539   from eventually_conj[OF eventually_conj[OF ev(1) ev(2)] eventually_conj[OF ev(3) this]]
  1540   obtain a where [arith]: "0 < a"
  1541     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
  1542     and f0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV f x :> (f' x)"
  1543     and g0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV g x :> (g' x)"
  1544     and Df: "\<And>t. 0 < t \<Longrightarrow> t < a \<Longrightarrow> dist (f' t / g' t) x < e / 4"
  1545     unfolding eventually_at_le by (auto simp: dist_real_def)
  1546     
  1547 
  1548   from Df have
  1549     "eventually (\<lambda>t. t < a) (at_right 0)" "eventually (\<lambda>t::real. 0 < t) (at_right 0)"
  1550     unfolding eventually_at by (auto intro!: exI[of _ a] simp: dist_real_def)
  1551 
  1552   moreover
  1553   have "eventually (\<lambda>t. 0 < g t) (at_right 0)" "eventually (\<lambda>t. g a < g t) (at_right 0)"
  1554     using g_0 by (auto elim: eventually_elim1 simp: filterlim_at_top_dense)
  1555 
  1556   moreover
  1557   have inv_g: "((\<lambda>x. inverse (g x)) ---> 0) (at_right 0)"
  1558     using tendsto_inverse_0 filterlim_mono[OF g_0 at_top_le_at_infinity order_refl]
  1559     by (rule filterlim_compose)
  1560   then have "((\<lambda>x. norm (1 - g a * inverse (g x))) ---> norm (1 - g a * 0)) (at_right 0)"
  1561     by (intro tendsto_intros)
  1562   then have "((\<lambda>x. norm (1 - g a / g x)) ---> 1) (at_right 0)"
  1563     by (simp add: inverse_eq_divide)
  1564   from this[unfolded tendsto_iff, rule_format, of 1]
  1565   have "eventually (\<lambda>x. norm (1 - g a / g x) < 2) (at_right 0)"
  1566     by (auto elim!: eventually_elim1 simp: dist_real_def)
  1567 
  1568   moreover
  1569   from inv_g have "((\<lambda>t. norm ((f a - x * g a) * inverse (g t))) ---> norm ((f a - x * g a) * 0)) (at_right 0)"
  1570     by (intro tendsto_intros)
  1571   then have "((\<lambda>t. norm (f a - x * g a) / norm (g t)) ---> 0) (at_right 0)"
  1572     by (simp add: inverse_eq_divide)
  1573   from this[unfolded tendsto_iff, rule_format, of "e / 2"] `0 < e`
  1574   have "eventually (\<lambda>t. norm (f a - x * g a) / norm (g t) < e / 2) (at_right 0)"
  1575     by (auto simp: dist_real_def)
  1576 
  1577   ultimately show "eventually (\<lambda>t. dist (f t / g t) x < e) (at_right 0)"
  1578   proof eventually_elim
  1579     fix t assume t[arith]: "0 < t" "t < a" "g a < g t" "0 < g t"
  1580     assume ineq: "norm (1 - g a / g t) < 2" "norm (f a - x * g a) / norm (g t) < e / 2"
  1581 
  1582     have "\<exists>y. t < y \<and> y < a \<and> (g a - g t) * f' y = (f a - f t) * g' y"
  1583       using f0 g0 t(1,2) by (intro GMVT') (force intro!: DERIV_isCont)+
  1584     then guess y ..
  1585     from this
  1586     have [arith]: "t < y" "y < a" and D_eq: "(f t - f a) / (g t - g a) = f' y / g' y"
  1587       using `g a < g t` g'_neq_0[of y] by (auto simp add: field_simps)
  1588 
  1589     have *: "f t / g t - x = ((f t - f a) / (g t - g a) - x) * (1 - g a / g t) + (f a - x * g a) / g t"
  1590       by (simp add: field_simps)
  1591     have "norm (f t / g t - x) \<le>
  1592         norm (((f t - f a) / (g t - g a) - x) * (1 - g a / g t)) + norm ((f a - x * g a) / g t)"
  1593       unfolding * by (rule norm_triangle_ineq)
  1594     also have "\<dots> = dist (f' y / g' y) x * norm (1 - g a / g t) + norm (f a - x * g a) / norm (g t)"
  1595       by (simp add: abs_mult D_eq dist_real_def)
  1596     also have "\<dots> < (e / 4) * 2 + e / 2"
  1597       using ineq Df[of y] `0 < e` by (intro add_le_less_mono mult_mono) auto
  1598     finally show "dist (f t / g t) x < e"
  1599       by (simp add: dist_real_def)
  1600   qed
  1601 qed
  1602 
  1603 lemma lhopital_right_at_top:
  1604   "LIM x at_right x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1605     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
  1606     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
  1607     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
  1608     ((\<lambda> x. (f' x / g' x)) ---> y) (at_right x) \<Longrightarrow>
  1609     ((\<lambda> x. f x / g x) ---> y) (at_right x)"
  1610   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
  1611   by (rule lhopital_right_0_at_top)
  1612 
  1613 lemma lhopital_left_at_top:
  1614   "LIM x at_left x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1615     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
  1616     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
  1617     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
  1618     ((\<lambda> x. (f' x / g' x)) ---> y) (at_left x) \<Longrightarrow>
  1619     ((\<lambda> x. f x / g x) ---> y) (at_left x)"
  1620   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
  1621   by (rule lhopital_right_at_top[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
  1622 
  1623 lemma lhopital_at_top:
  1624   "LIM x at x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1625     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
  1626     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
  1627     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
  1628     ((\<lambda> x. (f' x / g' x)) ---> y) (at x) \<Longrightarrow>
  1629     ((\<lambda> x. f x / g x) ---> y) (at x)"
  1630   unfolding eventually_at_split filterlim_at_split
  1631   by (auto intro!: lhopital_right_at_top[of g x g' f f'] lhopital_left_at_top[of g x g' f f'])
  1632 
  1633 lemma lhospital_at_top_at_top:
  1634   fixes f g :: "real \<Rightarrow> real"
  1635   assumes g_0: "LIM x at_top. g x :> at_top"
  1636   assumes g': "eventually (\<lambda>x. g' x \<noteq> 0) at_top"
  1637   assumes Df: "eventually (\<lambda>x. DERIV f x :> f' x) at_top"
  1638   assumes Dg: "eventually (\<lambda>x. DERIV g x :> g' x) at_top"
  1639   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) at_top"
  1640   shows "((\<lambda> x. f x / g x) ---> x) at_top"
  1641   unfolding filterlim_at_top_to_right
  1642 proof (rule lhopital_right_0_at_top)
  1643   let ?F = "\<lambda>x. f (inverse x)"
  1644   let ?G = "\<lambda>x. g (inverse x)"
  1645   let ?R = "at_right (0::real)"
  1646   let ?D = "\<lambda>f' x. f' (inverse x) * - (inverse x ^ Suc (Suc 0))"
  1647 
  1648   show "LIM x ?R. ?G x :> at_top"
  1649     using g_0 unfolding filterlim_at_top_to_right .
  1650 
  1651   show "eventually (\<lambda>x. DERIV ?G x  :> ?D g' x) ?R"
  1652     unfolding eventually_at_right_to_top
  1653     using Dg eventually_ge_at_top[where c="1::real"]
  1654     apply eventually_elim
  1655     apply (rule DERIV_cong)
  1656     apply (rule DERIV_chain'[where f=inverse])
  1657     apply (auto intro!:  DERIV_inverse)
  1658     done
  1659 
  1660   show "eventually (\<lambda>x. DERIV ?F x  :> ?D f' x) ?R"
  1661     unfolding eventually_at_right_to_top
  1662     using Df eventually_ge_at_top[where c="1::real"]
  1663     apply eventually_elim
  1664     apply (rule DERIV_cong)
  1665     apply (rule DERIV_chain'[where f=inverse])
  1666     apply (auto intro!:  DERIV_inverse)
  1667     done
  1668 
  1669   show "eventually (\<lambda>x. ?D g' x \<noteq> 0) ?R"
  1670     unfolding eventually_at_right_to_top
  1671     using g' eventually_ge_at_top[where c="1::real"]
  1672     by eventually_elim auto
  1673     
  1674   show "((\<lambda>x. ?D f' x / ?D g' x) ---> x) ?R"
  1675     unfolding filterlim_at_right_to_top
  1676     apply (intro filterlim_cong[THEN iffD2, OF refl refl _ lim])
  1677     using eventually_ge_at_top[where c="1::real"]
  1678     by eventually_elim simp
  1679 qed
  1680 
  1681 end