--- a/Admin/isatest/isatest-settings Mon Jan 31 11:15:02 2011 +0100
+++ b/Admin/isatest/isatest-settings Mon Jan 31 11:18:29 2011 +0100
@@ -21,7 +21,6 @@
blanchet@in.tum.de \
boehmes@in.tum.de \
bulwahn@in.tum.de \
-haftmann@in.tum.de \
hoelzl@in.tum.de \
krauss@in.tum.de \
noschinl@in.tum.de"
--- a/Admin/mira.py Mon Jan 31 11:15:02 2011 +0100
+++ b/Admin/mira.py Mon Jan 31 11:18:29 2011 +0100
@@ -209,10 +209,9 @@
except IOError:
mutabelle_log = ''
- attachments = { 'log': log, 'mutabelle_log': mutabelle_log}
-
return (return_code == 0 and mutabelle_log != '', extract_isabelle_run_summary(log),
- {'timing': extract_isabelle_run_timing(log)}, {'log': log}, None)
+ {'timing': extract_isabelle_run_timing(log)},
+ {'log': log, 'mutabelle_log': mutabelle_log}, None)
@configuration(repos = [Isabelle], deps = [(HOL, [0])])
def Mutabelle_Relation(*args):
--- a/CONTRIBUTORS Mon Jan 31 11:15:02 2011 +0100
+++ b/CONTRIBUTORS Mon Jan 31 11:18:29 2011 +0100
@@ -3,6 +3,10 @@
who is listed as an author in one of the source files of this Isabelle
distribution.
+Contributions to this Isabelle version
+--------------------------------------
+
+
Contributions to Isabelle2011
-----------------------------
--- a/NEWS Mon Jan 31 11:15:02 2011 +0100
+++ b/NEWS Mon Jan 31 11:18:29 2011 +0100
@@ -1,6 +1,11 @@
Isabelle NEWS -- history user-relevant changes
==============================================
+New in this Isabelle version
+----------------------------
+
+
+
New in Isabelle2011 (January 2011)
----------------------------------
--- a/src/HOL/Finite_Set.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Finite_Set.thy Mon Jan 31 11:18:29 2011 +0100
@@ -11,94 +11,48 @@
subsection {* Predicate for finite sets *}
-inductive finite :: "'a set => bool"
+inductive finite :: "'a set \<Rightarrow> bool"
where
emptyI [simp, intro!]: "finite {}"
- | insertI [simp, intro!]: "finite A ==> finite (insert a A)"
+ | insertI [simp, intro!]: "finite A \<Longrightarrow> finite (insert a A)"
+
+lemma finite_induct [case_names empty insert, induct set: finite]:
+ -- {* Discharging @{text "x \<notin> F"} entails extra work. *}
+ assumes "finite F"
+ assumes "P {}"
+ and insert: "\<And>x F. finite F \<Longrightarrow> x \<notin> F \<Longrightarrow> P F \<Longrightarrow> P (insert x F)"
+ shows "P F"
+using `finite F` proof induct
+ show "P {}" by fact
+ fix x F assume F: "finite F" and P: "P F"
+ show "P (insert x F)"
+ proof cases
+ assume "x \<in> F"
+ hence "insert x F = F" by (rule insert_absorb)
+ with P show ?thesis by (simp only:)
+ next
+ assume "x \<notin> F"
+ from F this P show ?thesis by (rule insert)
+ qed
+qed
+
+
+subsubsection {* Choice principles *}
lemma ex_new_if_finite: -- "does not depend on def of finite at all"
assumes "\<not> finite (UNIV :: 'a set)" and "finite A"
shows "\<exists>a::'a. a \<notin> A"
proof -
from assms have "A \<noteq> UNIV" by blast
- thus ?thesis by blast
-qed
-
-lemma finite_induct [case_names empty insert, induct set: finite]:
- "finite F ==>
- P {} ==> (!!x F. finite F ==> x \<notin> F ==> P F ==> P (insert x F)) ==> P F"
- -- {* Discharging @{text "x \<notin> F"} entails extra work. *}
-proof -
- assume "P {}" and
- insert: "!!x F. finite F ==> x \<notin> F ==> P F ==> P (insert x F)"
- assume "finite F"
- thus "P F"
- proof induct
- show "P {}" by fact
- fix x F assume F: "finite F" and P: "P F"
- show "P (insert x F)"
- proof cases
- assume "x \<in> F"
- hence "insert x F = F" by (rule insert_absorb)
- with P show ?thesis by (simp only:)
- next
- assume "x \<notin> F"
- from F this P show ?thesis by (rule insert)
- qed
- qed
+ then show ?thesis by blast
qed
-lemma finite_ne_induct[case_names singleton insert, consumes 2]:
-assumes fin: "finite F" shows "F \<noteq> {} \<Longrightarrow>
- \<lbrakk> \<And>x. P{x};
- \<And>x F. \<lbrakk> finite F; F \<noteq> {}; x \<notin> F; P F \<rbrakk> \<Longrightarrow> P (insert x F) \<rbrakk>
- \<Longrightarrow> P F"
-using fin
-proof induct
- case empty thus ?case by simp
-next
- case (insert x F)
- show ?case
- proof cases
- assume "F = {}"
- thus ?thesis using `P {x}` by simp
- next
- assume "F \<noteq> {}"
- thus ?thesis using insert by blast
- qed
-qed
+text {* A finite choice principle. Does not need the SOME choice operator. *}
-lemma finite_subset_induct [consumes 2, case_names empty insert]:
- assumes "finite F" and "F \<subseteq> A"
- and empty: "P {}"
- and insert: "!!a F. finite F ==> a \<in> A ==> a \<notin> F ==> P F ==> P (insert a F)"
- shows "P F"
-proof -
- from `finite F` and `F \<subseteq> A`
- show ?thesis
- proof induct
- show "P {}" by fact
- next
- fix x F
- assume "finite F" and "x \<notin> F" and
- P: "F \<subseteq> A ==> P F" and i: "insert x F \<subseteq> A"
- show "P (insert x F)"
- proof (rule insert)
- from i show "x \<in> A" by blast
- from i have "F \<subseteq> A" by blast
- with P show "P F" .
- show "finite F" by fact
- show "x \<notin> F" by fact
- qed
- qed
-qed
-
-
-text{* A finite choice principle. Does not need the SOME choice operator. *}
lemma finite_set_choice:
- "finite A \<Longrightarrow> ALL x:A. (EX y. P x y) \<Longrightarrow> EX f. ALL x:A. P x (f x)"
-proof (induct set: finite)
- case empty thus ?case by simp
+ "finite A \<Longrightarrow> \<forall>x\<in>A. \<exists>y. P x y \<Longrightarrow> \<exists>f. \<forall>x\<in>A. P x (f x)"
+proof (induct rule: finite_induct)
+ case empty then show ?case by simp
next
case (insert a A)
then obtain f b where f: "ALL x:A. P x (f x)" and ab: "P a b" by auto
@@ -109,16 +63,16 @@
qed
-text{* Finite sets are the images of initial segments of natural numbers: *}
+subsubsection {* Finite sets are the images of initial segments of natural numbers *}
lemma finite_imp_nat_seg_image_inj_on:
- assumes fin: "finite A"
- shows "\<exists> (n::nat) f. A = f ` {i. i<n} & inj_on f {i. i<n}"
-using fin
-proof induct
+ assumes "finite A"
+ shows "\<exists>(n::nat) f. A = f ` {i. i < n} \<and> inj_on f {i. i < n}"
+using assms proof induct
case empty
- show ?case
- proof show "\<exists>f. {} = f ` {i::nat. i < 0} & inj_on f {i. i<0}" by simp
+ show ?case
+ proof
+ show "\<exists>f. {} = f ` {i::nat. i < 0} \<and> inj_on f {i. i < 0}" by simp
qed
next
case (insert a A)
@@ -132,8 +86,8 @@
qed
lemma nat_seg_image_imp_finite:
- "!!f A. A = f ` {i::nat. i<n} \<Longrightarrow> finite A"
-proof (induct n)
+ "A = f ` {i::nat. i < n} \<Longrightarrow> finite A"
+proof (induct n arbitrary: A)
case 0 thus ?case by simp
next
case (Suc n)
@@ -152,12 +106,12 @@
qed
lemma finite_conv_nat_seg_image:
- "finite A = (\<exists> (n::nat) f. A = f ` {i::nat. i<n})"
-by(blast intro: nat_seg_image_imp_finite dest: finite_imp_nat_seg_image_inj_on)
+ "finite A \<longleftrightarrow> (\<exists>(n::nat) f. A = f ` {i::nat. i < n})"
+ by (blast intro: nat_seg_image_imp_finite dest: finite_imp_nat_seg_image_inj_on)
lemma finite_imp_inj_to_nat_seg:
-assumes "finite A"
-shows "EX f n::nat. f`A = {i. i<n} & inj_on f A"
+ assumes "finite A"
+ shows "\<exists>f n::nat. f ` A = {i. i < n} \<and> inj_on f A"
proof -
from finite_imp_nat_seg_image_inj_on[OF `finite A`]
obtain f and n::nat where bij: "bij_betw f {i. i<n} A"
@@ -168,160 +122,131 @@
thus ?thesis by blast
qed
-lemma finite_Collect_less_nat[iff]: "finite{n::nat. n<k}"
-by(fastsimp simp: finite_conv_nat_seg_image)
+lemma finite_Collect_less_nat [iff]:
+ "finite {n::nat. n < k}"
+ by (fastsimp simp: finite_conv_nat_seg_image)
-text {* Finiteness and set theoretic constructions *}
+lemma finite_Collect_le_nat [iff]:
+ "finite {n::nat. n \<le> k}"
+ by (simp add: le_eq_less_or_eq Collect_disj_eq)
-lemma finite_UnI: "finite F ==> finite G ==> finite (F Un G)"
-by (induct set: finite) simp_all
+
+subsubsection {* Finiteness and common set operations *}
-lemma finite_subset: "A \<subseteq> B ==> finite B ==> finite A"
- -- {* Every subset of a finite set is finite. *}
-proof -
- assume "finite B"
- thus "!!A. A \<subseteq> B ==> finite A"
- proof induct
- case empty
- thus ?case by simp
+lemma rev_finite_subset:
+ "finite B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> finite A"
+proof (induct arbitrary: A rule: finite_induct)
+ case empty
+ then show ?case by simp
+next
+ case (insert x F A)
+ have A: "A \<subseteq> insert x F" and r: "A - {x} \<subseteq> F \<Longrightarrow> finite (A - {x})" by fact+
+ show "finite A"
+ proof cases
+ assume x: "x \<in> A"
+ with A have "A - {x} \<subseteq> F" by (simp add: subset_insert_iff)
+ with r have "finite (A - {x})" .
+ hence "finite (insert x (A - {x}))" ..
+ also have "insert x (A - {x}) = A" using x by (rule insert_Diff)
+ finally show ?thesis .
next
- case (insert x F A)
- have A: "A \<subseteq> insert x F" and r: "A - {x} \<subseteq> F ==> finite (A - {x})" by fact+
- show "finite A"
- proof cases
- assume x: "x \<in> A"
- with A have "A - {x} \<subseteq> F" by (simp add: subset_insert_iff)
- with r have "finite (A - {x})" .
- hence "finite (insert x (A - {x}))" ..
- also have "insert x (A - {x}) = A" using x by (rule insert_Diff)
- finally show ?thesis .
- next
- show "A \<subseteq> F ==> ?thesis" by fact
- assume "x \<notin> A"
- with A show "A \<subseteq> F" by (simp add: subset_insert_iff)
- qed
+ show "A \<subseteq> F ==> ?thesis" by fact
+ assume "x \<notin> A"
+ with A show "A \<subseteq> F" by (simp add: subset_insert_iff)
qed
qed
-lemma rev_finite_subset: "finite B ==> A \<subseteq> B ==> finite A"
-by (rule finite_subset)
-
-lemma finite_Un [iff]: "finite (F Un G) = (finite F & finite G)"
-by (blast intro: finite_subset [of _ "X Un Y", standard] finite_UnI)
-
-lemma finite_Collect_disjI[simp]:
- "finite{x. P x | Q x} = (finite{x. P x} & finite{x. Q x})"
-by(simp add:Collect_disj_eq)
-
-lemma finite_Int [simp, intro]: "finite F | finite G ==> finite (F Int G)"
- -- {* The converse obviously fails. *}
-by (blast intro: finite_subset)
+lemma finite_subset:
+ "A \<subseteq> B \<Longrightarrow> finite B \<Longrightarrow> finite A"
+ by (rule rev_finite_subset)
-lemma finite_Collect_conjI [simp, intro]:
- "finite{x. P x} | finite{x. Q x} ==> finite{x. P x & Q x}"
- -- {* The converse obviously fails. *}
-by(simp add:Collect_conj_eq)
-
-lemma finite_Collect_le_nat[iff]: "finite{n::nat. n<=k}"
-by(simp add: le_eq_less_or_eq)
-
-lemma finite_insert [simp]: "finite (insert a A) = finite A"
- apply (subst insert_is_Un)
- apply (simp only: finite_Un, blast)
- done
-
-lemma finite_Union[simp, intro]:
- "\<lbrakk> finite A; !!M. M \<in> A \<Longrightarrow> finite M \<rbrakk> \<Longrightarrow> finite(\<Union>A)"
-by (induct rule:finite_induct) simp_all
-
-lemma finite_Inter[intro]: "EX A:M. finite(A) \<Longrightarrow> finite(Inter M)"
-by (blast intro: Inter_lower finite_subset)
+lemma finite_UnI:
+ assumes "finite F" and "finite G"
+ shows "finite (F \<union> G)"
+ using assms by induct simp_all
-lemma finite_INT[intro]: "EX x:I. finite(A x) \<Longrightarrow> finite(INT x:I. A x)"
-by (blast intro: INT_lower finite_subset)
+lemma finite_Un [iff]:
+ "finite (F \<union> G) \<longleftrightarrow> finite F \<and> finite G"
+ by (blast intro: finite_UnI finite_subset [of _ "F \<union> G"])
-lemma finite_empty_induct:
- assumes "finite A"
- and "P A"
- and "!!a A. finite A ==> a:A ==> P A ==> P (A - {a})"
- shows "P {}"
+lemma finite_insert [simp]: "finite (insert a A) \<longleftrightarrow> finite A"
proof -
- have "P (A - A)"
- proof -
- {
- fix c b :: "'a set"
- assume c: "finite c" and b: "finite b"
- and P1: "P b" and P2: "!!x y. finite y ==> x \<in> y ==> P y ==> P (y - {x})"
- have "c \<subseteq> b ==> P (b - c)"
- using c
- proof induct
- case empty
- from P1 show ?case by simp
- next
- case (insert x F)
- have "P (b - F - {x})"
- proof (rule P2)
- from _ b show "finite (b - F)" by (rule finite_subset) blast
- from insert show "x \<in> b - F" by simp
- from insert show "P (b - F)" by simp
- qed
- also have "b - F - {x} = b - insert x F" by (rule Diff_insert [symmetric])
- finally show ?case .
- qed
- }
- then show ?thesis by this (simp_all add: assms)
- qed
+ have "finite {a} \<and> finite A \<longleftrightarrow> finite A" by simp
+ then have "finite ({a} \<union> A) \<longleftrightarrow> finite A" by (simp only: finite_Un)
then show ?thesis by simp
qed
-lemma finite_Diff [simp, intro]: "finite A ==> finite (A - B)"
-by (rule Diff_subset [THEN finite_subset])
+lemma finite_Int [simp, intro]:
+ "finite F \<or> finite G \<Longrightarrow> finite (F \<inter> G)"
+ by (blast intro: finite_subset)
+
+lemma finite_Collect_conjI [simp, intro]:
+ "finite {x. P x} \<or> finite {x. Q x} \<Longrightarrow> finite {x. P x \<and> Q x}"
+ by (simp add: Collect_conj_eq)
+
+lemma finite_Collect_disjI [simp]:
+ "finite {x. P x \<or> Q x} \<longleftrightarrow> finite {x. P x} \<and> finite {x. Q x}"
+ by (simp add: Collect_disj_eq)
+
+lemma finite_Diff [simp, intro]:
+ "finite A \<Longrightarrow> finite (A - B)"
+ by (rule finite_subset, rule Diff_subset)
lemma finite_Diff2 [simp]:
- assumes "finite B" shows "finite (A - B) = finite A"
+ assumes "finite B"
+ shows "finite (A - B) \<longleftrightarrow> finite A"
proof -
- have "finite A \<longleftrightarrow> finite((A-B) Un (A Int B))" by(simp add: Un_Diff_Int)
- also have "\<dots> \<longleftrightarrow> finite(A-B)" using `finite B` by(simp)
+ have "finite A \<longleftrightarrow> finite((A - B) \<union> (A \<inter> B))" by (simp add: Un_Diff_Int)
+ also have "\<dots> \<longleftrightarrow> finite (A - B)" using `finite B` by simp
finally show ?thesis ..
qed
+lemma finite_Diff_insert [iff]:
+ "finite (A - insert a B) \<longleftrightarrow> finite (A - B)"
+proof -
+ have "finite (A - B) \<longleftrightarrow> finite (A - B - {a})" by simp
+ moreover have "A - insert a B = A - B - {a}" by auto
+ ultimately show ?thesis by simp
+qed
+
lemma finite_compl[simp]:
- "finite(A::'a set) \<Longrightarrow> finite(-A) = finite(UNIV::'a set)"
-by(simp add:Compl_eq_Diff_UNIV)
+ "finite (A :: 'a set) \<Longrightarrow> finite (- A) \<longleftrightarrow> finite (UNIV :: 'a set)"
+ by (simp add: Compl_eq_Diff_UNIV)
lemma finite_Collect_not[simp]:
- "finite{x::'a. P x} \<Longrightarrow> finite{x. ~P x} = finite(UNIV::'a set)"
-by(simp add:Collect_neg_eq)
+ "finite {x :: 'a. P x} \<Longrightarrow> finite {x. \<not> P x} \<longleftrightarrow> finite (UNIV :: 'a set)"
+ by (simp add: Collect_neg_eq)
+
+lemma finite_Union [simp, intro]:
+ "finite A \<Longrightarrow> (\<And>M. M \<in> A \<Longrightarrow> finite M) \<Longrightarrow> finite(\<Union>A)"
+ by (induct rule: finite_induct) simp_all
+
+lemma finite_UN_I [intro]:
+ "finite A \<Longrightarrow> (\<And>a. a \<in> A \<Longrightarrow> finite (B a)) \<Longrightarrow> finite (\<Union>a\<in>A. B a)"
+ by (induct rule: finite_induct) simp_all
-lemma finite_Diff_insert [iff]: "finite (A - insert a B) = finite (A - B)"
- apply (subst Diff_insert)
- apply (case_tac "a : A - B")
- apply (rule finite_insert [symmetric, THEN trans])
- apply (subst insert_Diff, simp_all)
- done
+lemma finite_UN [simp]:
+ "finite A \<Longrightarrow> finite (UNION A B) \<longleftrightarrow> (\<forall>x\<in>A. finite (B x))"
+ by (blast intro: finite_subset)
+
+lemma finite_Inter [intro]:
+ "\<exists>A\<in>M. finite A \<Longrightarrow> finite (\<Inter>M)"
+ by (blast intro: Inter_lower finite_subset)
-
-text {* Image and Inverse Image over Finite Sets *}
+lemma finite_INT [intro]:
+ "\<exists>x\<in>I. finite (A x) \<Longrightarrow> finite (\<Inter>x\<in>I. A x)"
+ by (blast intro: INT_lower finite_subset)
-lemma finite_imageI[simp, intro]: "finite F ==> finite (h ` F)"
- -- {* The image of a finite set is finite. *}
- by (induct set: finite) simp_all
+lemma finite_imageI [simp, intro]:
+ "finite F \<Longrightarrow> finite (h ` F)"
+ by (induct rule: finite_induct) simp_all
lemma finite_image_set [simp]:
"finite {x. P x} \<Longrightarrow> finite { f x | x. P x }"
by (simp add: image_Collect [symmetric])
-lemma finite_surj: "finite A ==> B <= f ` A ==> finite B"
- apply (frule finite_imageI)
- apply (erule finite_subset, assumption)
- done
-
-lemma finite_range_imageI:
- "finite (range g) ==> finite (range (%x. f (g x)))"
- apply (drule finite_imageI, simp add: range_composition)
- done
-
-lemma finite_imageD: "finite (f`A) ==> inj_on f A ==> finite A"
+lemma finite_imageD:
+ "finite (f ` A) \<Longrightarrow> inj_on f A \<Longrightarrow> finite A"
proof -
have aux: "!!A. finite (A - {}) = finite A" by simp
fix B :: "'a set"
@@ -340,18 +265,28 @@
done
qed (rule refl)
+lemma finite_surj:
+ "finite A \<Longrightarrow> B \<subseteq> f ` A \<Longrightarrow> finite B"
+ by (erule finite_subset) (rule finite_imageI)
-lemma inj_vimage_singleton: "inj f ==> f-`{a} \<subseteq> {THE x. f x = a}"
- -- {* The inverse image of a singleton under an injective function
- is included in a singleton. *}
- apply (auto simp add: inj_on_def)
- apply (blast intro: the_equality [symmetric])
- done
+lemma finite_range_imageI:
+ "finite (range g) \<Longrightarrow> finite (range (\<lambda>x. f (g x)))"
+ by (drule finite_imageI) (simp add: range_composition)
-lemma finite_vimageI: "[|finite F; inj h|] ==> finite (h -` F)"
- -- {* The inverse image of a finite set under an injective function
- is finite. *}
- apply (induct set: finite)
+lemma finite_subset_image:
+ assumes "finite B"
+ shows "B \<subseteq> f ` A \<Longrightarrow> \<exists>C\<subseteq>A. finite C \<and> B = f ` C"
+using assms proof induct
+ case empty then show ?case by simp
+next
+ case insert then show ?case
+ by (clarsimp simp del: image_insert simp add: image_insert [symmetric])
+ blast
+qed
+
+lemma finite_vimageI:
+ "finite F \<Longrightarrow> inj h \<Longrightarrow> finite (h -` F)"
+ apply (induct rule: finite_induct)
apply simp_all
apply (subst vimage_insert)
apply (simp add: finite_subset [OF inj_vimage_singleton])
@@ -369,40 +304,25 @@
lemma finite_vimage_iff: "bij h \<Longrightarrow> finite (h -` F) \<longleftrightarrow> finite F"
unfolding bij_def by (auto elim: finite_vimageD finite_vimageI)
-
-text {* The finite UNION of finite sets *}
-
-lemma finite_UN_I[intro]:
- "finite A ==> (!!a. a:A ==> finite (B a)) ==> finite (UN a:A. B a)"
-by (induct set: finite) simp_all
-
-text {*
- Strengthen RHS to
- @{prop "((ALL x:A. finite (B x)) & finite {x. x:A & B x \<noteq> {}})"}?
-
- We'd need to prove
- @{prop "finite C ==> ALL A B. (UNION A B) <= C --> finite {x. x:A & B x \<noteq> {}}"}
- by induction. *}
+lemma finite_Collect_bex [simp]:
+ assumes "finite A"
+ shows "finite {x. \<exists>y\<in>A. Q x y} \<longleftrightarrow> (\<forall>y\<in>A. finite {x. Q x y})"
+proof -
+ have "{x. \<exists>y\<in>A. Q x y} = (\<Union>y\<in>A. {x. Q x y})" by auto
+ with assms show ?thesis by simp
+qed
-lemma finite_UN [simp]:
- "finite A ==> finite (UNION A B) = (ALL x:A. finite (B x))"
-by (blast intro: finite_subset)
-
-lemma finite_Collect_bex[simp]: "finite A \<Longrightarrow>
- finite{x. EX y:A. Q x y} = (ALL y:A. finite{x. Q x y})"
-apply(subgoal_tac "{x. EX y:A. Q x y} = UNION A (%y. {x. Q x y})")
- apply auto
-done
+lemma finite_Collect_bounded_ex [simp]:
+ assumes "finite {y. P y}"
+ shows "finite {x. \<exists>y. P y \<and> Q x y} \<longleftrightarrow> (\<forall>y. P y \<longrightarrow> finite {x. Q x y})"
+proof -
+ have "{x. EX y. P y & Q x y} = (\<Union>y\<in>{y. P y}. {x. Q x y})" by auto
+ with assms show ?thesis by simp
+qed
-lemma finite_Collect_bounded_ex[simp]: "finite{y. P y} \<Longrightarrow>
- finite{x. EX y. P y & Q x y} = (ALL y. P y \<longrightarrow> finite{x. Q x y})"
-apply(subgoal_tac "{x. EX y. P y & Q x y} = UNION {y. P y} (%y. {x. Q x y})")
- apply auto
-done
-
-
-lemma finite_Plus: "[| finite A; finite B |] ==> finite (A <+> B)"
-by (simp add: Plus_def)
+lemma finite_Plus:
+ "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A <+> B)"
+ by (simp add: Plus_def)
lemma finite_PlusD:
fixes A :: "'a set" and B :: "'b set"
@@ -410,42 +330,36 @@
shows "finite A" "finite B"
proof -
have "Inl ` A \<subseteq> A <+> B" by auto
- hence "finite (Inl ` A :: ('a + 'b) set)" using fin by(rule finite_subset)
- thus "finite A" by(rule finite_imageD)(auto intro: inj_onI)
+ then have "finite (Inl ` A :: ('a + 'b) set)" using fin by (rule finite_subset)
+ then show "finite A" by (rule finite_imageD) (auto intro: inj_onI)
next
have "Inr ` B \<subseteq> A <+> B" by auto
- hence "finite (Inr ` B :: ('a + 'b) set)" using fin by(rule finite_subset)
- thus "finite B" by(rule finite_imageD)(auto intro: inj_onI)
+ then have "finite (Inr ` B :: ('a + 'b) set)" using fin by (rule finite_subset)
+ then show "finite B" by (rule finite_imageD) (auto intro: inj_onI)
qed
-lemma finite_Plus_iff[simp]: "finite (A <+> B) \<longleftrightarrow> finite A \<and> finite B"
-by(auto intro: finite_PlusD finite_Plus)
+lemma finite_Plus_iff [simp]:
+ "finite (A <+> B) \<longleftrightarrow> finite A \<and> finite B"
+ by (auto intro: finite_PlusD finite_Plus)
-lemma finite_Plus_UNIV_iff[simp]:
- "finite (UNIV :: ('a + 'b) set) =
- (finite (UNIV :: 'a set) & finite (UNIV :: 'b set))"
-by(subst UNIV_Plus_UNIV[symmetric])(rule finite_Plus_iff)
-
-
-text {* Sigma of finite sets *}
+lemma finite_Plus_UNIV_iff [simp]:
+ "finite (UNIV :: ('a + 'b) set) \<longleftrightarrow> finite (UNIV :: 'a set) \<and> finite (UNIV :: 'b set)"
+ by (subst UNIV_Plus_UNIV [symmetric]) (rule finite_Plus_iff)
lemma finite_SigmaI [simp, intro]:
- "finite A ==> (!!a. a:A ==> finite (B a)) ==> finite (SIGMA a:A. B a)"
+ "finite A \<Longrightarrow> (\<And>a. a\<in>A \<Longrightarrow> finite (B a)) ==> finite (SIGMA a:A. B a)"
by (unfold Sigma_def) blast
-lemma finite_cartesian_product: "[| finite A; finite B |] ==>
- finite (A <*> B)"
+lemma finite_cartesian_product:
+ "finite A \<Longrightarrow> finite B \<Longrightarrow> finite (A \<times> B)"
by (rule finite_SigmaI)
lemma finite_Prod_UNIV:
- "finite (UNIV::'a set) ==> finite (UNIV::'b set) ==> finite (UNIV::('a * 'b) set)"
- apply (subgoal_tac "(UNIV:: ('a * 'b) set) = Sigma UNIV (%x. UNIV)")
- apply (erule ssubst)
- apply (erule finite_SigmaI, auto)
- done
+ "finite (UNIV :: 'a set) \<Longrightarrow> finite (UNIV :: 'b set) \<Longrightarrow> finite (UNIV :: ('a \<times> 'b) set)"
+ by (simp only: UNIV_Times_UNIV [symmetric] finite_cartesian_product)
lemma finite_cartesian_productD1:
- "[| finite (A <*> B); B \<noteq> {} |] ==> finite A"
+ "finite (A \<times> B) \<Longrightarrow> B \<noteq> {} \<Longrightarrow> finite A"
apply (auto simp add: finite_conv_nat_seg_image)
apply (drule_tac x=n in spec)
apply (drule_tac x="fst o f" in spec)
@@ -474,37 +388,89 @@
apply (rule_tac x=k in image_eqI, auto)
done
-
-text {* The powerset of a finite set *}
-
-lemma finite_Pow_iff [iff]: "finite (Pow A) = finite A"
+lemma finite_Pow_iff [iff]:
+ "finite (Pow A) \<longleftrightarrow> finite A"
proof
assume "finite (Pow A)"
- with _ have "finite ((%x. {x}) ` A)" by (rule finite_subset) blast
- thus "finite A" by (rule finite_imageD [unfolded inj_on_def]) simp
+ then have "finite ((%x. {x}) ` A)" by (blast intro: finite_subset)
+ then show "finite A" by (rule finite_imageD [unfolded inj_on_def]) simp
next
assume "finite A"
- thus "finite (Pow A)"
+ then show "finite (Pow A)"
by induct (simp_all add: Pow_insert)
qed
-lemma finite_Collect_subsets[simp,intro]: "finite A \<Longrightarrow> finite{B. B \<subseteq> A}"
-by(simp add: Pow_def[symmetric])
-
+corollary finite_Collect_subsets [simp, intro]:
+ "finite A \<Longrightarrow> finite {B. B \<subseteq> A}"
+ by (simp add: Pow_def [symmetric])
lemma finite_UnionD: "finite(\<Union>A) \<Longrightarrow> finite A"
-by(blast intro: finite_subset[OF subset_Pow_Union])
+ by (blast intro: finite_subset [OF subset_Pow_Union])
-lemma finite_subset_image:
- assumes "finite B"
- shows "B \<subseteq> f ` A \<Longrightarrow> \<exists>C\<subseteq>A. finite C \<and> B = f ` C"
-using assms proof(induct)
- case empty thus ?case by simp
+subsubsection {* Further induction rules on finite sets *}
+
+lemma finite_ne_induct [case_names singleton insert, consumes 2]:
+ assumes "finite F" and "F \<noteq> {}"
+ assumes "\<And>x. P {x}"
+ and "\<And>x F. finite F \<Longrightarrow> F \<noteq> {} \<Longrightarrow> x \<notin> F \<Longrightarrow> P F \<Longrightarrow> P (insert x F)"
+ shows "P F"
+using assms proof induct
+ case empty then show ?case by simp
+next
+ case (insert x F) then show ?case by cases auto
+qed
+
+lemma finite_subset_induct [consumes 2, case_names empty insert]:
+ assumes "finite F" and "F \<subseteq> A"
+ assumes empty: "P {}"
+ and insert: "\<And>a F. finite F \<Longrightarrow> a \<in> A \<Longrightarrow> a \<notin> F \<Longrightarrow> P F \<Longrightarrow> P (insert a F)"
+ shows "P F"
+using `finite F` `F \<subseteq> A` proof induct
+ show "P {}" by fact
next
- case insert thus ?case
- by (clarsimp simp del: image_insert simp add: image_insert[symmetric])
- blast
+ fix x F
+ assume "finite F" and "x \<notin> F" and
+ P: "F \<subseteq> A \<Longrightarrow> P F" and i: "insert x F \<subseteq> A"
+ show "P (insert x F)"
+ proof (rule insert)
+ from i show "x \<in> A" by blast
+ from i have "F \<subseteq> A" by blast
+ with P show "P F" .
+ show "finite F" by fact
+ show "x \<notin> F" by fact
+ qed
+qed
+
+lemma finite_empty_induct:
+ assumes "finite A"
+ assumes "P A"
+ and remove: "\<And>a A. finite A \<Longrightarrow> a \<in> A \<Longrightarrow> P A \<Longrightarrow> P (A - {a})"
+ shows "P {}"
+proof -
+ have "\<And>B. B \<subseteq> A \<Longrightarrow> P (A - B)"
+ proof -
+ fix B :: "'a set"
+ assume "B \<subseteq> A"
+ with `finite A` have "finite B" by (rule rev_finite_subset)
+ from this `B \<subseteq> A` show "P (A - B)"
+ proof induct
+ case empty
+ from `P A` show ?case by simp
+ next
+ case (insert b B)
+ have "P (A - B - {b})"
+ proof (rule remove)
+ from `finite A` show "finite (A - B)" by induct auto
+ from insert show "b \<in> A - B" by simp
+ from insert show "P (A - B)" by simp
+ qed
+ also have "A - B - {b} = A - insert b B" by (rule Diff_insert [symmetric])
+ finally show ?case .
+ qed
+ qed
+ then have "P (A - A)" by blast
+ then show ?thesis by simp
qed
@@ -610,7 +576,7 @@
by (induct set: fold_graph) auto
lemma finite_imp_fold_graph: "finite A \<Longrightarrow> \<exists>x. fold_graph f z A x"
-by (induct set: finite) auto
+by (induct rule: finite_induct) auto
subsubsection{*From @{const fold_graph} to @{term fold}*}
@@ -949,13 +915,14 @@
lemma fold_image_1:
"finite S \<Longrightarrow> (\<forall>x\<in>S. f x = 1) \<Longrightarrow> fold_image op * f 1 S = 1"
- apply (induct set: finite)
+ apply (induct rule: finite_induct)
apply simp by auto
lemma fold_image_Un_Int:
"finite A ==> finite B ==>
fold_image times g 1 A * fold_image times g 1 B =
fold_image times g 1 (A Un B) * fold_image times g 1 (A Int B)"
+ apply (induct rule: finite_induct)
by (induct set: finite)
(auto simp add: mult_ac insert_absorb Int_insert_left)
@@ -981,7 +948,9 @@
ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {} \<rbrakk>
\<Longrightarrow> fold_image times g 1 (UNION I A) =
fold_image times (%i. fold_image times g 1 (A i)) 1 I"
-apply (induct set: finite, simp, atomize)
+apply (induct rule: finite_induct)
+apply simp
+apply atomize
apply (subgoal_tac "ALL i:F. x \<noteq> i")
prefer 2 apply blast
apply (subgoal_tac "A x Int UNION F A = {}")
@@ -1599,7 +1568,9 @@
and "\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}"
shows "F g (UNION I A) = F (F g \<circ> A) I"
apply (insert assms)
-apply (induct set: finite, simp, atomize)
+apply (induct rule: finite_induct)
+apply simp
+apply atomize
apply (subgoal_tac "\<forall>i\<in>Fa. x \<noteq> i")
prefer 2 apply blast
apply (subgoal_tac "A x Int UNION Fa A = {}")
@@ -1975,7 +1946,9 @@
qed
lemma card_seteq: "finite B ==> (!!A. A <= B ==> card B <= card A ==> A = B)"
-apply (induct set: finite, simp, clarify)
+apply (induct rule: finite_induct)
+apply simp
+apply clarify
apply (subgoal_tac "finite A & A - {x} <= F")
prefer 2 apply (blast intro: finite_subset, atomize)
apply (drule_tac x = "A - {x}" in spec)
@@ -2146,7 +2119,7 @@
subsubsection {* Cardinality of image *}
lemma card_image_le: "finite A ==> card (f ` A) <= card A"
-apply (induct set: finite)
+apply (induct rule: finite_induct)
apply simp
apply (simp add: le_SucI card_insert_if)
done
@@ -2198,6 +2171,7 @@
using assms unfolding bij_betw_def
using finite_imageD[of f A] by auto
+
subsubsection {* Pigeonhole Principles *}
lemma pigeonhole: "card A > card(f ` A) \<Longrightarrow> ~ inj_on f A "
@@ -2267,7 +2241,7 @@
subsubsection {* Cardinality of the Powerset *}
lemma card_Pow: "finite A ==> card (Pow A) = Suc (Suc 0) ^ card A" (* FIXME numeral 2 (!?) *)
-apply (induct set: finite)
+apply (induct rule: finite_induct)
apply (simp_all add: Pow_insert)
apply (subst card_Un_disjoint, blast)
apply (blast, blast)
@@ -2284,9 +2258,11 @@
ALL c : C. k dvd card c ==>
(ALL c1: C. ALL c2: C. c1 \<noteq> c2 --> c1 Int c2 = {}) ==>
k dvd card (Union C)"
-apply(frule finite_UnionD)
-apply(rotate_tac -1)
-apply (induct set: finite, simp_all, clarify)
+apply (frule finite_UnionD)
+apply (rotate_tac -1)
+apply (induct rule: finite_induct)
+apply simp_all
+apply clarify
apply (subst card_Un_disjoint)
apply (auto simp add: disjoint_eq_subset_Compl)
done
@@ -2294,7 +2270,7 @@
subsubsection {* Relating injectivity and surjectivity *}
-lemma finite_surj_inj: "finite(A) \<Longrightarrow> A <= f`A \<Longrightarrow> inj_on f A"
+lemma finite_surj_inj: "finite A \<Longrightarrow> A \<subseteq> f ` A \<Longrightarrow> inj_on f A"
apply(rule eq_card_imp_inj_on, assumption)
apply(frule finite_imageI)
apply(drule (1) card_seteq)
--- a/src/HOL/Fun.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Fun.thy Mon Jan 31 11:18:29 2011 +0100
@@ -546,12 +546,20 @@
apply (simp_all (no_asm_simp) add: inj_image_Compl_subset surj_Compl_image_subset)
done
+lemma inj_vimage_singleton: "inj f \<Longrightarrow> f -` {a} \<subseteq> {THE x. f x = a}"
+ -- {* The inverse image of a singleton under an injective function
+ is included in a singleton. *}
+ apply (auto simp add: inj_on_def)
+ apply (blast intro: the_equality [symmetric])
+ done
+
lemma (in ordered_ab_group_add) inj_uminus[simp, intro]: "inj_on uminus A"
by (auto intro!: inj_onI)
lemma (in linorder) strict_mono_imp_inj_on: "strict_mono f \<Longrightarrow> inj_on f A"
by (auto intro!: inj_onI dest: strict_mono_eq)
+
subsection{*Function Updating*}
definition
--- a/src/HOL/IsaMakefile Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/IsaMakefile Mon Jan 31 11:18:29 2011 +0100
@@ -1,4 +1,3 @@
-
#
# IsaMakefile for HOL
#
@@ -1153,7 +1152,6 @@
Multivariate_Analysis/Finite_Cartesian_Product.thy \
Multivariate_Analysis/Integration.certs \
Multivariate_Analysis/Integration.thy \
- Multivariate_Analysis/Gauge_Measure.thy \
Multivariate_Analysis/L2_Norm.thy \
Multivariate_Analysis/Multivariate_Analysis.thy \
Multivariate_Analysis/Operator_Norm.thy \
--- a/src/HOL/Multivariate_Analysis/Gauge_Measure.thy Mon Jan 31 11:15:02 2011 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3447 +0,0 @@
-
-header {* Lebsegue measure (defined via the gauge integral). *}
-(* Author: John Harrison
- Translation from HOL light: Robert Himmelmann, TU Muenchen *)
-
-theory Gauge_Measure
- imports Integration
-begin
-
-(* ------------------------------------------------------------------------- *)
-(* Lebesgue measure (in the case where the measure is finite). *)
-(* For the non-finite version, please see Probability/Lebesgue_Measure.thy *)
-(* ------------------------------------------------------------------------- *)
-
-definition has_gmeasure (infixr "has'_gmeasure" 80) where
- "s has_gmeasure m \<equiv> ((\<lambda>x. 1::real) has_integral m) s"
-
-definition gmeasurable :: "('n::ordered_euclidean_space) set \<Rightarrow> bool" where
- "gmeasurable s \<equiv> (\<exists>m. s has_gmeasure m)"
-
-lemma gmeasurableI[dest]:"s has_gmeasure m \<Longrightarrow> gmeasurable s"
- unfolding gmeasurable_def by auto
-
-definition gmeasure where
- "gmeasure s \<equiv> (if gmeasurable s then (SOME m. s has_gmeasure m) else 0)"
-
-lemma has_gmeasure_measure: "gmeasurable s \<longleftrightarrow> s has_gmeasure (gmeasure s)"
- unfolding gmeasure_def gmeasurable_def
- apply meson apply(subst if_P) defer apply(rule someI) by auto
-
-lemma has_gmeasure_measureI[intro]:"gmeasurable s \<Longrightarrow> s has_gmeasure (gmeasure s)"
- using has_gmeasure_measure by auto
-
-lemma has_gmeasure_unique: "s has_gmeasure m1 \<Longrightarrow> s has_gmeasure m2 \<Longrightarrow> m1 = m2"
- unfolding has_gmeasure_def apply(rule has_integral_unique) by auto
-
-lemma measure_unique[intro]: assumes "s has_gmeasure m" shows "gmeasure s = m"
- apply(rule has_gmeasure_unique[OF _ assms]) using assms
- unfolding has_gmeasure_measure[THEN sym] by auto
-
-lemma has_gmeasure_measurable_measure:
- "s has_gmeasure m \<longleftrightarrow> gmeasurable s \<and> gmeasure s = m"
- by(auto intro!:measure_unique simp:has_gmeasure_measure[THEN sym])
-
-lemmas has_gmeasure_imp_measurable = gmeasurableI
-
-lemma has_gmeasure:
- "s has_gmeasure m \<longleftrightarrow> ((\<lambda>x. if x \<in> s then 1 else 0) has_integral m) UNIV"
- unfolding has_integral_restrict_univ has_gmeasure_def ..
-
-lemma gmeasurable: "gmeasurable s \<longleftrightarrow> (\<lambda>x. 1::real) integrable_on s"
- unfolding gmeasurable_def integrable_on_def has_gmeasure_def by auto
-
-lemma gmeasurable_integrable:
- "gmeasurable s \<longleftrightarrow> (\<lambda>x. if x \<in> s then 1 else (0::real)) integrable_on UNIV"
- unfolding gmeasurable_def integrable_on_def has_gmeasure ..
-
-lemma measure_integral:
- assumes "gmeasurable s" shows "gmeasure s = (integral s (\<lambda>x. 1))"
- apply(rule integral_unique[THEN sym])
- unfolding has_gmeasure_def[symmetric] using assms by auto
-
-lemma measure_integral_univ: assumes "gmeasurable s"
- shows "gmeasure s = (integral UNIV (\<lambda>x. if x \<in> s then 1 else 0))"
- apply(rule integral_unique[THEN sym])
- using assms by(auto simp:has_gmeasure[THEN sym])
-
-lemmas integral_measure = measure_integral[THEN sym]
-
-lemmas integral_measure_univ = measure_integral_univ[THEN sym]
-
-lemma has_gmeasure_interval[intro]:
- "{a..b} has_gmeasure content{a..b}" (is ?t1)
- "{a<..<b} has_gmeasure content{a..b}" (is ?t2)
-proof- show ?t1 unfolding has_gmeasure_def using has_integral_const[where c="1::real"] by auto
- show ?t2 unfolding has_gmeasure apply(rule has_integral_spike[of "{a..b} - {a<..<b}",
- where f="\<lambda>x. (if x \<in> {a..b} then 1 else 0)"]) apply(rule negligible_frontier_interval)
- using interval_open_subset_closed[of a b]
- using `?t1` unfolding has_gmeasure by auto
-qed
-
-lemma gmeasurable_interval[intro]: "gmeasurable {a..b}" "gmeasurable {a<..<b}"
- by(auto intro:gmeasurableI)
-
-lemma measure_interval[simp]: "gmeasure{a..b} = content{a..b}" "gmeasure({a<..<b}) = content{a..b}"
- by(auto intro:measure_unique)
-
-lemma nonnegative_absolutely_integrable: fixes f::"'n::ordered_euclidean_space \<Rightarrow> 'm::ordered_euclidean_space"
- assumes "\<forall>x\<in>s. \<forall>i<DIM('m). 0 \<le> f(x)$$i" "f integrable_on s"
- shows "f absolutely_integrable_on s"
- unfolding absolutely_integrable_abs_eq apply rule defer
- apply(rule integrable_eq[of _ f]) using assms apply-apply(subst euclidean_eq) by auto
-
-lemma gmeasurable_inter[dest]: assumes "gmeasurable s" "gmeasurable t" shows "gmeasurable (s \<inter> t)"
-proof- have *:"(\<lambda>x. if x \<in> s \<inter> t then 1 else (0::real)) =
- (\<lambda>x. \<chi>\<chi> i. min (((if x \<in> s then 1 else 0)::real)$$i) (((if x \<in> t then 1 else 0)::real)$$i))"
- apply(rule ext) by auto
- show ?thesis unfolding gmeasurable_integrable apply(rule absolutely_integrable_onD)
- unfolding * apply(rule absolutely_integrable_min)
- apply(rule_tac[!] nonnegative_absolutely_integrable)
- using assms unfolding gmeasurable_integrable by auto
-qed
-
-lemma gmeasurable_union: assumes "gmeasurable s" "gmeasurable t"
- shows "gmeasurable (s \<union> t)"
-proof- have *:"(\<lambda>x. if x \<in> s \<union> t then 1 else (0::real)) =
- (\<lambda>x. \<chi>\<chi> i. max (((if x \<in> s then 1 else 0)::real)$$i) (((if x \<in> t then 1 else 0)::real)$$i)) "
- by(rule ext,auto)
- show ?thesis unfolding gmeasurable_integrable apply(rule absolutely_integrable_onD)
- unfolding * apply(rule absolutely_integrable_max)
- apply(rule_tac[!]nonnegative_absolutely_integrable)
- using assms unfolding gmeasurable_integrable by auto
-qed
-
-lemma has_gmeasure_disjoint_union:
- assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s1 \<inter> s2 = {}"
- shows "(s1 \<union> s2) has_gmeasure (m1 + m2)"
-proof- have *:"\<And>x. (if x \<in> s1 then 1 else 0) + (if x \<in> s2 then 1 else 0) =
- (if x \<in> s1 \<union> s2 then 1 else (0::real))" using assms(3) by auto
- show ?thesis using has_integral_add[OF assms(1-2)[unfolded has_gmeasure]]
- unfolding has_gmeasure * .
-qed
-
-lemma measure_disjoint_union: assumes "gmeasurable s" "gmeasurable t" "s \<inter> t = {}"
- shows "gmeasure(s \<union> t) = gmeasure s + gmeasure t"
- apply rule apply(rule has_gmeasure_disjoint_union) using assms by auto
-
-lemma has_gmeasure_pos_le[dest]: assumes "s has_gmeasure m" shows "0 \<le> m"
- apply(rule has_integral_nonneg) using assms unfolding has_gmeasure by auto
-
-lemma not_measurable_measure:"\<not> gmeasurable s \<Longrightarrow> gmeasure s = 0"
- unfolding gmeasure_def if_not_P ..
-
-lemma measure_pos_le[intro]: "0 <= gmeasure s"
- apply(cases "gmeasurable s") unfolding not_measurable_measure
- unfolding has_gmeasure_measure by auto
-
-lemma has_gmeasure_subset[dest]:
- assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s1 \<subseteq> s2"
- shows "m1 <= m2"
- using has_integral_subset_le[OF assms(3,1,2)[unfolded has_gmeasure_def]] by auto
-
-lemma measure_subset[dest]: assumes "gmeasurable s" "gmeasurable t" "s \<subseteq> t"
- shows "gmeasure s \<le> gmeasure t"
- using assms unfolding has_gmeasure_measure by auto
-
-lemma has_gmeasure_0:"s has_gmeasure 0 \<longleftrightarrow> negligible s" (is "?l = ?r")
-proof assume ?r thus ?l unfolding indicator_def_raw negligible apply(erule_tac x="UNIV" in allE)
- unfolding has_integral_restrict_univ has_gmeasure_def .
-next assume ?l note this[unfolded has_gmeasure_def has_integral_alt']
- note * = conjunctD2[OF this,rule_format]
- show ?r unfolding negligible_def
- proof safe case goal1
- from *(1)[of a b,unfolded integrable_on_def] guess y apply-
- apply(subst (asm) has_integral_restrict_univ[THEN sym]) by (erule exE) note y=this
- have "0 \<le> y" apply(rule has_integral_nonneg[OF y]) by auto
- moreover have "y \<le> 0" apply(rule has_integral_le[OF y])
- apply(rule `?l`[unfolded has_gmeasure_def has_integral_restrict_univ[THEN sym,of"\<lambda>x. 1"]]) by auto
- ultimately have "y = 0" by auto
- thus ?case using y unfolding has_integral_restrict_univ indicator_def_raw by auto
- qed
-qed
-
-lemma measure_eq_0: "negligible s ==> gmeasure s = 0"
- apply(rule measure_unique) unfolding has_gmeasure_0 by auto
-
-lemma has_gmeasure_empty[intro]: "{} has_gmeasure 0"
- unfolding has_gmeasure_0 by auto
-
-lemma measure_empty[simp]: "gmeasure {} = 0"
- apply(rule measure_eq_0) by auto
-
-lemma gmeasurable_empty[intro]: "gmeasurable {}" by(auto intro:gmeasurableI)
-
-lemma gmeasurable_measure_eq_0:
- "gmeasurable s ==> (gmeasure s = 0 \<longleftrightarrow> negligible s)"
- unfolding has_gmeasure_measure has_gmeasure_0[THEN sym] by(auto intro:measure_unique)
-
-lemma gmeasurable_measure_pos_lt:
- "gmeasurable s ==> (0 < gmeasure s \<longleftrightarrow> ~negligible s)"
- unfolding gmeasurable_measure_eq_0[THEN sym]
- using measure_pos_le[of s] unfolding le_less by fastsimp
-
-lemma negligible_interval:True .. (*
- "(!a b. negligible{a..b} \<longleftrightarrow> {a<..<b} = {}) \<and>
- (!a b. negligible({a<..<b}) \<longleftrightarrow> {a<..<b} = {})"
-qed REWRITE_TAC[GSYM HAS_GMEASURE_0] THEN
- MESON_TAC[HAS_GMEASURE_INTERVAL; CONTENT_EQ_0_INTERIOR;
- INTERIOR_CLOSED_INTERVAL; HAS_GMEASURE_UNIQUE]);;*)
-
-lemma gmeasurable_finite_unions:
- assumes "finite f" "\<And>s. s \<in> f \<Longrightarrow> gmeasurable s"
- shows "gmeasurable (\<Union> f)" using assms(1,2)
-proof induct case (insert s F)
- show ?case unfolding Union_insert apply(rule gmeasurable_union)
- using insert by auto
-qed auto
-
-lemma has_gmeasure_diff_subset: assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s2 \<subseteq> s1"
- shows "(s1 - s2) has_gmeasure (m1 - m2)"
-proof- have *:"(\<lambda>x. (if x \<in> s1 then 1 else 0) - (if x \<in> s2 then 1 else (0::real))) =
- (\<lambda>x. if x \<in> s1 - s2 then 1 else 0)" apply(rule ext) using assms(3) by auto
- show ?thesis using has_integral_sub[OF assms(1-2)[unfolded has_gmeasure]]
- unfolding has_gmeasure * .
-qed
-
-lemma gmeasurable_diff: assumes "gmeasurable s" "gmeasurable t"
- shows "gmeasurable (s - t)"
-proof- have *:"\<And>s t. gmeasurable s \<Longrightarrow> gmeasurable t \<Longrightarrow> t \<subseteq> s ==> gmeasurable (s - t)"
- unfolding gmeasurable_def apply(erule exE)+ apply(rule,rule has_gmeasure_diff_subset)
- by assumption+
- have **:"s - t = s - (s \<inter> t)" by auto
- show ?thesis unfolding ** apply(rule *) using assms by auto
-qed
-
-lemma measure_diff_subset: True .. (*
- "!s t. gmeasurable s \<and> gmeasurable t \<and> t \<subseteq> s
- ==> measure(s DIFF t) = gmeasure s - gmeasure t"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_DIFF_SUBSET; GSYM HAS_GMEASURE_MEASURE]);; *)
-
-lemma has_gmeasure_union_negligible[dest]:
- assumes "s has_gmeasure m" "negligible t"
- shows "(s \<union> t) has_gmeasure m" unfolding has_gmeasure
- apply(rule has_integral_spike[OF assms(2) _ assms(1)[unfolded has_gmeasure]]) by auto
-
-lemma has_gmeasure_diff_negligible[dest]:
- assumes "s has_gmeasure m" "negligible t"
- shows "(s - t) has_gmeasure m" unfolding has_gmeasure
- apply(rule has_integral_spike[OF assms(2) _ assms(1)[unfolded has_gmeasure]]) by auto
-
-lemma has_gmeasure_union_negligible_eq: True .. (*
- "!s t:real^N->bool m.
- negligible t ==> ((s \<union> t) has_gmeasure m \<longleftrightarrow> s has_gmeasure m)"
-qed REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
- ASM_SIMP_TAC[HAS_GMEASURE_UNION_NEGLIGIBLE] THEN
- SUBST1_TAC(SET_RULE `s:real^N->bool = (s \<union> t) DIFF (t DIFF s)`) THEN
- MATCH_MP_TAC HAS_GMEASURE_DIFF_NEGLIGIBLE THEN ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC NEGLIGIBLE_DIFF THEN ASM_REWRITE_TAC[]);; *)
-
-lemma has_gmeasure_diff_negligible_eq: True .. (*
- "!s t:real^N->bool m.
- negligible t ==> ((s DIFF t) has_gmeasure m \<longleftrightarrow> s has_gmeasure m)"
-qed REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
- ASM_SIMP_TAC[HAS_GMEASURE_DIFF_NEGLIGIBLE] THEN
- SUBST1_TAC(SET_RULE `s:real^N->bool = (s DIFF t) \<union> (t \<inter> s)`) THEN
- MATCH_MP_TAC HAS_GMEASURE_UNION_NEGLIGIBLE THEN
- ASM_SIMP_TAC[NEGLIGIBLE_INTER]);; *)
-
-lemma has_gmeasure_almost: assumes "s has_gmeasure m" "negligible t" "s \<union> t = s' \<union> t"
- shows "s' has_gmeasure m"
-proof- have *:"s' \<union> t - (t - s') = s'" by blast
- show ?thesis using has_gmeasure_union_negligible[OF assms(1-2)] unfolding assms(3)
- apply-apply(drule has_gmeasure_diff_negligible[where t="t - s'"])
- apply(rule negligible_diff) using assms(2) unfolding * by auto
-qed
-
-lemma has_gmeasure_almost_eq: True .. (*
- "!s s' t. negligible t \<and> s \<union> t = s' \<union> t
- ==> (s has_gmeasure m \<longleftrightarrow> s' has_gmeasure m)"
-qed MESON_TAC[HAS_GMEASURE_ALMOST]);; *)
-
-lemma gmeasurable_almost: True .. (*
- "!s s' t. gmeasurable s \<and> negligible t \<and> s \<union> t = s' \<union> t
- ==> gmeasurable s'"
-qed REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_ALMOST]);; *)
-
-lemma has_gmeasure_negligible_union:
- assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "negligible(s1 \<inter> s2)"
- shows "(s1 \<union> s2) has_gmeasure (m1 + m2)"
- apply(rule has_gmeasure_almost[of "(s1 - (s1 \<inter> s2)) \<union> (s2 - (s1 \<inter> s2))" _ "s1 \<inter> s2"])
- apply(rule has_gmeasure_disjoint_union)
- apply(rule has_gmeasure_almost[of s1,OF _ assms(3)]) prefer 3
- apply(rule has_gmeasure_almost[of s2,OF _ assms(3)])
- using assms by auto
-
-lemma measure_negligible_union: True .. (*
- "!s t. gmeasurable s \<and> gmeasurable t \<and> negligible(s \<inter> t)
- ==> measure(s \<union> t) = gmeasure s + gmeasure t"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNION; GSYM HAS_GMEASURE_MEASURE]);; *)
-
-lemma has_gmeasure_negligible_symdiff: True .. (*
- "!s t:real^N->bool m.
- s has_gmeasure m \<and>
- negligible((s DIFF t) \<union> (t DIFF s))
- ==> t has_gmeasure m"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_GMEASURE_ALMOST THEN
- MAP_EVERY EXISTS_TAC
- [`s:real^N->bool`; `(s DIFF t) \<union> (t DIFF s):real^N->bool`] THEN
- ASM_REWRITE_TAC[] THEN SET_TAC[]);; *)
-
-lemma gmeasurable_negligible_symdiff: True .. (*
- "!s t:real^N->bool.
- gmeasurable s \<and> negligible((s DIFF t) \<union> (t DIFF s))
- ==> gmeasurable t"
-qed REWRITE_TAC[measurable] THEN
- MESON_TAC[HAS_GMEASURE_NEGLIGIBLE_SYMDIFF]);; *)
-
-lemma measure_negligible_symdiff: True .. (*
- "!s t:real^N->bool.
- (measurable s \/ gmeasurable t) \<and>
- negligible((s DIFF t) \<union> (t DIFF s))
- ==> gmeasure s = gmeasure t"
-qed MESON_TAC[HAS_GMEASURE_NEGLIGIBLE_SYMDIFF; MEASURE_UNIQUE; UNION_COMM;
- HAS_GMEASURE_MEASURE]);; *)
-
-lemma has_gmeasure_negligible_unions: assumes "finite f"
- "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> ~(s = t) ==> negligible(s \<inter> t)"
- shows "(\<Union> f) has_gmeasure (setsum m f)" using assms
-proof induct case (insert x s)
- have *:"(x \<inter> \<Union>s) = \<Union>{x \<inter> y| y. y\<in>s}"by auto
- show ?case unfolding Union_insert setsum.insert [OF insert(1-2)]
- apply(rule has_gmeasure_negligible_union) unfolding *
- apply(rule insert) defer apply(rule insert) apply(rule insert) defer
- apply(rule insert) prefer 4 apply(rule negligible_unions)
- defer apply safe apply(rule insert) using insert by auto
-qed auto
-
-lemma measure_negligible_unions:
- assumes "finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> negligible(s \<inter> t)"
- shows "gmeasure(\<Union> f) = setsum m f"
- apply rule apply(rule has_gmeasure_negligible_unions)
- using assms by auto
-
-lemma has_gmeasure_disjoint_unions:
- assumes"finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> s \<inter> t = {}"
- shows "(\<Union> f) has_gmeasure (setsum m f)"
- apply(rule has_gmeasure_negligible_unions[OF assms(1-2)]) using assms(3) by auto
-
-lemma measure_disjoint_unions:
- assumes "finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> s \<inter> t = {}"
- shows "gmeasure(\<Union> f) = setsum m f"
- apply rule apply(rule has_gmeasure_disjoint_unions[OF assms]) by auto
-
-lemma has_gmeasure_negligible_unions_image:
- assumes "finite s" "\<And>x. x \<in> s ==> gmeasurable(f x)"
- "\<And>x y. x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x \<noteq> y \<Longrightarrow> negligible((f x) \<inter> (f y))"
- shows "(\<Union> (f ` s)) has_gmeasure (setsum (\<lambda>x. gmeasure(f x)) s)"
-proof- have *:"setsum (\<lambda>x. gmeasure(f x)) s = setsum gmeasure (f ` s)"
- apply(subst setsum_reindex_nonzero) defer
- apply(subst gmeasurable_measure_eq_0)
- proof- case goal2 thus ?case using assms(3)[of x y] by auto
- qed(insert assms, auto)
- show ?thesis unfolding * apply(rule has_gmeasure_negligible_unions) using assms by auto
-qed
-
-lemma measure_negligible_unions_image: True .. (*
- "!f:A->real^N->bool s.
- FINITE s \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
- ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE]);;*)
-
-lemma has_gmeasure_disjoint_unions_image: True .. (*
- "!f:A->real^N->bool s.
- FINITE s \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
- ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
-qed REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
- ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);;*)
-
-lemma measure_disjoint_unions_image: True .. (*
- "!f:A->real^N->bool s.
- FINITE s \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
- ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_DISJOINT_UNIONS_IMAGE]);;*)
-
-lemma has_gmeasure_negligible_unions_image_strong: True .. (*
- "!f:A->real^N->bool s.
- FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
- ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
-qed REPEAT STRIP_TAC THEN
- MP_TAC(ISPECL [`f:A->real^N->bool`;
- `{x | x \<in> s \<and> ~((f:A->real^N->bool) x = {})}`]
- HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
- ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN
- MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
- [GEN_REWRITE_TAC I [EXTENSION] THEN
- REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN
- MESON_TAC[NOT_IN_EMPTY];
- CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
- SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a \<and> ~(a \<and> b) \<longleftrightarrow> a \<and> ~b`] THEN
- REWRITE_TAC[MEASURE_EMPTY]]);; *)
-
-lemma measure_negligible_unions_image_strong: True .. (*
- "!f:A->real^N->bool s.
- FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
- ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; *)
-
-lemma has_gmeasure_disjoint_unions_image_strong: True .. (*
- "!f:A->real^N->bool s.
- FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
- ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
-qed REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
- ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; *)
-
-lemma measure_disjoint_unions_image_strong: True .. (*
- "!f:A->real^N->bool s.
- FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
- (!x. x \<in> s ==> gmeasurable(f x)) \<and>
- (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
- ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_SIMP_TAC[HAS_GMEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; *)
-
-lemma measure_union: True .. (*
- "!s t:real^N->bool.
- gmeasurable s \<and> gmeasurable t
- ==> measure(s \<union> t) = measure(s) + measure(t) - measure(s \<inter> t)"
-qed REPEAT STRIP_TAC THEN
- ONCE_REWRITE_TAC[SET_RULE
- `s \<union> t = (s \<inter> t) \<union> (s DIFF t) \<union> (t DIFF s)`] THEN
- ONCE_REWRITE_TAC[REAL_ARITH `a + b - c = c + (a - c) + (b - c)`] THEN
- MP_TAC(ISPECL [`s DIFF t:real^N->bool`; `t DIFF s:real^N->bool`]
- MEASURE_DISJOINT_UNION) THEN
- ASM_SIMP_TAC[MEASURABLE_DIFF] THEN
- ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
- MP_TAC(ISPECL [`s \<inter> t:real^N->bool`;
- `(s DIFF t) \<union> (t DIFF s):real^N->bool`]
- MEASURE_DISJOINT_UNION) THEN
- ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_UNION; GMEASURABLE_INTER] THEN
- ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
- REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN
- REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL
- [EXISTS_TAC `measure((s DIFF t) \<union> (s \<inter> t):real^N->bool)`;
- EXISTS_TAC `measure((t DIFF s) \<union> (s \<inter> t):real^N->bool)`] THEN
- (CONJ_TAC THENL
- [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION THEN
- ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_INTER];
- AP_TERM_TAC] THEN
- SET_TAC[]));; *)
-
-lemma measure_union_le: True .. (*
- "!s t:real^N->bool.
- gmeasurable s \<and> gmeasurable t
- ==> measure(s \<union> t) <= gmeasure s + gmeasure t"
-qed REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURE_UNION] THEN
- REWRITE_TAC[REAL_ARITH `a + b - c <= a + b \<longleftrightarrow> 0 <= c`] THEN
- MATCH_MP_TAC MEASURE_POS_LE THEN ASM_SIMP_TAC[MEASURABLE_INTER]);; *)
-
-lemma measure_unions_le: True .. (*
- "!f:(real^N->bool)->bool.
- FINITE f \<and> (!s. s \<in> f ==> gmeasurable s)
- ==> measure(UNIONS f) <= sum f (\<lambda>s. gmeasure s)"
-qed REWRITE_TAC[IMP_CONJ] THEN
- MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
- SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN
- REWRITE_TAC[MEASURE_EMPTY; REAL_LE_REFL] THEN
- MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN
- REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `measure(s:real^N->bool) + measure(UNIONS f:real^N->bool)` THEN
- ASM_SIMP_TAC[MEASURE_UNION_LE; GMEASURABLE_UNIONS] THEN
- REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
- ASM_SIMP_TAC[]);; *)
-
-lemma measure_unions_le_image: True .. (*
- "!f:A->bool s:A->(real^N->bool).
- FINITE f \<and> (!a. a \<in> f ==> gmeasurable(s a))
- ==> measure(UNIONS (IMAGE s f)) <= sum f (\<lambda>a. measure(s a))"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\<lambda>k:real^N->bool. gmeasure k)` THEN
- ASM_SIMP_TAC[MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
- GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
- REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN
- ASM_SIMP_TAC[MEASURE_POS_LE]);; *)
-
-lemma gmeasurable_inner_outer: True .. (*
- "!s:real^N->bool.
- gmeasurable s \<longleftrightarrow>
- !e. 0 < e
- ==> ?t u. t \<subseteq> s \<and> s \<subseteq> u \<and>
- gmeasurable t \<and> gmeasurable u \<and>
- abs(measure t - gmeasure u) < e"
-qed GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
- [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real^N->bool`) THEN
- ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM];
- ALL_TAC] THEN
- REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN
- X_GEN_TAC `e:real` THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
- ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
- MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN
- MAP_EVERY EXISTS_TAC
- [`(\<lambda>x. if x \<in> t then 1 else 0):real^N->real^1`;
- `(\<lambda>x. if x \<in> u then 1 else 0):real^N->real^1`;
- `lift(measure(t:real^N->bool))`;
- `lift(measure(u:real^N->bool))`] THEN
- ASM_REWRITE_TAC[GSYM HAS_GMEASURE; GSYM HAS_GMEASURE_MEASURE] THEN
- ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN
- REPEAT(COND_CASES_TAC THEN
- ASM_REWRITE_TAC[_VEC; REAL_POS; REAL_LE_REFL]) THEN
- ASM SET_TAC[]);; *)
-
-lemma has_gmeasure_inner_outer: True .. (*
- "!s:real^N->bool m.
- s has_gmeasure m \<longleftrightarrow>
- (!e. 0 < e ==> ?t. t \<subseteq> s \<and> gmeasurable t \<and>
- m - e < gmeasure t) \<and>
- (!e. 0 < e ==> ?u. s \<subseteq> u \<and> gmeasurable u \<and>
- gmeasure u < m + e)"
-qed REPEAT GEN_TAC THEN
- GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_MEASURABLE_MEASURE] THEN EQ_TAC THENL
- [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN
- ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC;
- ALL_TAC] THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN
- MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
- [GEN_REWRITE_TAC I [MEASURABLE_INNER_OUTER] THEN
- X_GEN_TAC `e:real` THEN DISCH_TAC THEN
- REMOVE_THEN "u" (MP_TAC o SPEC `e / 2`) THEN
- REMOVE_THEN "t" (MP_TAC o SPEC `e / 2`) THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
- REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
- REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
- REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
- STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
- `0 < e \<and> t <= u \<and> m - e / 2 < t \<and> u < m + e / 2
- ==> abs(t - u) < e`) THEN
- ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
- ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
- DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
- `~(0 < x - y) \<and> ~(0 < y - x) ==> x = y`) THEN
- CONJ_TAC THEN DISCH_TAC THENL
- [REMOVE_THEN "u" (MP_TAC o SPEC `measure(s:real^N->bool) - m`) THEN
- ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE];
- REMOVE_THEN "t" (MP_TAC o SPEC `m - measure(s:real^N->bool)`) THEN
- ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN
- ASM_MESON_TAC[MEASURE_SUBSET]]);; *)
-
-lemma has_gmeasure_inner_outer_le: True .. (*
- "!s:real^N->bool m.
- s has_gmeasure m \<longleftrightarrow>
- (!e. 0 < e ==> ?t. t \<subseteq> s \<and> gmeasurable t \<and>
- m - e <= gmeasure t) \<and>
- (!e. 0 < e ==> ?u. s \<subseteq> u \<and> gmeasurable u \<and>
- gmeasure u <= m + e)"
-qed REWRITE_TAC[HAS_GMEASURE_INNER_OUTER] THEN
- MESON_TAC[REAL_ARITH `0 < e \<and> m - e / 2 <= t ==> m - e < t`;
- REAL_ARITH `0 < e \<and> u <= m + e / 2 ==> u < m + e`;
- REAL_ARITH `0 < e \<longleftrightarrow> 0 < e / 2`; REAL_LT_IMP_LE]);; *)
-
-lemma has_gmeasure_limit: True .. (*
- "!s. s has_gmeasure m \<longleftrightarrow>
- !e. 0 < e
- ==> ?B. 0 < B \<and>
- !a b. ball(0,B) \<subseteq> {a..b}
- ==> ?z. (s \<inter> {a..b}) has_gmeasure z \<and>
- abs(z - m) < e"
-qed GEN_TAC THEN REWRITE_TAC[HAS_GMEASURE] THEN
- GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN
- REWRITE_TAC[IN_UNIV] THEN
- GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
- [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
- REWRITE_TAC[MESON[IN_INTER]
- `(if x \<in> k \<inter> s then a else b) =
- (if x \<in> s then if x \<in> k then a else b else b)`] THEN
- REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; NORM_LIFT]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* properties of gmeasure under simple affine transformations. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma has_gmeasure_affinity: True .. (*
- "!s m c y. s has_gmeasure y
- ==> (IMAGE (\<lambda>x:real^N. m % x + c) s)
- has_gmeasure abs(m) pow (dimindex(:N)) * y"
-qed REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THENL
- [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN
- ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`)
- (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN
- REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_GMEASURE_0] THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN
- SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[];
- ALL_TAC] THEN
- REWRITE_TAC[HAS_GMEASURE] THEN
- ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
- DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
- DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN
- ASM_SIMP_TAC[REAL_ARITH `0 < B \<and> 0 <= x ==> 0 < B + x`;
- NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
- MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
- REWRITE_TAC[IN_IMAGE] THEN
- ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN
- FIRST_X_ASSUM(MP_TAC o SPECL
- [`if 0 <= m then inv m % u + --(inv m % c):real^N
- else inv m % v + --(inv m % c)`;
- `if 0 <= m then inv m % v + --(inv m % c):real^N
- else inv m % u + --(inv m % c)`]) THEN
- MATCH_MP_TAC(TAUT `a \<and> (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN
- CONJ_TAC THENL
- [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
- DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN
- MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN
- CONJ_TAC THENL
- [REWRITE_TAC[NORM_ARITH `dist(0,x) = norm(x:real^N)`] THEN
- DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH
- `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN
- ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ];
- ALL_TAC] THEN
- SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT;
- COND_COMPONENT] THEN
- MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
- REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN
- SUBST1_TAC(REAL_ARITH
- `inv(m) = if 0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN
- SIMP_TAC[REAL_LE_INV_EQ] THEN
- REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN
- REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
- ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `0:real^N`) THEN
- ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN
- DISCH_THEN(X_CHOOSE_THEN `z:real^1`
- (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN
- MP_TAC th)) THEN
- DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
- FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = 0) ==> ~(inv x = 0)`)) THEN
- REWRITE_TAC[TAUT `a ==> b ==> c \<longleftrightarrow> b \<and> a ==> c`] THEN
- DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o
- MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
- ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN
- SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
- REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
- VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN
- ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN
- REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN
- REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN
- DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
- REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN
- REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN
- ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);; *)
-
-lemma stretch_galois: True .. (*
- "!x:real^N y:real^N m.
- (!k. 1 <= k \<and> k <= dimindex(:N) ==> ~(m k = 0))
- ==> ((y = (lambda k. m k * x$k)) \<longleftrightarrow> (lambda k. inv(m k) * y$k) = x)"
-qed REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
- MATCH_MP_TAC(MESON[]
- `(!x. p x ==> (q x \<longleftrightarrow> r x))
- ==> (!x. p x) ==> ((!x. q x) \<longleftrightarrow> (!x. r x))`) THEN
- GEN_TAC THEN ASM_CASES_TAC `1 <= k \<and> k <= dimindex(:N)` THEN
- ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; *)
-
-lemma has_gmeasure_stretch: True .. (*
- "!s m y. s has_gmeasure y
- ==> (IMAGE (\<lambda>x:real^N. lambda k. m k * x$k) s :real^N->bool)
- has_gmeasure abs(product (1..dimindex(:N)) m) * y"
-qed REPEAT STRIP_TAC THEN ASM_CASES_TAC
- `!k. 1 <= k \<and> k <= dimindex(:N) ==> ~(m k = 0)`
- THENL
- [ALL_TAC;
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
- REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN
- X_GEN_TAC `k:num` THEN STRIP_TAC THEN
- SUBGOAL_THEN `product(1..dimindex (:N)) m = 0` SUBST1_TAC THENL
- [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN
- REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_GMEASURE_0] THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `{x:real^N | x$k = 0}` THEN
- ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN
- ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN
- UNDISCH_TAC `(s:real^N->bool) has_gmeasure y` THEN
- REWRITE_TAC[HAS_GMEASURE] THEN
- ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
- DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
- SUBGOAL_THEN `0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL
- [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG];
- ALL_TAC] THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN
- ASM_SIMP_TAC[REAL_LT_DIV] THEN
- DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `sup(IMAGE (\<lambda>k. abs(m k) * B) (1..dimindex(:N)))` THEN
- MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
- [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG;
- IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY;
- EXISTS_IN_IMAGE] THEN
- ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ];
- DISCH_TAC] THEN
- MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
- ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN
- FIRST_X_ASSUM(MP_TAC o SPECL
- [`(lambda k. min (inv(m k) * (u:real^N)$k)
- (inv(m k) * (v:real^N)$k)):real^N`;
- `(lambda k. max (inv(m k) * (u:real^N)$k)
- (inv(m k) * (v:real^N)$k)):real^N`]) THEN
- MATCH_MP_TAC(TAUT `a \<and> (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN
- CONJ_TAC THENL
- [ALL_TAC;
- REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN
- DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
- SUBGOAL_THEN `!k. 1 <= k \<and> k <= dimindex (:N) ==> ~(inv(m k) = 0)`
- MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN
- ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
- DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN
- (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i)`]
- IMAGE_STRETCH_INTERVAL) THEN
- SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL
- [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
- `s \<subseteq> t ==> ~(s = {}) ==> ~(t = {})`)) THEN
- ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT];
- ALL_TAC] THEN
- ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM))
- THENL
- [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
- `b \<subseteq> s ==> b' \<subseteq> IMAGE f b ==> b' \<subseteq> IMAGE f s`)) THEN
- REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(0,x) = norm x`;
- IN_IMAGE] THEN
- ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN
- X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
- MATCH_MP_TAC REAL_LET_TRANS THEN
- EXISTS_TAC
- `norm(sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
- SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN
- REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
- REWRITE_TAC[REAL_ABS_POS] THEN
- MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
- ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
- NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
- REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL];
- ALL_TAC] THEN
- REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
- EXISTS_TAC `abs(sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N)))) * B` THEN
- SUBGOAL_THEN `0 < sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N)))`
- ASSUME_TAC THENL
- [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
- NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
- REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN
- ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL];
- ALL_TAC] THEN
- ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `0 < x ==> 0 < abs x`] THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N))) * B` THEN
- ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `0 < x ==> abs x <= x`] THEN
- ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
- NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
- ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN
- ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
- NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
- MP_TAC(ISPEC `IMAGE (\<lambda>k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN
- REWRITE_TAC[FORALL_IN_IMAGE] THEN
- ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY;
- GSYM NOT_LE; DIMINDEX_GE_1] THEN
- REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[];
-
- MATCH_MP_TAC(MESON[]
- `s = t \<and> P z ==> (f has_integral z) s ==> Q
- ==> ?w. (f has_integral w) t \<and> P w`) THEN
- SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN
- REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL
- [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
- `(!x. f x = x) ==> IMAGE f s = s`) THEN
- SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN
- ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID];
- REWRITE_TAC[ABS_; _SUB; LIFT_; _CMUL] THEN
- REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN
- REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN
- ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
- ASM_MESON_TAC[ABS_; _SUB; LIFT_]]]);; *)
-
-lemma has_gmeasure_translation: True .. (*
- "!s m a. s has_gmeasure m ==> (IMAGE (\<lambda>x:real^N. a + x) s) has_gmeasure m"
-qed REPEAT GEN_TAC THEN
- MP_TAC(ISPECL [`s:real^N->bool`; `1`; `a:real^N`; `m:real`]
- HAS_GMEASURE_AFFINITY) THEN
- REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
- REWRITE_TAC[VECTOR_ADD_SYM]);; *)
-
-lemma negligible_translation: True .. (*
- "!s a. negligible s ==> negligible (IMAGE (\<lambda>x:real^N. a + x) s)"
-qed SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION]);; *)
-
-lemma has_gmeasure_translation_eq: True .. (*
- "!s m. (IMAGE (\<lambda>x:real^N. a + x) s) has_gmeasure m \<longleftrightarrow> s has_gmeasure m"
-qed REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_GMEASURE_TRANSLATION] THEN
- DISCH_THEN(MP_TAC o SPEC `--a:real^N` o
- MATCH_MP HAS_GMEASURE_TRANSLATION) THEN
- MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
- REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN
- SET_TAC[]);; *)
-
-lemma negligible_translation_rev: True .. (*
- "!s a. negligible (IMAGE (\<lambda>x:real^N. a + x) s) ==> negligible s"
-qed SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION_EQ]);; *)
-
-lemma negligible_translation_eq: True .. (*
- "!s a. negligible (IMAGE (\<lambda>x:real^N. a + x) s) \<longleftrightarrow> negligible s"
-qed SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION_EQ]);; *)
-
-lemma gmeasurable_translation: True .. (*
- "!s. gmeasurable (IMAGE (\<lambda>x. a + x) s) \<longleftrightarrow> gmeasurable s"
-qed REWRITE_TAC[measurable; HAS_GMEASURE_TRANSLATION_EQ]);; *)
-
-lemma measure_translation: True .. (*
- "!s. gmeasurable s ==> measure(IMAGE (\<lambda>x. a + x) s) = gmeasure s"
-qed REWRITE_TAC[HAS_GMEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC MEASURE_UNIQUE THEN
- ASM_REWRITE_TAC[HAS_GMEASURE_TRANSLATION_EQ]);; *)
-
-lemma has_gmeasure_scaling: True .. (*
- "!s m c. s has_gmeasure m
- ==> (IMAGE (\<lambda>x:real^N. c % x) s) has_gmeasure
- (abs(c) pow dimindex(:N)) * m"
-qed REPEAT GEN_TAC THEN
- MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `0:real^N`; `m:real`]
- HAS_GMEASURE_AFFINITY) THEN
- REWRITE_TAC[VECTOR_ADD_RID]);; *)
-
-lemma has_gmeasure_scaling_eq: True .. (*
- "!s m c. ~(c = 0)
- ==> (IMAGE (\<lambda>x:real^N. c % x) s
- has_gmeasure (abs(c) pow dimindex(:N)) * m \<longleftrightarrow>
- s has_gmeasure m)"
-qed REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_GMEASURE_SCALING] THEN
- DISCH_THEN(MP_TAC o SPEC `inv(c)` o MATCH_MP HAS_GMEASURE_SCALING) THEN
- REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
- REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
- ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN
- REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN
- MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; *)
-
-lemma gmeasurable_scaling: True .. (*
- "!s c. gmeasurable s ==> gmeasurable (IMAGE (\<lambda>x. c % x) s)"
-qed REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_SCALING]);; *)
-
-lemma gmeasurable_scaling_eq: True .. (*
- "!s c. ~(c = 0) ==> (measurable (IMAGE (\<lambda>x. c % x) s) \<longleftrightarrow> gmeasurable s)"
-qed REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN
- DISCH_THEN(MP_TAC o SPEC `inv c` o MATCH_MP GMEASURABLE_SCALING) THEN
- REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
- MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
- SET_TAC[]);; *)
-
-lemma measure_scaling: True .. (*
- "!s. gmeasurable s
- ==> measure(IMAGE (\<lambda>x:real^N. c % x) s) =
- (abs(c) pow dimindex(:N)) * gmeasure s"
-qed REWRITE_TAC[HAS_GMEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_GMEASURE_SCALING]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Measurability of countable unions and intersections of various kinds. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma has_gmeasure_nested_unions:
- assumes "\<And>n. gmeasurable(s n)" "\<And>n. gmeasure(s n) \<le> B" "\<And>n. s(n) \<subseteq> s(Suc n)"
- shows "gmeasurable(\<Union> { s n | n. n \<in> UNIV }) \<and>
- (\<lambda>n. gmeasure(s n)) ----> gmeasure(\<Union> { s(n) | n. n \<in> UNIV })"
-proof- let ?g = "\<lambda>x. if x \<in> \<Union>{s n |n. n \<in> UNIV} then 1 else (0::real)"
- have "?g integrable_on UNIV \<and> (\<lambda>k. integral UNIV (\<lambda>x. if x \<in> s k then 1 else 0)) ----> integral UNIV ?g"
- proof(rule monotone_convergence_increasing)
- case goal1 show ?case using assms(1) unfolding gmeasurable_integrable by auto
- case goal2 show ?case using assms(3) by auto
- have "\<forall>m n. m\<le>n \<longrightarrow> s m \<subseteq> s n" apply(subst transitive_stepwise_le_eq)
- using assms(3) by auto note * = this[rule_format]
- have **:"\<And>x e n. \<lbrakk>x \<in> s n; 0 < e\<rbrakk> \<Longrightarrow> \<exists>N. \<forall>n. x \<notin> s n \<longrightarrow> N \<le> n \<longrightarrow> dist 0 1 < e"
- apply(rule_tac x=n in exI) using * by auto
- case goal3 show ?case unfolding Lim_sequentially by(auto intro!: **)
- case goal4 show ?case unfolding bounded_def apply(rule_tac x=0 in exI)
- apply(rule_tac x=B in exI) unfolding dist_real_def apply safe
- unfolding measure_integral_univ[OF assms(1),THEN sym]
- apply(subst abs_of_nonpos) using assms(1,2) by auto
- qed note conjunctD2[OF this]
- thus ?thesis unfolding gmeasurable_integrable[THEN sym] measure_integral_univ[OF assms(1)]
- apply- unfolding measure_integral_univ by auto
-qed
-
-lemmas gmeasurable_nested_unions = has_gmeasure_nested_unions(1)
-
-lemma sums_alt:"f sums s = (\<lambda>n. setsum f {0..n}) ----> s"
-proof- have *:"\<And>n. {0..<Suc n} = {0..n}" by auto
- show ?thesis unfolding sums_def apply(subst LIMSEQ_Suc_iff[THEN sym]) unfolding * ..
-qed
-
-lemma has_gmeasure_countable_negligible_unions:
- assumes "\<And>n. gmeasurable(s n)" "\<And>m n. m \<noteq> n \<Longrightarrow> negligible(s m \<inter> s n)"
- "\<And>n. setsum (\<lambda>k. gmeasure(s k)) {0..n} <= B"
- shows "gmeasurable(\<Union> { s(n) |n. n \<in> UNIV })" (is ?m)
- "((\<lambda>n. gmeasure(s n)) sums (gmeasure(\<Union> { s(n) |n. n \<in> UNIV })))" (is ?s)
-proof- have *:"\<And>n. (\<Union> (s ` {0..n})) has_gmeasure (setsum (\<lambda>k. gmeasure(s k)) {0..n})"
- apply(rule has_gmeasure_negligible_unions_image) using assms by auto
- have **:"(\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) = (\<Union>{s n |n. n \<in> UNIV})" unfolding simple_image by fastsimp
- have "gmeasurable (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) \<and>
- (\<lambda>n. gmeasure (\<Union>(s ` {0..n}))) ----> gmeasure (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV})"
- apply(rule has_gmeasure_nested_unions) apply(rule gmeasurableI,rule *)
- unfolding measure_unique[OF *] defer apply(rule Union_mono,rule image_mono) using assms(3) by auto
- note lem = conjunctD2[OF this,unfolded **]
- show ?m using lem(1) .
- show ?s using lem(2) unfolding sums_alt measure_unique[OF *] .
-qed
-
-lemma negligible_countable_unions: True .. (*
- "!s:num->real^N->bool.
- (!n. negligible(s n)) ==> negligible(UNIONS {s(n) | n \<in> (:num)})"
-qed REPEAT STRIP_TAC THEN
- MP_TAC(ISPECL [`s:num->real^N->bool`; `0`]
- HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
- ASM_SIMP_TAC[MEASURE_EQ_0; SUM_0; REAL_LE_REFL; LIFT_NUM] THEN ANTS_TAC THENL
- [ASM_MESON_TAC[HAS_GMEASURE_0; gmeasurable; INTER_SUBSET; NEGLIGIBLE_SUBSET];
- ALL_TAC] THEN
- SIMP_TAC[GSYM GMEASURABLE_MEASURE_EQ_0] THEN
- STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ] THEN
- MATCH_MP_TAC SERIES_UNIQUE THEN REWRITE_TAC[LIFT_NUM] THEN
- MAP_EVERY EXISTS_TAC [`(\<lambda>k. 0):num->real^1`; `from 0`] THEN
- ASM_REWRITE_TAC[SERIES_0]);; *)
-
-lemma gmeasurable_countable_unions_strong:
- assumes "\<And>n. gmeasurable(s n)" "\<And>n::nat. gmeasure(\<Union>{s k |k. k \<le> n}) \<le> B"
- shows "gmeasurable(\<Union>{ s(n) |n. n \<in> UNIV })"
-proof- have *:"\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV} = \<Union>range s" unfolding simple_image by fastsimp
- show ?thesis unfolding simple_image
- apply(rule gmeasurable_nested_unions[of "\<lambda>n. \<Union>(s ` {0..n})", THEN conjunct1,unfolded *])
- proof- fix n::nat show "gmeasurable (\<Union>s ` {0..n})"
- apply(rule gmeasurable_finite_unions) using assms(1) by auto
- show "gmeasure (\<Union>s ` {0..n}) \<le> B"
- using assms(2)[of n] unfolding simple_image[THEN sym] by auto
- show "\<Union>s ` {0..n} \<subseteq> \<Union>s ` {0..Suc n}" apply(rule Union_mono) by auto
- qed
-qed
-
-lemma has_gmeasure_countable_negligible_unions_bounded: True .. (*
- "!s:num->real^N->bool.
- (!n. gmeasurable(s n)) \<and>
- (!m n. ~(m = n) ==> negligible(s m \<inter> s n)) \<and>
- bounded(\<Union>{ s(n) | n \<in> (:num) })
- ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) }) \<and>
- ((\<lambda>n. lift(measure(s n))) sums
- lift(measure(\<Union>{ s(n) | n \<in> (:num) }))) (from 0)"
-qed REPEAT GEN_TAC THEN STRIP_TAC THEN
- FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
- REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
- MATCH_MP_TAC HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN
- EXISTS_TAC `measure(interval[a:real^N,b])` THEN
- ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
- MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
- ASM_SIMP_TAC[FINITE_NUMSEG];
- MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC GMEASURABLE_UNIONS THEN
- ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE];
- ASM SET_TAC[]]]);; *)
-
-lemma gmeasurable_countable_negligible_unions_bounded: True .. (*
- "!s:num->real^N->bool.
- (!n. gmeasurable(s n)) \<and>
- (!m n. ~(m = n) ==> negligible(s m \<inter> s n)) \<and>
- bounded(\<Union>{ s(n) | n \<in> (:num) })
- ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) })"
-qed SIMP_TAC[HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED]);; *)
-
-lemma gmeasurable_countable_unions: True .. (*
- "!s:num->real^N->bool B.
- (!n. gmeasurable(s n)) \<and>
- (!n. sum (0..n) (\<lambda>k. measure(s k)) \<le> B)
- ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) })"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_COUNTABLE_UNIONS_STRONG THEN
- EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN
- X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sum(0..n) (\<lambda>k. measure(s k:real^N->bool))` THEN
- ASM_REWRITE_TAC[] THEN
- W(MP_TAC o PART_MATCH (rand o rand) MEASURE_UNIONS_LE_IMAGE o
- rand o snd) THEN
- ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
- ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
- REWRITE_TAC[IN_NUMSEG; LE_0]);; *)
-
-lemma gmeasurable_countable_inters: True .. (*
- "!s:num->real^N->bool.
- (!n. gmeasurable(s n))
- ==> gmeasurable(INTERS { s(n) | n \<in> (:num) })"
-qed REPEAT STRIP_TAC THEN
- SUBGOAL_THEN `INTERS { s(n):real^N->bool | n \<in> (:num) } =
- s 0 DIFF (\<Union>{s 0 DIFF s n | n \<in> (:num)})`
- SUBST1_TAC THENL
- [GEN_REWRITE_TAC I [EXTENSION] THEN
- REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN
- REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
- ASM SET_TAC[];
- ALL_TAC] THEN
- MATCH_MP_TAC GMEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC GMEASURABLE_COUNTABLE_UNIONS_STRONG THEN
- EXISTS_TAC `measure(s 0:real^N->bool)` THEN
- ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN
- GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
- ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
- [ALL_TAC;
- REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN
- MESON_TAC[IN_DIFF]] THEN
- ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
- ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
- GMEASURABLE_DIFF; GMEASURABLE_UNIONS]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* measurability of compact and bounded open sets. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma gmeasurable_compact: True .. (*
- "!s:real^N->bool. compact s ==> gmeasurable s"
-qed lemma lemma = prove
- (`!f s:real^N->bool.
- (!n. FINITE(f n)) \<and>
- (!n. s \<subseteq> UNIONS(f n)) \<and>
- (!x. ~(x \<in> s) ==> ?n. ~(x \<in> UNIONS(f n))) \<and>
- (!n a. a \<in> f(SUC n) ==> ?b. b \<in> f(n) \<and> a \<subseteq> b) \<and>
- (!n a. a \<in> f(n) ==> gmeasurable a)
- ==> gmeasurable s"
-qed REPEAT STRIP_TAC THEN
- SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) \<subseteq> UNIONS(f n)`
- ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
- SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n \<in> (:num) }:real^N->bool`
- SUBST1_TAC THENL
- [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
- MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
- REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN
- REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[];
- MATCH_MP_TAC GMEASURABLE_COUNTABLE_INTERS THEN
- ASM_REWRITE_TAC[] THEN GEN_TAC THEN
- MATCH_MP_TAC GMEASURABLE_UNIONS THEN
- ASM_MESON_TAC[]]) in
- REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
- EXISTS_TAC
- `\n. { k | ?u:real^N. (!i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> integer(u$i)) \<and>
- k = { x:real^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> u$i / 2 pow n \<le> x$i \<and>
- x$i < (u$i + 1) / 2 pow n } \<and>
- ~(s \<inter> k = {})}` THEN
- REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
- [X_GEN_TAC `n:num` THEN
- SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
- SUBGOAL_THEN
- `?N. !x:real^N i. x \<in> s \<and> 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> abs(x$i * 2 pow n) < N`
- STRIP_ASSUME_TAC THENL
- [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
- REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
- X_GEN_TAC `B:real` THEN STRIP_TAC THEN
- MP_TAC(SPEC `B * 2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN
- MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN
- X_GEN_TAC `N:num` THEN
- REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN
- SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
- ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS];
- ALL_TAC] THEN
- MATCH_MP_TAC FINITE_SUBSET THEN
- EXISTS_TAC
- `IMAGE (\<lambda>u. {x | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> (u:real^N)$i \<le> (x:real^N)$i * 2 pow n \<and>
- x$i * 2 pow n < u$i + 1})
- {u | !i. 1 \<le> i \<and> i \<le> dimindex(:N) ==> integer (u$i) \<and>
- abs(u$i) \<le> N}` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN
- REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG];
- REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN
- X_GEN_TAC `l:real^N->bool` THEN
- MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN
- STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN
- X_GEN_TAC `k:num` THEN STRIP_TAC THEN
- MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN
- ASM_SIMP_TAC[INTEGER_CLOSED] THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
- DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN
- REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
- DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN
- ASM_REWRITE_TAC[] THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN
- ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
- X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
- X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
- REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
- ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
- EXISTS_TAC `(lambda i. floor(2 pow n * (x:real^N)$i)):real^N` THEN
- ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
- REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN
- REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
- REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN
- ASM_REWRITE_TAC[IN_ELIM_THM] THEN
- SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
- REWRITE_TAC[REAL_MUL_SYM; FLOOR];
- X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
- FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
- REWRITE_TAC[closed; open_def] THEN
- DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
- ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
- DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
- MP_TAC(SPECL [`inv(2)`; `e / (dimindex(:N))`] REAL_ARCH_POW_INV) THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT;
- DIMINDEX_GE_1; ARITH_RULE `0 < x \<longleftrightarrow> 1 \<le> x`] THEN
- CONV_TAC REAL_RAT_REDUCE_CONV THEN
- MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
- REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
- REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
- ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
- ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
- REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
- X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
- REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
- DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN
- DISCH_THEN(X_CHOOSE_THEN `y:real^N`
- (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
- REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
- FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
- `d < e ==> x \<le> d ==> x < e`)) THEN
- REWRITE_TAC[dist] THEN
- W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
- MATCH_MP_TAC(REAL_ARITH `a \<le> b ==> x \<le> a ==> x \<le> b`) THEN
- GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
- ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN
- SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
- X_GEN_TAC `k:num` THEN STRIP_TAC THEN
- REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN
- ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
- REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC;
- MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN
- DISCH_THEN(X_CHOOSE_THEN `u:real^N`
- (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
- DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN
- REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
- ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
- ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
- REWRITE_TAC[UNWIND_THM2] THEN
- EXISTS_TAC `(lambda i. floor((u:real^N)$i / 2)):real^N` THEN
- ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN
- MATCH_MP_TAC(SET_RULE `~(s \<inter> a = {}) \<and> a \<subseteq> b
- ==> ~(s \<inter> b = {}) \<and> a \<subseteq> b`) THEN
- ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN
- X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
- REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
- REWRITE_TAC[GSYM real_div] THEN
- SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
- MP_TAC(SPEC `(u:real^N)$k / 2` FLOOR) THEN
- REWRITE_TAC[REAL_ARITH `u / 2 < floor(u / 2) + 1 \<longleftrightarrow>
- u < 2 * floor(u / 2) + 2`] THEN
- ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN
- REAL_ARITH_TAC;
- REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
- MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN
- DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN
- ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
- GEN_TAC THEN DISCH_TAC THEN
- EXISTS_TAC `interval(inv(2 pow n) % u:real^N,
- inv(2 pow n) % (u + 1))` THEN
- EXISTS_TAC `interval[inv(2 pow n) % u:real^N,
- inv(2 pow n) % (u + 1)]` THEN
- REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN
- ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN
- REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
- CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
- ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT;
- VEC_COMPONENT] THEN
- REAL_ARITH_TAC]);; *)
-
-lemma gmeasurable_open: True .. (*
- "!s:real^N->bool. bounded s \<and> open s ==> gmeasurable s"
-qed REPEAT STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
- REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
- FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
- `s \<subseteq> t ==> s = t DIFF (t DIFF s)`)) THEN
- MATCH_MP_TAC GMEASURABLE_DIFF THEN
- REWRITE_TAC[MEASURABLE_INTERVAL] THEN
- MATCH_MP_TAC GMEASURABLE_COMPACT THEN
- SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN
- MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);; *)
-
-lemma gmeasurable_closure: True .. (*
- "!s. bounded s ==> gmeasurable(closure s)"
-qed SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE;
- BOUNDED_CLOSURE]);; *)
-
-lemma gmeasurable_interior: True .. (*
- "!s. bounded s ==> gmeasurable(interior s)"
-qed SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);; *)
-
-lemma gmeasurable_frontier: True .. (*
- "!s:real^N->bool. bounded s ==> gmeasurable(frontier s)"
-qed REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
- MATCH_MP_TAC GMEASURABLE_DIFF THEN
- ASM_SIMP_TAC[MEASURABLE_CLOSURE; GMEASURABLE_INTERIOR] THEN
- MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
- REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; *)
-
-lemma measure_frontier: True .. (*
- "!s:real^N->bool.
- bounded s
- ==> measure(frontier s) = measure(closure s) - measure(interior s)"
-qed REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
- MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
- ASM_SIMP_TAC[MEASURABLE_CLOSURE; GMEASURABLE_INTERIOR] THEN
- MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
- REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; *)
-
-lemma gmeasurable_jordan: True .. (*
- "!s:real^N->bool. bounded s \<and> negligible(frontier s) ==> gmeasurable s"
-qed REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
- GEN_TAC THEN DISCH_TAC THEN
- EXISTS_TAC `interior(s):real^N->bool` THEN
- EXISTS_TAC `closure(s):real^N->bool` THEN
- ASM_SIMP_TAC[MEASURABLE_INTERIOR; GMEASURABLE_CLOSURE] THEN
- REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN
- ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
- ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);; *)
-
-lemma has_gmeasure_elementary: True .. (*
- "!d s. d division_of s ==> s has_gmeasure (sum d content)"
-qed REPEAT STRIP_TAC THEN REWRITE_TAC[has_gmeasure] THEN
- FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
- ASM_SIMP_TAC[LIFT_SUM] THEN
- MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
- ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_gmeasure] THEN
- ASM_MESON_TAC[HAS_GMEASURE_INTERVAL; division_of]);; *)
-
-lemma gmeasurable_elementary: True .. (*
- "!d s. d division_of s ==> gmeasurable s"
-qed REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_ELEMENTARY]);; *)
-
-lemma measure_elementary: True .. (*
- "!d s. d division_of s ==> gmeasure s = sum d content"
-qed MESON_TAC[HAS_GMEASURE_ELEMENTARY; MEASURE_UNIQUE]);; *)
-
-lemma gmeasurable_inter_interval: True .. (*
- "!s a b:real^N. gmeasurable s ==> gmeasurable (s \<inter> {a..b})"
-qed SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_INTERVAL]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* A nice lemma for negligibility proofs. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE: True .. (*
- "!s. gmeasurable s \<and> bounded s \<and>
- (!c x:real^N. 0 \<le> c \<and> x \<in> s \<and> (c % x) \<in> s ==> c = 1)
- ==> negligible s"
-qed REPEAT STRIP_TAC THEN
- SUBGOAL_THEN `~(0 < measure(s:real^N->bool))`
- (fun th -> ASM_MESON_TAC[th; GMEASURABLE_MEASURE_POS_LT]) THEN
- DISCH_TAC THEN
- MP_TAC(SPEC `(0:real^N) INSERT s`
- BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
- ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN
- X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
- SUBGOAL_THEN
- `?N. EVEN N \<and> 0 < N \<and>
- measure(interval[--a:real^N,a])
- < (N * measure(s:real^N->bool)) / 4 pow dimindex (:N)`
- STRIP_ASSUME_TAC THENL
- [FIRST_ASSUM(MP_TAC o SPEC
- `measure(interval[--a:real^N,a]) * 4 pow (dimindex(:N))` o
- MATCH_MP REAL_ARCH) THEN
- SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
- SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `0 < measure(s:real^N->bool)`] THEN
- DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN
- CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
- FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
- `x < a ==> a \<le> b ==> x < b`)) THEN
- REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC;
- ALL_TAC] THEN
- MP_TAC(ISPECL [`\<Union>(IMAGE (\<lambda>m. IMAGE (\<lambda>x:real^N. (m / N) % x) s)
- (1..N))`;
- `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN
- MP_TAC(ISPECL [`measure:(real^N->bool)->real`;
- `IMAGE (\<lambda>m. IMAGE (\<lambda>x:real^N. (m / N) % x) s) (1..N)`]
- HAS_GMEASURE_DISJOINT_UNIONS) THEN
- SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN
- REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
- [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE] THEN
- MATCH_MP_TAC GMEASURABLE_SCALING THEN ASM_REWRITE_TAC[];
- ALL_TAC] THEN
- REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
- ONCE_REWRITE_TAC[TAUT `(a \<and> b) \<and> ~c ==> d \<longleftrightarrow> a \<and> b \<and> ~d ==> c`] THEN
- SUBGOAL_THEN
- `!m n. m \<in> 1..N \<and> n \<in> 1..N \<and>
- ~(DISJOINT (IMAGE (\<lambda>x:real^N. m / N % x) s)
- (IMAGE (\<lambda>x. n / N % x) s))
- ==> m = n`
- ASSUME_TAC THENL
- [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
- REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
- REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
- REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
- DISCH_THEN(X_CHOOSE_THEN `x:real^N`
- (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
- REWRITE_TAC[IN_IMAGE] THEN
- DISCH_THEN(X_CHOOSE_THEN `y:real^N`
- (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
- DISCH_THEN(MP_TAC o AP_TERM `(%) (N / m) :real^N->real^N`) THEN
- SUBGOAL_THEN `~(N = 0) \<and> ~(m = 0)` STRIP_ASSUME_TAC THENL
- [REWRITE_TAC[REAL_OF_NUM_EQ] THEN
- REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN
- ARITH_TAC;
- ALL_TAC] THEN
- FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV)
- [GSYM CONTRAPOS_THM]) THEN
- ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD
- `~(x = 0) \<and> ~(y = 0) ==> x / y * y / x = 1`] THEN
- ASM_SIMP_TAC[REAL_FIELD
- `~(x = 0) \<and> ~(y = 0) ==> x / y * z / x = z / y`] THEN
- REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`n / m`; `y:real^N`]) THEN
- ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD
- `~(y = 0) ==> (x / y = 1 \<longleftrightarrow> x = y)`] THEN
- REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ];
- ALL_TAC] THEN
- ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
- REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
- [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[];
- REWRITE_TAC[MEASURABLE_INTERVAL];
- REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
- REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
- X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN
- DISCH_TAC THEN
- MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN
- DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN
- DISCH_THEN(MP_TAC o SPECL [`0:real^N`; `x:real^N`; `n / N`]) THEN
- ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
- DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN
- CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN
- DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
- `1 \<le> n \<and> n \<le> N ==> 0 < N \<and> n \<le> N`)) THEN
- SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN
- SIMP_TAC[REAL_MUL_LID];
- ALL_TAC] THEN
- FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN
- ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN
- FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
- MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC
- `sum (1..N) (measure o (\<lambda>m. IMAGE (\<lambda>x:real^N. m / N % x) s))` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
- MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN
- REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
- ASM_REWRITE_TAC[SET_RULE `DISJOINT s s \<longleftrightarrow> s = {}`; IMAGE_EQ_EMPTY] THEN
- DISCH_THEN SUBST_ALL_TAC THEN
- ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN
- FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
- ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN
- FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
- `x < a ==> a \<le> b ==> x < b`)) THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
- ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN
- ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
- REWRITE_TAC[GSYM REAL_POW_MUL] THEN
- REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN
- FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o
- GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
- REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN
- RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `0 < 2 * x \<longleftrightarrow> 0 < x`]) THEN
- ASM_SIMP_TAC[REAL_FIELD `0 < y ==> x / (2 * y) * 4 = x * 2 / y`] THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sum(M..(2*M)) (\<lambda>i. (i * 2 / M) pow dimindex (:N))` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
- SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN
- REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN
- ARITH_TAC] THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sum(M..(2*M)) (\<lambda>i. 2)` THEN CONJ_TAC THENL
- [REWRITE_TAC[SUM_CONST_NUMSEG] THEN
- REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN
- REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
- X_GEN_TAC `n:num` THEN STRIP_TAC THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `2 pow (dimindex(:N))` THEN
- CONJ_TAC THENL
- [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN
- MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN
- ARITH_TAC;
- ALL_TAC] THEN
- MATCH_MP_TAC REAL_POW_LE2 THEN
- REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN
- ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
- REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN
- UNDISCH_TAC `M:num \<le> n` THEN ARITH_TAC);; *)
-
-lemma STARLIKE_NEGLIGIBLE_LEMMA: True .. (*
- "!s. compact s \<and>
- (!c x:real^N. 0 \<le> c \<and> x \<in> s \<and> (c % x) \<in> s ==> c = 1)
- ==> negligible s"
-qed REPEAT STRIP_TAC THEN
- MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN
- ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);; *)
-
-lemma STARLIKE_NEGLIGIBLE: True .. (*
- "!s a. closed s \<and>
- (!c x:real^N. 0 \<le> c \<and> (a + x) \<in> s \<and> (a + c % x) \<in> s ==> c = 1)
- ==> negligible s"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN
- EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
- MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
- MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL
- [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN
- ASM_SIMP_TAC[CLOSED_TRANSLATION];
- REWRITE_TAC[IN_IMAGE; IN_INTER] THEN
- ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y \<longleftrightarrow> y = a + x`] THEN
- REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);; *)
-
-lemma STARLIKE_NEGLIGIBLE_STRONG: True .. (*
- "!s a. closed s \<and>
- (!c x:real^N. 0 \<le> c \<and> c < 1 \<and> (a + x) \<in> s
- ==> ~((a + c % x) \<in> s))
- ==> negligible s"
-qed REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
- EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
- MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
- MATCH_MP_TAC(REAL_ARITH `~(x < y) \<and> ~(y < x) ==> x = y`) THEN
- STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`inv c`; `c % x:real^N`]) THEN
- ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN
- ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `1 < c ==> ~(c = 0)`] THEN
- ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
- GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN
- MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* In particular. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma NEGLIGIBLE_HYPERPLANE: True .. (*
- "!a b. ~(a = 0 \<and> b = 0) ==> negligible {x:real^N | a dot x = b}"
-qed REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = 0` THEN
- ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN
- MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
- SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL
- [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN
- EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN
- MATCH_MP_TAC(REAL_ARITH `~(a = 0) ==> ~(a = b) \/ ~(--a = b)`) THEN
- ASM_REWRITE_TAC[DOT_EQ_0];
- ALL_TAC] THEN
- MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
- REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN
- MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN
- DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
- `0 \<le> t \<and> ac + ay = b \<and> ac + t * ay = b
- ==> ((ay = 0 ==> ac = b) \<and> (t - 1) * ay = 0)`)) THEN
- ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);; *)
-
-lemma NEGLIGIBLE_LOWDIM: True .. (*
- "!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s"
-qed GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
- DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `{x:real^N | a dot x = 0}` THEN
- ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Measurability of bounded convex sets. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma NEGLIGIBLE_CONVEX_FRONTIER: True .. (*
- "!s:real^N->bool. convex s ==> negligible(frontier s)"
-qed SUBGOAL_THEN
- `!s:real^N->bool. convex s \<and> (0) \<in> s ==> negligible(frontier s)`
- ASSUME_TAC THENL
- [ALL_TAC;
- X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
- ASM_CASES_TAC `s:real^N->bool = {}` THEN
- ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
- DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\<lambda>x:real^N. --a + x) s`) THEN
- ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN
- ASM_REWRITE_TAC[UNWIND_THM2;
- VECTOR_ARITH `0:real^N = --a + x \<longleftrightarrow> x = a`] THEN
- REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN
- REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN
- REWRITE_TAC[ARITH_RULE `d:num \<le> e \<longleftrightarrow> d < e \/ d = e`] THEN STRIP_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `closure s:real^N->bool` THEN
- REWRITE_TAC[frontier; SUBSET_DIFF] THEN
- MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE];
- ALL_TAC] THEN
- SUBGOAL_THEN `?a:real^N. a \<in> interior s` CHOOSE_TAC THENL
- [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
- (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
- FIRST_X_ASSUM SUBST_ALL_TAC THEN
- MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN
- ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN
- MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN
- ASM_REWRITE_TAC[INSERT_SUBSET];
- ALL_TAC] THEN
- MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN
- EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
- REPEAT GEN_TAC THEN STRIP_TAC THEN
- REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN
- SIMP_TAC[VECTOR_ARITH
- `a + c % x:real^N = (a + x) - (1 - c) % ((a + x) - a)`] THEN
- MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN
- RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
- ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; *)
-
-lemma GMEASURABLE_CONVEX: True .. (*
- "!s:real^N->bool. convex s \<and> bounded s ==> gmeasurable s"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_JORDAN THEN
- ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Various special cases. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma NEGLIGIBLE_SPHERE: True .. (*
- "!a r. negligible {x:real^N | dist(a,x) = r}"
-qed REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
- SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; *)
-
-lemma GMEASURABLE_BALL: True .. (*
- "!a r. gmeasurable(ball(a,r))"
-qed SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);; *)
-
-lemma GMEASURABLE_CBALL: True .. (*
- "!a r. gmeasurable(cball(a,r))"
-qed SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Negligibility of image under non-injective linear map. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma NEGLIGIBLE_LINEAR_SINGULAR_IMAGE: True .. (*
- "!f:real^N->real^N s.
- linear f \<and> ~(!x y. f(x) = f(y) ==> x = y)
- ==> negligible(IMAGE f s)"
-qed REPEAT GEN_TAC THEN
- DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN
- DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `{x:real^N | a dot x = 0}` THEN
- ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Approximation of gmeasurable set by union of intervals. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma COVERING_LEMMA: True .. (*
- "!a b:real^N s g.
- s \<subseteq> {a..b} \<and> ~({a<..<b} = {}) \<and> gauge g
- ==> ?d. COUNTABLE d \<and>
- (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
- (\<exists>c d. k = {c..d})) \<and>
- (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
- ==> interior k1 \<inter> interior k2 = {}) \<and>
- (!k. k \<in> d ==> ?x. x \<in> (s \<inter> k) \<and> k \<subseteq> g(x)) \<and>
- s \<subseteq> \<Union>d"
-qed REPEAT STRIP_TAC THEN
- SUBGOAL_THEN
- `?d. COUNTABLE d \<and>
- (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
- (\<exists>c d:real^N. k = {c..d})) \<and>
- (!k1 k2. k1 \<in> d \<and> k2 \<in> d
- ==> k1 \<subseteq> k2 \/ k2 \<subseteq> k1 \/
- interior k1 \<inter> interior k2 = {}) \<and>
- (!x. x \<in> s ==> ?k. k \<in> d \<and> x \<in> k \<and> k \<subseteq> g(x)) \<and>
- (!k. k \<in> d ==> FINITE {l | l \<in> d \<and> k \<subseteq> l})`
- ASSUME_TAC THENL
- [EXISTS_TAC
- `IMAGE (\<lambda>(n,v).
- interval[(lambda i. a$i + (v$i) / 2 pow n *
- ((b:real^N)$i - (a:real^N)$i)):real^N,
- (lambda i. a$i + ((v$i) + 1) / 2 pow n * (b$i - a$i))])
- {n,v | n \<in> (:num) \<and>
- v \<in> {v:num^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> v$i < 2 EXP n}}` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC COUNTABLE_IMAGE THEN
- MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
- REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN
- GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
- MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
- ALL_TAC] THEN
- CONJ_TAC THENL
- [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
- MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
- REWRITE_TAC[IN_ELIM_PAIR_THM] THEN
- REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
- REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
- SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN
- REWRITE_TAC[REAL_LE_LADD; REAL_LE_ADDR; REAL_ARITH
- `a + x * (b - a) \<le> b \<longleftrightarrow> 0 \<le> (1 - x) * (b - a)`] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
- REPEAT STRIP_TAC THEN
- (MATCH_MP_TAC REAL_LE_MUL ORELSE MATCH_MP_TAC REAL_LE_RMUL) THEN
- ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
- REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_LE_ADDR] THEN
- SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
- ASM_SIMP_TAC[ARITH_RULE `x + 1 \<le> y \<longleftrightarrow> x < y`; REAL_LT_IMP_LE];
- ALL_TAC] THEN
- CONJ_TAC THENL
- [ONCE_REWRITE_TAC[IMP_CONJ] THEN
- REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN
- REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN
- REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
- GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
- MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
- [REPEAT GEN_TAC THEN
- GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
- REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[];
- ALL_TAC] THEN
- MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
- MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN
- REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN
- SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN
- MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN
- ONCE_REWRITE_TAC[TAUT `a \<and> b \<and> c \<longleftrightarrow> ~(a \<and> b ==> ~c)`] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
- ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN
- REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN
- ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
- REWRITE_TAC[REAL_ARITH `~(x + 1 \<le> x)`] THEN DISJ2_TAC THEN
- MATCH_MP_TAC(MESON[]
- `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (\<exists>i. P i)`) THEN
- X_GEN_TAC `i:num` THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
- ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN
- UNDISCH_TAC `m:num \<le> n` THEN REWRITE_TAC[LE_EXISTS] THEN
- DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN
- ONCE_REWRITE_TAC[ADD_SYM] THEN
- REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
- REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
- ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2;
- REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
- SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- CONJ_TAC THENL
- [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
- SUBGOAL_THEN
- `?e. 0 < e \<and> !y. (!i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> abs((x:real^N)$i - (y:real^N)$i) \<le> e)
- ==> y \<in> g(x)`
- STRIP_ASSUME_TAC THENL
- [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN
- STRIP_TAC THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
- DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
- DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `e / 2 / (dimindex(:N))` THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
- ARITH] THEN
- X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
- MATCH_MP_TAC(SET_RULE `!s. s \<subseteq> t \<and> x \<in> s ==> x \<in> t`) THEN
- EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN
- MATCH_MP_TAC(REAL_ARITH `0 < e \<and> x \<le> e / 2 ==> x < e`) THEN
- ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `sum(1..dimindex(:N)) (\<lambda>i. abs((x - y:real^N)$i))` THEN
- REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
- ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT;
- DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1];
- ALL_TAC] THEN
- REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
- MP_TAC(SPECL [`1 / 2`; `e / norm(b - a:real^N)`]
- REAL_ARCH_POW_INV) THEN
- SUBGOAL_THEN `0 < norm(b - a:real^N)` ASSUME_TAC THENL
- [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN
- CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
- MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
- REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN
- SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN
- MATCH_MP_TAC(MESON[]
- `(!x. Q x ==> R x) \<and> (\<exists>x. P x \<and> Q x) ==> ?x. P x \<and> Q x \<and> R x`) THEN
- CONJ_TAC THENL
- [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
- MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN
- REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
- DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
- ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
- `(a + n \<le> x \<and> x \<le> a + m) \<and>
- (a + n \<le> y \<and> y \<le> a + m) ==> abs(x - y) \<le> m - n`)) THEN
- MATCH_MP_TAC(REAL_ARITH
- `y * z \<le> e
- ==> a \<le> ((x + 1) * y) * z - ((x * y) * z) ==> a \<le> e`) THEN
- RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
- ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
- FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
- (REAL_ARITH `n < e * x ==> 0 \<le> e * (inv y - x) ==> n \<le> e / y`)) THEN
- MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
- REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
- ASM_SIMP_TAC[REAL_SUB_LT] THEN
- MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
- ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN
- REWRITE_TAC[TAUT `(a ==> c) \<and> (a ==> b) \<longleftrightarrow> a ==> b \<and> c`] THEN
- REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN
- STRIP_TAC THEN
- SUBGOAL_THEN `(x:real^N) \<in> {a..b}` MP_TAC THENL
- [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN
- DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN
- DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x \<le> y ==> x = y \/ x < y`)
- (ASSUME `(x:real^N)$i \<le> (b:real^N)$i`))
- THENL
- [EXISTS_TAC `2 EXP n - 1` THEN
- SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT;
- EXP_LT_0; LE_1; ARITH] THEN
- ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - 1 < a`] THEN
- MATCH_MP_TAC(REAL_ARITH
- `1 * (b - a) = x \<and> y \<le> x ==> a + y \<le> b \<and> b \<le> a + x`) THEN
- ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ;
- REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
- SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0;
- REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- MP_TAC(SPEC `2 pow n * ((x:real^N)$i - (a:real^N)$i) /
- ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN
- ANTS_TAC THENL
- [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS;
- REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV];
- ALL_TAC] THEN
- MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
- REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
- DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
- REWRITE_TAC[REAL_ARITH `a + b * c \<le> x \<and> x \<le> a + b' * c \<longleftrightarrow>
- b * c \<le> x - a \<and> x - a \<le> b' * c`] THEN
- ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
- REAL_SUB_LT; GSYM real_div] THEN
- ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
- SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
- SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
- EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) /
- ((b:real^N)$i - (a:real^N)$i) *
- 2 pow n` THEN
- REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
- ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN
- ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN
- ASM_REAL_ARITH_TAC;
- ALL_TAC] THEN
- REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
- MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
- REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
- MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC
- `IMAGE (\<lambda>(n,v).
- interval[(lambda i. a$i + (v$i) / 2 pow n *
- ((b:real^N)$i - (a:real^N)$i)):real^N,
- (lambda i. a$i + ((v$i) + 1) / 2 pow n * (b$i - a$i))])
- {m,v | m \<in> 0..n \<and>
- v \<in> {v:num^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
- ==> v$i < 2 EXP m}}` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC FINITE_IMAGE THEN
- MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
- REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
- ALL_TAC] THEN
- GEN_REWRITE_TAC I [SUBSET] THEN
- REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
- REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
- MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN
- DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
- MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN
- REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN
- SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
- ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
- ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
- REWRITE_TAC[REAL_ARITH `x \<le> x + 1`] THEN
- DISCH_THEN(MP_TAC o SPEC `1`) THEN
- REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN
- DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
- `w / m \<le> v / n \<and> (v + 1) / n \<le> (w + 1) / m
- ==> inv n \<le> inv m`)) THEN
- REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
- ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN
- ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
- ALL_TAC] THEN
- SUBGOAL_THEN
- `?d. COUNTABLE d \<and>
- (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
- (\<exists>c d:real^N. k = {c..d})) \<and>
- (!k1 k2. k1 \<in> d \<and> k2 \<in> d
- ==> k1 \<subseteq> k2 \/ k2 \<subseteq> k1 \/
- interior k1 \<inter> interior k2 = {}) \<and>
- (!k. k \<in> d ==> (\<exists>x. x \<in> s \<inter> k \<and> k \<subseteq> g x)) \<and>
- (!k. k \<in> d ==> FINITE {l | l \<in> d \<and> k \<subseteq> l}) \<and>
- s \<subseteq> \<Union>d`
- MP_TAC THENL
- [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC
- `{k:real^N->bool | k \<in> d \<and> ?x. x \<in> (s \<inter> k) \<and> k \<subseteq> g x}` THEN
- ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
- [MATCH_MP_TAC COUNTABLE_SUBSET THEN
- EXISTS_TAC `d:(real^N->bool)->bool` THEN
- ASM_REWRITE_TAC[] THEN SET_TAC[];
- X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC FINITE_SUBSET THEN
- EXISTS_TAC `{l:real^N->bool | l \<in> d \<and> k \<subseteq> l}` THEN
- ASM_REWRITE_TAC[] THEN SET_TAC[];
- ASM SET_TAC[]];
- ALL_TAC] THEN
- DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC
- `{k:real^N->bool | k \<in> d \<and> !k'. k' \<in> d \<and> ~(k = k')
- ==> ~(k \<subseteq> k')}` THEN
- ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
- [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN
- ASM_REWRITE_TAC[] THEN SET_TAC[];
- ASM SET_TAC[];
- ALL_TAC] THEN
- FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
- (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
- GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN
- MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN
- REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
- MP_TAC(ISPEC `\k l:real^N->bool. k \<in> d \<and> l \<in> d \<and> l \<subseteq> k \<and> ~(k = l)`
- WF_FINITE) THEN
- REWRITE_TAC[WF] THEN ANTS_TAC THENL
- [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN
- ASM_CASES_TAC `(l:real^N->bool) \<in> d` THEN
- ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN
- MATCH_MP_TAC FINITE_SUBSET THEN
- EXISTS_TAC `{m:real^N->bool | m \<in> d \<and> l \<subseteq> m}` THEN
- ASM_SIMP_TAC[] THEN SET_TAC[];
- ALL_TAC] THEN
- DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l \<in> d \<and> x \<in> l`) THEN
- REWRITE_TAC[] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
- MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; *)
-
-lemma GMEASURABLE_OUTER_INTERVALS_BOUNDED: True .. (*
- "!s a b:real^N e.
- gmeasurable s \<and> s \<subseteq> {a..b} \<and> 0 < e
- ==> ?d. COUNTABLE d \<and>
- (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
- (\<exists>c d. k = {c..d})) \<and>
- (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
- ==> interior k1 \<inter> interior k2 = {}) \<and>
- s \<subseteq> \<Union>d \<and>
- gmeasurable (\<Union>d) \<and>
- gmeasure (\<Union>d) \<le> gmeasure s + e"
-qed lemma lemma = prove
- (`(!x y. (x,y) \<in> IMAGE (\<lambda>z. f z,g z) s ==> P x y) \<longleftrightarrow>
- (!z. z \<in> s ==> P (f z) (g z))"
-qed REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in
- REPEAT GEN_TAC THEN
- ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
- [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN
- EXISTS_TAC `{}:(real^N->bool)->bool` THEN
- ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID;
- SUBSET_REFL; COUNTABLE_EMPTY; GMEASURABLE_EMPTY] THEN
- ASM_SIMP_TAC[REAL_LT_IMP_LE];
- ALL_TAC] THEN
- STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THENL
- [EXISTS_TAC `{interval[a:real^N,b]}` THEN
- REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN
- ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT;
- NOT_IN_EMPTY; SUBSET_REFL; GMEASURABLE_INTERVAL] THEN
- CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
- SUBGOAL_THEN
- `measure(interval[a:real^N,b]) = 0 \<and> measure(s:real^N->bool) = 0`
- (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN
- SUBGOAL_THEN
- `interval[a:real^N,b] has_gmeasure 0 \<and> (s:real^N->bool) has_gmeasure 0`
- (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN
- REWRITE_TAC[HAS_GMEASURE_0] THEN
- MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
- [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL];
- ASM_MESON_TAC[NEGLIGIBLE_SUBSET]];
- ALL_TAC] THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN
- DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN
- FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN
- SUBGOAL_THEN
- `((\<lambda>x:real^N. if x \<in> s then 1 else 0) has_integral (lift m))
- {a..b}`
- ASSUME_TAC THENL
- [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_GMEASURE]) THEN
- MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN
- ASM SET_TAC[];
- ALL_TAC] THEN
- FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN
- DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
- DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN
- MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`;
- `g:real^N->real^N->bool`] COVERING_LEMMA) THEN
- ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
- X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
- MP_TAC(ISPECL [`(\<lambda>x. if x \<in> s then 1 else 0):real^N->real^1`;
- `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`;
- `e:real`]
- HENSTOCK_LEMMA_PART1) THEN
- ASM_REWRITE_TAC[] THEN
- FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
- ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN
- SUBGOAL_THEN
- `!k l:real^N->bool. k \<in> d \<and> l \<in> d \<and> ~(k = l)
- ==> negligible(k \<inter> l)`
- ASSUME_TAC THENL
- [REPEAT STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN
- ASM_SIMP_TAC[] THEN
- SUBGOAL_THEN
- `?x y:real^N u v:real^N. k = {x..y} \<and> l = {u..v}`
- MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
- DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
- REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `(interval[x:real^N,y] DIFF {x<..<y}) UNION
- (interval[u:real^N,v] DIFF {u<..<v}) UNION
- (interval (x,y) \<inter> interval (u,v))` THEN
- CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
- ASM_REWRITE_TAC[UNION_EMPTY] THEN
- SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `!D. FINITE D \<and> D \<subseteq> d
- ==> gmeasurable(\<Union>D :real^N->bool) \<and> measure(\<Union>D) \<le> m + e`
- ASSUME_TAC THENL
- [GEN_TAC THEN STRIP_TAC THEN
- SUBGOAL_THEN
- `?t:(real^N->bool)->real^N. !k. k \<in> D ==> t(k) \<in> (s \<inter> k) \<and>
- k \<subseteq> (g(t k))`
- (CHOOSE_THEN (LABEL_TAC "+")) THENL
- [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN
- REMOVE_THEN "*" (MP_TAC o SPEC
- `IMAGE (\<lambda>k. (t:(real^N->bool)->real^N) k,k) D`) THEN
- ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN
- ANTS_TAC THENL
- [REWRITE_TAC[tagged_partial_division_of; fine] THEN
- ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
- REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN
- ASM_SIMP_TAC[] THEN
- CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]];
- ALL_TAC] THEN
- USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN
- SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
- ASM_SIMP_TAC[VSUM_SUB] THEN
- SUBGOAL_THEN `D division_of (\<Union>D:real^N->bool)` ASSUME_TAC THENL
- [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN
- FIRST_ASSUM(ASSUME_TAC o MATCH_MP GMEASURABLE_ELEMENTARY) THEN
- SUBGOAL_THEN `vsum D (\<lambda>k:real^N->bool. content k % 1) =
- lift(measure(\<Union>D))`
- SUBST1_TAC THENL
- [ONCE_REWRITE_TAC[GSYM _EQ] THEN
- ASM_SIMP_TAC[LIFT_; _VSUM; o_DEF; _CMUL; _VEC] THEN
- SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `vsum D (\<lambda>k. integral k (\<lambda>x:real^N. if x \<in> s then 1 else 0)) =
- lift(sum D (\<lambda>k. measure(k \<inter> s)))`
- SUBST1_TAC THENL
- [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN
- X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
- SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL
- [ASM_MESON_TAC[SUBSET; GMEASURABLE_INTERVAL]; ALL_TAC] THEN
- ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; GMEASURABLE_INTER] THEN
- REWRITE_TAC[MESON[IN_INTER]
- `(if x \<in> k \<inter> s then a else b) =
- (if x \<in> k then if x \<in> s then a else b else b)`] THEN
- CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_RESTRICT_UNIV THEN
- ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
- REWRITE_TAC[MESON[IN_INTER]
- `(if x \<in> k then if x \<in> s then a else b else b) =
- (if x \<in> k \<inter> s then a else b)`] THEN
- ASM_SIMP_TAC[GSYM GMEASURABLE_INTEGRABLE; GMEASURABLE_INTER];
- ALL_TAC] THEN
- ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
- MATCH_MP_TAC(REAL_ARITH `y \<le> m ==> abs(x - y) \<le> e ==> x \<le> m + e`) THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `measure(\<Union>D \<inter> s:real^N->bool)` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN
- ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
- MATCH_MP_TAC GMEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN
- REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN
- MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
- ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL
- [ASM_MESON_TAC[SUBSET; GMEASURABLE_INTERVAL; GMEASURABLE_INTER];
- ALL_TAC] THEN
- MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
- STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `k \<inter> l:real^N->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[];
- ALL_TAC] THEN
- ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
- [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
- MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
- ASM_REWRITE_TAC[INFINITE] THEN
- DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
- (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
- MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`]
- HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
- MATCH_MP_TAC(TAUT `a \<and> (a \<and> b ==> c) ==> (a ==> b) ==> c`) THEN
- REWRITE_TAC[GSYM CONJ_ASSOC] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
- FORALL_IN_IMAGE; IN_UNIV]) THEN
- RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
- REPEAT CONJ_TAC THENL
- [ASM_MESON_TAC[MEASURABLE_INTERVAL; GMEASURABLE_INTER];
- ASM_MESON_TAC[];
- X_GEN_TAC `n:num` THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN
- SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN
- DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
- MATCH_MP_TAC(REAL_ARITH `x = y ==> x \<le> e ==> y \<le> e`) THEN
- MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
- ASM_MESON_TAC[FINITE_NUMSEG; GMEASURABLE_INTERVAL];
- ALL_TAC] THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
- GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_)] THEN
- REWRITE_TAC[] THEN
- MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN
- EXISTS_TAC
- `\n. vsum(from 0 \<inter> (0..n)) (\<lambda>n. lift(measure(s n:real^N->bool)))` THEN
- ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
- REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN
- SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN
- ASM_REWRITE_TAC[GSYM ; LIFT_; FROM_INTER_NUMSEG]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Hence for linear transformation, suffices to check compact intervals. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma GMEASURABLE_LINEAR_IMAGE_INTERVAL: True .. (*
- "!f a b. linear f ==> gmeasurable(IMAGE f {a..b})"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_CONVEX THEN CONJ_TAC THENL
- [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN
- ASM_MESON_TAC[CONVEX_INTERVAL];
- MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
- ASM_MESON_TAC[BOUNDED_INTERVAL]]);; *)
-
-lemma HAS_GMEASURE_LINEAR_SUFFICIENT: True .. (*
- "!f:real^N->real^N m.
- linear f \<and>
- (!a b. IMAGE f {a..b} has_gmeasure
- (m * measure{a..b}))
- ==> !s. gmeasurable s ==> (IMAGE f s) has_gmeasure (m * gmeasure s)"
-qed REPEAT GEN_TAC THEN STRIP_TAC THEN
- DISJ_CASES_TAC(REAL_ARITH `m < 0 \/ 0 \<le> m`) THENL
- [FIRST_X_ASSUM(MP_TAC o SPECL [`0:real^N`; `1:real^N`]) THEN
- DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_POS_LE) THEN
- MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN
- MATCH_MP_TAC(REAL_ARITH `0 < --m * x ==> ~(0 \<le> m * x)`) THEN
- MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
- REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN
- SIMP_TAC[VEC_COMPONENT; REAL_LT_01];
- ALL_TAC] THEN
- ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL
- [ALL_TAC;
- SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL
- [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN
- SUBGOAL_THEN `m * measure(interval[0:real^N,1]) = 0` MP_TAC THENL
- [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) {0..1}`
- HAS_GMEASURE_UNIQUE) THEN
- ASM_REWRITE_TAC[HAS_GMEASURE_0];
- REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN
- MATCH_MP_TAC(TAUT `~b \<and> (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
- [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL;
- INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01];
- ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_GMEASURE_0]]]] THEN
- MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN
- ASM_REWRITE_TAC[] THEN
- DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN
- UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN
- SUBGOAL_THEN
- `!s. bounded s \<and> gmeasurable s
- ==> (IMAGE (f:real^N->real^N) s) has_gmeasure (m * gmeasure s)`
- ASSUME_TAC THENL
- [REPEAT STRIP_TAC THEN
- FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
- REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
- SUBGOAL_THEN
- `!d. COUNTABLE d \<and>
- (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
- (\<exists>c d. k = {c..d})) \<and>
- (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
- ==> interior k1 \<inter> interior k2 = {})
- ==> IMAGE (f:real^N->real^N) (\<Union>d) has_gmeasure
- (m * measure(\<Union>d))`
- ASSUME_TAC THENL
- [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN
- SUBGOAL_THEN
- `!g:real^N->real^N.
- linear g
- ==> !k l. k \<in> d \<and> l \<in> d \<and> ~(k = l)
- ==> negligible((IMAGE g k) \<inter> (IMAGE g l))`
- MP_TAC THENL
- [REPEAT STRIP_TAC THEN
- ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL
- [ALL_TAC;
- ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE;
- NEGLIGIBLE_INTER]] THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k \<inter> IMAGE g l) UNION
- interior(IMAGE g k \<inter> IMAGE g l)` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
- `s \<subseteq> t ==> s \<subseteq> (t DIFF u) \<union> u`) THEN
- REWRITE_TAC[CLOSURE_SUBSET]] THEN
- MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
- MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN
- MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL];
- ALL_TAC] THEN
- REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER
- IMAGE g (interior l)` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC
- `IMAGE (g:real^N->real^N) (interior k \<inter> interior l)` THEN
- CONJ_TAC THENL
- [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; SET_TAC[]];
- MATCH_MP_TAC(SET_RULE
- `s \<subseteq> u \<and> t \<subseteq> v ==> (s \<inter> t) \<subseteq> (u \<inter> v)`) THEN
- CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN
- ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]];
- ALL_TAC] THEN
- DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN
- MP_TAC(SPEC `\x:real^N. x` th)) THEN
- ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\<lambda>x. x) s = s`] THEN
- REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
- [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`]
- HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
- ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
- MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- MATCH_MP_TAC EQ_TRANS THEN
- EXISTS_TAC `sum d (\<lambda>k:real^N->bool. m * gmeasure k)` THEN CONJ_TAC THENL
- [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN
- REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN
- CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN
- ASM_REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE] THEN
- ASM_MESON_TAC[MEASURABLE_INTERVAL];
- ALL_TAC] THEN
- MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
- ASM_REWRITE_TAC[INFINITE] THEN
- DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
- (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
- MP_TAC(ISPEC `s:num->real^N->bool`
- HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
- MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)`
- HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
- RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
- FORALL_IN_IMAGE; IN_UNIV]) THEN
- RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
- ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL
- [REPEAT CONJ_TAC THENL
- [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL];
- ASM_MESON_TAC[];
- ONCE_REWRITE_TAC[GSYM o_DEF] THEN
- REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN
- MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
- EXISTS_TAC `interval[a:real^N,b]` THEN
- REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
- ALL_TAC] THEN
- STRIP_TAC THEN ANTS_TAC THENL
- [REPEAT CONJ_TAC THENL
- [ASM_MESON_TAC[MEASURABLE_INTERVAL];
- ASM_MESON_TAC[];
- MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
- EXISTS_TAC `interval[a:real^N,b]` THEN
- REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
- ALL_TAC] THEN
- STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
- SUBGOAL_THEN `m * gmeasure (\<Union>(IMAGE s (:num)):real^N->bool) =
- measure(\<Union>(IMAGE (\<lambda>x. IMAGE f (s x)) (:num)):real^N->bool)`
- (fun th -> ASM_REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE; th]) THEN
- ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN
- MATCH_MP_TAC SERIES_UNIQUE THEN
- EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN
- EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN
- EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN
- CONJ_TAC THENL
- [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN
- ASM_MESON_TAC[MEASURE_UNIQUE];
- REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN
- ASM_REWRITE_TAC[]];
- ALL_TAC] THEN
- REWRITE_TAC[HAS_GMEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN
- X_GEN_TAC `e:real` THEN DISCH_TAC THENL
- [MP_TAC(ISPECL [`{a..b} DIFF s:real^N->bool`; `a:real^N`;
- `b:real^N`; `e / (1 + abs m)`] GMEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
- ANTS_TAC THENL
- [ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_INTERVAL] THEN
- ASM_SIMP_TAC[REAL_ARITH `0 < 1 + abs x`; REAL_LT_DIV] THEN SET_TAC[];
- ALL_TAC] THEN
- DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `IMAGE f {a..b} DIFF
- IMAGE (f:real^N->real^N) (\<Union>d)` THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
- ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN
- CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
- [ASM_MESON_TAC[MEASURABLE_DIFF; gmeasurable]; ALL_TAC] THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `measure(IMAGE f {a..b}) -
- measure(IMAGE (f:real^N->real^N) (\<Union>d))` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
- MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
- REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN
- MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN
- FIRST_ASSUM(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
- REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (1 + abs m)` THEN
- CONJ_TAC THENL
- [REWRITE_TAC[REAL_ARITH `a - x \<le> a - y \<longleftrightarrow> y \<le> x`] THEN
- REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
- REWRITE_TAC[GSYM real_div] THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
- GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
- ASM_REWRITE_TAC[] THEN
- FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
- `d \<le> a + e ==> a = i - s ==> s - e \<le> i - d`)) THEN
- MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
- ASM_REWRITE_TAC[MEASURABLE_INTERVAL];
- MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`;
- `e / (1 + abs m)`] GMEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `0 < 1 + abs x`] THEN
- DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
- EXISTS_TAC `IMAGE (f:real^N->real^N) (\<Union>d)` THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
- ASM_SIMP_TAC[IMAGE_SUBSET] THEN
- SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN
- EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (1 + abs m)` THEN
- CONJ_TAC THENL
- [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
- REWRITE_TAC[REAL_LE_LADD] THEN
- REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
- REWRITE_TAC[GSYM real_div] THEN
- ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
- GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]];
- ALL_TAC] THEN
- REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_GMEASURE_LIMIT] THEN
- X_GEN_TAC `e:real` THEN DISCH_TAC THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_GMEASURE_MEASURE]) THEN
- GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_LIMIT] THEN
- DISCH_THEN(MP_TAC o SPEC `e / (1 + abs m)`) THEN
- ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `0 < 1 + abs x`] THEN
- DISCH_THEN(X_CHOOSE_THEN `B:real`
- (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
- MP_TAC(ISPEC `ball(0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
- REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
- REMOVE_THEN "*" MP_TAC THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN
- DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
- DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
- MP_TAC(ISPECL [`interval[c:real^N,d]`; `0:real^N`]
- BOUNDED_SUBSET_BALL) THEN
- REWRITE_TAC[BOUNDED_INTERVAL] THEN
- DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN
- MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN
- ASM_REWRITE_TAC[] THEN
- DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
-
- EXISTS_TAC `D * C` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC
- `s \<inter> (IMAGE (h:real^N->real^N) {a..b})`) THEN
- SUBGOAL_THEN
- `IMAGE (f:real^N->real^N) (s \<inter> IMAGE h (interval [a,b])) =
- (IMAGE f s) \<inter> {a..b}`
- SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL
- [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
- ASM_SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_LINEAR_IMAGE_INTERVAL];
- ALL_TAC] THEN
- DISCH_TAC THEN EXISTS_TAC
- `m * measure(s \<inter> (IMAGE (h:real^N->real^N) {a..b}))` THEN
- ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (1 + abs m)` THEN
- CONJ_TAC THENL
- [ALL_TAC;
- REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
- ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
- GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN
- REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN
- GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN
- ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN
- FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
- `abs(z - m) < e ==> z \<le> w \<and> w \<le> m ==> abs(w - m) \<le> e`)) THEN
- SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE
- (ASSUME `s \<inter> interval [c:real^N,d] has_gmeasure z`))) THEN
- CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
- ASM_SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_LINEAR_IMAGE_INTERVAL;
- GMEASURABLE_INTERVAL; INTER_SUBSET] THEN
- MATCH_MP_TAC(SET_RULE
- `!v. t \<subseteq> v \<and> v \<subseteq> u ==> s \<inter> t \<subseteq> s \<inter> u`) THEN
- EXISTS_TAC `ball(0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC(SET_RULE
- `!f. (!x. h(f x) = x) \<and> IMAGE f s \<subseteq> t ==> s \<subseteq> IMAGE h t`) THEN
- EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN
- MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(0:real^N,D * C)` THEN
- ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN
- X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
- MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN
- ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
- ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Some inductions by expressing mapping in terms of elementary matrices. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma INDUCT_MATRIX_ROW_OPERATIONS: True .. (*
- "!P:real^N^N->bool.
- (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
- (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
- 1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
- ==> A$i$j = 0) ==> P A) \<and>
- (!A m n. P A \<and> 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i j. A$i$(swap(m,n) j))) \<and>
- (!A m n c. P A \<and> 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i. if i = m then row m A + c % row n A
- else row i A))
- ==> !A. P A"
-qed GEN_TAC THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN
- SUBGOAL_THEN
- `!k A:real^N^N.
- (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
- k \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
- ==> A$i$j = 0)
- ==> P A`
- (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN
- EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN
- MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
- [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN
- REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
- ASM_REWRITE_TAC[LE_0];
- ALL_TAC] THEN
- X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN
- DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 \<le> k`) THEN
- ASM_REWRITE_TAC[ARITH] THEN
- ASM_CASES_TAC `k \<le> dimindex(:N)` THENL
- [ALL_TAC;
- REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
- ASM_ARITH_TAC] THEN
- SUBGOAL_THEN
- `!A:real^N^N.
- ~(A$k$k = 0) \<and>
- (!i j. 1 \<le> i \<and> i \<le> dimindex (:N) \<and>
- SUC k \<le> j \<and> j \<le> dimindex (:N) \<and> ~(i = j)
- ==> A$i$j = 0)
- ==> P A`
- (LABEL_TAC "nonzero_hyp") THENL
- [ALL_TAC;
- X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN
- ASM_CASES_TAC `row k (A:real^N^N) = 0` THENL
- [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[];
- ALL_TAC] THEN
- FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
- SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN
- REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
- X_GEN_TAC `l:num` THEN STRIP_TAC THEN
- ASM_CASES_TAC `l:num = k` THENL
- [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[];
- ALL_TAC] THEN
- REMOVE_THEN "swap_cols" (MP_TAC o SPECL
- [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`;
- `k:num`; `l:num`]) THEN
- ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL
- [ALL_TAC;
- MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
- REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
- REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN
- REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN
- ONCE_REWRITE_TAC[ARITH_RULE `SUC k \<le> i \<longleftrightarrow> 1 \<le> i \<and> SUC k \<le> i`] THEN
- ASM_SIMP_TAC[LAMBDA_BETA] THEN
- ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
- STRIP_TAC THEN SUBGOAL_THEN `l:num \<le> k` ASSUME_TAC THENL
- [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
- ASM_REWRITE_TAC[] THEN ARITH_TAC;
- ALL_TAC] THEN
- REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
- FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
- ASM_ARITH_TAC] THEN
- SUBGOAL_THEN
- `!l A:real^N^N.
- ~(A$k$k = 0) \<and>
- (!i j. 1 \<le> i \<and> i \<le> dimindex (:N) \<and>
- SUC k \<le> j \<and> j \<le> dimindex (:N) \<and> ~(i = j)
- ==> A$i$j = 0) \<and>
- (!i. l \<le> i \<and> i \<le> dimindex(:N) \<and> ~(i = k) ==> A$i$k = 0)
- ==> P A`
- MP_TAC THENL
- [ALL_TAC;
- DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN
- REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 \<le> i \<and> i \<le> n)`]] THEN
- MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
- [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
- USE_THEN "ind_hyp" MATCH_MP_TAC THEN
- MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
- ASM_CASES_TAC `j:num = k` THENL
- [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
- REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
- ALL_TAC] THEN
- X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN
- GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
- DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
- ASM_CASES_TAC `l:num = k` THENL
- [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
- REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
- ALL_TAC] THEN
- DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 \<le> l`) THENL
- [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
- MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
- ASM_CASES_TAC `j:num = k` THENL
- [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
- REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
- ALL_TAC] THEN
- ASM_CASES_TAC `l \<le> dimindex(:N)` THENL
- [ALL_TAC;
- REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
- ASM_ARITH_TAC] THEN
- REMOVE_THEN "inner_hyp" (MP_TAC o SPECL
- [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A
- else row i A):real^N^N`]) THEN
- ANTS_TAC THENL
- [SUBGOAL_THEN `!i. l \<le> i ==> 1 \<le> i` ASSUME_TAC THENL
- [ASM_ARITH_TAC; ALL_TAC] THEN
- ONCE_REWRITE_TAC[ARITH_RULE `SUC k \<le> j \<longleftrightarrow> 1 \<le> j \<and> SUC k \<le> j`] THEN
- ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT;
- VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
- ASM_SIMP_TAC[REAL_FIELD `~(y = 0) ==> x + --(x / y) * y = 0`] THEN
- REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
- ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL
- [REPEAT STRIP_TAC THEN
- MATCH_MP_TAC(REAL_RING `x = 0 \<and> y = 0 ==> x + z * y = 0`) THEN
- CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
- REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC];
- ALL_TAC] THEN
- DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL
- [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A
- else row i (A:real^N^N)):real^N^N`;
- `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN
- ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
- VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN
- REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
- REAL_ARITH_TAC);; *)
-
-lemma INDUCT_MATRIX_ELEMENTARY: True .. (*
- "!P:real^N^N->bool.
- (!A B. P A \<and> P B ==> P(A ** B)) \<and>
- (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
- (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
- 1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
- ==> A$i$j = 0) ==> P A) \<and>
- (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) \<and>
- (!m n c. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i j. if i = m \<and> j = n then c
- else if i = j then 1 else 0))
- ==> !A. P A"
-qed GEN_TAC THEN
- DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
- DISCH_THEN(fun th ->
- MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN
- REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
- DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN
- REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
- UNDISCH_TAC `(P:real^N^N->bool) A` THENL
- [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
- DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN
- AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
- X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- X_GEN_TAC `j:num` THEN STRIP_TAC THEN
- ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL
- [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN
- ONCE_REWRITE_TAC[COND_RAND] THEN
- SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN
- COND_CASES_TAC THEN REWRITE_TAC[] THEN
- RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC;
- ALL_TAC] THEN
- ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL
- [ALL_TAC;
- ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
- REWRITE_TAC[REAL_MUL_LZERO] THEN
- GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
- ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN
- ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN
- MATCH_MP_TAC EQ_TRANS THEN
- EXISTS_TAC
- `sum {m,n} (\<lambda>k. (if k = n then c else if m = k then 1 else 0) *
- (A:real^N^N)$k$j)` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC SUM_SUPERSET THEN
- ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
- IN_NUMSEG; REAL_MUL_LZERO] THEN
- ASM_ARITH_TAC;
- ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
- REAL_ARITH_TAC]);; *)
-
-lemma INDUCT_MATRIX_ELEMENTARY_ALT: True .. (*
- "!P:real^N^N->bool.
- (!A B. P A \<and> P B ==> P(A ** B)) \<and>
- (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
- (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
- 1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
- ==> A$i$j = 0) ==> P A) \<and>
- (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) \<and>
- (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(lambda i j. if i = m \<and> j = n \/ i = j then 1 else 0))
- ==> !A. P A"
-qed GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN
- ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
- ASM_CASES_TAC `c = 0` THENL
- [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
- MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
- ASM_SIMP_TAC[LAMBDA_BETA; COND_ID];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `(lambda i j. if i = m \<and> j = n then c else if i = j then 1 else 0) =
- ((lambda i j. if i = j then if j = n then inv c else 1 else 0):real^N^N) **
- ((lambda i j. if i = m \<and> j = n \/ i = j then 1 else 0):real^N^N) **
- ((lambda i j. if i = j then if j = n then c else 1 else 0):real^N^N)`
- SUBST1_TAC THENL
- [ALL_TAC;
- REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A \<and> P B ==> P(A ** B)`) THEN
- CONJ_TAC) THEN
- ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
- MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
- ASM_SIMP_TAC[LAMBDA_BETA]] THEN
- SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN
- X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- X_GEN_TAC `j:num` THEN STRIP_TAC THEN
- ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH
- `(if p then 1 else 0) * (if q then c else 0) =
- if q then if p then c else 0 else 0`] THEN
- REWRITE_TAC[REAL_ARITH
- `(if p then x else 0) * y = (if p then x * y else 0)`] THEN
- GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
- ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
- ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
- ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN
- ASM_CASES_TAC `i:num = n` THEN
- ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* The same thing in mapping form (might have been easier all along). *)
-(* ------------------------------------------------------------------------- *)
-
-lemma INDUCT_LINEAR_ELEMENTARY: True .. (*
- "!P. (!f g. linear f \<and> linear g \<and> P f \<and> P g ==> P(f o g)) \<and>
- (!f i. linear f \<and> 1 \<le> i \<and> i \<le> dimindex(:N) \<and> (!x. (f x)$i = 0)
- ==> P f) \<and>
- (!c. P(\<lambda>x. lambda i. c i * x$i)) \<and>
- (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(\<lambda>x. lambda i. x$swap(m,n) i)) \<and>
- (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
- ==> P(\<lambda>x. lambda i. if i = m then x$m + x$n else x$i))
- ==> !f:real^N->real^N. linear f ==> P f"
-qed GEN_TAC THEN
- MP_TAC(ISPEC `\A:real^N^N. P(\<lambda>x:real^N. A ** x):bool`
- INDUCT_MATRIX_ELEMENTARY_ALT) THEN
- REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
- [ALL_TAC;
- DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN
- ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN
- MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
- [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN
- STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
- [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN
- ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN
- REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC];
- ALL_TAC] THEN
- MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
- [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN
- STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
- [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN
- ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
- DISCH_THEN MATCH_MP_TAC THEN
- UNDISCH_TAC `row m (A:real^N^N) = 0` THEN
- ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul;
- REAL_MUL_LZERO; SUM_0];
- ALL_TAC] THEN
- MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
- [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN
- MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN
- MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
- MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
- `sum(1..dimindex(:N)) (\<lambda>j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j
- else 0)` THEN
- CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN
- MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
- ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO];
- ALL_TAC] THEN
- MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN
- MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
- DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
- ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA;
- mat; IN_DIMINDEX_SWAP]
- THENL
- [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
- ONCE_REWRITE_TAC[COND_RATOR] THEN
- SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN
- REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
- COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
- MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
- ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
- ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
- GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
- ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN
- MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
- `sum {m,n} (\<lambda>j. if n = j \/ j = m then (x:real^N)$j else 0)` THEN
- CONJ_TAC THENL
- [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
- ASM_REWRITE_TAC[REAL_ADD_RID];
- CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
- ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
- IN_NUMSEG; REAL_MUL_LZERO] THEN
- ASM_ARITH_TAC]]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Hence the effect of an arbitrary linear map on a gmeasurable set. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma LAMBDA_SWAP_GALOIS: True .. (*
- "!x:real^N y:real^N.
- 1 \<le> m \<and> m \<le> dimindex(:N) \<and> 1 \<le> n \<and> n \<le> dimindex(:N)
- ==> (x = (lambda i. y$swap(m,n) i) \<longleftrightarrow>
- (lambda i. x$swap(m,n) i) = y)"
-qed SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN
- REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
- DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
- ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
- ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);; *)
-
-lemma LAMBDA_ADD_GALOIS: True .. (*
- "!x:real^N y:real^N.
- 1 \<le> m \<and> m \<le> dimindex(:N) \<and> 1 \<le> n \<and> n \<le> dimindex(:N) \<and>
- ~(m = n)
- ==> (x = (lambda i. if i = m then y$m + y$n else y$i) \<longleftrightarrow>
- (lambda i. if i = m then x$m - x$n else x$i) = y)"
-qed SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
- REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
- DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
- ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
- REAL_ARITH_TAC);; *)
-
-lemma HAS_GMEASURE_SHEAR_INTERVAL: True .. (*
- "!a b:real^N m n.
- 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
- 1 \<le> n \<and> n \<le> dimindex(:N) \<and>
- ~(m = n) \<and> ~({a..b} = {}) \<and>
- 0 \<le> a$n
- ==> (IMAGE (\<lambda>x. (lambda i. if i = m then x$m + x$n else x$i))
- {a..b}:real^N->bool)
- has_gmeasure gmeasure (interval [a,b])"
-qed lemma lemma = prove
- (`!s t u v:real^N->bool.
- gmeasurable s \<and> gmeasurable t \<and> gmeasurable u \<and>
- negligible(s \<inter> t) \<and> negligible(s \<inter> u) \<and>
- negligible(t \<inter> u) \<and>
- s \<union> t \<union> u = v
- ==> v has_gmeasure (measure s) + (measure t) + (measure u)"
-qed REPEAT STRIP_TAC THEN
- ASM_SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE; GMEASURABLE_UNION] THEN
- FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
- ASM_SIMP_TAC[MEASURE_UNION; GMEASURABLE_UNION] THEN
- ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION;
- GMEASURABLE_UNION; NEGLIGIBLE_INTER; GMEASURABLE_INTER] THEN
- REAL_ARITH_TAC)
- and lemma' = prove
- (`!s t u a.
- gmeasurable s \<and> gmeasurable t \<and>
- s \<union> (IMAGE (\<lambda>x. a + x) t) = u \<and>
- negligible(s \<inter> (IMAGE (\<lambda>x. a + x) t))
- ==> gmeasure s + gmeasure t = gmeasure u"
-qed REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
- ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; GMEASURABLE_TRANSLATION;
- MEASURE_TRANSLATION]) in
- REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
- SUBGOAL_THEN
- `linear((\<lambda>x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)`
- ASSUME_TAC THENL
- [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
- VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- MP_TAC(ISPECL
- [`IMAGE (\<lambda>x. lambda i. if i = m then x$m + x$n else x$i)
- (interval[a:real^N,b]):real^N->bool`;
- `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
- {x:real^N | (basis m - basis n) dot x \<le> a$m}`;
- `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
- {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
- `interval[a:real^N,
- (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`]
- lemma) THEN
- ANTS_TAC THENL
- [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
- CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
- CONVEX_INTER; GMEASURABLE_CONVEX; BOUNDED_INTER;
- BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
- REWRITE_TAC[INTER] THEN
- REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
- ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN
- ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
- DOT_BASIS; DOT_LSUB] THEN
- ONCE_REWRITE_TAC[MESON[]
- `(!i:num. P i) \<longleftrightarrow> P m \<and> (!i. ~(i = m) ==> P i)`] THEN
- ASM_SIMP_TAC[] THEN
- REWRITE_TAC[TAUT `(p \<and> x) \<and> (q \<and> x) \<and> r \<longleftrightarrow> x \<and> p \<and> q \<and> r`;
- TAUT `(p \<and> x) \<and> q \<and> (r \<and> x) \<longleftrightarrow> x \<and> p \<and> q \<and> r`;
- TAUT `((p \<and> x) \<and> q) \<and> (r \<and> x) \<and> s \<longleftrightarrow>
- x \<and> p \<and> q \<and> r \<and> s`;
- TAUT `(a \<and> x \/ (b \<and> x) \<and> c \/ (d \<and> x) \<and> e \<longleftrightarrow> f \<and> x) \<longleftrightarrow>
- x ==> (a \/ b \<and> c \/ d \<and> e \<longleftrightarrow> f)`] THEN
- ONCE_REWRITE_TAC[SET_RULE
- `{x | P x \<and> Q x} = {x | P x} \<inter> {x | Q x}`] THEN
- REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
- [ALL_TAC;
- GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN
- ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
- REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN
- MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL
- [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`;
- EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`;
- EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`]
- THEN (CONJ_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
- REWRITE_TAC[VECTOR_SUB_EQ] THEN
- ASM_MESON_TAC[BASIS_INJ];
- ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
- NOT_IN_EMPTY] THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN
- ASM_REAL_ARITH_TAC]);
- ALL_TAC] THEN
- ASM_SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE;
- GMEASURABLE_LINEAR_IMAGE_INTERVAL;
- GMEASURABLE_INTERVAL] THEN
- MP_TAC(ISPECL
- [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
- {x:real^N | (basis m - basis n) dot x \<le> a$m}`;
- `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
- {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
- `interval[a:real^N,
- (lambda i. if i = m then (a:real^N)$m + b$n
- else (b:real^N)$i)]`;
- `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m
- else 0):real^N`]
- lemma') THEN
- ANTS_TAC THENL
- [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
- CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
- CONVEX_INTER; GMEASURABLE_CONVEX; BOUNDED_INTER;
- BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
- REWRITE_TAC[INTER] THEN
- REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
- ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y \<longleftrightarrow>
- x - (lambda i. p i) = y`] THEN
- ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
- DOT_BASIS; DOT_LSUB; UNWIND_THM1;
- VECTOR_SUB_COMPONENT] THEN
- ONCE_REWRITE_TAC[MESON[]
- `(!i:num. P i) \<longleftrightarrow> P m \<and> (!i. ~(i = m) ==> P i)`] THEN
- ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL
- [X_GEN_TAC `x:real^N` THEN
- FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
- ASM_REWRITE_TAC[] THEN
- ASM_CASES_TAC
- `!i. ~(i = m)
- ==> 1 \<le> i \<and> i \<le> dimindex (:N)
- ==> (a:real^N)$i \<le> (x:real^N)$i \<and>
- x$i \<le> (b:real^N)$i` THEN
- ASM_REWRITE_TAC[] THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
- ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
- ONCE_REWRITE_TAC[TAUT `((a \<and> b) \<and> c) \<and> (d \<and> e) \<and> f \<longleftrightarrow>
- (b \<and> e) \<and> a \<and> c \<and> d \<and> f`] THEN
- ONCE_REWRITE_TAC[SET_RULE
- `{x | P x \<and> Q x} = {x | P x} \<inter> {x | Q x}`] THEN
- MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`
- THEN CONJ_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
- REWRITE_TAC[VECTOR_SUB_EQ] THEN
- ASM_MESON_TAC[BASIS_INJ];
- ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
- NOT_IN_EMPTY] THEN
- FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
- ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]];
- ALL_TAC] THEN
- DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH
- `a = b + c ==> a = x + b ==> x = c`) THEN
- ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES;
- LAMBDA_BETA] THEN
- REPEAT(COND_CASES_TAC THENL
- [ALL_TAC;
- FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
- MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
- X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
- FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
- ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN
- SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)`
- SUBST1_TAC THENL
- [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN
- ASM_ARITH_TAC;
- ALL_TAC] THEN
- SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN
- ASM_SIMP_TAC[IN_DELETE] THEN
- MATCH_MP_TAC(REAL_RING
- `s1 = s3 \<and> s2 = s3
- ==> ((bm + bn) - am) * s1 =
- ((am + bn) - am) * s2 + (bm - am) * s3`) THEN
- CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN
- SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);; *)
-
-lemma HAS_GMEASURE_LINEAR_IMAGE: True .. (*
- "!f:real^N->real^N s.
- linear f \<and> gmeasurable s
- ==> (IMAGE f s) has_gmeasure (abs(det(matrix f)) * gmeasure s)"
-qed REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
- MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL
- [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
- REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
- DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
- DISCH_THEN(CONJUNCTS_THEN2
- (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`)
- (MP_TAC o SPEC `s:real^N->bool`)) THEN
- ASM_REWRITE_TAC[] THEN
- GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_MEASURABLE_MEASURE] THEN
- STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN
- REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC];
-
- MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN
- SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)`
- ASSUME_TAC THENL
- [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
- EXISTS_TAC `basis m:real^N` THEN
- ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS];
- ALL_TAC] THEN
- MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN
- ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE;
- MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
- DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_GMEASURE_0] THEN
- ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE];
-
- MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN
- DISCH_TAC THEN
- FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_GMEASURE_MEASURE]) THEN
- FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o
- MATCH_MP HAS_GMEASURE_STRETCH) THEN
- MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
- AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
- SIMP_TAC[matrix; LAMBDA_BETA] THEN
- W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN
- SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN
- DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
- REWRITE_TAC[REAL_MUL_RID];
-
- MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
- MATCH_MP_TAC HAS_GMEASURE_LINEAR_SUFFICIENT THEN
- ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT;
- VECTOR_MUL_COMPONENT; CART_EQ] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
- SUBGOAL_THEN `matrix (\<lambda>x:real^N. lambda i. x$swap (m,n) i):real^N^N =
- transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)`
- SUBST1_TAC THENL
- [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP;
- matrix_vector_mul; CART_EQ; matrix; mat; basis;
- COND_COMPONENT; transp] THEN
- REWRITE_TAC[EQ_SYM_EQ];
- ALL_TAC] THEN
- REWRITE_TAC[DET_TRANSP] THEN
- W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o
- rand o lhand o rand o snd) THEN
- ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN
- DISCH_THEN(K ALL_TAC) THEN
- REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN
- ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
- [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_GMEASURE_EMPTY; MEASURE_EMPTY];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `~(IMAGE (\<lambda>x:real^N. lambda i. x$swap (m,n) i)
- {a..b}:real^N->bool = {})`
- MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
- SUBGOAL_THEN
- `IMAGE (\<lambda>x:real^N. lambda i. x$swap (m,n) i)
- {a..b}:real^N->bool =
- interval[(lambda i. a$swap (m,n) i),
- (lambda i. b$swap (m,n) i)]`
- SUBST1_TAC THENL
- [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN
- ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN
- SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN
- DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
- ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
- ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT];
- ALL_TAC] THEN
- REWRITE_TAC[HAS_GMEASURE_MEASURABLE_MEASURE; GMEASURABLE_INTERVAL] THEN
- REWRITE_TAC[MEASURE_INTERVAL] THEN
- ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN
- DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN
- ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN
- MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`]
- (GSYM PRODUCT_PERMUTE)) THEN
- REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
- ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG];
-
- MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
- MATCH_MP_TAC HAS_GMEASURE_LINEAR_SUFFICIENT THEN
- MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
- [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
- VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
- DISCH_TAC] THEN
- MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
- SUBGOAL_THEN
- `det(matrix(\<lambda>x. lambda i. if i = m then (x:real^N)$m + x$n
- else x$i):real^N^N) = 1`
- SUBST1_TAC THENL
- [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN
- FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
- `~(m:num = n) ==> m < n \/ n < m`))
- THENL
- [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd);
- W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)]
- THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
- matrix; REAL_ADD_RID; COND_ID;
- PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN
- DISCH_THEN MATCH_MP_TAC THEN
- REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
- ASM_ARITH_TAC;
- ALL_TAC] THEN
- REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN
- ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
- [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_GMEASURE_EMPTY; MEASURE_EMPTY];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `IMAGE (\<lambda>x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) =
- IMAGE (\<lambda>x:real^N. (lambda i. if i = m \/ i = n then a$n else 0) +
- x)
- (IMAGE (\<lambda>x:real^N. lambda i. if i = m then x$m + x$n else x$i)
- (IMAGE (\<lambda>x. (lambda i. if i = n then --(a$n) else 0) + x)
- {a..b}))`
- SUBST1_TAC THENL
- [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
- ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
- CART_EQ] THEN
- MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN
- STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
- ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
- ALL_TAC] THEN
- MATCH_MP_TAC HAS_GMEASURE_TRANSLATION THEN
- SUBGOAL_THEN
- `measure{a..b} =
- measure(IMAGE (\<lambda>x:real^N. (lambda i. if i = n then --(a$n) else 0) + x)
- {a..b}:real^N->bool)`
- SUBST1_TAC THENL
- [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_TRANSLATION THEN
- REWRITE_TAC[MEASURABLE_INTERVAL];
- ALL_TAC] THEN
- SUBGOAL_THEN
- `~(IMAGE (\<lambda>x:real^N. (lambda i. if i = n then --(a$n) else 0) + x)
- {a..b}:real^N->bool = {})`
- MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
- ONCE_REWRITE_TAC[VECTOR_ARITH `c + x = 1 % x + c`] THEN
- ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN
- DISCH_TAC THEN MATCH_MP_TAC HAS_GMEASURE_SHEAR_INTERVAL THEN
- ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
- REAL_ARITH_TAC]);; *)
-
-lemma GMEASURABLE_LINEAR_IMAGE: True .. (*
- "!f:real^N->real^N s.
- linear f \<and> gmeasurable s ==> gmeasurable(IMAGE f s)"
-qed REPEAT GEN_TAC THEN
- DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE) THEN
- SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
-
-lemma MEASURE_LINEAR_IMAGE: True .. (*
- "!f:real^N->real^N s.
- linear f \<and> gmeasurable s
- ==> measure(IMAGE f s) = abs(det(matrix f)) * gmeasure s"
-qed REPEAT GEN_TAC THEN
- DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE) THEN
- SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
-
-lemma HAS_GMEASURE_LINEAR_IMAGE_SAME: True .. (*
- "!f s. linear f \<and> gmeasurable s \<and> abs(det(matrix f)) = 1
- ==> (IMAGE f s) has_gmeasure (measure s)"
-qed MESON_TAC[HAS_GMEASURE_LINEAR_IMAGE; REAL_MUL_LID]);; *)
-
-lemma MEASURE_LINEAR_IMAGE_SAME: True .. (*
- "!f:real^N->real^N s.
- linear f \<and> gmeasurable s \<and> abs(det(matrix f)) = 1
- ==> measure(IMAGE f s) = gmeasure s"
-qed REPEAT GEN_TAC THEN
- DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE_SAME) THEN
- SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* gmeasure of a standard simplex. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma CONGRUENT_IMAGE_STD_SIMPLEX: True .. (*
- "!p. p permutes 1..dimindex(:N)
- ==> {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
- (!i. 1 \<le> i \<and> i < dimindex(:N)
- ==> x$(p i) \<le> x$(p(i + 1)))} =
- IMAGE (\<lambda>x:real^N. lambda i. sum(1..inverse p(i)) (\<lambda>j. x$j))
- {x | (!i. 1 \<le> i \<and> i \<le> dimindex (:N) ==> 0 \<le> x$i) \<and>
- sum (1..dimindex (:N)) (\<lambda>i. x$i) \<le> 1}"
-qed REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
- [ALL_TAC;
- REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
- ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
- ARITH_RULE `i < n ==> i \<le> n \<and> i + 1 \<le> n`;
- ARITH_RULE `1 \<le> n + 1`; DIMINDEX_GE_1] THEN
- STRIP_TAC THEN
- FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
- ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN
- REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 \<le> SUC n`] THEN
- ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN
- FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN
- REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
- STRIP_TAC THEN
- EXISTS_TAC `(lambda i. if i = 1 then x$(p 1)
- else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN
- ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
- ARITH_RULE `i < n ==> i \<le> n \<and> i + 1 \<le> n`;
- ARITH_RULE `1 \<le> n + 1`; DIMINDEX_GE_1; CART_EQ] THEN
- REPEAT CONJ_TAC THENL
- [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- SUBGOAL_THEN `1 \<le> inverse (p:num->num) i \<and>
- !x. x \<le> inverse p i ==> x \<le> dimindex(:N)`
- ASSUME_TAC THENL
- [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
- ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN
- SIMP_TAC[ARITH_RULE `2 \<le> n ==> ~(n = 1)`] THEN
- GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV)
- [GSYM REAL_MUL_LID] THEN
- ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
- REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
- REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
- FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
- `1 \<le> p ==> p = 1 \/ 2 \<le> p`) o CONJUNCT1) THEN
- ASM_SIMP_TAC[ARITH] THEN
- FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
- REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN
- ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE];
-
- X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN
- ASM_REWRITE_TAC[REAL_SUB_LE] THEN
- FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
- ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
-
- SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH;
- ARITH_RULE `2 \<le> n ==> ~(n = 1)`] THEN
- GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV)
- [GSYM REAL_MUL_LID] THEN
- ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
- REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
- REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
- COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN
- ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN
- ASM_MESON_TAC[DIMINDEX_GE_1;
- ARITH_RULE `1 \<le> n \<and> ~(2 \<le> n) ==> n = 1`]]);; *)
-
-lemma HAS_GMEASURE_IMAGE_STD_SIMPLEX: True .. (*
- "!p. p permutes 1..dimindex(:N)
- ==> {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
- (!i. 1 \<le> i \<and> i < dimindex(:N)
- ==> x$(p i) \<le> x$(p(i + 1)))}
- has_gmeasure
- (measure (convex hull
- (0 INSERT {basis i:real^N | 1 \<le> i \<and> i \<le> dimindex(:N)})))"
-qed REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN
- ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN
- MATCH_MP_TAC HAS_GMEASURE_LINEAR_IMAGE_SAME THEN
- REPEAT CONJ_TAC THENL
- [REWRITE_TAC[linear; CART_EQ] THEN
- ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
- GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN
- REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
- REPEAT STRIP_TAC THEN REWRITE_TAC[] THENL
- [MATCH_MP_TAC VECTOR_ADD_COMPONENT;
- MATCH_MP_TAC VECTOR_MUL_COMPONENT] THEN
- ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
- MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
- MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
- REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
- MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
- `abs(det
- ((lambda i. ((lambda i j. if j \<le> i then 1 else 0):real^N^N)
- $inverse p i)
- :real^N^N))` THEN
- CONJ_TAC THENL
- [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
- ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
- LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN
- X_GEN_TAC `i:num` THEN STRIP_TAC THEN
- X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
- EXISTS_TAC `sum (1..inverse (p:num->num) i)
- (\<lambda>k. if k = j then 1 else 0)` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC SUM_EQ THEN
- ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN
- REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN
- ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS;
- PERMUTES_INVERSE];
- ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]];
- ALL_TAC] THEN
- ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN
- REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN
- MATCH_MP_TAC(REAL_ARITH `x = 1 ==> abs x = 1`) THEN
- ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN
- REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);; *)
-
-lemma HAS_GMEASURE_STD_SIMPLEX: True .. (*
- "(convex hull (0:real^N INSERT {basis i | 1 \<le> i \<and> i \<le> dimindex(:N)}))
- has_gmeasure inv((FACT(dimindex(:N))))"
-qed lemma lemma = prove
- (`!f:num->real. (!i. 1 \<le> i \<and> i < n ==> f i \<le> f(i + 1)) \<longleftrightarrow>
- (!i j. 1 \<le> i \<and> i \<le> j \<and> j \<le> n ==> f i \<le> f j)"
-qed GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
- [GEN_TAC THEN INDUCT_TAC THEN
- SIMP_TAC[LE; REAL_LE_REFL] THEN
- STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
- MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN
- ASM_SIMP_TAC[ARITH_RULE `SUC x \<le> y ==> x \<le> y`] THEN
- REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
- REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in
- MP_TAC(ISPECL
- [`\p. {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
- (!i. 1 \<le> i \<and> i < dimindex(:N)
- ==> x$(p i) \<le> x$(p(i + 1)))}`;
- `{p | p permutes 1..dimindex(:N)}`]
- HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
- ASM_SIMP_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
- HAS_GMEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN
- ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG;
- CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN
- ANTS_TAC THENL
- [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN
- SUBGOAL_THEN `?i. i \<in> 1..dimindex(:N) \<and> ~(p i:num = q i)` MP_TAC THENL
- [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN
- GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
- REWRITE_TAC[TAUT `a ==> ~(b \<and> ~c) \<longleftrightarrow> a \<and> b ==> c`] THEN
- REWRITE_TAC[IN_NUMSEG] THEN
- DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
- MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
- EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = 0}` THEN
- CONJ_TAC THENL
- [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
- MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG];
- ALL_TAC] THEN
- REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN
- ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN
- SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL
- [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
- SUBGOAL_THEN `1 \<le> l \<and> l \<le> dimindex(:N)` STRIP_ASSUME_TAC THENL
- [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
- SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL
- [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
- ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
- ALL_TAC] THEN
- SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL
- [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
- SUBGOAL_THEN `1 \<le> m \<and> m \<le> dimindex(:N)` STRIP_ASSUME_TAC THENL
- [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
- SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL
- [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
- ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
- ALL_TAC] THEN
- X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
- FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN
- ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN
- MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
- ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS];
- ALL_TAC] THEN
- REWRITE_TAC[HAS_GMEASURE_MEASURABLE_MEASURE] THEN
- DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL
- [MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
- MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
- REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
- ALL_TAC] THEN
- ASM_SIMP_TAC[REAL_FIELD `~(y = 0) ==> (x = inv y \<longleftrightarrow> y * x = 1)`;
- REAL_OF_NUM_EQ; FACT_NZ] THEN
- FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN
- EXISTS_TAC `measure(interval[0:real^N,1])` THEN CONJ_TAC THENL
- [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN
- REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
- [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
- RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN
- SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
- X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN
- STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN
- MATCH_MP_TAC REAL_LE_TRANS THENL
- [EXISTS_TAC `(x:real^N)$(p 1)`;
- EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN
- ASM_REWRITE_TAC[] THEN
- FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN
- ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG];
- ALL_TAC] THEN
- REWRITE_TAC[SET_RULE `s \<subseteq> UNIONS(IMAGE f t) \<longleftrightarrow>
- !x. x \<in> s ==> ?y. y \<in> t \<and> x \<in> f y`] THEN
- X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN
- SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
- MP_TAC(ISPEC `\i j. ~((x:real^N)$j \<le> x$i)` TOPOLOGICAL_SORT) THEN
- REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN
- ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
- DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN
- REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN
- DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2
- (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN
- EXISTS_TAC `\i. if i \<in> 1..dimindex(:N) then f(i) else i` THEN
- REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE
- `1 \<le> i \<and> i \<le> j \<and> j \<le> n \<longleftrightarrow>
- 1 \<le> i \<and> 1 \<le> j \<and> i \<le> n \<and> j \<le> n \<and> i \<le> j`] THEN
- ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN
- CONJ_TAC THENL
- [ALL_TAC;
- ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN
- SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN
- SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Hence the gmeasure of a general simplex. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma HAS_GMEASURE_SIMPLEX_0: True .. (*
- "!l:(real^N)list.
- LENGTH l = dimindex(:N)
- ==> (convex hull (0 INSERT set_of_list l)) has_gmeasure
- abs(det(vector l)) / (FACT(dimindex(:N)))"
-qed REPEAT STRIP_TAC THEN
- SUBGOAL_THEN
- `0 INSERT (set_of_list l) =
- IMAGE (\<lambda>x:real^N. transp(vector l:real^N^N) ** x)
- (0 INSERT {basis i:real^N | 1 \<le> i \<and> i \<le> dimindex(:N)})`
- SUBST1_TAC THENL
- [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
- REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN
- REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN
- SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN
- ONCE_REWRITE_TAC[COND_RAND] THEN
- SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN
- REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
- ONCE_REWRITE_TAC[TAUT `a \<and> b \<and> c \<longleftrightarrow> ~(b \<and> c ==> ~a)`] THEN
- X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN
- SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
- REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN
- ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
- EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL
- [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN
- ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC;
- ALL_TAC] THEN
- ASM_SIMP_TAC[GSYM CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
- SUBGOAL_THEN
- `det(vector l:real^N^N) = det(matrix(\<lambda>x:real^N. transp(vector l) ** x))`
- SUBST1_TAC THENL
- [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN
- REWRITE_TAC[real_div] THEN
- ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
- HAS_GMEASURE_STD_SIMPLEX)] THEN
- MATCH_MP_TAC HAS_GMEASURE_LINEAR_IMAGE THEN
- REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
- MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
- ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
- MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
- REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);; *)
-
-lemma HAS_GMEASURE_SIMPLEX: True .. (*
- "!a l:(real^N)list.
- LENGTH l = dimindex(:N)
- ==> (convex hull (set_of_list(CONS a l))) has_gmeasure
- abs(det(vector(MAP (\<lambda>x. x - a) l))) / (FACT(dimindex(:N)))"
-qed REPEAT STRIP_TAC THEN
- MP_TAC(ISPEC `MAP (\<lambda>x:real^N. x - a) l` HAS_GMEASURE_SIMPLEX_0) THEN
- ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN
- DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_GMEASURE_TRANSLATION) THEN
- REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN
- MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
- REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN
- REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`;
- SET_RULE `IMAGE (\<lambda>x. x) s = s`]);; *)
-
-lemma GMEASURABLE_SIMPLEX: True .. (*
- "!l. gmeasurable(convex hull (set_of_list l))"
-qed GEN_TAC THEN
- MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN
- MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);; *)
-
-lemma MEASURE_SIMPLEX: True .. (*
- "!a l:(real^N)list.
- LENGTH l = dimindex(:N)
- ==> measure(convex hull (set_of_list(CONS a l))) =
- abs(det(vector(MAP (\<lambda>x. x - a) l))) / (FACT(dimindex(:N)))"
-qed MESON_TAC[HAS_GMEASURE_SIMPLEX; HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Area of a triangle. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma HAS_GMEASURE_TRIANGLE: True .. (*
- "!a b c:real^2.
- convex hull {a,b,c} has_gmeasure
- abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / 2"
-qed REPEAT STRIP_TAC THEN
- MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_GMEASURE_SIMPLEX) THEN
- REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN
- CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN
- SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);; *)
-
-lemma GMEASURABLE_TRIANGLE: True .. (*
- "!a b c:real^N. gmeasurable(convex hull {a,b,c})"
-qed REPEAT GEN_TAC THEN
- MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
- REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; *)
-
-lemma MEASURE_TRIANGLE: True .. (*
- "!a b c:real^2.
- measure(convex hull {a,b,c}) =
- abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / 2"
-qed REWRITE_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
- HAS_GMEASURE_TRIANGLE]);; *)
-
-(* ------------------------------------------------------------------------- *)
-(* Volume of a tetrahedron. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma HAS_GMEASURE_TETRAHEDRON: True .. (*
- "!a b c d:real^3.
- convex hull {a,b,c,d} has_gmeasure
- abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
- (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
- (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
- (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
- (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
- (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) /
- 6"
-qed REPEAT STRIP_TAC THEN
- MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_GMEASURE_SIMPLEX) THEN
- REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN
- CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN
- SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);; *)
-
-lemma GMEASURABLE_TETRAHEDRON: True .. (*
- "!a b c d:real^N. gmeasurable(convex hull {a,b,c,d})"
-qed REPEAT GEN_TAC THEN
- MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
- MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
- REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; *)
-
-lemma MEASURE_TETRAHEDRON: True .. (*
- "!a b c d:real^3.
- measure(convex hull {a,b,c,d}) =
- abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
- (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
- (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
- (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
- (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
- (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / 6"
-qed REWRITE_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
- HAS_GMEASURE_TETRAHEDRON]);; *)
-
-end
--- a/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Mon Jan 31 11:18:29 2011 +0100
@@ -1,5 +1,5 @@
theory Multivariate_Analysis
-imports Fashoda Gauge_Measure
+imports Fashoda
begin
end
--- a/src/HOL/Probability/Information.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Information.thy Mon Jan 31 11:18:29 2011 +0100
@@ -180,30 +180,6 @@
by (simp add: cong \<nu>.integral_cong_measure[OF cong(2)])
qed
-lemma (in sigma_finite_measure) KL_divergence_vimage:
- assumes f: "bij_betw f S (space M)"
- assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
- shows "KL_divergence b (vimage_algebra S f) (\<lambda>A. \<nu> (f ` A)) (\<lambda>A. \<mu> (f ` A)) = KL_divergence b M \<nu> \<mu>"
- (is "KL_divergence b ?M ?\<nu> ?\<mu> = _")
-proof -
- interpret \<nu>: measure_space M \<nu> by fact
- interpret v: measure_space ?M ?\<nu>
- using f by (rule \<nu>.measure_space_isomorphic)
-
- let ?RN = "sigma_finite_measure.RN_deriv ?M ?\<mu> ?\<nu>"
- from RN_deriv_vimage[OF f[THEN bij_inv_the_inv_into] \<nu>]
- have *: "\<nu>.almost_everywhere (\<lambda>x. ?RN (the_inv_into S f x) = RN_deriv \<nu> x)"
- by (rule absolutely_continuous_AE[OF \<nu>])
-
- show ?thesis
- unfolding KL_divergence_def \<nu>.integral_vimage_inv[OF f]
- apply (rule \<nu>.integral_cong_AE)
- apply (rule \<nu>.AE_mp[OF *])
- apply (rule \<nu>.AE_cong)
- apply simp
- done
-qed
-
lemma (in finite_measure_space) KL_divergence_eq_finite:
assumes v: "finite_measure_space M \<nu>"
assumes ac: "absolutely_continuous \<nu>"
@@ -259,50 +235,6 @@
\<lparr> space = X`space M, sets = Pow (X`space M) \<rparr>
\<lparr> space = Y`space M, sets = Pow (Y`space M) \<rparr> X Y"
-lemma (in information_space) mutual_information_commute_generic:
- assumes X: "random_variable S X" and Y: "random_variable T Y"
- assumes ac: "measure_space.absolutely_continuous (sigma (pair_algebra S T))
- (pair_sigma_finite.pair_measure S (distribution X) T (distribution Y)) (joint_distribution X Y)"
- shows "mutual_information b S T X Y = mutual_information b T S Y X"
-proof -
- interpret P: prob_space "sigma (pair_algebra S T)" "joint_distribution X Y"
- using random_variable_pairI[OF X Y] by (rule distribution_prob_space)
- interpret Q: prob_space "sigma (pair_algebra T S)" "joint_distribution Y X"
- using random_variable_pairI[OF Y X] by (rule distribution_prob_space)
- interpret X: prob_space S "distribution X" using X by (rule distribution_prob_space)
- interpret Y: prob_space T "distribution Y" using Y by (rule distribution_prob_space)
- interpret ST: pair_sigma_finite S "distribution X" T "distribution Y" by default
- interpret TS: pair_sigma_finite T "distribution Y" S "distribution X" by default
-
- have ST: "measure_space (sigma (pair_algebra S T)) (joint_distribution X Y)" by default
- have TS: "measure_space (sigma (pair_algebra T S)) (joint_distribution Y X)" by default
-
- have bij_ST: "bij_betw (\<lambda>(x, y). (y, x)) (space (sigma (pair_algebra S T))) (space (sigma (pair_algebra T S)))"
- by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
- have bij_TS: "bij_betw (\<lambda>(x, y). (y, x)) (space (sigma (pair_algebra T S))) (space (sigma (pair_algebra S T)))"
- by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
-
- { fix A
- have "joint_distribution X Y ((\<lambda>(x, y). (y, x)) ` A) = joint_distribution Y X A"
- unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>]) }
- note jd_commute = this
-
- { fix A assume A: "A \<in> sets (sigma (pair_algebra T S))"
- have *: "\<And>x y. indicator ((\<lambda>(x, y). (y, x)) ` A) (x, y) = (indicator A (y, x) :: pextreal)"
- unfolding indicator_def by auto
- have "ST.pair_measure ((\<lambda>(x, y). (y, x)) ` A) = TS.pair_measure A"
- unfolding ST.pair_measure_def TS.pair_measure_def
- using A by (auto simp add: TS.Fubini[symmetric] *) }
- note pair_measure_commute = this
-
- show ?thesis
- unfolding mutual_information_def
- unfolding ST.KL_divergence_vimage[OF bij_TS ST ac, symmetric]
- unfolding space_sigma space_pair_algebra jd_commute
- unfolding ST.pair_sigma_algebra_swap[symmetric]
- by (simp cong: TS.KL_divergence_cong[OF TS] add: pair_measure_commute)
-qed
-
lemma (in prob_space) finite_variables_absolutely_continuous:
assumes X: "finite_random_variable S X" and Y: "finite_random_variable T Y"
shows "measure_space.absolutely_continuous (sigma (pair_algebra S T))
@@ -330,16 +262,6 @@
qed
qed
-lemma (in information_space) mutual_information_commute:
- assumes X: "finite_random_variable S X" and Y: "finite_random_variable T Y"
- shows "mutual_information b S T X Y = mutual_information b T S Y X"
- by (intro finite_random_variableD X Y mutual_information_commute_generic finite_variables_absolutely_continuous)
-
-lemma (in information_space) mutual_information_commute_simple:
- assumes X: "simple_function X" and Y: "simple_function Y"
- shows "\<I>(X;Y) = \<I>(Y;X)"
- by (intro X Y simple_function_imp_finite_random_variable mutual_information_commute)
-
lemma (in information_space)
assumes MX: "finite_random_variable MX X"
assumes MY: "finite_random_variable MY Y"
@@ -371,6 +293,18 @@
unfolding mutual_information_def .
qed
+lemma (in information_space) mutual_information_commute:
+ assumes X: "finite_random_variable S X" and Y: "finite_random_variable T Y"
+ shows "mutual_information b S T X Y = mutual_information b T S Y X"
+ unfolding mutual_information_generic_eq[OF X Y] mutual_information_generic_eq[OF Y X]
+ unfolding joint_distribution_commute_singleton[of X Y]
+ by (auto simp add: ac_simps intro!: setsum_reindex_cong[OF swap_inj_on])
+
+lemma (in information_space) mutual_information_commute_simple:
+ assumes X: "simple_function X" and Y: "simple_function Y"
+ shows "\<I>(X;Y) = \<I>(Y;X)"
+ by (intro X Y simple_function_imp_finite_random_variable mutual_information_commute)
+
lemma (in information_space) mutual_information_eq:
assumes "simple_function X" "simple_function Y"
shows "\<I>(X;Y) = (\<Sum> (x,y) \<in> X ` space M \<times> Y ` space M.
--- a/src/HOL/Probability/Lebesgue_Integration.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Lebesgue_Integration.thy Mon Jan 31 11:18:29 2011 +0100
@@ -471,20 +471,26 @@
unfolding sigma_algebra.simple_function_def[OF N_subalgebra(3)]
by auto
-lemma (in sigma_algebra) simple_function_vimage:
- fixes g :: "'a \<Rightarrow> pextreal" and f :: "'d \<Rightarrow> 'a"
- assumes g: "simple_function g" and f: "f \<in> S \<rightarrow> space M"
- shows "sigma_algebra.simple_function (vimage_algebra S f) (\<lambda>x. g (f x))"
-proof -
- have subset: "(\<lambda>x. g (f x)) ` S \<subseteq> g ` space M"
- using f by auto
- interpret V: sigma_algebra "vimage_algebra S f"
- using f by (rule sigma_algebra_vimage)
- show ?thesis using g
- unfolding simple_function_eq_borel_measurable
- unfolding V.simple_function_eq_borel_measurable
- using measurable_vimage[OF _ f, of g borel]
- using finite_subset[OF subset] by auto
+lemma (in measure_space) simple_function_vimage:
+ assumes T: "sigma_algebra M'" "T \<in> measurable M M'"
+ and f: "sigma_algebra.simple_function M' f"
+ shows "simple_function (\<lambda>x. f (T x))"
+proof (intro simple_function_def[THEN iffD2] conjI ballI)
+ interpret T: sigma_algebra M' by fact
+ have "(\<lambda>x. f (T x)) ` space M \<subseteq> f ` space M'"
+ using T unfolding measurable_def by auto
+ then show "finite ((\<lambda>x. f (T x)) ` space M)"
+ using f unfolding T.simple_function_def by (auto intro: finite_subset)
+ fix i assume i: "i \<in> (\<lambda>x. f (T x)) ` space M"
+ then have "i \<in> f ` space M'"
+ using T unfolding measurable_def by auto
+ then have "f -` {i} \<inter> space M' \<in> sets M'"
+ using f unfolding T.simple_function_def by auto
+ then have "T -` (f -` {i} \<inter> space M') \<inter> space M \<in> sets M"
+ using T unfolding measurable_def by auto
+ also have "T -` (f -` {i} \<inter> space M') \<inter> space M = (\<lambda>x. f (T x)) -` {i} \<inter> space M"
+ using T unfolding measurable_def by auto
+ finally show "(\<lambda>x. f (T x)) -` {i} \<inter> space M \<in> sets M" .
qed
section "Simple integral"
@@ -816,28 +822,30 @@
unfolding measure_space.simple_integral_def_raw[OF N] by simp
lemma (in measure_space) simple_integral_vimage:
- fixes g :: "'a \<Rightarrow> pextreal" and f :: "'d \<Rightarrow> 'a"
- assumes f: "bij_betw f S (space M)"
- shows "simple_integral g =
- measure_space.simple_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g (f x))"
- (is "_ = measure_space.simple_integral ?T ?\<mu> _")
+ assumes T: "sigma_algebra M'" "T \<in> measurable M M'"
+ and f: "sigma_algebra.simple_function M' f"
+ shows "measure_space.simple_integral M' (\<lambda>A. \<mu> (T -` A \<inter> space M)) f = (\<integral>\<^isup>S x. f (T x))"
+ (is "measure_space.simple_integral M' ?nu f = _")
proof -
- from f interpret T: measure_space ?T ?\<mu> by (rule measure_space_isomorphic)
- have surj: "f`S = space M"
- using f unfolding bij_betw_def by simp
- have *: "(\<lambda>x. g (f x)) ` S = g ` f ` S" by auto
- have **: "f`S = space M" using f unfolding bij_betw_def by auto
- { fix x assume "x \<in> space M"
- have "(f ` ((\<lambda>x. g (f x)) -` {g x} \<inter> S)) =
- (f ` (f -` (g -` {g x}) \<inter> S))" by auto
- also have "f -` (g -` {g x}) \<inter> S = f -` (g -` {g x} \<inter> space M) \<inter> S"
- using f unfolding bij_betw_def by auto
- also have "(f ` (f -` (g -` {g x} \<inter> space M) \<inter> S)) = g -` {g x} \<inter> space M"
- using ** by (intro image_vimage_inter_eq) auto
- finally have "(f ` ((\<lambda>x. g (f x)) -` {g x} \<inter> S)) = g -` {g x} \<inter> space M" by auto }
- then show ?thesis using assms
- unfolding simple_integral_def T.simple_integral_def bij_betw_def
- by (auto simp add: * intro!: setsum_cong)
+ interpret T: measure_space M' ?nu using T by (rule measure_space_vimage) auto
+ show "T.simple_integral f = (\<integral>\<^isup>S x. f (T x))"
+ unfolding simple_integral_def T.simple_integral_def
+ proof (intro setsum_mono_zero_cong_right ballI)
+ show "(\<lambda>x. f (T x)) ` space M \<subseteq> f ` space M'"
+ using T unfolding measurable_def by auto
+ show "finite (f ` space M')"
+ using f unfolding T.simple_function_def by auto
+ next
+ fix i assume "i \<in> f ` space M' - (\<lambda>x. f (T x)) ` space M"
+ then have "T -` (f -` {i} \<inter> space M') \<inter> space M = {}" by (auto simp: image_iff)
+ then show "i * \<mu> (T -` (f -` {i} \<inter> space M') \<inter> space M) = 0" by simp
+ next
+ fix i assume "i \<in> (\<lambda>x. f (T x)) ` space M"
+ then have "T -` (f -` {i} \<inter> space M') \<inter> space M = (\<lambda>x. f (T x)) -` {i} \<inter> space M"
+ using T unfolding measurable_def by auto
+ then show "i * \<mu> (T -` (f -` {i} \<inter> space M') \<inter> space M) = i * \<mu> ((\<lambda>x. f (T x)) -` {i} \<inter> space M)"
+ by auto
+ qed
qed
section "Continuous posititve integration"
@@ -1016,71 +1024,6 @@
shows "f ` A = g ` B"
using assms by blast
-lemma (in measure_space) positive_integral_vimage:
- fixes g :: "'a \<Rightarrow> pextreal" and f :: "'d \<Rightarrow> 'a"
- assumes f: "bij_betw f S (space M)"
- shows "positive_integral g =
- measure_space.positive_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g (f x))"
- (is "_ = measure_space.positive_integral ?T ?\<mu> _")
-proof -
- from f interpret T: measure_space ?T ?\<mu> by (rule measure_space_isomorphic)
- have f_fun: "f \<in> S \<rightarrow> space M" using assms unfolding bij_betw_def by auto
- from assms have inv: "bij_betw (the_inv_into S f) (space M) S"
- by (rule bij_betw_the_inv_into)
- then have inv_fun: "the_inv_into S f \<in> space M \<rightarrow> S" unfolding bij_betw_def by auto
- have surj: "f`S = space M"
- using f unfolding bij_betw_def by simp
- have inj: "inj_on f S"
- using f unfolding bij_betw_def by simp
- have inv_f: "\<And>x. x \<in> space M \<Longrightarrow> f (the_inv_into S f x) = x"
- using f_the_inv_into_f[of f S] f unfolding bij_betw_def by auto
- from simple_integral_vimage[OF assms, symmetric]
- have *: "simple_integral = T.simple_integral \<circ> (\<lambda>g. g \<circ> f)" by (simp add: comp_def)
- show ?thesis
- unfolding positive_integral_alt1 T.positive_integral_alt1 SUPR_def * image_compose
- proof (safe intro!: arg_cong[where f=Sup] image_set_cong, simp_all add: comp_def)
- fix g' :: "'a \<Rightarrow> pextreal" assume "simple_function g'" "\<forall>x\<in>space M. g' x \<le> g x \<and> g' x \<noteq> \<omega>"
- then show "\<exists>h. T.simple_function h \<and> (\<forall>x\<in>S. h x \<le> g (f x) \<and> h x \<noteq> \<omega>) \<and>
- T.simple_integral (\<lambda>x. g' (f x)) = T.simple_integral h"
- using f unfolding bij_betw_def
- by (auto intro!: exI[of _ "\<lambda>x. g' (f x)"]
- simp add: le_fun_def simple_function_vimage[OF _ f_fun])
- next
- fix g' :: "'d \<Rightarrow> pextreal" assume g': "T.simple_function g'" "\<forall>x\<in>S. g' x \<le> g (f x) \<and> g' x \<noteq> \<omega>"
- let ?g = "\<lambda>x. g' (the_inv_into S f x)"
- show "\<exists>h. simple_function h \<and> (\<forall>x\<in>space M. h x \<le> g x \<and> h x \<noteq> \<omega>) \<and>
- T.simple_integral g' = T.simple_integral (\<lambda>x. h (f x))"
- proof (intro exI[of _ ?g] conjI ballI)
- { fix x assume x: "x \<in> space M"
- then have "the_inv_into S f x \<in> S" using inv_fun by auto
- with g' have "g' (the_inv_into S f x) \<le> g (f (the_inv_into S f x)) \<and> g' (the_inv_into S f x) \<noteq> \<omega>"
- by auto
- then show "g' (the_inv_into S f x) \<le> g x" "g' (the_inv_into S f x) \<noteq> \<omega>"
- using f_the_inv_into_f[of f S x] x f unfolding bij_betw_def by auto }
- note vimage_vimage_inv[OF f inv_f inv_fun, simp]
- from T.simple_function_vimage[OF g'(1), unfolded space_vimage_algebra, OF inv_fun]
- show "simple_function (\<lambda>x. g' (the_inv_into S f x))"
- unfolding simple_function_def by (simp add: simple_function_def)
- show "T.simple_integral g' = T.simple_integral (\<lambda>x. ?g (f x))"
- using the_inv_into_f_f[OF inj] by (auto intro!: T.simple_integral_cong)
- qed
- qed
-qed
-
-lemma (in measure_space) positive_integral_vimage_inv:
- fixes g :: "'d \<Rightarrow> pextreal" and f :: "'d \<Rightarrow> 'a"
- assumes f: "bij_inv S (space M) f h"
- shows "measure_space.positive_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) g =
- (\<integral>\<^isup>+x. g (h x))"
-proof -
- interpret v: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
- using f by (rule measure_space_isomorphic[OF bij_inv_bij_betw(1)])
- show ?thesis
- unfolding positive_integral_vimage[OF f[THEN bij_inv_bij_betw(1)], of "\<lambda>x. g (h x)"]
- using f[unfolded bij_inv_def]
- by (auto intro!: v.positive_integral_cong)
-qed
-
lemma (in measure_space) positive_integral_SUP_approx:
assumes "f \<up> s"
and f: "\<And>i. f i \<in> borel_measurable M"
@@ -1245,6 +1188,23 @@
using positive_integral_isoton[OF `f \<up> u` e(1)[THEN borel_measurable_simple_function]]
unfolding positive_integral_eq_simple_integral[OF e] .
+lemma (in measure_space) positive_integral_vimage:
+ assumes T: "sigma_algebra M'" "T \<in> measurable M M'" and f: "f \<in> borel_measurable M'"
+ shows "measure_space.positive_integral M' (\<lambda>A. \<mu> (T -` A \<inter> space M)) f = (\<integral>\<^isup>+ x. f (T x))"
+ (is "measure_space.positive_integral M' ?nu f = _")
+proof -
+ interpret T: measure_space M' ?nu using T by (rule measure_space_vimage) auto
+ obtain f' where f': "f' \<up> f" "\<And>i. T.simple_function (f' i)"
+ using T.borel_measurable_implies_simple_function_sequence[OF f] by blast
+ then have f: "(\<lambda>i x. f' i (T x)) \<up> (\<lambda>x. f (T x))" "\<And>i. simple_function (\<lambda>x. f' i (T x))"
+ using simple_function_vimage[OF T] unfolding isoton_fun_expand by auto
+ show "T.positive_integral f = (\<integral>\<^isup>+ x. f (T x))"
+ using positive_integral_isoton_simple[OF f]
+ using T.positive_integral_isoton_simple[OF f']
+ unfolding simple_integral_vimage[OF T f'(2)] isoton_def
+ by simp
+qed
+
lemma (in measure_space) positive_integral_linear:
assumes f: "f \<in> borel_measurable M"
and g: "g \<in> borel_measurable M"
@@ -1614,21 +1574,21 @@
thus ?thesis by (simp del: Real_eq_0 add: integral_def)
qed
-lemma (in measure_space) integral_vimage_inv:
- assumes f: "bij_betw f S (space M)"
- shows "measure_space.integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g x) = (\<integral>x. g (the_inv_into S f x))"
+lemma (in measure_space) integral_vimage:
+ assumes T: "sigma_algebra M'" "T \<in> measurable M M'"
+ assumes f: "measure_space.integrable M' (\<lambda>A. \<mu> (T -` A \<inter> space M)) f"
+ shows "integrable (\<lambda>x. f (T x))" (is ?P)
+ and "measure_space.integral M' (\<lambda>A. \<mu> (T -` A \<inter> space M)) f = (\<integral>x. f (T x))" (is ?I)
proof -
- interpret v: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
- using f by (rule measure_space_isomorphic)
- have "\<And>x. x \<in> space (vimage_algebra S f) \<Longrightarrow> the_inv_into S f (f x) = x"
- using f[unfolded bij_betw_def] by (simp add: the_inv_into_f_f)
- then have *: "v.positive_integral (\<lambda>x. Real (g (the_inv_into S f (f x)))) = v.positive_integral (\<lambda>x. Real (g x))"
- "v.positive_integral (\<lambda>x. Real (- g (the_inv_into S f (f x)))) = v.positive_integral (\<lambda>x. Real (- g x))"
- by (auto intro!: v.positive_integral_cong)
- show ?thesis
- unfolding integral_def v.integral_def
- unfolding positive_integral_vimage[OF f]
- by (simp add: *)
+ interpret T: measure_space M' "\<lambda>A. \<mu> (T -` A \<inter> space M)"
+ using T by (rule measure_space_vimage) auto
+ from measurable_comp[OF T(2), of f borel]
+ have borel: "(\<lambda>x. Real (f x)) \<in> borel_measurable M'" "(\<lambda>x. Real (- f x)) \<in> borel_measurable M'"
+ and "(\<lambda>x. f (T x)) \<in> borel_measurable M"
+ using f unfolding T.integrable_def by (auto simp: comp_def)
+ then show ?P ?I
+ using f unfolding T.integral_def integral_def T.integrable_def integrable_def
+ unfolding borel[THEN positive_integral_vimage[OF T]] by auto
qed
lemma (in measure_space) integral_minus[intro, simp]:
--- a/src/HOL/Probability/Lebesgue_Measure.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Lebesgue_Measure.thy Mon Jan 31 11:18:29 2011 +0100
@@ -1,7 +1,7 @@
(* Author: Robert Himmelmann, TU Muenchen *)
header {* Lebsegue measure *}
theory Lebesgue_Measure
- imports Product_Measure Gauge_Measure Complete_Measure
+ imports Product_Measure Complete_Measure
begin
subsection {* Standard Cubes *}
@@ -42,144 +42,165 @@
by (auto simp add:dist_norm)
qed
-lemma Union_inter_cube:"\<Union>{s \<inter> cube n |n. n \<in> UNIV} = s"
-proof safe case goal1
- from mem_big_cube[of x] guess n . note n=this
- show ?case unfolding Union_iff apply(rule_tac x="s \<inter> cube n" in bexI)
- using n goal1 by auto
-qed
+definition lebesgue :: "'a::ordered_euclidean_space algebra" where
+ "lebesgue = \<lparr> space = UNIV, sets = {A. \<forall>n. (indicator A :: 'a \<Rightarrow> real) integrable_on cube n} \<rparr>"
+
+definition "lmeasure A = (SUP n. Real (integral (cube n) (indicator A)))"
+
+lemma space_lebesgue[simp]: "space lebesgue = UNIV"
+ unfolding lebesgue_def by simp
+
+lemma lebesgueD: "A \<in> sets lebesgue \<Longrightarrow> (indicator A :: _ \<Rightarrow> real) integrable_on cube n"
+ unfolding lebesgue_def by simp
+
+lemma lebesgueI: "(\<And>n. (indicator A :: _ \<Rightarrow> real) integrable_on cube n) \<Longrightarrow> A \<in> sets lebesgue"
+ unfolding lebesgue_def by simp
-lemma gmeasurable_cube[intro]:"gmeasurable (cube n)"
- unfolding cube_def by auto
+lemma absolutely_integrable_on_indicator[simp]:
+ fixes A :: "'a::ordered_euclidean_space set"
+ shows "((indicator A :: _ \<Rightarrow> real) absolutely_integrable_on X) \<longleftrightarrow>
+ (indicator A :: _ \<Rightarrow> real) integrable_on X"
+ unfolding absolutely_integrable_on_def by simp
-lemma gmeasure_le_inter_cube[intro]: fixes s::"'a::ordered_euclidean_space set"
- assumes "gmeasurable (s \<inter> cube n)" shows "gmeasure (s \<inter> cube n) \<le> gmeasure (cube n::'a set)"
- apply(rule has_gmeasure_subset[of "s\<inter>cube n" _ "cube n"])
- unfolding has_gmeasure_measure[THEN sym] using assms by auto
+lemma LIMSEQ_indicator_UN:
+ "(\<lambda>k. indicator (\<Union> i<k. A i) x) ----> (indicator (\<Union>i. A i) x :: real)"
+proof cases
+ assume "\<exists>i. x \<in> A i" then guess i .. note i = this
+ then have *: "\<And>n. (indicator (\<Union> i<n + Suc i. A i) x :: real) = 1"
+ "(indicator (\<Union> i. A i) x :: real) = 1" by (auto simp: indicator_def)
+ show ?thesis
+ apply (rule LIMSEQ_offset[of _ "Suc i"]) unfolding * by auto
+qed (auto simp: indicator_def)
+
+lemma indicator_add:
+ "A \<inter> B = {} \<Longrightarrow> (indicator A x::_::monoid_add) + indicator B x = indicator (A \<union> B) x"
+ unfolding indicator_def by auto
-lemma has_gmeasure_cube[intro]: "(cube n::('a::ordered_euclidean_space) set)
- has_gmeasure ((2 * real n) ^ (DIM('a)))"
-proof-
- have "content {\<chi>\<chi> i. - real n..(\<chi>\<chi> i. real n)::'a} = (2 * real n) ^ (DIM('a))"
- apply(subst content_closed_interval) defer
- by (auto simp add:setprod_constant)
- thus ?thesis unfolding cube_def
- using has_gmeasure_interval(1)[of "(\<chi>\<chi> i. - real n)::'a" "(\<chi>\<chi> i. real n)::'a"]
- by auto
-qed
+interpretation lebesgue: sigma_algebra lebesgue
+proof (intro sigma_algebra_iff2[THEN iffD2] conjI allI ballI impI lebesgueI)
+ fix A n assume A: "A \<in> sets lebesgue"
+ have "indicator (space lebesgue - A) = (\<lambda>x. 1 - indicator A x :: real)"
+ by (auto simp: fun_eq_iff indicator_def)
+ then show "(indicator (space lebesgue - A) :: _ \<Rightarrow> real) integrable_on cube n"
+ using A by (auto intro!: integrable_sub dest: lebesgueD simp: cube_def)
+next
+ fix n show "(indicator {} :: _\<Rightarrow>real) integrable_on cube n"
+ by (auto simp: cube_def indicator_def_raw)
+next
+ fix A :: "nat \<Rightarrow> 'a set" and n ::nat assume "range A \<subseteq> sets lebesgue"
+ then have A: "\<And>i. (indicator (A i) :: _ \<Rightarrow> real) integrable_on cube n"
+ by (auto dest: lebesgueD)
+ show "(indicator (\<Union>i. A i) :: _ \<Rightarrow> real) integrable_on cube n" (is "?g integrable_on _")
+ proof (intro dominated_convergence[where g="?g"] ballI)
+ fix k show "(indicator (\<Union>i<k. A i) :: _ \<Rightarrow> real) integrable_on cube n"
+ proof (induct k)
+ case (Suc k)
+ have *: "(\<Union> i<Suc k. A i) = (\<Union> i<k. A i) \<union> A k"
+ unfolding lessThan_Suc UN_insert by auto
+ have *: "(\<lambda>x. max (indicator (\<Union> i<k. A i) x) (indicator (A k) x) :: real) =
+ indicator (\<Union> i<Suc k. A i)" (is "(\<lambda>x. max (?f x) (?g x)) = _")
+ by (auto simp: fun_eq_iff * indicator_def)
+ show ?case
+ using absolutely_integrable_max[of ?f "cube n" ?g] A Suc by (simp add: *)
+ qed auto
+ qed (auto intro: LIMSEQ_indicator_UN simp: cube_def)
+qed simp
-lemma gmeasure_cube_eq[simp]:
- "gmeasure (cube n::('a::ordered_euclidean_space) set) = (2 * real n) ^ DIM('a)"
- by (intro measure_unique) auto
-
-lemma gmeasure_cube_ge_n: "gmeasure (cube n::('a::ordered_euclidean_space) set) \<ge> real n"
-proof cases
- assume "n = 0" then show ?thesis by simp
+interpretation lebesgue: measure_space lebesgue lmeasure
+proof
+ have *: "indicator {} = (\<lambda>x. 0 :: real)" by (simp add: fun_eq_iff)
+ show "lmeasure {} = 0" by (simp add: integral_0 * lmeasure_def)
next
- assume "n \<noteq> 0"
- have "real n \<le> (2 * real n)^1" by simp
- also have "\<dots> \<le> (2 * real n)^DIM('a)"
- using DIM_positive[where 'a='a] `n \<noteq> 0`
- by (intro power_increasing) auto
- also have "\<dots> = gmeasure (cube n::'a set)" by simp
- finally show ?thesis .
+ show "countably_additive lebesgue lmeasure"
+ proof (intro countably_additive_def[THEN iffD2] allI impI)
+ fix A :: "nat \<Rightarrow> 'b set" assume rA: "range A \<subseteq> sets lebesgue" "disjoint_family A"
+ then have A[simp, intro]: "\<And>i n. (indicator (A i) :: _ \<Rightarrow> real) integrable_on cube n"
+ by (auto dest: lebesgueD)
+ let "?m n i" = "integral (cube n) (indicator (A i) :: _\<Rightarrow>real)"
+ let "?M n I" = "integral (cube n) (indicator (\<Union>i\<in>I. A i) :: _\<Rightarrow>real)"
+ have nn[simp, intro]: "\<And>i n. 0 \<le> ?m n i" by (auto intro!: integral_nonneg)
+ assume "(\<Union>i. A i) \<in> sets lebesgue"
+ then have UN_A[simp, intro]: "\<And>i n. (indicator (\<Union>i. A i) :: _ \<Rightarrow> real) integrable_on cube n"
+ by (auto dest: lebesgueD)
+ show "(\<Sum>\<^isub>\<infinity>n. lmeasure (A n)) = lmeasure (\<Union>i. A i)" unfolding lmeasure_def
+ proof (subst psuminf_SUP_eq)
+ fix n i show "Real (?m n i) \<le> Real (?m (Suc n) i)"
+ using cube_subset[of n "Suc n"] by (auto intro!: integral_subset_le)
+ next
+ show "(SUP n. \<Sum>\<^isub>\<infinity>i. Real (?m n i)) = (SUP n. Real (?M n UNIV))"
+ unfolding psuminf_def
+ proof (subst setsum_Real, (intro arg_cong[where f="SUPR UNIV"] ext ballI nn SUP_eq_LIMSEQ[THEN iffD2])+)
+ fix n :: nat show "mono (\<lambda>m. \<Sum>x<m. ?m n x)"
+ proof (intro mono_iff_le_Suc[THEN iffD2] allI)
+ fix m show "(\<Sum>x<m. ?m n x) \<le> (\<Sum>x<Suc m. ?m n x)"
+ using nn[of n m] by auto
+ qed
+ show "0 \<le> ?M n UNIV"
+ using UN_A by (auto intro!: integral_nonneg)
+ fix m show "0 \<le> (\<Sum>x<m. ?m n x)" by (auto intro!: setsum_nonneg)
+ next
+ fix n
+ have "\<And>m. (UNION {..<m} A) \<in> sets lebesgue" using rA by auto
+ from lebesgueD[OF this]
+ have "(\<lambda>m. ?M n {..< m}) ----> ?M n UNIV"
+ (is "(\<lambda>m. integral _ (?A m)) ----> ?I")
+ by (intro dominated_convergence(2)[where f="?A" and h="\<lambda>x. 1::real"])
+ (auto intro: LIMSEQ_indicator_UN simp: cube_def)
+ moreover
+ { fix m have *: "(\<Sum>x<m. ?m n x) = ?M n {..< m}"
+ proof (induct m)
+ case (Suc m)
+ have "(\<Union>i<m. A i) \<in> sets lebesgue" using rA by auto
+ then have "(indicator (\<Union>i<m. A i) :: _\<Rightarrow>real) integrable_on (cube n)"
+ by (auto dest!: lebesgueD)
+ moreover
+ have "(\<Union>i<m. A i) \<inter> A m = {}"
+ using rA(2)[unfolded disjoint_family_on_def, THEN bspec, of m]
+ by auto
+ then have "\<And>x. indicator (\<Union>i<Suc m. A i) x =
+ indicator (\<Union>i<m. A i) x + (indicator (A m) x :: real)"
+ by (auto simp: indicator_add lessThan_Suc ac_simps)
+ ultimately show ?case
+ using Suc A by (simp add: integral_add[symmetric])
+ qed auto }
+ ultimately show "(\<lambda>m. \<Sum>x<m. ?m n x) ----> ?M n UNIV"
+ by simp
+ qed
+ qed
+ qed
qed
-lemma gmeasure_setsum:
- assumes "finite A" and "\<And>s t. s \<in> A \<Longrightarrow> t \<in> A \<Longrightarrow> s \<noteq> t \<Longrightarrow> f s \<inter> f t = {}"
- and "\<And>i. i \<in> A \<Longrightarrow> gmeasurable (f i)"
- shows "gmeasure (\<Union>i\<in>A. f i) = (\<Sum>i\<in>A. gmeasure (f i))"
+lemma has_integral_interval_cube:
+ fixes a b :: "'a::ordered_euclidean_space"
+ shows "(indicator {a .. b} has_integral
+ content ({\<chi>\<chi> i. max (- real n) (a $$ i) .. \<chi>\<chi> i. min (real n) (b $$ i)} :: 'a set)) (cube n)"
+ (is "(?I has_integral content ?R) (cube n)")
proof -
- have "gmeasure (\<Union>i\<in>A. f i) = gmeasure (\<Union>f ` A)" by auto
- also have "\<dots> = setsum gmeasure (f ` A)" using assms
- proof (intro measure_negligible_unions)
- fix X Y assume "X \<in> f`A" "Y \<in> f`A" "X \<noteq> Y"
- then have "X \<inter> Y = {}" using assms by auto
- then show "negligible (X \<inter> Y)" by auto
- qed auto
- also have "\<dots> = setsum gmeasure (f ` A - {{}})"
- using assms by (intro setsum_mono_zero_cong_right) auto
- also have "\<dots> = (\<Sum>i\<in>A - {i. f i = {}}. gmeasure (f i))"
- proof (intro setsum_reindex_cong inj_onI)
- fix s t assume *: "s \<in> A - {i. f i = {}}" "t \<in> A - {i. f i = {}}" "f s = f t"
- show "s = t"
- proof (rule ccontr)
- assume "s \<noteq> t" with assms(2)[of s t] * show False by auto
- qed
- qed auto
- also have "\<dots> = (\<Sum>i\<in>A. gmeasure (f i))"
- using assms by (intro setsum_mono_zero_cong_left) auto
- finally show ?thesis .
-qed
-
-lemma gmeasurable_finite_UNION[intro]:
- assumes "\<And>i. i \<in> S \<Longrightarrow> gmeasurable (A i)" "finite S"
- shows "gmeasurable (\<Union>i\<in>S. A i)"
- unfolding UNION_eq_Union_image using assms
- by (intro gmeasurable_finite_unions) auto
-
-lemma gmeasurable_countable_UNION[intro]:
- fixes A :: "nat \<Rightarrow> ('a::ordered_euclidean_space) set"
- assumes measurable: "\<And>i. gmeasurable (A i)"
- and finite: "\<And>n. gmeasure (UNION {.. n} A) \<le> B"
- shows "gmeasurable (\<Union>i. A i)"
-proof -
- have *: "\<And>n. \<Union>{A k |k. k \<le> n} = (\<Union>i\<le>n. A i)"
- "(\<Union>{A n |n. n \<in> UNIV}) = (\<Union>i. A i)" by auto
- show ?thesis
- by (rule gmeasurable_countable_unions_strong[of A B, unfolded *, OF assms])
+ let "{?N .. ?P}" = ?R
+ have [simp]: "(\<lambda>x. if x \<in> cube n then ?I x else 0) = indicator ?R"
+ by (auto simp: indicator_def cube_def fun_eq_iff eucl_le[where 'a='a])
+ have "(?I has_integral content ?R) (cube n) \<longleftrightarrow> (indicator ?R has_integral content ?R) UNIV"
+ unfolding has_integral_restrict_univ[where s="cube n", symmetric] by simp
+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x. 1) has_integral content ?R) ?R"
+ unfolding indicator_def_raw has_integral_restrict_univ ..
+ finally show ?thesis
+ using has_integral_const[of "1::real" "?N" "?P"] by simp
qed
-subsection {* Measurability *}
-
-definition lebesgue :: "'a::ordered_euclidean_space algebra" where
- "lebesgue = \<lparr> space = UNIV, sets = {A. \<forall>n. gmeasurable (A \<inter> cube n)} \<rparr>"
-
-lemma space_lebesgue[simp]:"space lebesgue = UNIV"
- unfolding lebesgue_def by auto
-
-lemma lebesgueD[dest]: assumes "S \<in> sets lebesgue"
- shows "\<And>n. gmeasurable (S \<inter> cube n)"
- using assms unfolding lebesgue_def by auto
-
-lemma lebesgueI[intro]: assumes "gmeasurable S"
- shows "S \<in> sets lebesgue" unfolding lebesgue_def cube_def
- using assms gmeasurable_interval by auto
-
-lemma lebesgueI2: "(\<And>n. gmeasurable (S \<inter> cube n)) \<Longrightarrow> S \<in> sets lebesgue"
- using assms unfolding lebesgue_def by auto
-
-interpretation lebesgue: sigma_algebra lebesgue
-proof
- show "sets lebesgue \<subseteq> Pow (space lebesgue)"
- unfolding lebesgue_def by auto
- show "{} \<in> sets lebesgue"
- using gmeasurable_empty by auto
- { fix A B :: "'a set" assume "A \<in> sets lebesgue" "B \<in> sets lebesgue"
- then show "A \<union> B \<in> sets lebesgue"
- by (auto intro: gmeasurable_union simp: lebesgue_def Int_Un_distrib2) }
- { fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> sets lebesgue"
- show "(\<Union>i. A i) \<in> sets lebesgue"
- proof (rule lebesgueI2)
- fix n show "gmeasurable ((\<Union>i. A i) \<inter> cube n)" unfolding UN_extend_simps
- using A
- by (intro gmeasurable_countable_UNION[where B="gmeasure (cube n::'a set)"])
- (auto intro!: measure_subset gmeasure_setsum simp: UN_extend_simps simp del: gmeasure_cube_eq UN_simps)
- qed }
- { fix A assume A: "A \<in> sets lebesgue" show "space lebesgue - A \<in> sets lebesgue"
- proof (rule lebesgueI2)
- fix n
- have *: "(space lebesgue - A) \<inter> cube n = cube n - (A \<inter> cube n)"
- unfolding lebesgue_def by auto
- show "gmeasurable ((space lebesgue - A) \<inter> cube n)" unfolding *
- using A by (auto intro!: gmeasurable_diff)
- qed }
-qed
-
-lemma lebesgueI_borel[intro, simp]: fixes s::"'a::ordered_euclidean_space set"
+lemma lebesgueI_borel[intro, simp]:
+ fixes s::"'a::ordered_euclidean_space set"
assumes "s \<in> sets borel" shows "s \<in> sets lebesgue"
-proof- let ?S = "range (\<lambda>(a, b). {a .. (b :: 'a\<Colon>ordered_euclidean_space)})"
- have *:"?S \<subseteq> sets lebesgue" by auto
+proof -
+ let ?S = "range (\<lambda>(a, b). {a .. (b :: 'a\<Colon>ordered_euclidean_space)})"
+ have *:"?S \<subseteq> sets lebesgue"
+ proof (safe intro!: lebesgueI)
+ fix n :: nat and a b :: 'a
+ let ?N = "\<chi>\<chi> i. max (- real n) (a $$ i)"
+ let ?P = "\<chi>\<chi> i. min (real n) (b $$ i)"
+ show "(indicator {a..b} :: 'a\<Rightarrow>real) integrable_on cube n"
+ unfolding integrable_on_def
+ using has_integral_interval_cube[of a b] by auto
+ qed
have "s \<in> sigma_sets UNIV ?S" using assms
unfolding borel_eq_atLeastAtMost by (simp add: sigma_def)
thus ?thesis
@@ -189,171 +210,153 @@
lemma lebesgueI_negligible[dest]: fixes s::"'a::ordered_euclidean_space set"
assumes "negligible s" shows "s \<in> sets lebesgue"
-proof (rule lebesgueI2)
- fix n
- have *:"\<And>x. (if x \<in> cube n then indicator s x else 0) = (if x \<in> s \<inter> cube n then 1 else 0)"
- unfolding indicator_def_raw by auto
- note assms[unfolded negligible_def,rule_format,of "(\<chi>\<chi> i. - real n)::'a" "\<chi>\<chi> i. real n"]
- thus "gmeasurable (s \<inter> cube n)" apply-apply(rule gmeasurableI[of _ 0]) unfolding has_gmeasure_def
- apply(subst(asm) has_integral_restrict_univ[THEN sym]) unfolding cube_def[symmetric]
- apply(subst has_integral_restrict_univ[THEN sym]) unfolding * .
-qed
+ using assms by (force simp: cube_def integrable_on_def negligible_def intro!: lebesgueI)
-section {* The Lebesgue Measure *}
-
-definition "lmeasure A = (SUP n. Real (gmeasure (A \<inter> cube n)))"
-
-lemma lmeasure_eq_0: assumes "negligible S" shows "lmeasure S = 0"
+lemma lmeasure_eq_0:
+ fixes S :: "'a::ordered_euclidean_space set" assumes "negligible S" shows "lmeasure S = 0"
proof -
- from lebesgueI_negligible[OF assms]
- have "\<And>n. gmeasurable (S \<inter> cube n)" by auto
- from gmeasurable_measure_eq_0[OF this]
- have "\<And>n. gmeasure (S \<inter> cube n) = 0" using assms by auto
- then show ?thesis unfolding lmeasure_def by simp
+ have "\<And>n. integral (cube n) (indicator S :: 'a\<Rightarrow>real) = 0"
+ unfolding integral_def using assms
+ by (intro some1_equality ex_ex1I has_integral_unique)
+ (auto simp: cube_def negligible_def intro: )
+ then show ?thesis unfolding lmeasure_def by auto
qed
lemma lmeasure_iff_LIMSEQ:
assumes "A \<in> sets lebesgue" "0 \<le> m"
- shows "lmeasure A = Real m \<longleftrightarrow> (\<lambda>n. (gmeasure (A \<inter> cube n))) ----> m"
- unfolding lmeasure_def using assms cube_subset[where 'a='a]
- by (intro SUP_eq_LIMSEQ monoI measure_subset) force+
+ shows "lmeasure A = Real m \<longleftrightarrow> (\<lambda>n. integral (cube n) (indicator A :: _ \<Rightarrow> real)) ----> m"
+ unfolding lmeasure_def
+proof (intro SUP_eq_LIMSEQ)
+ show "mono (\<lambda>n. integral (cube n) (indicator A::_=>real))"
+ using cube_subset assms by (intro monoI integral_subset_le) (auto dest!: lebesgueD)
+ fix n show "0 \<le> integral (cube n) (indicator A::_=>real)"
+ using assms by (auto dest!: lebesgueD intro!: integral_nonneg)
+qed fact
-interpretation lebesgue: measure_space lebesgue lmeasure
-proof
- show "lmeasure {} = 0"
- by (auto intro!: lmeasure_eq_0)
- show "countably_additive lebesgue lmeasure"
- proof (unfold countably_additive_def, intro allI impI conjI)
- fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets lebesgue" "disjoint_family A"
- then have A: "\<And>i. A i \<in> sets lebesgue" by auto
- show "(\<Sum>\<^isub>\<infinity>n. lmeasure (A n)) = lmeasure (\<Union>i. A i)" unfolding lmeasure_def
- proof (subst psuminf_SUP_eq)
- { fix i n
- have "gmeasure (A i \<inter> cube n) \<le> gmeasure (A i \<inter> cube (Suc n))"
- using A cube_subset[of n "Suc n"] by (auto intro!: measure_subset)
- then show "Real (gmeasure (A i \<inter> cube n)) \<le> Real (gmeasure (A i \<inter> cube (Suc n)))"
- by auto }
- show "(SUP n. \<Sum>\<^isub>\<infinity>i. Real (gmeasure (A i \<inter> cube n))) = (SUP n. Real (gmeasure ((\<Union>i. A i) \<inter> cube n)))"
- proof (intro arg_cong[where f="SUPR UNIV"] ext)
- fix n
- have sums: "(\<lambda>i. gmeasure (A i \<inter> cube n)) sums gmeasure (\<Union>{A i \<inter> cube n |i. i \<in> UNIV})"
- proof (rule has_gmeasure_countable_negligible_unions(2))
- fix i show "gmeasurable (A i \<inter> cube n)" using A by auto
- next
- fix i m :: nat assume "m \<noteq> i"
- then have "A m \<inter> cube n \<inter> (A i \<inter> cube n) = {}"
- using `disjoint_family A` unfolding disjoint_family_on_def by auto
- then show "negligible (A m \<inter> cube n \<inter> (A i \<inter> cube n))" by auto
- next
- fix i
- have "(\<Sum>k = 0..i. gmeasure (A k \<inter> cube n)) = gmeasure (\<Union>k\<le>i . A k \<inter> cube n)"
- unfolding atLeast0AtMost using A
- proof (intro gmeasure_setsum[symmetric])
- fix s t :: nat assume "s \<noteq> t" then have "A t \<inter> A s = {}"
- using `disjoint_family A` unfolding disjoint_family_on_def by auto
- then show "A s \<inter> cube n \<inter> (A t \<inter> cube n) = {}" by auto
- qed auto
- also have "\<dots> \<le> gmeasure (cube n :: 'b set)" using A
- by (intro measure_subset gmeasurable_finite_UNION) auto
- finally show "(\<Sum>k = 0..i. gmeasure (A k \<inter> cube n)) \<le> gmeasure (cube n :: 'b set)" .
- qed
- show "(\<Sum>\<^isub>\<infinity>i. Real (gmeasure (A i \<inter> cube n))) = Real (gmeasure ((\<Union>i. A i) \<inter> cube n))"
- unfolding psuminf_def
- apply (subst setsum_Real)
- apply (simp add: measure_pos_le)
- proof (rule SUP_eq_LIMSEQ[THEN iffD2])
- have "(\<Union>{A i \<inter> cube n |i. i \<in> UNIV}) = (\<Union>i. A i) \<inter> cube n" by auto
- with sums show "(\<lambda>i. \<Sum>k<i. gmeasure (A k \<inter> cube n)) ----> gmeasure ((\<Union>i. A i) \<inter> cube n)"
- unfolding sums_def atLeast0LessThan by simp
- qed (auto intro!: monoI setsum_nonneg setsum_mono2)
- qed
- qed
- qed
+lemma has_integral_indicator_UNIV:
+ fixes s A :: "'a::ordered_euclidean_space set" and x :: real
+ shows "((indicator (s \<inter> A) :: 'a\<Rightarrow>real) has_integral x) UNIV = ((indicator s :: _\<Rightarrow>real) has_integral x) A"
+proof -
+ have "(\<lambda>x. if x \<in> A then indicator s x else 0) = (indicator (s \<inter> A) :: _\<Rightarrow>real)"
+ by (auto simp: fun_eq_iff indicator_def)
+ then show ?thesis
+ unfolding has_integral_restrict_univ[where s=A, symmetric] by simp
qed
-lemma lmeasure_finite_has_gmeasure: assumes "s \<in> sets lebesgue" "lmeasure s = Real m" "0 \<le> m"
- shows "s has_gmeasure m"
-proof-
- have *:"(\<lambda>n. (gmeasure (s \<inter> cube n))) ----> m"
- using `lmeasure s = Real m` unfolding lmeasure_iff_LIMSEQ[OF `s \<in> sets lebesgue` `0 \<le> m`] .
- have s: "\<And>n. gmeasurable (s \<inter> cube n)" using assms by auto
- have "(\<lambda>x. if x \<in> s then 1 else (0::real)) integrable_on UNIV \<and>
- (\<lambda>k. integral UNIV (\<lambda>x. if x \<in> s \<inter> cube k then 1 else (0::real)))
- ----> integral UNIV (\<lambda>x. if x \<in> s then 1 else 0)"
- proof(rule monotone_convergence_increasing)
- have "lmeasure s \<le> Real m" using `lmeasure s = Real m` by simp
- then have "\<forall>n. gmeasure (s \<inter> cube n) \<le> m"
- unfolding lmeasure_def complete_lattice_class.SUP_le_iff
- using `0 \<le> m` by (auto simp: measure_pos_le)
- thus *:"bounded {integral UNIV (\<lambda>x. if x \<in> s \<inter> cube k then 1 else (0::real)) |k. True}"
- unfolding integral_measure_univ[OF s] bounded_def apply-
- apply(rule_tac x=0 in exI,rule_tac x=m in exI) unfolding dist_real_def
- by (auto simp: measure_pos_le)
- show "\<forall>k. (\<lambda>x. if x \<in> s \<inter> cube k then (1::real) else 0) integrable_on UNIV"
- unfolding integrable_restrict_univ
- using s unfolding gmeasurable_def has_gmeasure_def by auto
- have *:"\<And>n. n \<le> Suc n" by auto
- show "\<forall>k. \<forall>x\<in>UNIV. (if x \<in> s \<inter> cube k then 1 else 0) \<le> (if x \<in> s \<inter> cube (Suc k) then 1 else (0::real))"
- using cube_subset[OF *] by fastsimp
- show "\<forall>x\<in>UNIV. (\<lambda>k. if x \<in> s \<inter> cube k then 1 else 0) ----> (if x \<in> s then 1 else (0::real))"
- unfolding Lim_sequentially
- proof safe case goal1 from real_arch_lt[of "norm x"] guess N .. note N = this
- show ?case apply(rule_tac x=N in exI)
- proof safe case goal1
- have "x \<in> cube n" using cube_subset[OF goal1] N
- using ball_subset_cube[of N] by(auto simp: dist_norm)
- thus ?case using `e>0` by auto
- qed
- qed
- qed note ** = conjunctD2[OF this]
- hence *:"m = integral UNIV (\<lambda>x. if x \<in> s then 1 else 0)" apply-
- apply(rule LIMSEQ_unique[OF _ **(2)]) unfolding measure_integral_univ[THEN sym,OF s] using * .
- show ?thesis unfolding has_gmeasure * apply(rule integrable_integral) using ** by auto
+lemma
+ fixes s a :: "'a::ordered_euclidean_space set"
+ shows integral_indicator_UNIV:
+ "integral UNIV (indicator (s \<inter> A) :: 'a\<Rightarrow>real) = integral A (indicator s :: _\<Rightarrow>real)"
+ and integrable_indicator_UNIV:
+ "(indicator (s \<inter> A) :: 'a\<Rightarrow>real) integrable_on UNIV \<longleftrightarrow> (indicator s :: 'a\<Rightarrow>real) integrable_on A"
+ unfolding integral_def integrable_on_def has_integral_indicator_UNIV by auto
+
+lemma lmeasure_finite_has_integral:
+ fixes s :: "'a::ordered_euclidean_space set"
+ assumes "s \<in> sets lebesgue" "lmeasure s = Real m" "0 \<le> m"
+ shows "(indicator s has_integral m) UNIV"
+proof -
+ let ?I = "indicator :: 'a set \<Rightarrow> 'a \<Rightarrow> real"
+ have **: "(?I s) integrable_on UNIV \<and> (\<lambda>k. integral UNIV (?I (s \<inter> cube k))) ----> integral UNIV (?I s)"
+ proof (intro monotone_convergence_increasing allI ballI)
+ have LIMSEQ: "(\<lambda>n. integral (cube n) (?I s)) ----> m"
+ using assms(2) unfolding lmeasure_iff_LIMSEQ[OF assms(1, 3)] .
+ { fix n have "integral (cube n) (?I s) \<le> m"
+ using cube_subset assms
+ by (intro incseq_le[where L=m] LIMSEQ incseq_def[THEN iffD2] integral_subset_le allI impI)
+ (auto dest!: lebesgueD) }
+ moreover
+ { fix n have "0 \<le> integral (cube n) (?I s)"
+ using assms by (auto dest!: lebesgueD intro!: integral_nonneg) }
+ ultimately
+ show "bounded {integral UNIV (?I (s \<inter> cube k)) |k. True}"
+ unfolding bounded_def
+ apply (rule_tac exI[of _ 0])
+ apply (rule_tac exI[of _ m])
+ by (auto simp: dist_real_def integral_indicator_UNIV)
+ fix k show "?I (s \<inter> cube k) integrable_on UNIV"
+ unfolding integrable_indicator_UNIV using assms by (auto dest!: lebesgueD)
+ fix x show "?I (s \<inter> cube k) x \<le> ?I (s \<inter> cube (Suc k)) x"
+ using cube_subset[of k "Suc k"] by (auto simp: indicator_def)
+ next
+ fix x :: 'a
+ from mem_big_cube obtain k where k: "x \<in> cube k" .
+ { fix n have "?I (s \<inter> cube (n + k)) x = ?I s x"
+ using k cube_subset[of k "n + k"] by (auto simp: indicator_def) }
+ note * = this
+ show "(\<lambda>k. ?I (s \<inter> cube k) x) ----> ?I s x"
+ by (rule LIMSEQ_offset[where k=k]) (auto simp: *)
+ qed
+ note ** = conjunctD2[OF this]
+ have m: "m = integral UNIV (?I s)"
+ apply (intro LIMSEQ_unique[OF _ **(2)])
+ using assms(2) unfolding lmeasure_iff_LIMSEQ[OF assms(1,3)] integral_indicator_UNIV .
+ show ?thesis
+ unfolding m by (intro integrable_integral **)
qed
-lemma lmeasure_finite_gmeasurable: assumes "s \<in> sets lebesgue" "lmeasure s \<noteq> \<omega>"
- shows "gmeasurable s"
+lemma lmeasure_finite_integrable: assumes "s \<in> sets lebesgue" "lmeasure s \<noteq> \<omega>"
+ shows "(indicator s :: _ \<Rightarrow> real) integrable_on UNIV"
proof (cases "lmeasure s")
- case (preal m) from lmeasure_finite_has_gmeasure[OF `s \<in> sets lebesgue` this]
- show ?thesis unfolding gmeasurable_def by auto
+ case (preal m) from lmeasure_finite_has_integral[OF `s \<in> sets lebesgue` this]
+ show ?thesis unfolding integrable_on_def by auto
qed (insert assms, auto)
-lemma has_gmeasure_lmeasure: assumes "s has_gmeasure m"
- shows "lmeasure s = Real m"
-proof-
- have gmea:"gmeasurable s" using assms by auto
- then have s: "s \<in> sets lebesgue" by auto
- have m:"m \<ge> 0" using assms by auto
- have *:"m = gmeasure (\<Union>{s \<inter> cube n |n. n \<in> UNIV})" unfolding Union_inter_cube
- using assms by(rule measure_unique[THEN sym])
- show ?thesis
- unfolding lmeasure_iff_LIMSEQ[OF s `0 \<le> m`] unfolding *
- apply(rule gmeasurable_nested_unions[THEN conjunct2, where B1="gmeasure s"])
- proof- fix n::nat show *:"gmeasurable (s \<inter> cube n)"
- using gmeasurable_inter[OF gmea gmeasurable_cube] .
- show "gmeasure (s \<inter> cube n) \<le> gmeasure s" apply(rule measure_subset)
- apply(rule * gmea)+ by auto
- show "s \<inter> cube n \<subseteq> s \<inter> cube (Suc n)" using cube_subset[of n "Suc n"] by auto
- qed
+lemma has_integral_lebesgue: assumes "((indicator s :: _\<Rightarrow>real) has_integral m) UNIV"
+ shows "s \<in> sets lebesgue"
+proof (intro lebesgueI)
+ let ?I = "indicator :: 'a set \<Rightarrow> 'a \<Rightarrow> real"
+ fix n show "(?I s) integrable_on cube n" unfolding cube_def
+ proof (intro integrable_on_subinterval)
+ show "(?I s) integrable_on UNIV"
+ unfolding integrable_on_def using assms by auto
+ qed auto
qed
-lemma has_gmeasure_iff_lmeasure:
- "A has_gmeasure m \<longleftrightarrow> (A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m)"
+lemma has_integral_lmeasure: assumes "((indicator s :: _\<Rightarrow>real) has_integral m) UNIV"
+ shows "lmeasure s = Real m"
+proof (intro lmeasure_iff_LIMSEQ[THEN iffD2])
+ let ?I = "indicator :: 'a set \<Rightarrow> 'a \<Rightarrow> real"
+ show "s \<in> sets lebesgue" using has_integral_lebesgue[OF assms] .
+ show "0 \<le> m" using assms by (rule has_integral_nonneg) auto
+ have "(\<lambda>n. integral UNIV (?I (s \<inter> cube n))) ----> integral UNIV (?I s)"
+ proof (intro dominated_convergence(2) ballI)
+ show "(?I s) integrable_on UNIV" unfolding integrable_on_def using assms by auto
+ fix n show "?I (s \<inter> cube n) integrable_on UNIV"
+ unfolding integrable_indicator_UNIV using `s \<in> sets lebesgue` by (auto dest: lebesgueD)
+ fix x show "norm (?I (s \<inter> cube n) x) \<le> ?I s x" by (auto simp: indicator_def)
+ next
+ fix x :: 'a
+ from mem_big_cube obtain k where k: "x \<in> cube k" .
+ { fix n have "?I (s \<inter> cube (n + k)) x = ?I s x"
+ using k cube_subset[of k "n + k"] by (auto simp: indicator_def) }
+ note * = this
+ show "(\<lambda>k. ?I (s \<inter> cube k) x) ----> ?I s x"
+ by (rule LIMSEQ_offset[where k=k]) (auto simp: *)
+ qed
+ then show "(\<lambda>n. integral (cube n) (?I s)) ----> m"
+ unfolding integral_unique[OF assms] integral_indicator_UNIV by simp
+qed
+
+lemma has_integral_iff_lmeasure:
+ "(indicator A has_integral m) UNIV \<longleftrightarrow> (A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m)"
proof
- assume "A has_gmeasure m"
- with has_gmeasure_lmeasure[OF this]
- have "gmeasurable A" "0 \<le> m" "lmeasure A = Real m" by auto
- then show "A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m" by auto
+ assume "(indicator A has_integral m) UNIV"
+ with has_integral_lmeasure[OF this] has_integral_lebesgue[OF this]
+ show "A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m"
+ by (auto intro: has_integral_nonneg)
next
assume "A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m"
- then show "A has_gmeasure m" by (intro lmeasure_finite_has_gmeasure) auto
+ then show "(indicator A has_integral m) UNIV" by (intro lmeasure_finite_has_integral) auto
qed
-lemma gmeasure_lmeasure: assumes "gmeasurable s" shows "lmeasure s = Real (gmeasure s)"
-proof -
- note has_gmeasure_measureI[OF assms]
- note has_gmeasure_lmeasure[OF this]
- thus ?thesis .
+lemma lmeasure_eq_integral: assumes "(indicator s::_\<Rightarrow>real) integrable_on UNIV"
+ shows "lmeasure s = Real (integral UNIV (indicator s))"
+ using assms unfolding integrable_on_def
+proof safe
+ fix y :: real assume "(indicator s has_integral y) UNIV"
+ from this[unfolded has_integral_iff_lmeasure] integral_unique[OF this]
+ show "lmeasure s = Real (integral UNIV (indicator s))" by simp
qed
lemma lebesgue_simple_function_indicator:
@@ -362,12 +365,12 @@
shows "f = (\<lambda>x. (\<Sum>y \<in> f ` UNIV. y * indicator (f -` {y}) x))"
apply(rule,subst lebesgue.simple_function_indicator_representation[OF f]) by auto
-lemma lmeasure_gmeasure:
- "gmeasurable s \<Longrightarrow> gmeasure s = real (lmeasure s)"
- by (subst gmeasure_lmeasure) auto
+lemma integral_eq_lmeasure:
+ "(indicator s::_\<Rightarrow>real) integrable_on UNIV \<Longrightarrow> integral UNIV (indicator s) = real (lmeasure s)"
+ by (subst lmeasure_eq_integral) (auto intro!: integral_nonneg)
-lemma lmeasure_finite: assumes "gmeasurable s" shows "lmeasure s \<noteq> \<omega>"
- using gmeasure_lmeasure[OF assms] by auto
+lemma lmeasure_finite: assumes "(indicator s::_\<Rightarrow>real) integrable_on UNIV" shows "lmeasure s \<noteq> \<omega>"
+ using lmeasure_eq_integral[OF assms] by auto
lemma negligible_iff_lebesgue_null_sets:
"negligible A \<longleftrightarrow> A \<in> lebesgue.null_sets"
@@ -377,35 +380,65 @@
show "A \<in> lebesgue.null_sets" by auto
next
assume A: "A \<in> lebesgue.null_sets"
- then have *:"gmeasurable A" using lmeasure_finite_gmeasurable[of A] by auto
- show "negligible A"
- unfolding gmeasurable_measure_eq_0[OF *, symmetric]
- unfolding lmeasure_gmeasure[OF *] using A by auto
+ then have *:"((indicator A) has_integral (0::real)) UNIV" using lmeasure_finite_has_integral[of A] by auto
+ show "negligible A" unfolding negligible_def
+ proof (intro allI)
+ fix a b :: 'a
+ have integrable: "(indicator A :: _\<Rightarrow>real) integrable_on {a..b}"
+ by (intro integrable_on_subinterval has_integral_integrable) (auto intro: *)
+ then have "integral {a..b} (indicator A) \<le> (integral UNIV (indicator A) :: real)"
+ using * by (auto intro!: integral_subset_le has_integral_integrable)
+ moreover have "(0::real) \<le> integral {a..b} (indicator A)"
+ using integrable by (auto intro!: integral_nonneg)
+ ultimately have "integral {a..b} (indicator A) = (0::real)"
+ using integral_unique[OF *] by auto
+ then show "(indicator A has_integral (0::real)) {a..b}"
+ using integrable_integral[OF integrable] by simp
+ qed
+qed
+
+lemma integral_const[simp]:
+ fixes a b :: "'a::ordered_euclidean_space"
+ shows "integral {a .. b} (\<lambda>x. c) = content {a .. b} *\<^sub>R c"
+ by (rule integral_unique) (rule has_integral_const)
+
+lemma lmeasure_UNIV[intro]: "lmeasure (UNIV::'a::ordered_euclidean_space set) = \<omega>"
+ unfolding lmeasure_def SUP_\<omega>
+proof (intro allI impI)
+ fix x assume "x < \<omega>"
+ then obtain r where r: "x = Real r" "0 \<le> r" by (cases x) auto
+ then obtain n where n: "r < of_nat n" using ex_less_of_nat by auto
+ show "\<exists>i\<in>UNIV. x < Real (integral (cube i) (indicator UNIV::'a\<Rightarrow>real))"
+ proof (intro bexI[of _ n])
+ have [simp]: "indicator UNIV = (\<lambda>x. 1)" by (auto simp: fun_eq_iff)
+ { fix m :: nat assume "0 < m" then have "real n \<le> (\<Prod>x<m. 2 * real n)"
+ proof (induct m)
+ case (Suc m)
+ show ?case
+ proof cases
+ assume "m = 0" then show ?thesis by (simp add: lessThan_Suc)
+ next
+ assume "m \<noteq> 0" then have "real n \<le> (\<Prod>x<m. 2 * real n)" using Suc by auto
+ then show ?thesis
+ by (auto simp: lessThan_Suc field_simps mult_le_cancel_left1)
+ qed
+ qed auto } note this[OF DIM_positive[where 'a='a], simp]
+ then have [simp]: "0 \<le> (\<Prod>x<DIM('a). 2 * real n)" using real_of_nat_ge_zero by arith
+ have "x < Real (of_nat n)" using n r by auto
+ also have "Real (of_nat n) \<le> Real (integral (cube n) (indicator UNIV::'a\<Rightarrow>real))"
+ by (auto simp: real_eq_of_nat[symmetric] cube_def content_closed_interval_cases)
+ finally show "x < Real (integral (cube n) (indicator UNIV::'a\<Rightarrow>real))" .
+ qed auto
qed
lemma
fixes a b ::"'a::ordered_euclidean_space"
shows lmeasure_atLeastAtMost[simp]: "lmeasure {a..b} = Real (content {a..b})"
- and lmeasure_greaterThanLessThan[simp]: "lmeasure {a <..< b} = Real (content {a..b})"
- using has_gmeasure_interval[of a b] by (auto intro!: has_gmeasure_lmeasure)
-
-lemma lmeasure_cube:
- "lmeasure (cube n::('a::ordered_euclidean_space) set) = (Real ((2 * real n) ^ (DIM('a))))"
- by (intro has_gmeasure_lmeasure) auto
-
-lemma lmeasure_UNIV[intro]: "lmeasure UNIV = \<omega>"
- unfolding lmeasure_def SUP_\<omega>
-proof (intro allI impI)
- fix x assume "x < \<omega>"
- then obtain r where r: "x = Real r" "0 \<le> r" by (cases x) auto
- then obtain n where n: "r < of_nat n" using ex_less_of_nat by auto
- show "\<exists>i\<in>UNIV. x < Real (gmeasure (UNIV \<inter> cube i))"
- proof (intro bexI[of _ n])
- have "x < Real (of_nat n)" using n r by auto
- also have "Real (of_nat n) \<le> Real (gmeasure (UNIV \<inter> cube n))"
- using gmeasure_cube_ge_n[of n] by (auto simp: real_eq_of_nat[symmetric])
- finally show "x < Real (gmeasure (UNIV \<inter> cube n))" .
- qed auto
+proof -
+ have "(indicator (UNIV \<inter> {a..b})::_\<Rightarrow>real) integrable_on UNIV"
+ unfolding integrable_indicator_UNIV by (simp add: integrable_const indicator_def_raw)
+ from lmeasure_eq_integral[OF this] show ?thesis unfolding integral_indicator_UNIV
+ by (simp add: indicator_def_raw)
qed
lemma atLeastAtMost_singleton_euclidean[simp]:
@@ -421,9 +454,7 @@
lemma lmeasure_singleton[simp]:
fixes a :: "'a::ordered_euclidean_space" shows "lmeasure {a} = 0"
- using has_gmeasure_interval[of a a] unfolding zero_pextreal_def
- by (intro has_gmeasure_lmeasure)
- (simp add: content_closed_interval DIM_positive)
+ using lmeasure_atLeastAtMost[of a a] by simp
declare content_real[simp]
@@ -433,21 +464,33 @@
"lmeasure {a <.. b} = Real (if a \<le> b then b - a else 0)"
proof cases
assume "a < b"
- then have "lmeasure {a <.. b} = lmeasure {a <..< b} + lmeasure {b}"
- by (subst lebesgue.measure_additive)
- (auto intro!: lebesgueI_borel arg_cong[where f=lmeasure])
+ then have "lmeasure {a <.. b} = lmeasure {a .. b} - lmeasure {a}"
+ by (subst lebesgue.measure_Diff[symmetric])
+ (auto intro!: arg_cong[where f=lmeasure])
then show ?thesis by auto
qed auto
lemma
fixes a b :: real
shows lmeasure_real_atLeastLessThan[simp]:
- "lmeasure {a ..< b} = Real (if a \<le> b then b - a else 0)" (is ?eqlt)
+ "lmeasure {a ..< b} = Real (if a \<le> b then b - a else 0)"
proof cases
assume "a < b"
- then have "lmeasure {a ..< b} = lmeasure {a} + lmeasure {a <..< b}"
- by (subst lebesgue.measure_additive)
- (auto intro!: lebesgueI_borel arg_cong[where f=lmeasure])
+ then have "lmeasure {a ..< b} = lmeasure {a .. b} - lmeasure {b}"
+ by (subst lebesgue.measure_Diff[symmetric])
+ (auto intro!: arg_cong[where f=lmeasure])
+ then show ?thesis by auto
+qed auto
+
+lemma
+ fixes a b :: real
+ shows lmeasure_real_greaterThanLessThan[simp]:
+ "lmeasure {a <..< b} = Real (if a \<le> b then b - a else 0)"
+proof cases
+ assume "a < b"
+ then have "lmeasure {a <..< b} = lmeasure {a <.. b} - lmeasure {b}"
+ by (subst lebesgue.measure_Diff[symmetric])
+ (auto intro!: arg_cong[where f=lmeasure])
then show ?thesis by auto
qed auto
@@ -463,7 +506,7 @@
show "range cube \<subseteq> sets borel" by (auto intro: borel_closed)
{ fix x have "\<exists>n. x\<in>cube n" using mem_big_cube by auto }
thus "(\<Union>i. cube i) = space borel" by auto
- show "\<forall>i. lmeasure (cube i) \<noteq> \<omega>" unfolding lmeasure_cube by auto
+ show "\<forall>i. lmeasure (cube i) \<noteq> \<omega>" unfolding cube_def by auto
qed
interpretation lebesgue: sigma_finite_measure lebesgue lmeasure
@@ -482,7 +525,8 @@
shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.simple_integral f))) UNIV"
unfolding lebesgue.simple_integral_def
apply(subst lebesgue_simple_function_indicator[OF f])
-proof- case goal1
+proof -
+ case goal1
have *:"\<And>x. \<forall>y\<in>range f. y * indicator (f -` {y}) x \<noteq> \<omega>"
"\<forall>x\<in>range f. x * lmeasure (f -` {x} \<inter> UNIV) \<noteq> \<omega>"
using f' om unfolding indicator_def by auto
@@ -494,16 +538,19 @@
fix y::'a show "((\<lambda>x. real (f y * indicator (f -` {f y}) x)) has_integral
real (f y * lmeasure (f -` {f y} \<inter> UNIV))) UNIV"
proof(cases "f y = 0") case False
- have mea:"gmeasurable (f -` {f y})" apply(rule lmeasure_finite_gmeasurable)
+ have mea:"(indicator (f -` {f y}) ::_\<Rightarrow>real) integrable_on UNIV"
+ apply(rule lmeasure_finite_integrable)
using assms unfolding lebesgue.simple_function_def using False by auto
- have *:"\<And>x. real (indicator (f -` {f y}) x::pextreal) = (if x \<in> f -` {f y} then 1 else 0)" by auto
+ have *:"\<And>x. real (indicator (f -` {f y}) x::pextreal) = (indicator (f -` {f y}) x)"
+ by (auto simp: indicator_def)
show ?thesis unfolding real_of_pextreal_mult[THEN sym]
apply(rule has_integral_cmul[where 'b=real, unfolded real_scaleR_def])
- unfolding Int_UNIV_right lmeasure_gmeasure[OF mea,THEN sym]
- unfolding measure_integral_univ[OF mea] * apply(rule integrable_integral)
- unfolding gmeasurable_integrable[THEN sym] using mea .
+ unfolding Int_UNIV_right lmeasure_eq_integral[OF mea,THEN sym]
+ unfolding integral_eq_lmeasure[OF mea, symmetric] *
+ apply(rule integrable_integral) using mea .
qed auto
- qed qed
+ qed
+qed
lemma bounded_realI: assumes "\<forall>x\<in>s. abs (x::real) \<le> B" shows "bounded s"
unfolding bounded_def dist_real_def apply(rule_tac x=0 in exI)
@@ -689,6 +736,21 @@
show "p2e \<in> ?P \<rightarrow> ?U" "e2p \<in> ?U \<rightarrow> ?P" by (auto simp: e2p_def)
qed auto
+declare restrict_extensional[intro]
+
+lemma e2p_extensional[intro]:"e2p (y::'a::ordered_euclidean_space) \<in> extensional {..<DIM('a)}"
+ unfolding e2p_def by auto
+
+lemma e2p_image_vimage: fixes A::"'a::ordered_euclidean_space set"
+ shows "e2p ` A = p2e -` A \<inter> extensional {..<DIM('a)}"
+proof(rule set_eqI,rule)
+ fix x assume "x \<in> e2p ` A" then guess y unfolding image_iff .. note y=this
+ show "x \<in> p2e -` A \<inter> extensional {..<DIM('a)}"
+ apply safe apply(rule vimageI[OF _ y(1)]) unfolding y p2e_e2p by auto
+next fix x assume "x \<in> p2e -` A \<inter> extensional {..<DIM('a)}"
+ thus "x \<in> e2p ` A" unfolding image_iff apply(rule_tac x="p2e x" in bexI) apply(subst e2p_p2e) by auto
+qed
+
interpretation borel_product: product_sigma_finite "\<lambda>x. borel::real algebra" "\<lambda>x. lmeasure"
by default
@@ -720,6 +782,14 @@
then show "e2p -` A \<inter> space ?E \<in> sets ?E" by simp
qed
+lemma measurable_e2p:
+ "e2p \<in> measurable (borel::'a algebra)
+ (sigma (product_algebra (\<lambda>x. borel :: real algebra) {..<DIM('a::ordered_euclidean_space)}))"
+ using measurable_e2p_on_generator[where 'a='a] unfolding borel_eq_lessThan
+ by (subst sigma_product_algebra_sigma_eq[where S="\<lambda>_ i. {..<real i}"])
+ (auto intro!: measurable_sigma_sigma isotoneI real_arch_lt
+ simp: product_algebra_def)
+
lemma measurable_p2e_on_generator:
"p2e \<in> measurable
(product_algebra
@@ -738,33 +808,13 @@
then show "p2e -` A \<inter> space ?P \<in> sets ?P" by auto
qed
-lemma borel_vimage_algebra_eq:
- defines "F \<equiv> product_algebra (\<lambda>x. \<lparr> space = (UNIV::real set), sets = range lessThan \<rparr>) {..<DIM('a::ordered_euclidean_space)}"
- shows "sigma_algebra.vimage_algebra (borel::'a::ordered_euclidean_space algebra) (space (sigma F)) p2e = sigma F"
- unfolding borel_eq_lessThan
-proof (intro vimage_algebra_sigma)
- let ?E = "\<lparr>space = (UNIV::'a set), sets = range lessThan\<rparr>"
- show "bij_inv (space (sigma F)) (space (sigma ?E)) p2e e2p"
- using bij_inv_p2e_e2p unfolding F_def by simp
- show "sets F \<subseteq> Pow (space F)" "sets ?E \<subseteq> Pow (space ?E)" unfolding F_def
- by (intro product_algebra_sets_into_space) auto
- show "p2e \<in> measurable F ?E"
- "e2p \<in> measurable ?E F"
- unfolding F_def using measurable_p2e_on_generator measurable_e2p_on_generator by auto
-qed
-
-lemma product_borel_eq_vimage:
- "sigma (product_algebra (\<lambda>x. borel) {..<DIM('a::ordered_euclidean_space)}) =
- sigma_algebra.vimage_algebra borel (extensional {..<DIM('a)})
- (p2e:: _ \<Rightarrow> 'a::ordered_euclidean_space)"
- unfolding borel_vimage_algebra_eq[simplified]
- unfolding borel_eq_lessThan
- apply(subst sigma_product_algebra_sigma_eq[where S="\<lambda>i. \<lambda>n. lessThan (real n)"])
- unfolding lessThan_iff
-proof- fix i assume i:"i<DIM('a)"
- show "(\<lambda>n. {..<real n}) \<up> space \<lparr>space = UNIV, sets = range lessThan\<rparr>"
- by(auto intro!:real_arch_lt isotoneI)
-qed auto
+lemma measurable_p2e:
+ "p2e \<in> measurable (sigma (product_algebra (\<lambda>x. borel :: real algebra) {..<DIM('a::ordered_euclidean_space)}))
+ (borel::'a algebra)"
+ using measurable_p2e_on_generator[where 'a='a] unfolding borel_eq_lessThan
+ by (subst sigma_product_algebra_sigma_eq[where S="\<lambda>_ i. {..<real i}"])
+ (auto intro!: measurable_sigma_sigma isotoneI real_arch_lt
+ simp: product_algebra_def)
lemma e2p_Int:"e2p ` A \<inter> e2p ` B = e2p ` (A \<inter> B)" (is "?L = ?R")
apply(rule image_Int[THEN sym])
@@ -787,46 +837,16 @@
unfolding Int_stable_def algebra.select_convs
apply safe unfolding inter_interval by auto
-lemma inj_on_disjoint_family_on: assumes "disjoint_family_on A S" "inj f"
- shows "disjoint_family_on (\<lambda>x. f ` A x) S"
- unfolding disjoint_family_on_def
-proof(rule,rule,rule)
- fix x1 x2 assume x:"x1 \<in> S" "x2 \<in> S" "x1 \<noteq> x2"
- show "f ` A x1 \<inter> f ` A x2 = {}"
- proof(rule ccontr) case goal1
- then obtain z where z:"z \<in> f ` A x1 \<inter> f ` A x2" by auto
- then obtain z1 z2 where z12:"z1 \<in> A x1" "z2 \<in> A x2" "f z1 = z" "f z2 = z" by auto
- hence "z1 = z2" using assms(2) unfolding inj_on_def by blast
- hence "x1 = x2" using z12(1-2) using assms[unfolded disjoint_family_on_def] using x by auto
- thus False using x(3) by auto
- qed
-qed
-
-declare restrict_extensional[intro]
-
-lemma e2p_extensional[intro]:"e2p (y::'a::ordered_euclidean_space) \<in> extensional {..<DIM('a)}"
- unfolding e2p_def by auto
-
-lemma e2p_image_vimage: fixes A::"'a::ordered_euclidean_space set"
- shows "e2p ` A = p2e -` A \<inter> extensional {..<DIM('a)}"
-proof(rule set_eqI,rule)
- fix x assume "x \<in> e2p ` A" then guess y unfolding image_iff .. note y=this
- show "x \<in> p2e -` A \<inter> extensional {..<DIM('a)}"
- apply safe apply(rule vimageI[OF _ y(1)]) unfolding y p2e_e2p by auto
-next fix x assume "x \<in> p2e -` A \<inter> extensional {..<DIM('a)}"
- thus "x \<in> e2p ` A" unfolding image_iff apply(rule_tac x="p2e x" in bexI) apply(subst e2p_p2e) by auto
-qed
-
lemma lmeasure_measure_eq_borel_prod:
fixes A :: "('a::ordered_euclidean_space) set"
assumes "A \<in> sets borel"
shows "lmeasure A = borel_product.product_measure {..<DIM('a)} (e2p ` A :: (nat \<Rightarrow> real) set)"
proof (rule measure_unique_Int_stable[where X=A and A=cube])
- interpret fprod: finite_product_sigma_finite "\<lambda>x. borel" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
+ interpret fprod: finite_product_sigma_finite "\<lambda>x. borel :: real algebra" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
show "Int_stable \<lparr> space = UNIV :: 'a set, sets = range (\<lambda>(a,b). {a..b}) \<rparr>"
(is "Int_stable ?E" ) using Int_stable_cuboids' .
show "borel = sigma ?E" using borel_eq_atLeastAtMost .
- show "\<And>i. lmeasure (cube i) \<noteq> \<omega>" unfolding lmeasure_cube by auto
+ show "\<And>i. lmeasure (cube i) \<noteq> \<omega>" unfolding cube_def by auto
show "\<And>X. X \<in> sets ?E \<Longrightarrow>
lmeasure X = borel_product.product_measure {..<DIM('a)} (e2p ` X :: (nat \<Rightarrow> real) set)"
proof- case goal1 then obtain a b where X:"X = {a..b}" by auto
@@ -859,64 +879,19 @@
show "measure_space borel lmeasure" by default
show "measure_space borel
(\<lambda>a::'a set. finite_product_sigma_finite.measure (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` a))"
- apply default unfolding countably_additive_def
- proof safe fix A::"nat \<Rightarrow> 'a set" assume A:"range A \<subseteq> sets borel" "disjoint_family A"
- "(\<Union>i. A i) \<in> sets borel"
- note fprod.ca[unfolded countably_additive_def,rule_format]
- note ca = this[of "\<lambda> n. e2p ` (A n)"]
- show "(\<Sum>\<^isub>\<infinity>n. finite_product_sigma_finite.measure
- (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` A n)) =
- finite_product_sigma_finite.measure (\<lambda>x. borel)
- (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` (\<Union>i. A i))" unfolding image_UN
- proof(rule ca) show "range (\<lambda>n. e2p ` A n) \<subseteq> sets
- (sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)}))"
- unfolding product_borel_eq_vimage
- proof case goal1
- then guess y unfolding image_iff .. note y=this(2)
- show ?case unfolding borel.in_vimage_algebra y apply-
- apply(rule_tac x="A y" in bexI,rule e2p_image_vimage)
- using A(1) by auto
- qed
-
- show "disjoint_family (\<lambda>n. e2p ` A n)" apply(rule inj_on_disjoint_family_on)
- using bij_inv_p2e_e2p[THEN bij_inv_bij_betw(2)] using A(2) unfolding bij_betw_def by auto
- show "(\<Union>n. e2p ` A n) \<in> sets (sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)}))"
- unfolding product_borel_eq_vimage borel.in_vimage_algebra
- proof(rule bexI[OF _ A(3)],rule set_eqI,rule)
- fix x assume x:"x \<in> (\<Union>n. e2p ` A n)" hence "p2e x \<in> (\<Union>i. A i)" by auto
- moreover have "x \<in> extensional {..<DIM('a)}"
- using x unfolding extensional_def e2p_def_raw by auto
- ultimately show "x \<in> p2e -` (\<Union>i. A i) \<inter> extensional {..<DIM('a)}" by auto
- next fix x assume x:"x \<in> p2e -` (\<Union>i. A i) \<inter> extensional {..<DIM('a)}"
- hence "p2e x \<in> (\<Union>i. A i)" by auto
- hence "\<exists>n. x \<in> e2p ` A n" apply safe apply(rule_tac x=i in exI)
- unfolding image_iff apply(rule_tac x="p2e x" in bexI)
- apply(subst e2p_p2e) using x by auto
- thus "x \<in> (\<Union>n. e2p ` A n)" by auto
- qed
- qed
- qed auto
+ proof (rule fprod.measure_space_vimage)
+ show "sigma_algebra borel" by default
+ show "(p2e :: (nat \<Rightarrow> real) \<Rightarrow> 'a) \<in> measurable fprod.P borel" by (rule measurable_p2e)
+ fix A :: "'a set" assume "A \<in> sets borel"
+ show "fprod.measure (e2p ` A) = fprod.measure (p2e -` A \<inter> space fprod.P)"
+ by (simp add: e2p_image_vimage)
+ qed
qed
-lemma e2p_p2e'[simp]: fixes x::"'a::ordered_euclidean_space"
- assumes "A \<subseteq> extensional {..<DIM('a)}"
- shows "e2p ` (p2e ` A ::'a set) = A"
- apply(rule set_eqI) unfolding image_iff Bex_def apply safe defer
- apply(rule_tac x="p2e x" in exI,safe) using assms by auto
-
-lemma range_p2e:"range (p2e::_\<Rightarrow>'a::ordered_euclidean_space) = UNIV"
- apply safe defer unfolding image_iff apply(rule_tac x="\<lambda>i. x $$ i" in bexI)
- unfolding p2e_def by auto
-
-lemma p2e_inv_extensional:"(A::'a::ordered_euclidean_space set)
- = p2e ` (p2e -` A \<inter> extensional {..<DIM('a)})"
- unfolding p2e_def_raw apply safe unfolding image_iff
-proof- fix x assume "x\<in>A"
- let ?y = "\<lambda>i. if i<DIM('a) then x$$i else undefined"
- have *:"Chi ?y = x" apply(subst euclidean_eq) by auto
- show "\<exists>xa\<in>Chi -` A \<inter> extensional {..<DIM('a)}. x = Chi xa" apply(rule_tac x="?y" in bexI)
- apply(subst euclidean_eq) unfolding extensional_def using `x\<in>A` by(auto simp: *)
-qed
+lemma range_e2p:"range (e2p::'a::ordered_euclidean_space \<Rightarrow> _) = extensional {..<DIM('a)}"
+ unfolding e2p_def_raw
+ apply auto
+ by (rule_tac x="\<chi>\<chi> i. x i" in image_eqI) (auto simp: fun_eq_iff extensional_def)
lemma borel_fubini_positiv_integral:
fixes f :: "'a::ordered_euclidean_space \<Rightarrow> pextreal"
@@ -925,22 +900,27 @@
borel_product.product_positive_integral {..<DIM('a)} (f \<circ> p2e)"
proof- def U \<equiv> "extensional {..<DIM('a)} :: (nat \<Rightarrow> real) set"
interpret fprod: finite_product_sigma_finite "\<lambda>x. borel" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
- have *:"sigma_algebra.vimage_algebra borel U (p2e:: _ \<Rightarrow> 'a)
- = sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)})"
- unfolding U_def product_borel_eq_vimage[symmetric] ..
show ?thesis
- unfolding borel.positive_integral_vimage[unfolded space_borel, OF bij_inv_p2e_e2p[THEN bij_inv_bij_betw(1)]]
- apply(subst fprod.positive_integral_cong_measure[THEN sym, of "\<lambda>A. lmeasure (p2e ` A)"])
- unfolding U_def[symmetric] *[THEN sym] o_def
- proof- fix A assume A:"A \<in> sets (sigma_algebra.vimage_algebra borel U (p2e ::_ \<Rightarrow> 'a))"
- hence *:"A \<subseteq> extensional {..<DIM('a)}" unfolding U_def by auto
- from A guess B unfolding borel.in_vimage_algebra U_def ..
- then have "(p2e ` A::'a set) \<in> sets borel"
- by (simp add: p2e_inv_extensional[of B, symmetric])
- from lmeasure_measure_eq_borel_prod[OF this] show "lmeasure (p2e ` A::'a set) =
- finite_product_sigma_finite.measure (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} A"
- unfolding e2p_p2e'[OF *] .
- qed auto
+ proof (subst borel.positive_integral_vimage[symmetric, of _ "e2p :: 'a \<Rightarrow> _" "(\<lambda>x. f (p2e x))", unfolded p2e_e2p])
+ show "(e2p :: 'a \<Rightarrow> _) \<in> measurable borel fprod.P" by (rule measurable_e2p)
+ show "sigma_algebra fprod.P" by default
+ from measurable_comp[OF measurable_p2e f]
+ show "(\<lambda>x. f (p2e x)) \<in> borel_measurable fprod.P" by (simp add: comp_def)
+ let "?L A" = "lmeasure ((e2p::'a \<Rightarrow> (nat \<Rightarrow> real)) -` A \<inter> space borel)"
+ show "measure_space.positive_integral fprod.P ?L (\<lambda>x. f (p2e x)) =
+ fprod.positive_integral (f \<circ> p2e)"
+ unfolding comp_def
+ proof (rule fprod.positive_integral_cong_measure)
+ fix A :: "(nat \<Rightarrow> real) set" assume "A \<in> sets fprod.P"
+ then have A: "(e2p::'a \<Rightarrow> (nat \<Rightarrow> real)) -` A \<inter> space borel \<in> sets borel"
+ by (rule measurable_sets[OF measurable_e2p])
+ have [simp]: "A \<inter> extensional {..<DIM('a)} = A"
+ using `A \<in> sets fprod.P`[THEN fprod.sets_into_space] by auto
+ show "?L A = fprod.measure A"
+ unfolding lmeasure_measure_eq_borel_prod[OF A]
+ by (simp add: range_e2p)
+ qed
+ qed
qed
lemma borel_fubini:
--- a/src/HOL/Probability/Measure.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Measure.thy Mon Jan 31 11:18:29 2011 +0100
@@ -525,6 +525,15 @@
qed
qed
+lemma True
+proof
+ fix x a b :: nat
+ have "\<And>x a b :: int. x dvd a \<Longrightarrow> x dvd (a + b) \<Longrightarrow> x dvd b"
+ by (metis dvd_mult_div_cancel zadd_commute zdvd_reduce)
+ then have "x dvd a \<Longrightarrow> x dvd (a + b) \<Longrightarrow> x dvd b"
+ unfolding zdvd_int[of x] zadd_int[symmetric] .
+qed
+
lemma measure_unique_Int_stable:
fixes M E :: "'a algebra" and A :: "nat \<Rightarrow> 'a set"
assumes "Int_stable E" "M = sigma E"
@@ -608,45 +617,6 @@
ultimately show ?thesis by (simp add: isoton_def)
qed
-section "Isomorphisms between measure spaces"
-
-lemma (in measure_space) measure_space_isomorphic:
- fixes f :: "'c \<Rightarrow> 'a"
- assumes "bij_betw f S (space M)"
- shows "measure_space (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A))"
- (is "measure_space ?T ?\<mu>")
-proof -
- have "f \<in> S \<rightarrow> space M" using assms unfolding bij_betw_def by auto
- then interpret T: sigma_algebra ?T by (rule sigma_algebra_vimage)
- show ?thesis
- proof
- show "\<mu> (f`{}) = 0" by simp
- show "countably_additive ?T (\<lambda>A. \<mu> (f ` A))"
- proof (unfold countably_additive_def, intro allI impI)
- fix A :: "nat \<Rightarrow> 'c set" assume "range A \<subseteq> sets ?T" "disjoint_family A"
- then have "\<forall>i. \<exists>F'. F' \<in> sets M \<and> A i = f -` F' \<inter> S"
- by (auto simp: image_iff image_subset_iff Bex_def vimage_algebra_def)
- from choice[OF this] obtain F where F: "\<And>i. F i \<in> sets M" and A: "\<And>i. A i = f -` F i \<inter> S" by auto
- then have [simp]: "\<And>i. f ` (A i) = F i"
- using sets_into_space assms
- by (force intro!: image_vimage_inter_eq[where T="space M"] simp: bij_betw_def)
- have "disjoint_family F"
- proof (intro disjoint_family_on_bisimulation[OF `disjoint_family A`])
- fix n m assume "A n \<inter> A m = {}"
- then have "f -` (F n \<inter> F m) \<inter> S = {}" unfolding A by auto
- moreover
- have "F n \<in> sets M" "F m \<in> sets M" using F by auto
- then have "f`S = space M" "F n \<inter> F m \<subseteq> space M"
- using sets_into_space assms by (auto simp: bij_betw_def)
- note image_vimage_inter_eq[OF this, symmetric]
- ultimately show "F n \<inter> F m = {}" by simp
- qed
- with F show "(\<Sum>\<^isub>\<infinity> i. \<mu> (f ` A i)) = \<mu> (f ` (\<Union>i. A i))"
- by (auto simp add: image_UN intro!: measure_countably_additive)
- qed
- qed
-qed
-
section "@{text \<mu>}-null sets"
abbreviation (in measure_space) "null_sets \<equiv> {N\<in>sets M. \<mu> N = 0}"
@@ -803,23 +773,17 @@
lemma (in measure_space) AE_conjI:
assumes AE_P: "AE x. P x" and AE_Q: "AE x. Q x"
shows "AE x. P x \<and> Q x"
-proof -
- from AE_P obtain A where P: "{x\<in>space M. \<not> P x} \<subseteq> A"
- and A: "A \<in> sets M" "\<mu> A = 0"
- by (auto elim!: AE_E)
-
- from AE_Q obtain B where Q: "{x\<in>space M. \<not> Q x} \<subseteq> B"
- and B: "B \<in> sets M" "\<mu> B = 0"
- by (auto elim!: AE_E)
+ apply (rule AE_mp[OF AE_P])
+ apply (rule AE_mp[OF AE_Q])
+ by simp
- show ?thesis
- proof (intro AE_I)
- show "A \<union> B \<in> sets M" "\<mu> (A \<union> B) = 0" using A B
- using measure_subadditive[of A B] by auto
- show "{x\<in>space M. \<not> (P x \<and> Q x)} \<subseteq> A \<union> B"
- using P Q by auto
- qed
-qed
+lemma (in measure_space) AE_conj_iff[simp]:
+ shows "(AE x. P x \<and> Q x) \<longleftrightarrow> (AE x. P x) \<and> (AE x. Q x)"
+proof (intro conjI iffI AE_conjI)
+ assume *: "AE x. P x \<and> Q x"
+ from * show "AE x. P x" by (rule AE_mp) auto
+ from * show "AE x. Q x" by (rule AE_mp) auto
+qed auto
lemma (in measure_space) AE_E2:
assumes "AE x. P x" "{x\<in>space M. P x} \<in> sets M"
@@ -845,14 +809,6 @@
by (rule AE_mp[OF AE_space]) auto
qed
-lemma (in measure_space) AE_conj_iff[simp]:
- shows "(AE x. P x \<and> Q x) \<longleftrightarrow> (AE x. P x) \<and> (AE x. Q x)"
-proof (intro conjI iffI AE_conjI)
- assume *: "AE x. P x \<and> Q x"
- from * show "AE x. P x" by (rule AE_mp) auto
- from * show "AE x. Q x" by (rule AE_mp) auto
-qed auto
-
lemma (in measure_space) all_AE_countable:
"(\<forall>i::'i::countable. AE x. P i x) \<longleftrightarrow> (AE x. \<forall>i. P i x)"
proof
@@ -893,27 +849,28 @@
lemma (in measure_space) measure_space_vimage:
fixes M' :: "'b algebra"
- assumes "f \<in> measurable M M'"
- and "sigma_algebra M'"
- shows "measure_space M' (\<lambda>A. \<mu> (f -` A \<inter> space M))" (is "measure_space M' ?T")
+ assumes T: "sigma_algebra M'" "T \<in> measurable M M'"
+ and \<nu>: "\<And>A. A \<in> sets M' \<Longrightarrow> \<nu> A = \<mu> (T -` A \<inter> space M)"
+ shows "measure_space M' \<nu>"
proof -
interpret M': sigma_algebra M' by fact
-
show ?thesis
proof
- show "?T {} = 0" by simp
+ show "\<nu> {} = 0" using \<nu>[of "{}"] by simp
- show "countably_additive M' ?T"
- proof (unfold countably_additive_def, safe)
+ show "countably_additive M' \<nu>"
+ proof (intro countably_additive_def[THEN iffD2] allI impI)
fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets M'" "disjoint_family A"
- hence *: "\<And>i. f -` (A i) \<inter> space M \<in> sets M"
- using `f \<in> measurable M M'` by (auto simp: measurable_def)
- moreover have "(\<Union>i. f -` A i \<inter> space M) \<in> sets M"
+ then have A: "\<And>i. A i \<in> sets M'" "(\<Union>i. A i) \<in> sets M'" by auto
+ then have *: "range (\<lambda>i. T -` (A i) \<inter> space M) \<subseteq> sets M"
+ using `T \<in> measurable M M'` by (auto simp: measurable_def)
+ moreover have "(\<Union>i. T -` A i \<inter> space M) \<in> sets M"
using * by blast
- moreover have **: "disjoint_family (\<lambda>i. f -` A i \<inter> space M)"
+ moreover have **: "disjoint_family (\<lambda>i. T -` A i \<inter> space M)"
using `disjoint_family A` by (auto simp: disjoint_family_on_def)
- ultimately show "(\<Sum>\<^isub>\<infinity> i. ?T (A i)) = ?T (\<Union>i. A i)"
- using measure_countably_additive[OF _ **] by (auto simp: comp_def vimage_UN)
+ ultimately show "(\<Sum>\<^isub>\<infinity> i. \<nu> (A i)) = \<nu> (\<Union>i. A i)"
+ using measure_countably_additive[OF _ **] A
+ by (auto simp: comp_def vimage_UN \<nu>)
qed
qed
qed
@@ -1020,29 +977,6 @@
qed force+
qed
-lemma (in sigma_finite_measure) sigma_finite_measure_isomorphic:
- assumes f: "bij_betw f S (space M)"
- shows "sigma_finite_measure (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A))"
-proof -
- interpret M: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
- using f by (rule measure_space_isomorphic)
- show ?thesis
- proof default
- from sigma_finite guess A::"nat \<Rightarrow> 'a set" .. note A = this
- show "\<exists>A::nat\<Rightarrow>'b set. range A \<subseteq> sets (vimage_algebra S f) \<and> (\<Union>i. A i) = space (vimage_algebra S f) \<and> (\<forall>i. \<mu> (f ` A i) \<noteq> \<omega>)"
- proof (intro exI conjI)
- show "(\<Union>i::nat. f -` A i \<inter> S) = space (vimage_algebra S f)"
- using A f[THEN bij_betw_imp_funcset] by (auto simp: vimage_UN[symmetric])
- show "range (\<lambda>i. f -` A i \<inter> S) \<subseteq> sets (vimage_algebra S f)"
- using A by (auto simp: vimage_algebra_def)
- have "\<And>i. f ` (f -` A i \<inter> S) = A i"
- using f A sets_into_space
- by (intro image_vimage_inter_eq) (auto simp: bij_betw_def)
- then show "\<forall>i. \<mu> (f ` (f -` A i \<inter> S)) \<noteq> \<omega>" using A by simp
- qed
- qed
-qed
-
section "Real measure values"
lemma (in measure_space) real_measure_Union:
--- a/src/HOL/Probability/Probability_Space.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Probability_Space.thy Mon Jan 31 11:18:29 2011 +0100
@@ -195,8 +195,8 @@
assumes "random_variable S X"
shows "prob_space S (distribution X)"
proof -
- interpret S: measure_space S "distribution X"
- using measure_space_vimage[of X S] assms unfolding distribution_def by simp
+ interpret S: measure_space S "distribution X" unfolding distribution_def
+ using assms by (intro measure_space_vimage) auto
show ?thesis
proof
have "X -` space S \<inter> space M = space M"
--- a/src/HOL/Probability/Product_Measure.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Product_Measure.thy Mon Jan 31 11:18:29 2011 +0100
@@ -523,22 +523,6 @@
unfolding * by (rule measurable_comp)
qed
-lemma (in pair_sigma_algebra) pair_sigma_algebra_swap:
- "sigma (pair_algebra M2 M1) = (vimage_algebra (space M2 \<times> space M1) (\<lambda>(x, y). (y, x)))"
- unfolding vimage_algebra_def
- apply (simp add: sets_sigma)
- apply (subst sigma_sets_vimage[symmetric])
- apply (fastsimp simp: pair_algebra_def)
- using M1.sets_into_space M2.sets_into_space apply (fastsimp simp: pair_algebra_def)
-proof -
- have "(\<lambda>X. (\<lambda>(x, y). (y, x)) -` X \<inter> space M2 \<times> space M1) ` sets E
- = sets (pair_algebra M2 M1)" (is "?S = _")
- by (rule pair_algebra_swap)
- then show "sigma (pair_algebra M2 M1) = \<lparr>space = space M2 \<times> space M1,
- sets = sigma_sets (space M2 \<times> space M1) ?S\<rparr>"
- by (simp add: pair_algebra_def sigma_def)
-qed
-
definition (in pair_sigma_finite)
"pair_measure A = M1.positive_integral (\<lambda>x.
M2.positive_integral (\<lambda>y. indicator A (x, y)))"
@@ -644,6 +628,17 @@
qed
qed
+lemma (in pair_sigma_algebra) sets_swap:
+ assumes "A \<in> sets P"
+ shows "(\<lambda>(x, y). (y, x)) -` A \<inter> space (sigma (pair_algebra M2 M1)) \<in> sets (sigma (pair_algebra M2 M1))"
+ (is "_ -` A \<inter> space ?Q \<in> sets ?Q")
+proof -
+ have *: "(\<lambda>(x, y). (y, x)) -` A \<inter> space ?Q = (\<lambda>(x, y). (y, x)) ` A"
+ using `A \<in> sets P` sets_into_space by (auto simp: space_pair_algebra)
+ show ?thesis
+ unfolding * using assms by (rule sets_pair_sigma_algebra_swap)
+qed
+
lemma (in pair_sigma_finite) pair_measure_alt2:
assumes "A \<in> sets P"
shows "pair_measure A = M2.positive_integral (\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` A))"
@@ -656,29 +651,20 @@
show "range F \<subseteq> sets E" "F \<up> space E" "\<And>i. pair_measure (F i) \<noteq> \<omega>"
using F by auto
show "measure_space P pair_measure" by default
- next
+ interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ have P: "sigma_algebra P" by default
show "measure_space P ?\<nu>"
- proof
- show "?\<nu> {} = 0" by auto
- show "countably_additive P ?\<nu>"
- unfolding countably_additive_def
- proof (intro allI impI)
- fix F :: "nat \<Rightarrow> ('a \<times> 'b) set"
- assume F: "range F \<subseteq> sets P" "disjoint_family F"
- from F have *: "\<And>i. F i \<in> sets P" "(\<Union>i. F i) \<in> sets P" by auto
- moreover from F have "\<And>i. (\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` F i)) \<in> borel_measurable M2"
- by (intro measure_cut_measurable_snd) auto
- moreover have "\<And>y. disjoint_family (\<lambda>i. (\<lambda>x. (x, y)) -` F i)"
- by (intro disjoint_family_on_bisimulation[OF F(2)]) auto
- moreover have "\<And>y. y \<in> space M2 \<Longrightarrow> range (\<lambda>i. (\<lambda>x. (x, y)) -` F i) \<subseteq> sets M1"
- using F by (auto intro!: measurable_cut_snd)
- ultimately show "(\<Sum>\<^isub>\<infinity>n. ?\<nu> (F n)) = ?\<nu> (\<Union>i. F i)"
- by (simp add: vimage_UN M2.positive_integral_psuminf[symmetric]
- M1.measure_countably_additive
- cong: M2.positive_integral_cong)
- qed
+ apply (rule Q.measure_space_vimage[OF P])
+ apply (rule Q.pair_sigma_algebra_swap_measurable)
+ proof -
+ fix A assume "A \<in> sets P"
+ from sets_swap[OF this]
+ show "M2.positive_integral (\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` A)) =
+ Q.pair_measure ((\<lambda>(x, y). (y, x)) -` A \<inter> space Q.P)"
+ using sets_into_space[OF `A \<in> sets P`]
+ by (auto simp add: Q.pair_measure_alt space_pair_algebra
+ intro!: M2.positive_integral_cong arg_cong[where f=\<mu>1])
qed
- next
fix X assume "X \<in> sets E"
then obtain A B where X: "X = A \<times> B" and AB: "A \<in> sets M1" "B \<in> sets M2"
unfolding pair_algebra_def by auto
@@ -802,31 +788,40 @@
unfolding F_SUPR by simp
qed
+lemma (in pair_sigma_finite) positive_integral_product_swap:
+ assumes f: "f \<in> borel_measurable P"
+ shows "measure_space.positive_integral
+ (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x))) =
+ positive_integral f"
+proof -
+ interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ have P: "sigma_algebra P" by default
+ show ?thesis
+ unfolding Q.positive_integral_vimage[OF P Q.pair_sigma_algebra_swap_measurable f, symmetric]
+ proof (rule positive_integral_cong_measure)
+ fix A
+ assume A: "A \<in> sets P"
+ from Q.pair_sigma_algebra_swap_measurable[THEN measurable_sets, OF this] this sets_into_space[OF this]
+ show "Q.pair_measure ((\<lambda>(x, y). (y, x)) -` A \<inter> space Q.P) = pair_measure A"
+ by (auto intro!: M1.positive_integral_cong arg_cong[where f=\<mu>2]
+ simp: pair_measure_alt Q.pair_measure_alt2 space_pair_algebra)
+ qed
+qed
+
lemma (in pair_sigma_finite) positive_integral_snd_measurable:
assumes f: "f \<in> borel_measurable P"
shows "M2.positive_integral (\<lambda>y. M1.positive_integral (\<lambda>x. f (x, y))) =
positive_integral f"
proof -
interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
- have s: "\<And>x y. (case (x, y) of (x, y) \<Rightarrow> f (y, x)) = f (y, x)" by simp
- have t: "(\<lambda>x. f (case x of (x, y) \<Rightarrow> (y, x))) = (\<lambda>(x, y). f (y, x))" by (auto simp: fun_eq_iff)
- have bij: "bij_betw (\<lambda>(x, y). (y, x)) (space M2 \<times> space M1) (space P)"
- by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
note pair_sigma_algebra_measurable[OF f]
from Q.positive_integral_fst_measurable[OF this]
have "M2.positive_integral (\<lambda>y. M1.positive_integral (\<lambda>x. f (x, y))) =
Q.positive_integral (\<lambda>(x, y). f (y, x))"
by simp
- also have "\<dots> = positive_integral f"
- unfolding positive_integral_vimage[OF bij, of f] t
- unfolding pair_sigma_algebra_swap[symmetric]
- proof (rule Q.positive_integral_cong_measure[symmetric])
- fix A assume "A \<in> sets Q.P"
- from this Q.sets_pair_sigma_algebra_swap[OF this]
- show "pair_measure ((\<lambda>(x, y). (y, x)) ` A) = Q.pair_measure A"
- by (auto intro!: M1.positive_integral_cong arg_cong[where f=\<mu>2]
- simp: pair_measure_alt Q.pair_measure_alt2)
- qed
+ also have "Q.positive_integral (\<lambda>(x, y). f (y, x)) = positive_integral f"
+ unfolding positive_integral_product_swap[OF f, symmetric]
+ by (auto intro!: Q.positive_integral_cong)
finally show ?thesis .
qed
@@ -863,28 +858,6 @@
qed
qed
-lemma (in pair_sigma_finite) positive_integral_product_swap:
- "measure_space.positive_integral
- (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) f =
- positive_integral (\<lambda>(x,y). f (y,x))"
-proof -
- interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
- have t: "(\<lambda>y. case case y of (y, x) \<Rightarrow> (x, y) of (x, y) \<Rightarrow> f (y, x)) = f"
- by (auto simp: fun_eq_iff)
- have bij: "bij_betw (\<lambda>(x, y). (y, x)) (space M2 \<times> space M1) (space P)"
- by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
- show ?thesis
- unfolding positive_integral_vimage[OF bij, of "\<lambda>(y,x). f (x,y)"]
- unfolding pair_sigma_algebra_swap[symmetric] t
- proof (rule Q.positive_integral_cong_measure[symmetric])
- fix A assume "A \<in> sets Q.P"
- from this Q.sets_pair_sigma_algebra_swap[OF this]
- show "pair_measure ((\<lambda>(x, y). (y, x)) ` A) = Q.pair_measure A"
- by (auto intro!: M1.positive_integral_cong arg_cong[where f=\<mu>2]
- simp: pair_measure_alt Q.pair_measure_alt2)
- qed
-qed
-
lemma (in pair_sigma_algebra) measurable_product_swap:
"f \<in> measurable (sigma (pair_algebra M2 M1)) M \<longleftrightarrow> (\<lambda>(x,y). f (y,x)) \<in> measurable P M"
proof -
@@ -895,27 +868,42 @@
qed
lemma (in pair_sigma_finite) integrable_product_swap:
- "measure_space.integrable
- (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) f \<longleftrightarrow>
- integrable (\<lambda>(x,y). f (y,x))"
+ assumes "integrable f"
+ shows "measure_space.integrable
+ (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) (\<lambda>(x,y). f (y,x))"
proof -
interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
- show ?thesis
- unfolding Q.integrable_def integrable_def
- unfolding positive_integral_product_swap
- unfolding measurable_product_swap
- by (simp add: case_prod_distrib)
+ have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
+ show ?thesis unfolding *
+ using assms unfolding Q.integrable_def integrable_def
+ apply (subst (1 2) positive_integral_product_swap)
+ using `integrable f` unfolding integrable_def
+ by (auto simp: *[symmetric] Q.measurable_product_swap[symmetric])
+qed
+
+lemma (in pair_sigma_finite) integrable_product_swap_iff:
+ "measure_space.integrable
+ (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) (\<lambda>(x,y). f (y,x)) \<longleftrightarrow>
+ integrable f"
+proof -
+ interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ from Q.integrable_product_swap[of "\<lambda>(x,y). f (y,x)"] integrable_product_swap[of f]
+ show ?thesis by auto
qed
lemma (in pair_sigma_finite) integral_product_swap:
- "measure_space.integral
- (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) f =
- integral (\<lambda>(x,y). f (y,x))"
+ assumes "integrable f"
+ shows "measure_space.integral
+ (sigma (pair_algebra M2 M1)) (pair_sigma_finite.pair_measure M2 \<mu>2 M1 \<mu>1) (\<lambda>(x,y). f (y,x)) =
+ integral f"
proof -
interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
show ?thesis
- unfolding integral_def Q.integral_def positive_integral_product_swap
- by (simp add: case_prod_distrib)
+ unfolding integral_def Q.integral_def *
+ apply (subst (1 2) positive_integral_product_swap)
+ using `integrable f` unfolding integrable_def
+ by (auto simp: *[symmetric] Q.measurable_product_swap[symmetric])
qed
lemma (in pair_sigma_finite) integrable_fst_measurable:
@@ -988,10 +976,10 @@
proof -
interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
have Q_int: "Q.integrable (\<lambda>(x, y). f (y, x))"
- using f unfolding integrable_product_swap by simp
+ using f unfolding integrable_product_swap_iff .
show ?INT
using Q.integrable_fst_measurable(2)[OF Q_int]
- unfolding integral_product_swap by simp
+ using integral_product_swap[OF f] by simp
show ?AE
using Q.integrable_fst_measurable(1)[OF Q_int]
by simp
@@ -1355,18 +1343,6 @@
pair_algebra_sets_into_space product_algebra_sets_into_space)
auto
-lemma (in product_sigma_algebra) product_product_vimage_algebra:
- assumes [simp]: "I \<inter> J = {}"
- shows "sigma_algebra.vimage_algebra
- (sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J))))
- (space (sigma (product_algebra M (I \<union> J)))) (\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))) =
- sigma (product_algebra M (I \<union> J))"
- unfolding sigma_pair_algebra_sigma_eq using sets_into_space
- by (intro vimage_algebra_sigma[OF bij_inv_restrict_merge]
- pair_algebra_sets_into_space product_algebra_sets_into_space
- measurable_merge_on_generating measurable_restrict_on_generating)
- auto
-
lemma (in product_sigma_algebra) pair_product_product_vimage_algebra:
assumes [simp]: "I \<inter> J = {}"
shows "sigma_algebra.vimage_algebra (sigma (product_algebra M (I \<union> J)))
@@ -1378,24 +1354,6 @@
measurable_merge_on_generating measurable_restrict_on_generating)
auto
-lemma (in product_sigma_algebra) pair_product_singleton_vimage_algebra:
- assumes [simp]: "i \<notin> I"
- shows "sigma_algebra.vimage_algebra (sigma (pair_algebra (sigma (product_algebra M I)) (M i)))
- (space (sigma (product_algebra M (insert i I)))) (\<lambda>x. (restrict x I, x i)) =
- (sigma (product_algebra M (insert i I)))"
- unfolding sigma_pair_algebra_product_singleton using sets_into_space
- by (intro vimage_algebra_sigma[OF bij_inv_restrict_insert]
- pair_algebra_sets_into_space product_algebra_sets_into_space
- measurable_merge_singleton_on_generating measurable_restrict_singleton_on_generating)
- auto
-
-lemma (in product_sigma_algebra) singleton_vimage_algebra:
- "sigma_algebra.vimage_algebra (sigma (product_algebra M {i})) (space (M i)) (\<lambda>x. \<lambda>j\<in>{i}. x) = M i"
- using sets_into_space
- by (intro vimage_algebra_sigma[of "M i", unfolded M.sigma_eq, OF bij_inv_singleton[symmetric]]
- product_algebra_sets_into_space measurable_singleton_on_generator measurable_component_on_generator)
- auto
-
lemma (in product_sigma_algebra) measurable_restrict_iff:
assumes IJ[simp]: "I \<inter> J = {}"
shows "f \<in> measurable (sigma (pair_algebra
@@ -1430,6 +1388,13 @@
then show "?f \<in> measurable ?P M'" by (simp add: comp_def)
qed
+lemma (in product_sigma_algebra) singleton_vimage_algebra:
+ "sigma_algebra.vimage_algebra (sigma (product_algebra M {i})) (space (M i)) (\<lambda>x. \<lambda>j\<in>{i}. x) = M i"
+ using sets_into_space
+ by (intro vimage_algebra_sigma[of "M i", unfolded M.sigma_eq, OF bij_inv_singleton[symmetric]]
+ product_algebra_sets_into_space measurable_singleton_on_generator measurable_component_on_generator)
+ auto
+
lemma (in product_sigma_algebra) measurable_component_singleton:
"(\<lambda>x. f (x i)) \<in> measurable (sigma (product_algebra M {i})) M' \<longleftrightarrow>
f \<in> measurable (M i) M'"
@@ -1479,6 +1444,55 @@
using sets_into_space unfolding measurable_component_singleton[symmetric]
by (auto intro!: measurable_cong arg_cong[where f=f] simp: fun_eq_iff extensional_def)
+
+lemma (in pair_sigma_algebra) measurable_pair_split:
+ assumes "sigma_algebra M1'" "sigma_algebra M2'"
+ assumes f: "f \<in> measurable M1 M1'" and g: "g \<in> measurable M2 M2'"
+ shows "(\<lambda>(x, y). (f x, g y)) \<in> measurable P (sigma (pair_algebra M1' M2'))"
+proof (rule measurable_sigma)
+ interpret M1': sigma_algebra M1' by fact
+ interpret M2': sigma_algebra M2' by fact
+ interpret Q: pair_sigma_algebra M1' M2' by default
+ show "sets Q.E \<subseteq> Pow (space Q.E)"
+ using M1'.sets_into_space M2'.sets_into_space by (auto simp: pair_algebra_def)
+ show "(\<lambda>(x, y). (f x, g y)) \<in> space P \<rightarrow> space Q.E"
+ using f g unfolding measurable_def pair_algebra_def by auto
+ fix A assume "A \<in> sets Q.E"
+ then obtain X Y where A: "A = X \<times> Y" "X \<in> sets M1'" "Y \<in> sets M2'"
+ unfolding pair_algebra_def by auto
+ then have *: "(\<lambda>(x, y). (f x, g y)) -` A \<inter> space P =
+ (f -` X \<inter> space M1) \<times> (g -` Y \<inter> space M2)"
+ by (auto simp: pair_algebra_def)
+ then show "(\<lambda>(x, y). (f x, g y)) -` A \<inter> space P \<in> sets P"
+ using f g A unfolding measurable_def *
+ by (auto intro!: pair_algebraI in_sigma)
+qed
+
+lemma (in product_sigma_algebra) measurable_add_dim:
+ assumes "i \<notin> I" "finite I"
+ shows "(\<lambda>(f, y). f(i := y)) \<in> measurable (sigma (pair_algebra (sigma (product_algebra M I)) (M i)))
+ (sigma (product_algebra M (insert i I)))"
+proof (subst measurable_cong)
+ interpret I: finite_product_sigma_algebra M I by default fact
+ interpret i: finite_product_sigma_algebra M "{i}" by default auto
+ interpret Ii: pair_sigma_algebra I.P "M i" by default
+ interpret Ii': pair_sigma_algebra I.P i.P by default
+ have disj: "I \<inter> {i} = {}" using `i \<notin> I` by auto
+ have "(\<lambda>(x, y). (id x, \<lambda>_\<in>{i}. y)) \<in> measurable Ii.P Ii'.P"
+ proof (intro Ii.measurable_pair_split I.measurable_ident)
+ show "(\<lambda>y. \<lambda>_\<in>{i}. y) \<in> measurable (M i) i.P"
+ apply (rule measurable_singleton[THEN iffD1])
+ using i.measurable_ident unfolding id_def .
+ qed default
+ from measurable_comp[OF this measurable_merge[OF disj]]
+ show "(\<lambda>(x, y). merge I x {i} y) \<circ> (\<lambda>(x, y). (id x, \<lambda>_\<in>{i}. y))
+ \<in> measurable (sigma (pair_algebra I.P (M i))) (sigma (product_algebra M (insert i I)))"
+ (is "?f \<in> _") by simp
+ fix x assume "x \<in> space Ii.P"
+ with assms show "(\<lambda>(f, y). f(i := y)) x = ?f x"
+ by (cases x) (simp add: merge_def fun_eq_iff pair_algebra_def extensional_def)
+qed
+
locale product_sigma_finite =
fixes M :: "'i \<Rightarrow> 'a algebra" and \<mu> :: "'i \<Rightarrow> 'a set \<Rightarrow> pextreal"
assumes sigma_finite_measures: "\<And>i. sigma_finite_measure (M i) (\<mu> i)"
@@ -1549,29 +1563,24 @@
interpret I: sigma_finite_measure P \<nu> by fact
interpret P: pair_sigma_finite P \<nu> "M i" "\<mu> i" ..
- let ?h = "\<lambda>x. (restrict x I, x i)"
- let ?\<nu> = "\<lambda>A. P.pair_measure (?h ` A)"
+ let ?h = "(\<lambda>(f, y). f(i := y))"
+ let ?\<nu> = "\<lambda>A. P.pair_measure (?h -` A \<inter> space P.P)"
+ have I': "sigma_algebra I'.P" by default
interpret I': measure_space "sigma (product_algebra M (insert i I))" ?\<nu>
- apply (subst pair_product_singleton_vimage_algebra[OF `i \<notin> I`, symmetric])
- apply (intro P.measure_space_isomorphic bij_inv_bij_betw)
- unfolding sigma_pair_algebra_product_singleton
- by (rule bij_inv_restrict_insert[OF `i \<notin> I`])
+ apply (rule P.measure_space_vimage[OF I'])
+ apply (rule measurable_add_dim[OF `i \<notin> I` `finite I`])
+ by simp
show ?case
proof (intro exI[of _ ?\<nu>] conjI ballI)
{ fix A assume A: "A \<in> (\<Pi> i\<in>insert i I. sets (M i))"
- moreover then have "A \<in> (\<Pi> i\<in>I. sets (M i))" by auto
- moreover have "(\<lambda>x. (restrict x I, x i)) ` Pi\<^isub>E (insert i I) A = Pi\<^isub>E I A \<times> A i"
- using `i \<notin> I`
- apply auto
- apply (rule_tac x="a(i:=b)" in image_eqI)
- apply (auto simp: extensional_def fun_eq_iff)
- done
- ultimately show "?\<nu> (Pi\<^isub>E (insert i I) A) = (\<Prod>i\<in>insert i I. \<mu> i (A i))"
- apply simp
+ then have *: "?h -` Pi\<^isub>E (insert i I) A \<inter> space P.P = Pi\<^isub>E I A \<times> A i"
+ using `i \<notin> I` M.sets_into_space by (auto simp: pair_algebra_def) blast
+ show "?\<nu> (Pi\<^isub>E (insert i I) A) = (\<Prod>i\<in>insert i I. \<mu> i (A i))"
+ unfolding * using A
apply (subst P.pair_measure_times)
- apply fastsimp
- apply fastsimp
- using `i \<notin> I` `finite I` prod[of A] by (auto simp: ac_simps) }
+ using A apply fastsimp
+ using A apply fastsimp
+ using `i \<notin> I` `finite I` prod[of A] A by (auto simp: ac_simps) }
note product = this
show "sigma_finite_measure I'.P ?\<nu>"
proof
@@ -1671,7 +1680,7 @@
shows "pair_sigma_finite.pair_measure
(sigma (product_algebra M I)) (product_measure I)
(sigma (product_algebra M J)) (product_measure J)
- ((\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))) ` A) =
+ ((\<lambda>(x,y). merge I x J y) -` A \<inter> space (sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J))))) =
product_measure (I \<union> J) A"
proof -
interpret I: finite_product_sigma_finite M \<mu> I by default fact
@@ -1679,51 +1688,52 @@
have "finite (I \<union> J)" using fin by auto
interpret IJ: finite_product_sigma_finite M \<mu> "I \<union> J" by default fact
interpret P: pair_sigma_finite I.P I.measure J.P J.measure by default
- let ?f = "\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))"
- from IJ.sigma_finite_pairs obtain F where
- F: "\<And>i. i\<in> I \<union> J \<Longrightarrow> range (F i) \<subseteq> sets (M i)"
- "(\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k) \<up> space IJ.G"
- "\<And>k. \<forall>i\<in>I\<union>J. \<mu> i (F i k) \<noteq> \<omega>"
- by auto
- let ?F = "\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k"
- have split_f_image[simp]: "\<And>F. ?f ` (Pi\<^isub>E (I \<union> J) F) = (Pi\<^isub>E I F) \<times> (Pi\<^isub>E J F)"
- apply auto apply (rule_tac x="merge I a J b" in image_eqI)
- by (auto dest: extensional_restrict)
- show "P.pair_measure (?f ` A) = IJ.measure A"
+ let ?g = "\<lambda>(x,y). merge I x J y"
+ let "?X S" = "?g -` S \<inter> space P.P"
+ from IJ.sigma_finite_pairs obtain F where
+ F: "\<And>i. i\<in> I \<union> J \<Longrightarrow> range (F i) \<subseteq> sets (M i)"
+ "(\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k) \<up> space IJ.G"
+ "\<And>k. \<forall>i\<in>I\<union>J. \<mu> i (F i k) \<noteq> \<omega>"
+ by auto
+ let ?F = "\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k"
+ show "P.pair_measure (?X A) = IJ.measure A"
proof (rule measure_unique_Int_stable[OF _ _ _ _ _ _ _ _ A])
- show "Int_stable IJ.G" by (simp add: PiE_Int Int_stable_def product_algebra_def) auto
- show "range ?F \<subseteq> sets IJ.G" using F by (simp add: image_subset_iff product_algebra_def)
- show "?F \<up> space IJ.G " using F(2) by simp
- show "measure_space IJ.P (\<lambda>A. P.pair_measure (?f ` A))"
- apply (subst product_product_vimage_algebra[OF IJ, symmetric])
- apply (intro P.measure_space_isomorphic bij_inv_bij_betw)
- unfolding sigma_pair_algebra_sigma_eq
- by (rule bij_inv_restrict_merge[OF `I \<inter> J = {}`])
- show "measure_space IJ.P IJ.measure" by fact
- next
- fix A assume "A \<in> sets IJ.G"
- then obtain F where A[simp]: "A = Pi\<^isub>E (I \<union> J) F" "F \<in> (\<Pi> i\<in>I \<union> J. sets (M i))"
- by (auto simp: product_algebra_def)
- then have F: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets (M i)" "\<And>i. i \<in> J \<Longrightarrow> F i \<in> sets (M i)"
- by auto
- have "P.pair_measure (?f ` A) = (\<Prod>i\<in>I. \<mu> i (F i)) * (\<Prod>i\<in>J. \<mu> i (F i))"
- using `finite J` `finite I` F
- by (simp add: P.pair_measure_times I.measure_times J.measure_times)
- also have "\<dots> = (\<Prod>i\<in>I \<union> J. \<mu> i (F i))"
- using `finite J` `finite I` `I \<inter> J = {}` by (simp add: setprod_Un_one)
- also have "\<dots> = IJ.measure A"
- using `finite J` `finite I` F unfolding A
- by (intro IJ.measure_times[symmetric]) auto
- finally show "P.pair_measure (?f ` A) = IJ.measure A" .
- next
- fix k
- have "\<And>i. i \<in> I \<union> J \<Longrightarrow> F i k \<in> sets (M i)" using F by auto
- then have "P.pair_measure (?f ` ?F k) = (\<Prod>i\<in>I. \<mu> i (F i k)) * (\<Prod>i\<in>J. \<mu> i (F i k))"
- by (simp add: P.pair_measure_times I.measure_times J.measure_times)
- then show "P.pair_measure (?f ` ?F k) \<noteq> \<omega>"
- using `finite I` F by (simp add: setprod_\<omega>)
- qed simp
- qed
+ show "Int_stable IJ.G" by (simp add: PiE_Int Int_stable_def product_algebra_def) auto
+ show "range ?F \<subseteq> sets IJ.G" using F by (simp add: image_subset_iff product_algebra_def)
+ show "?F \<up> space IJ.G " using F(2) by simp
+ have "sigma_algebra IJ.P" by default
+ then show "measure_space IJ.P (\<lambda>A. P.pair_measure (?X A))"
+ apply (rule P.measure_space_vimage)
+ apply (rule measurable_merge[OF `I \<inter> J = {}`])
+ by simp
+ show "measure_space IJ.P IJ.measure" by fact
+ next
+ fix A assume "A \<in> sets IJ.G"
+ then obtain F where A[simp]: "A = Pi\<^isub>E (I \<union> J) F"
+ and F: "\<And>i. i \<in> I \<union> J \<Longrightarrow> F i \<in> sets (M i)"
+ by (auto simp: product_algebra_def)
+ then have "?X A = (Pi\<^isub>E I F \<times> Pi\<^isub>E J F)"
+ using sets_into_space by (auto simp: space_pair_algebra) blast+
+ then have "P.pair_measure (?X A) = (\<Prod>i\<in>I. \<mu> i (F i)) * (\<Prod>i\<in>J. \<mu> i (F i))"
+ using `finite J` `finite I` F
+ by (simp add: P.pair_measure_times I.measure_times J.measure_times)
+ also have "\<dots> = (\<Prod>i\<in>I \<union> J. \<mu> i (F i))"
+ using `finite J` `finite I` `I \<inter> J = {}` by (simp add: setprod_Un_one)
+ also have "\<dots> = IJ.measure A"
+ using `finite J` `finite I` F unfolding A
+ by (intro IJ.measure_times[symmetric]) auto
+ finally show "P.pair_measure (?X A) = IJ.measure A" .
+ next
+ fix k
+ have k: "\<And>i. i \<in> I \<union> J \<Longrightarrow> F i k \<in> sets (M i)" using F by auto
+ then have "?X (?F k) = (\<Pi>\<^isub>E i\<in>I. F i k) \<times> (\<Pi>\<^isub>E i\<in>J. F i k)"
+ using sets_into_space by (auto simp: space_pair_algebra) blast+
+ with k have "P.pair_measure (?X (?F k)) = (\<Prod>i\<in>I. \<mu> i (F i k)) * (\<Prod>i\<in>J. \<mu> i (F i k))"
+ by (simp add: P.pair_measure_times I.measure_times J.measure_times)
+ then show "P.pair_measure (?X (?F k)) \<noteq> \<omega>"
+ using `finite I` F by (simp add: setprod_\<omega>)
+ qed simp
+qed
lemma (in product_sigma_finite) product_positive_integral_fold:
assumes IJ[simp]: "I \<inter> J = {}" and fin: "finite I" "finite J"
@@ -1736,23 +1746,18 @@
have "finite (I \<union> J)" using fin by auto
interpret IJ: finite_product_sigma_finite M \<mu> "I \<union> J" by default fact
interpret P: pair_sigma_finite I.P I.measure J.P J.measure by default
- let ?f = "\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))"
have P_borel: "(\<lambda>x. f (case x of (x, y) \<Rightarrow> merge I x J y)) \<in> borel_measurable P.P"
unfolding case_prod_distrib measurable_merge_iff[OF IJ, symmetric] using f .
- have bij: "bij_betw ?f (space IJ.P) (space P.P)"
- unfolding sigma_pair_algebra_sigma_eq
- by (intro bij_inv_bij_betw) (rule bij_inv_restrict_merge[OF IJ])
- have "IJ.positive_integral f = IJ.positive_integral (\<lambda>x. f (restrict x (I \<union> J)))"
- by (auto intro!: IJ.positive_integral_cong arg_cong[where f=f] dest!: extensional_restrict)
- also have "\<dots> = I.positive_integral (\<lambda>x. J.positive_integral (\<lambda>y. f (merge I x J y)))"
+ show ?thesis
unfolding P.positive_integral_fst_measurable[OF P_borel, simplified]
- unfolding P.positive_integral_vimage[OF bij]
- unfolding product_product_vimage_algebra[OF IJ]
- apply simp
- apply (rule IJ.positive_integral_cong_measure[symmetric])
- apply (rule measure_fold)
- using assms by auto
- finally show ?thesis .
+ apply (subst IJ.positive_integral_cong_measure[symmetric])
+ apply (rule measure_fold[OF IJ fin])
+ apply assumption
+ proof (rule P.positive_integral_vimage)
+ show "sigma_algebra IJ.P" by default
+ show "(\<lambda>(x, y). merge I x J y) \<in> measurable P.P IJ.P" by (rule measurable_merge[OF IJ])
+ show "f \<in> borel_measurable IJ.P" using f .
+ qed
qed
lemma (in product_sigma_finite) product_positive_integral_singleton:
@@ -1760,31 +1765,18 @@
shows "product_positive_integral {i} (\<lambda>x. f (x i)) = M.positive_integral i f"
proof -
interpret I: finite_product_sigma_finite M \<mu> "{i}" by default simp
- have bij: "bij_betw (\<lambda>x. \<lambda>j\<in>{i}. x) (space (M i)) (space I.P)"
- by (auto intro!: bij_betwI ext simp: extensional_def)
- have *: "(\<lambda>x. (\<lambda>x. \<lambda>j\<in>{i}. x) -` Pi\<^isub>E {i} x \<inter> space (M i)) ` (\<Pi> i\<in>{i}. sets (M i)) = sets (M i)"
- proof (subst image_cong, rule refl)
- fix x assume "x \<in> (\<Pi> i\<in>{i}. sets (M i))"
- then show "(\<lambda>x. \<lambda>j\<in>{i}. x) -` Pi\<^isub>E {i} x \<inter> space (M i) = x i"
- using sets_into_space by auto
- qed auto
- have vimage: "I.vimage_algebra (space (M i)) (\<lambda>x. \<lambda>j\<in>{i}. x) = M i"
- unfolding I.vimage_algebra_def
- unfolding product_sigma_algebra_def sets_sigma
- apply (subst sigma_sets_vimage[symmetric])
- apply (simp_all add: image_image sigma_sets_eq product_algebra_def * del: vimage_Int)
- using sets_into_space by blast
+ have T: "(\<lambda>x. x i) \<in> measurable (sigma (product_algebra M {i})) (M i)"
+ using measurable_component_singleton[of "\<lambda>x. x" i]
+ measurable_ident[unfolded id_def] by auto
show "I.positive_integral (\<lambda>x. f (x i)) = M.positive_integral i f"
- unfolding I.positive_integral_vimage[OF bij]
- unfolding vimage
- apply (subst positive_integral_cong_measure)
- proof -
- fix A assume A: "A \<in> sets (M i)"
- have "(\<lambda>x. \<lambda>j\<in>{i}. x) ` A = (\<Pi>\<^isub>E i\<in>{i}. A)"
- by (auto intro!: image_eqI ext[where 'b='a] simp: extensional_def)
- with A show "product_measure {i} ((\<lambda>x. \<lambda>j\<in>{i}. x) ` A) = \<mu> i A"
- using I.measure_times[of "\<lambda>i. A"] by simp
- qed simp
+ unfolding I.positive_integral_vimage[OF sigma_algebras T f, symmetric]
+ proof (rule positive_integral_cong_measure)
+ fix A let ?P = "(\<lambda>x. x i) -` A \<inter> space (sigma (product_algebra M {i}))"
+ assume A: "A \<in> sets (M i)"
+ then have *: "?P = {i} \<rightarrow>\<^isub>E A" using sets_into_space by auto
+ show "product_measure {i} ?P = \<mu> i A" unfolding *
+ using A I.measure_times[of "\<lambda>_. A"] by auto
+ qed
qed
lemma (in product_sigma_finite) product_positive_integral_insert:
--- a/src/HOL/Probability/Radon_Nikodym.thy Mon Jan 31 11:15:02 2011 +0100
+++ b/src/HOL/Probability/Radon_Nikodym.thy Mon Jan 31 11:18:29 2011 +0100
@@ -1104,38 +1104,6 @@
unfolding eq[OF A, symmetric] RN_deriv(2)[OF \<nu> A, symmetric] ..
qed
-lemma (in sigma_finite_measure) RN_deriv_vimage:
- fixes f :: "'b \<Rightarrow> 'a"
- assumes f: "bij_inv S (space M) f g"
- assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
- shows "AE x.
- sigma_finite_measure.RN_deriv (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>A. \<nu> (f ` A)) (g x) = RN_deriv \<nu> x"
-proof (rule RN_deriv_unique[OF \<nu>])
- interpret sf: sigma_finite_measure "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
- using f by (rule sigma_finite_measure_isomorphic[OF bij_inv_bij_betw(1)])
- interpret \<nu>: measure_space M \<nu> using \<nu>(1) .
- have \<nu>': "measure_space (vimage_algebra S f) (\<lambda>A. \<nu> (f ` A))"
- using f by (rule \<nu>.measure_space_isomorphic[OF bij_inv_bij_betw(1)])
- { fix A assume "A \<in> sets M" then have "f ` (f -` A \<inter> S) = A"
- using sets_into_space f[THEN bij_inv_bij_betw(1), unfolded bij_betw_def]
- by (intro image_vimage_inter_eq[where T="space M"]) auto }
- note A_f = this
- then have ac: "sf.absolutely_continuous (\<lambda>A. \<nu> (f ` A))"
- using \<nu>(2) by (auto simp: sf.absolutely_continuous_def absolutely_continuous_def)
- show "(\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (g x)) \<in> borel_measurable M"
- using sf.RN_deriv(1)[OF \<nu>' ac]
- unfolding measurable_vimage_iff_inv[OF f] comp_def .
- fix A assume "A \<in> sets M"
- then have *: "\<And>x. x \<in> space M \<Longrightarrow> indicator (f -` A \<inter> S) (g x) = (indicator A x :: pextreal)"
- using f by (auto simp: bij_inv_def indicator_def)
- have "\<nu> (f ` (f -` A \<inter> S)) = sf.positive_integral (\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) x * indicator (f -` A \<inter> S) x)"
- using `A \<in> sets M` by (force intro!: sf.RN_deriv(2)[OF \<nu>' ac])
- also have "\<dots> = (\<integral>\<^isup>+x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (g x) * indicator A x)"
- unfolding positive_integral_vimage_inv[OF f]
- by (simp add: * cong: positive_integral_cong)
- finally show "\<nu> A = (\<integral>\<^isup>+x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (g x) * indicator A x)"
- unfolding A_f[OF `A \<in> sets M`] .
-qed
lemma (in sigma_finite_measure) RN_deriv_finite:
assumes sfm: "sigma_finite_measure M \<nu>" and ac: "absolutely_continuous \<nu>"