src/HOL/Deriv.thy
author wenzelm
Fri Mar 07 22:30:58 2014 +0100 (2014-03-07)
changeset 55990 41c6b99c5fb7
parent 55970 6d123f0ae358
child 56181 2aa0b19e74f3
permissions -rw-r--r--
more antiquotations;
     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_conv_add_uminus 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 f: "FDERIV f x : s :> f'" and g: "FDERIV g x : s :> g'" 
   393   assumes x: "g x \<noteq> 0"
   394   shows "FDERIV (\<lambda>x. f x / g x) x : s :>
   395                 (\<lambda>h. - f x * (inverse (g x) * g' h * inverse (g x)) + f' h / g x)"
   396   using FDERIV_mult[OF f FDERIV_inverse[OF x g]]
   397   by (simp add: divide_inverse field_simps)
   398 
   399 text{*Conventional form requires mult-AC laws. Types real and complex only.*}
   400 lemma FDERIV_divide'[FDERIV_intros]: 
   401   fixes f :: "_ \<Rightarrow> 'a::real_normed_field"
   402   assumes f: "FDERIV f x : s :> f'" and g: "FDERIV g x : s :> g'" and x: "g x \<noteq> 0"
   403   shows "FDERIV (\<lambda>x. f x / g x) x : s :>
   404                 (\<lambda>h. (f' h * g x - f x * g' h) / (g x * g x))"
   405 proof -
   406   { fix h
   407     have "f' h / g x - f x * (inverse (g x) * g' h * inverse (g x)) =
   408           (f' h * g x - f x * g' h) / (g x * g x)"
   409       by (simp add: divide_inverse field_simps nonzero_inverse_mult_distrib x)
   410    }
   411   then show ?thesis
   412     using FDERIV_divide [OF f g] x
   413     by simp
   414 qed
   415 
   416 subsection {* Uniqueness *}
   417 
   418 text {*
   419 
   420 This can not generally shown for @{const FDERIV}, as we need to approach the point from
   421 all directions. There is a proof in @{text Multivariate_Analysis} for @{text euclidean_space}.
   422 
   423 *}
   424 
   425 lemma FDERIV_zero_unique:
   426   assumes "FDERIV (\<lambda>x. 0) x :> F" shows "F = (\<lambda>h. 0)"
   427 proof -
   428   interpret F: bounded_linear F
   429     using assms by (rule FDERIV_bounded_linear)
   430   let ?r = "\<lambda>h. norm (F h) / norm h"
   431   have *: "?r -- 0 --> 0"
   432     using assms unfolding fderiv_def by simp
   433   show "F = (\<lambda>h. 0)"
   434   proof
   435     fix h show "F h = 0"
   436     proof (rule ccontr)
   437       assume **: "F h \<noteq> 0"
   438       then have h: "h \<noteq> 0"
   439         by (clarsimp simp add: F.zero)
   440       with ** have "0 < ?r h"
   441         by (simp add: divide_pos_pos)
   442       from LIM_D [OF * this] obtain s where s: "0 < s"
   443         and r: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < s \<Longrightarrow> ?r x < ?r h" by auto
   444       from dense [OF s] obtain t where t: "0 < t \<and> t < s" ..
   445       let ?x = "scaleR (t / norm h) h"
   446       have "?x \<noteq> 0" and "norm ?x < s" using t h by simp_all
   447       hence "?r ?x < ?r h" by (rule r)
   448       thus "False" using t h by (simp add: F.scaleR)
   449     qed
   450   qed
   451 qed
   452 
   453 lemma FDERIV_unique:
   454   assumes "FDERIV f x :> F" and "FDERIV f x :> F'" shows "F = F'"
   455 proof -
   456   have "FDERIV (\<lambda>x. 0) x :> (\<lambda>h. F h - F' h)"
   457     using FDERIV_diff [OF assms] by simp
   458   hence "(\<lambda>h. F h - F' h) = (\<lambda>h. 0)"
   459     by (rule FDERIV_zero_unique)
   460   thus "F = F'"
   461     unfolding fun_eq_iff right_minus_eq .
   462 qed
   463 
   464 subsection {* Differentiability predicate *}
   465 
   466 definition isDiff :: "'a filter \<Rightarrow> ('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> bool" where
   467   isDiff_def: "isDiff F f \<longleftrightarrow> (\<exists>D. (f has_derivative D) F)"
   468 
   469 abbreviation differentiable_in :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> bool"
   470     ("(_) differentiable (_) in (_)"  [1000, 1000, 60] 60) where
   471   "f differentiable x in s \<equiv> isDiff (at x within s) f"
   472 
   473 abbreviation differentiable :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> bool"
   474     (infixl "differentiable" 60) where
   475   "f differentiable x \<equiv> f differentiable x in UNIV"
   476 
   477 lemma differentiable_subset: "f differentiable x in s \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f differentiable x in t"
   478   unfolding isDiff_def by (blast intro: FDERIV_subset)
   479 
   480 lemma differentiable_ident [simp]: "isDiff F (\<lambda>x. x)"
   481   unfolding isDiff_def by (blast intro: FDERIV_ident)
   482 
   483 lemma differentiable_const [simp]: "isDiff F (\<lambda>z. a)"
   484   unfolding isDiff_def by (blast intro: FDERIV_const)
   485 
   486 lemma differentiable_in_compose:
   487   "f differentiable (g x) in (g`s) \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f (g x)) differentiable x in s"
   488   unfolding isDiff_def by (blast intro: FDERIV_in_compose)
   489 
   490 lemma differentiable_compose:
   491   "f differentiable (g x) \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f (g x)) differentiable x in s"
   492   by (blast intro: differentiable_in_compose differentiable_subset)
   493 
   494 lemma differentiable_sum [simp]:
   495   "isDiff F f \<Longrightarrow> isDiff F g \<Longrightarrow> isDiff F (\<lambda>x. f x + g x)"
   496   unfolding isDiff_def by (blast intro: FDERIV_add)
   497 
   498 lemma differentiable_minus [simp]:
   499   "isDiff F f \<Longrightarrow> isDiff F (\<lambda>x. - f x)"
   500   unfolding isDiff_def by (blast intro: FDERIV_minus)
   501 
   502 lemma differentiable_diff [simp]:
   503   "isDiff F f \<Longrightarrow> isDiff F g \<Longrightarrow> isDiff F (\<lambda>x. f x - g x)"
   504   unfolding isDiff_def by (blast intro: FDERIV_diff)
   505 
   506 lemma differentiable_mult [simp]:
   507   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_algebra"
   508   shows "f differentiable x in s \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f x * g x) differentiable x in s"
   509   unfolding isDiff_def by (blast intro: FDERIV_mult)
   510 
   511 lemma differentiable_inverse [simp]:
   512   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   513   shows "f differentiable x in s \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> (\<lambda>x. inverse (f x)) differentiable x in s"
   514   unfolding isDiff_def by (blast intro: FDERIV_inverse)
   515 
   516 lemma differentiable_divide [simp]:
   517   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   518   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"
   519   unfolding divide_inverse using assms by simp
   520 
   521 lemma differentiable_power [simp]:
   522   fixes f g :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   523   shows "f differentiable x in s \<Longrightarrow> (\<lambda>x. f x ^ n) differentiable x in s"
   524   unfolding isDiff_def by (blast intro: FDERIV_power)
   525 
   526 lemma differentiable_scaleR [simp]:
   527   "f differentiable x in s \<Longrightarrow> g differentiable x in s \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) differentiable x in s"
   528   unfolding isDiff_def by (blast intro: FDERIV_scaleR)
   529 
   530 definition 
   531   -- {*Differentiation: D is derivative of function f at x*}
   532   deriv ::
   533     "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool"
   534     ("(DERIV (_)/ (_)/ : (_)/ :> (_))" [1000, 1000, 1000, 60] 60)
   535 where
   536   deriv_fderiv: "DERIV f x : s :> D = FDERIV f x : s :> (\<lambda>x. x * D)"
   537 
   538 abbreviation
   539   -- {*Differentiation: D is derivative of function f at x*}
   540   deriv_at ::
   541     "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   542     ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   543 where
   544   "DERIV f x :> D \<equiv> DERIV f x : UNIV :> D"
   545 
   546 lemma differentiable_def: "(f::real \<Rightarrow> real) differentiable x in s \<longleftrightarrow> (\<exists>D. DERIV f x : s :> D)"
   547 proof safe
   548   assume "f differentiable x in s"
   549   then obtain f' where *: "FDERIV f x : s :> f'"
   550     unfolding isDiff_def by auto
   551   then obtain c where "f' = (\<lambda>x. x * c)"
   552     by (metis real_bounded_linear FDERIV_bounded_linear)
   553   with * show "\<exists>D. DERIV f x : s :> D"
   554     unfolding deriv_fderiv by auto
   555 qed (auto simp: isDiff_def deriv_fderiv)
   556 
   557 lemma differentiableE [elim?]:
   558   fixes f :: "real \<Rightarrow> real"
   559   assumes f: "f differentiable x in s" obtains df where "DERIV f x : s :> df"
   560   using assms by (auto simp: differentiable_def)
   561 
   562 lemma differentiableD: "(f::real \<Rightarrow> real) differentiable x in s \<Longrightarrow> \<exists>D. DERIV f x : s :> D"
   563   by (auto elim: differentiableE)
   564 
   565 lemma differentiableI: "DERIV f x : s :> D \<Longrightarrow> (f::real \<Rightarrow> real) differentiable x in s"
   566   by (force simp add: differentiable_def)
   567 
   568 lemma DERIV_I_FDERIV: "FDERIV f x : s :> F \<Longrightarrow> (\<And>x. x * F' = F x) \<Longrightarrow> DERIV f x : s :> F'"
   569   by (simp add: deriv_fderiv)
   570 
   571 lemma DERIV_D_FDERIV: "DERIV f x : s :> F \<Longrightarrow> FDERIV f x : s :> (\<lambda>x. x * F)"
   572   by (simp add: deriv_fderiv)
   573 
   574 lemma deriv_def:
   575   "DERIV f x :> D \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   576   apply (simp add: deriv_fderiv fderiv_def bounded_linear_mult_left LIM_zero_iff[symmetric, of _ D])
   577   apply (subst (2) tendsto_norm_zero_iff[symmetric])
   578   apply (rule filterlim_cong)
   579   apply (simp_all add: eventually_at_filter field_simps nonzero_norm_divide)
   580   done
   581 
   582 subsection {* Derivatives *}
   583 
   584 lemma DERIV_iff: "(DERIV f x :> D) \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   585   by (simp add: deriv_def)
   586 
   587 lemma DERIV_D: "DERIV f x :> D \<Longrightarrow> (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
   588   by (simp add: deriv_def)
   589 
   590 lemma DERIV_const [simp]: "DERIV (\<lambda>x. k) x : s :> 0"
   591   by (rule DERIV_I_FDERIV[OF FDERIV_const]) auto
   592 
   593 lemma DERIV_ident [simp]: "DERIV (\<lambda>x. x) x : s :> 1"
   594   by (rule DERIV_I_FDERIV[OF FDERIV_ident]) auto
   595 
   596 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"
   597   by (rule DERIV_I_FDERIV[OF FDERIV_add]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   598 
   599 lemma DERIV_minus: "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. - f x) x : s :> - D"
   600   by (rule DERIV_I_FDERIV[OF FDERIV_minus]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   601 
   602 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"
   603   by (rule DERIV_I_FDERIV[OF FDERIV_diff]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   604 
   605 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"
   606   by (simp only: DERIV_add DERIV_minus)
   607 
   608 lemma DERIV_continuous: "DERIV f x : s :> D \<Longrightarrow> continuous (at x within s) f"
   609   by (drule FDERIV_continuous[OF DERIV_D_FDERIV]) simp
   610 
   611 lemma DERIV_isCont: "DERIV f x :> D \<Longrightarrow> isCont f x"
   612   by (auto dest!: DERIV_continuous)
   613 
   614 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"
   615   by (rule DERIV_I_FDERIV[OF FDERIV_mult]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   616 
   617 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"
   618   by (rule DERIV_I_FDERIV[OF FDERIV_mult]) (auto simp: field_simps dest: DERIV_D_FDERIV)
   619 
   620 text {* Derivative of linear multiplication *}
   621 
   622 lemma DERIV_cmult:
   623   "DERIV f x : s :> D ==> DERIV (%x. c * f x) x : s :> c*D"
   624   by (drule DERIV_mult' [OF DERIV_const], simp)
   625 
   626 lemma DERIV_cmult_right:
   627   "DERIV f x : s :> D ==> DERIV (%x. f x * c) x : s :> D * c"
   628   using DERIV_cmult   by (force simp add: mult_ac)
   629 
   630 lemma DERIV_cmult_Id [simp]: "DERIV (op * c) x : s :> c"
   631   by (cut_tac c = c and x = x in DERIV_ident [THEN DERIV_cmult], simp)
   632 
   633 lemma DERIV_cdivide: "DERIV f x : s :> D ==> DERIV (%x. f x / c) x : s :> D / c"
   634   apply (subgoal_tac "DERIV (%x. (1 / c) * f x) x : s :> (1 / c) * D", force)
   635   apply (erule DERIV_cmult)
   636   done
   637 
   638 lemma DERIV_unique:
   639   "DERIV f x :> D \<Longrightarrow> DERIV f x :> E \<Longrightarrow> D = E"
   640   unfolding deriv_def by (rule LIM_unique) 
   641 
   642 lemma DERIV_setsum':
   643   "(\<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"
   644   by (rule DERIV_I_FDERIV[OF FDERIV_setsum]) (auto simp: setsum_right_distrib dest: DERIV_D_FDERIV)
   645 
   646 lemma DERIV_setsum:
   647   "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"
   648   by (rule DERIV_setsum')
   649 
   650 lemma DERIV_sumr [rule_format (no_asm)]: (* REMOVE *)
   651      "(\<forall>r. m \<le> r & r < (m + n) --> DERIV (%x. f r x) x : s :> (f' r x))
   652       --> DERIV (%x. \<Sum>n=m..<n::nat. f n x :: real) x : s :> (\<Sum>r=m..<n. f' r x)"
   653   by (auto intro: DERIV_setsum)
   654 
   655 lemma DERIV_inverse':
   656   "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))"
   657   by (rule DERIV_I_FDERIV[OF FDERIV_inverse]) (auto dest: DERIV_D_FDERIV)
   658 
   659 text {* Power of @{text "-1"} *}
   660 
   661 lemma DERIV_inverse:
   662   "x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse(x)) x : s :> - (inverse x ^ Suc (Suc 0))"
   663   by (drule DERIV_inverse' [OF DERIV_ident]) simp
   664 
   665 text {* Derivative of inverse *}
   666 
   667 lemma DERIV_inverse_fun:
   668   "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))))"
   669   by (drule (1) DERIV_inverse') (simp add: mult_ac nonzero_inverse_mult_distrib)
   670 
   671 text {* Derivative of quotient *}
   672 
   673 lemma DERIV_divide:
   674   "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)"
   675   by (rule DERIV_I_FDERIV[OF FDERIV_divide])
   676      (auto dest: DERIV_D_FDERIV simp: field_simps nonzero_inverse_mult_distrib divide_inverse)
   677 
   678 lemma DERIV_quotient:
   679   "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))"
   680   by (drule (2) DERIV_divide) (simp add: mult_commute)
   681 
   682 lemma DERIV_power_Suc:
   683   "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. f x ^ Suc n) x : s :> (1 + of_nat n) * (D * f x ^ n)"
   684   by (rule DERIV_I_FDERIV[OF FDERIV_power]) (auto simp: deriv_fderiv)
   685 
   686 lemma DERIV_power:
   687   "DERIV f x : s :> D \<Longrightarrow> DERIV (\<lambda>x. f x ^ n) x : s :> of_nat n * (D * f x ^ (n - Suc 0))"
   688   by (rule DERIV_I_FDERIV[OF FDERIV_power]) (auto simp: deriv_fderiv)
   689 
   690 lemma DERIV_pow: "DERIV (%x. x ^ n) x : s :> real n * (x ^ (n - Suc 0))"
   691   apply (cut_tac DERIV_power [OF DERIV_ident])
   692   apply (simp add: real_of_nat_def)
   693   done
   694 
   695 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"
   696   using FDERIV_compose[of f "\<lambda>x. x * D" x s g "\<lambda>x. x * E"]
   697   by (auto simp: deriv_fderiv ac_simps dest: FDERIV_subset)
   698 
   699 corollary DERIV_chain2: "DERIV f (g x) :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (%x. f (g x)) x : s :> Da * Db"
   700   by (rule DERIV_chain')
   701 
   702 text {* Standard version *}
   703 
   704 lemma DERIV_chain: "DERIV f (g x) :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (f o g) x : s :> Da * Db"
   705   by (drule (1) DERIV_chain', simp add: o_def mult_commute)
   706 
   707 lemma DERIV_image_chain: 
   708   "DERIV f (g x) : (g ` s) :> Da \<Longrightarrow> DERIV g x : s :> Db \<Longrightarrow> DERIV (f o g) x : s :> Da * Db"
   709   using FDERIV_in_compose [of g "\<lambda>x. x * Db" x s f "\<lambda>x. x * Da "]
   710   by (simp add: deriv_fderiv o_def  mult_ac)
   711 
   712 (*These two are from HOL Light: HAS_COMPLEX_DERIVATIVE_CHAIN*)
   713 lemma DERIV_chain_s:
   714   assumes "(\<And>x. x \<in> s \<Longrightarrow> DERIV g x :> g'(x))"
   715       and "DERIV f x :> f'" 
   716       and "f x \<in> s"
   717     shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   718   by (metis (full_types) DERIV_chain' mult_commute assms)
   719 
   720 lemma DERIV_chain3: (*HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV*)
   721   assumes "(\<And>x. DERIV g x :> g'(x))"
   722       and "DERIV f x :> f'" 
   723     shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   724   by (metis UNIV_I DERIV_chain_s [of UNIV] assms)
   725 
   726 
   727 subsubsection {* @{text "DERIV_intros"} *}
   728 
   729 ML {*
   730 structure Deriv_Intros = Named_Thms
   731 (
   732   val name = @{binding DERIV_intros}
   733   val description = "DERIV introduction rules"
   734 )
   735 *}
   736 
   737 setup Deriv_Intros.setup
   738 
   739 lemma DERIV_cong: "DERIV f x : s :> X \<Longrightarrow> X = Y \<Longrightarrow> DERIV f x : s :> Y"
   740   by simp
   741 
   742 declare
   743   DERIV_const[THEN DERIV_cong, DERIV_intros]
   744   DERIV_ident[THEN DERIV_cong, DERIV_intros]
   745   DERIV_add[THEN DERIV_cong, DERIV_intros]
   746   DERIV_minus[THEN DERIV_cong, DERIV_intros]
   747   DERIV_mult[THEN DERIV_cong, DERIV_intros]
   748   DERIV_diff[THEN DERIV_cong, DERIV_intros]
   749   DERIV_inverse'[THEN DERIV_cong, DERIV_intros]
   750   DERIV_divide[THEN DERIV_cong, DERIV_intros]
   751   DERIV_power[where 'a=real, THEN DERIV_cong,
   752               unfolded real_of_nat_def[symmetric], DERIV_intros]
   753   DERIV_setsum[THEN DERIV_cong, DERIV_intros]
   754 
   755 text{*Alternative definition for differentiability*}
   756 
   757 lemma DERIV_LIM_iff:
   758   fixes f :: "'a::{real_normed_vector,inverse} \<Rightarrow> 'a" shows
   759      "((%h. (f(a + h) - f(a)) / h) -- 0 --> D) =
   760       ((%x. (f(x)-f(a)) / (x-a)) -- a --> D)"
   761 apply (rule iffI)
   762 apply (drule_tac k="- a" in LIM_offset)
   763 apply simp
   764 apply (drule_tac k="a" in LIM_offset)
   765 apply (simp add: add_commute)
   766 done
   767 
   768 lemma DERIV_iff2: "(DERIV f x :> D) \<longleftrightarrow> (\<lambda>z. (f z - f x) / (z - x)) --x --> D"
   769   by (simp add: deriv_def DERIV_LIM_iff)
   770 
   771 lemma DERIV_cong_ev: "x = y \<Longrightarrow> eventually (\<lambda>x. f x = g x) (nhds x) \<Longrightarrow> u = v \<Longrightarrow>
   772     DERIV f x :> u \<longleftrightarrow> DERIV g y :> v"
   773   unfolding DERIV_iff2
   774 proof (rule filterlim_cong)
   775   assume *: "eventually (\<lambda>x. f x = g x) (nhds x)"
   776   moreover from * have "f x = g x" by (auto simp: eventually_nhds)
   777   moreover assume "x = y" "u = v"
   778   ultimately show "eventually (\<lambda>xa. (f xa - f x) / (xa - x) = (g xa - g y) / (xa - y)) (at x)"
   779     by (auto simp: eventually_at_filter elim: eventually_elim1)
   780 qed simp_all
   781 
   782 lemma DERIV_shift:
   783   "(DERIV f (x + z) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (x + z)) x :> y)"
   784   by (simp add: DERIV_iff field_simps)
   785 
   786 lemma DERIV_mirror:
   787   "(DERIV f (- x) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (- x::real) :: real) x :> - y)"
   788   by (simp add: deriv_def filterlim_at_split filterlim_at_left_to_right
   789                 tendsto_minus_cancel_left field_simps conj_commute)
   790 
   791 text {* Caratheodory formulation of derivative at a point *}
   792 
   793 lemma CARAT_DERIV: (*FIXME: SUPERSEDED BY THE ONE IN Deriv.thy. But still used by NSA/HDeriv.thy*)
   794   "(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)"
   795       (is "?lhs = ?rhs")
   796 proof
   797   assume der: "DERIV f x :> l"
   798   show "\<exists>g. (\<forall>z. f z - f x = g z * (z-x)) \<and> isCont g x \<and> g x = l"
   799   proof (intro exI conjI)
   800     let ?g = "(%z. if z = x then l else (f z - f x) / (z-x))"
   801     show "\<forall>z. f z - f x = ?g z * (z-x)" by simp
   802     show "isCont ?g x" using der
   803       by (simp add: isCont_iff DERIV_iff cong: LIM_equal [rule_format])
   804     show "?g x = l" by simp
   805   qed
   806 next
   807   assume "?rhs"
   808   then obtain g where
   809     "(\<forall>z. f z - f x = g z * (z-x))" and "isCont g x" and "g x = l" by blast
   810   thus "(DERIV f x :> l)"
   811      by (auto simp add: isCont_iff DERIV_iff cong: LIM_cong)
   812 qed
   813 
   814 text {*
   815  Let's do the standard proof, though theorem
   816  @{text "LIM_mult2"} follows from a NS proof
   817 *}
   818 
   819 subsection {* Local extrema *}
   820 
   821 text{*If @{term "0 < f'(x)"} then @{term x} is Locally Strictly Increasing At The Right*}
   822 
   823 lemma DERIV_pos_inc_right:
   824   fixes f :: "real => real"
   825   assumes der: "DERIV f x :> l"
   826       and l:   "0 < l"
   827   shows "\<exists>d > 0. \<forall>h > 0. h < d --> f(x) < f(x + h)"
   828 proof -
   829   from l der [THEN DERIV_D, THEN LIM_D [where r = "l"]]
   830   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)"
   831     by simp
   832   then obtain s
   833         where s:   "0 < s"
   834           and all: "!!z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < l"
   835     by auto
   836   thus ?thesis
   837   proof (intro exI conjI strip)
   838     show "0<s" using s .
   839     fix h::real
   840     assume "0 < h" "h < s"
   841     with all [of h] show "f x < f (x+h)"
   842     proof (simp add: abs_if pos_less_divide_eq split add: split_if_asm)
   843       assume "~ (f (x+h) - f x) / h < l" and h: "0 < h"
   844       with l
   845       have "0 < (f (x+h) - f x) / h" by arith
   846       thus "f x < f (x+h)"
   847   by (simp add: pos_less_divide_eq h)
   848     qed
   849   qed
   850 qed
   851 
   852 lemma DERIV_neg_dec_left:
   853   fixes f :: "real => real"
   854   assumes der: "DERIV f x :> l"
   855       and l:   "l < 0"
   856   shows "\<exists>d > 0. \<forall>h > 0. h < d --> f(x) < f(x-h)"
   857 proof -
   858   from l der [THEN DERIV_D, THEN LIM_D [where r = "-l"]]
   859   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)"
   860     by simp
   861   then obtain s
   862         where s:   "0 < s"
   863           and all: "!!z. z \<noteq> 0 \<and> \<bar>z\<bar> < s \<longrightarrow> \<bar>(f(x+z) - f x) / z - l\<bar> < -l"
   864     by auto
   865   thus ?thesis
   866   proof (intro exI conjI strip)
   867     show "0<s" using s .
   868     fix h::real
   869     assume "0 < h" "h < s"
   870     with all [of "-h"] show "f x < f (x-h)"
   871     proof (simp add: abs_if pos_less_divide_eq split add: split_if_asm)
   872       assume " - ((f (x-h) - f x) / h) < l" and h: "0 < h"
   873       with l
   874       have "0 < (f (x-h) - f x) / h" by arith
   875       thus "f x < f (x-h)"
   876   by (simp add: pos_less_divide_eq h)
   877     qed
   878   qed
   879 qed
   880 
   881 lemma DERIV_pos_inc_left:
   882   fixes f :: "real => real"
   883   shows "DERIV f x :> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d --> f(x - h) < f(x)"
   884   apply (rule DERIV_neg_dec_left [of "%x. - f x" x "-l", simplified])
   885   apply (auto simp add: DERIV_minus)
   886   done
   887 
   888 lemma DERIV_neg_dec_right:
   889   fixes f :: "real => real"
   890   shows "DERIV f x :> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d --> f(x) > f(x + h)"
   891   apply (rule DERIV_pos_inc_right [of "%x. - f x" x "-l", simplified])
   892   apply (auto simp add: DERIV_minus)
   893   done
   894 
   895 lemma DERIV_local_max:
   896   fixes f :: "real => real"
   897   assumes der: "DERIV f x :> l"
   898       and d:   "0 < d"
   899       and le:  "\<forall>y. \<bar>x-y\<bar> < d --> f(y) \<le> f(x)"
   900   shows "l = 0"
   901 proof (cases rule: linorder_cases [of l 0])
   902   case equal thus ?thesis .
   903 next
   904   case less
   905   from DERIV_neg_dec_left [OF der less]
   906   obtain d' where d': "0 < d'"
   907              and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x-h)" by blast
   908   from real_lbound_gt_zero [OF d d']
   909   obtain e where "0 < e \<and> e < d \<and> e < d'" ..
   910   with lt le [THEN spec [where x="x-e"]]
   911   show ?thesis by (auto simp add: abs_if)
   912 next
   913   case greater
   914   from DERIV_pos_inc_right [OF der greater]
   915   obtain d' where d': "0 < d'"
   916              and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x + h)" by blast
   917   from real_lbound_gt_zero [OF d d']
   918   obtain e where "0 < e \<and> e < d \<and> e < d'" ..
   919   with lt le [THEN spec [where x="x+e"]]
   920   show ?thesis by (auto simp add: abs_if)
   921 qed
   922 
   923 
   924 text{*Similar theorem for a local minimum*}
   925 lemma DERIV_local_min:
   926   fixes f :: "real => real"
   927   shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) \<le> f(y) |] ==> l = 0"
   928 by (drule DERIV_minus [THEN DERIV_local_max], auto)
   929 
   930 
   931 text{*In particular, if a function is locally flat*}
   932 lemma DERIV_local_const:
   933   fixes f :: "real => real"
   934   shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) = f(y) |] ==> l = 0"
   935 by (auto dest!: DERIV_local_max)
   936 
   937 
   938 subsection {* Rolle's Theorem *}
   939 
   940 text{*Lemma about introducing open ball in open interval*}
   941 lemma lemma_interval_lt:
   942      "[| a < x;  x < b |]
   943       ==> \<exists>d::real. 0 < d & (\<forall>y. \<bar>x-y\<bar> < d --> a < y & y < b)"
   944 
   945 apply (simp add: abs_less_iff)
   946 apply (insert linorder_linear [of "x-a" "b-x"], safe)
   947 apply (rule_tac x = "x-a" in exI)
   948 apply (rule_tac [2] x = "b-x" in exI, auto)
   949 done
   950 
   951 lemma lemma_interval: "[| a < x;  x < b |] ==>
   952         \<exists>d::real. 0 < d &  (\<forall>y. \<bar>x-y\<bar> < d --> a \<le> y & y \<le> b)"
   953 apply (drule lemma_interval_lt, auto)
   954 apply force
   955 done
   956 
   957 text{*Rolle's Theorem.
   958    If @{term f} is defined and continuous on the closed interval
   959    @{text "[a,b]"} and differentiable on the open interval @{text "(a,b)"},
   960    and @{term "f(a) = f(b)"},
   961    then there exists @{text "x0 \<in> (a,b)"} such that @{term "f'(x0) = 0"}*}
   962 theorem Rolle:
   963   assumes lt: "a < b"
   964       and eq: "f(a) = f(b)"
   965       and con: "\<forall>x. a \<le> x & x \<le> b --> isCont f x"
   966       and dif [rule_format]: "\<forall>x. a < x & x < b --> f differentiable x"
   967   shows "\<exists>z::real. a < z & z < b & DERIV f z :> 0"
   968 proof -
   969   have le: "a \<le> b" using lt by simp
   970   from isCont_eq_Ub [OF le con]
   971   obtain x where x_max: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f z \<le> f x"
   972              and alex: "a \<le> x" and xleb: "x \<le> b"
   973     by blast
   974   from isCont_eq_Lb [OF le con]
   975   obtain x' where x'_min: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f x' \<le> f z"
   976               and alex': "a \<le> x'" and x'leb: "x' \<le> b"
   977     by blast
   978   show ?thesis
   979   proof cases
   980     assume axb: "a < x & x < b"
   981         --{*@{term f} attains its maximum within the interval*}
   982     hence ax: "a<x" and xb: "x<b" by arith + 
   983     from lemma_interval [OF ax xb]
   984     obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
   985       by blast
   986     hence bound': "\<forall>y. \<bar>x-y\<bar> < d \<longrightarrow> f y \<le> f x" using x_max
   987       by blast
   988     from differentiableD [OF dif [OF axb]]
   989     obtain l where der: "DERIV f x :> l" ..
   990     have "l=0" by (rule DERIV_local_max [OF der d bound'])
   991         --{*the derivative at a local maximum is zero*}
   992     thus ?thesis using ax xb der by auto
   993   next
   994     assume notaxb: "~ (a < x & x < b)"
   995     hence xeqab: "x=a | x=b" using alex xleb by arith
   996     hence fb_eq_fx: "f b = f x" by (auto simp add: eq)
   997     show ?thesis
   998     proof cases
   999       assume ax'b: "a < x' & x' < b"
  1000         --{*@{term f} attains its minimum within the interval*}
  1001       hence ax': "a<x'" and x'b: "x'<b" by arith+ 
  1002       from lemma_interval [OF ax' x'b]
  1003       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
  1004   by blast
  1005       hence bound': "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> f x' \<le> f y" using x'_min
  1006   by blast
  1007       from differentiableD [OF dif [OF ax'b]]
  1008       obtain l where der: "DERIV f x' :> l" ..
  1009       have "l=0" by (rule DERIV_local_min [OF der d bound'])
  1010         --{*the derivative at a local minimum is zero*}
  1011       thus ?thesis using ax' x'b der by auto
  1012     next
  1013       assume notax'b: "~ (a < x' & x' < b)"
  1014         --{*@{term f} is constant througout the interval*}
  1015       hence x'eqab: "x'=a | x'=b" using alex' x'leb by arith
  1016       hence fb_eq_fx': "f b = f x'" by (auto simp add: eq)
  1017       from dense [OF lt]
  1018       obtain r where ar: "a < r" and rb: "r < b" by blast
  1019       from lemma_interval [OF ar rb]
  1020       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>r-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
  1021   by blast
  1022       have eq_fb: "\<forall>z. a \<le> z --> z \<le> b --> f z = f b"
  1023       proof (clarify)
  1024         fix z::real
  1025         assume az: "a \<le> z" and zb: "z \<le> b"
  1026         show "f z = f b"
  1027         proof (rule order_antisym)
  1028           show "f z \<le> f b" by (simp add: fb_eq_fx x_max az zb)
  1029           show "f b \<le> f z" by (simp add: fb_eq_fx' x'_min az zb)
  1030         qed
  1031       qed
  1032       have bound': "\<forall>y. \<bar>r-y\<bar> < d \<longrightarrow> f r = f y"
  1033       proof (intro strip)
  1034         fix y::real
  1035         assume lt: "\<bar>r-y\<bar> < d"
  1036         hence "f y = f b" by (simp add: eq_fb bound)
  1037         thus "f r = f y" by (simp add: eq_fb ar rb order_less_imp_le)
  1038       qed
  1039       from differentiableD [OF dif [OF conjI [OF ar rb]]]
  1040       obtain l where der: "DERIV f r :> l" ..
  1041       have "l=0" by (rule DERIV_local_const [OF der d bound'])
  1042         --{*the derivative of a constant function is zero*}
  1043       thus ?thesis using ar rb der by auto
  1044     qed
  1045   qed
  1046 qed
  1047 
  1048 
  1049 subsection{*Mean Value Theorem*}
  1050 
  1051 lemma lemma_MVT:
  1052      "f a - (f b - f a)/(b-a) * a = f b - (f b - f a)/(b-a) * (b::real)"
  1053   by (cases "a = b") (simp_all add: field_simps)
  1054 
  1055 theorem MVT:
  1056   assumes lt:  "a < b"
  1057       and con: "\<forall>x. a \<le> x & x \<le> b --> isCont f x"
  1058       and dif [rule_format]: "\<forall>x. a < x & x < b --> f differentiable x"
  1059   shows "\<exists>l z::real. a < z & z < b & DERIV f z :> l &
  1060                    (f(b) - f(a) = (b-a) * l)"
  1061 proof -
  1062   let ?F = "%x. f x - ((f b - f a) / (b-a)) * x"
  1063   have contF: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont ?F x"
  1064     using con by (fast intro: isCont_intros)
  1065   have difF: "\<forall>x. a < x \<and> x < b \<longrightarrow> ?F differentiable x"
  1066   proof (clarify)
  1067     fix x::real
  1068     assume ax: "a < x" and xb: "x < b"
  1069     from differentiableD [OF dif [OF conjI [OF ax xb]]]
  1070     obtain l where der: "DERIV f x :> l" ..
  1071     show "?F differentiable x"
  1072       by (rule differentiableI [where D = "l - (f b - f a)/(b-a)"],
  1073           blast intro: DERIV_diff DERIV_cmult_Id der)
  1074   qed
  1075   from Rolle [where f = ?F, OF lt lemma_MVT contF difF]
  1076   obtain z where az: "a < z" and zb: "z < b" and der: "DERIV ?F z :> 0"
  1077     by blast
  1078   have "DERIV (%x. ((f b - f a)/(b-a)) * x) z :> (f b - f a)/(b-a)"
  1079     by (rule DERIV_cmult_Id)
  1080   hence derF: "DERIV (\<lambda>x. ?F x + (f b - f a) / (b - a) * x) z
  1081                    :> 0 + (f b - f a) / (b - a)"
  1082     by (rule DERIV_add [OF der])
  1083   show ?thesis
  1084   proof (intro exI conjI)
  1085     show "a < z" using az .
  1086     show "z < b" using zb .
  1087     show "f b - f a = (b - a) * ((f b - f a)/(b-a))" by (simp)
  1088     show "DERIV f z :> ((f b - f a)/(b-a))"  using derF by simp
  1089   qed
  1090 qed
  1091 
  1092 lemma MVT2:
  1093      "[| a < b; \<forall>x. a \<le> x & x \<le> b --> DERIV f x :> f'(x) |]
  1094       ==> \<exists>z::real. a < z & z < b & (f b - f a = (b - a) * f'(z))"
  1095 apply (drule MVT)
  1096 apply (blast intro: DERIV_isCont)
  1097 apply (force dest: order_less_imp_le simp add: differentiable_def)
  1098 apply (blast dest: DERIV_unique order_less_imp_le)
  1099 done
  1100 
  1101 
  1102 text{*A function is constant if its derivative is 0 over an interval.*}
  1103 
  1104 lemma DERIV_isconst_end:
  1105   fixes f :: "real => real"
  1106   shows "[| a < b;
  1107          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1108          \<forall>x. a < x & x < b --> DERIV f x :> 0 |]
  1109         ==> f b = f a"
  1110 apply (drule MVT, assumption)
  1111 apply (blast intro: differentiableI)
  1112 apply (auto dest!: DERIV_unique simp add: diff_eq_eq)
  1113 done
  1114 
  1115 lemma DERIV_isconst1:
  1116   fixes f :: "real => real"
  1117   shows "[| a < b;
  1118          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1119          \<forall>x. a < x & x < b --> DERIV f x :> 0 |]
  1120         ==> \<forall>x. a \<le> x & x \<le> b --> f x = f a"
  1121 apply safe
  1122 apply (drule_tac x = a in order_le_imp_less_or_eq, safe)
  1123 apply (drule_tac b = x in DERIV_isconst_end, auto)
  1124 done
  1125 
  1126 lemma DERIV_isconst2:
  1127   fixes f :: "real => real"
  1128   shows "[| a < b;
  1129          \<forall>x. a \<le> x & x \<le> b --> isCont f x;
  1130          \<forall>x. a < x & x < b --> DERIV f x :> 0;
  1131          a \<le> x; x \<le> b |]
  1132         ==> f x = f a"
  1133 apply (blast dest: DERIV_isconst1)
  1134 done
  1135 
  1136 lemma DERIV_isconst3: fixes a b x y :: real
  1137   assumes "a < b" and "x \<in> {a <..< b}" and "y \<in> {a <..< b}"
  1138   assumes derivable: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> DERIV f x :> 0"
  1139   shows "f x = f y"
  1140 proof (cases "x = y")
  1141   case False
  1142   let ?a = "min x y"
  1143   let ?b = "max x y"
  1144   
  1145   have "\<forall>z. ?a \<le> z \<and> z \<le> ?b \<longrightarrow> DERIV f z :> 0"
  1146   proof (rule allI, rule impI)
  1147     fix z :: real assume "?a \<le> z \<and> z \<le> ?b"
  1148     hence "a < z" and "z < b" using `x \<in> {a <..< b}` and `y \<in> {a <..< b}` by auto
  1149     hence "z \<in> {a<..<b}" by auto
  1150     thus "DERIV f z :> 0" by (rule derivable)
  1151   qed
  1152   hence isCont: "\<forall>z. ?a \<le> z \<and> z \<le> ?b \<longrightarrow> isCont f z"
  1153     and DERIV: "\<forall>z. ?a < z \<and> z < ?b \<longrightarrow> DERIV f z :> 0" using DERIV_isCont by auto
  1154 
  1155   have "?a < ?b" using `x \<noteq> y` by auto
  1156   from DERIV_isconst2[OF this isCont DERIV, of x] and DERIV_isconst2[OF this isCont DERIV, of y]
  1157   show ?thesis by auto
  1158 qed auto
  1159 
  1160 lemma DERIV_isconst_all:
  1161   fixes f :: "real => real"
  1162   shows "\<forall>x. DERIV f x :> 0 ==> f(x) = f(y)"
  1163 apply (rule linorder_cases [of x y])
  1164 apply (blast intro: sym DERIV_isCont DERIV_isconst_end)+
  1165 done
  1166 
  1167 lemma DERIV_const_ratio_const:
  1168   fixes f :: "real => real"
  1169   shows "[|a \<noteq> b; \<forall>x. DERIV f x :> k |] ==> (f(b) - f(a)) = (b-a) * k"
  1170 apply (rule linorder_cases [of a b], auto)
  1171 apply (drule_tac [!] f = f in MVT)
  1172 apply (auto dest: DERIV_isCont DERIV_unique simp add: differentiable_def)
  1173 apply (auto dest: DERIV_unique simp add: ring_distribs)
  1174 done
  1175 
  1176 lemma DERIV_const_ratio_const2:
  1177   fixes f :: "real => real"
  1178   shows "[|a \<noteq> b; \<forall>x. DERIV f x :> k |] ==> (f(b) - f(a))/(b-a) = k"
  1179 apply (rule_tac c1 = "b-a" in real_mult_right_cancel [THEN iffD1])
  1180 apply (auto dest!: DERIV_const_ratio_const simp add: mult_assoc)
  1181 done
  1182 
  1183 lemma real_average_minus_first [simp]: "((a + b) /2 - a) = (b-a)/(2::real)"
  1184 by (simp)
  1185 
  1186 lemma real_average_minus_second [simp]: "((b + a)/2 - a) = (b-a)/(2::real)"
  1187 by (simp)
  1188 
  1189 text{*Gallileo's "trick": average velocity = av. of end velocities*}
  1190 
  1191 lemma DERIV_const_average:
  1192   fixes v :: "real => real"
  1193   assumes neq: "a \<noteq> (b::real)"
  1194       and der: "\<forall>x. DERIV v x :> k"
  1195   shows "v ((a + b)/2) = (v a + v b)/2"
  1196 proof (cases rule: linorder_cases [of a b])
  1197   case equal with neq show ?thesis by simp
  1198 next
  1199   case less
  1200   have "(v b - v a) / (b - a) = k"
  1201     by (rule DERIV_const_ratio_const2 [OF neq der])
  1202   hence "(b-a) * ((v b - v a) / (b-a)) = (b-a) * k" by simp
  1203   moreover have "(v ((a + b) / 2) - v a) / ((a + b) / 2 - a) = k"
  1204     by (rule DERIV_const_ratio_const2 [OF _ der], simp add: neq)
  1205   ultimately show ?thesis using neq by force
  1206 next
  1207   case greater
  1208   have "(v b - v a) / (b - a) = k"
  1209     by (rule DERIV_const_ratio_const2 [OF neq der])
  1210   hence "(b-a) * ((v b - v a) / (b-a)) = (b-a) * k" by simp
  1211   moreover have " (v ((b + a) / 2) - v a) / ((b + a) / 2 - a) = k"
  1212     by (rule DERIV_const_ratio_const2 [OF _ der], simp add: neq)
  1213   ultimately show ?thesis using neq by (force simp add: add_commute)
  1214 qed
  1215 
  1216 (* A function with positive derivative is increasing. 
  1217    A simple proof using the MVT, by Jeremy Avigad. And variants.
  1218 *)
  1219 lemma DERIV_pos_imp_increasing:
  1220   fixes a::real and b::real and f::"real => real"
  1221   assumes "a < b" and "\<forall>x. a \<le> x & x \<le> b --> (EX y. DERIV f x :> y & y > 0)"
  1222   shows "f a < f b"
  1223 proof (rule ccontr)
  1224   assume f: "~ f a < f b"
  1225   have "EX l z. a < z & z < b & DERIV f z :> l
  1226       & f b - f a = (b - a) * l"
  1227     apply (rule MVT)
  1228       using assms
  1229       apply auto
  1230       apply (metis DERIV_isCont)
  1231      apply (metis differentiableI less_le)
  1232     done
  1233   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l"
  1234       and "f b - f a = (b - a) * l"
  1235     by auto
  1236   with assms f have "~(l > 0)"
  1237     by (metis linorder_not_le mult_le_0_iff diff_le_0_iff_le)
  1238   with assms z show False
  1239     by (metis DERIV_unique less_le)
  1240 qed
  1241 
  1242 lemma DERIV_nonneg_imp_nondecreasing:
  1243   fixes a::real and b::real and f::"real => real"
  1244   assumes "a \<le> b" and
  1245     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y \<ge> 0)"
  1246   shows "f a \<le> f b"
  1247 proof (rule ccontr, cases "a = b")
  1248   assume "~ f a \<le> f b" and "a = b"
  1249   then show False by auto
  1250 next
  1251   assume A: "~ f a \<le> f b"
  1252   assume B: "a ~= b"
  1253   with assms have "EX l z. a < z & z < b & DERIV f z :> l
  1254       & f b - f a = (b - a) * l"
  1255     apply -
  1256     apply (rule MVT)
  1257       apply auto
  1258       apply (metis DERIV_isCont)
  1259      apply (metis differentiableI less_le)
  1260     done
  1261   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l"
  1262       and C: "f b - f a = (b - a) * l"
  1263     by auto
  1264   with A have "a < b" "f b < f a" by auto
  1265   with C have "\<not> l \<ge> 0" by (auto simp add: not_le algebra_simps)
  1266     (metis A add_le_cancel_right assms(1) less_eq_real_def mult_right_mono add_left_mono linear order_refl)
  1267   with assms z show False
  1268     by (metis DERIV_unique order_less_imp_le)
  1269 qed
  1270 
  1271 lemma DERIV_neg_imp_decreasing:
  1272   fixes a::real and b::real and f::"real => real"
  1273   assumes "a < b" and
  1274     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y < 0)"
  1275   shows "f a > f b"
  1276 proof -
  1277   have "(%x. -f x) a < (%x. -f x) b"
  1278     apply (rule DERIV_pos_imp_increasing [of a b "%x. -f x"])
  1279     using assms
  1280     apply auto
  1281     apply (metis DERIV_minus neg_0_less_iff_less)
  1282     done
  1283   thus ?thesis
  1284     by simp
  1285 qed
  1286 
  1287 lemma DERIV_nonpos_imp_nonincreasing:
  1288   fixes a::real and b::real and f::"real => real"
  1289   assumes "a \<le> b" and
  1290     "\<forall>x. a \<le> x & x \<le> b --> (\<exists>y. DERIV f x :> y & y \<le> 0)"
  1291   shows "f a \<ge> f b"
  1292 proof -
  1293   have "(%x. -f x) a \<le> (%x. -f x) b"
  1294     apply (rule DERIV_nonneg_imp_nondecreasing [of a b "%x. -f x"])
  1295     using assms
  1296     apply auto
  1297     apply (metis DERIV_minus neg_0_le_iff_le)
  1298     done
  1299   thus ?thesis
  1300     by simp
  1301 qed
  1302 
  1303 text {* Derivative of inverse function *}
  1304 
  1305 lemma DERIV_inverse_function:
  1306   fixes f g :: "real \<Rightarrow> real"
  1307   assumes der: "DERIV f (g x) :> D"
  1308   assumes neq: "D \<noteq> 0"
  1309   assumes a: "a < x" and b: "x < b"
  1310   assumes inj: "\<forall>y. a < y \<and> y < b \<longrightarrow> f (g y) = y"
  1311   assumes cont: "isCont g x"
  1312   shows "DERIV g x :> inverse D"
  1313 unfolding DERIV_iff2
  1314 proof (rule LIM_equal2)
  1315   show "0 < min (x - a) (b - x)"
  1316     using a b by arith 
  1317 next
  1318   fix y
  1319   assume "norm (y - x) < min (x - a) (b - x)"
  1320   hence "a < y" and "y < b" 
  1321     by (simp_all add: abs_less_iff)
  1322   thus "(g y - g x) / (y - x) =
  1323         inverse ((f (g y) - x) / (g y - g x))"
  1324     by (simp add: inj)
  1325 next
  1326   have "(\<lambda>z. (f z - f (g x)) / (z - g x)) -- g x --> D"
  1327     by (rule der [unfolded DERIV_iff2])
  1328   hence 1: "(\<lambda>z. (f z - x) / (z - g x)) -- g x --> D"
  1329     using inj a b by simp
  1330   have 2: "\<exists>d>0. \<forall>y. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow> g y \<noteq> g x"
  1331   proof (safe intro!: exI)
  1332     show "0 < min (x - a) (b - x)"
  1333       using a b by simp
  1334   next
  1335     fix y
  1336     assume "norm (y - x) < min (x - a) (b - x)"
  1337     hence y: "a < y" "y < b"
  1338       by (simp_all add: abs_less_iff)
  1339     assume "g y = g x"
  1340     hence "f (g y) = f (g x)" by simp
  1341     hence "y = x" using inj y a b by simp
  1342     also assume "y \<noteq> x"
  1343     finally show False by simp
  1344   qed
  1345   have "(\<lambda>y. (f (g y) - x) / (g y - g x)) -- x --> D"
  1346     using cont 1 2 by (rule isCont_LIM_compose2)
  1347   thus "(\<lambda>y. inverse ((f (g y) - x) / (g y - g x)))
  1348         -- x --> inverse D"
  1349     using neq by (rule tendsto_inverse)
  1350 qed
  1351 
  1352 subsection {* Generalized Mean Value Theorem *}
  1353 
  1354 theorem GMVT:
  1355   fixes a b :: real
  1356   assumes alb: "a < b"
  1357     and fc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
  1358     and fd: "\<forall>x. a < x \<and> x < b \<longrightarrow> f differentiable x"
  1359     and gc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont g x"
  1360     and gd: "\<forall>x. a < x \<and> x < b \<longrightarrow> g differentiable x"
  1361   shows "\<exists>g'c f'c c.
  1362     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)"
  1363 proof -
  1364   let ?h = "\<lambda>x. (f b - f a)*(g x) - (g b - g a)*(f x)"
  1365   from assms have "a < b" by simp
  1366   moreover have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont ?h x"
  1367     using fc gc by simp
  1368   moreover have "\<forall>x. a < x \<and> x < b \<longrightarrow> ?h differentiable x"
  1369     using fd gd by simp
  1370   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)
  1371   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" ..
  1372   then obtain c where cdef: "a < c \<and> c < b \<and> DERIV ?h c :> l \<and> ?h b - ?h a = (b - a) * l" ..
  1373 
  1374   from cdef have cint: "a < c \<and> c < b" by auto
  1375   with gd have "g differentiable c" by simp
  1376   hence "\<exists>D. DERIV g c :> D" by (rule differentiableD)
  1377   then obtain g'c where g'cdef: "DERIV g c :> g'c" ..
  1378 
  1379   from cdef have "a < c \<and> c < b" by auto
  1380   with fd have "f differentiable c" by simp
  1381   hence "\<exists>D. DERIV f c :> D" by (rule differentiableD)
  1382   then obtain f'c where f'cdef: "DERIV f c :> f'c" ..
  1383 
  1384   from cdef have "DERIV ?h c :> l" by auto
  1385   moreover have "DERIV ?h c :>  g'c * (f b - f a) - f'c * (g b - g a)"
  1386     using g'cdef f'cdef by (auto intro!: DERIV_intros)
  1387   ultimately have leq: "l =  g'c * (f b - f a) - f'c * (g b - g a)" by (rule DERIV_unique)
  1388 
  1389   {
  1390     from cdef have "?h b - ?h a = (b - a) * l" by auto
  1391     also from leq have "\<dots> = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
  1392     finally have "?h b - ?h a = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
  1393   }
  1394   moreover
  1395   {
  1396     have "?h b - ?h a =
  1397          ((f b)*(g b) - (f a)*(g b) - (g b)*(f b) + (g a)*(f b)) -
  1398           ((f b)*(g a) - (f a)*(g a) - (g b)*(f a) + (g a)*(f a))"
  1399       by (simp add: algebra_simps)
  1400     hence "?h b - ?h a = 0" by auto
  1401   }
  1402   ultimately have "(b - a) * (g'c * (f b - f a) - f'c * (g b - g a)) = 0" by auto
  1403   with alb have "g'c * (f b - f a) - f'c * (g b - g a) = 0" by simp
  1404   hence "g'c * (f b - f a) = f'c * (g b - g a)" by simp
  1405   hence "(f b - f a) * g'c = (g b - g a) * f'c" by (simp add: mult_ac)
  1406 
  1407   with g'cdef f'cdef cint show ?thesis by auto
  1408 qed
  1409 
  1410 lemma GMVT':
  1411   fixes f g :: "real \<Rightarrow> real"
  1412   assumes "a < b"
  1413   assumes isCont_f: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont f z"
  1414   assumes isCont_g: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont g z"
  1415   assumes DERIV_g: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV g z :> (g' z)"
  1416   assumes DERIV_f: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV f z :> (f' z)"
  1417   shows "\<exists>c. a < c \<and> c < b \<and> (f b - f a) * g' c = (g b - g a) * f' c"
  1418 proof -
  1419   have "\<exists>g'c f'c c. DERIV g c :> g'c \<and> DERIV f c :> f'c \<and>
  1420     a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
  1421     using assms by (intro GMVT) (force simp: differentiable_def)+
  1422   then obtain c where "a < c" "c < b" "(f b - f a) * g' c = (g b - g a) * f' c"
  1423     using DERIV_f DERIV_g by (force dest: DERIV_unique)
  1424   then show ?thesis
  1425     by auto
  1426 qed
  1427 
  1428 
  1429 subsection {* L'Hopitals rule *}
  1430 
  1431 lemma isCont_If_ge:
  1432   fixes a :: "'a :: linorder_topology"
  1433   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"
  1434   unfolding isCont_def continuous_within
  1435   apply (intro filterlim_split_at)
  1436   apply (subst filterlim_cong[OF refl refl, where g=g])
  1437   apply (simp_all add: eventually_at_filter less_le)
  1438   apply (subst filterlim_cong[OF refl refl, where g=f])
  1439   apply (simp_all add: eventually_at_filter less_le)
  1440   done
  1441 
  1442 lemma lhopital_right_0:
  1443   fixes f0 g0 :: "real \<Rightarrow> real"
  1444   assumes f_0: "(f0 ---> 0) (at_right 0)"
  1445   assumes g_0: "(g0 ---> 0) (at_right 0)"
  1446   assumes ev:
  1447     "eventually (\<lambda>x. g0 x \<noteq> 0) (at_right 0)"
  1448     "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
  1449     "eventually (\<lambda>x. DERIV f0 x :> f' x) (at_right 0)"
  1450     "eventually (\<lambda>x. DERIV g0 x :> g' x) (at_right 0)"
  1451   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) (at_right 0)"
  1452   shows "((\<lambda> x. f0 x / g0 x) ---> x) (at_right 0)"
  1453 proof -
  1454   def f \<equiv> "\<lambda>x. if x \<le> 0 then 0 else f0 x"
  1455   then have "f 0 = 0" by simp
  1456 
  1457   def g \<equiv> "\<lambda>x. if x \<le> 0 then 0 else g0 x"
  1458   then have "g 0 = 0" by simp
  1459 
  1460   have "eventually (\<lambda>x. g0 x \<noteq> 0 \<and> g' x \<noteq> 0 \<and>
  1461       DERIV f0 x :> (f' x) \<and> DERIV g0 x :> (g' x)) (at_right 0)"
  1462     using ev by eventually_elim auto
  1463   then obtain a where [arith]: "0 < a"
  1464     and g0_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g0 x \<noteq> 0"
  1465     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
  1466     and f0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV f0 x :> (f' x)"
  1467     and g0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV g0 x :> (g' x)"
  1468     unfolding eventually_at eventually_at by (auto simp: dist_real_def)
  1469 
  1470   have g_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g x \<noteq> 0"
  1471     using g0_neq_0 by (simp add: g_def)
  1472 
  1473   { fix x assume x: "0 < x" "x < a" then have "DERIV f x :> (f' x)"
  1474       by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ f0[OF x]])
  1475          (auto simp: f_def eventually_nhds_metric dist_real_def intro!: exI[of _ x]) }
  1476   note f = this
  1477 
  1478   { fix x assume x: "0 < x" "x < a" then have "DERIV g x :> (g' x)"
  1479       by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ g0[OF x]])
  1480          (auto simp: g_def eventually_nhds_metric dist_real_def intro!: exI[of _ x]) }
  1481   note g = this
  1482 
  1483   have "isCont f 0"
  1484     unfolding f_def by (intro isCont_If_ge f_0 continuous_const)
  1485 
  1486   have "isCont g 0"
  1487     unfolding g_def by (intro isCont_If_ge g_0 continuous_const)
  1488 
  1489   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)"
  1490   proof (rule bchoice, rule)
  1491     fix x assume "x \<in> {0 <..< a}"
  1492     then have x[arith]: "0 < x" "x < a" by auto
  1493     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"
  1494       by auto
  1495     have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont f x"
  1496       using `isCont f 0` f by (auto intro: DERIV_isCont simp: le_less)
  1497     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont g x"
  1498       using `isCont g 0` g by (auto intro: DERIV_isCont simp: le_less)
  1499     ultimately have "\<exists>c. 0 < c \<and> c < x \<and> (f x - f 0) * g' c = (g x - g 0) * f' c"
  1500       using f g `x < a` by (intro GMVT') auto
  1501     then obtain c where *: "0 < c" "c < x" "(f x - f 0) * g' c = (g x - g 0) * f' c"
  1502       by blast
  1503     moreover
  1504     from * g'(1)[of c] g'(2) have "(f x - f 0)  / (g x - g 0) = f' c / g' c"
  1505       by (simp add: field_simps)
  1506     ultimately show "\<exists>y. 0 < y \<and> y < x \<and> f x / g x = f' y / g' y"
  1507       using `f 0 = 0` `g 0 = 0` by (auto intro!: exI[of _ c])
  1508   qed
  1509   then obtain \<zeta> where "\<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)" ..
  1510   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)"
  1511     unfolding eventually_at by (intro exI[of _ a]) (auto simp: dist_real_def)
  1512   moreover
  1513   from \<zeta> have "eventually (\<lambda>x. norm (\<zeta> x) \<le> x) (at_right 0)"
  1514     by eventually_elim auto
  1515   then have "((\<lambda>x. norm (\<zeta> x)) ---> 0) (at_right 0)"
  1516     by (rule_tac real_tendsto_sandwich[where f="\<lambda>x. 0" and h="\<lambda>x. x"])
  1517        (auto intro: tendsto_const tendsto_ident_at)
  1518   then have "(\<zeta> ---> 0) (at_right 0)"
  1519     by (rule tendsto_norm_zero_cancel)
  1520   with \<zeta> have "filterlim \<zeta> (at_right 0) (at_right 0)"
  1521     by (auto elim!: eventually_elim1 simp: filterlim_at)
  1522   from this lim have "((\<lambda>t. f' (\<zeta> t) / g' (\<zeta> t)) ---> x) (at_right 0)"
  1523     by (rule_tac filterlim_compose[of _ _ _ \<zeta>])
  1524   ultimately have "((\<lambda>t. f t / g t) ---> x) (at_right 0)" (is ?P)
  1525     by (rule_tac filterlim_cong[THEN iffD1, OF refl refl])
  1526        (auto elim: eventually_elim1)
  1527   also have "?P \<longleftrightarrow> ?thesis"
  1528     by (rule filterlim_cong) (auto simp: f_def g_def eventually_at_filter)
  1529   finally show ?thesis .
  1530 qed
  1531 
  1532 lemma lhopital_right:
  1533   "((f::real \<Rightarrow> real) ---> 0) (at_right x) \<Longrightarrow> (g ---> 0) (at_right x) \<Longrightarrow>
  1534     eventually (\<lambda>x. g x \<noteq> 0) (at_right x) \<Longrightarrow>
  1535     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
  1536     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
  1537     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
  1538     ((\<lambda> x. (f' x / g' x)) ---> y) (at_right x) \<Longrightarrow>
  1539   ((\<lambda> x. f x / g x) ---> y) (at_right x)"
  1540   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
  1541   by (rule lhopital_right_0)
  1542 
  1543 lemma lhopital_left:
  1544   "((f::real \<Rightarrow> real) ---> 0) (at_left x) \<Longrightarrow> (g ---> 0) (at_left x) \<Longrightarrow>
  1545     eventually (\<lambda>x. g x \<noteq> 0) (at_left x) \<Longrightarrow>
  1546     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
  1547     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
  1548     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
  1549     ((\<lambda> x. (f' x / g' x)) ---> y) (at_left x) \<Longrightarrow>
  1550   ((\<lambda> x. f x / g x) ---> y) (at_left x)"
  1551   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
  1552   by (rule lhopital_right[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
  1553 
  1554 lemma lhopital:
  1555   "((f::real \<Rightarrow> real) ---> 0) (at x) \<Longrightarrow> (g ---> 0) (at x) \<Longrightarrow>
  1556     eventually (\<lambda>x. g x \<noteq> 0) (at x) \<Longrightarrow>
  1557     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
  1558     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
  1559     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
  1560     ((\<lambda> x. (f' x / g' x)) ---> y) (at x) \<Longrightarrow>
  1561   ((\<lambda> x. f x / g x) ---> y) (at x)"
  1562   unfolding eventually_at_split filterlim_at_split
  1563   by (auto intro!: lhopital_right[of f x g g' f'] lhopital_left[of f x g g' f'])
  1564 
  1565 lemma lhopital_right_0_at_top:
  1566   fixes f g :: "real \<Rightarrow> real"
  1567   assumes g_0: "LIM x at_right 0. g x :> at_top"
  1568   assumes ev:
  1569     "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
  1570     "eventually (\<lambda>x. DERIV f x :> f' x) (at_right 0)"
  1571     "eventually (\<lambda>x. DERIV g x :> g' x) (at_right 0)"
  1572   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) (at_right 0)"
  1573   shows "((\<lambda> x. f x / g x) ---> x) (at_right 0)"
  1574   unfolding tendsto_iff
  1575 proof safe
  1576   fix e :: real assume "0 < e"
  1577 
  1578   with lim[unfolded tendsto_iff, rule_format, of "e / 4"]
  1579   have "eventually (\<lambda>t. dist (f' t / g' t) x < e / 4) (at_right 0)" by simp
  1580   from eventually_conj[OF eventually_conj[OF ev(1) ev(2)] eventually_conj[OF ev(3) this]]
  1581   obtain a where [arith]: "0 < a"
  1582     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
  1583     and f0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV f x :> (f' x)"
  1584     and g0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV g x :> (g' x)"
  1585     and Df: "\<And>t. 0 < t \<Longrightarrow> t < a \<Longrightarrow> dist (f' t / g' t) x < e / 4"
  1586     unfolding eventually_at_le by (auto simp: dist_real_def)
  1587     
  1588 
  1589   from Df have
  1590     "eventually (\<lambda>t. t < a) (at_right 0)" "eventually (\<lambda>t::real. 0 < t) (at_right 0)"
  1591     unfolding eventually_at by (auto intro!: exI[of _ a] simp: dist_real_def)
  1592 
  1593   moreover
  1594   have "eventually (\<lambda>t. 0 < g t) (at_right 0)" "eventually (\<lambda>t. g a < g t) (at_right 0)"
  1595     using g_0 by (auto elim: eventually_elim1 simp: filterlim_at_top_dense)
  1596 
  1597   moreover
  1598   have inv_g: "((\<lambda>x. inverse (g x)) ---> 0) (at_right 0)"
  1599     using tendsto_inverse_0 filterlim_mono[OF g_0 at_top_le_at_infinity order_refl]
  1600     by (rule filterlim_compose)
  1601   then have "((\<lambda>x. norm (1 - g a * inverse (g x))) ---> norm (1 - g a * 0)) (at_right 0)"
  1602     by (intro tendsto_intros)
  1603   then have "((\<lambda>x. norm (1 - g a / g x)) ---> 1) (at_right 0)"
  1604     by (simp add: inverse_eq_divide)
  1605   from this[unfolded tendsto_iff, rule_format, of 1]
  1606   have "eventually (\<lambda>x. norm (1 - g a / g x) < 2) (at_right 0)"
  1607     by (auto elim!: eventually_elim1 simp: dist_real_def)
  1608 
  1609   moreover
  1610   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)"
  1611     by (intro tendsto_intros)
  1612   then have "((\<lambda>t. norm (f a - x * g a) / norm (g t)) ---> 0) (at_right 0)"
  1613     by (simp add: inverse_eq_divide)
  1614   from this[unfolded tendsto_iff, rule_format, of "e / 2"] `0 < e`
  1615   have "eventually (\<lambda>t. norm (f a - x * g a) / norm (g t) < e / 2) (at_right 0)"
  1616     by (auto simp: dist_real_def)
  1617 
  1618   ultimately show "eventually (\<lambda>t. dist (f t / g t) x < e) (at_right 0)"
  1619   proof eventually_elim
  1620     fix t assume t[arith]: "0 < t" "t < a" "g a < g t" "0 < g t"
  1621     assume ineq: "norm (1 - g a / g t) < 2" "norm (f a - x * g a) / norm (g t) < e / 2"
  1622 
  1623     have "\<exists>y. t < y \<and> y < a \<and> (g a - g t) * f' y = (f a - f t) * g' y"
  1624       using f0 g0 t(1,2) by (intro GMVT') (force intro!: DERIV_isCont)+
  1625     then obtain y where [arith]: "t < y" "y < a"
  1626       and D_eq0: "(g a - g t) * f' y = (f a - f t) * g' y"
  1627       by blast
  1628     from D_eq0 have D_eq: "(f t - f a) / (g t - g a) = f' y / g' y"
  1629       using `g a < g t` g'_neq_0[of y] by (auto simp add: field_simps)
  1630 
  1631     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"
  1632       by (simp add: field_simps)
  1633     have "norm (f t / g t - x) \<le>
  1634         norm (((f t - f a) / (g t - g a) - x) * (1 - g a / g t)) + norm ((f a - x * g a) / g t)"
  1635       unfolding * by (rule norm_triangle_ineq)
  1636     also have "\<dots> = dist (f' y / g' y) x * norm (1 - g a / g t) + norm (f a - x * g a) / norm (g t)"
  1637       by (simp add: abs_mult D_eq dist_real_def)
  1638     also have "\<dots> < (e / 4) * 2 + e / 2"
  1639       using ineq Df[of y] `0 < e` by (intro add_le_less_mono mult_mono) auto
  1640     finally show "dist (f t / g t) x < e"
  1641       by (simp add: dist_real_def)
  1642   qed
  1643 qed
  1644 
  1645 lemma lhopital_right_at_top:
  1646   "LIM x at_right x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1647     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
  1648     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
  1649     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
  1650     ((\<lambda> x. (f' x / g' x)) ---> y) (at_right x) \<Longrightarrow>
  1651     ((\<lambda> x. f x / g x) ---> y) (at_right x)"
  1652   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
  1653   by (rule lhopital_right_0_at_top)
  1654 
  1655 lemma lhopital_left_at_top:
  1656   "LIM x at_left x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1657     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
  1658     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
  1659     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
  1660     ((\<lambda> x. (f' x / g' x)) ---> y) (at_left x) \<Longrightarrow>
  1661     ((\<lambda> x. f x / g x) ---> y) (at_left x)"
  1662   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
  1663   by (rule lhopital_right_at_top[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
  1664 
  1665 lemma lhopital_at_top:
  1666   "LIM x at x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
  1667     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
  1668     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
  1669     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
  1670     ((\<lambda> x. (f' x / g' x)) ---> y) (at x) \<Longrightarrow>
  1671     ((\<lambda> x. f x / g x) ---> y) (at x)"
  1672   unfolding eventually_at_split filterlim_at_split
  1673   by (auto intro!: lhopital_right_at_top[of g x g' f f'] lhopital_left_at_top[of g x g' f f'])
  1674 
  1675 lemma lhospital_at_top_at_top:
  1676   fixes f g :: "real \<Rightarrow> real"
  1677   assumes g_0: "LIM x at_top. g x :> at_top"
  1678   assumes g': "eventually (\<lambda>x. g' x \<noteq> 0) at_top"
  1679   assumes Df: "eventually (\<lambda>x. DERIV f x :> f' x) at_top"
  1680   assumes Dg: "eventually (\<lambda>x. DERIV g x :> g' x) at_top"
  1681   assumes lim: "((\<lambda> x. (f' x / g' x)) ---> x) at_top"
  1682   shows "((\<lambda> x. f x / g x) ---> x) at_top"
  1683   unfolding filterlim_at_top_to_right
  1684 proof (rule lhopital_right_0_at_top)
  1685   let ?F = "\<lambda>x. f (inverse x)"
  1686   let ?G = "\<lambda>x. g (inverse x)"
  1687   let ?R = "at_right (0::real)"
  1688   let ?D = "\<lambda>f' x. f' (inverse x) * - (inverse x ^ Suc (Suc 0))"
  1689 
  1690   show "LIM x ?R. ?G x :> at_top"
  1691     using g_0 unfolding filterlim_at_top_to_right .
  1692 
  1693   show "eventually (\<lambda>x. DERIV ?G x  :> ?D g' x) ?R"
  1694     unfolding eventually_at_right_to_top
  1695     using Dg eventually_ge_at_top[where c="1::real"]
  1696     apply eventually_elim
  1697     apply (rule DERIV_cong)
  1698     apply (rule DERIV_chain'[where f=inverse])
  1699     apply (auto intro!:  DERIV_inverse)
  1700     done
  1701 
  1702   show "eventually (\<lambda>x. DERIV ?F x  :> ?D f' x) ?R"
  1703     unfolding eventually_at_right_to_top
  1704     using Df eventually_ge_at_top[where c="1::real"]
  1705     apply eventually_elim
  1706     apply (rule DERIV_cong)
  1707     apply (rule DERIV_chain'[where f=inverse])
  1708     apply (auto intro!:  DERIV_inverse)
  1709     done
  1710 
  1711   show "eventually (\<lambda>x. ?D g' x \<noteq> 0) ?R"
  1712     unfolding eventually_at_right_to_top
  1713     using g' eventually_ge_at_top[where c="1::real"]
  1714     by eventually_elim auto
  1715     
  1716   show "((\<lambda>x. ?D f' x / ?D g' x) ---> x) ?R"
  1717     unfolding filterlim_at_right_to_top
  1718     apply (intro filterlim_cong[THEN iffD2, OF refl refl _ lim])
  1719     using eventually_ge_at_top[where c="1::real"]
  1720     by eventually_elim simp
  1721 qed
  1722 
  1723 end