# HG changeset patch # User paulson # Date 1524063456 -3600 # Node ID 1b05f74f2e5f8948de6f50ab8d6020fdc601debf # Parent 73a5a33486ee2400ee0701d632dee57af52864c3 tidying up including contributions from Paulo Emílio de Vilhena diff -r 73a5a33486ee -r 1b05f74f2e5f NEWS --- a/NEWS Tue Apr 17 22:35:48 2018 +0100 +++ b/NEWS Wed Apr 18 15:57:36 2018 +0100 @@ -209,6 +209,10 @@ choice operator. The dual of this property is also proved in Hilbert_Choice.thy. +* New syntax for the minimum/maximum of a function over a finite set: +MIN x\A. B and even MIN x. B (only useful for finite types), also +MAX. + * Clarifed theorem names: Min.antimono ~> Min.subset_imp @@ -255,8 +259,9 @@ * HOL-Algebra: renamed (^) to [^] -* Session HOL-Analysis: Moebius functions and the Riemann mapping -theorem. +* Session HOL-Analysis: Moebius functions, the Riemann mapping +theorem, the Vitali covering theorem, change-of-variables results for +integration and measures. * Class linordered_semiring_1 covers zero_less_one also, ruling out pathologic instances. Minor INCOMPATIBILITY. diff -r 73a5a33486ee -r 1b05f74f2e5f src/HOL/Algebra/Congruence.thy --- a/src/HOL/Algebra/Congruence.thy Tue Apr 17 22:35:48 2018 +0100 +++ b/src/HOL/Algebra/Congruence.thy Wed Apr 18 15:57:36 2018 +0100 @@ -1,6 +1,6 @@ (* Title: HOL/Algebra/Congruence.thy Author: Clemens Ballarin, started 3 January 2008 - Copyright: Clemens Ballarin + with thanks to Paulo Emílio de Vilhena *) theory Congruence @@ -119,7 +119,7 @@ by (fast intro: elemI elim: elemE dest: subsetD) lemma (in equivalence) mem_imp_elem [simp, intro]: - "[| x \ A; x \ carrier S |] ==> x .\ A" + "\ x \ A; x \ carrier S \ \ x .\ A" unfolding elem_def by blast lemma set_eqI: @@ -215,15 +215,11 @@ lemma (in equivalence) set_eq_sym [sym]: assumes "A {.=} B" - and "A \ carrier S" "B \ carrier S" shows "B {.=} A" using assms unfolding set_eq_def elem_def by fast -(* FIXME: the following two required in Isabelle 2008, not Isabelle 2007 *) -(* alternatively, could declare lemmas [trans] = ssubst [where 'a = "'a set"] *) - lemma (in equivalence) equal_set_eq_trans [trans]: assumes AB: "A = B" and BC: "B {.=} C" shows "A {.=} C" @@ -234,7 +230,6 @@ shows "A {.=} C" using AB BC by simp - lemma (in equivalence) set_eq_trans [trans]: assumes AB: "A {.=} B" and BC: "B {.=} C" and carr: "A \ carrier S" "B \ carrier S" "C \ carrier S" @@ -265,46 +260,46 @@ show "c .\ A" by simp qed -(* FIXME: generalise for insert *) +lemma (in equivalence) set_eq_insert_aux: + assumes x: "x .= x'" + and carr: "x \ carrier S" "x' \ carrier S" "A \ carrier S" + shows "\a \ (insert x A). a .\ (insert x' A)" +proof + fix a + show "a \ insert x A \ a .\ insert x' A" + proof cases + assume "a \ A" + thus "a .\ insert x' A" + using carr(3) by blast + next + assume "a \ insert x A" "a \ A" + hence "a = x" + by blast + thus "a .\ insert x' A" + by (meson x elemI insertI1) + qed +qed -(* lemma (in equivalence) set_eq_insert: assumes x: "x .= x'" - and carr: "x \ carrier S" "x' \ carrier S" "A \ carrier S" - shows "insert x A {.=} insert x' A" - unfolding set_eq_def elem_def -apply rule -apply rule -apply (case_tac "xa = x") -using x apply fast -apply (subgoal_tac "xa \ A") prefer 2 apply fast -apply (rule_tac x=xa in bexI) -using carr apply (rule_tac refl) apply auto [1] -apply safe -*) + and carr: "x \ carrier S" "x' \ carrier S" "A \ carrier S" + shows "insert x A {.=} insert x' A" +proof- + have "(\a \ (insert x A). a .\ (insert x' A)) \ + (\a \ (insert x' A). a .\ (insert x A))" + using set_eq_insert_aux carr x sym by blast + thus "insert x A {.=} insert x' A" + using set_eq_def by blast +qed lemma (in equivalence) set_eq_pairI: assumes xx': "x .= x'" and carr: "x \ carrier S" "x' \ carrier S" "y \ carrier S" shows "{x, y} {.=} {x', y}" -unfolding set_eq_def elem_def -proof safe - have "x' \ {x', y}" by fast - with xx' show "\b\{x', y}. x .= b" by fast -next - have "y \ {x', y}" by fast - with carr show "\b\{x', y}. y .= b" by fast -next - have "x \ {x, y}" by fast - with xx'[symmetric] carr - show "\a\{x, y}. x' .= a" by fast -next - have "y \ {x, y}" by fast - with carr show "\a\{x, y}. y .= a" by fast -qed + using assms set_eq_insert by simp lemma (in equivalence) is_closedI: - assumes closed: "!!x y. [| x .= y; x \ A; y \ carrier S |] ==> y \ A" + assumes closed: "\x y. \x .= y; x \ A; y \ carrier S\ \ y \ A" and S: "A \ carrier S" shows "is_closed A" unfolding eq_is_closed_def eq_closure_of_def elem_def @@ -312,19 +307,19 @@ by (blast dest: closed sym) lemma (in equivalence) closure_of_eq: - "[| x .= x'; A \ carrier S; x \ closure_of A; x \ carrier S; x' \ carrier S |] ==> x' \ closure_of A" + "\x .= x'; A \ carrier S; x \ closure_of A; x' \ carrier S\ \ x' \ closure_of A" unfolding eq_closure_of_def elem_def by (blast intro: trans sym) lemma (in equivalence) is_closed_eq [dest]: - "[| x .= x'; x \ A; is_closed A; x \ carrier S; x' \ carrier S |] ==> x' \ A" + "\x .= x'; x \ A; is_closed A; x \ carrier S; x' \ carrier S\ \ x' \ A" unfolding eq_is_closed_def using closure_of_eq [where A = A] by simp lemma (in equivalence) is_closed_eq_rev [dest]: - "[| x .= x'; x' \ A; is_closed A; x \ carrier S; x' \ carrier S |] ==> x \ A" - by (drule sym) (simp_all add: is_closed_eq) + "\x .= x'; x' \ A; is_closed A; x \ carrier S; x' \ carrier S\ \ x \ A" + by (meson subsetD eq_is_closed_def is_closed_eq sym) lemma closure_of_closed [simp, intro]: fixes S (structure) @@ -334,81 +329,55 @@ lemma closure_of_memI: fixes S (structure) - assumes "a .\ A" - and "a \ carrier S" + assumes "a .\ A" and "a \ carrier S" shows "a \ closure_of A" -unfolding eq_closure_of_def -using assms -by fast + by (simp add: assms eq_closure_of_def) lemma closure_ofI2: fixes S (structure) - assumes "a .= a'" - and "a' \ A" - and "a \ carrier S" + assumes "a .= a'" and "a' \ A" and "a \ carrier S" shows "a \ closure_of A" -unfolding eq_closure_of_def elem_def -using assms -by fast + by (meson assms closure_of_memI elem_def) lemma closure_of_memE: fixes S (structure) - assumes p: "a \ closure_of A" - and r: "\a \ carrier S; a .\ A\ \ P" + assumes "a \ closure_of A" + and "\a \ carrier S; a .\ A\ \ P" shows "P" -proof - - from p - have acarr: "a \ carrier S" - and "a .\ A" - by (simp add: eq_closure_of_def)+ - thus "P" by (rule r) -qed + using eq_closure_of_def assms by fastforce lemma closure_ofE2: fixes S (structure) - assumes p: "a \ closure_of A" - and r: "\a'. \a \ carrier S; a' \ A; a .= a'\ \ P" + assumes "a \ closure_of A" + and "\a'. \a \ carrier S; a' \ A; a .= a'\ \ P" shows "P" -proof - - from p have acarr: "a \ carrier S" by (simp add: eq_closure_of_def) + by (meson closure_of_memE elemE assms) - from p have "\a'\A. a .= a'" by (simp add: eq_closure_of_def elem_def) - from this obtain a' - where "a' \ A" and "a .= a'" by auto - - from acarr and this - show "P" by (rule r) +lemma (in equivalence) closure_inclusion: + assumes "A \ B" + shows "closure_of A \ closure_of B" + unfolding eq_closure_of_def +proof + fix x + assume "x \ {y \ carrier S. y .\ A}" + hence "x \ carrier S \ x .\ A" + by blast + hence "x \ carrier S \ x .\ B" + using assms elem_subsetD by blast + thus "x \ {y \ carrier S. y .\ B}" + by simp qed -(* -lemma (in equivalence) classes_consistent: - assumes Acarr: "A \ carrier S" - shows "is_closed (closure_of A)" -apply (blast intro: elemI elim elemE) -using assms -apply (intro is_closedI closure_of_memI, simp) - apply (elim elemE closure_of_memE) -proof - - fix x a' a'' - assume carr: "x \ carrier S" "a' \ carrier S" - assume a''A: "a'' \ A" - with Acarr have "a'' \ carrier S" by fast - note [simp] = carr this Acarr - - assume "x .= a'" - also assume "a' .= a''" - also from a''A - have "a'' .\ A" by (simp add: elem_exact) - finally show "x .\ A" by simp -qed -*) -(* lemma (in equivalence) classes_small: assumes "is_closed B" and "A \ B" shows "closure_of A \ B" -using assms -by (blast dest: is_closedD2 elem_subsetD elim: closure_of_memE) +proof- + have "closure_of A \ closure_of B" + using closure_inclusion assms by simp + thus "closure_of A \ B" + using assms(1) eq_is_closed_def by fastforce +qed lemma (in equivalence) classes_eq: assumes "A \ carrier S" @@ -419,9 +388,21 @@ lemma (in equivalence) complete_classes: assumes c: "is_closed A" shows "A = closure_of A" -using assms -by (blast intro: closure_of_memI elem_exact dest: is_closedD1 is_closedD2 closure_of_memE) -*) + using assms by (simp add: eq_is_closed_def) + +lemma (in equivalence) closure_idemp_weak: + "closure_of (closure_of A) {.=} closure_of A" + by (simp add: classes_eq set_eq_sym) + +lemma (in equivalence) closure_idemp_strong: + assumes "A \ carrier S" + shows "closure_of (closure_of A) = closure_of A" + using assms closure_of_eq complete_classes is_closedI by auto + +lemma (in equivalence) complete_classes2: + assumes "A \ carrier S" + shows "is_closed (closure_of A)" + using closure_idemp_strong by (simp add: assms eq_is_closed_def) lemma equivalence_subset: assumes "equivalence L" "A \ carrier L" diff -r 73a5a33486ee -r 1b05f74f2e5f src/HOL/Analysis/Change_Of_Vars.thy --- a/src/HOL/Analysis/Change_Of_Vars.thy Tue Apr 17 22:35:48 2018 +0100 +++ b/src/HOL/Analysis/Change_Of_Vars.thy Wed Apr 18 15:57:36 2018 +0100 @@ -1,12 +1,12 @@ theory Change_Of_Vars - imports "HOL-Analysis.Vitali_Covering_Theorem" "HOL-Analysis.Determinants" + imports Vitali_Covering_Theorem Determinants begin subsection\Induction on matrix row operations\ lemma induct_matrix_row_operations: - fixes P :: "(real^'n, 'n::finite) vec \ bool" + fixes P :: "real^'n^'n \ bool" assumes zero_row: "\A i. row i A = 0 \ P A" and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" and swap_cols: "\A m n. \P A; m \ n\ \ P(\ i j. A $ i $ Fun.swap m n id j)" @@ -115,7 +115,7 @@ qed lemma induct_matrix_elementary: - fixes P :: "(real^'n, 'n::finite) vec \ bool" + fixes P :: "real^'n^'n \ bool" assumes mult: "\A B. \P A; P B\ \ P(A ** B)" and zero_row: "\A i. row i A = 0 \ P A" and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" @@ -146,7 +146,7 @@ qed lemma induct_matrix_elementary_alt: - fixes P :: "(real^'n, 'n::finite) vec \ bool" + fixes P :: "real^'n^'n \ bool" assumes mult: "\A B. \P A; P B\ \ P(A ** B)" and zero_row: "\A i. row i A = 0 \ P A" and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" @@ -196,14 +196,14 @@ then show "P (( *v) (A ** B))" by (metis (no_types, lifting) comp linear_compose matrix_compose matrix_eq matrix_vector_mul matrix_vector_mul_linear) next - fix A :: "((real, 'n) vec, 'n) vec" and i + fix A :: "real^'n^'n" and i assume "row i A = 0" then show "P (( *v) A)" by (metis inner_zero_left matrix_vector_mul_component matrix_vector_mul_linear row_def vec_eq_iff vec_lambda_beta zeroes) next - fix A :: "((real, 'n) vec, 'n) vec" + fix A :: "real^'n^'n" assume 0: "\i j. i \ j \ A $ i $ j = 0" - have "A $ i $ i * x $ i = (\j\UNIV. A $ i $ j * x $ j)" for x :: "(real, 'n) vec" and i :: "'n" + have "A $ i $ i * x $ i = (\j\UNIV. A $ i $ j * x $ j)" for x and i :: "'n" by (simp add: 0 comm_monoid_add_class.sum.remove [where x=i]) then have "(\x. \ i. A $ i $ i * x $ i) = (( *v) A)" by (auto simp: 0 matrix_vector_mult_def) @@ -214,7 +214,7 @@ assume "m \ n" have eq: "(\j\UNIV. if i = Fun.swap m n id j then x $ j else 0) = (\j\UNIV. if j = Fun.swap m n id i then x $ j else 0)" - for i and x :: "(real, 'n) vec" + for i and x :: "real^'n" unfolding swap_def by (rule sum.cong) auto have "(\x::real^'n. \ i. x $ Fun.swap m n id i) = (( *v) (\ i j. if i = Fun.swap m n id j then 1 else 0))" by (auto simp: mat_def matrix_vector_mult_def eq if_distrib [of "\x. x * y" for y] cong: if_cong) @@ -223,7 +223,7 @@ next fix m n :: "'n" assume "m \ n" - then have "x $ m + x $ n = (\j\UNIV. of_bool (j = n \ m = j) * x $ j)" for x :: "(real, 'n) vec" + then have "x $ m + x $ n = (\j\UNIV. of_bool (j = n \ m = j) * x $ j)" for x :: "real^'n" by (auto simp: of_bool_def if_distrib [of "\x. x * y" for y] sum.remove cong: if_cong) then have "(\x::real^'n. \ i. if i = m then x $ m + x $ n else x $ i) = (( *v) (\ i j. of_bool (i = m \ j = n \ i = j)))" @@ -390,7 +390,7 @@ using True by auto have "ball 0 B \ (\x. \ k. x $ k / m k) ` ball 0 ?C" proof clarsimp - fix x :: "(real, 'n) vec" + fix x :: "real^'n" assume x: "norm x < B" have [simp]: "\Max (range (\k. \m k\))\ = Max (range (\k. \m k\))" by (meson Max_ge abs_ge_zero abs_of_nonneg finite finite_imageI order_trans rangeI) @@ -452,8 +452,6 @@ - - proposition fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes "linear f" "S \ lmeasurable" @@ -473,7 +471,7 @@ using f [OF gS] g [OF S] matrix_compose [OF \linear g\ \linear f\] by (simp add: o_def image_comp abs_mult det_mul) next - fix f :: "(real, 'n) vec \ (real, 'n) vec" and i and S :: "(real, 'n) vec set" + fix f :: "real^'n::_ \ real^'n::_" and i and S :: "(real^'n::_) set" assume "linear f" and 0: "\x. f x $ i = 0" and "S \ lmeasurable" then have "\ inj f" by (metis (full_types) linear_injective_imp_surjective one_neq_zero surjE vec_component) @@ -490,7 +488,7 @@ finally show "?Q f S" . qed next - fix c and S :: "(real, 'n) vec set" + fix c and S :: "(real^'n::_) set" assume "S \ lmeasurable" show "(\a. \ i. c i * a $ i) ` S \ lmeasurable \ ?Q (\a. \ i. c i * a $ i) S" proof @@ -532,7 +530,7 @@ using measure_linear_sufficient [OF lin \S \ lmeasurable\] meq 1 by force+ qed next - fix m :: "'n" and n :: "'n" and S :: "(real, 'n) vec set" + fix m n :: "'n" and S :: "(real, 'n) vec set" assume "m \ n" and "S \ lmeasurable" let ?h = "\v::(real, 'n) vec. \ i. if i = m then v $ m + v $ n else v $ i" have lin: "linear ?h" @@ -616,26 +614,6 @@ by (simp add: measure_linear_image \linear f\ S f) qed -lemma sets_lebesgue_inner_closed: - assumes "S \ sets lebesgue" "e > 0" - obtains T where "closed T" "T \ S" "S-T \ lmeasurable" "measure lebesgue (S - T) < e" -proof - - have "-S \ sets lebesgue" - using assms by (simp add: Compl_in_sets_lebesgue) - then obtain T where "open T" "-S \ T" - and T: "(T - -S) \ lmeasurable" "measure lebesgue (T - -S) < e" - using lmeasurable_outer_open assms by blast - show thesis - proof - show "closed (-T)" - using \open T\ by blast - show "-T \ S" - using \- S \ T\ by auto - show "S - ( -T) \ lmeasurable" "measure lebesgue (S - (- T)) < e" - using T by (auto simp: Int_commute) - qed -qed - subsection\@{text F_sigma} and @{text G_delta} sets.\ (*https://en.wikipedia.org/wiki/F\_set*) @@ -645,7 +623,6 @@ inductive gdelta :: "'a::topological_space set \ bool" where "(\n::nat. open (F n)) \ gdelta (INTER UNIV F)" - lemma fsigma_Union_compact: fixes S :: "'a::{real_normed_vector,heine_borel} set" shows "fsigma S \ (\F::nat \ 'a set. range F \ Collect compact \ S = UNION UNIV F)" @@ -698,12 +675,9 @@ by (simp add: 1 gdelta.intros open_closed) qed - - lemma gdelta_complement: "gdelta(- S) \ fsigma S" using fsigma_imp_gdelta gdelta_imp_fsigma by force - text\A Lebesgue set is almost an @{text F_sigma} or @{text G_delta}.\ lemma lebesgue_set_almost_fsigma: assumes "S \ sets lebesgue" @@ -1839,7 +1813,7 @@ using \r > 0\ \d > 0\ by auto show "{x' \ S. \v. v \ 0 \ (\\>0. \e>0. \z\S - {x'}. norm (x' - z) < e \ \v \ (z - x')\ < \ * norm (x' - z))} \ ball x (min d r) \ ?W" proof (clarsimp simp: dist_norm norm_minus_commute) - fix y :: "(real, 'm) vec" and w :: "(real, 'm) vec" + fix y w assume "y \ S" "w \ 0" and less [rule_format]: "\\>0. \e>0. \z\S - {y}. norm (y - z) < e \ \w \ (z - y)\ < \ * norm (y - z)" diff -r 73a5a33486ee -r 1b05f74f2e5f src/HOL/Analysis/Lebesgue_Measure.thy --- a/src/HOL/Analysis/Lebesgue_Measure.thy Tue Apr 17 22:35:48 2018 +0100 +++ b/src/HOL/Analysis/Lebesgue_Measure.thy Wed Apr 18 15:57:36 2018 +0100 @@ -1297,6 +1297,26 @@ qed qed +lemma sets_lebesgue_inner_closed: + assumes "S \ sets lebesgue" "e > 0" + obtains T where "closed T" "T \ S" "S-T \ lmeasurable" "measure lebesgue (S - T) < e" +proof - + have "-S \ sets lebesgue" + using assms by (simp add: Compl_in_sets_lebesgue) + then obtain T where "open T" "-S \ T" + and T: "(T - -S) \ lmeasurable" "measure lebesgue (T - -S) < e" + using lmeasurable_outer_open assms by blast + show thesis + proof + show "closed (-T)" + using \open T\ by blast + show "-T \ S" + using \- S \ T\ by auto + show "S - ( -T) \ lmeasurable" "measure lebesgue (S - (- T)) < e" + using T by (auto simp: Int_commute) + qed +qed + lemma lebesgue_openin: "\openin (subtopology euclidean S) T; S \ sets lebesgue\ \ T \ sets lebesgue" by (metis borel_open openin_open sets.Int sets_completionI_sets sets_lborel)