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