src/HOL/Analysis/Change_Of_Vars.thy
author wenzelm
Mon Mar 25 17:21:26 2019 +0100 (4 weeks ago)
changeset 69981 3dced198b9ec
parent 69922 4a9167f377b0
child 70136 f03a01a18c6e
permissions -rw-r--r--
more strict AFP properties;
     1 (*  Title:      HOL/Analysis/Change_Of_Vars.thy
     2     Authors:    LC Paulson, based on material from HOL Light
     3 *)
     4 
     5 section\<open>Change of Variables Theorems\<close>
     6 
     7 theory Change_Of_Vars
     8   imports Vitali_Covering_Theorem Determinants
     9 
    10 begin
    11 
    12 subsection \<open>Orthogonal Transformation of Balls\<close>
    13 
    14 lemma image_orthogonal_transformation_ball:
    15   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
    16   assumes "orthogonal_transformation f"
    17   shows "f ` ball x r = ball (f x) r"
    18 proof (intro equalityI subsetI)
    19   fix y assume "y \<in> f ` ball x r"
    20   with assms show "y \<in> ball (f x) r"
    21     by (auto simp: orthogonal_transformation_isometry)
    22 next
    23   fix y assume y: "y \<in> ball (f x) r"
    24   then obtain z where z: "y = f z"
    25     using assms orthogonal_transformation_surj by blast
    26   with y assms show "y \<in> f ` ball x r"
    27     by (auto simp: orthogonal_transformation_isometry)
    28 qed
    29 
    30 lemma  image_orthogonal_transformation_cball:
    31   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
    32   assumes "orthogonal_transformation f"
    33   shows "f ` cball x r = cball (f x) r"
    34 proof (intro equalityI subsetI)
    35   fix y assume "y \<in> f ` cball x r"
    36   with assms show "y \<in> cball (f x) r"
    37     by (auto simp: orthogonal_transformation_isometry)
    38 next
    39   fix y assume y: "y \<in> cball (f x) r"
    40   then obtain z where z: "y = f z"
    41     using assms orthogonal_transformation_surj by blast
    42   with y assms show "y \<in> f ` cball x r"
    43     by (auto simp: orthogonal_transformation_isometry)
    44 qed
    45 
    46 
    47 subsection \<open>Measurable Shear and Stretch\<close>
    48 
    49 proposition
    50   fixes a :: "real^'n"
    51   assumes "m \<noteq> n" and ab_ne: "cbox a b \<noteq> {}" and an: "0 \<le> a$n"
    52   shows measurable_shear_interval: "(\<lambda>x. \<chi> i. if i = m then x$m + x$n else x$i) ` (cbox a b) \<in> lmeasurable"
    53        (is  "?f ` _ \<in> _")
    54    and measure_shear_interval: "measure lebesgue ((\<lambda>x. \<chi> i. if i = m then x$m + x$n else x$i) ` cbox a b)
    55                = measure lebesgue (cbox a b)" (is "?Q")
    56 proof -
    57   have lin: "linear ?f"
    58     by (rule linearI) (auto simp: plus_vec_def scaleR_vec_def algebra_simps)
    59   show fab: "?f ` cbox a b \<in> lmeasurable"
    60     by (simp add: lin measurable_linear_image_interval)
    61   let ?c = "\<chi> i. if i = m then b$m + b$n else b$i"
    62   let ?mn = "axis m 1 - axis n (1::real)"
    63   have eq1: "measure lebesgue (cbox a ?c)
    64             = measure lebesgue (?f ` cbox a b)
    65             + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m})
    66             + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})"
    67   proof (rule measure_Un3_negligible)
    68     show "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m} \<in> lmeasurable" "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} \<in> lmeasurable"
    69       by (auto simp: convex_Int convex_halfspace_le convex_halfspace_ge bounded_Int measurable_convex)
    70     have "negligible {x. ?mn \<bullet> x = a$m}"
    71       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
    72     moreover have "?f ` cbox a b \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}) \<subseteq> {x. ?mn \<bullet> x = a$m}"
    73       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
    74     ultimately show "negligible ((?f ` cbox a b) \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}))"
    75       by (rule negligible_subset)
    76     have "negligible {x. ?mn \<bullet> x = b$m}"
    77       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
    78     moreover have "(?f ` cbox a b) \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}) \<subseteq> {x. ?mn \<bullet> x = b$m}"
    79       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
    80     ultimately show "negligible (?f ` cbox a b \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}))"
    81       by (rule negligible_subset)
    82     have "negligible {x. ?mn \<bullet> x = b$m}"
    83       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
    84     moreover have "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})) \<subseteq> {x. ?mn \<bullet> x = b$m}"
    85       using \<open>m \<noteq> n\<close> ab_ne
    86       apply (auto simp: algebra_simps mem_box_cart inner_axis')
    87       apply (drule_tac x=m in spec)+
    88       apply simp
    89       done
    90     ultimately show "negligible (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}))"
    91       by (rule negligible_subset)
    92     show "?f ` cbox a b \<union> cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<union> cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} = cbox a ?c" (is "?lhs = _")
    93     proof
    94       show "?lhs \<subseteq> cbox a ?c"
    95         by (auto simp: mem_box_cart add_mono) (meson add_increasing2 an order_trans)
    96       show "cbox a ?c \<subseteq> ?lhs"
    97         apply (auto simp: algebra_simps image_iff inner_axis' lambda_add_Galois [OF \<open>m \<noteq> n\<close>])
    98         apply (auto simp: mem_box_cart split: if_split_asm)
    99         done
   100     qed
   101   qed (fact fab)
   102   let ?d = "\<chi> i. if i = m then a $ m - b $ m else 0"
   103   have eq2: "measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}) + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})
   104            = measure lebesgue (cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i))"
   105   proof (rule measure_translate_add[of "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m}" "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}"
   106      "(\<chi> i. if i = m then a$m - b$m else 0)" "cbox a (\<chi> i. if i = m then a$m + b$n else b$i)"])
   107     show "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m}) \<in> lmeasurable"
   108       "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} \<in> lmeasurable"
   109       by (auto simp: convex_Int convex_halfspace_le convex_halfspace_ge bounded_Int measurable_convex)
   110     have "\<And>x. \<lbrakk>x $ n + a $ m \<le> x $ m\<rbrakk>
   111          \<Longrightarrow> x \<in> (+) (\<chi> i. if i = m then a $ m - b $ m else 0) ` {x. x $ n + b $ m \<le> x $ m}"
   112       using \<open>m \<noteq> n\<close>
   113       by (rule_tac x="x - (\<chi> i. if i = m then a$m - b$m else 0)" in image_eqI)
   114          (simp_all add: mem_box_cart)
   115     then have imeq: "(+) ?d ` {x. b $ m \<le> ?mn \<bullet> x} = {x. a $ m \<le> ?mn \<bullet> x}"
   116       using \<open>m \<noteq> n\<close> by (auto simp: mem_box_cart inner_axis' algebra_simps)
   117     have "\<And>x. \<lbrakk>0 \<le> a $ n; x $ n + a $ m \<le> x $ m;
   118                 \<forall>i. i \<noteq> m \<longrightarrow> a $ i \<le> x $ i \<and> x $ i \<le> b $ i\<rbrakk>
   119          \<Longrightarrow> a $ m \<le> x $ m"
   120       using \<open>m \<noteq> n\<close>  by force
   121     then have "(+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x})
   122             = cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i) \<inter> {x. a $ m \<le> ?mn \<bullet> x}"
   123       using an ab_ne
   124       apply (simp add: cbox_translation [symmetric] translation_Int interval_ne_empty_cart imeq)
   125       apply (auto simp: mem_box_cart inner_axis' algebra_simps if_distrib all_if_distrib)
   126       by (metis (full_types) add_mono mult_2_right)
   127     then show "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<union>
   128           (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x}) =
   129           cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i)"  (is "?lhs = ?rhs")
   130       using an \<open>m \<noteq> n\<close>
   131       apply (auto simp: mem_box_cart inner_axis' algebra_simps if_distrib all_if_distrib, force)
   132         apply (drule_tac x=n in spec)+
   133       by (meson ab_ne add_mono_thms_linordered_semiring(3) dual_order.trans interval_ne_empty_cart(1))
   134     have "negligible{x. ?mn \<bullet> x = a$m}"
   135       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
   136     moreover have "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter>
   137                                  (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x})) \<subseteq> {x. ?mn \<bullet> x = a$m}"
   138       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
   139     ultimately show "negligible (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter>
   140                                  (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x}))"
   141       by (rule negligible_subset)
   142   qed
   143   have ac_ne: "cbox a ?c \<noteq> {}"
   144     using ab_ne an
   145     by (clarsimp simp: interval_eq_empty_cart) (meson add_less_same_cancel1 le_less_linear less_le_trans)
   146   have ax_ne: "cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i) \<noteq> {}"
   147     using ab_ne an
   148     by (clarsimp simp: interval_eq_empty_cart) (meson add_less_same_cancel1 le_less_linear less_le_trans)
   149   have eq3: "measure lebesgue (cbox a ?c) = measure lebesgue (cbox a (\<chi> i. if i = m then a$m + b$n else b$i)) + measure lebesgue (cbox a b)"
   150     by (simp add: content_cbox_if_cart ab_ne ac_ne ax_ne algebra_simps prod.delta_remove
   151              if_distrib [of "\<lambda>u. u - z" for z] prod.remove)
   152   show ?Q
   153     using eq1 eq2 eq3
   154     by (simp add: algebra_simps)
   155 qed
   156 
   157 
   158 proposition
   159   fixes S :: "(real^'n) set"
   160   assumes "S \<in> lmeasurable"
   161   shows measurable_stretch: "((\<lambda>x. \<chi> k. m k * x$k) ` S) \<in> lmeasurable" (is  "?f ` S \<in> _")
   162     and measure_stretch: "measure lebesgue ((\<lambda>x. \<chi> k. m k * x$k) ` S) = \<bar>prod m UNIV\<bar> * measure lebesgue S"
   163     (is "?MEQ")
   164 proof -
   165   have "(?f ` S) \<in> lmeasurable \<and> ?MEQ"
   166   proof (cases "\<forall>k. m k \<noteq> 0")
   167     case True
   168     have m0: "0 < \<bar>prod m UNIV\<bar>"
   169       using True by simp
   170     have "(indicat_real (?f ` S) has_integral \<bar>prod m UNIV\<bar> * measure lebesgue S) UNIV"
   171     proof (clarsimp simp add: has_integral_alt [where i=UNIV])
   172       fix e :: "real"
   173       assume "e > 0"
   174       have "(indicat_real S has_integral (measure lebesgue S)) UNIV"
   175         using assms lmeasurable_iff_has_integral by blast
   176       then obtain B where "B>0"
   177         and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow>
   178                         \<exists>z. (indicat_real S has_integral z) (cbox a b) \<and>
   179                             \<bar>z - measure lebesgue S\<bar> < e / \<bar>prod m UNIV\<bar>"
   180         by (simp add: has_integral_alt [where i=UNIV]) (metis (full_types) divide_pos_pos m0  m0 \<open>e > 0\<close>)
   181       show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
   182                   (\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox a b) \<and>
   183                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e)"
   184       proof (intro exI conjI allI)
   185         let ?C = "Max (range (\<lambda>k. \<bar>m k\<bar>)) * B"
   186         show "?C > 0"
   187           using True \<open>B > 0\<close> by (simp add: Max_gr_iff)
   188         show "ball 0 ?C \<subseteq> cbox u v \<longrightarrow>
   189                   (\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox u v) \<and>
   190                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e)" for u v
   191         proof
   192           assume uv: "ball 0 ?C \<subseteq> cbox u v"
   193           with \<open>?C > 0\<close> have cbox_ne: "cbox u v \<noteq> {}"
   194             using centre_in_ball by blast
   195           let ?\<alpha> = "\<lambda>k. u$k / m k"
   196           let ?\<beta> = "\<lambda>k. v$k / m k"
   197           have invm0: "\<And>k. inverse (m k) \<noteq> 0"
   198             using True by auto
   199           have "ball 0 B \<subseteq> (\<lambda>x. \<chi> k. x $ k / m k) ` ball 0 ?C"
   200           proof clarsimp
   201             fix x :: "real^'n"
   202             assume x: "norm x < B"
   203             have [simp]: "\<bar>Max (range (\<lambda>k. \<bar>m k\<bar>))\<bar> = Max (range (\<lambda>k. \<bar>m k\<bar>))"
   204               by (meson Max_ge abs_ge_zero abs_of_nonneg finite finite_imageI order_trans rangeI)
   205             have "norm (\<chi> k. m k * x $ k) \<le> norm (Max (range (\<lambda>k. \<bar>m k\<bar>)) *\<^sub>R x)"
   206               by (rule norm_le_componentwise_cart) (auto simp: abs_mult intro: mult_right_mono)
   207             also have "\<dots> < ?C"
   208               using x by simp (metis \<open>B > 0\<close> \<open>?C > 0\<close> mult.commute real_mult_less_iff1 zero_less_mult_pos)
   209             finally have "norm (\<chi> k. m k * x $ k) < ?C" .
   210             then show "x \<in> (\<lambda>x. \<chi> k. x $ k / m k) ` ball 0 ?C"
   211               using stretch_Galois [of "inverse \<circ> m"] True by (auto simp: image_iff field_simps)
   212           qed
   213           then have Bsub: "ball 0 B \<subseteq> cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k))"
   214             using cbox_ne uv image_stretch_interval_cart [of "inverse \<circ> m" u v, symmetric]
   215             by (force simp: field_simps)
   216           obtain z where zint: "(indicat_real S has_integral z) (cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k)))"
   217                    and zless: "\<bar>z - measure lebesgue S\<bar> < e / \<bar>prod m UNIV\<bar>"
   218             using B [OF Bsub] by blast
   219           have ind: "indicat_real (?f ` S) = (\<lambda>x. indicator S (\<chi> k. x$k / m k))"
   220             using True stretch_Galois [of m] by (force simp: indicator_def)
   221           show "\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox u v) \<and>
   222                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e"
   223           proof (simp add: ind, intro conjI exI)
   224             have "((\<lambda>x. indicat_real S (\<chi> k. x $ k/ m k)) has_integral z *\<^sub>R \<bar>prod m UNIV\<bar>)
   225                 ((\<lambda>x. \<chi> k. x $ k * m k) ` cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k)))"
   226               using True has_integral_stretch_cart [OF zint, of "inverse \<circ> m"]
   227               by (simp add: field_simps prod_dividef)
   228             moreover have "((\<lambda>x. \<chi> k. x $ k * m k) ` cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k))) = cbox u v"
   229               using True image_stretch_interval_cart [of "inverse \<circ> m" u v, symmetric]
   230                 image_stretch_interval_cart [of "\<lambda>k. 1" u v, symmetric] \<open>cbox u v \<noteq> {}\<close>
   231               by (simp add: field_simps image_comp o_def)
   232             ultimately show "((\<lambda>x. indicat_real S (\<chi> k. x $ k/ m k)) has_integral z *\<^sub>R \<bar>prod m UNIV\<bar>) (cbox u v)"
   233               by simp
   234             have "\<bar>z *\<^sub>R \<bar>prod m UNIV\<bar> - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar>
   235                  = \<bar>prod m UNIV\<bar> * \<bar>z - measure lebesgue S\<bar>"
   236               by (metis (no_types, hide_lams) abs_abs abs_scaleR mult.commute real_scaleR_def right_diff_distrib')
   237             also have "\<dots> < e"
   238               using zless True by (simp add: field_simps)
   239             finally show "\<bar>z *\<^sub>R \<bar>prod m UNIV\<bar> - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e" .
   240           qed
   241         qed
   242       qed
   243     qed
   244     then show ?thesis
   245       by (auto simp: has_integral_integrable integral_unique lmeasure_integral_UNIV measurable_integrable)
   246   next
   247     case False
   248     then obtain k where "m k = 0" and prm: "prod m UNIV = 0"
   249       by auto
   250     have nfS: "negligible (?f ` S)"
   251       by (rule negligible_subset [OF negligible_standard_hyperplane_cart]) (use \<open>m k = 0\<close> in auto)
   252     then have "(?f ` S) \<in> lmeasurable"
   253       by (simp add: negligible_iff_measure)
   254     with nfS show ?thesis
   255       by (simp add: prm negligible_iff_measure0)
   256   qed
   257   then show "(?f ` S) \<in> lmeasurable" ?MEQ
   258     by metis+
   259 qed
   260 
   261 
   262 proposition
   263  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   264   assumes "linear f" "S \<in> lmeasurable"
   265   shows measurable_linear_image: "(f ` S) \<in> lmeasurable"
   266     and measure_linear_image: "measure lebesgue (f ` S) = \<bar>det (matrix f)\<bar> * measure lebesgue S" (is "?Q f S")
   267 proof -
   268   have "\<forall>S \<in> lmeasurable. (f ` S) \<in> lmeasurable \<and> ?Q f S"
   269   proof (rule induct_linear_elementary [OF \<open>linear f\<close>]; intro ballI)
   270     fix f g and S :: "(real,'n) vec set"
   271     assume "linear f" and "linear g"
   272       and f [rule_format]: "\<forall>S \<in> lmeasurable. f ` S \<in> lmeasurable \<and> ?Q f S"
   273       and g [rule_format]: "\<forall>S \<in> lmeasurable. g ` S \<in> lmeasurable \<and> ?Q g S"
   274       and S: "S \<in> lmeasurable"
   275     then have gS: "g ` S \<in> lmeasurable"
   276       by blast
   277     show "(f \<circ> g) ` S \<in> lmeasurable \<and> ?Q (f \<circ> g) S"
   278       using f [OF gS] g [OF S] matrix_compose [OF \<open>linear g\<close> \<open>linear f\<close>]
   279       by (simp add: o_def image_comp abs_mult det_mul)
   280   next
   281     fix f :: "real^'n::_ \<Rightarrow> real^'n::_" and i and S :: "(real^'n::_) set"
   282     assume "linear f" and 0: "\<And>x. f x $ i = 0" and "S \<in> lmeasurable"
   283     then have "\<not> inj f"
   284       by (metis (full_types) linear_injective_imp_surjective one_neq_zero surjE vec_component)
   285     have detf: "det (matrix f) = 0"
   286       using \<open>\<not> inj f\<close> det_nz_iff_inj[OF \<open>linear f\<close>] by blast
   287     show "f ` S \<in> lmeasurable \<and> ?Q f S"
   288     proof
   289       show "f ` S \<in> lmeasurable"
   290         using lmeasurable_iff_indicator_has_integral \<open>linear f\<close> \<open>\<not> inj f\<close> negligible_UNIV negligible_linear_singular_image by blast
   291       have "measure lebesgue (f ` S) = 0"
   292         by (meson \<open>\<not> inj f\<close> \<open>linear f\<close> negligible_imp_measure0 negligible_linear_singular_image)
   293       also have "\<dots> = \<bar>det (matrix f)\<bar> * measure lebesgue S"
   294         by (simp add: detf)
   295       finally show "?Q f S" .
   296     qed
   297   next
   298     fix c and S :: "(real^'n::_) set"
   299     assume "S \<in> lmeasurable"
   300     show "(\<lambda>a. \<chi> i. c i * a $ i) ` S \<in> lmeasurable \<and> ?Q (\<lambda>a. \<chi> i. c i * a $ i) S"
   301     proof
   302       show "(\<lambda>a. \<chi> i. c i * a $ i) ` S \<in> lmeasurable"
   303         by (simp add: \<open>S \<in> lmeasurable\<close> measurable_stretch)
   304       show "?Q (\<lambda>a. \<chi> i. c i * a $ i) S"
   305         by (simp add: measure_stretch [OF \<open>S \<in> lmeasurable\<close>, of c] axis_def matrix_def det_diagonal)
   306     qed
   307   next
   308     fix m :: "'n" and n :: "'n" and S :: "(real, 'n) vec set"
   309     assume "m \<noteq> n" and "S \<in> lmeasurable"
   310     let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i"
   311     have lin: "linear ?h"
   312       by (rule linearI) (simp_all add: plus_vec_def scaleR_vec_def)
   313     have meq: "measure lebesgue ((\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i) ` cbox a b)
   314              = measure lebesgue (cbox a b)" for a b
   315     proof (cases "cbox a b = {}")
   316       case True then show ?thesis
   317         by simp
   318     next
   319       case False
   320       then have him: "?h ` (cbox a b) \<noteq> {}"
   321         by blast
   322       have eq: "?h ` (cbox a b) = cbox (?h a) (?h b)"
   323         by (auto simp: image_iff lambda_swap_Galois mem_box_cart) (metis swap_id_eq)+
   324       show ?thesis
   325         using him prod.permute [OF permutes_swap_id, where S=UNIV and g="\<lambda>i. (b - a)$i", symmetric]
   326         by (simp add: eq content_cbox_cart False)
   327     qed
   328     have "(\<chi> i j. if Fun.swap m n id i = j then 1 else 0) = (\<chi> i j. if j = Fun.swap m n id i then 1 else (0::real))"
   329       by (auto intro!: Cart_lambda_cong)
   330     then have "matrix ?h = transpose(\<chi> i j. mat 1 $ i $ Fun.swap m n id j)"
   331       by (auto simp: matrix_eq transpose_def axis_def mat_def matrix_def)
   332     then have 1: "\<bar>det (matrix ?h)\<bar> = 1"
   333       by (simp add: det_permute_columns permutes_swap_id sign_swap_id abs_mult)
   334     show "?h ` S \<in> lmeasurable \<and> ?Q ?h S"
   335     proof
   336       show "?h ` S \<in> lmeasurable" "?Q ?h S"
   337         using measure_linear_sufficient [OF lin \<open>S \<in> lmeasurable\<close>] meq 1 by force+
   338     qed
   339   next
   340     fix m n :: "'n" and S :: "(real, 'n) vec set"
   341     assume "m \<noteq> n" and "S \<in> lmeasurable"
   342     let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. if i = m then v $ m + v $ n else v $ i"
   343     have lin: "linear ?h"
   344       by (rule linearI) (auto simp: algebra_simps plus_vec_def scaleR_vec_def vec_eq_iff)
   345     consider "m < n" | " n < m"
   346       using \<open>m \<noteq> n\<close> less_linear by blast
   347     then have 1: "det(matrix ?h) = 1"
   348     proof cases
   349       assume "m < n"
   350       have *: "matrix ?h $ i $ j = (0::real)" if "j < i" for i j :: 'n
   351       proof -
   352         have "axis j 1 = (\<chi> n. if n = j then 1 else (0::real))"
   353           using axis_def by blast
   354         then have "(\<chi> p q. if p = m then axis q 1 $ m + axis q 1 $ n else axis q 1 $ p) $ i $ j = (0::real)"
   355           using \<open>j < i\<close> axis_def \<open>m < n\<close> by auto
   356         with \<open>m < n\<close> show ?thesis
   357           by (auto simp: matrix_def axis_def cong: if_cong)
   358       qed
   359       show ?thesis
   360         using \<open>m \<noteq> n\<close> by (subst det_upperdiagonal [OF *]) (auto simp: matrix_def axis_def cong: if_cong)
   361     next
   362       assume "n < m"
   363       have *: "matrix ?h $ i $ j = (0::real)" if "j > i" for i j :: 'n
   364       proof -
   365         have "axis j 1 = (\<chi> n. if n = j then 1 else (0::real))"
   366           using axis_def by blast
   367         then have "(\<chi> p q. if p = m then axis q 1 $ m + axis q 1 $ n else axis q 1 $ p) $ i $ j = (0::real)"
   368           using \<open>j > i\<close> axis_def \<open>m > n\<close> by auto
   369         with \<open>m > n\<close> show ?thesis
   370           by (auto simp: matrix_def axis_def cong: if_cong)
   371       qed
   372       show ?thesis
   373         using \<open>m \<noteq> n\<close>
   374         by (subst det_lowerdiagonal [OF *]) (auto simp: matrix_def axis_def cong: if_cong)
   375     qed
   376     have meq: "measure lebesgue (?h ` (cbox a b)) = measure lebesgue (cbox a b)" for a b
   377     proof (cases "cbox a b = {}")
   378       case True then show ?thesis by simp
   379     next
   380       case False
   381       then have ne: "(+) (\<chi> i. if i = n then - a $ n else 0) ` cbox a b \<noteq> {}"
   382         by auto
   383       let ?v = "\<chi> i. if i = n then - a $ n else 0"
   384       have "?h ` cbox a b
   385             = (+) (\<chi> i. if i = m \<or> i = n then a $ n else 0) ` ?h ` (+) ?v ` (cbox a b)"
   386         using \<open>m \<noteq> n\<close> unfolding image_comp o_def by (force simp: vec_eq_iff)
   387       then have "measure lebesgue (?h ` (cbox a b))
   388                = measure lebesgue ((\<lambda>v. \<chi> i. if i = m then v $ m + v $ n else v $ i) `
   389                                    (+) ?v ` cbox a b)"
   390         by (rule ssubst) (rule measure_translation)
   391       also have "\<dots> = measure lebesgue ((\<lambda>v. \<chi> i. if i = m then v $ m + v $ n else v $ i) ` cbox (?v +a) (?v + b))"
   392         by (metis (no_types, lifting) cbox_translation)
   393       also have "\<dots> = measure lebesgue ((+) (\<chi> i. if i = n then - a $ n else 0) ` cbox a b)"
   394         apply (subst measure_shear_interval)
   395         using \<open>m \<noteq> n\<close> ne apply auto
   396         apply (simp add: cbox_translation)
   397         by (metis cbox_borel cbox_translation measure_completion sets_lborel)
   398       also have "\<dots> = measure lebesgue (cbox a b)"
   399         by (rule measure_translation)
   400         finally show ?thesis .
   401       qed
   402     show "?h ` S \<in> lmeasurable \<and> ?Q ?h S"
   403       using measure_linear_sufficient [OF lin \<open>S \<in> lmeasurable\<close>] meq 1 by force
   404   qed
   405   with assms show "(f ` S) \<in> lmeasurable" "?Q f S"
   406     by metis+
   407 qed
   408 
   409 
   410 lemma
   411  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   412   assumes f: "orthogonal_transformation f" and S: "S \<in> lmeasurable"
   413   shows measurable_orthogonal_image: "f ` S \<in> lmeasurable"
   414     and measure_orthogonal_image: "measure lebesgue (f ` S) = measure lebesgue S"
   415 proof -
   416   have "linear f"
   417     by (simp add: f orthogonal_transformation_linear)
   418   then show "f ` S \<in> lmeasurable"
   419     by (metis S measurable_linear_image)
   420   show "measure lebesgue (f ` S) = measure lebesgue S"
   421     by (simp add: measure_linear_image \<open>linear f\<close> S f)
   422 qed
   423 
   424 subsection\<open>\<open>F_sigma\<close> and \<open>G_delta\<close> sets.\<close>(*FIX ME mv *)
   425 
   426 (*https://en.wikipedia.org/wiki/F\<sigma>_set*)
   427 inductive%important fsigma :: "'a::topological_space set \<Rightarrow> bool" where
   428   "(\<And>n::nat. closed (F n)) \<Longrightarrow> fsigma (\<Union>(F ` UNIV))"
   429 
   430 inductive%important gdelta :: "'a::topological_space set \<Rightarrow> bool" where
   431   "(\<And>n::nat. open (F n)) \<Longrightarrow> gdelta (\<Inter>(F ` UNIV))"
   432 
   433 lemma fsigma_Union_compact:
   434   fixes S :: "'a::{real_normed_vector,heine_borel} set"
   435   shows "fsigma S \<longleftrightarrow> (\<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> Collect compact \<and> S = \<Union>(F ` UNIV))"
   436 proof safe
   437   assume "fsigma S"
   438   then obtain F :: "nat \<Rightarrow> 'a set" where F: "range F \<subseteq> Collect closed" "S = \<Union>(F ` UNIV)"
   439     by (meson fsigma.cases image_subsetI mem_Collect_eq)
   440   then have "\<exists>D::nat \<Rightarrow> 'a set. range D \<subseteq> Collect compact \<and> \<Union>(D ` UNIV) = F i" for i
   441     using closed_Union_compact_subsets [of "F i"]
   442     by (metis image_subsetI mem_Collect_eq range_subsetD)
   443   then obtain D :: "nat \<Rightarrow> nat \<Rightarrow> 'a set"
   444     where D: "\<And>i. range (D i) \<subseteq> Collect compact \<and> \<Union>((D i) ` UNIV) = F i"
   445     by metis
   446   let ?DD = "\<lambda>n. (\<lambda>(i,j). D i j) (prod_decode n)"
   447   show "\<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> Collect compact \<and> S = \<Union>(F ` UNIV)"
   448   proof (intro exI conjI)
   449     show "range ?DD \<subseteq> Collect compact"
   450       using D by clarsimp (metis mem_Collect_eq rangeI split_conv subsetCE surj_pair)
   451     show "S = \<Union> (range ?DD)"
   452     proof
   453       show "S \<subseteq> \<Union> (range ?DD)"
   454         using D F
   455         by clarsimp (metis UN_iff old.prod.case prod_decode_inverse prod_encode_eq)
   456       show "\<Union> (range ?DD) \<subseteq> S"
   457         using D F  by fastforce
   458     qed
   459   qed
   460 next
   461   fix F :: "nat \<Rightarrow> 'a set"
   462   assume "range F \<subseteq> Collect compact" and "S = \<Union>(F ` UNIV)"
   463   then show "fsigma (\<Union>(F ` UNIV))"
   464     by (simp add: compact_imp_closed fsigma.intros image_subset_iff)
   465 qed
   466 
   467 lemma gdelta_imp_fsigma: "gdelta S \<Longrightarrow> fsigma (- S)"
   468 proof (induction rule: gdelta.induct)
   469   case (1 F)
   470   have "- \<Inter>(F ` UNIV) = (\<Union>i. -(F i))"
   471     by auto
   472   then show ?case
   473     by (simp add: fsigma.intros closed_Compl 1)
   474 qed
   475 
   476 lemma fsigma_imp_gdelta: "fsigma S \<Longrightarrow> gdelta (- S)"
   477 proof (induction rule: fsigma.induct)
   478   case (1 F)
   479   have "- \<Union>(F ` UNIV) = (\<Inter>i. -(F i))"
   480     by auto
   481   then show ?case
   482     by (simp add: 1 gdelta.intros open_closed)
   483 qed
   484 
   485 lemma gdelta_complement: "gdelta(- S) \<longleftrightarrow> fsigma S"
   486   using fsigma_imp_gdelta gdelta_imp_fsigma by force
   487 
   488 text\<open>A Lebesgue set is almost an \<open>F_sigma\<close> or \<open>G_delta\<close>.\<close>
   489 lemma lebesgue_set_almost_fsigma:
   490   assumes "S \<in> sets lebesgue"
   491   obtains C T where "fsigma C" "negligible T" "C \<union> T = S" "disjnt C T"
   492 proof -
   493   { fix n::nat
   494     have "\<exists>T. closed T \<and> T \<subseteq> S \<and> S - T \<in> lmeasurable \<and> measure lebesgue (S-T) < 1 / Suc n"
   495       using sets_lebesgue_inner_closed [OF assms]
   496       by (metis divide_pos_pos less_numeral_extra(1) of_nat_0_less_iff zero_less_Suc)
   497   }
   498   then obtain F where F: "\<And>n::nat. closed (F n) \<and> F n \<subseteq> S \<and> S - F n \<in> lmeasurable \<and> measure lebesgue (S - F n) < 1 / Suc n"
   499     by metis
   500   let ?C = "\<Union>(F ` UNIV)"
   501   show thesis
   502   proof
   503     show "fsigma ?C"
   504       using F by (simp add: fsigma.intros)
   505     show "negligible (S - ?C)"
   506     proof (clarsimp simp add: negligible_outer_le)
   507       fix e :: "real"
   508       assume "0 < e"
   509       then obtain n where n: "1 / Suc n < e"
   510         using nat_approx_posE by metis
   511       show "\<exists>T. S - (\<Union>x. F x) \<subseteq> T \<and> T \<in> lmeasurable \<and> measure lebesgue T \<le> e"
   512       proof (intro exI conjI)
   513         show "measure lebesgue (S - F n) \<le> e"
   514           by (meson F n less_trans not_le order.asym)
   515       qed (use F in auto)
   516     qed
   517     show "?C \<union> (S - ?C) = S"
   518       using F by blast
   519     show "disjnt ?C (S - ?C)"
   520       by (auto simp: disjnt_def)
   521   qed
   522 qed
   523 
   524 lemma lebesgue_set_almost_gdelta:
   525   assumes "S \<in> sets lebesgue"
   526   obtains C T where "gdelta C" "negligible T" "S \<union> T = C" "disjnt S T"
   527 proof -
   528   have "-S \<in> sets lebesgue"
   529     using assms Compl_in_sets_lebesgue by blast
   530   then obtain C T where C: "fsigma C" "negligible T" "C \<union> T = -S" "disjnt C T"
   531     using lebesgue_set_almost_fsigma by metis
   532   show thesis
   533   proof
   534     show "gdelta (-C)"
   535       by (simp add: \<open>fsigma C\<close> fsigma_imp_gdelta)
   536     show "S \<union> T = -C" "disjnt S T"
   537       using C by (auto simp: disjnt_def)
   538   qed (use C in auto)
   539 qed
   540 
   541 
   542 proposition measure_semicontinuous_with_hausdist_explicit:
   543   assumes "bounded S" and neg: "negligible(frontier S)" and "e > 0"
   544   obtains d where "d > 0"
   545                   "\<And>T. \<lbrakk>T \<in> lmeasurable; \<And>y. y \<in> T \<Longrightarrow> \<exists>x. x \<in> S \<and> dist x y < d\<rbrakk>
   546                         \<Longrightarrow> measure lebesgue T < measure lebesgue S + e"
   547 proof (cases "S = {}")
   548   case True
   549   with that \<open>e > 0\<close> show ?thesis by force
   550 next
   551   case False
   552   then have frS: "frontier S \<noteq> {}"
   553     using \<open>bounded S\<close> frontier_eq_empty not_bounded_UNIV by blast
   554   have "S \<in> lmeasurable"
   555     by (simp add: \<open>bounded S\<close> measurable_Jordan neg)
   556   have null: "(frontier S) \<in> null_sets lebesgue"
   557     by (metis neg negligible_iff_null_sets)
   558   have "frontier S \<in> lmeasurable" and mS0: "measure lebesgue (frontier S) = 0"
   559     using neg negligible_imp_measurable negligible_iff_measure by blast+
   560   with \<open>e > 0\<close> lmeasurable_outer_open
   561   obtain U where "open U"
   562     and U: "frontier S \<subseteq> U" "U - frontier S \<in> lmeasurable" "measure lebesgue (U - frontier S) < e"
   563     by (metis fmeasurableD)
   564   with null have "U \<in> lmeasurable"
   565     by (metis borel_open measurable_Diff_null_set sets_completionI_sets sets_lborel)
   566   have "measure lebesgue (U - frontier S) = measure lebesgue U"
   567     using mS0 by (simp add: \<open>U \<in> lmeasurable\<close> fmeasurableD measure_Diff_null_set null)
   568   with U have mU: "measure lebesgue U < e"
   569     by simp
   570   show ?thesis
   571   proof
   572     have "U \<noteq> UNIV"
   573       using \<open>U \<in> lmeasurable\<close> by auto
   574     then have "- U \<noteq> {}"
   575       by blast
   576     with \<open>open U\<close> \<open>frontier S \<subseteq> U\<close> show "setdist (frontier S) (- U) > 0"
   577       by (auto simp: \<open>bounded S\<close> open_closed compact_frontier_bounded setdist_gt_0_compact_closed frS)
   578     fix T
   579     assume "T \<in> lmeasurable"
   580       and T: "\<And>t. t \<in> T \<Longrightarrow> \<exists>y. y \<in> S \<and> dist y t < setdist (frontier S) (- U)"
   581     then have "measure lebesgue T - measure lebesgue S \<le> measure lebesgue (T - S)"
   582       by (simp add: \<open>S \<in> lmeasurable\<close> measure_diff_le_measure_setdiff)
   583     also have "\<dots>  \<le> measure lebesgue U"
   584     proof -
   585       have "T - S \<subseteq> U"
   586       proof clarify
   587         fix x
   588         assume "x \<in> T" and "x \<notin> S"
   589         then obtain y where "y \<in> S" and y: "dist y x < setdist (frontier S) (- U)"
   590           using T by blast
   591         have "closed_segment x y \<inter> frontier S \<noteq> {}"
   592           using connected_Int_frontier \<open>x \<notin> S\<close> \<open>y \<in> S\<close> by blast
   593         then obtain z where z: "z \<in> closed_segment x y" "z \<in> frontier S"
   594           by auto
   595         with y have "dist z x < setdist(frontier S) (- U)"
   596           by (auto simp: dist_commute dest!: dist_in_closed_segment)
   597         with z have False if "x \<in> -U"
   598           using setdist_le_dist [OF \<open>z \<in> frontier S\<close> that] by auto
   599         then show "x \<in> U"
   600           by blast
   601       qed
   602       then show ?thesis
   603         by (simp add: \<open>S \<in> lmeasurable\<close> \<open>T \<in> lmeasurable\<close> \<open>U \<in> lmeasurable\<close> fmeasurableD measure_mono_fmeasurable sets.Diff)
   604     qed
   605     finally have "measure lebesgue T - measure lebesgue S \<le> measure lebesgue U" .
   606     with mU show "measure lebesgue T < measure lebesgue S + e"
   607       by linarith
   608   qed
   609 qed
   610 
   611 proposition lebesgue_regular_inner:
   612  assumes "S \<in> sets lebesgue"
   613  obtains K C where "negligible K" "\<And>n::nat. compact(C n)" "S = (\<Union>n. C n) \<union> K"
   614 proof -
   615   have "\<exists>T. closed T \<and> T \<subseteq> S \<and> (S - T) \<in> lmeasurable \<and> measure lebesgue (S - T) < (1/2)^n" for n
   616     using sets_lebesgue_inner_closed assms
   617     by (metis sets_lebesgue_inner_closed zero_less_divide_1_iff zero_less_numeral zero_less_power)
   618   then obtain C where clo: "\<And>n. closed (C n)" and subS: "\<And>n. C n \<subseteq> S"
   619     and mea: "\<And>n. (S - C n) \<in> lmeasurable"
   620     and less: "\<And>n. measure lebesgue (S - C n) < (1/2)^n"
   621     by metis
   622   have "\<exists>F. (\<forall>n::nat. compact(F n)) \<and> (\<Union>n. F n) = C m" for m::nat
   623     by (metis clo closed_Union_compact_subsets)
   624   then obtain D :: "[nat,nat] \<Rightarrow> 'a set" where D: "\<And>m n. compact(D m n)" "\<And>m. (\<Union>n. D m n) = C m"
   625     by metis
   626   let ?C = "from_nat_into (\<Union>m. range (D m))"
   627   have "countable (\<Union>m. range (D m))"
   628     by blast
   629   have "range (from_nat_into (\<Union>m. range (D m))) = (\<Union>m. range (D m))"
   630     using range_from_nat_into by simp
   631   then have CD: "\<exists>m n. ?C k = D m n"  for k
   632     by (metis (mono_tags, lifting) UN_iff rangeE range_eqI)
   633   show thesis
   634   proof
   635     show "negligible (S - (\<Union>n. C n))"
   636     proof (clarsimp simp: negligible_outer_le)
   637       fix e :: "real"
   638       assume "e > 0"
   639       then obtain n where n: "(1/2)^n < e"
   640         using real_arch_pow_inv [of e "1/2"] by auto
   641       show "\<exists>T. S - (\<Union>n. C n) \<subseteq> T \<and> T \<in> lmeasurable \<and> measure lebesgue T \<le> e"
   642       proof (intro exI conjI)
   643         show "S - (\<Union>n. C n) \<subseteq> S - C n"
   644           by blast
   645         show "S - C n \<in> lmeasurable"
   646           by (simp add: mea)
   647         show "measure lebesgue (S - C n) \<le> e"
   648           using less [of n] n by simp
   649       qed
   650     qed
   651     show "compact (?C n)" for n
   652       using CD D by metis
   653     show "S = (\<Union>n. ?C n) \<union> (S - (\<Union>n. C n))" (is "_ = ?rhs")
   654     proof
   655       show "S \<subseteq> ?rhs"
   656         using D by fastforce
   657       show "?rhs \<subseteq> S"
   658         using subS D CD by auto (metis Sup_upper range_eqI subsetCE)
   659     qed
   660   qed
   661 qed
   662 
   663 
   664 lemma sets_lebesgue_continuous_image:
   665   assumes T: "T \<in> sets lebesgue" and contf: "continuous_on S f"
   666     and negim: "\<And>T. \<lbrakk>negligible T; T \<subseteq> S\<rbrakk> \<Longrightarrow> negligible(f ` T)" and "T \<subseteq> S"
   667  shows "f ` T \<in> sets lebesgue"
   668 proof -
   669   obtain K C where "negligible K" and com: "\<And>n::nat. compact(C n)" and Teq: "T = (\<Union>n. C n) \<union> K"
   670     using lebesgue_regular_inner [OF T] by metis
   671   then have comf: "\<And>n::nat. compact(f ` C n)"
   672     by (metis Un_subset_iff Union_upper \<open>T \<subseteq> S\<close> compact_continuous_image contf continuous_on_subset rangeI)
   673   have "((\<Union>n. f ` C n) \<union> f ` K) \<in> sets lebesgue"
   674   proof (rule sets.Un)
   675     have "K \<subseteq> S"
   676       using Teq \<open>T \<subseteq> S\<close> by blast
   677     show "(\<Union>n. f ` C n) \<in> sets lebesgue"
   678     proof (rule sets.countable_Union)
   679       show "range (\<lambda>n. f ` C n) \<subseteq> sets lebesgue"
   680         using borel_compact comf by (auto simp: borel_compact)
   681     qed auto
   682     show "f ` K \<in> sets lebesgue"
   683       by (simp add: \<open>K \<subseteq> S\<close> \<open>negligible K\<close> negim negligible_imp_sets)
   684   qed
   685   then show ?thesis
   686     by (simp add: Teq image_Un image_Union)
   687 qed
   688 
   689 lemma differentiable_image_in_sets_lebesgue:
   690   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   691   assumes S: "S \<in> sets lebesgue" and dim: "DIM('m) \<le> DIM('n)" and f: "f differentiable_on S"
   692   shows "f`S \<in> sets lebesgue"
   693 proof (rule sets_lebesgue_continuous_image [OF S])
   694   show "continuous_on S f"
   695     by (meson differentiable_imp_continuous_on f)
   696   show "\<And>T. \<lbrakk>negligible T; T \<subseteq> S\<rbrakk> \<Longrightarrow> negligible (f ` T)"
   697     using differentiable_on_subset f
   698     by (auto simp: intro!: negligible_differentiable_image_negligible [OF dim])
   699 qed auto
   700 
   701 lemma sets_lebesgue_on_continuous_image:
   702   assumes S: "S \<in> sets lebesgue" and X: "X \<in> sets (lebesgue_on S)" and contf: "continuous_on S f"
   703     and negim: "\<And>T. \<lbrakk>negligible T; T \<subseteq> S\<rbrakk> \<Longrightarrow> negligible(f ` T)"
   704   shows "f ` X \<in> sets (lebesgue_on (f ` S))"
   705 proof -
   706   have "X \<subseteq> S"
   707     by (metis S X sets.Int_space_eq2 sets_restrict_space_iff)
   708   moreover have "f ` S \<in> sets lebesgue"
   709     using S contf negim sets_lebesgue_continuous_image by blast
   710   moreover have "f ` X \<in> sets lebesgue"
   711     by (metis S X contf negim sets_lebesgue_continuous_image sets_restrict_space_iff space_restrict_space space_restrict_space2)
   712   ultimately show ?thesis
   713     by (auto simp: sets_restrict_space_iff)
   714 qed
   715 
   716 lemma differentiable_image_in_sets_lebesgue_on:
   717   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   718   assumes S: "S \<in> sets lebesgue" and X: "X \<in> sets (lebesgue_on S)" and dim: "DIM('m) \<le> DIM('n)"
   719        and f: "f differentiable_on S"
   720      shows "f ` X \<in> sets (lebesgue_on (f`S))"
   721 proof (rule sets_lebesgue_on_continuous_image [OF S X])
   722   show "continuous_on S f"
   723     by (meson differentiable_imp_continuous_on f)
   724   show "\<And>T. \<lbrakk>negligible T; T \<subseteq> S\<rbrakk> \<Longrightarrow> negligible (f ` T)"
   725     using differentiable_on_subset f
   726     by (auto simp: intro!: negligible_differentiable_image_negligible [OF dim])
   727 qed
   728 
   729 
   730 proposition
   731  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   732   assumes S: "S \<in> lmeasurable"
   733   and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   734   and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   735   and bounded: "\<And>x. x \<in> S \<Longrightarrow> \<bar>det (matrix (f' x))\<bar> \<le> B"
   736   shows measurable_bounded_differentiable_image:
   737        "f ` S \<in> lmeasurable"
   738     and measure_bounded_differentiable_image:
   739        "measure lebesgue (f ` S) \<le> B * measure lebesgue S" (is "?M")
   740 proof -
   741   have "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) \<le> B * measure lebesgue S"
   742   proof (cases "B < 0")
   743     case True
   744     then have "S = {}"
   745       by (meson abs_ge_zero bounded empty_iff equalityI less_le_trans linorder_not_less subsetI)
   746     then show ?thesis
   747       by auto
   748   next
   749     case False
   750     then have "B \<ge> 0"
   751       by arith
   752     let ?\<mu> = "measure lebesgue"
   753     have f_diff: "f differentiable_on S"
   754       using deriv by (auto simp: differentiable_on_def differentiable_def)
   755     have eps: "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> (B+e) * ?\<mu> S" (is "?ME")
   756               if "e > 0" for e
   757     proof -
   758       have eps_d: "f ` S \<in> lmeasurable"  "?\<mu> (f ` S) \<le> (B+e) * (?\<mu> S + d)" (is "?MD")
   759                   if "d > 0" for d
   760       proof -
   761         obtain T where "open T" "S \<subseteq> T" and TS: "(T-S) \<in> lmeasurable" and "?\<mu> (T-S) < d"
   762           using S \<open>d > 0\<close> lmeasurable_outer_open by blast
   763         with S have "T \<in> lmeasurable" and Tless: "?\<mu> T < ?\<mu> S + d"
   764           by (auto simp: measurable_measure_Diff dest!: fmeasurable_Diff_D)
   765         have "\<exists>r. 0 < r \<and> r < d \<and> ball x r \<subseteq> T \<and> f ` (S \<inter> ball x r) \<in> lmeasurable \<and>
   766                   ?\<mu> (f ` (S \<inter> ball x r)) \<le> (B + e) * ?\<mu> (ball x r)"
   767           if "x \<in> S" "d > 0" for x d
   768         proof -
   769           have lin: "linear (f' x)"
   770             and lim0: "((\<lambda>y. (f y - (f x + f' x (y - x))) /\<^sub>R norm(y - x)) \<longlongrightarrow> 0) (at x within S)"
   771             using deriv \<open>x \<in> S\<close> by (auto simp: has_derivative_within bounded_linear.linear field_simps)
   772           have bo: "bounded (f' x ` ball 0 1)"
   773             by (simp add: bounded_linear_image linear_linear lin)
   774           have neg: "negligible (frontier (f' x ` ball 0 1))"
   775             using deriv has_derivative_linear \<open>x \<in> S\<close>
   776             by (auto intro!: negligible_convex_frontier [OF convex_linear_image])
   777           have 0: "0 < e * unit_ball_vol (real CARD('n))"
   778             using  \<open>e > 0\<close> by simp
   779           obtain k where "k > 0" and k:
   780                   "\<And>U. \<lbrakk>U \<in> lmeasurable; \<And>y. y \<in> U \<Longrightarrow> \<exists>z. z \<in> f' x ` ball 0 1 \<and> dist z y < k\<rbrakk>
   781                         \<Longrightarrow> ?\<mu> U < ?\<mu> (f' x ` ball 0 1) + e * unit_ball_vol (CARD('n))"
   782             using measure_semicontinuous_with_hausdist_explicit [OF bo neg 0] by blast
   783           obtain l where "l > 0" and l: "ball x l \<subseteq> T"
   784             using \<open>x \<in> S\<close> \<open>open T\<close> \<open>S \<subseteq> T\<close> openE by blast
   785           obtain \<zeta> where "0 < \<zeta>"
   786             and \<zeta>: "\<And>y. \<lbrakk>y \<in> S; y \<noteq> x; dist y x < \<zeta>\<rbrakk>
   787                         \<Longrightarrow> norm (f y - (f x + f' x (y - x))) / norm (y - x) < k"
   788             using lim0 \<open>k > 0\<close> by (force simp: Lim_within field_simps)
   789           define r where "r \<equiv> min (min l (\<zeta>/2)) (min 1 (d/2))"
   790           show ?thesis
   791           proof (intro exI conjI)
   792             show "r > 0" "r < d"
   793               using \<open>l > 0\<close> \<open>\<zeta> > 0\<close> \<open>d > 0\<close> by (auto simp: r_def)
   794             have "r \<le> l"
   795               by (auto simp: r_def)
   796             with l show "ball x r \<subseteq> T"
   797               by auto
   798             have ex_lessK: "\<exists>x' \<in> ball 0 1. dist (f' x x') ((f y - f x) /\<^sub>R r) < k"
   799               if "y \<in> S" and "dist x y < r" for y
   800             proof (cases "y = x")
   801               case True
   802               with lin linear_0 \<open>k > 0\<close> that show ?thesis
   803                 by (rule_tac x=0 in bexI) (auto simp: linear_0)
   804             next
   805               case False
   806               then show ?thesis
   807               proof (rule_tac x="(y - x) /\<^sub>R r" in bexI)
   808                 have "f' x ((y - x) /\<^sub>R r) = f' x (y - x) /\<^sub>R r"
   809                   by (simp add: lin linear_scale)
   810                 then have "dist (f' x ((y - x) /\<^sub>R r)) ((f y - f x) /\<^sub>R r) = norm (f' x (y - x) /\<^sub>R r - (f y - f x) /\<^sub>R r)"
   811                   by (simp add: dist_norm)
   812                 also have "\<dots> = norm (f' x (y - x) - (f y - f x)) / r"
   813                   using \<open>r > 0\<close> by (simp add: scale_right_diff_distrib [symmetric] divide_simps)
   814                 also have "\<dots> \<le> norm (f y - (f x + f' x (y - x))) / norm (y - x)"
   815                   using that \<open>r > 0\<close> False by (simp add: algebra_simps divide_simps dist_norm norm_minus_commute mult_right_mono)
   816                 also have "\<dots> < k"
   817                   using that \<open>0 < \<zeta>\<close> by (simp add: dist_commute r_def  \<zeta> [OF \<open>y \<in> S\<close> False])
   818                 finally show "dist (f' x ((y - x) /\<^sub>R r)) ((f y - f x) /\<^sub>R r) < k" .
   819                 show "(y - x) /\<^sub>R r \<in> ball 0 1"
   820                   using that \<open>r > 0\<close> by (simp add: dist_norm divide_simps norm_minus_commute)
   821               qed
   822             qed
   823             let ?rfs = "(\<lambda>x. x /\<^sub>R r) ` (+) (- f x) ` f ` (S \<inter> ball x r)"
   824             have rfs_mble: "?rfs \<in> lmeasurable"
   825             proof (rule bounded_set_imp_lmeasurable)
   826               have "f differentiable_on S \<inter> ball x r"
   827                 using f_diff by (auto simp: fmeasurableD differentiable_on_subset)
   828               with S show "?rfs \<in> sets lebesgue"
   829                 by (auto simp: sets.Int intro!: lebesgue_sets_translation differentiable_image_in_sets_lebesgue)
   830               let ?B = "(\<lambda>(x, y). x + y) ` (f' x ` ball 0 1 \<times> ball 0 k)"
   831               have "bounded ?B"
   832                 by (simp add: bounded_plus [OF bo])
   833               moreover have "?rfs \<subseteq> ?B"
   834                 apply (auto simp: dist_norm image_iff dest!: ex_lessK)
   835                 by (metis (no_types, hide_lams) add.commute diff_add_cancel dist_0_norm dist_commute dist_norm mem_ball)
   836               ultimately show "bounded (?rfs)"
   837                 by (rule bounded_subset)
   838             qed
   839             then have "(\<lambda>x. r *\<^sub>R x) ` ?rfs \<in> lmeasurable"
   840               by (simp add: measurable_linear_image)
   841             with \<open>r > 0\<close> have "(+) (- f x) ` f ` (S \<inter> ball x r) \<in> lmeasurable"
   842               by (simp add: image_comp o_def)
   843             then have "(+) (f x) ` (+) (- f x) ` f ` (S \<inter> ball x r) \<in> lmeasurable"
   844               using  measurable_translation by blast
   845             then show fsb: "f ` (S \<inter> ball x r) \<in> lmeasurable"
   846               by (simp add: image_comp o_def)
   847             have "?\<mu> (f ` (S \<inter> ball x r)) = ?\<mu> (?rfs) * r ^ CARD('n)"
   848               using \<open>r > 0\<close> fsb
   849               by (simp add: measure_linear_image measure_translation_subtract measurable_translation_subtract field_simps cong: image_cong_simp)
   850             also have "\<dots> \<le> (\<bar>det (matrix (f' x))\<bar> * unit_ball_vol (CARD('n)) + e * unit_ball_vol (CARD('n))) * r ^ CARD('n)"
   851             proof -
   852               have "?\<mu> (?rfs) < ?\<mu> (f' x ` ball 0 1) + e * unit_ball_vol (CARD('n))"
   853                 using rfs_mble by (force intro: k dest!: ex_lessK)
   854               then have "?\<mu> (?rfs) < \<bar>det (matrix (f' x))\<bar> * unit_ball_vol (CARD('n)) + e * unit_ball_vol (CARD('n))"
   855                 by (simp add: lin measure_linear_image [of "f' x"] content_ball)
   856               with \<open>r > 0\<close> show ?thesis
   857                 by auto
   858             qed
   859             also have "\<dots> \<le> (B + e) * ?\<mu> (ball x r)"
   860               using bounded [OF \<open>x \<in> S\<close>] \<open>r > 0\<close> by (simp add: content_ball algebra_simps)
   861             finally show "?\<mu> (f ` (S \<inter> ball x r)) \<le> (B + e) * ?\<mu> (ball x r)" .
   862           qed
   863         qed
   864         then obtain r where
   865           r0d: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow> 0 < r x d \<and> r x d < d"
   866           and rT: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow> ball x (r x d) \<subseteq> T"
   867           and r: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow>
   868                   (f ` (S \<inter> ball x (r x d))) \<in> lmeasurable \<and>
   869                   ?\<mu> (f ` (S \<inter> ball x (r x d))) \<le> (B + e) * ?\<mu> (ball x (r x d))"
   870           by metis
   871         obtain C where "countable C" and Csub: "C \<subseteq> {(x,r x t) |x t. x \<in> S \<and> 0 < t}"
   872           and pwC: "pairwise (\<lambda>i j. disjnt (ball (fst i) (snd i)) (ball (fst j) (snd j))) C"
   873           and negC: "negligible(S - (\<Union>i \<in> C. ball (fst i) (snd i)))"
   874           apply (rule Vitali_covering_theorem_balls [of S "{(x,r x t) |x t. x \<in> S \<and> 0 < t}" fst snd])
   875            apply auto
   876           by (metis dist_eq_0_iff r0d)
   877         let ?UB = "(\<Union>(x,s) \<in> C. ball x s)"
   878         have eq: "f ` (S \<inter> ?UB) = (\<Union>(x,s) \<in> C. f ` (S \<inter> ball x s))"
   879           by auto
   880         have mle: "?\<mu> (\<Union>(x,s) \<in> K. f ` (S \<inter> ball x s)) \<le> (B + e) * (?\<mu> S + d)"  (is "?l \<le> ?r")
   881           if "K \<subseteq> C" and "finite K" for K
   882         proof -
   883           have gt0: "b > 0" if "(a, b) \<in> K" for a b
   884             using Csub that \<open>K \<subseteq> C\<close> r0d by auto
   885           have inj: "inj_on (\<lambda>(x, y). ball x y) K"
   886             by (force simp: inj_on_def ball_eq_ball_iff dest: gt0)
   887           have disjnt: "disjoint ((\<lambda>(x, y). ball x y) ` K)"
   888             using pwC that
   889             apply (clarsimp simp: pairwise_def case_prod_unfold ball_eq_ball_iff)
   890             by (metis subsetD fst_conv snd_conv)
   891           have "?l \<le> (\<Sum>i\<in>K. ?\<mu> (case i of (x, s) \<Rightarrow> f ` (S \<inter> ball x s)))"
   892           proof (rule measure_UNION_le [OF \<open>finite K\<close>], clarify)
   893             fix x r
   894             assume "(x,r) \<in> K"
   895             then have "x \<in> S"
   896               using Csub \<open>K \<subseteq> C\<close> by auto
   897             show "f ` (S \<inter> ball x r) \<in> sets lebesgue"
   898               by (meson Int_lower1 S differentiable_on_subset f_diff fmeasurableD lmeasurable_ball order_refl sets.Int differentiable_image_in_sets_lebesgue)
   899           qed
   900           also have "\<dots> \<le> (\<Sum>(x,s) \<in> K. (B + e) * ?\<mu> (ball x s))"
   901             apply (rule sum_mono)
   902             using Csub r \<open>K \<subseteq> C\<close> by auto
   903           also have "\<dots> = (B + e) * (\<Sum>(x,s) \<in> K. ?\<mu> (ball x s))"
   904             by (simp add: prod.case_distrib sum_distrib_left)
   905           also have "\<dots> = (B + e) * sum ?\<mu> ((\<lambda>(x, y). ball x y) ` K)"
   906             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> by (simp add: inj sum.reindex prod.case_distrib)
   907           also have "\<dots> = (B + e) * ?\<mu> (\<Union>(x,s) \<in> K. ball x s)"
   908             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> that
   909             by (subst measure_Union') (auto simp: disjnt measure_Union')
   910           also have "\<dots> \<le> (B + e) * ?\<mu> T"
   911             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> that apply simp
   912             apply (rule measure_mono_fmeasurable [OF _ _ \<open>T \<in> lmeasurable\<close>])
   913             using Csub rT by force+
   914           also have "\<dots> \<le> (B + e) * (?\<mu> S + d)"
   915             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> Tless by simp
   916           finally show ?thesis .
   917         qed
   918         have fSUB_mble: "(f ` (S \<inter> ?UB)) \<in> lmeasurable"
   919           unfolding eq using Csub r False \<open>e > 0\<close> that
   920           by (auto simp: intro!: fmeasurable_UN_bound [OF \<open>countable C\<close> _ mle])
   921         have fSUB_meas: "?\<mu> (f ` (S \<inter> ?UB)) \<le> (B + e) * (?\<mu> S + d)"  (is "?MUB")
   922           unfolding eq using Csub r False \<open>e > 0\<close> that
   923           by (auto simp: intro!: measure_UN_bound [OF \<open>countable C\<close> _ mle])
   924         have neg: "negligible ((f ` (S \<inter> ?UB) - f ` S) \<union> (f ` S - f ` (S \<inter> ?UB)))"
   925         proof (rule negligible_subset [OF negligible_differentiable_image_negligible [OF order_refl negC, where f=f]])
   926           show "f differentiable_on S - (\<Union>i\<in>C. ball (fst i) (snd i))"
   927             by (meson DiffE differentiable_on_subset subsetI f_diff)
   928         qed force
   929         show "f ` S \<in> lmeasurable"
   930           by (rule lmeasurable_negligible_symdiff [OF fSUB_mble neg])
   931         show ?MD
   932           using fSUB_meas measure_negligible_symdiff [OF fSUB_mble neg] by simp
   933       qed
   934       show "f ` S \<in> lmeasurable"
   935         using eps_d [of 1] by simp
   936       show ?ME
   937       proof (rule field_le_epsilon)
   938         fix \<delta> :: real
   939         assume "0 < \<delta>"
   940         then show "?\<mu> (f ` S) \<le> (B + e) * ?\<mu> S + \<delta>"
   941           using eps_d [of "\<delta> / (B+e)"] \<open>e > 0\<close> \<open>B \<ge> 0\<close> by (auto simp: divide_simps mult_ac)
   942       qed
   943     qed
   944     show ?thesis
   945     proof (cases "?\<mu> S = 0")
   946       case True
   947       with eps have "?\<mu> (f ` S) = 0"
   948         by (metis mult_zero_right not_le zero_less_measure_iff)
   949       then show ?thesis
   950         using eps [of 1] by (simp add: True)
   951     next
   952       case False
   953       have "?\<mu> (f ` S) \<le> B * ?\<mu> S"
   954       proof (rule field_le_epsilon)
   955         fix e :: real
   956         assume "e > 0"
   957         then show "?\<mu> (f ` S) \<le> B * ?\<mu> S + e"
   958           using eps [of "e / ?\<mu> S"] False by (auto simp: algebra_simps zero_less_measure_iff)
   959       qed
   960       with eps [of 1] show ?thesis by auto
   961     qed
   962   qed
   963   then show "f ` S \<in> lmeasurable" ?M by blast+
   964 qed
   965 
   966 lemma m_diff_image_weak:
   967  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   968   assumes S: "S \<in> lmeasurable"
   969     and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   970     and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   971   shows "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
   972 proof -
   973   let ?\<mu> = "measure lebesgue"
   974   have aint_S: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
   975     using int unfolding absolutely_integrable_on_def by auto
   976   define m where "m \<equiv> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
   977   have *: "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> m + e * ?\<mu> S"
   978     if "e > 0" for e
   979   proof -
   980     define T where "T \<equiv> \<lambda>n. {x \<in> S. n * e \<le> \<bar>det (matrix (f' x))\<bar> \<and>
   981                                      \<bar>det (matrix (f' x))\<bar> < (Suc n) * e}"
   982     have meas_t: "T n \<in> lmeasurable" for n
   983     proof -
   984       have *: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) \<in> borel_measurable (lebesgue_on S)"
   985         using aint_S by (simp add: S borel_measurable_restrict_space_iff fmeasurableD set_integrable_def)
   986       have [intro]: "x \<in> sets (lebesgue_on S) \<Longrightarrow> x \<in> sets lebesgue" for x
   987         using S sets_restrict_space_subset by blast
   988       have "{x \<in> S. real n * e \<le> \<bar>det (matrix (f' x))\<bar>} \<in> sets lebesgue"
   989         using * by (auto simp: borel_measurable_iff_halfspace_ge space_restrict_space)
   990       then have 1: "{x \<in> S. real n * e \<le> \<bar>det (matrix (f' x))\<bar>} \<in> lmeasurable"
   991         using S by (simp add: fmeasurableI2)
   992       have "{x \<in> S. \<bar>det (matrix (f' x))\<bar> < (1 + real n) * e} \<in> sets lebesgue"
   993         using * by (auto simp: borel_measurable_iff_halfspace_less space_restrict_space)
   994       then have 2: "{x \<in> S. \<bar>det (matrix (f' x))\<bar> < (1 + real n) * e} \<in> lmeasurable"
   995         using S by (simp add: fmeasurableI2)
   996       show ?thesis
   997         using fmeasurable.Int [OF 1 2] by (simp add: T_def Int_def cong: conj_cong)
   998     qed
   999     have aint_T: "\<And>k. (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on T k"
  1000       using set_integrable_subset [OF aint_S] meas_t T_def by blast
  1001     have Seq: "S = (\<Union>n. T n)"
  1002       apply (auto simp: T_def)
  1003       apply (rule_tac x="nat(floor(abs(det(matrix(f' x))) / e))" in exI)
  1004       using that apply auto
  1005       using of_int_floor_le pos_le_divide_eq apply blast
  1006       by (metis add.commute pos_divide_less_eq real_of_int_floor_add_one_gt)
  1007     have meas_ft: "f ` T n \<in> lmeasurable" for n
  1008     proof (rule measurable_bounded_differentiable_image)
  1009       show "T n \<in> lmeasurable"
  1010         by (simp add: meas_t)
  1011     next
  1012       fix x :: "(real,'n) vec"
  1013       assume "x \<in> T n"
  1014       show "(f has_derivative f' x) (at x within T n)"
  1015         by (metis (no_types, lifting) \<open>x \<in> T n\<close> deriv has_derivative_within_subset mem_Collect_eq subsetI T_def)
  1016       show "\<bar>det (matrix (f' x))\<bar> \<le> (Suc n) * e"
  1017         using \<open>x \<in> T n\<close> T_def by auto
  1018     next
  1019       show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T n"
  1020         using aint_T absolutely_integrable_on_def by blast
  1021     qed
  1022     have disT: "disjoint (range T)"
  1023       unfolding disjoint_def
  1024     proof clarsimp
  1025       show "T m \<inter> T n = {}" if "T m \<noteq> T n" for m n
  1026         using that
  1027       proof (induction m n rule: linorder_less_wlog)
  1028         case (less m n)
  1029         with \<open>e > 0\<close> show ?case
  1030           unfolding T_def
  1031           proof (clarsimp simp add: Collect_conj_eq [symmetric])
  1032             fix x
  1033             assume "e > 0"  "m < n"  "n * e \<le> \<bar>det (matrix (f' x))\<bar>"  "\<bar>det (matrix (f' x))\<bar> < (1 + real m) * e"
  1034             then have "n < 1 + real m"
  1035               by (metis (no_types, hide_lams) less_le_trans mult.commute not_le real_mult_le_cancel_iff2)
  1036             then show "False"
  1037               using less.hyps by linarith
  1038           qed
  1039       qed auto
  1040     qed
  1041     have injT: "inj_on T ({n. T n \<noteq> {}})"
  1042       unfolding inj_on_def
  1043     proof clarsimp
  1044       show "m = n" if "T m = T n" "T n \<noteq> {}" for m n
  1045         using that
  1046       proof (induction m n rule: linorder_less_wlog)
  1047         case (less m n)
  1048         have False if "T n \<subseteq> T m" "x \<in> T n" for x
  1049           using \<open>e > 0\<close> \<open>m < n\<close> that
  1050           apply (auto simp: T_def  mult.commute intro: less_le_trans dest!: subsetD)
  1051           by (metis add.commute less_le_trans nat_less_real_le not_le real_mult_le_cancel_iff2)
  1052         then show ?case
  1053           using less.prems by blast
  1054       qed auto
  1055     qed
  1056     have sum_eq_Tim: "(\<Sum>k\<le>n. f (T k)) = sum f (T ` {..n})" if "f {} = 0" for f :: "_ \<Rightarrow> real" and n
  1057     proof (subst sum.reindex_nontrivial)
  1058       fix i j  assume "i \<in> {..n}" "j \<in> {..n}" "i \<noteq> j" "T i = T j"
  1059       with that  injT [unfolded inj_on_def] show "f (T i) = 0"
  1060         by simp metis
  1061     qed (use atMost_atLeast0 in auto)
  1062     let ?B = "m + e * ?\<mu> S"
  1063     have "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> ?B" for n
  1064     proof -
  1065       have "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> (\<Sum>k\<le>n. ((k+1) * e) * ?\<mu>(T k))"
  1066       proof (rule sum_mono [OF measure_bounded_differentiable_image])
  1067         show "(f has_derivative f' x) (at x within T k)" if "x \<in> T k" for k x
  1068           using that unfolding T_def by (blast intro: deriv has_derivative_within_subset)
  1069         show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T k" for k
  1070           using absolutely_integrable_on_def aint_T by blast
  1071         show "\<bar>det (matrix (f' x))\<bar> \<le> real (k + 1) * e" if "x \<in> T k" for k x
  1072           using T_def that by auto
  1073       qed (use meas_t in auto)
  1074       also have "\<dots> \<le> (\<Sum>k\<le>n. (k * e) * ?\<mu>(T k)) + (\<Sum>k\<le>n. e * ?\<mu>(T k))"
  1075         by (simp add: algebra_simps sum.distrib)
  1076       also have "\<dots> \<le> ?B"
  1077       proof (rule add_mono)
  1078         have "(\<Sum>k\<le>n. real k * e * ?\<mu> (T k)) = (\<Sum>k\<le>n. integral (T k) (\<lambda>x. k * e))"
  1079           by (simp add: lmeasure_integral [OF meas_t]
  1080                    flip: integral_mult_right integral_mult_left)
  1081         also have "\<dots> \<le> (\<Sum>k\<le>n. integral (T k) (\<lambda>x.  (abs (det (matrix (f' x))))))"
  1082         proof (rule sum_mono)
  1083           fix k
  1084           assume "k \<in> {..n}"
  1085           show "integral (T k) (\<lambda>x. k * e) \<le> integral (T k) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1086           proof (rule integral_le [OF integrable_on_const [OF meas_t]])
  1087             show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T k"
  1088               using absolutely_integrable_on_def aint_T by blast
  1089           next
  1090             fix x assume "x \<in> T k"
  1091             show "k * e \<le> \<bar>det (matrix (f' x))\<bar>"
  1092               using \<open>x \<in> T k\<close> T_def by blast
  1093           qed
  1094         qed
  1095         also have "\<dots> = sum (\<lambda>T. integral T (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)) (T ` {..n})"
  1096           by (auto intro: sum_eq_Tim)
  1097         also have "\<dots> = integral (\<Union>k\<le>n. T k) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1098         proof (rule integral_unique [OF has_integral_Union, symmetric])
  1099           fix S  assume "S \<in> T ` {..n}"
  1100           then show "((\<lambda>x. \<bar>det (matrix (f' x))\<bar>) has_integral integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)) S"
  1101           using absolutely_integrable_on_def aint_T by blast
  1102         next
  1103           show "pairwise (\<lambda>S S'. negligible (S \<inter> S')) (T ` {..n})"
  1104             using disT unfolding disjnt_iff by (auto simp: pairwise_def intro!: empty_imp_negligible)
  1105         qed auto
  1106         also have "\<dots> \<le> m"
  1107           unfolding m_def
  1108         proof (rule integral_subset_le)
  1109           have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on (\<Union>k\<le>n. T k)"
  1110             apply (rule set_integrable_subset [OF aint_S])
  1111              apply (intro measurable meas_t fmeasurableD)
  1112             apply (force simp: Seq)
  1113             done
  1114           then show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on (\<Union>k\<le>n. T k)"
  1115             using absolutely_integrable_on_def by blast
  1116         qed (use Seq int in auto)
  1117         finally show "(\<Sum>k\<le>n. real k * e * ?\<mu> (T k)) \<le> m" .
  1118       next
  1119         have "(\<Sum>k\<le>n. ?\<mu> (T k)) = sum ?\<mu> (T ` {..n})"
  1120           by (auto intro: sum_eq_Tim)
  1121         also have "\<dots> = ?\<mu> (\<Union>k\<le>n. T k)"
  1122           using S disT by (auto simp: pairwise_def meas_t intro: measure_Union' [symmetric])
  1123         also have "\<dots> \<le> ?\<mu> S"
  1124           using S by (auto simp: Seq intro: meas_t fmeasurableD measure_mono_fmeasurable)
  1125         finally have "(\<Sum>k\<le>n. ?\<mu> (T k)) \<le> ?\<mu> S" .
  1126         then show "(\<Sum>k\<le>n. e * ?\<mu> (T k)) \<le> e * ?\<mu> S"
  1127           by (metis less_eq_real_def ordered_comm_semiring_class.comm_mult_left_mono sum_distrib_left that)
  1128       qed
  1129       finally show "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> ?B" .
  1130     qed
  1131     moreover have "measure lebesgue (\<Union>k\<le>n. f ` T k) \<le> (\<Sum>k\<le>n. ?\<mu> (f ` T k))" for n
  1132       by (simp add: fmeasurableD meas_ft measure_UNION_le)
  1133     ultimately have B_ge_m: "?\<mu> (\<Union>k\<le>n. (f ` T k)) \<le> ?B" for n
  1134       by (meson order_trans)
  1135     have "(\<Union>n. f ` T n) \<in> lmeasurable"
  1136       by (rule fmeasurable_countable_Union [OF meas_ft B_ge_m])
  1137     moreover have "?\<mu> (\<Union>n. f ` T n) \<le> m + e * ?\<mu> S"
  1138       by (rule measure_countable_Union_le [OF meas_ft B_ge_m])
  1139     ultimately show "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> m + e * ?\<mu> S"
  1140       by (auto simp: Seq image_Union)
  1141   qed
  1142   show ?thesis
  1143   proof
  1144     show "f ` S \<in> lmeasurable"
  1145       using * linordered_field_no_ub by blast
  1146     let ?x = "m - ?\<mu> (f ` S)"
  1147     have False if "?\<mu> (f ` S) > integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1148     proof -
  1149       have ml: "m < ?\<mu> (f ` S)"
  1150         using m_def that by blast
  1151       then have "?\<mu> S \<noteq> 0"
  1152         using "*"(2) bgauge_existence_lemma by fastforce
  1153       with ml have 0: "0 < - (m - ?\<mu> (f ` S))/2 / ?\<mu> S"
  1154         using that zero_less_measure_iff by force
  1155       then show ?thesis
  1156         using * [OF 0] that by (auto simp: divide_simps m_def split: if_split_asm)
  1157     qed
  1158     then show "?\<mu> (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1159       by fastforce
  1160   qed
  1161 qed
  1162 
  1163 
  1164 theorem
  1165  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  1166   assumes S: "S \<in> sets lebesgue"
  1167     and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  1168     and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
  1169   shows measurable_differentiable_image: "f ` S \<in> lmeasurable"
  1170     and measure_differentiable_image:
  1171        "measure lebesgue (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" (is "?M")
  1172 proof -
  1173   let ?I = "\<lambda>n::nat. cbox (vec (-n)) (vec n) \<inter> S"
  1174   let ?\<mu> = "measure lebesgue"
  1175   have "x \<in> cbox (vec (- real (nat \<lceil>norm x\<rceil>))) (vec (real (nat \<lceil>norm x\<rceil>)))" for x :: "real^'n::_"
  1176     apply (auto simp: mem_box_cart)
  1177     apply (metis abs_le_iff component_le_norm_cart minus_le_iff of_nat_ceiling order.trans)
  1178     by (meson abs_le_D1 norm_bound_component_le_cart real_nat_ceiling_ge)
  1179   then have Seq: "S = (\<Union>n. ?I n)"
  1180     by auto
  1181   have fIn: "f ` ?I n \<in> lmeasurable"
  1182        and mfIn: "?\<mu> (f ` ?I n) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" (is ?MN) for n
  1183   proof -
  1184     have In: "?I n \<in> lmeasurable"
  1185       by (simp add: S bounded_Int bounded_set_imp_lmeasurable sets.Int)
  1186     moreover have "\<And>x. x \<in> ?I n \<Longrightarrow> (f has_derivative f' x) (at x within ?I n)"
  1187       by (meson Int_iff deriv has_derivative_within_subset subsetI)
  1188     moreover have int_In: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on ?I n"
  1189     proof -
  1190       have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
  1191         using int absolutely_integrable_integrable_bound by force
  1192       then have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on ?I n"
  1193         by (metis (no_types) Int_lower1 In fmeasurableD inf_commute set_integrable_subset)
  1194       then show ?thesis
  1195         using absolutely_integrable_on_def by blast
  1196     qed
  1197     ultimately have "f ` ?I n \<in> lmeasurable" "?\<mu> (f ` ?I n) \<le> integral (?I n) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1198       using m_diff_image_weak by metis+
  1199     moreover have "integral (?I n) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1200       by (simp add: int_In int integral_subset_le)
  1201     ultimately show "f ` ?I n \<in> lmeasurable" ?MN
  1202       by auto
  1203   qed
  1204   have "?I k \<subseteq> ?I n" if "k \<le> n" for k n
  1205     by (rule Int_mono) (use that in \<open>auto simp: subset_interval_imp_cart\<close>)
  1206   then have "(\<Union>k\<le>n. f ` ?I k) = f ` ?I n" for n
  1207     by (fastforce simp add:)
  1208   with mfIn have "?\<mu> (\<Union>k\<le>n. f ` ?I k) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" for n
  1209     by simp
  1210   then have "(\<Union>n. f ` ?I n) \<in> lmeasurable" "?\<mu> (\<Union>n. f ` ?I n) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  1211     by (rule fmeasurable_countable_Union [OF fIn] measure_countable_Union_le [OF fIn])+
  1212   then show "f ` S \<in> lmeasurable" ?M
  1213     by (metis Seq image_UN)+
  1214 qed
  1215 
  1216 
  1217 lemma borel_measurable_simple_function_limit_increasing:
  1218   fixes f :: "'a::euclidean_space \<Rightarrow> real"
  1219   shows "(f \<in> borel_measurable lebesgue \<and> (\<forall>x. 0 \<le> f x)) \<longleftrightarrow>
  1220          (\<exists>g. (\<forall>n x. 0 \<le> g n x \<and> g n x \<le> f x) \<and> (\<forall>n x. g n x \<le> (g(Suc n) x)) \<and>
  1221               (\<forall>n. g n \<in> borel_measurable lebesgue) \<and> (\<forall>n. finite(range (g n))) \<and>
  1222               (\<forall>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x))"
  1223          (is "?lhs = ?rhs")
  1224 proof
  1225   assume f: ?lhs
  1226   have leb_f: "{x. a \<le> f x \<and> f x < b} \<in> sets lebesgue" for a b
  1227   proof -
  1228     have "{x. a \<le> f x \<and> f x < b} = {x. f x < b} - {x. f x < a}"
  1229       by auto
  1230     also have "\<dots> \<in> sets lebesgue"
  1231       using borel_measurable_vimage_halfspace_component_lt [of f UNIV] f by auto
  1232     finally show ?thesis .
  1233   qed
  1234   have "g n x \<le> f x"
  1235         if inc_g: "\<And>n x. 0 \<le> g n x \<and> g n x \<le> g (Suc n) x"
  1236            and meas_g: "\<And>n. g n \<in> borel_measurable lebesgue"
  1237            and fin: "\<And>n. finite(range (g n))" and lim: "\<And>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x" for g n x
  1238   proof -
  1239     have "\<exists>r>0. \<forall>N. \<exists>n\<ge>N. dist (g n x) (f x) \<ge> r" if "g n x > f x"
  1240     proof -
  1241       have g: "g n x \<le> g (N + n) x" for N
  1242         by (rule transitive_stepwise_le) (use inc_g in auto)
  1243       have "\<exists>na\<ge>N. g n x - f x \<le> dist (g na x) (f x)" for N
  1244         apply (rule_tac x="N+n" in exI)
  1245         using g [of N] by (auto simp: dist_norm)
  1246       with that show ?thesis
  1247         using diff_gt_0_iff_gt by blast
  1248     qed
  1249     with lim show ?thesis
  1250       apply (auto simp: lim_sequentially)
  1251       by (meson less_le_not_le not_le_imp_less)
  1252   qed
  1253   moreover
  1254   let ?\<Omega> = "\<lambda>n k. indicator {y. k/2^n \<le> f y \<and> f y < (k+1)/2^n}"
  1255   let ?g = "\<lambda>n x. (\<Sum>k::real | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x)"
  1256   have "\<exists>g. (\<forall>n x. 0 \<le> g n x \<and> g n x \<le> (g(Suc n) x)) \<and>
  1257              (\<forall>n. g n \<in> borel_measurable lebesgue) \<and> (\<forall>n. finite(range (g n))) \<and>(\<forall>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x)"
  1258   proof (intro exI allI conjI)
  1259     show "0 \<le> ?g n x" for n x
  1260     proof (clarify intro!: ordered_comm_monoid_add_class.sum_nonneg)
  1261       fix k::real
  1262       assume "k \<in> \<int>" and k: "\<bar>k\<bar> \<le> 2 ^ (2*n)"
  1263       show "0 \<le> k/2^n * ?\<Omega> n k x"
  1264         using f \<open>k \<in> \<int>\<close> apply (auto simp: indicator_def divide_simps Ints_def)
  1265         apply (drule spec [where x=x])
  1266         using zero_le_power [of "2::real" n] mult_nonneg_nonneg [of "f x" "2^n"]
  1267         by linarith
  1268     qed
  1269     show "?g n x \<le> ?g (Suc n) x" for n x
  1270     proof -
  1271       have "?g n x =
  1272             (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n).
  1273               k/2^n * (indicator {y. k/2^n \<le> f y \<and> f y < (k+1/2)/2^n} x +
  1274               indicator {y. (k+1/2)/2^n \<le> f y \<and> f y < (k+1)/2^n} x))"
  1275         by (rule sum.cong [OF refl]) (simp add: indicator_def divide_simps)
  1276       also have "\<dots> = (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * indicator {y. k/2^n \<le> f y \<and> f y < (k+1/2)/2^n} x) +
  1277                        (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * indicator {y. (k+1/2)/2^n \<le> f y \<and> f y < (k+1)/2^n} x)"
  1278         by (simp add:  comm_monoid_add_class.sum.distrib algebra_simps)
  1279       also have "\<dots> = (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). (2 * k)/2 ^ Suc n * indicator {y. (2 * k)/2 ^ Suc n \<le> f y \<and> f y < (2 * k+1)/2 ^ Suc n} x) +
  1280                        (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). (2 * k)/2 ^ Suc n * indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < ((2 * k+1) + 1)/2 ^ Suc n} x)"
  1281         by (force simp: field_simps indicator_def intro: sum.cong)
  1282       also have "\<dots> \<le> (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2 * Suc n). k/2 ^ Suc n * (indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x))"
  1283                 (is "?a + _ \<le> ?b")
  1284       proof -
  1285         have *: "\<lbrakk>sum f I \<le> sum h I; a + sum h I \<le> b\<rbrakk> \<Longrightarrow> a + sum f I \<le> b" for I a b f and h :: "real\<Rightarrow>real"
  1286           by linarith
  1287         let ?h = "\<lambda>k. (2*k+1)/2 ^ Suc n *
  1288                       (indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < ((2*k+1) + 1)/2 ^ Suc n} x)"
  1289         show ?thesis
  1290         proof (rule *)
  1291           show "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n).
  1292                   2 * k/2 ^ Suc n * indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < (2 * k+1 + 1)/2 ^ Suc n} x)
  1293                 \<le> sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}"
  1294             by (rule sum_mono) (simp add: indicator_def divide_simps)
  1295         next
  1296           have \<alpha>: "?a = (\<Sum>k \<in> (*)2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
  1297                          k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
  1298             by (auto simp: inj_on_def field_simps comm_monoid_add_class.sum.reindex)
  1299           have \<beta>: "sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}
  1300                    = (\<Sum>k \<in> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
  1301                       k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
  1302             by (auto simp: inj_on_def field_simps comm_monoid_add_class.sum.reindex)
  1303           have 0: "(*) 2 ` {k \<in> \<int>. P k} \<inter> (\<lambda>x. 2 * x + 1) ` {k \<in> \<int>. P k} = {}" for P :: "real \<Rightarrow> bool"
  1304           proof -
  1305             have "2 * i \<noteq> 2 * j + 1" for i j :: int by arith
  1306             thus ?thesis
  1307               unfolding Ints_def by auto (use of_int_eq_iff in fastforce)
  1308           qed
  1309           have "?a + sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}
  1310                 = (\<Sum>k \<in> (*)2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
  1311                   k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
  1312             unfolding \<alpha> \<beta>
  1313             using finite_abs_int_segment [of "2 ^ (2*n)"]
  1314             by (subst sum_Un) (auto simp: 0)
  1315           also have "\<dots> \<le> ?b"
  1316           proof (rule sum_mono2)
  1317             show "finite {k::real. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)}"
  1318               by (rule finite_abs_int_segment)
  1319             show "(*) 2 ` {k::real. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2^(2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2^(2*n)} \<subseteq> {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)}"
  1320               apply auto
  1321               using one_le_power [of "2::real" "2*n"]  by linarith
  1322             have *: "\<lbrakk>x \<in> (S \<union> T) - U; \<And>x. x \<in> S \<Longrightarrow> x \<in> U; \<And>x. x \<in> T \<Longrightarrow> x \<in> U\<rbrakk> \<Longrightarrow> P x" for S T U P
  1323               by blast
  1324             have "0 \<le> b" if "b \<in> \<int>" "f x * (2 * 2^n) < b + 1" for b
  1325             proof -
  1326               have "0 \<le> f x * (2 * 2^n)"
  1327                 by (simp add: f)
  1328               also have "\<dots> < b+1"
  1329                 by (simp add: that)
  1330               finally show "0 \<le> b"
  1331                 using \<open>b \<in> \<int>\<close> by (auto simp: elim!: Ints_cases)
  1332             qed
  1333             then show "0 \<le> b/2 ^ Suc n * indicator {y. b/2 ^ Suc n \<le> f y \<and> f y < (b + 1)/2 ^ Suc n} x"
  1334                   if "b \<in> {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)} -
  1335                           ((*) 2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)})" for b
  1336               using that by (simp add: indicator_def divide_simps)
  1337           qed
  1338           finally show "?a + sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<le> ?b" .
  1339         qed
  1340       qed
  1341       finally show ?thesis .
  1342     qed
  1343     show "?g n \<in> borel_measurable lebesgue" for n
  1344       apply (intro borel_measurable_indicator borel_measurable_times borel_measurable_sum)
  1345       using leb_f sets_restrict_UNIV by auto
  1346     show "finite (range (?g n))" for n
  1347     proof -
  1348       have "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x)
  1349               \<in> (\<lambda>k. k/2^n) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}" for x
  1350       proof (cases "\<exists>k. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n) \<and> k/2^n \<le> f x \<and> f x < (k+1)/2^n")
  1351         case True
  1352         then show ?thesis
  1353           by (blast intro: indicator_sum_eq)
  1354       next
  1355         case False
  1356         then have "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) = 0"
  1357           by auto
  1358         then show ?thesis by force
  1359       qed
  1360       then have "range (?g n) \<subseteq> ((\<lambda>k. (k/2^n)) ` {k. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n)})"
  1361         by auto
  1362       moreover have "finite ((\<lambda>k::real. (k/2^n)) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)})"
  1363         by (intro finite_imageI finite_abs_int_segment)
  1364       ultimately show ?thesis
  1365         by (rule finite_subset)
  1366     qed
  1367     show "(\<lambda>n. ?g n x) \<longlonglongrightarrow> f x" for x
  1368     proof (clarsimp simp add: lim_sequentially)
  1369       fix e::real
  1370       assume "e > 0"
  1371       obtain N1 where N1: "2 ^ N1 > abs(f x)"
  1372         using real_arch_pow by fastforce
  1373       obtain N2 where N2: "(1/2) ^ N2 < e"
  1374         using real_arch_pow_inv \<open>e > 0\<close> by fastforce
  1375       have "dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) (f x) < e" if "N1 + N2 \<le> n" for n
  1376       proof -
  1377         let ?m = "real_of_int \<lfloor>2^n * f x\<rfloor>"
  1378         have "\<bar>?m\<bar> \<le> 2^n * 2^N1"
  1379           using N1 apply (simp add: f)
  1380           by (meson floor_mono le_floor_iff less_le_not_le mult_le_cancel_left_pos zero_less_numeral zero_less_power)
  1381         also have "\<dots> \<le> 2 ^ (2*n)"
  1382           by (metis that add_leD1 add_le_cancel_left mult.commute mult_2_right one_less_numeral_iff
  1383                     power_add power_increasing_iff semiring_norm(76))
  1384         finally have m_le: "\<bar>?m\<bar> \<le> 2 ^ (2*n)" .
  1385         have "?m/2^n \<le> f x" "f x < (?m + 1)/2^n"
  1386           by (auto simp: mult.commute pos_divide_le_eq mult_imp_less_div_pos)
  1387         then have eq: "dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) (f x)
  1388                      = dist (?m/2^n) (f x)"
  1389           by (subst indicator_sum_eq [of ?m]) (auto simp: m_le)
  1390         have "\<bar>2^n\<bar> * \<bar>?m/2^n - f x\<bar> = \<bar>2^n * (?m/2^n - f x)\<bar>"
  1391           by (simp add: abs_mult)
  1392         also have "\<dots> < 2 ^ N2 * e"
  1393           using N2 by (simp add: divide_simps mult.commute) linarith
  1394         also have "\<dots> \<le> \<bar>2^n\<bar> * e"
  1395           using that \<open>e > 0\<close> by auto
  1396         finally have "dist (?m/2^n) (f x) < e"
  1397           by (simp add: dist_norm)
  1398         then show ?thesis
  1399           using eq by linarith
  1400       qed
  1401       then show "\<exists>no. \<forall>n\<ge>no. dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k * ?\<Omega> n k x/2^n) (f x) < e"
  1402         by force
  1403     qed
  1404   qed
  1405   ultimately show ?rhs
  1406     by metis
  1407 next
  1408   assume RHS: ?rhs
  1409   with borel_measurable_simple_function_limit [of f UNIV, unfolded borel_measurable_UNIV_eq]
  1410   show ?lhs
  1411     by (blast intro: order_trans)
  1412 qed
  1413 
  1414 subsection\<open>Borel measurable Jacobian determinant\<close>
  1415 
  1416 lemma lemma_partial_derivatives0:
  1417   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1418   assumes "linear f" and lim0: "((\<lambda>x. f x /\<^sub>R norm x) \<longlongrightarrow> 0) (at 0 within S)"
  1419     and lb: "\<And>v. v \<noteq> 0 \<Longrightarrow> (\<exists>k>0. \<forall>e>0. \<exists>x. x \<in> S - {0} \<and> norm x < e \<and> k * norm x \<le> \<bar>v \<bullet> x\<bar>)"
  1420   shows "f x = 0"
  1421 proof -
  1422   interpret linear f by fact
  1423   have "dim {x. f x = 0} \<le> DIM('a)"
  1424     by (rule dim_subset_UNIV)
  1425   moreover have False if less: "dim {x. f x = 0} < DIM('a)"
  1426   proof -
  1427     obtain d where "d \<noteq> 0" and d: "\<And>y. f y = 0 \<Longrightarrow> d \<bullet> y = 0"
  1428       using orthogonal_to_subspace_exists [OF less] orthogonal_def
  1429       by (metis (mono_tags, lifting) mem_Collect_eq span_base)
  1430     then obtain k where "k > 0"
  1431       and k: "\<And>e. e > 0 \<Longrightarrow> \<exists>y. y \<in> S - {0} \<and> norm y < e \<and> k * norm y \<le> \<bar>d \<bullet> y\<bar>"
  1432       using lb by blast
  1433     have "\<exists>h. \<forall>n. ((h n \<in> S \<and> h n \<noteq> 0 \<and> k * norm (h n) \<le> \<bar>d \<bullet> h n\<bar>) \<and> norm (h n) < 1 / real (Suc n)) \<and>
  1434                norm (h (Suc n)) < norm (h n)"
  1435     proof (rule dependent_nat_choice)
  1436       show "\<exists>y. (y \<in> S \<and> y \<noteq> 0 \<and> k * norm y \<le> \<bar>d \<bullet> y\<bar>) \<and> norm y < 1 / real (Suc 0)"
  1437         by simp (metis DiffE insertCI k not_less not_one_le_zero)
  1438     qed (use k [of "min (norm x) (1/(Suc n + 1))" for x n] in auto)
  1439     then obtain \<alpha> where \<alpha>: "\<And>n. \<alpha> n \<in> S - {0}" and kd: "\<And>n. k * norm(\<alpha> n) \<le> \<bar>d \<bullet> \<alpha> n\<bar>"
  1440          and norm_lt: "\<And>n. norm(\<alpha> n) < 1/(Suc n)"
  1441       by force
  1442     let ?\<beta> = "\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)"
  1443     have com: "\<And>g. (\<forall>n. g n \<in> sphere (0::'a) 1)
  1444               \<Longrightarrow> \<exists>l \<in> sphere 0 1. \<exists>\<rho>::nat\<Rightarrow>nat. strict_mono \<rho> \<and> (g \<circ> \<rho>) \<longlonglongrightarrow> l"
  1445       using compact_sphere compact_def by metis
  1446     moreover have "\<forall>n. ?\<beta> n \<in> sphere 0 1"
  1447       using \<alpha> by auto
  1448     ultimately obtain l::'a and \<rho>::"nat\<Rightarrow>nat"
  1449        where l: "l \<in> sphere 0 1" and "strict_mono \<rho>" and to_l: "(?\<beta> \<circ> \<rho>) \<longlonglongrightarrow> l"
  1450       by meson
  1451     moreover have "continuous (at l) (\<lambda>x. (\<bar>d \<bullet> x\<bar> - k))"
  1452       by (intro continuous_intros)
  1453     ultimately have lim_dl: "((\<lambda>x. (\<bar>d \<bullet> x\<bar> - k)) \<circ> (?\<beta> \<circ> \<rho>)) \<longlonglongrightarrow> (\<bar>d \<bullet> l\<bar> - k)"
  1454       by (meson continuous_imp_tendsto)
  1455     have "\<forall>\<^sub>F i in sequentially. 0 \<le> ((\<lambda>x. \<bar>d \<bullet> x\<bar> - k) \<circ> ((\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>)) i"
  1456       using \<alpha> kd by (auto simp: divide_simps)
  1457     then have "k \<le> \<bar>d \<bullet> l\<bar>"
  1458       using tendsto_lowerbound [OF lim_dl, of 0] by auto
  1459     moreover have "d \<bullet> l = 0"
  1460     proof (rule d)
  1461       show "f l = 0"
  1462       proof (rule LIMSEQ_unique [of "f \<circ> ?\<beta> \<circ> \<rho>"])
  1463         have "isCont f l"
  1464           using \<open>linear f\<close> linear_continuous_at linear_conv_bounded_linear by blast
  1465         then show "(f \<circ> (\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>) \<longlonglongrightarrow> f l"
  1466           unfolding comp_assoc
  1467           using to_l continuous_imp_tendsto by blast
  1468         have "\<alpha> \<longlonglongrightarrow> 0"
  1469           using norm_lt LIMSEQ_norm_0 by metis
  1470         with \<open>strict_mono \<rho>\<close> have "(\<alpha> \<circ> \<rho>) \<longlonglongrightarrow> 0"
  1471           by (metis LIMSEQ_subseq_LIMSEQ)
  1472         with lim0 \<alpha> have "((\<lambda>x. f x /\<^sub>R norm x) \<circ> (\<alpha> \<circ> \<rho>)) \<longlonglongrightarrow> 0"
  1473           by (force simp: tendsto_at_iff_sequentially)
  1474         then show "(f \<circ> (\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>) \<longlonglongrightarrow> 0"
  1475           by (simp add: o_def scale)
  1476       qed
  1477     qed
  1478     ultimately show False
  1479       using \<open>k > 0\<close> by auto
  1480   qed
  1481   ultimately have dim: "dim {x. f x = 0} = DIM('a)"
  1482     by force
  1483   then show ?thesis
  1484     using dim_eq_full
  1485     by (metis (mono_tags, lifting) eq_0_on_span eucl.span_Basis linear_axioms linear_eq_stdbasis
  1486         mem_Collect_eq module_hom_zero span_base span_raw_def)
  1487 qed
  1488 
  1489 lemma lemma_partial_derivatives:
  1490   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1491   assumes "linear f" and lim: "((\<lambda>x. f (x - a) /\<^sub>R norm (x - a)) \<longlongrightarrow> 0) (at a within S)"
  1492     and lb: "\<And>v. v \<noteq> 0 \<Longrightarrow> (\<exists>k>0.  \<forall>e>0. \<exists>x \<in> S - {a}. norm(a - x) < e \<and> k * norm(a - x) \<le> \<bar>v \<bullet> (x - a)\<bar>)"
  1493   shows "f x = 0"
  1494 proof -
  1495   have "((\<lambda>x. f x /\<^sub>R norm x) \<longlongrightarrow> 0) (at 0 within (\<lambda>x. x-a) ` S)"
  1496     using lim by (simp add: Lim_within dist_norm)
  1497   then show ?thesis
  1498   proof (rule lemma_partial_derivatives0 [OF \<open>linear f\<close>])
  1499     fix v :: "'a"
  1500     assume v: "v \<noteq> 0"
  1501     show "\<exists>k>0. \<forall>e>0. \<exists>x. x \<in> (\<lambda>x. x - a) ` S - {0} \<and> norm x < e \<and> k * norm x \<le> \<bar>v \<bullet> x\<bar>"
  1502       using lb [OF v] by (force simp:  norm_minus_commute)
  1503   qed
  1504 qed
  1505 
  1506 
  1507 proposition borel_measurable_partial_derivatives:
  1508   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n"
  1509   assumes S: "S \<in> sets lebesgue"
  1510     and f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  1511   shows "(\<lambda>x. (matrix(f' x)$m$n)) \<in> borel_measurable (lebesgue_on S)"
  1512 proof -
  1513   have contf: "continuous_on S f"
  1514     using continuous_on_eq_continuous_within f has_derivative_continuous by blast
  1515   have "{x \<in> S.  (matrix (f' x)$m$n) \<le> b} \<in> sets lebesgue" for b
  1516   proof (rule sets_negligible_symdiff)
  1517     let ?T = "{x \<in> S. \<forall>e>0. \<exists>d>0. \<exists>A. A$m$n < b \<and> (\<forall>i j. A$i$j \<in> \<rat>) \<and>
  1518                        (\<forall>y \<in> S. norm(y - x) < d \<longrightarrow> norm(f y - f x - A *v (y - x)) \<le> e * norm(y - x))}"
  1519     let ?U = "S \<inter>
  1520               (\<Inter>e \<in> {e \<in> \<rat>. e > 0}.
  1521                 \<Union>A \<in> {A. A$m$n < b \<and> (\<forall>i j. A$i$j \<in> \<rat>)}.
  1522                   \<Union>d \<in> {d \<in> \<rat>. 0 < d}.
  1523                      S \<inter> (\<Inter>y \<in> S. {x \<in> S. norm(y - x) < d \<longrightarrow> norm(f y - f x - A *v (y - x)) \<le> e * norm(y - x)}))"
  1524     have "?T = ?U"
  1525     proof (intro set_eqI iffI)
  1526       fix x
  1527       assume xT: "x \<in> ?T"
  1528       then show "x \<in> ?U"
  1529       proof (clarsimp simp add:)
  1530         fix q :: real
  1531         assume "q \<in> \<rat>" "q > 0"
  1532         then obtain d A where "d > 0" and A: "A $ m $ n < b" "\<And>i j. A $ i $ j \<in> \<rat>"
  1533           "\<And>y. \<lbrakk>y\<in>S;  norm (y - x) < d\<rbrakk> \<Longrightarrow> norm (f y - f x - A *v (y - x)) \<le> q * norm (y - x)"
  1534           using xT by auto
  1535         then obtain \<delta> where "d > \<delta>" "\<delta> > 0" "\<delta> \<in> \<rat>"
  1536           using Rats_dense_in_real by blast
  1537         with A show "\<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
  1538                          (\<exists>s. s \<in> \<rat> \<and> 0 < s \<and> (\<forall>y\<in>S. norm (y - x) < s \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> q * norm (y - x)))"
  1539           by force
  1540       qed
  1541     next
  1542       fix x
  1543       assume xU: "x \<in> ?U"
  1544       then show "x \<in> ?T"
  1545       proof clarsimp
  1546         fix e :: "real"
  1547         assume "e > 0"
  1548         then obtain \<epsilon> where \<epsilon>: "e > \<epsilon>" "\<epsilon> > 0" "\<epsilon> \<in> \<rat>"
  1549           using Rats_dense_in_real by blast
  1550         with xU obtain A r where "x \<in> S" and Ar: "A $ m $ n < b" "\<forall>i j. A $ i $ j \<in> \<rat>" "r \<in> \<rat>" "r > 0"
  1551           and "\<forall>y\<in>S. norm (y - x) < r \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> \<epsilon> * norm (y - x)"
  1552           by (auto simp: split: if_split_asm)
  1553         then have "\<forall>y\<in>S. norm (y - x) < r \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)"
  1554           by (meson \<open>e > \<epsilon>\<close> less_eq_real_def mult_right_mono norm_ge_zero order_trans)
  1555         then show "\<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and> (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
  1556           using \<open>x \<in> S\<close> Ar by blast
  1557       qed
  1558     qed
  1559     moreover have "?U \<in> sets lebesgue"
  1560     proof -
  1561       have coQ: "countable {e \<in> \<rat>. 0 < e}"
  1562         using countable_Collect countable_rat by blast
  1563       have ne: "{e \<in> \<rat>. (0::real) < e} \<noteq> {}"
  1564         using zero_less_one Rats_1 by blast
  1565       have coA: "countable {A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>)}"
  1566       proof (rule countable_subset)
  1567         show "countable {A. \<forall>i j. A $ i $ j \<in> \<rat>}"
  1568           using countable_vector [OF countable_vector, of "\<lambda>i j. \<rat>"] by (simp add: countable_rat)
  1569       qed blast
  1570       have *: "\<lbrakk>U \<noteq> {} \<Longrightarrow> closedin (top_of_set S) (S \<inter> \<Inter> U)\<rbrakk>
  1571                \<Longrightarrow> closedin (top_of_set S) (S \<inter> \<Inter> U)" for U
  1572         by fastforce
  1573       have eq: "{x::(real,'m)vec. P x \<and> (Q x \<longrightarrow> R x)} = {x. P x \<and> \<not> Q x} \<union> {x. P x \<and> R x}" for P Q R
  1574         by auto
  1575       have sets: "S \<inter> (\<Inter>y\<in>S. {x \<in> S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)})
  1576                   \<in> sets lebesgue" for e A d
  1577       proof -
  1578         have clo: "closedin (top_of_set S)
  1579                      {x \<in> S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)}"
  1580           for y
  1581         proof -
  1582           have cont1: "continuous_on S (\<lambda>x. norm (y - x))"
  1583           and  cont2: "continuous_on S (\<lambda>x. e * norm (y - x) - norm (f y - f x - (A *v y - A *v x)))"
  1584             by (force intro: contf continuous_intros)+
  1585           have clo1: "closedin (top_of_set S) {x \<in> S. d \<le> norm (y - x)}"
  1586             using continuous_closedin_preimage [OF cont1, of "{d..}"] by (simp add: vimage_def Int_def)
  1587           have clo2: "closedin (top_of_set S)
  1588                        {x \<in> S. norm (f y - f x - (A *v y - A *v x)) \<le> e * norm (y - x)}"
  1589             using continuous_closedin_preimage [OF cont2, of "{0..}"] by (simp add: vimage_def Int_def)
  1590           show ?thesis
  1591             by (auto simp: eq not_less matrix_vector_mult_diff_distrib intro: clo1 clo2)
  1592         qed
  1593         show ?thesis
  1594           by (rule lebesgue_closedin [of S]) (force intro: * S clo)+
  1595       qed
  1596       show ?thesis
  1597         by (intro sets sets.Int S sets.countable_UN'' sets.countable_INT'' coQ coA) auto
  1598     qed
  1599     ultimately show "?T \<in> sets lebesgue"
  1600       by simp
  1601     let ?M = "(?T - {x \<in> S. matrix (f' x) $ m $ n \<le> b} \<union> ({x \<in> S. matrix (f' x) $ m $ n \<le> b} - ?T))"
  1602     let ?\<Theta> = "\<lambda>x v. \<forall>\<xi>>0. \<exists>e>0. \<forall>y \<in> S-{x}. norm (x - y) < e \<longrightarrow> \<bar>v \<bullet> (y - x)\<bar> < \<xi> * norm (x - y)"
  1603     have nN: "negligible {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
  1604       unfolding negligible_eq_zero_density
  1605     proof clarsimp
  1606       fix x v and r e :: "real"
  1607       assume "x \<in> S" "v \<noteq> 0" "r > 0" "e > 0"
  1608       and Theta [rule_format]: "?\<Theta> x v"
  1609       moreover have "(norm v * e / 2) / CARD('m) ^ CARD('m) > 0"
  1610         by (simp add: \<open>v \<noteq> 0\<close> \<open>e > 0\<close>)
  1611       ultimately obtain d where "d > 0"
  1612          and dless: "\<And>y. \<lbrakk>y \<in> S - {x}; norm (x - y) < d\<rbrakk> \<Longrightarrow>
  1613                         \<bar>v \<bullet> (y - x)\<bar> < ((norm v * e / 2) / CARD('m) ^ CARD('m)) * norm (x - y)"
  1614         by metis
  1615       let ?W = "ball x (min d r) \<inter> {y. \<bar>v \<bullet> (y - x)\<bar> < (norm v * e/2 * min d r) / CARD('m) ^ CARD('m)}"
  1616       have "open {x. \<bar>v \<bullet> (x - a)\<bar> < b}" for a b
  1617         by (intro open_Collect_less continuous_intros)
  1618       show "\<exists>d>0. d \<le> r \<and>
  1619             (\<exists>U. {x' \<in> S. \<exists>v\<noteq>0. ?\<Theta> x' v} \<inter> ball x d \<subseteq> U \<and>
  1620                  U \<in> lmeasurable \<and> measure lebesgue U < e * content (ball x d))"
  1621       proof (intro exI conjI)
  1622         show "0 < min d r" "min d r \<le> r"
  1623           using \<open>r > 0\<close> \<open>d > 0\<close> by auto
  1624         show "{x' \<in> S. \<exists>v. v \<noteq> 0 \<and> (\<forall>\<xi>>0. \<exists>e>0. \<forall>z\<in>S - {x'}. norm (x' - z) < e \<longrightarrow> \<bar>v \<bullet> (z - x')\<bar> < \<xi> * norm (x' - z))} \<inter> ball x (min d r) \<subseteq> ?W"
  1625           proof (clarsimp simp: dist_norm norm_minus_commute)
  1626             fix y w
  1627             assume "y \<in> S" "w \<noteq> 0"
  1628               and less [rule_format]:
  1629                     "\<forall>\<xi>>0. \<exists>e>0. \<forall>z\<in>S - {y}. norm (y - z) < e \<longrightarrow> \<bar>w \<bullet> (z - y)\<bar> < \<xi> * norm (y - z)"
  1630               and d: "norm (y - x) < d" and r: "norm (y - x) < r"
  1631             show "\<bar>v \<bullet> (y - x)\<bar> < norm v * e * min d r / (2 * real CARD('m) ^ CARD('m))"
  1632             proof (cases "y = x")
  1633               case True
  1634               with \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> \<open>v \<noteq> 0\<close> show ?thesis
  1635                 by simp
  1636             next
  1637               case False
  1638               have "\<bar>v \<bullet> (y - x)\<bar> < norm v * e / 2 / real (CARD('m) ^ CARD('m)) * norm (x - y)"
  1639                 apply (rule dless)
  1640                 using False \<open>y \<in> S\<close> d by (auto simp: norm_minus_commute)
  1641               also have "\<dots> \<le> norm v * e * min d r / (2 * real CARD('m) ^ CARD('m))"
  1642                 using d r \<open>e > 0\<close> by (simp add: field_simps norm_minus_commute mult_left_mono)
  1643               finally show ?thesis .
  1644             qed
  1645           qed
  1646           show "?W \<in> lmeasurable"
  1647             by (simp add: fmeasurable_Int_fmeasurable borel_open)
  1648           obtain k::'m where True
  1649             by metis
  1650           obtain T where T: "orthogonal_transformation T" and v: "v = T(norm v *\<^sub>R axis k (1::real))"
  1651             using rotation_rightward_line by metis
  1652           define b where "b \<equiv> norm v"
  1653           have "b > 0"
  1654             using \<open>v \<noteq> 0\<close> by (auto simp: b_def)
  1655           obtain eqb: "inv T v = b *\<^sub>R axis k (1::real)" and "inj T" "bij T" and invT: "orthogonal_transformation (inv T)"
  1656             by (metis UNIV_I b_def  T v bij_betw_inv_into_left orthogonal_transformation_inj orthogonal_transformation_bij orthogonal_transformation_inv)
  1657           let ?v = "\<chi> i. min d r / CARD('m)"
  1658           let ?v' = "\<chi> i. if i = k then (e/2 * min d r) / CARD('m) ^ CARD('m) else min d r"
  1659           let ?x' = "inv T x"
  1660           let ?W' = "(ball ?x' (min d r) \<inter> {y. \<bar>(y - ?x')$k\<bar> < e * min d r / (2 * CARD('m) ^ CARD('m))})"
  1661           have abs: "x - e \<le> y \<and> y \<le> x + e \<longleftrightarrow> abs(y - x) \<le> e" for x y e::real
  1662             by auto
  1663           have "?W = T ` ?W'"
  1664           proof -
  1665             have 1: "T ` (ball (inv T x) (min d r)) = ball x (min d r)"
  1666               by (simp add: T image_orthogonal_transformation_ball orthogonal_transformation_surj surj_f_inv_f)
  1667             have 2: "{y. \<bar>v \<bullet> (y - x)\<bar> < b * e * min d r / (2 * real CARD('m) ^ CARD('m))} =
  1668                       T ` {y. \<bar>y $ k - ?x' $ k\<bar> < e * min d r / (2 * real CARD('m) ^ CARD('m))}"
  1669             proof -
  1670               have *: "\<bar>T (b *\<^sub>R axis k 1) \<bullet> (y - x)\<bar> = b * \<bar>inv T y $ k - ?x' $ k\<bar>" for y
  1671               proof -
  1672                 have "\<bar>T (b *\<^sub>R axis k 1) \<bullet> (y - x)\<bar> = \<bar>(b *\<^sub>R axis k 1) \<bullet> inv T (y - x)\<bar>"
  1673                   by (metis (no_types, hide_lams) b_def eqb invT orthogonal_transformation_def v)
  1674                 also have "\<dots> = b * \<bar>(axis k 1) \<bullet> inv T (y - x)\<bar>"
  1675                   using \<open>b > 0\<close> by (simp add: abs_mult)
  1676                 also have "\<dots> = b * \<bar>inv T y $ k - ?x' $ k\<bar>"
  1677                   using orthogonal_transformation_linear [OF invT]
  1678                   by (simp add: inner_axis' linear_diff)
  1679                 finally show ?thesis
  1680                   by simp
  1681               qed
  1682               show ?thesis
  1683                 using v b_def [symmetric]
  1684                 using \<open>b > 0\<close> by (simp add: * bij_image_Collect_eq [OF \<open>bij T\<close>] mult_less_cancel_left_pos times_divide_eq_right [symmetric] del: times_divide_eq_right)
  1685             qed
  1686             show ?thesis
  1687               using \<open>b > 0\<close> by (simp add: image_Int \<open>inj T\<close> 1 2 b_def [symmetric])
  1688           qed
  1689           moreover have "?W' \<in> lmeasurable"
  1690             by (auto intro: fmeasurable_Int_fmeasurable)
  1691           ultimately have "measure lebesgue ?W = measure lebesgue ?W'"
  1692             by (metis measure_orthogonal_image T)
  1693           also have "\<dots> \<le> measure lebesgue (cbox (?x' - ?v') (?x' + ?v'))"
  1694           proof (rule measure_mono_fmeasurable)
  1695             show "?W' \<subseteq> cbox (?x' - ?v') (?x' + ?v')"
  1696               apply (clarsimp simp add: mem_box_cart abs dist_norm norm_minus_commute simp del: min_less_iff_conj min.bounded_iff)
  1697               by (metis component_le_norm_cart less_eq_real_def le_less_trans vector_minus_component)
  1698           qed auto
  1699           also have "\<dots> \<le> e/2 * measure lebesgue (cbox (?x' - ?v) (?x' + ?v))"
  1700           proof -
  1701             have "cbox (?x' - ?v) (?x' + ?v) \<noteq> {}"
  1702               using \<open>r > 0\<close> \<open>d > 0\<close> by (auto simp: interval_eq_empty_cart divide_less_0_iff)
  1703             with \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> show ?thesis
  1704               apply (simp add: content_cbox_if_cart mem_box_cart)
  1705               apply (auto simp: prod_nonneg)
  1706               apply (simp add: abs if_distrib prod.delta_remove prod_constant field_simps power_diff split: if_split_asm)
  1707               done
  1708           qed
  1709           also have "\<dots> \<le> e/2 * measure lebesgue (cball ?x' (min d r))"
  1710           proof (rule mult_left_mono [OF measure_mono_fmeasurable])
  1711             have *: "norm (?x' - y) \<le> min d r"
  1712               if y: "\<And>i. \<bar>?x' $ i - y $ i\<bar> \<le> min d r / real CARD('m)" for y
  1713             proof -
  1714               have "norm (?x' - y) \<le> (\<Sum>i\<in>UNIV. \<bar>(?x' - y) $ i\<bar>)"
  1715                 by (rule norm_le_l1_cart)
  1716               also have "\<dots> \<le> real CARD('m) * (min d r / real CARD('m))"
  1717                 by (rule sum_bounded_above) (use y in auto)
  1718               finally show ?thesis
  1719                 by simp
  1720             qed
  1721             show "cbox (?x' - ?v) (?x' + ?v) \<subseteq> cball ?x' (min d r)"
  1722               apply (clarsimp simp only: mem_box_cart dist_norm mem_cball intro!: *)
  1723               by (simp add: abs_diff_le_iff abs_minus_commute)
  1724           qed (use \<open>e > 0\<close> in auto)
  1725           also have "\<dots> < e * content (cball ?x' (min d r))"
  1726             using \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> by auto
  1727           also have "\<dots> = e * content (ball x (min d r))"
  1728             using \<open>r > 0\<close> \<open>d > 0\<close> by (simp add: content_cball content_ball)
  1729           finally show "measure lebesgue ?W < e * content (ball x (min d r))" .
  1730       qed
  1731     qed
  1732     have *: "(\<And>x. (x \<notin> S) \<Longrightarrow> (x \<in> T \<longleftrightarrow> x \<in> U)) \<Longrightarrow> (T - U) \<union> (U - T) \<subseteq> S" for S T U :: "(real,'m) vec set"
  1733       by blast
  1734     have MN: "?M \<subseteq> {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
  1735     proof (rule *)
  1736       fix x
  1737       assume x: "x \<notin> {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
  1738       show "(x \<in> ?T) \<longleftrightarrow> (x \<in> {x \<in> S. matrix (f' x) $ m $ n \<le> b})"
  1739       proof (cases "x \<in> S")
  1740         case True
  1741         then have x: "\<not> ?\<Theta> x v" if "v \<noteq> 0" for v
  1742           using x that by force
  1743         show ?thesis
  1744         proof (rule iffI; clarsimp)
  1745           assume b: "\<forall>e>0. \<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
  1746                                     (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
  1747                      (is "\<forall>e>0. \<exists>d>0. \<exists>A. ?\<Phi> e d A")
  1748           then have "\<forall>k. \<exists>d>0. \<exists>A. ?\<Phi> (1 / Suc k) d A"
  1749             by (metis (no_types, hide_lams) less_Suc_eq_0_disj of_nat_0_less_iff zero_less_divide_1_iff)
  1750           then obtain \<delta> A where \<delta>: "\<And>k. \<delta> k > 0"
  1751                            and Ab: "\<And>k. A k $ m $ n < b"
  1752                            and A: "\<And>k y. \<lbrakk>y \<in> S; norm (y - x) < \<delta> k\<rbrakk> \<Longrightarrow>
  1753                                           norm (f y - f x - A k *v (y - x)) \<le> 1/(Suc k) * norm (y - x)"
  1754             by metis
  1755           have "\<forall>i j. \<exists>a. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> a"
  1756           proof (intro allI)
  1757             fix i j
  1758             have vax: "(A n *v axis j 1) $ i = A n $ i $ j" for n
  1759               by (metis cart_eq_inner_axis matrix_vector_mul_component)
  1760             let ?CA = "{x. Cauchy (\<lambda>n. (A n) *v x)}"
  1761             have "subspace ?CA"
  1762               unfolding subspace_def convergent_eq_Cauchy [symmetric]
  1763                 by (force simp: algebra_simps intro: tendsto_intros)
  1764             then have CA_eq: "?CA = span ?CA"
  1765               by (metis span_eq_iff)
  1766             also have "\<dots> = UNIV"
  1767             proof -
  1768               have "dim ?CA \<le> CARD('m)"
  1769                 using dim_subset_UNIV[of ?CA]
  1770                 by auto
  1771               moreover have "False" if less: "dim ?CA < CARD('m)"
  1772               proof -
  1773                 obtain d where "d \<noteq> 0" and d: "\<And>y. y \<in> span ?CA \<Longrightarrow> orthogonal d y"
  1774                   using less by (force intro: orthogonal_to_subspace_exists [of ?CA])
  1775                 with x [OF \<open>d \<noteq> 0\<close>] obtain \<xi> where "\<xi> > 0"
  1776                   and \<xi>: "\<And>e. e > 0 \<Longrightarrow> \<exists>y \<in> S - {x}. norm (x - y) < e \<and> \<xi> * norm (x - y) \<le> \<bar>d \<bullet> (y - x)\<bar>"
  1777                   by (fastforce simp: not_le Bex_def)
  1778                 obtain \<gamma> z where \<gamma>Sx: "\<And>i. \<gamma> i \<in> S - {x}"
  1779                            and \<gamma>le:   "\<And>i. \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar>"
  1780                            and \<gamma>x:    "\<gamma> \<longlonglongrightarrow> x"
  1781                            and z:     "(\<lambda>n. (\<gamma> n - x) /\<^sub>R norm (\<gamma> n - x)) \<longlonglongrightarrow> z"
  1782                 proof -
  1783                   have "\<exists>\<gamma>. (\<forall>i. (\<gamma> i \<in> S - {x} \<and>
  1784                                   \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar> \<and> norm(\<gamma> i - x) < 1/Suc i) \<and>
  1785                                  norm(\<gamma>(Suc i) - x) < norm(\<gamma> i - x))"
  1786                   proof (rule dependent_nat_choice)
  1787                     show "\<exists>y. y \<in> S - {x} \<and> \<xi> * norm (y - x) \<le> \<bar>d \<bullet> (y - x)\<bar> \<and> norm (y - x) < 1 / Suc 0"
  1788                       using \<xi> [of 1] by (auto simp: dist_norm norm_minus_commute)
  1789                   next
  1790                     fix y i
  1791                     assume "y \<in> S - {x} \<and> \<xi> * norm (y - x) \<le> \<bar>d \<bullet> (y - x)\<bar> \<and> norm (y - x) < 1/Suc i"
  1792                     then have "min (norm(y - x)) (1/((Suc i) + 1)) > 0"
  1793                       by auto
  1794                     then obtain y' where "y' \<in> S - {x}" and y': "norm (x - y') < min (norm (y - x)) (1/((Suc i) + 1))"
  1795                                          "\<xi> * norm (x - y') \<le> \<bar>d \<bullet> (y' - x)\<bar>"
  1796                       using \<xi> by metis
  1797                     with \<xi> show "\<exists>y'. (y' \<in> S - {x} \<and> \<xi> * norm (y' - x) \<le> \<bar>d \<bullet> (y' - x)\<bar> \<and>
  1798                               norm (y' - x) < 1/(Suc (Suc i))) \<and> norm (y' - x) < norm (y - x)"
  1799                       by (auto simp: dist_norm norm_minus_commute)
  1800                   qed
  1801                   then obtain \<gamma> where
  1802                         \<gamma>Sx: "\<And>i. \<gamma> i \<in> S - {x}"
  1803                         and \<gamma>le: "\<And>i. \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar>"
  1804                         and \<gamma>conv: "\<And>i. norm(\<gamma> i - x) < 1/(Suc i)"
  1805                     by blast
  1806                   let ?f = "\<lambda>i. (\<gamma> i - x) /\<^sub>R norm (\<gamma> i - x)"
  1807                   have "?f i \<in> sphere 0 1" for i
  1808                     using \<gamma>Sx by auto
  1809                   then obtain l \<rho> where "l \<in> sphere 0 1" "strict_mono \<rho>" and l: "(?f \<circ> \<rho>) \<longlonglongrightarrow> l"
  1810                     using compact_sphere [of "0::(real,'m) vec" 1]  unfolding compact_def by meson
  1811                   show thesis
  1812                   proof
  1813                     show "(\<gamma> \<circ> \<rho>) i \<in> S - {x}" "\<xi> * norm ((\<gamma> \<circ> \<rho>) i - x) \<le> \<bar>d \<bullet> ((\<gamma> \<circ> \<rho>) i - x)\<bar>" for i
  1814                       using \<gamma>Sx \<gamma>le by auto
  1815                     have "\<gamma> \<longlonglongrightarrow> x"
  1816                     proof (clarsimp simp add: LIMSEQ_def dist_norm)
  1817                       fix r :: "real"
  1818                       assume "r > 0"
  1819                       with real_arch_invD obtain no where "no \<noteq> 0" "real no > 1/r"
  1820                         by (metis divide_less_0_1_iff not_less_iff_gr_or_eq of_nat_0_eq_iff reals_Archimedean2)
  1821                       with \<gamma>conv show "\<exists>no. \<forall>n\<ge>no. norm (\<gamma> n - x) < r"
  1822                         by (metis \<open>r > 0\<close> add.commute divide_inverse inverse_inverse_eq inverse_less_imp_less less_trans mult.left_neutral nat_le_real_less of_nat_Suc)
  1823                     qed
  1824                     with \<open>strict_mono \<rho>\<close> show "(\<gamma> \<circ> \<rho>) \<longlonglongrightarrow> x"
  1825                       by (metis LIMSEQ_subseq_LIMSEQ)
  1826                     show "(\<lambda>n. ((\<gamma> \<circ> \<rho>) n - x) /\<^sub>R norm ((\<gamma> \<circ> \<rho>) n - x)) \<longlonglongrightarrow> l"
  1827                       using l by (auto simp: o_def)
  1828                   qed
  1829                 qed
  1830                 have "isCont (\<lambda>x. (\<bar>d \<bullet> x\<bar> - \<xi>)) z"
  1831                   by (intro continuous_intros)
  1832                 from isCont_tendsto_compose [OF this z]
  1833                 have lim: "(\<lambda>y. \<bar>d \<bullet> ((\<gamma> y - x) /\<^sub>R norm (\<gamma> y - x))\<bar> - \<xi>) \<longlonglongrightarrow> \<bar>d \<bullet> z\<bar> - \<xi>"
  1834                   by auto
  1835                 moreover have "\<forall>\<^sub>F i in sequentially. 0 \<le> \<bar>d \<bullet> ((\<gamma> i - x) /\<^sub>R norm (\<gamma> i - x))\<bar> - \<xi>"
  1836                 proof (rule eventuallyI)
  1837                   fix n
  1838                   show "0 \<le> \<bar>d \<bullet> ((\<gamma> n - x) /\<^sub>R norm (\<gamma> n - x))\<bar> - \<xi>"
  1839                   using \<gamma>le [of n] \<gamma>Sx by (auto simp: abs_mult divide_simps)
  1840                 qed
  1841                 ultimately have "\<xi> \<le> \<bar>d \<bullet> z\<bar>"
  1842                   using tendsto_lowerbound [where a=0] by fastforce
  1843                 have "Cauchy (\<lambda>n. (A n) *v z)"
  1844                 proof (clarsimp simp add: Cauchy_def)
  1845                   fix \<epsilon> :: "real"
  1846                   assume "0 < \<epsilon>"
  1847                   then obtain N::nat where "N > 0" and N: "\<epsilon>/2 > 1/N"
  1848                     by (metis half_gt_zero inverse_eq_divide neq0_conv real_arch_inverse)
  1849                   show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (A m *v z) (A n *v z) < \<epsilon>"
  1850                   proof (intro exI allI impI)
  1851                     fix i j
  1852                     assume ij: "N \<le> i" "N \<le> j"
  1853                     let ?V = "\<lambda>i k. A i *v ((\<gamma> k - x) /\<^sub>R norm (\<gamma> k - x))"
  1854                     have "\<forall>\<^sub>F k in sequentially. dist (\<gamma> k) x < min (\<delta> i) (\<delta> j)"
  1855                       using \<gamma>x [unfolded tendsto_iff] by (meson min_less_iff_conj \<delta>)
  1856                     then have even: "\<forall>\<^sub>F k in sequentially. norm (?V i k - ?V j k) - 2 / N \<le> 0"
  1857                     proof (rule eventually_mono, clarsimp)
  1858                       fix p
  1859                       assume p: "dist (\<gamma> p) x < \<delta> i" "dist (\<gamma> p) x < \<delta> j"
  1860                       let ?C = "\<lambda>k. f (\<gamma> p) - f x - A k *v (\<gamma> p - x)"
  1861                       have "norm ((A i - A j) *v (\<gamma> p - x)) = norm (?C j - ?C i)"
  1862                         by (simp add: algebra_simps)
  1863                       also have "\<dots> \<le> norm (?C j) + norm (?C i)"
  1864                         using norm_triangle_ineq4 by blast
  1865                       also have "\<dots> \<le> 1/(Suc j) * norm (\<gamma> p - x) + 1/(Suc i) * norm (\<gamma> p - x)"
  1866                         by (metis A Diff_iff \<gamma>Sx dist_norm p add_mono)
  1867                       also have "\<dots> \<le> 1/N * norm (\<gamma> p - x) + 1/N * norm (\<gamma> p - x)"
  1868                         apply (intro add_mono mult_right_mono)
  1869                         using ij \<open>N > 0\<close> by (auto simp: field_simps)
  1870                       also have "\<dots> = 2 / N * norm (\<gamma> p - x)"
  1871                         by simp
  1872                       finally have no_le: "norm ((A i - A j) *v (\<gamma> p - x)) \<le> 2 / N * norm (\<gamma> p - x)" .
  1873                       have "norm (?V i p - ?V j p) =
  1874                             norm ((A i - A j) *v ((\<gamma> p - x) /\<^sub>R norm (\<gamma> p - x)))"
  1875                         by (simp add: algebra_simps)
  1876                       also have "\<dots> = norm ((A i - A j) *v (\<gamma> p - x)) / norm (\<gamma> p - x)"
  1877                         by (simp add: divide_inverse matrix_vector_mult_scaleR)
  1878                       also have "\<dots> \<le> 2 / N"
  1879                         using no_le by (auto simp: divide_simps)
  1880                       finally show "norm (?V i p - ?V j p) \<le> 2 / N" .
  1881                     qed
  1882                     have "isCont (\<lambda>w. (norm(A i *v w - A j *v w) - 2 / N)) z"
  1883                       by (intro continuous_intros)
  1884                     from isCont_tendsto_compose [OF this z]
  1885                     have lim: "(\<lambda>w. norm (A i *v ((\<gamma> w - x) /\<^sub>R norm (\<gamma> w - x)) -
  1886                                     A j *v ((\<gamma> w - x) /\<^sub>R norm (\<gamma> w - x))) - 2 / N)
  1887                                \<longlonglongrightarrow> norm (A i *v z - A j *v z) - 2 / N"
  1888                       by auto
  1889                     have "dist (A i *v z) (A j *v z) \<le> 2 / N"
  1890                       using tendsto_upperbound [OF lim even] by (auto simp: dist_norm)
  1891                     with N show "dist (A i *v z) (A j *v z) < \<epsilon>"
  1892                       by linarith
  1893                   qed
  1894                 qed
  1895                 then have "d \<bullet> z = 0"
  1896                   using CA_eq d orthogonal_def by auto
  1897                 then show False
  1898                   using \<open>0 < \<xi>\<close> \<open>\<xi> \<le> \<bar>d \<bullet> z\<bar>\<close> by auto
  1899               qed
  1900               ultimately show ?thesis
  1901                 using dim_eq_full by fastforce
  1902             qed
  1903             finally have "?CA = UNIV" .
  1904             then have "Cauchy (\<lambda>n. (A n) *v axis j 1)"
  1905               by auto
  1906             then obtain L where "(\<lambda>n. A n *v axis j 1) \<longlonglongrightarrow> L"
  1907               by (auto simp: Cauchy_convergent_iff convergent_def)
  1908             then have "(\<lambda>x. (A x *v axis j 1) $ i) \<longlonglongrightarrow> L $ i"
  1909               by (rule tendsto_vec_nth)
  1910             then show "\<exists>a. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> a"
  1911               by (force simp: vax)
  1912           qed
  1913           then obtain B where B: "\<And>i j. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> B $ i $ j"
  1914             by (auto simp: lambda_skolem)
  1915           have lin_df: "linear (f' x)"
  1916                and lim_df: "((\<lambda>y. (1 / norm (y - x)) *\<^sub>R (f y - (f x + f' x (y - x)))) \<longlongrightarrow> 0) (at x within S)"
  1917             using \<open>x \<in> S\<close> assms by (auto simp: has_derivative_within linear_linear)
  1918           moreover
  1919           interpret linear "f' x" by fact
  1920           have "(matrix (f' x) - B) *v w = 0" for w
  1921           proof (rule lemma_partial_derivatives [of "(*v) (matrix (f' x) - B)"])
  1922             show "linear ((*v) (matrix (f' x) - B))"
  1923               by (rule matrix_vector_mul_linear)
  1924             have "((\<lambda>y. ((f x + f' x (y - x)) - f y) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
  1925               using tendsto_minus [OF lim_df] by (simp add: algebra_simps divide_simps)
  1926             then show "((\<lambda>y. (matrix (f' x) - B) *v (y - x) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
  1927             proof (rule Lim_transform)
  1928               have "((\<lambda>y. ((f y + B *v x - (f x + B *v y)) /\<^sub>R norm (y - x))) \<longlongrightarrow> 0) (at x within S)"
  1929               proof (clarsimp simp add: Lim_within dist_norm)
  1930                 fix e :: "real"
  1931                 assume "e > 0"
  1932                 then obtain q::nat where "q \<noteq> 0" and qe2: "1/q < e/2"
  1933                   by (metis divide_pos_pos inverse_eq_divide real_arch_inverse zero_less_numeral)
  1934                 let ?g = "\<lambda>p. sum  (\<lambda>i. sum (\<lambda>j. abs((A p - B)$i$j)) UNIV) UNIV"
  1935                 have "(\<lambda>k. onorm (\<lambda>y. (A k - B) *v y)) \<longlonglongrightarrow> 0"
  1936                 proof (rule Lim_null_comparison)
  1937                   show "\<forall>\<^sub>F k in sequentially. norm (onorm (\<lambda>y. (A k - B) *v y)) \<le> ?g k"
  1938                   proof (rule eventually_sequentiallyI)
  1939                     fix k :: "nat"
  1940                     assume "0 \<le> k"
  1941                     have "0 \<le> onorm ((*v) (A k - B))"
  1942                       using matrix_vector_mul_bounded_linear
  1943                       by (rule onorm_pos_le)
  1944                     then show "norm (onorm ((*v) (A k - B))) \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>(A k - B) $ i $ j\<bar>)"
  1945                       by (simp add: onorm_le_matrix_component_sum del: vector_minus_component)
  1946                   qed
  1947                 next
  1948                   show "?g \<longlonglongrightarrow> 0"
  1949                     using B Lim_null tendsto_rabs_zero_iff by (fastforce intro!: tendsto_null_sum)
  1950                 qed
  1951                 with \<open>e > 0\<close> obtain p where "\<And>n. n \<ge> p \<Longrightarrow> \<bar>onorm ((*v) (A n - B))\<bar> < e/2"
  1952                   unfolding lim_sequentially by (metis diff_zero dist_real_def divide_pos_pos zero_less_numeral)
  1953                 then have pqe2: "\<bar>onorm ((*v) (A (p + q) - B))\<bar> < e/2" (*17 [`abs (onorm (\y. A (p + q) ** y - B ** y)) < e / &2`]*)
  1954                   using le_add1 by blast
  1955                 show "\<exists>d>0. \<forall>y\<in>S. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow>
  1956                            inverse (norm (y - x)) * norm (f y + B *v x - (f x + B *v y)) < e"
  1957                 proof (intro exI, safe)
  1958                   show "0 < \<delta>(p + q)"
  1959                     by (simp add: \<delta>)
  1960                 next
  1961                   fix y
  1962                   assume y: "y \<in> S" "norm (y - x) < \<delta>(p + q)" and "y \<noteq> x"
  1963                   have *: "\<lbrakk>norm(b - c) < e - d; norm(y - x - b) \<le> d\<rbrakk> \<Longrightarrow> norm(y - x - c) < e"
  1964                     for b c d e x and y:: "real^'n"
  1965                     using norm_triangle_ineq2 [of "y - x - c" "y - x - b"] by simp
  1966                   have "norm (f y - f x - B *v (y - x)) < e * norm (y - x)"
  1967                   proof (rule *)
  1968                     show "norm (f y - f x - A (p + q) *v (y - x)) \<le> norm (y - x) / (Suc (p + q))"
  1969                       using A [OF y] by simp
  1970                     have "norm (A (p + q) *v (y - x) - B *v (y - x)) \<le> onorm(\<lambda>x. (A(p + q) - B) *v x) * norm(y - x)"
  1971                       by (metis linear_linear matrix_vector_mul_linear matrix_vector_mult_diff_rdistrib onorm)
  1972                     also have "\<dots> < (e/2) * norm (y - x)"
  1973                       using \<open>y \<noteq> x\<close> pqe2 by auto
  1974                     also have "\<dots> \<le> (e - 1 / (Suc (p + q))) * norm (y - x)"
  1975                     proof (rule mult_right_mono)
  1976                       have "1 / Suc (p + q) \<le> 1 / q"
  1977                         using \<open>q \<noteq> 0\<close> by (auto simp: divide_simps)
  1978                       also have "\<dots> < e/2"
  1979                         using qe2 by auto
  1980                       finally show "e / 2 \<le> e - 1 / real (Suc (p + q))"
  1981                         by linarith
  1982                     qed auto
  1983                     finally show "norm (A (p + q) *v (y - x) - B *v (y - x)) < e * norm (y - x) - norm (y - x) / real (Suc (p + q))"
  1984                       by (simp add: algebra_simps)
  1985                   qed
  1986                   then show "inverse (norm (y - x)) * norm (f y + B *v x - (f x + B *v y)) < e"
  1987                     using \<open>y \<noteq> x\<close> by (simp add: divide_simps algebra_simps)
  1988                 qed
  1989               qed
  1990               then show "((\<lambda>y. (matrix (f' x) - B) *v (y - x) /\<^sub>R
  1991                            norm (y - x) - (f x + f' x (y - x) - f y) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0)
  1992                           (at x within S)"
  1993                 by (simp add: algebra_simps diff lin_df matrix_vector_mul_linear scalar_mult_eq_scaleR)
  1994             qed
  1995           qed (use x in \<open>simp; auto simp: not_less\<close>)
  1996           ultimately have "f' x = (*v) B"
  1997             by (force simp: algebra_simps scalar_mult_eq_scaleR)
  1998           show "matrix (f' x) $ m $ n \<le> b"
  1999           proof (rule tendsto_upperbound [of "\<lambda>i. (A i $ m $ n)" _ sequentially])
  2000             show "(\<lambda>i. A i $ m $ n) \<longlonglongrightarrow> matrix (f' x) $ m $ n"
  2001               by (simp add: B \<open>f' x = (*v) B\<close>)
  2002             show "\<forall>\<^sub>F i in sequentially. A i $ m $ n \<le> b"
  2003               by (simp add: Ab less_eq_real_def)
  2004           qed auto
  2005         next
  2006           fix e :: "real"
  2007           assume "x \<in> S" and b: "matrix (f' x) $ m $ n \<le> b" and "e > 0"
  2008           then obtain d where "d>0"
  2009             and d: "\<And>y. y\<in>S \<Longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow> norm (f y - f x - f' x (y - x)) / (norm (y - x))
  2010                   < e/2"
  2011             using f [OF \<open>x \<in> S\<close>] unfolding Deriv.has_derivative_at_within Lim_within
  2012             by (auto simp: field_simps dest: spec [of _ "e/2"])
  2013           let ?A = "matrix(f' x) - (\<chi> i j. if i = m \<and> j = n then e / 4 else 0)"
  2014           obtain B where BRats: "\<And>i j. B$i$j \<in> \<rat>" and Bo_e6: "onorm((*v) (?A - B)) < e/6"
  2015             using matrix_rational_approximation \<open>e > 0\<close>
  2016             by (metis zero_less_divide_iff zero_less_numeral)
  2017           show "\<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
  2018                 (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
  2019           proof (intro exI conjI ballI allI impI)
  2020             show "d>0"
  2021               by (rule \<open>d>0\<close>)
  2022             show "B $ m $ n < b"
  2023             proof -
  2024               have "\<bar>matrix ((*v) (?A - B)) $ m $ n\<bar> \<le> onorm ((*v) (?A - B))"
  2025                 using component_le_onorm [OF matrix_vector_mul_linear, of _ m n] by metis
  2026               then show ?thesis
  2027                 using b Bo_e6 by simp
  2028             qed
  2029             show "B $ i $ j \<in> \<rat>" for i j
  2030               using BRats by auto
  2031             show "norm (f y - f x - B *v (y - x)) \<le> e * norm (y - x)"
  2032               if "y \<in> S" and y: "norm (y - x) < d" for y
  2033             proof (cases "y = x")
  2034               case True then show ?thesis
  2035                 by simp
  2036             next
  2037               case False
  2038               have *: "norm(d' - d) \<le> e/2 \<Longrightarrow> norm(y - (x + d')) < e/2 \<Longrightarrow> norm(y - x - d) \<le> e" for d d' e and x y::"real^'n"
  2039                 using norm_triangle_le [of "d' - d" "y - (x + d')"] by simp
  2040               show ?thesis
  2041               proof (rule *)
  2042                 have split246: "\<lbrakk>norm y \<le> e / 6; norm(x - y) \<le> e / 4\<rbrakk> \<Longrightarrow> norm x \<le> e/2" if "e > 0" for e and x y :: "real^'n"
  2043                   using norm_triangle_le [of y "x-y" "e/2"] \<open>e > 0\<close> by simp
  2044                 have "linear (f' x)"
  2045                   using True f has_derivative_linear by blast
  2046                 then have "norm (f' x (y - x) - B *v (y - x)) = norm ((matrix (f' x) - B) *v (y - x))"
  2047                   by (simp add: matrix_vector_mult_diff_rdistrib)
  2048                 also have "\<dots> \<le> (e * norm (y - x)) / 2"
  2049                 proof (rule split246)
  2050                   have "norm ((?A - B) *v (y - x)) / norm (y - x) \<le> onorm(\<lambda>x. (?A - B) *v x)"
  2051                     by (rule le_onorm) auto
  2052                   also have  "\<dots> < e/6"
  2053                     by (rule Bo_e6)
  2054                   finally have "norm ((?A - B) *v (y - x)) / norm (y - x) < e / 6" .
  2055                   then show "norm ((?A - B) *v (y - x)) \<le> e * norm (y - x) / 6"
  2056                     by (simp add: divide_simps False)
  2057                   have "norm ((matrix (f' x) - B) *v (y - x) - ((?A - B) *v (y - x))) = norm ((\<chi> i j. if i = m \<and> j = n then e / 4 else 0) *v (y - x))"
  2058                     by (simp add: algebra_simps)
  2059                   also have "\<dots> = norm((e/4) *\<^sub>R (y - x)$n *\<^sub>R axis m (1::real))"
  2060                   proof -
  2061                     have "(\<Sum>j\<in>UNIV. (if i = m \<and> j = n then e / 4 else 0) * (y $ j - x $ j)) * 4 = e * (y $ n - x $ n) * axis m 1 $ i" for i
  2062                     proof (cases "i=m")
  2063                       case True then show ?thesis
  2064                         by (auto simp: if_distrib [of "\<lambda>z. z * _"] cong: if_cong)
  2065                     next
  2066                       case False then show ?thesis
  2067                         by (simp add: axis_def)
  2068                     qed
  2069                     then have "(\<chi> i j. if i = m \<and> j = n then e / 4 else 0) *v (y - x) = (e/4) *\<^sub>R (y - x)$n *\<^sub>R axis m (1::real)"
  2070                       by (auto simp: vec_eq_iff matrix_vector_mult_def)
  2071                     then show ?thesis
  2072                       by metis
  2073                   qed
  2074                   also have "\<dots> \<le> e * norm (y - x) / 4"
  2075                     using \<open>e > 0\<close> apply (simp add: norm_mult abs_mult)
  2076                     by (metis component_le_norm_cart vector_minus_component)
  2077                   finally show "norm ((matrix (f' x) - B) *v (y - x) - ((?A - B) *v (y - x))) \<le> e * norm (y - x) / 4" .
  2078                   show "0 < e * norm (y - x)"
  2079                     by (simp add: False \<open>e > 0\<close>)
  2080                 qed
  2081                 finally show "norm (f' x (y - x) - B *v (y - x)) \<le> (e * norm (y - x)) / 2" .
  2082                 show "norm (f y - (f x + f' x (y - x))) < (e * norm (y - x)) / 2"
  2083                   using False d [OF \<open>y \<in> S\<close>] y by (simp add: dist_norm field_simps)
  2084               qed
  2085             qed
  2086           qed
  2087         qed
  2088       qed auto
  2089     qed
  2090     show "negligible ?M"
  2091       using negligible_subset [OF nN MN] .
  2092   qed
  2093   then show ?thesis
  2094     by (simp add: borel_measurable_vimage_halfspace_component_le sets_restrict_space_iff assms)
  2095 qed
  2096 
  2097 
  2098 theorem borel_measurable_det_Jacobian:
  2099  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  2100   assumes S: "S \<in> sets lebesgue" and f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  2101   shows "(\<lambda>x. det(matrix(f' x))) \<in> borel_measurable (lebesgue_on S)"
  2102   unfolding det_def
  2103   by%unimportant (intro measurable) (auto intro: f borel_measurable_partial_derivatives [OF S])
  2104 
  2105 text\<open>The localisation wrt S uses the same argument for many similar results.\<close>
  2106 (*See HOL Light's MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL, etc.*)
  2107 theorem borel_measurable_lebesgue_on_preimage_borel:
  2108   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2109   assumes "S \<in> sets lebesgue"
  2110   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
  2111          (\<forall>T. T \<in> sets borel \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue)"
  2112 proof -
  2113   have "{x. (if x \<in> S then f x else 0) \<in> T} \<in> sets lebesgue \<longleftrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue"
  2114          if "T \<in> sets borel" for T
  2115     proof (cases "0 \<in> T")
  2116       case True
  2117       then have "{x \<in> S. f x \<in> T} = {x. (if x \<in> S then f x else 0) \<in> T} \<inter> S"
  2118                 "{x. (if x \<in> S then f x else 0) \<in> T} = {x \<in> S. f x \<in> T} \<union> -S"
  2119         by auto
  2120       then show ?thesis
  2121         by (metis (no_types, lifting) Compl_in_sets_lebesgue assms sets.Int sets.Un)
  2122     next
  2123       case False
  2124       then have "{x. (if x \<in> S then f x else 0) \<in> T} = {x \<in> S. f x \<in> T}"
  2125         by auto
  2126       then show ?thesis
  2127         by auto
  2128     qed
  2129     then show ?thesis
  2130       unfolding borel_measurable_lebesgue_preimage_borel borel_measurable_UNIV [OF assms, symmetric]
  2131       by blast
  2132 qed
  2133 
  2134 lemma sets_lebesgue_almost_borel:
  2135   assumes "S \<in> sets lebesgue"
  2136   obtains B N where "B \<in> sets borel" "negligible N" "B \<union> N = S"
  2137 proof -
  2138   obtain T N N' where "S = T \<union> N" "N \<subseteq> N'" "N' \<in> null_sets lborel" "T \<in> sets borel"
  2139     using sets_completionE [OF assms] by auto
  2140   then show thesis
  2141     by (metis negligible_iff_null_sets negligible_subset null_sets_completionI that)
  2142 qed
  2143 
  2144 lemma double_lebesgue_sets:
  2145  assumes S: "S \<in> sets lebesgue" and T: "T \<in> sets lebesgue" and fim: "f ` S \<subseteq> T"
  2146  shows "(\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue) \<longleftrightarrow>
  2147           f \<in> borel_measurable (lebesgue_on S) \<and>
  2148           (\<forall>U. negligible U \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue)"
  2149          (is "?lhs \<longleftrightarrow> _ \<and> ?rhs")
  2150   unfolding borel_measurable_lebesgue_on_preimage_borel [OF S]
  2151 proof (intro iffI allI conjI impI, safe)
  2152   fix V :: "'b set"
  2153   assume *: "\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
  2154     and "V \<in> sets borel"
  2155   then have V: "V \<in> sets lebesgue"
  2156     by simp
  2157   have "{x \<in> S. f x \<in> V} = {x \<in> S. f x \<in> T \<inter> V}"
  2158     using fim by blast
  2159   also have "{x \<in> S. f x \<in> T \<inter> V} \<in> sets lebesgue"
  2160     using T V * le_inf_iff by blast
  2161   finally show "{x \<in> S. f x \<in> V} \<in> sets lebesgue" .
  2162 next
  2163   fix U :: "'b set"
  2164   assume "\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
  2165          "negligible U" "U \<subseteq> T"
  2166   then show "{x \<in> S. f x \<in> U} \<in> sets lebesgue"
  2167     using negligible_imp_sets by blast
  2168 next
  2169   fix U :: "'b set"
  2170   assume 1 [rule_format]: "(\<forall>T. T \<in> sets borel \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue)"
  2171      and 2 [rule_format]: "\<forall>U. negligible U \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
  2172      and "U \<in> sets lebesgue" "U \<subseteq> T"
  2173   then obtain C N where C: "C \<in> sets borel \<and> negligible N \<and> C \<union> N = U"
  2174     using sets_lebesgue_almost_borel
  2175     by metis
  2176   then have "{x \<in> S. f x \<in> C} \<in> sets lebesgue"
  2177     by (blast intro: 1)
  2178   moreover have "{x \<in> S. f x \<in> N} \<in> sets lebesgue"
  2179     using C \<open>U \<subseteq> T\<close> by (blast intro: 2)
  2180   moreover have "{x \<in> S. f x \<in> C \<union> N} = {x \<in> S. f x \<in> C} \<union> {x \<in> S. f x \<in> N}"
  2181     by auto
  2182   ultimately show "{x \<in> S. f x \<in> U} \<in> sets lebesgue"
  2183     using C by auto
  2184 qed
  2185 
  2186 
  2187 subsection\<open>Simplest case of Sard's theorem (we don't need continuity of derivative)\<close>
  2188 
  2189 lemma Sard_lemma00:
  2190   fixes P :: "'b::euclidean_space set"
  2191   assumes "a \<ge> 0" and a: "a *\<^sub>R i \<noteq> 0" and i: "i \<in> Basis"
  2192     and P: "P \<subseteq> {x. a *\<^sub>R i \<bullet> x = 0}"
  2193     and "0 \<le> m" "0 \<le> e"
  2194  obtains S where "S \<in> lmeasurable"
  2195             and "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
  2196             and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (DIM('b) - 1)"
  2197 proof -
  2198   have "a > 0"
  2199     using assms by simp
  2200   let ?v = "(\<Sum>j\<in>Basis. (if j = i then e else m) *\<^sub>R j)"
  2201   show thesis
  2202   proof
  2203     have "- e \<le> x \<bullet> i" "x \<bullet> i \<le> e"
  2204       if "t \<in> P" "norm (x - t) \<le> e" for x t
  2205       using \<open>a > 0\<close> that Basis_le_norm [of i "x-t"] P i
  2206       by (auto simp: inner_commute algebra_simps)
  2207     moreover have "- m \<le> x \<bullet> j" "x \<bullet> j \<le> m"
  2208       if "norm x \<le> m" "t \<in> P" "norm (x - t) \<le> e" "j \<in> Basis" and "j \<noteq> i"
  2209       for x t j
  2210       using that Basis_le_norm [of j x] by auto
  2211     ultimately
  2212     show "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> cbox (-?v) ?v"
  2213       by (auto simp: mem_box)
  2214     have *: "\<forall>k\<in>Basis. - ?v \<bullet> k \<le> ?v \<bullet> k"
  2215       using \<open>0 \<le> m\<close> \<open>0 \<le> e\<close> by (auto simp: inner_Basis)
  2216     have 2: "2 ^ DIM('b) = 2 * 2 ^ (DIM('b) - Suc 0)"
  2217       by (metis DIM_positive Suc_pred power_Suc)
  2218     show "measure lebesgue (cbox (-?v) ?v) \<le> 2 * e * (2 * m) ^ (DIM('b) - 1)"
  2219       using \<open>i \<in> Basis\<close>
  2220       by (simp add: content_cbox [OF *] prod.distrib prod.If_cases Diff_eq [symmetric] 2)
  2221   qed blast
  2222 qed
  2223 
  2224 text\<open>As above, but reorienting the vector (HOL Light's @text{GEOM\_BASIS\_MULTIPLE\_TAC})\<close>
  2225 lemma Sard_lemma0:
  2226   fixes P :: "(real^'n::{finite,wellorder}) set"
  2227   assumes "a \<noteq> 0"
  2228     and P: "P \<subseteq> {x. a \<bullet> x = 0}" and "0 \<le> m" "0 \<le> e"
  2229   obtains S where "S \<in> lmeasurable"
  2230     and "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
  2231     and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
  2232 proof -
  2233   obtain T and k::'n where T: "orthogonal_transformation T" and a: "a = T (norm a *\<^sub>R axis k (1::real))"
  2234     using rotation_rightward_line by metis
  2235   have Tinv [simp]: "T (inv T x) = x" for x
  2236     by (simp add: T orthogonal_transformation_surj surj_f_inv_f)
  2237   obtain S where S: "S \<in> lmeasurable"
  2238     and subS: "{z. norm z \<le> m \<and> (\<exists>t \<in> T-`P. norm(z - t) \<le> e)} \<subseteq> S"
  2239     and mS: "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
  2240   proof (rule Sard_lemma00 [of "norm a" "axis k (1::real)" "T-`P" m e])
  2241     have "norm a *\<^sub>R axis k 1 \<bullet> x = 0" if "T x \<in> P" for x
  2242     proof -
  2243       have "a \<bullet> T x = 0"
  2244         using P that by blast
  2245       then show ?thesis
  2246         by (metis (no_types, lifting) T a orthogonal_orthogonal_transformation orthogonal_def)
  2247     qed
  2248     then show "T -` P \<subseteq> {x. norm a *\<^sub>R axis k 1 \<bullet> x = 0}"
  2249       by auto
  2250   qed (use assms T in auto)
  2251   show thesis
  2252   proof
  2253     show "T ` S \<in> lmeasurable"
  2254       using S measurable_orthogonal_image T by blast
  2255     have "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> T ` {z. norm z \<le> m \<and> (\<exists>t\<in>T -` P. norm (z - t) \<le> e)}"
  2256     proof clarsimp
  2257       fix x t
  2258       assume "norm x \<le> m" "t \<in> P" "norm (x - t) \<le> e"
  2259       then have "norm (inv T x) \<le> m"
  2260         using orthogonal_transformation_inv [OF T] by (simp add: orthogonal_transformation_norm)
  2261       moreover have "\<exists>t\<in>T -` P. norm (inv T x - t) \<le> e"
  2262       proof
  2263         have "T (inv T x - inv T t) = x - t"
  2264           using T linear_diff orthogonal_transformation_def
  2265           by (metis (no_types, hide_lams) Tinv)
  2266         then have "norm (inv T x - inv T t) = norm (x - t)"
  2267           by (metis T orthogonal_transformation_norm)
  2268         then show "norm (inv T x - inv T t) \<le> e"
  2269           using \<open>norm (x - t) \<le> e\<close> by linarith
  2270        next
  2271          show "inv T t \<in> T -` P"
  2272            using \<open>t \<in> P\<close> by force
  2273       qed
  2274       ultimately show "x \<in> T ` {z. norm z \<le> m \<and> (\<exists>t\<in>T -` P. norm (z - t) \<le> e)}"
  2275         by force
  2276     qed
  2277     then show "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> T ` S"
  2278       using image_mono [OF subS] by (rule order_trans)
  2279     show "measure lebesgue (T ` S) \<le> 2 * e * (2 * m) ^ (CARD('n) - 1)"
  2280       using mS T by (simp add: S measure_orthogonal_image)
  2281   qed
  2282 qed
  2283 
  2284 text\<open>As above, but translating the sets (HOL Light's @text{GEN\_GEOM\_ORIGIN\_TAC})\<close>
  2285 lemma Sard_lemma1:
  2286   fixes P :: "(real^'n::{finite,wellorder}) set"
  2287    assumes P: "dim P < CARD('n)" and "0 \<le> m" "0 \<le> e"
  2288  obtains S where "S \<in> lmeasurable"
  2289             and "{z. norm(z - w) \<le> m \<and> (\<exists>t \<in> P. norm(z - w - t) \<le> e)} \<subseteq> S"
  2290             and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
  2291 proof -
  2292   obtain a where "a \<noteq> 0" "P \<subseteq> {x. a \<bullet> x = 0}"
  2293     using lowdim_subset_hyperplane [of P] P span_base by auto
  2294   then obtain S where S: "S \<in> lmeasurable"
  2295     and subS: "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
  2296     and mS: "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
  2297     by (rule Sard_lemma0 [OF _ _ \<open>0 \<le> m\<close> \<open>0 \<le> e\<close>])
  2298   show thesis
  2299   proof
  2300     show "(+)w ` S \<in> lmeasurable"
  2301       by (metis measurable_translation S)
  2302     show "{z. norm (z - w) \<le> m \<and> (\<exists>t\<in>P. norm (z - w - t) \<le> e)} \<subseteq> (+)w ` S"
  2303       using subS by force
  2304     show "measure lebesgue ((+)w ` S) \<le> 2 * e * (2 * m) ^ (CARD('n) - 1)"
  2305       by (metis measure_translation mS)
  2306   qed
  2307 qed
  2308 
  2309 lemma Sard_lemma2:
  2310   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n::{finite,wellorder}"
  2311   assumes mlen: "CARD('m) \<le> CARD('n)" (is "?m \<le> ?n")
  2312     and "B > 0" "bounded S"
  2313     and derS: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  2314     and rank: "\<And>x. x \<in> S \<Longrightarrow> rank(matrix(f' x)) < CARD('n)"
  2315     and B: "\<And>x. x \<in> S \<Longrightarrow> onorm(f' x) \<le> B"
  2316   shows "negligible(f ` S)"
  2317 proof -
  2318   have lin_f': "\<And>x. x \<in> S \<Longrightarrow> linear(f' x)"
  2319     using derS has_derivative_linear by blast
  2320   show ?thesis
  2321   proof (clarsimp simp add: negligible_outer_le)
  2322     fix e :: "real"
  2323     assume "e > 0"
  2324     obtain c where csub: "S \<subseteq> cbox (- (vec c)) (vec c)" and "c > 0"
  2325     proof -
  2326       obtain b where b: "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> b"
  2327         using \<open>bounded S\<close> by (auto simp: bounded_iff)
  2328       show thesis
  2329       proof
  2330         have "- \<bar>b\<bar> - 1 \<le> x $ i \<and> x $ i \<le> \<bar>b\<bar> + 1" if "x \<in> S" for x i
  2331           using component_le_norm_cart [of x i] b [OF that] by auto
  2332         then show "S \<subseteq> cbox (- vec (\<bar>b\<bar> + 1)) (vec (\<bar>b\<bar> + 1))"
  2333           by (auto simp: mem_box_cart)
  2334       qed auto
  2335     qed
  2336     then have box_cc: "box (- (vec c)) (vec c) \<noteq> {}" and cbox_cc: "cbox (- (vec c)) (vec c) \<noteq> {}"
  2337       by (auto simp: interval_eq_empty_cart)
  2338     obtain d where "d > 0" "d \<le> B"
  2339              and d: "(d * 2) * (4 * B) ^ (?n - 1) \<le> e / (2*c) ^ ?m / ?m ^ ?m"
  2340       apply (rule that [of "min B (e / (2*c) ^ ?m / ?m ^ ?m / (4 * B) ^ (?n - 1) / 2)"])
  2341       using \<open>B > 0\<close> \<open>c > 0\<close> \<open>e > 0\<close>
  2342       by (simp_all add: divide_simps min_mult_distrib_right)
  2343     have "\<exists>r. 0 < r \<and> r \<le> 1/2 \<and>
  2344               (x \<in> S
  2345                \<longrightarrow> (\<forall>y. y \<in> S \<and> norm(y - x) < r
  2346                        \<longrightarrow> norm(f y - f x - f' x (y - x)) \<le> d * norm(y - x)))" for x
  2347     proof (cases "x \<in> S")
  2348       case True
  2349       then obtain r where "r > 0"
  2350               and "\<And>y. \<lbrakk>y \<in> S; norm (y - x) < r\<rbrakk>
  2351                        \<Longrightarrow> norm (f y - f x - f' x (y - x)) \<le> d * norm (y - x)"
  2352         using derS \<open>d > 0\<close> by (force simp: has_derivative_within_alt)
  2353       then show ?thesis
  2354         by (rule_tac x="min r (1/2)" in exI) simp
  2355     next
  2356       case False
  2357       then show ?thesis
  2358         by (rule_tac x="1/2" in exI) simp
  2359     qed
  2360     then obtain r where r12: "\<And>x. 0 < r x \<and> r x \<le> 1/2"
  2361             and r: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S; norm(y - x) < r x\<rbrakk>
  2362                           \<Longrightarrow> norm(f y - f x - f' x (y - x)) \<le> d * norm(y - x)"
  2363       by metis
  2364     then have ga: "gauge (\<lambda>x. ball x (r x))"
  2365       by (auto simp: gauge_def)
  2366     obtain \<D> where \<D>: "countable \<D>" and sub_cc: "\<Union>\<D> \<subseteq> cbox (- vec c) (vec c)"
  2367       and cbox: "\<And>K. K \<in> \<D> \<Longrightarrow> interior K \<noteq> {} \<and> (\<exists>u v. K = cbox u v)"
  2368       and djointish: "pairwise (\<lambda>A B. interior A \<inter> interior B = {}) \<D>"
  2369       and covered: "\<And>K. K \<in> \<D> \<Longrightarrow> \<exists>x \<in> S \<inter> K. K \<subseteq> ball x (r x)"
  2370       and close: "\<And>u v. cbox u v \<in> \<D> \<Longrightarrow> \<exists>n. \<forall>i::'m. v $ i - u $ i = 2*c / 2^n"
  2371       and covers: "S \<subseteq> \<Union>\<D>"
  2372       apply (rule covering_lemma [OF csub box_cc ga])
  2373       apply (auto simp: Basis_vec_def cart_eq_inner_axis [symmetric])
  2374       done
  2375     let ?\<mu> = "measure lebesgue"
  2376     have "\<exists>T. T \<in> lmeasurable \<and> f ` (K \<inter> S) \<subseteq> T \<and> ?\<mu> T \<le> e / (2*c) ^ ?m * ?\<mu> K"
  2377       if "K \<in> \<D>" for K
  2378     proof -
  2379       obtain u v where uv: "K = cbox u v"
  2380         using cbox \<open>K \<in> \<D>\<close> by blast
  2381       then have uv_ne: "cbox u v \<noteq> {}"
  2382         using cbox that by fastforce
  2383       obtain x where x: "x \<in> S \<inter> cbox u v" "cbox u v \<subseteq> ball x (r x)"
  2384         using \<open>K \<in> \<D>\<close> covered uv by blast
  2385       then have "dim (range (f' x)) < ?n"
  2386         using rank_dim_range [of "matrix (f' x)"] x rank[of x]
  2387         by (auto simp: matrix_works scalar_mult_eq_scaleR lin_f')
  2388       then obtain T where T: "T \<in> lmeasurable"
  2389             and subT: "{z. norm(z - f x) \<le> (2 * B) * norm(v - u) \<and> (\<exists>t \<in> range (f' x). norm(z - f x - t) \<le> d * norm(v - u))} \<subseteq> T"
  2390             and measT: "?\<mu> T \<le> (2 * (d * norm(v - u))) * (2 * ((2 * B) * norm(v - u))) ^ (?n - 1)"
  2391                         (is "_ \<le> ?DVU")
  2392         apply (rule Sard_lemma1 [of "range (f' x)" "(2 * B) * norm(v - u)" "d * norm(v - u)" "f x"])
  2393         using \<open>B > 0\<close> \<open>d > 0\<close> by simp_all
  2394       show ?thesis
  2395       proof (intro exI conjI)
  2396         have "f ` (K \<inter> S) \<subseteq> {z. norm(z - f x) \<le> (2 * B) * norm(v - u) \<and> (\<exists>t \<in> range (f' x). norm(z - f x - t) \<le> d * norm(v - u))}"
  2397           unfolding uv
  2398         proof (clarsimp simp: mult.assoc, intro conjI)
  2399           fix y
  2400           assume y: "y \<in> cbox u v" and "y \<in> S"
  2401           then have "norm (y - x) < r x"
  2402             by (metis dist_norm mem_ball norm_minus_commute subsetCE x(2))
  2403           then have le_dyx: "norm (f y - f x - f' x (y - x)) \<le> d * norm (y - x)"
  2404             using r [of x y] x \<open>y \<in> S\<close> by blast
  2405           have yx_le: "norm (y - x) \<le> norm (v - u)"
  2406           proof (rule norm_le_componentwise_cart)
  2407             show "norm ((y - x) $ i) \<le> norm ((v - u) $ i)" for i
  2408               using x y by (force simp: mem_box_cart dest!: spec [where x=i])
  2409           qed
  2410           have *: "\<lbrakk>norm(y - x - z) \<le> d; norm z \<le> B; d \<le> B\<rbrakk> \<Longrightarrow> norm(y - x) \<le> 2 * B"
  2411             for x y z :: "real^'n::_" and d B
  2412             using norm_triangle_ineq2 [of "y - x" z] by auto
  2413           show "norm (f y - f x) \<le> 2 * (B * norm (v - u))"
  2414           proof (rule * [OF le_dyx])
  2415             have "norm (f' x (y - x)) \<le> onorm (f' x) * norm (y - x)"
  2416               using onorm [of "f' x" "y-x"] by (meson IntE lin_f' linear_linear x(1))
  2417             also have "\<dots> \<le> B * norm (v - u)"
  2418             proof (rule mult_mono)
  2419               show "onorm (f' x) \<le> B"
  2420                 using B x by blast
  2421             qed (use \<open>B > 0\<close> yx_le in auto)
  2422             finally show "norm (f' x (y - x)) \<le> B * norm (v - u)" .
  2423             show "d * norm (y - x) \<le> B * norm (v - u)"
  2424               using \<open>B > 0\<close> by (auto intro: mult_mono [OF \<open>d \<le> B\<close> yx_le])
  2425           qed
  2426           show "\<exists>t. norm (f y - f x - f' x t) \<le> d * norm (v - u)"
  2427             apply (rule_tac x="y-x" in exI)
  2428             using \<open>d > 0\<close> yx_le le_dyx mult_left_mono [where c=d]
  2429             by (meson order_trans real_mult_le_cancel_iff2)
  2430         qed
  2431         with subT show "f ` (K \<inter> S) \<subseteq> T" by blast
  2432         show "?\<mu> T \<le> e / (2*c) ^ ?m * ?\<mu> K"
  2433         proof (rule order_trans [OF measT])
  2434           have "?DVU = (d * 2 * (4 * B) ^ (?n - 1)) * norm (v - u)^?n"
  2435             using \<open>c > 0\<close>
  2436             apply (simp add: algebra_simps power_mult_distrib)
  2437             by (metis Suc_pred power_Suc zero_less_card_finite)
  2438           also have "\<dots> \<le> (e / (2*c) ^ ?m / (?m ^ ?m)) * norm(v - u) ^ ?n"
  2439             by (rule mult_right_mono [OF d]) auto
  2440           also have "\<dots> \<le> e / (2*c) ^ ?m * ?\<mu> K"
  2441           proof -
  2442             have "u \<in> ball (x) (r x)" "v \<in> ball x (r x)"
  2443               using box_ne_empty(1) contra_subsetD [OF x(2)] mem_box(2) uv_ne by fastforce+
  2444             moreover have "r x \<le> 1/2"
  2445               using r12 by auto
  2446             ultimately have "norm (v - u) \<le> 1"
  2447               using norm_triangle_half_r [of x u 1 v]
  2448               by (metis (no_types, hide_lams) dist_commute dist_norm less_eq_real_def less_le_trans mem_ball)
  2449             then have "norm (v - u) ^ ?n \<le> norm (v - u) ^ ?m"
  2450               by (simp add: power_decreasing [OF mlen])
  2451             also have "\<dots> \<le> ?\<mu> K * real (?m ^ ?m)"
  2452             proof -
  2453               obtain n where n: "\<And>i. v$i - u$i = 2 * c / 2^n"
  2454                 using close [of u v] \<open>K \<in> \<D>\<close> uv by blast
  2455               have "norm (v - u) ^ ?m \<le> (\<Sum>i\<in>UNIV. \<bar>(v - u) $ i\<bar>) ^ ?m"
  2456                 by (intro norm_le_l1_cart power_mono) auto
  2457               also have "\<dots> \<le> (\<Prod>i\<in>UNIV. v $ i - u $ i) * real CARD('m) ^ CARD('m)"
  2458                 by (simp add: n field_simps \<open>c > 0\<close> less_eq_real_def)
  2459               also have "\<dots> = ?\<mu> K * real (?m ^ ?m)"
  2460                 by (simp add: uv uv_ne content_cbox_cart)
  2461               finally show ?thesis .
  2462             qed
  2463             finally have *: "1 / real (?m ^ ?m) * norm (v - u) ^ ?n \<le> ?\<mu> K"
  2464               by (simp add: divide_simps)
  2465             show ?thesis
  2466               using mult_left_mono [OF *, of "e / (2*c) ^ ?m"] \<open>c > 0\<close> \<open>e > 0\<close> by auto
  2467           qed
  2468           finally show "?DVU \<le> e / (2*c) ^ ?m * ?\<mu> K" .
  2469         qed
  2470       qed (use T in auto)
  2471     qed
  2472     then obtain g where meas_g: "\<And>K. K \<in> \<D> \<Longrightarrow> g K \<in> lmeasurable"
  2473                     and sub_g: "\<And>K. K \<in> \<D> \<Longrightarrow> f ` (K \<inter> S) \<subseteq> g K"
  2474                     and le_g: "\<And>K. K \<in> \<D> \<Longrightarrow> ?\<mu> (g K) \<le> e / (2*c)^?m * ?\<mu> K"
  2475       by metis
  2476     have le_e: "?\<mu> (\<Union>i\<in>\<F>. g i) \<le> e"
  2477       if "\<F> \<subseteq> \<D>" "finite \<F>" for \<F>
  2478     proof -
  2479       have "?\<mu> (\<Union>i\<in>\<F>. g i) \<le> (\<Sum>i\<in>\<F>. ?\<mu> (g i))"
  2480         using meas_g \<open>\<F> \<subseteq> \<D>\<close> by (auto intro: measure_UNION_le [OF \<open>finite \<F>\<close>])
  2481       also have "\<dots> \<le> (\<Sum>K\<in>\<F>. e / (2*c) ^ ?m * ?\<mu> K)"
  2482         using \<open>\<F> \<subseteq> \<D>\<close> sum_mono [OF le_g] by (meson le_g subsetCE sum_mono)
  2483       also have "\<dots> = e / (2*c) ^ ?m * (\<Sum>K\<in>\<F>. ?\<mu> K)"
  2484         by (simp add: sum_distrib_left)
  2485       also have "\<dots> \<le> e"
  2486       proof -
  2487         have "\<F> division_of \<Union>\<F>"
  2488         proof (rule division_ofI)
  2489           show "K \<subseteq> \<Union>\<F>"  "K \<noteq> {}" "\<exists>a b. K = cbox a b" if "K \<in> \<F>" for K
  2490             using \<open>K \<in> \<F>\<close> covered cbox \<open>\<F> \<subseteq> \<D>\<close> by (auto simp: Union_upper)
  2491           show "interior K \<inter> interior L = {}" if "K \<in> \<F>" and "L \<in> \<F>" and "K \<noteq> L" for K L
  2492             by (metis (mono_tags, lifting) \<open>\<F> \<subseteq> \<D>\<close> pairwiseD djointish pairwise_subset that)
  2493         qed (use that in auto)
  2494         then have "sum ?\<mu> \<F> \<le> ?\<mu> (\<Union>\<F>)"
  2495           by (simp add: content_division)
  2496         also have "\<dots> \<le> ?\<mu> (cbox (- vec c) (vec c) :: (real, 'm) vec set)"
  2497         proof (rule measure_mono_fmeasurable)
  2498           show "\<Union>\<F> \<subseteq> cbox (- vec c) (vec c)"
  2499             by (meson Sup_subset_mono sub_cc order_trans \<open>\<F> \<subseteq> \<D>\<close>)
  2500         qed (use \<open>\<F> division_of \<Union>\<F>\<close> lmeasurable_division in auto)
  2501         also have "\<dots> = content (cbox (- vec c) (vec c) :: (real, 'm) vec set)"
  2502           by simp
  2503         also have "\<dots> \<le> (2 ^ ?m * c ^ ?m)"
  2504           using \<open>c > 0\<close> by (simp add: content_cbox_if_cart)
  2505         finally have "sum ?\<mu> \<F> \<le> (2 ^ ?m * c ^ ?m)" .
  2506         then show ?thesis
  2507           using \<open>e > 0\<close> \<open>c > 0\<close> by (auto simp: divide_simps mult_less_0_iff)
  2508       qed
  2509       finally show ?thesis .
  2510     qed
  2511     show "\<exists>T. f ` S \<subseteq> T \<and> T \<in> lmeasurable \<and> ?\<mu> T \<le> e"
  2512     proof (intro exI conjI)
  2513       show "f ` S \<subseteq> \<Union> (g ` \<D>)"
  2514         using covers sub_g by force
  2515       show "\<Union> (g ` \<D>) \<in> lmeasurable"
  2516         by (rule fmeasurable_UN_bound [OF \<open>countable \<D>\<close> meas_g le_e])
  2517       show "?\<mu> (\<Union> (g ` \<D>)) \<le> e"
  2518         by (rule measure_UN_bound [OF \<open>countable \<D>\<close> meas_g le_e])
  2519     qed
  2520   qed
  2521 qed
  2522 
  2523 
  2524 theorem baby_Sard:
  2525   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n::{finite,wellorder}"
  2526   assumes mlen: "CARD('m) \<le> CARD('n)"
  2527     and der: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  2528     and rank: "\<And>x. x \<in> S \<Longrightarrow> rank(matrix(f' x)) < CARD('n)"
  2529   shows "negligible(f ` S)"
  2530 proof -
  2531   let ?U = "\<lambda>n. {x \<in> S. norm(x) \<le> n \<and> onorm(f' x) \<le> real n}"
  2532   have "\<And>x. x \<in> S \<Longrightarrow> \<exists>n. norm x \<le> real n \<and> onorm (f' x) \<le> real n"
  2533     by (meson linear order_trans real_arch_simple)
  2534   then have eq: "S = (\<Union>n. ?U n)"
  2535     by auto
  2536   have "negligible (f ` ?U n)" for n
  2537   proof (rule Sard_lemma2 [OF mlen])
  2538     show "0 < real n + 1"
  2539       by auto
  2540     show "bounded (?U n)"
  2541       using bounded_iff by blast
  2542     show "(f has_derivative f' x) (at x within ?U n)" if "x \<in> ?U n" for x
  2543       using der that by (force intro: has_derivative_subset)
  2544   qed (use rank in auto)
  2545   then show ?thesis
  2546     by (subst eq) (simp add: image_Union negligible_Union_nat)
  2547 qed
  2548 
  2549 
  2550 subsection\<open>A one-way version of change-of-variables not assuming injectivity. \<close>
  2551 
  2552 lemma integral_on_image_ubound_weak:
  2553   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real"
  2554   assumes S: "S \<in> sets lebesgue"
  2555       and f: "f \<in> borel_measurable (lebesgue_on (g ` S))"
  2556       and nonneg_fg:  "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
  2557       and der_g:   "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2558       and det_int_fg: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
  2559       and meas_gim: "\<And>T. \<lbrakk>T \<subseteq> g ` S; T \<in> sets lebesgue\<rbrakk> \<Longrightarrow> {x \<in> S. g x \<in> T} \<in> sets lebesgue"
  2560     shows "f integrable_on (g ` S) \<and>
  2561            integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
  2562          (is "_ \<and> _ \<le> ?b")
  2563 proof -
  2564   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar>"
  2565   have cont_g: "continuous_on S g"
  2566     using der_g has_derivative_continuous_on by blast
  2567   have [simp]: "space (lebesgue_on S) = S"
  2568     by (simp add: S)
  2569   have gS_in_sets_leb: "g ` S \<in> sets lebesgue"
  2570     apply (rule differentiable_image_in_sets_lebesgue)
  2571     using der_g by (auto simp: S differentiable_def differentiable_on_def)
  2572   obtain h where nonneg_h: "\<And>n x. 0 \<le> h n x"
  2573     and h_le_f: "\<And>n x. x \<in> S \<Longrightarrow> h n (g x) \<le> f (g x)"
  2574     and h_inc: "\<And>n x. h n x \<le> h (Suc n) x"
  2575     and h_meas: "\<And>n. h n \<in> borel_measurable lebesgue"
  2576     and fin_R: "\<And>n. finite(range (h n))"
  2577     and lim: "\<And>x. x \<in> g ` S \<Longrightarrow> (\<lambda>n. h n x) \<longlonglongrightarrow> f x"
  2578   proof -
  2579     let ?f = "\<lambda>x. if x \<in> g ` S then f x else 0"
  2580     have "?f \<in> borel_measurable lebesgue \<and> (\<forall>x. 0 \<le> ?f x)"
  2581       by (auto simp: gS_in_sets_leb f nonneg_fg measurable_restrict_space_iff [symmetric])
  2582     then show ?thesis
  2583       apply (clarsimp simp add: borel_measurable_simple_function_limit_increasing)
  2584       apply (rename_tac h)
  2585       by (rule_tac h=h in that) (auto split: if_split_asm)
  2586   qed
  2587   have h_lmeas: "{t. h n (g t) = y} \<inter> S \<in> sets lebesgue" for y n
  2588   proof -
  2589     have "space (lebesgue_on (UNIV::(real,'n) vec set)) = UNIV"
  2590       by simp
  2591     then have "((h n) -`{y} \<inter> g ` S) \<in> sets (lebesgue_on (g ` S))"
  2592       by (metis Int_commute borel_measurable_vimage h_meas image_eqI inf_top.right_neutral sets_restrict_space space_borel space_completion space_lborel)
  2593     then have "({u. h n u = y} \<inter> g ` S) \<in> sets lebesgue"
  2594       using gS_in_sets_leb
  2595       by (simp add: integral_indicator fmeasurableI2 sets_restrict_space_iff vimage_def)
  2596     then have "{x \<in> S. g x \<in> ({u. h n u = y} \<inter> g ` S)} \<in> sets lebesgue"
  2597       using meas_gim[of "({u. h n u = y} \<inter> g ` S)"] by force
  2598     moreover have "{t. h n (g t) = y} \<inter> S = {x \<in> S. g x \<in> ({u. h n u = y} \<inter> g ` S)}"
  2599       by blast
  2600     ultimately show ?thesis
  2601       by auto
  2602   qed
  2603   have hint: "h n integrable_on g ` S \<and> integral (g ` S) (h n) \<le> integral S (\<lambda>x. ?D x * h n (g x))"
  2604           (is "?INT \<and> ?lhs \<le> ?rhs")  for n
  2605   proof -
  2606     let ?R = "range (h n)"
  2607     have hn_eq: "h n = (\<lambda>x. \<Sum>y\<in>?R. y * indicat_real {x. h n x = y} x)"
  2608       by (simp add: indicator_def if_distrib fin_R cong: if_cong)
  2609     have yind: "(\<lambda>t. y * indicator{x. h n x = y} t) integrable_on (g ` S) \<and>
  2610                 (integral (g ` S) (\<lambda>t. y * indicator {x. h n x = y} t))
  2611                  \<le> integral S (\<lambda>t. \<bar>det (matrix (g' t))\<bar> * y * indicator {x. h n x = y} (g t))"
  2612        if y: "y \<in> ?R" for y::real
  2613     proof (cases "y=0")
  2614       case True
  2615       then show ?thesis using gS_in_sets_leb integrable_0 by force
  2616     next
  2617       case False
  2618       with that have "y > 0"
  2619         using less_eq_real_def nonneg_h by fastforce
  2620       have "(\<lambda>x. if x \<in> {t. h n (g t) = y} then ?D x else 0) integrable_on S"
  2621       proof (rule measurable_bounded_by_integrable_imp_integrable)
  2622         have "(\<lambda>x. ?D x) \<in> borel_measurable (lebesgue_on ({t. h n (g t) = y} \<inter> S))"
  2623           apply (intro borel_measurable_abs borel_measurable_det_Jacobian [OF h_lmeas, where f=g])
  2624           by (meson der_g IntD2 has_derivative_within_subset inf_le2)
  2625         then have "(\<lambda>x. if x \<in> {t. h n (g t) = y} \<inter> S then ?D x else 0) \<in> borel_measurable lebesgue"
  2626           by (rule borel_measurable_If_I [OF _ h_lmeas])
  2627         then show "(\<lambda>x. if x \<in> {t. h n (g t) = y} then ?D x else 0) \<in> borel_measurable (lebesgue_on S)"
  2628           by (simp add: if_if_eq_conj Int_commute borel_measurable_UNIV [OF S, symmetric])
  2629         show "(\<lambda>x. ?D x *\<^sub>R f (g x) /\<^sub>R y) integrable_on S"
  2630           by (rule integrable_cmul) (use det_int_fg in auto)
  2631         show "norm (if x \<in> {t. h n (g t) = y} then ?D x else 0) \<le> ?D x *\<^sub>R f (g x) /\<^sub>R y"
  2632           if "x \<in> S" for x
  2633           using nonneg_h [of n x] \<open>y > 0\<close> nonneg_fg [of x] h_le_f [of x n] that
  2634           by (auto simp: divide_simps ordered_semiring_class.mult_left_mono)
  2635       qed (use S in auto)
  2636       then have int_det: "(\<lambda>t. \<bar>det (matrix (g' t))\<bar>) integrable_on ({t. h n (g t) = y} \<inter> S)"
  2637         using integrable_restrict_Int by force
  2638       have "(g ` ({t. h n (g t) = y} \<inter> S)) \<in> lmeasurable"
  2639         apply (rule measurable_differentiable_image [OF h_lmeas])
  2640          apply (blast intro: has_derivative_within_subset [OF der_g])
  2641         apply (rule int_det)
  2642         done
  2643       moreover have "g ` ({t. h n (g t) = y} \<inter> S) = {x. h n x = y} \<inter> g ` S"
  2644         by blast
  2645       moreover have "measure lebesgue (g ` ({t. h n (g t) = y} \<inter> S))
  2646                      \<le> integral ({t. h n (g t) = y} \<inter> S) (\<lambda>t. \<bar>det (matrix (g' t))\<bar>)"
  2647         apply (rule measure_differentiable_image [OF h_lmeas _ int_det])
  2648         apply (blast intro: has_derivative_within_subset [OF der_g])
  2649         done
  2650       ultimately show ?thesis
  2651         using \<open>y > 0\<close> integral_restrict_Int [of S "{t. h n (g t) = y}" "\<lambda>t. \<bar>det (matrix (g' t))\<bar> * y"]
  2652         apply (simp add: integrable_on_indicator integrable_on_cmult_iff integral_indicator)
  2653         apply (simp add: indicator_def if_distrib cong: if_cong)
  2654         done
  2655     qed
  2656     have hn_int: "h n integrable_on g ` S"
  2657       apply (subst hn_eq)
  2658       using yind by (force intro: integrable_sum [OF fin_R])
  2659     then show ?thesis
  2660     proof
  2661       have "?lhs = integral (g ` S) (\<lambda>x. \<Sum>y\<in>range (h n). y * indicat_real {x. h n x = y} x)"
  2662         by (metis hn_eq)
  2663       also have "\<dots> = (\<Sum>y\<in>range (h n). integral (g ` S) (\<lambda>x. y * indicat_real {x. h n x = y} x))"
  2664         by (rule integral_sum [OF fin_R]) (use yind in blast)
  2665       also have "\<dots> \<le> (\<Sum>y\<in>range (h n). integral S (\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)))"
  2666         using yind by (force intro: sum_mono)
  2667       also have "\<dots> = integral S (\<lambda>u. \<Sum>y\<in>range (h n). \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u))"
  2668       proof (rule integral_sum [OF fin_R, symmetric])
  2669         fix y assume y: "y \<in> ?R"
  2670         with nonneg_h have "y \<ge> 0"
  2671           by auto
  2672         show "(\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)) integrable_on S"
  2673         proof (rule measurable_bounded_by_integrable_imp_integrable)
  2674           have "(\<lambda>x. indicat_real {x. h n x = y} (g x)) \<in> borel_measurable (lebesgue_on S)"
  2675             using h_lmeas S
  2676             by (auto simp: indicator_vimage [symmetric] borel_measurable_indicator_iff sets_restrict_space_iff)
  2677           then show "(\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)) \<in> borel_measurable (lebesgue_on S)"
  2678             by (intro borel_measurable_times borel_measurable_abs borel_measurable_const borel_measurable_det_Jacobian [OF S der_g])
  2679         next
  2680           fix x
  2681           assume "x \<in> S"
  2682           have "y * indicat_real {x. h n x = y} (g x) \<le> f (g x)"
  2683             by (metis (full_types) \<open>x \<in> S\<close> h_le_f indicator_def mem_Collect_eq mult.right_neutral mult_zero_right nonneg_fg)
  2684           with \<open>y \<ge> 0\<close> show "norm (?D x * y * indicat_real {x. h n x = y} (g x)) \<le> ?D x * f(g x)"
  2685             by (simp add: abs_mult mult.assoc mult_left_mono)
  2686         qed (use S det_int_fg in auto)
  2687       qed
  2688       also have "\<dots> = integral S (\<lambda>T. \<bar>det (matrix (g' T))\<bar> *
  2689                                         (\<Sum>y\<in>range (h n). y * indicat_real {x. h n x = y} (g T)))"
  2690         by (simp add: sum_distrib_left mult.assoc)
  2691       also have "\<dots> = ?rhs"
  2692         by (metis hn_eq)
  2693       finally show "integral (g ` S) (h n) \<le> ?rhs" .
  2694     qed
  2695   qed
  2696   have le: "integral S (\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) \<le> ?b" for n
  2697   proof (rule integral_le)
  2698     show "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) integrable_on S"
  2699     proof (rule measurable_bounded_by_integrable_imp_integrable)
  2700       have "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> *\<^sub>R h n (g T)) \<in> borel_measurable (lebesgue_on S)"
  2701       proof (intro borel_measurable_scaleR borel_measurable_abs borel_measurable_det_Jacobian \<open>S \<in> sets lebesgue\<close>)
  2702         have eq: "{x \<in> S. f x \<le> a} = (\<Union>b \<in> (f ` S) \<inter> atMost a. {x. f x = b} \<inter> S)" for f and a::real
  2703           by auto
  2704         have "finite ((\<lambda>x. h n (g x)) ` S \<inter> {..a})" for a
  2705           by (force intro: finite_subset [OF _ fin_R])
  2706         with h_lmeas [of n] show "(\<lambda>x. h n (g x)) \<in> borel_measurable (lebesgue_on S)"
  2707           apply (simp add: borel_measurable_vimage_halfspace_component_le \<open>S \<in> sets lebesgue\<close> sets_restrict_space_iff eq)
  2708           by (metis (mono_tags) SUP_inf sets.finite_UN)
  2709       qed (use der_g in blast)
  2710       then show "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) \<in> borel_measurable (lebesgue_on S)"
  2711         by simp
  2712       show "norm (?D x * h n (g x)) \<le> ?D x *\<^sub>R f (g x)"
  2713         if "x \<in> S" for x
  2714         by (simp add: h_le_f mult_left_mono nonneg_h that)
  2715     qed (use S det_int_fg in auto)
  2716     show "?D x * h n (g x) \<le> ?D x * f (g x)" if "x \<in> S" for x
  2717       by (simp add: \<open>x \<in> S\<close> h_le_f mult_left_mono)
  2718     show "(\<lambda>x. ?D x * f (g x)) integrable_on S"
  2719       using det_int_fg by blast
  2720   qed
  2721   have "f integrable_on g ` S \<and> (\<lambda>k. integral (g ` S) (h k)) \<longlonglongrightarrow> integral (g ` S) f"
  2722   proof (rule monotone_convergence_increasing)
  2723     have "\<bar>integral (g ` S) (h n)\<bar> \<le> integral S (\<lambda>x. ?D x * f (g x))" for n
  2724     proof -
  2725       have "\<bar>integral (g ` S) (h n)\<bar> = integral (g ` S) (h n)"
  2726         using hint by (simp add: integral_nonneg nonneg_h)
  2727       also have "\<dots> \<le> integral S (\<lambda>x. ?D x * f (g x))"
  2728         using hint le by (meson order_trans)
  2729       finally show ?thesis .
  2730     qed
  2731     then show "bounded (range (\<lambda>k. integral (g ` S) (h k)))"
  2732       by (force simp: bounded_iff)
  2733   qed (use h_inc lim hint in auto)
  2734   moreover have "integral (g ` S) (h n) \<le> integral S (\<lambda>x. ?D x * f (g x))" for n
  2735     using hint by (blast intro: le order_trans)
  2736   ultimately show ?thesis
  2737     by (auto intro: Lim_bounded)
  2738 qed
  2739 
  2740 
  2741 lemma integral_on_image_ubound_nonneg:
  2742   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real"
  2743   assumes nonneg_fg: "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
  2744       and der_g:   "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2745       and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
  2746   shows "f integrable_on (g ` S) \<and> integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
  2747          (is "_ \<and> _ \<le> ?b")
  2748 proof -
  2749   let ?D = "\<lambda>x. det (matrix (g' x))"
  2750   define S' where "S' \<equiv> {x \<in> S. ?D x * f(g x) \<noteq> 0}"
  2751   then have der_gS': "\<And>x. x \<in> S' \<Longrightarrow> (g has_derivative g' x) (at x within S')"
  2752     by (metis (mono_tags, lifting) der_g has_derivative_within_subset mem_Collect_eq subset_iff)
  2753   have "(\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) integrable_on UNIV"
  2754     by (simp add: integrable_restrict_UNIV intS)
  2755   then have Df_borel: "(\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> borel_measurable lebesgue"
  2756     using integrable_imp_measurable borel_measurable_UNIV_eq by blast
  2757   have S': "S' \<in> sets lebesgue"
  2758   proof -
  2759     from Df_borel borel_measurable_vimage_open [of _ UNIV]
  2760     have "{x. (if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> T} \<in> sets lebesgue"
  2761       if "open T" for T
  2762       using that unfolding borel_measurable_UNIV_eq
  2763       by (fastforce simp add: dest!: spec)
  2764     then have "{x. (if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> -{0}} \<in> sets lebesgue"
  2765       using open_Compl by blast
  2766     then show ?thesis
  2767       by (simp add: S'_def conj_ac split: if_split_asm cong: conj_cong)
  2768   qed
  2769   then have gS': "g ` S' \<in> sets lebesgue"
  2770   proof (rule differentiable_image_in_sets_lebesgue)
  2771     show "g differentiable_on S'"
  2772       using der_g unfolding S'_def differentiable_def differentiable_on_def
  2773       by (blast intro: has_derivative_within_subset)
  2774   qed auto
  2775   have f: "f \<in> borel_measurable (lebesgue_on (g ` S'))"
  2776   proof (clarsimp simp add: borel_measurable_vimage_open)
  2777     fix T :: "real set"
  2778     assume "open T"
  2779     have "{x \<in> g ` S'. f x \<in> T} = g ` {x \<in> S'. f(g x) \<in> T}"
  2780       by blast
  2781     moreover have "g ` {x \<in> S'. f(g x) \<in> T} \<in> sets lebesgue"
  2782     proof (rule differentiable_image_in_sets_lebesgue)
  2783       let ?h = "\<lambda>x. \<bar>?D x\<bar> * f (g x) /\<^sub>R \<bar>?D x\<bar>"
  2784       have "(\<lambda>x. if x \<in> S' then \<bar>?D x\<bar> * f (g x) else 0) = (\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0)"
  2785         by (auto simp: S'_def)
  2786       also have "\<dots> \<in> borel_measurable lebesgue"
  2787         by (rule Df_borel)
  2788       finally have *: "(\<lambda>x. \<bar>?D x\<bar> * f (g x)) \<in> borel_measurable (lebesgue_on S')"
  2789         by (simp add: borel_measurable_If_D)
  2790       have "?h \<in> borel_measurable (lebesgue_on S')"
  2791         by (intro * S' der_gS' borel_measurable_det_Jacobian measurable) (blast intro: der_gS')
  2792       moreover have "?h x = f(g x)" if "x \<in> S'" for x
  2793         using that by (auto simp: S'_def)
  2794       ultimately have "(\<lambda>x. f(g x)) \<in> borel_measurable (lebesgue_on S')"
  2795         by (metis (no_types, lifting) measurable_lebesgue_cong)
  2796       then show "{x \<in> S'. f (g x) \<in> T} \<in> sets lebesgue"
  2797         by (simp add: \<open>S' \<in> sets lebesgue\<close> \<open>open T\<close> borel_measurable_vimage_open sets_restrict_space_iff)
  2798       show "g differentiable_on {x \<in> S'. f (g x) \<in> T}"
  2799         using der_g unfolding S'_def differentiable_def differentiable_on_def
  2800         by (blast intro: has_derivative_within_subset)
  2801     qed auto
  2802     ultimately have "{x \<in> g ` S'. f x \<in> T} \<in> sets lebesgue"
  2803       by metis
  2804     then show "{x \<in> g ` S'. f x \<in> T} \<in> sets (lebesgue_on (g ` S'))"
  2805       by (simp add: \<open>g ` S' \<in> sets lebesgue\<close> sets_restrict_space_iff)
  2806   qed
  2807   have intS': "(\<lambda>x. \<bar>?D x\<bar> * f (g x)) integrable_on S'"
  2808     using intS
  2809     by (rule integrable_spike_set) (auto simp: S'_def intro: empty_imp_negligible)
  2810   have lebS': "{x \<in> S'. g x \<in> T} \<in> sets lebesgue" if "T \<subseteq> g ` S'" "T \<in> sets lebesgue" for T
  2811   proof -
  2812     have "g \<in> borel_measurable (lebesgue_on S')"
  2813       using der_gS' has_derivative_continuous_on S'
  2814       by (blast intro: continuous_imp_measurable_on_sets_lebesgue)
  2815     moreover have "{x \<in> S'. g x \<in> U} \<in> sets lebesgue" if "negligible U" "U \<subseteq> g ` S'" for U
  2816     proof (intro negligible_imp_sets negligible_differentiable_vimage that)
  2817       fix x
  2818       assume x: "x \<in> S'"
  2819       then have "linear (g' x)"
  2820         using der_gS' has_derivative_linear by blast
  2821       with x show "inj (g' x)"
  2822         by (auto simp: S'_def det_nz_iff_inj)
  2823     qed (use der_gS' in auto)
  2824     ultimately show ?thesis
  2825       using double_lebesgue_sets [OF S' gS' order_refl] that by blast
  2826   qed
  2827   have int_gS': "f integrable_on g ` S' \<and> integral (g ` S') f \<le> integral S' (\<lambda>x. \<bar>?D x\<bar> * f(g x))"
  2828     using integral_on_image_ubound_weak [OF S' f nonneg_fg der_gS' intS' lebS'] S'_def by blast
  2829   have "negligible (g ` {x \<in> S. det(matrix(g' x)) = 0})"
  2830   proof (rule baby_Sard, simp_all)
  2831     fix x
  2832     assume x: "x \<in> S \<and> det (matrix (g' x)) = 0"
  2833     then show "(g has_derivative g' x) (at x within {x \<in> S. det (matrix (g' x)) = 0})"
  2834       by (metis (no_types, lifting) der_g has_derivative_within_subset mem_Collect_eq subsetI)
  2835     then show "rank (matrix (g' x)) < CARD('n)"
  2836       using det_nz_iff_inj matrix_vector_mul_linear x
  2837       by (fastforce simp add: less_rank_noninjective)
  2838   qed
  2839   then have negg: "negligible (g ` S - g ` {x \<in> S. ?D x \<noteq> 0})"
  2840     by (rule negligible_subset) (auto simp: S'_def)
  2841   have null: "g ` {x \<in> S. ?D x \<noteq> 0} - g ` S = {}"
  2842     by (auto simp: S'_def)
  2843   let ?F = "{x \<in> S. f (g x) \<noteq> 0}"
  2844   have eq: "g ` S' = g ` ?F \<inter> g ` {x \<in> S. ?D x \<noteq> 0}"
  2845     by (auto simp: S'_def image_iff)
  2846   show ?thesis
  2847   proof
  2848     have "((\<lambda>x. if x \<in> g ` ?F then f x else 0) integrable_on g ` {x \<in> S. ?D x \<noteq> 0})"
  2849       using int_gS' eq integrable_restrict_Int [where f=f]
  2850       by simp
  2851     then have "f integrable_on g ` {x \<in> S. ?D x \<noteq> 0}"
  2852       by (auto simp: image_iff elim!: integrable_eq)
  2853     then show "f integrable_on g ` S"
  2854       apply (rule integrable_spike_set [OF _ empty_imp_negligible negligible_subset])
  2855       using negg null by auto
  2856     have "integral (g ` S) f = integral (g ` {x \<in> S. ?D x \<noteq> 0}) f"
  2857       using negg by (auto intro: negligible_subset integral_spike_set)
  2858     also have "\<dots> = integral (g ` {x \<in> S. ?D x \<noteq> 0}) (\<lambda>x. if x \<in> g ` ?F then f x else 0)"
  2859       by (auto simp: image_iff intro!: integral_cong)
  2860     also have "\<dots> = integral (g ` S') f"
  2861       using  eq integral_restrict_Int by simp
  2862     also have "\<dots> \<le> integral S' (\<lambda>x. \<bar>?D x\<bar> * f(g x))"
  2863       by (metis int_gS')
  2864     also have "\<dots> \<le> ?b"
  2865       by (rule integral_subset_le [OF _ intS' intS]) (use nonneg_fg S'_def in auto)
  2866     finally show "integral (g ` S) f \<le> ?b" .
  2867   qed
  2868 qed
  2869 
  2870 
  2871 lemma absolutely_integrable_on_image_real:
  2872   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
  2873   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2874     and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) absolutely_integrable_on S"
  2875   shows "f absolutely_integrable_on (g ` S)"
  2876 proof -
  2877   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f (g x)"
  2878   let ?N = "{x \<in> S. f (g x) < 0}" and ?P = "{x \<in> S. f (g x) > 0}"
  2879   have eq: "{x. (if x \<in> S then ?D x else 0) > 0} = {x \<in> S. ?D x > 0}"
  2880            "{x. (if x \<in> S then ?D x else 0) < 0} = {x \<in> S. ?D x < 0}"
  2881     by auto
  2882   have "?D integrable_on S"
  2883     using intS absolutely_integrable_on_def by blast
  2884   then have "(\<lambda>x. if x \<in> S then ?D x else 0) integrable_on UNIV"
  2885     by (simp add: integrable_restrict_UNIV)
  2886   then have D_borel: "(\<lambda>x. if x \<in> S then ?D x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
  2887     using integrable_imp_measurable borel_measurable_UNIV_eq by blast
  2888   then have Dlt: "{x \<in> S. ?D x < 0} \<in> sets lebesgue"
  2889     unfolding borel_measurable_vimage_halfspace_component_lt
  2890     by (drule_tac x=0 in spec) (auto simp: eq)
  2891   from D_borel have Dgt: "{x \<in> S. ?D x > 0} \<in> sets lebesgue"
  2892     unfolding borel_measurable_vimage_halfspace_component_gt
  2893     by (drule_tac x=0 in spec) (auto simp: eq)
  2894 
  2895   have dfgbm: "?D \<in> borel_measurable (lebesgue_on S)"
  2896     using intS absolutely_integrable_on_def integrable_imp_measurable by blast
  2897   have der_gN: "(g has_derivative g' x) (at x within ?N)" if "x \<in> ?N" for x
  2898       using der_g has_derivative_within_subset that by force
  2899   have "(\<lambda>x. - f x) integrable_on g ` ?N \<and>
  2900          integral (g ` ?N) (\<lambda>x. - f x) \<le> integral ?N (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x))"
  2901   proof (rule integral_on_image_ubound_nonneg [OF _ der_gN])
  2902     have 1: "?D integrable_on {x \<in> S. ?D x < 0}"
  2903       using Dlt
  2904       by (auto intro: set_lebesgue_integral_eq_integral [OF set_integrable_subset] intS)
  2905     have "uminus \<circ> (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x)) integrable_on ?N"
  2906       by (simp add: o_def mult_less_0_iff empty_imp_negligible integrable_spike_set [OF 1])
  2907     then show "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x)) integrable_on ?N"
  2908       by (simp add: integrable_neg_iff o_def)
  2909   qed auto
  2910   then have "f integrable_on g ` ?N"
  2911     by (simp add: integrable_neg_iff)
  2912   moreover have "g ` ?N = {y \<in> g ` S. f y < 0}"
  2913     by auto
  2914   ultimately have "f integrable_on {y \<in> g ` S. f y < 0}"
  2915     by simp
  2916   then have N: "f absolutely_integrable_on {y \<in> g ` S. f y < 0}"
  2917     by (rule absolutely_integrable_absolutely_integrable_ubound) auto
  2918 
  2919   have der_gP: "(g has_derivative g' x) (at x within ?P)" if "x \<in> ?P" for x
  2920       using der_g has_derivative_within_subset that by force
  2921   have "f integrable_on g ` ?P \<and> integral (g ` ?P) f \<le> integral ?P ?D"
  2922   proof (rule integral_on_image_ubound_nonneg [OF _ der_gP])
  2923     have "?D integrable_on {x \<in> S. 0 < ?D x}"
  2924       using Dgt
  2925       by (auto intro: set_lebesgue_integral_eq_integral [OF set_integrable_subset] intS)
  2926     then show "?D integrable_on ?P"
  2927       apply (rule integrable_spike_set)
  2928       by (auto simp: zero_less_mult_iff empty_imp_negligible)
  2929   qed auto
  2930   then have "f integrable_on g ` ?P"
  2931     by metis
  2932   moreover have "g ` ?P = {y \<in> g ` S. f y > 0}"
  2933     by auto
  2934   ultimately have "f integrable_on {y \<in> g ` S. f y > 0}"
  2935     by simp
  2936   then have P: "f absolutely_integrable_on {y \<in> g ` S. f y > 0}"
  2937     by (rule absolutely_integrable_absolutely_integrable_lbound) auto
  2938   have "(\<lambda>x. if x \<in> g ` S \<and> f x < 0 \<or> x \<in> g ` S \<and> 0 < f x then f x else 0) = (\<lambda>x. if x \<in> g ` S then f x else 0)"
  2939     by auto
  2940   then show ?thesis
  2941     using absolutely_integrable_Un [OF N P] absolutely_integrable_restrict_UNIV [symmetric, where f=f]
  2942     by simp
  2943 qed
  2944 
  2945 
  2946 proposition absolutely_integrable_on_image:
  2947   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  2948   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2949     and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S"
  2950   shows "f absolutely_integrable_on (g ` S)"
  2951   apply (rule absolutely_integrable_componentwise [OF absolutely_integrable_on_image_real [OF der_g]])
  2952   using%unimportant absolutely_integrable_component [OF intS]  by%unimportant auto
  2953 
  2954 proposition integral_on_image_ubound:
  2955   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
  2956   assumes"\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
  2957     and "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2958     and "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
  2959   shows "integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
  2960   using%unimportant integral_on_image_ubound_nonneg [OF assms] by%unimportant simp
  2961 
  2962 
  2963 subsection\<open>Change-of-variables theorem\<close>
  2964 
  2965 text\<open>The classic change-of-variables theorem. We have two versions with quite general hypotheses,
  2966 the first that the transforming function has a continuous inverse, the second that the base set is
  2967 Lebesgue measurable.\<close>
  2968 lemma cov_invertible_nonneg_le:
  2969   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
  2970   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  2971     and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
  2972     and f0: "\<And>y. y \<in> T \<Longrightarrow> 0 \<le> f y"
  2973     and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
  2974     and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
  2975     and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
  2976   shows "f integrable_on T \<and> (integral T f) \<le> b \<longleftrightarrow>
  2977              (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S \<and>
  2978              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) \<le> b"
  2979         (is "?lhs = ?rhs")
  2980 proof -
  2981   have Teq: "T = g`S" and Seq: "S = h`T"
  2982     using hg gh image_iff by fastforce+
  2983   have gS: "g differentiable_on S"
  2984     by (meson der_g differentiable_def differentiable_on_def)
  2985   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f (g x)"
  2986   show ?thesis
  2987   proof
  2988     assume ?lhs
  2989     then have fT: "f integrable_on T" and intf: "integral T f \<le> b"
  2990       by blast+
  2991     show ?rhs
  2992     proof
  2993       let ?fgh = "\<lambda>x. \<bar>det (matrix (h' x))\<bar> * (\<bar>det (matrix (g' (h x)))\<bar> * f (g (h x)))"
  2994       have ddf: "?fgh x = f x"
  2995         if "x \<in> T" for x
  2996       proof -
  2997         have "matrix (h' x) ** matrix (g' (h x)) = mat 1"
  2998           using that id[OF that] der_g[of "h x"] gh[OF that] left_inverse_linear has_derivative_linear
  2999           by (subst matrix_compose[symmetric]) (force simp: matrix_id_mat_1 has_derivative_linear)+
  3000         then have "\<bar>det (matrix (h' x))\<bar> * \<bar>det (matrix (g' (h x)))\<bar> = 1"
  3001           by (metis abs_1 abs_mult det_I det_mul)
  3002         then show ?thesis
  3003           by (simp add: gh that)
  3004       qed
  3005       have "?D integrable_on (h ` T)"
  3006       proof (intro set_lebesgue_integral_eq_integral absolutely_integrable_on_image_real)
  3007         show "(\<lambda>x. ?fgh x) absolutely_integrable_on T"
  3008         proof (subst absolutely_integrable_on_iff_nonneg)
  3009           show "(\<lambda>x. ?fgh x) integrable_on T"
  3010             using ddf fT integrable_eq by force
  3011         qed (simp add: zero_le_mult_iff f0 gh)
  3012       qed (use der_h in auto)
  3013       with Seq show "(\<lambda>x. ?D x) integrable_on S"
  3014         by simp
  3015       have "integral S (\<lambda>x. ?D x) \<le> integral T (\<lambda>x. ?fgh x)"
  3016         unfolding Seq
  3017       proof (rule integral_on_image_ubound)
  3018         show "(\<lambda>x. ?fgh x) integrable_on T"
  3019         using ddf fT integrable_eq by force
  3020       qed (use f0 gh der_h in auto)
  3021       also have "\<dots> = integral T f"
  3022         by (force simp: ddf intro: integral_cong)
  3023       also have "\<dots> \<le> b"
  3024         by (rule intf)
  3025       finally show "integral S (\<lambda>x. ?D x) \<le> b" .
  3026     qed
  3027   next
  3028     assume R: ?rhs
  3029     then have "f integrable_on g ` S"
  3030       using der_g f0 hg integral_on_image_ubound_nonneg by blast
  3031     moreover have "integral (g ` S) f \<le> integral S (\<lambda>x. ?D x)"
  3032       by (rule integral_on_image_ubound [OF f0 der_g]) (use R Teq in auto)
  3033     ultimately show ?lhs
  3034       using R by (simp add: Teq)
  3035   qed
  3036 qed
  3037 
  3038 
  3039 lemma cov_invertible_nonneg_eq:
  3040   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
  3041   assumes "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3042       and "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
  3043       and "\<And>y. y \<in> T \<Longrightarrow> 0 \<le> f y"
  3044       and "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
  3045       and "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
  3046       and "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
  3047   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) has_integral b) S \<longleftrightarrow> (f has_integral b) T"
  3048   using cov_invertible_nonneg_le [OF assms]
  3049   by (simp add: has_integral_iff) (meson eq_iff)
  3050 
  3051 
  3052 lemma cov_invertible_real:
  3053   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
  3054   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3055       and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
  3056       and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
  3057       and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
  3058       and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
  3059   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) absolutely_integrable_on S \<and>
  3060            integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) = b \<longleftrightarrow>
  3061          f absolutely_integrable_on T \<and> integral T f = b"
  3062          (is "?lhs = ?rhs")
  3063 proof -
  3064   have Teq: "T = g`S" and Seq: "S = h`T"
  3065     using hg gh image_iff by fastforce+
  3066   let ?DP = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)" and ?DN = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * -f(g x)"
  3067   have "+": "(?DP has_integral b) {x \<in> S. f (g x) > 0} \<longleftrightarrow> (f has_integral b) {y \<in> T. f y > 0}" for b
  3068   proof (rule cov_invertible_nonneg_eq)
  3069     have *: "(\<lambda>x. f (g x)) -` Y \<inter> {x \<in> S. f (g x) > 0}
  3070           = ((\<lambda>x. f (g x)) -` Y \<inter> S) \<inter> {x \<in> S. f (g x) > 0}" for Y
  3071       by auto
  3072     show "(g has_derivative g' x) (at x within {x \<in> S. f (g x) > 0})" if "x \<in> {x \<in> S. f (g x) > 0}" for x
  3073       using that der_g has_derivative_within_subset by fastforce
  3074     show "(h has_derivative h' y) (at y within {y \<in> T. f y > 0})" if "y \<in> {y \<in> T. f y > 0}" for y
  3075       using that der_h has_derivative_within_subset by fastforce
  3076   qed (use gh hg id in auto)
  3077   have "-": "(?DN has_integral b) {x \<in> S. f (g x) < 0} \<longleftrightarrow> ((\<lambda>x. - f x) has_integral b) {y \<in> T. f y < 0}" for b
  3078   proof (rule cov_invertible_nonneg_eq)
  3079     have *: "(\<lambda>x. - f (g x)) -` y \<inter> {x \<in> S. f (g x) < 0}
  3080           = ((\<lambda>x. f (g x)) -` uminus ` y \<inter> S) \<inter> {x \<in> S. f (g x) < 0}" for y
  3081       using image_iff by fastforce
  3082     show "(g has_derivative g' x) (at x within {x \<in> S. f (g x) < 0})" if "x \<in> {x \<in> S. f (g x) < 0}" for x
  3083       using that der_g has_derivative_within_subset by fastforce
  3084     show "(h has_derivative h' y) (at y within {y \<in> T. f y < 0})" if "y \<in> {y \<in> T. f y < 0}" for y
  3085       using that der_h has_derivative_within_subset by fastforce
  3086   qed (use gh hg id in auto)
  3087   show ?thesis
  3088   proof
  3089     assume LHS: ?lhs
  3090     have eq: "{x. (if x \<in> S then ?DP x else 0) > 0} = {x \<in> S. ?DP x > 0}"
  3091       "{x. (if x \<in> S then ?DP x else 0) < 0} = {x \<in> S. ?DP x < 0}"
  3092       by auto
  3093     have "?DP integrable_on S"
  3094       using LHS absolutely_integrable_on_def by blast
  3095     then have "(\<lambda>x. if x \<in> S then ?DP x else 0) integrable_on UNIV"
  3096       by (simp add: integrable_restrict_UNIV)
  3097     then have D_borel: "(\<lambda>x. if x \<in> S then ?DP x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
  3098       using integrable_imp_measurable borel_measurable_UNIV_eq by blast
  3099     then have SN: "{x \<in> S. ?DP x < 0} \<in> sets lebesgue"
  3100       unfolding borel_measurable_vimage_halfspace_component_lt
  3101       by (drule_tac x=0 in spec) (auto simp: eq)
  3102     from D_borel have SP: "{x \<in> S. ?DP x > 0} \<in> sets lebesgue"
  3103       unfolding borel_measurable_vimage_halfspace_component_gt
  3104       by (drule_tac x=0 in spec) (auto simp: eq)
  3105     have "?DP absolutely_integrable_on {x \<in> S. ?DP x > 0}"
  3106       using LHS by (fast intro!: set_integrable_subset [OF _, of _ S] SP)
  3107     then have aP: "?DP absolutely_integrable_on {x \<in> S. f (g x) > 0}"
  3108       by (rule absolutely_integrable_spike_set) (auto simp: zero_less_mult_iff empty_imp_negligible)
  3109     have "?DP absolutely_integrable_on {x \<in> S. ?DP x < 0}"
  3110       using LHS by (fast intro!: set_integrable_subset [OF _, of _ S] SN)
  3111     then have aN: "?DP absolutely_integrable_on {x \<in> S. f (g x) < 0}"
  3112       by (rule absolutely_integrable_spike_set) (auto simp: mult_less_0_iff empty_imp_negligible)
  3113     have fN: "f integrable_on {y \<in> T. f y < 0}"
  3114              "integral {y \<in> T. f y < 0} f = integral {x \<in> S. f (g x) < 0} ?DP"
  3115       using "-" [of "integral {x \<in> S. f(g x) < 0} ?DN"] aN
  3116       by (auto simp: set_lebesgue_integral_eq_integral has_integral_iff integrable_neg_iff)
  3117     have faN: "f absolutely_integrable_on {y \<in> T. f y < 0}"
  3118       apply (rule absolutely_integrable_integrable_bound [where g = "\<lambda>x. - f x"])
  3119       using fN by (auto simp: integrable_neg_iff)
  3120     have fP: "f integrable_on {y \<in> T. f y > 0}"
  3121              "integral {y \<in> T. f y > 0} f = integral {x \<in> S. f (g x) > 0} ?DP"
  3122       using "+" [of "integral {x \<in> S. f(g x) > 0} ?DP"] aP
  3123       by (auto simp: set_lebesgue_integral_eq_integral has_integral_iff integrable_neg_iff)
  3124     have faP: "f absolutely_integrable_on {y \<in> T. f y > 0}"
  3125       apply (rule absolutely_integrable_integrable_bound [where g = f])
  3126       using fP by auto
  3127     have fa: "f absolutely_integrable_on ({y \<in> T. f y < 0} \<union> {y \<in> T. f y > 0})"
  3128       by (rule absolutely_integrable_Un [OF faN faP])
  3129     show ?rhs
  3130     proof
  3131       have eq: "((if x \<in> T \<and> f x < 0 \<or> x \<in> T \<and> 0 < f x then 1 else 0) * f x)
  3132               = (if x \<in> T then 1 else 0) * f x" for x
  3133         by auto
  3134       show "f absolutely_integrable_on T"
  3135         using fa by (simp add: indicator_def set_integrable_def eq)
  3136       have [simp]: "{y \<in> T. f y < 0} \<inter> {y \<in> T. 0 < f y} = {}" for T and f :: "(real^'n::_) \<Rightarrow> real"
  3137         by auto
  3138       have "integral T f = integral ({y \<in> T. f y < 0} \<union> {y \<in> T. f y > 0}) f"
  3139         by (intro empty_imp_negligible integral_spike_set) (auto simp: eq)
  3140       also have "\<dots> = integral {y \<in> T. f y < 0} f + integral {y \<in> T. f y > 0} f"
  3141         using fN fP by simp
  3142       also have "\<dots> = integral {x \<in> S. f (g x) < 0} ?DP + integral {x \<in> S. 0 < f (g x)} ?DP"
  3143         by (simp add: fN fP)
  3144       also have "\<dots> = integral ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. 0 < f (g x)}) ?DP"
  3145         using aP aN by (simp add: set_lebesgue_integral_eq_integral)
  3146       also have "\<dots> = integral S ?DP"
  3147         by (intro empty_imp_negligible integral_spike_set) auto
  3148       also have "\<dots> = b"
  3149         using LHS by simp
  3150       finally show "integral T f = b" .
  3151     qed
  3152   next
  3153     assume RHS: ?rhs
  3154     have eq: "{x. (if x \<in> T then f x else 0) > 0} = {x \<in> T. f x > 0}"
  3155              "{x. (if x \<in> T then f x else 0) < 0} = {x \<in> T. f x < 0}"
  3156       by auto
  3157     have "f integrable_on T"
  3158       using RHS absolutely_integrable_on_def by blast
  3159     then have "(\<lambda>x. if x \<in> T then f x else 0) integrable_on UNIV"
  3160       by (simp add: integrable_restrict_UNIV)
  3161     then have D_borel: "(\<lambda>x. if x \<in> T then f x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
  3162       using integrable_imp_measurable borel_measurable_UNIV_eq by blast
  3163     then have TN: "{x \<in> T. f x < 0} \<in> sets lebesgue"
  3164       unfolding borel_measurable_vimage_halfspace_component_lt
  3165       by (drule_tac x=0 in spec) (auto simp: eq)
  3166     from D_borel have TP: "{x \<in> T. f x > 0} \<in> sets lebesgue"
  3167       unfolding borel_measurable_vimage_halfspace_component_gt
  3168       by (drule_tac x=0 in spec) (auto simp: eq)
  3169     have aint: "f absolutely_integrable_on {y. y \<in> T \<and> 0 < (f y)}"
  3170                "f absolutely_integrable_on {y. y \<in> T \<and> (f y) < 0}"
  3171          and intT: "integral T f = b"
  3172       using set_integrable_subset [of _ T] TP TN RHS
  3173       by blast+
  3174     show ?lhs
  3175     proof
  3176       have fN: "f integrable_on {v \<in> T. f v < 0}"
  3177         using absolutely_integrable_on_def aint by blast
  3178       then have DN: "(?DN has_integral integral {y \<in> T. f y < 0} (\<lambda>x. - f x)) {x \<in> S. f (g x) < 0}"
  3179         using "-" [of "integral {y \<in> T. f y < 0} (\<lambda>x. - f x)"]
  3180         by (simp add: has_integral_neg_iff integrable_integral)
  3181       have aDN: "?DP absolutely_integrable_on {x \<in> S. f (g x) < 0}"
  3182         apply (rule absolutely_integrable_integrable_bound [where g = ?DN])
  3183         using DN hg by (fastforce simp: abs_mult integrable_neg_iff)+
  3184       have fP: "f integrable_on {v \<in> T. f v > 0}"
  3185         using absolutely_integrable_on_def aint by blast
  3186       then have DP: "(?DP has_integral integral {y \<in> T. f y > 0} f) {x \<in> S. f (g x) > 0}"
  3187         using "+" [of "integral {y \<in> T. f y > 0} f"]
  3188         by (simp add: has_integral_neg_iff integrable_integral)
  3189       have aDP: "?DP absolutely_integrable_on {x \<in> S. f (g x) > 0}"
  3190         apply (rule absolutely_integrable_integrable_bound [where g = ?DP])
  3191         using DP hg by (fastforce simp: integrable_neg_iff)+
  3192       have eq: "(if x \<in> S then 1 else 0) * ?DP x = (if x \<in> S \<and> f (g x) < 0 \<or> x \<in> S \<and> f (g x) > 0 then 1 else 0) * ?DP x" for x
  3193         by force
  3194       have "?DP absolutely_integrable_on ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. f (g x) > 0})"
  3195         by (rule absolutely_integrable_Un [OF aDN aDP])
  3196       then show I: "?DP absolutely_integrable_on S"
  3197         by (simp add: indicator_def eq set_integrable_def)
  3198       have [simp]: "{y \<in> S. f y < 0} \<inter> {y \<in> S. 0 < f y} = {}" for S and f :: "(real^'n::_) \<Rightarrow> real"
  3199         by auto
  3200       have "integral S ?DP = integral ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. f (g x) > 0}) ?DP"
  3201         by (intro empty_imp_negligible integral_spike_set) auto
  3202       also have "\<dots> = integral {x \<in> S. f (g x) < 0} ?DP + integral {x \<in> S. 0 < f (g x)} ?DP"
  3203         using aDN aDP by (simp add: set_lebesgue_integral_eq_integral)
  3204       also have "\<dots> = - integral {y \<in> T. f y < 0} (\<lambda>x. - f x) + integral {y \<in> T. f y > 0} f"
  3205         using DN DP by (auto simp: has_integral_iff)
  3206       also have "\<dots> = integral ({x \<in> T. f x < 0} \<union> {x \<in> T. 0 < f x}) f"
  3207         by (simp add: fN fP)
  3208       also have "\<dots> = integral T f"
  3209         by (intro empty_imp_negligible integral_spike_set) auto
  3210       also have "\<dots> = b"
  3211         using intT by simp
  3212       finally show "integral S ?DP = b" .
  3213     qed
  3214   qed
  3215 qed
  3216 
  3217 
  3218 lemma cv_inv_version3:
  3219   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3220   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3221     and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
  3222     and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
  3223     and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
  3224     and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
  3225   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3226              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
  3227          \<longleftrightarrow> f absolutely_integrable_on T \<and> integral T f = b"
  3228 proof -
  3229   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)"
  3230   have "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x) $ i) absolutely_integrable_on S \<and> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * (f(g x) $ i)) = b $ i) \<longleftrightarrow>
  3231         ((\<lambda>x. f x $ i) absolutely_integrable_on T \<and> integral T (\<lambda>x. f x $ i) = b $ i)" for i
  3232     by (rule cov_invertible_real [OF der_g der_h hg gh id])
  3233   then have "?D absolutely_integrable_on S \<and> (?D has_integral b) S \<longleftrightarrow>
  3234         f absolutely_integrable_on T \<and> (f has_integral b) T"
  3235     unfolding absolutely_integrable_componentwise_iff [where f=f] has_integral_componentwise_iff [of f]
  3236               absolutely_integrable_componentwise_iff [where f="?D"] has_integral_componentwise_iff [of ?D]
  3237     by (auto simp: all_conj_distrib Basis_vec_def cart_eq_inner_axis [symmetric]
  3238            has_integral_iff set_lebesgue_integral_eq_integral)
  3239   then show ?thesis
  3240     using absolutely_integrable_on_def by blast
  3241 qed
  3242 
  3243 
  3244 lemma cv_inv_version4:
  3245   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3246   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S) \<and> invertible(matrix(g' x))"
  3247     and hg: "\<And>x. x \<in> S \<Longrightarrow> continuous_on (g ` S) h \<and> h(g x) = x"
  3248   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3249              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
  3250          \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3251 proof -
  3252   have "\<forall>x. \<exists>h'. x \<in> S
  3253            \<longrightarrow> (g has_derivative g' x) (at x within S) \<and> linear h' \<and> g' x \<circ> h' = id \<and> h' \<circ> g' x = id"
  3254     using der_g matrix_invertible has_derivative_linear by blast
  3255   then obtain h' where h':
  3256     "\<And>x. x \<in> S
  3257            \<Longrightarrow> (g has_derivative g' x) (at x within S) \<and>
  3258                linear (h' x) \<and> g' x \<circ> (h' x) = id \<and> (h' x) \<circ> g' x = id"
  3259     by metis
  3260   show ?thesis
  3261   proof (rule cv_inv_version3)
  3262     show "\<And>y. y \<in> g ` S \<Longrightarrow> (h has_derivative h' (h y)) (at y within g ` S)"
  3263       using h' hg
  3264       by (force simp: continuous_on_eq_continuous_within intro!: has_derivative_inverse_within)
  3265   qed (use h' hg in auto)
  3266 qed
  3267 
  3268 
  3269 theorem has_absolute_integral_change_of_variables_invertible:
  3270   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3271   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3272       and hg: "\<And>x. x \<in> S \<Longrightarrow> h(g x) = x"
  3273       and conth: "continuous_on (g ` S) h"
  3274   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b \<longleftrightarrow>
  3275          f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3276     (is "?lhs = ?rhs")
  3277 proof -
  3278   let ?S = "{x \<in> S. invertible (matrix (g' x))}" and ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)"
  3279   have *: "?D absolutely_integrable_on ?S \<and> integral ?S ?D = b
  3280            \<longleftrightarrow> f absolutely_integrable_on (g ` ?S) \<and> integral (g ` ?S) f = b"
  3281   proof (rule cv_inv_version4)
  3282     show "(g has_derivative g' x) (at x within ?S) \<and> invertible (matrix (g' x))"
  3283       if "x \<in> ?S" for x
  3284       using der_g that has_derivative_within_subset that by fastforce
  3285     show "continuous_on (g ` ?S) h \<and> h (g x) = x"
  3286       if "x \<in> ?S" for x
  3287       using that continuous_on_subset [OF conth]  by (simp add: hg image_mono)
  3288   qed
  3289   have "(g has_derivative g' x) (at x within {x \<in> S. rank (matrix (g' x)) < CARD('m)})" if "x \<in> S" for x
  3290     by (metis (no_types, lifting) der_g has_derivative_within_subset mem_Collect_eq subsetI that)
  3291   then have "negligible (g ` {x \<in> S. \<not> invertible (matrix (g' x))})"
  3292     by (auto simp: invertible_det_nz det_eq_0_rank intro: baby_Sard)
  3293   then have neg: "negligible {x \<in> g ` S. x \<notin> g ` ?S \<and> f x \<noteq> 0}"
  3294     by (auto intro: negligible_subset)
  3295   have [simp]: "{x \<in> g ` ?S. x \<notin> g ` S \<and> f x \<noteq> 0} = {}"
  3296     by auto
  3297   have "?D absolutely_integrable_on ?S \<and> integral ?S ?D = b
  3298     \<longleftrightarrow> ?D absolutely_integrable_on S \<and> integral S ?D = b"
  3299     apply (intro conj_cong absolutely_integrable_spike_set_eq)
  3300       apply(auto simp: integral_spike_set invertible_det_nz empty_imp_negligible neg)
  3301     done
  3302   moreover
  3303   have "f absolutely_integrable_on (g ` ?S) \<and> integral (g ` ?S) f = b
  3304     \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3305     by (auto intro!: conj_cong absolutely_integrable_spike_set_eq integral_spike_set neg)
  3306   ultimately
  3307   show ?thesis
  3308     using "*" by blast
  3309 qed
  3310 
  3311 
  3312 
  3313 theorem has_absolute_integral_change_of_variables_compact:
  3314   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3315   assumes "compact S"
  3316       and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3317       and inj: "inj_on g S"
  3318   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3319              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
  3320       \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b)"
  3321 proof -
  3322   obtain h where hg: "\<And>x. x \<in> S \<Longrightarrow> h(g x) = x"
  3323     using inj by (metis the_inv_into_f_f)
  3324   have conth: "continuous_on (g ` S) h"
  3325     by (metis \<open>compact S\<close> continuous_on_inv der_g has_derivative_continuous_on hg)
  3326   show ?thesis
  3327     by (rule has_absolute_integral_change_of_variables_invertible [OF der_g hg conth])
  3328 qed
  3329 
  3330 
  3331 lemma has_absolute_integral_change_of_variables_compact_family:
  3332   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3333   assumes compact: "\<And>n::nat. compact (F n)"
  3334       and der_g: "\<And>x. x \<in> (\<Union>n. F n) \<Longrightarrow> (g has_derivative g' x) (at x within (\<Union>n. F n))"
  3335       and inj: "inj_on g (\<Union>n. F n)"
  3336   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on (\<Union>n. F n) \<and>
  3337              integral (\<Union>n. F n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
  3338       \<longleftrightarrow> f absolutely_integrable_on (g ` (\<Union>n. F n)) \<and> integral (g ` (\<Union>n. F n)) f = b)"
  3339 proof -
  3340   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)"
  3341   let ?U = "\<lambda>n. \<Union>m\<le>n. F m"
  3342   let ?lift = "vec::real\<Rightarrow>real^1"
  3343   have F_leb: "F m \<in> sets lebesgue" for m
  3344     by (simp add: compact borel_compact)
  3345   have iff: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)) absolutely_integrable_on (?U n) \<and>
  3346              integral (?U n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)) = b
  3347          \<longleftrightarrow> f absolutely_integrable_on (g ` (?U n)) \<and> integral (g ` (?U n)) f = b" for n b and f :: "real^'m::_ \<Rightarrow> real^'k"
  3348   proof (rule has_absolute_integral_change_of_variables_compact)
  3349     show "compact (?U n)"
  3350       by (simp add: compact compact_UN)
  3351     show "(g has_derivative g' x) (at x within (?U n))"
  3352       if "x \<in> ?U n" for x
  3353       using that by (blast intro!: has_derivative_within_subset [OF der_g])
  3354     show "inj_on g (?U n)"
  3355       using inj by (auto simp: inj_on_def)
  3356   qed
  3357   show ?thesis
  3358     unfolding image_UN
  3359   proof safe
  3360     assume DS: "?D absolutely_integrable_on (\<Union>n. F n)"
  3361       and b: "b = integral (\<Union>n. F n) ?D"
  3362     have DU: "\<And>n. ?D absolutely_integrable_on (?U n)"
  3363              "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
  3364       using integral_countable_UN [OF DS F_leb] by auto
  3365     with iff have fag: "f absolutely_integrable_on g ` (?U n)"
  3366       and fg_int: "integral (\<Union>m\<le>n. g ` F m) f = integral (?U n) ?D" for n
  3367       by (auto simp: image_UN)
  3368     let ?h = "\<lambda>x. if x \<in> (\<Union>m. g ` F m) then norm(f x) else 0"
  3369     have "(\<lambda>x. if x \<in> (\<Union>m. g ` F m) then f x else 0) absolutely_integrable_on UNIV"
  3370     proof (rule dominated_convergence_absolutely_integrable)
  3371       show "(\<lambda>x. if x \<in> (\<Union>m\<le>k. g ` F m) then f x else 0) absolutely_integrable_on UNIV" for k
  3372         unfolding absolutely_integrable_restrict_UNIV
  3373         using fag by (simp add: image_UN)
  3374       let ?nf = "\<lambda>n x. if x \<in> (\<Union>m\<le>n. g ` F m) then norm(f x) else 0"
  3375       show "?h integrable_on UNIV"
  3376       proof (rule monotone_convergence_increasing [THEN conjunct1])
  3377         show "?nf k integrable_on UNIV" for k
  3378           using fag
  3379           unfolding integrable_restrict_UNIV absolutely_integrable_on_def by (simp add: image_UN)
  3380         { fix n
  3381           have "(norm \<circ> ?D) absolutely_integrable_on ?U n"
  3382             by (intro absolutely_integrable_norm DU)
  3383           then have "integral (g ` ?U n) (norm \<circ> f) = integral (?U n) (norm \<circ> ?D)"
  3384             using iff [of n "vec \<circ> norm \<circ> f" "integral (?U n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R (?lift \<circ> norm \<circ> f) (g x))"]
  3385             unfolding absolutely_integrable_on_1_iff integral_on_1_eq by (auto simp: o_def)
  3386         }
  3387         moreover have "bounded (range (\<lambda>k. integral (?U k) (norm \<circ> ?D)))"
  3388           unfolding bounded_iff
  3389         proof (rule exI, clarify)
  3390           fix k
  3391           show "norm (integral (?U k) (norm \<circ> ?D)) \<le> integral (\<Union>n. F n) (norm \<circ> ?D)"
  3392             unfolding integral_restrict_UNIV [of _ "norm \<circ> ?D", symmetric]
  3393           proof (rule integral_norm_bound_integral)
  3394             show "(\<lambda>x. if x \<in> \<Union> (F ` {..k}) then (norm \<circ> ?D) x else 0) integrable_on UNIV"
  3395               "(\<lambda>x. if x \<in> (\<Union>n. F n) then (norm \<circ> ?D) x else 0) integrable_on UNIV"
  3396               using DU(1) DS
  3397               unfolding absolutely_integrable_on_def o_def integrable_restrict_UNIV by auto
  3398           qed auto
  3399         qed
  3400         ultimately show "bounded (range (\<lambda>k. integral UNIV (?nf k)))"
  3401           by (simp add: integral_restrict_UNIV image_UN [symmetric] o_def)
  3402       next
  3403         show "(\<lambda>k. if x \<in> (\<Union>m\<le>k. g ` F m) then norm (f x) else 0)
  3404               \<longlonglongrightarrow> (if x \<in> (\<Union>m. g ` F m) then norm (f x) else 0)" for x
  3405           by (force intro: Lim_eventually eventually_sequentiallyI)
  3406       qed auto
  3407     next
  3408       show "(\<lambda>k. if x \<in> (\<Union>m\<le>k. g ` F m) then f x else 0)
  3409             \<longlonglongrightarrow> (if x \<in> (\<Union>m. g ` F m) then f x else 0)" for x
  3410       proof clarsimp
  3411         fix m y
  3412         assume "y \<in> F m"
  3413         show "(\<lambda>k. if \<exists>x\<in>{..k}. g y \<in> g ` F x then f (g y) else 0) \<longlonglongrightarrow> f (g y)"
  3414           using \<open>y \<in> F m\<close> by (force intro: Lim_eventually eventually_sequentiallyI [of m])
  3415       qed
  3416     qed auto
  3417     then show fai: "f absolutely_integrable_on (\<Union>m. g ` F m)"
  3418       using absolutely_integrable_restrict_UNIV by blast
  3419     show "integral ((\<Union>x. g ` F x)) f = integral (\<Union>n. F n) ?D"
  3420     proof (rule LIMSEQ_unique)
  3421       show "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>x. g ` F x) f"
  3422         unfolding fg_int [symmetric]
  3423       proof (rule integral_countable_UN [OF fai])
  3424         show "g ` F m \<in> sets lebesgue" for m
  3425         proof (rule differentiable_image_in_sets_lebesgue [OF F_leb])
  3426           show "g differentiable_on F m"
  3427             by (meson der_g differentiableI UnionI differentiable_on_def differentiable_on_subset rangeI subsetI)
  3428         qed auto
  3429       qed
  3430     next
  3431       show "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
  3432         by (rule DU)
  3433     qed
  3434   next
  3435     assume fs: "f absolutely_integrable_on (\<Union>x. g ` F x)"
  3436       and b: "b = integral ((\<Union>x. g ` F x)) f"
  3437     have gF_leb: "g ` F m \<in> sets lebesgue" for m
  3438     proof (rule differentiable_image_in_sets_lebesgue [OF F_leb])
  3439       show "g differentiable_on F m"
  3440         using der_g unfolding differentiable_def differentiable_on_def
  3441         by (meson Sup_upper UNIV_I UnionI has_derivative_within_subset image_eqI)
  3442     qed auto
  3443     have fgU: "\<And>n. f absolutely_integrable_on (\<Union>m\<le>n. g ` F m)"
  3444       "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>m. g ` F m) f"
  3445       using integral_countable_UN [OF fs gF_leb] by auto
  3446     with iff have DUn: "?D absolutely_integrable_on ?U n"
  3447       and D_int: "integral (?U n) ?D = integral (\<Union>m\<le>n. g ` F m) f" for n
  3448       by (auto simp: image_UN)
  3449     let ?h = "\<lambda>x. if x \<in> (\<Union>n. F n) then norm(?D x) else 0"
  3450     have "(\<lambda>x. if x \<in> (\<Union>n. F n) then ?D x else 0) absolutely_integrable_on UNIV"
  3451     proof (rule dominated_convergence_absolutely_integrable)
  3452       show "(\<lambda>x. if x \<in> ?U k then ?D x else 0) absolutely_integrable_on UNIV" for k
  3453         unfolding absolutely_integrable_restrict_UNIV using DUn by simp
  3454       let ?nD = "\<lambda>n x. if x \<in> ?U n then norm(?D x) else 0"
  3455       show "?h integrable_on UNIV"
  3456       proof (rule monotone_convergence_increasing [THEN conjunct1])
  3457         show "?nD k integrable_on UNIV" for k
  3458           using DUn
  3459           unfolding integrable_restrict_UNIV absolutely_integrable_on_def by (simp add: image_UN)
  3460         { fix n::nat
  3461           have "(norm \<circ> f) absolutely_integrable_on (\<Union>m\<le>n. g ` F m)"
  3462             apply (rule absolutely_integrable_norm)
  3463             using fgU by blast
  3464           then have "integral (?U n) (norm \<circ> ?D) = integral (g ` ?U n) (norm \<circ> f)"
  3465             using iff [of n "?lift \<circ> norm \<circ> f" "integral (g ` ?U n) (?lift \<circ> norm \<circ> f)"]
  3466             unfolding absolutely_integrable_on_1_iff integral_on_1_eq image_UN by (auto simp: o_def)
  3467         }
  3468         moreover have "bounded (range (\<lambda>k. integral (g ` ?U k) (norm \<circ> f)))"
  3469           unfolding bounded_iff
  3470         proof (rule exI, clarify)
  3471           fix k
  3472           show "norm (integral (g ` ?U k) (norm \<circ> f)) \<le> integral (g ` (\<Union>n. F n)) (norm \<circ> f)"
  3473             unfolding integral_restrict_UNIV [of _ "norm \<circ> f", symmetric]
  3474           proof (rule integral_norm_bound_integral)
  3475             show "(\<lambda>x. if x \<in> g ` ?U k then (norm \<circ> f) x else 0) integrable_on UNIV"
  3476                  "(\<lambda>x. if x \<in> g ` (\<Union>n. F n) then (norm \<circ> f) x else 0) integrable_on UNIV"
  3477               using fgU fs
  3478               unfolding absolutely_integrable_on_def o_def integrable_restrict_UNIV
  3479               by (auto simp: image_UN)
  3480           qed auto
  3481         qed
  3482         ultimately show "bounded (range (\<lambda>k. integral UNIV (?nD k)))"
  3483           unfolding integral_restrict_UNIV image_UN [symmetric] o_def by simp
  3484       next
  3485         show "(\<lambda>k. if x \<in> ?U k then norm (?D x) else 0) \<longlonglongrightarrow> (if x \<in> (\<Union>n. F n) then norm (?D x) else 0)" for x
  3486           by (force intro: Lim_eventually eventually_sequentiallyI)
  3487       qed auto
  3488     next
  3489       show "(\<lambda>k. if x \<in> ?U k then ?D x else 0) \<longlonglongrightarrow> (if x \<in> (\<Union>n. F n) then ?D x else 0)" for x
  3490       proof clarsimp
  3491         fix n
  3492         assume "x \<in> F n"
  3493         show "(\<lambda>m. if \<exists>j\<in>{..m}. x \<in> F j then ?D x else 0) \<longlonglongrightarrow> ?D x"
  3494           using \<open>x \<in> F n\<close> by (auto intro!: Lim_eventually eventually_sequentiallyI [of n])
  3495       qed
  3496     qed auto
  3497     then show Dai: "?D absolutely_integrable_on (\<Union>n. F n)"
  3498       unfolding absolutely_integrable_restrict_UNIV by simp
  3499     show "integral (\<Union>n. F n) ?D = integral ((\<Union>x. g ` F x)) f"
  3500     proof (rule LIMSEQ_unique)
  3501       show "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>x. g ` F x) f"
  3502         by (rule fgU)
  3503       show "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
  3504         unfolding D_int [symmetric] by (rule integral_countable_UN [OF Dai F_leb])
  3505     qed
  3506   qed
  3507 qed
  3508 
  3509 
  3510 theorem has_absolute_integral_change_of_variables:
  3511   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3512   assumes S: "S \<in> sets lebesgue"
  3513     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3514     and inj: "inj_on g S"
  3515   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3516            integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
  3517      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3518 proof -
  3519   obtain C N where "fsigma C" "negligible N" and CNS: "C \<union> N = S" and "disjnt C N"
  3520     using lebesgue_set_almost_fsigma [OF S] .
  3521   then obtain F :: "nat \<Rightarrow> (real^'m::_) set"
  3522     where F: "range F \<subseteq> Collect compact" and Ceq: "C = Union(range F)"
  3523     using fsigma_Union_compact by metis
  3524   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)"
  3525   have "?D absolutely_integrable_on C \<and> integral C ?D = b
  3526     \<longleftrightarrow> f absolutely_integrable_on (g ` C) \<and> integral (g ` C) f = b"
  3527     unfolding Ceq
  3528   proof (rule has_absolute_integral_change_of_variables_compact_family)
  3529     fix n x
  3530     assume "x \<in> \<Union>(F ` UNIV)"
  3531     then show "(g has_derivative g' x) (at x within \<Union>(F ` UNIV))"
  3532       using Ceq \<open>C \<union> N = S\<close> der_g has_derivative_within_subset by blast
  3533   next
  3534     have "\<Union>(F ` UNIV) \<subseteq> S"
  3535       using Ceq \<open>C \<union> N = S\<close> by blast
  3536     then show "inj_on g (\<Union>(F ` UNIV))"
  3537       using inj by (meson inj_on_subset)
  3538   qed (use F in auto)
  3539   moreover
  3540   have "?D absolutely_integrable_on C \<and> integral C ?D = b
  3541     \<longleftrightarrow> ?D absolutely_integrable_on S \<and> integral S ?D = b"
  3542   proof (rule conj_cong)
  3543     have neg: "negligible {x \<in> C - S. ?D x \<noteq> 0}" "negligible {x \<in> S - C. ?D x \<noteq> 0}"
  3544       using CNS by (blast intro: negligible_subset [OF \<open>negligible N\<close>])+
  3545     then show "(?D absolutely_integrable_on C) = (?D absolutely_integrable_on S)"
  3546       by (rule absolutely_integrable_spike_set_eq)
  3547     show "(integral C ?D = b) \<longleftrightarrow> (integral S ?D = b)"
  3548       using integral_spike_set [OF neg] by simp
  3549   qed
  3550   moreover
  3551   have "f absolutely_integrable_on (g ` C) \<and> integral (g ` C) f = b
  3552     \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3553   proof (rule conj_cong)
  3554     have "g differentiable_on N"
  3555       by (metis CNS der_g differentiable_def differentiable_on_def differentiable_on_subset sup.cobounded2)
  3556     with \<open>negligible N\<close>
  3557     have neg_gN: "negligible (g ` N)"
  3558       by (blast intro: negligible_differentiable_image_negligible)
  3559     have neg: "negligible {x \<in> g ` C - g ` S. f x \<noteq> 0}"
  3560               "negligible {x \<in> g ` S - g ` C. f x \<noteq> 0}"
  3561       using CNS by (blast intro: negligible_subset [OF neg_gN])+
  3562     then show "(f absolutely_integrable_on g ` C) = (f absolutely_integrable_on g ` S)"
  3563       by (rule absolutely_integrable_spike_set_eq)
  3564     show "(integral (g ` C) f = b) \<longleftrightarrow> (integral (g ` S) f = b)"
  3565       using integral_spike_set [OF neg] by simp
  3566   qed
  3567   ultimately show ?thesis
  3568     by simp
  3569 qed
  3570 
  3571 
  3572 corollary absolutely_integrable_change_of_variables:
  3573   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3574   assumes "S \<in> sets lebesgue"
  3575     and "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3576     and "inj_on g S"
  3577   shows "f absolutely_integrable_on (g ` S)
  3578      \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S"
  3579   using%unimportant assms has_absolute_integral_change_of_variables by%unimportant blast
  3580 
  3581 corollary integral_change_of_variables:
  3582   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3583   assumes S: "S \<in> sets lebesgue"
  3584     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
  3585     and inj: "inj_on g S"
  3586     and disj: "(f absolutely_integrable_on (g ` S) \<or>
  3587         (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S)"
  3588   shows "integral (g ` S) f = integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x))"
  3589   using%unimportant has_absolute_integral_change_of_variables [OF S der_g inj] disj
  3590   by%unimportant blast
  3591 
  3592 lemma has_absolute_integral_change_of_variables_1:
  3593   fixes f :: "real \<Rightarrow> real^'n::{finite,wellorder}" and g :: "real \<Rightarrow> real"
  3594   assumes S: "S \<in> sets lebesgue"
  3595     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_vector_derivative g' x) (at x within S)"
  3596     and inj: "inj_on g S"
  3597   shows "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3598            integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) = b
  3599      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3600 proof -
  3601   let ?lift = "vec :: real \<Rightarrow> real^1"
  3602   let ?drop = "(\<lambda>x::real^1. x $ 1)"
  3603   have S': "?lift ` S \<in> sets lebesgue"
  3604     by (auto intro: differentiable_image_in_sets_lebesgue [OF S] differentiable_vec)
  3605   have "((\<lambda>x. vec (g (x $ 1))) has_derivative (*\<^sub>R) (g' z)) (at (vec z) within ?lift ` S)"
  3606     if "z \<in> S" for z
  3607     using der_g [OF that]
  3608     by (simp add: has_vector_derivative_def has_derivative_vector_1)
  3609   then have der': "\<And>x. x \<in> ?lift ` S \<Longrightarrow>
  3610         (?lift \<circ> g \<circ> ?drop has_derivative (*\<^sub>R) (g' (?drop x))) (at x within ?lift ` S)"
  3611     by (auto simp: o_def)
  3612   have inj': "inj_on (vec \<circ> g \<circ> ?drop) (vec ` S)"
  3613     using inj by (simp add: inj_on_def)
  3614   let ?fg = "\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)"
  3615   have "((\<lambda>x. ?fg x $ i) absolutely_integrable_on S \<and> ((\<lambda>x. ?fg x $ i) has_integral b $ i) S
  3616     \<longleftrightarrow> (\<lambda>x. f x $ i) absolutely_integrable_on g ` S \<and> ((\<lambda>x. f x $ i) has_integral b $ i) (g ` S))" for i
  3617     using has_absolute_integral_change_of_variables [OF S' der' inj', of "\<lambda>x. ?lift(f (?drop x) $ i)" "?lift (b$i)"]
  3618     unfolding integrable_on_1_iff integral_on_1_eq absolutely_integrable_on_1_iff absolutely_integrable_drop absolutely_integrable_on_def
  3619     by (auto simp: image_comp o_def integral_vec1_eq has_integral_iff)
  3620   then have "?fg absolutely_integrable_on S \<and> (?fg has_integral b) S
  3621          \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> (f has_integral b) (g ` S)"
  3622     unfolding has_integral_componentwise_iff [where y=b]
  3623            absolutely_integrable_componentwise_iff [where f=f]
  3624            absolutely_integrable_componentwise_iff [where f = ?fg]
  3625     by (force simp: Basis_vec_def cart_eq_inner_axis)
  3626   then show ?thesis
  3627     using absolutely_integrable_on_def by blast
  3628 qed
  3629 
  3630 
  3631 corollary absolutely_integrable_change_of_variables_1:
  3632   fixes f :: "real \<Rightarrow> real^'n::{finite,wellorder}" and g :: "real \<Rightarrow> real"
  3633   assumes S: "S \<in> sets lebesgue"
  3634     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_vector_derivative g' x) (at x within S)"
  3635     and inj: "inj_on g S"
  3636   shows "(f absolutely_integrable_on g ` S \<longleftrightarrow>
  3637              (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S)"
  3638   using%unimportant has_absolute_integral_change_of_variables_1 [OF assms] by%unimportant auto
  3639 
  3640 
  3641 subsection\<open>Change of variables for integrals: special case of linear function\<close>
  3642 
  3643 lemma has_absolute_integral_change_of_variables_linear:
  3644   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3645   assumes "linear g"
  3646   shows "(\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
  3647            integral S (\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) = b
  3648      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
  3649 proof (cases "det(matrix g) = 0")
  3650   case True
  3651   then have "negligible(g ` S)"
  3652     using assms det_nz_iff_inj negligible_linear_singular_image by blast
  3653   with True show ?thesis
  3654     by (auto simp: absolutely_integrable_on_def integrable_negligible integral_negligible)
  3655 next
  3656   case False
  3657   then obtain h where h: "\<And>x. x \<in> S \<Longrightarrow> h (g x) = x" "linear h"
  3658     using assms det_nz_iff_inj linear_injective_isomorphism by blast
  3659   show ?thesis
  3660   proof (rule has_absolute_integral_change_of_variables_invertible)
  3661     show "(g has_derivative g) (at x within S)" for x
  3662       by (simp add: assms linear_imp_has_derivative)
  3663     show "continuous_on (g ` S) h"
  3664       using continuous_on_eq_continuous_within has_derivative_continuous linear_imp_has_derivative h by blast
  3665   qed (use h in auto)
  3666 qed
  3667 
  3668 lemma absolutely_integrable_change_of_variables_linear:
  3669   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3670   assumes "linear g"
  3671   shows "(\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S
  3672      \<longleftrightarrow> f absolutely_integrable_on (g ` S)"
  3673   using assms has_absolute_integral_change_of_variables_linear by blast
  3674 
  3675 lemma absolutely_integrable_on_linear_image:
  3676   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3677   assumes "linear g"
  3678   shows "f absolutely_integrable_on (g ` S)
  3679      \<longleftrightarrow> (f \<circ> g) absolutely_integrable_on S \<or> det(matrix g) = 0"
  3680   unfolding assms absolutely_integrable_change_of_variables_linear [OF assms, symmetric] absolutely_integrable_on_scaleR_iff
  3681   by (auto simp: set_integrable_def)
  3682 
  3683 lemma integral_change_of_variables_linear:
  3684   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
  3685   assumes "linear g"
  3686       and "f absolutely_integrable_on (g ` S) \<or> (f \<circ> g) absolutely_integrable_on S"
  3687     shows "integral (g ` S) f = \<bar>det (matrix g)\<bar> *\<^sub>R integral S (f \<circ> g)"
  3688 proof -
  3689   have "((\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f (g x)) absolutely_integrable_on S) \<or> (f absolutely_integrable_on g ` S)"
  3690     using absolutely_integrable_on_linear_image assms by blast
  3691   moreover
  3692   have ?thesis if "((\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f (g x)) absolutely_integrable_on S)" "(f absolutely_integrable_on g ` S)"
  3693     using has_absolute_integral_change_of_variables_linear [OF \<open>linear g\<close>] that
  3694     by (auto simp: o_def)
  3695   ultimately show ?thesis
  3696     using absolutely_integrable_change_of_variables_linear [OF \<open>linear g\<close>]
  3697     by blast
  3698 qed
  3699 
  3700 subsection\<open>Change of variable for measure\<close>
  3701 
  3702 lemma has_measure_differentiable_image:
  3703   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  3704   assumes "S \<in> sets lebesgue"
  3705       and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  3706       and "inj_on f S"
  3707   shows "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) = m
  3708      \<longleftrightarrow> ((\<lambda>x. \<bar>det (matrix (f' x))\<bar>) has_integral m) S"
  3709   using has_absolute_integral_change_of_variables [OF assms, of "\<lambda>x. (1::real^1)" "vec m"]
  3710   unfolding absolutely_integrable_on_1_iff integral_on_1_eq integrable_on_1_iff absolutely_integrable_on_def
  3711   by (auto simp: has_integral_iff lmeasurable_iff_integrable_on lmeasure_integral)
  3712 
  3713 lemma measurable_differentiable_image_eq:
  3714   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  3715   assumes "S \<in> sets lebesgue"
  3716       and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  3717       and "inj_on f S"
  3718   shows "f ` S \<in> lmeasurable \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
  3719   using has_measure_differentiable_image [OF assms]
  3720   by blast
  3721 
  3722 lemma measurable_differentiable_image_alt:
  3723   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  3724   assumes "S \<in> sets lebesgue"
  3725     and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  3726     and "inj_on f S"
  3727   shows "f ` S \<in> lmeasurable \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
  3728   using measurable_differentiable_image_eq [OF assms]
  3729   by (simp only: absolutely_integrable_on_iff_nonneg)
  3730 
  3731 lemma measure_differentiable_image_eq:
  3732   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
  3733   assumes S: "S \<in> sets lebesgue"
  3734     and der_f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  3735     and inj: "inj_on f S"
  3736     and intS: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
  3737   shows "measure lebesgue (f ` S) = integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
  3738   using measurable_differentiable_image_eq [OF S der_f inj]
  3739         assms has_measure_differentiable_image by blast
  3740 
  3741 end