# HG changeset patch # User wenzelm # Date 1694465974 -7200 # Node ID 5930c89d3bf29301ec13143fb5c5df099fee71e3 # Parent 0d2ea608d2234bb3a2b061bdf9faaa78682c54e1# Parent 4da1e18a963302532de351d01a92ced4f98c47d7 merged diff -r 0d2ea608d223 -r 5930c89d3bf2 Admin/components/components.sha1 --- a/Admin/components/components.sha1 Mon Sep 11 19:31:09 2023 +0200 +++ b/Admin/components/components.sha1 Mon Sep 11 22:59:34 2023 +0200 @@ -113,6 +113,7 @@ b1c40ce6c087da7e70e221ddd3fcadfa569acb2f foiltex-2.1.4b.tar.gz f339234ec18369679be0095264e0c0af7762f351 gnu-utils-20210414.tar.gz 71259aa46134e6cf2c6473b4fc408051b3336490 gnu-utils-20211030.tar.gz +c489cae2a96ce18bec813d2eb1f528c88006382a go-1.21.0-v1.tar.gz 683acd94761ef460cca1a628f650355370de5afb hol-light-bundle-0.5-126.tar.gz 511fa8df8be88eb0500032bbd17742d33bdd4636 hugo-0.88.1.tar.gz 989234b3799fe8750f3c24825d1f717c24fb0214 idea-icons-20210508.tar.gz diff -r 0d2ea608d223 -r 5930c89d3bf2 Admin/components/go --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Admin/components/go Mon Sep 11 22:59:34 2023 +0200 @@ -0,0 +1,1 @@ +go-1.21.0-v1 diff -r 0d2ea608d223 -r 5930c89d3bf2 CONTRIBUTORS --- a/CONTRIBUTORS Mon Sep 11 19:31:09 2023 +0200 +++ b/CONTRIBUTORS Mon Sep 11 22:59:34 2023 +0200 @@ -3,6 +3,10 @@ listed as an author in one of the source files of this Isabelle distribution. +Contributions to this Isabelle version +-------------------------------------- + + Contributions to Isabelle2023 ----------------------------- diff -r 0d2ea608d223 -r 5930c89d3bf2 NEWS --- a/NEWS Mon Sep 11 19:31:09 2023 +0200 +++ b/NEWS Mon Sep 11 22:59:34 2023 +0200 @@ -4,6 +4,17 @@ (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.) +New in this Isabelle version +---------------------------- + +*** System *** + +* Isabelle/Scala and derived Scala tools now use the syntax of Scala +3.3, instead of 3.1. This is the "-old-syntax" variant (Java-like) as +before, not "-new-syntax" (Python-like). Minor INCOMPATIBILITY. + + + New in Isabelle2023 (September 2023) ------------------------------------ diff -r 0d2ea608d223 -r 5930c89d3bf2 etc/settings --- a/etc/settings Mon Sep 11 19:31:09 2023 +0200 +++ b/etc/settings Mon Sep 11 22:59:34 2023 +0200 @@ -16,8 +16,8 @@ ISABELLE_TOOL_JAVA_OPTIONS="-Djava.awt.headless=true -Xms512m -Xmx4g -Xss16m" -ISABELLE_JAVAC_OPTIONS="-encoding UTF-8 -Xlint:-options -deprecation -source 11 -target 11" -ISABELLE_SCALAC_OPTIONS="-encoding UTF-8 -feature -deprecation -release 11 -source 3.1 -old-syntax -no-indent -color never -pagewidth 78 -J-Xms512m -J-Xmx4g -J-Xss16m" +ISABELLE_JAVAC_OPTIONS="-encoding UTF-8 -Xlint:-options -deprecation -source 17 -target 17" +ISABELLE_SCALAC_OPTIONS="-encoding UTF-8 -feature -java-output-version 17 -source 3.3 -old-syntax -no-indent -color never -pagewidth 78 -J-Xms512m -J-Xmx4g -J-Xss16m" ISABELLE_SCALA_JAR="$ISABELLE_HOME/lib/classes/isabelle.jar" diff -r 0d2ea608d223 -r 5930c89d3bf2 lib/Tools/scala_build --- a/lib/Tools/scala_build Mon Sep 11 19:31:09 2023 +0200 +++ b/lib/Tools/scala_build Mon Sep 11 22:59:34 2023 +0200 @@ -51,12 +51,6 @@ ## main -#remove historic material -rm -rf \ - "$ISABELLE_HOME/lib/classes/Pure.jar" \ - "$ISABELLE_HOME/lib/classes/Pure.shasum" \ - "$ISABELLE_HOME/src/Tools/jEdit/dist" - classpath "$CLASSPATH"; export CLASSPATH="" eval "declare -a JAVA_ARGS=($ISABELLE_TOOL_JAVA_OPTIONS)" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Algebra/Ring.thy --- a/src/HOL/Algebra/Ring.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Algebra/Ring.thy Mon Sep 11 22:59:34 2023 +0200 @@ -878,7 +878,7 @@ lemma (in ring) inv_neg_one [simp]: "inv (\ \) = \ \" by (simp add: inv_char local.ring_axioms ring.r_minus) -lemma (in monoid) inv_eq_imp_eq: "x \ Units G \ y \ Units G \ inv x = inv y \ x = y" +lemma (in monoid) inv_eq_imp_eq [dest!]: "inv x = inv y \ x \ Units G \ y \ Units G \ x = y" by (metis Units_inv_inv) lemma (in ring) Units_minus_one_closed [intro]: "\ \ \ Units R" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Abstract_Topological_Spaces.thy --- a/src/HOL/Analysis/Abstract_Topological_Spaces.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Abstract_Topological_Spaces.thy Mon Sep 11 22:59:34 2023 +0200 @@ -35,10 +35,6 @@ "\connectedin X C; closedin X T; openin X T\ \ C \ T \ disjnt C T" by (metis Diff_eq_empty_iff Int_empty_right clopenin_eq_frontier_of connectedin_Int_frontier_of disjnt_def) -lemma connected_space_quotient_map_image: - "\quotient_map X X' q; connected_space X\ \ connected_space X'" - by (metis connectedin_continuous_map_image connectedin_topspace quotient_imp_continuous_map quotient_imp_surjective_map) - lemma connected_space_retraction_map_image: "\retraction_map X X' r; connected_space X\ \ connected_space X'" using connected_space_quotient_map_image retraction_imp_quotient_map by blast @@ -291,8 +287,6 @@ by (simp add: Ceq \a \ U\ \a \ topspace X\ connected_component_in_connected_components_of) qed -thm connected_space_iff_components_eq - lemma open_in_finite_connected_components: assumes "finite(connected_components_of X)" "C \ connected_components_of X" shows "openin X C" @@ -307,12 +301,7 @@ lemma connected_components_of_disjoint: assumes "C \ connected_components_of X" "C' \ connected_components_of X" shows "(disjnt C C' \ (C \ C'))" -proof - - have "C \ {}" - using nonempty_connected_components_of assms by blast - with assms show ?thesis - by (metis disjnt_self_iff_empty pairwiseD pairwise_disjoint_connected_components_of) -qed + using assms nonempty_connected_components_of pairwiseD pairwise_disjoint_connected_components_of by fastforce lemma connected_components_of_overlap: "\C \ connected_components_of X; C' \ connected_components_of X\ \ C \ C' \ {} \ C = C'" @@ -439,8 +428,7 @@ next case False then show ?thesis - apply (simp add: PiE_iff) - by (smt (verit) Collect_empty_eq False PiE_eq_empty_iff PiE_iff connected_component_of_eq_empty) + by (smt (verit, best) PiE_eq_empty_iff PiE_iff connected_component_of_eq_empty topspace_product_topology) qed @@ -490,11 +478,14 @@ lemma monotone_map_from_subtopology: assumes "monotone_map X Y f" - "\x y. x \ topspace X \ y \ topspace X \ x \ S \ f x = f y \ y \ S" + "\x y. \x \ topspace X; y \ topspace X; x \ S; f x = f y\ \ y \ S" shows "monotone_map (subtopology X S) Y f" - using assms - unfolding monotone_map_def connectedin_subtopology - by (smt (verit, del_insts) Collect_cong Collect_empty_eq IntE IntI connectedin_empty image_subset_iff mem_Collect_eq subsetI topspace_subtopology) +proof - + have "\y. y \ topspace Y \ connectedin X {x \ topspace X. x \ S \ f x = y}" + by (smt (verit) Collect_cong assms connectedin_empty empty_def monotone_map_def) + then show ?thesis + using assms by (auto simp: monotone_map_def connectedin_subtopology) +qed lemma monotone_map_restriction: "monotone_map X Y f \ {x \ topspace X. f x \ v} = u @@ -5115,17 +5106,10 @@ locally_compact_space_prod_topology by blast qed -text \Essentially the same proof\ lemma k_space_prod_topology_right: assumes "k_space X" and Y: "locally_compact_space Y" "Hausdorff_space Y \ regular_space Y" shows "k_space (prod_topology X Y)" -proof - - obtain q and Z :: "('a set * 'a) topology" where "locally_compact_space Z" and q: "quotient_map Z X q" - using \k_space X\ k_space_as_quotient by blast - then show ?thesis - using quotient_map_prod_left [OF Y q] using Y k_space_quotient_map_image locally_compact_imp_k_space - locally_compact_space_prod_topology by blast -qed + using assms homeomorphic_k_space homeomorphic_space_prod_topology_swap k_space_prod_topology_left by blast lemma continuous_map_from_k_space: @@ -5258,13 +5242,7 @@ f \ (topspace X) \ topspace Y \ (\k. compactin Y k \ open_map (subtopology X {x \ topspace X. f x \ k}) (subtopology Y k) f)" - (is "?lhs=?rhs") -proof - show "?lhs \ ?rhs" - by (simp add: open_map_imp_subset_topspace open_map_restriction) - show "?rhs \ ?lhs" - by (simp add: assms open_map_into_k_space) -qed + using assms open_map_imp_subset_topspace open_map_into_k_space open_map_restriction by fastforce lemma closed_map_into_k_space_eq: assumes "k_space Y" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Affine.thy --- a/src/HOL/Analysis/Affine.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Affine.thy Mon Sep 11 22:59:34 2023 +0200 @@ -5,7 +5,7 @@ begin lemma if_smult: "(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)" - by (fact if_distrib) + by simp lemma sum_delta_notmem: assumes "x \ s" @@ -13,12 +13,7 @@ and "sum (\y. if (x = y) then P x else Q y) s = sum Q s" and "sum (\y. if (y = x) then P y else Q y) s = sum Q s" and "sum (\y. if (x = y) then P y else Q y) s = sum Q s" - apply (rule_tac [!] sum.cong) - using assms - apply auto - done - -lemmas independent_finite = independent_imp_finite + by (smt (verit, best) assms sum.cong)+ lemma span_substd_basis: assumes d: "d \ Basis" @@ -32,13 +27,11 @@ ultimately have "span d \ ?B" using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast moreover have *: "card d \ dim (span d)" - using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms] - span_superset[of d] - by auto + by (simp add: d dim_eq_card_independent independent_substdbasis) moreover from * have "dim ?B \ dim (span d)" using dim_substandard[OF assms] by auto ultimately show ?thesis - using s subspace_dim_equal[of "span d" "?B"] subspace_span[of d] by auto + by (simp add: s subspace_dim_equal) qed lemma basis_to_substdbasis_subspace_isomorphism: @@ -51,7 +44,8 @@ using dim_unique[of B B "card B"] assms span_superset[of B] by auto have "dim B \ card (Basis :: 'a set)" using dim_subset_UNIV[of B] by simp - from obtain_subset_with_card_n[OF this] obtain d :: "'a set" where d: "d \ Basis" and t: "card d = dim B" + from obtain_subset_with_card_n[OF this] + obtain d :: "'a set" where d: "d \ Basis" and t: "card d = dim B" by auto let ?t = "{x::'a::euclidean_space. \i\Basis. i \ d \ x\i = 0}" have "\f. linear f \ f ` B = d \ f ` span B = ?t \ inj_on f (span B)" @@ -65,9 +59,9 @@ subsection \Affine set and affine hull\ definition\<^marker>\tag important\ affine :: "'a::real_vector set \ bool" - where "affine s \ (\x\s. \y\s. \u v. u + v = 1 \ u *\<^sub>R x + v *\<^sub>R y \ s)" + where "affine S \ (\x\S. \y\S. \u v. u + v = 1 \ u *\<^sub>R x + v *\<^sub>R y \ S)" -lemma affine_alt: "affine s \ (\x\s. \y\s. \u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \ s)" +lemma affine_alt: "affine S \ (\x\S. \y\S. \u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \ S)" unfolding affine_def by (metis eq_diff_eq') lemma affine_empty [iff]: "affine {}" @@ -79,21 +73,21 @@ lemma affine_UNIV [iff]: "affine UNIV" unfolding affine_def by auto -lemma affine_Inter [intro]: "(\s. s\f \ affine s) \ affine (\f)" +lemma affine_Inter [intro]: "(\S. S\\ \ affine S) \ affine (\\)" unfolding affine_def by auto -lemma affine_Int[intro]: "affine s \ affine t \ affine (s \ t)" +lemma affine_Int[intro]: "affine S \ affine T \ affine (S \ T)" unfolding affine_def by auto -lemma affine_scaling: "affine s \ affine (image (\x. c *\<^sub>R x) s)" - apply (clarsimp simp add: affine_def) +lemma affine_scaling: "affine S \ affine ((*\<^sub>R) c ` S)" + apply (clarsimp simp: affine_def) apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI) apply (auto simp: algebra_simps) done -lemma affine_affine_hull [simp]: "affine(affine hull s)" +lemma affine_affine_hull [simp]: "affine(affine hull S)" unfolding hull_def - using affine_Inter[of "{t. affine t \ s \ t}"] by auto + using affine_Inter[of "{T. affine T \ S \ T}"] by auto lemma affine_hull_eq[simp]: "(affine hull s = s) \ affine s" by (metis affine_affine_hull hull_same) @@ -198,6 +192,8 @@ "affine hull p = {y. \S u. finite S \ S \ {} \ S \ p \ sum u S = 1 \ sum (\v. u v *\<^sub>R v) S = y}" (is "_ = ?rhs") proof (rule hull_unique) + have "\x. sum (\z. 1) {x} = 1" + by auto show "p \ ?rhs" proof (intro subsetI CollectI exI conjI) show "\x. sum (\z. 1) {x} = 1" @@ -452,31 +448,16 @@ unfolding affine_parallel_def using image_add_0 by blast -lemma affine_parallel_commut: +lemma affine_parallel_commute: assumes "affine_parallel A B" shows "affine_parallel B A" -proof - - from assms obtain a where B: "B = (\x. a + x) ` A" - unfolding affine_parallel_def by auto - have [simp]: "(\x. x - a) = plus (- a)" by (simp add: fun_eq_iff) - from B show ?thesis - using translation_galois [of B a A] - unfolding affine_parallel_def by blast -qed + by (metis affine_parallel_def assms translation_galois) lemma affine_parallel_assoc: assumes "affine_parallel A B" and "affine_parallel B C" shows "affine_parallel A C" -proof - - from assms obtain ab where "B = (\x. ab + x) ` A" - unfolding affine_parallel_def by auto - moreover - from assms obtain bc where "C = (\x. bc + x) ` B" - unfolding affine_parallel_def by auto - ultimately show ?thesis - using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto -qed + by (metis affine_parallel_def assms translation_assoc) lemma affine_translation_aux: fixes a :: "'a::real_vector" @@ -503,24 +484,13 @@ lemma affine_translation: "affine S \ affine ((+) a ` S)" for a :: "'a::real_vector" -proof - show "affine ((+) a ` S)" if "affine S" - using that translation_assoc [of "- a" a S] - by (auto intro: affine_translation_aux [of "- a" "((+) a ` S)"]) - show "affine S" if "affine ((+) a ` S)" - using that by (rule affine_translation_aux) -qed + by (metis affine_translation_aux translation_galois) lemma parallel_is_affine: fixes S T :: "'a::real_vector set" assumes "affine S" "affine_parallel S T" shows "affine T" -proof - - from assms obtain a where "T = (\x. a + x) ` S" - unfolding affine_parallel_def by auto - then show ?thesis - using affine_translation assms by auto -qed + by (metis affine_parallel_def affine_translation assms) lemma subspace_imp_affine: "subspace s \ affine s" unfolding subspace_def affine_def by auto @@ -532,64 +502,12 @@ subsubsection\<^marker>\tag unimportant\ \Subspace parallel to an affine set\ lemma subspace_affine: "subspace S \ affine S \ 0 \ S" -proof - - have h0: "subspace S \ affine S \ 0 \ S" - using subspace_imp_affine[of S] subspace_0 by auto - { - assume assm: "affine S \ 0 \ S" - { - fix c :: real - fix x - assume x: "x \ S" - have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto - moreover - have "(1 - c) *\<^sub>R 0 + c *\<^sub>R x \ S" - using affine_alt[of S] assm x by auto - ultimately have "c *\<^sub>R x \ S" by auto - } - then have h1: "\c. \x \ S. c *\<^sub>R x \ S" by auto - - { - fix x y - assume xy: "x \ S" "y \ S" - define u where "u = (1 :: real)/2" - have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)" - by auto - moreover - have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y" - by (simp add: algebra_simps) - moreover - have "(1 - u) *\<^sub>R x + u *\<^sub>R y \ S" - using affine_alt[of S] assm xy by auto - ultimately - have "(1/2) *\<^sub>R (x+y) \ S" - using u_def by auto - moreover - have "x + y = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))" - by auto - ultimately - have "x + y \ S" - using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto - } - then have "\x \ S. \y \ S. x + y \ S" - by auto - then have "subspace S" - using h1 assm unfolding subspace_def by auto - } - then show ?thesis using h0 by metis -qed + by (metis add_cancel_right_left affine_alt diff_add_cancel mem_affine_3 scaleR_eq_0_iff subspace_def vector_space_assms(4)) lemma affine_diffs_subspace: assumes "affine S" "a \ S" shows "subspace ((\x. (-a)+x) ` S)" -proof - - have [simp]: "(\x. x - a) = plus (- a)" by (simp add: fun_eq_iff) - have "affine ((\x. (-a)+x) ` S)" - using affine_translation assms by blast - moreover have "0 \ ((\x. (-a)+x) ` S)" - using assms exI[of "(\x. x\S \ -a+x = 0)" a] by auto - ultimately show ?thesis using subspace_affine by auto -qed + by (metis ab_left_minus affine_translation assms image_eqI subspace_affine) lemma affine_diffs_subspace_subtract: "subspace ((\x. x - a) ` S)" if "affine S" "a \ S" @@ -600,61 +518,26 @@ and "a \ S" assumes "L \ {y. \x \ S. (-a) + x = y}" shows "subspace L \ affine_parallel S L" -proof - - from assms have "L = plus (- a) ` S" by auto - then have par: "affine_parallel S L" - unfolding affine_parallel_def .. - then have "affine L" using assms parallel_is_affine by auto - moreover have "0 \ L" - using assms by auto - ultimately show ?thesis - using subspace_affine par by auto -qed + by (smt (verit) Collect_cong ab_left_minus affine_parallel_def assms image_def mem_Collect_eq parallel_is_affine subspace_affine) lemma parallel_subspace_aux: assumes "subspace A" and "subspace B" and "affine_parallel A B" shows "A \ B" -proof - - from assms obtain a where a: "\x. x \ A \ a + x \ B" - using affine_parallel_expl[of A B] by auto - then have "-a \ A" - using assms subspace_0[of B] by auto - then have "a \ A" - using assms subspace_neg[of A "-a"] by auto - then show ?thesis - using assms a unfolding subspace_def by auto -qed + by (metis add.right_neutral affine_parallel_expl assms subsetI subspace_def) lemma parallel_subspace: assumes "subspace A" and "subspace B" and "affine_parallel A B" shows "A = B" -proof - show "A \ B" - using assms parallel_subspace_aux by auto - show "A \ B" - using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto -qed + by (simp add: affine_parallel_commute assms parallel_subspace_aux subset_antisym) lemma affine_parallel_subspace: assumes "affine S" "S \ {}" shows "\!L. subspace L \ affine_parallel S L" -proof - - have ex: "\L. subspace L \ affine_parallel S L" - using assms parallel_subspace_explicit by auto - { - fix L1 L2 - assume ass: "subspace L1 \ affine_parallel S L1" "subspace L2 \ affine_parallel S L2" - then have "affine_parallel L1 L2" - using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto - then have "L1 = L2" - using ass parallel_subspace by auto - } - then show ?thesis using ex by auto -qed + by (meson affine_parallel_assoc affine_parallel_commute assms equals0I parallel_subspace parallel_subspace_explicit) subsection \Affine Dependence\ @@ -662,50 +545,49 @@ text "Formalized by Lars Schewe." definition\<^marker>\tag important\ affine_dependent :: "'a::real_vector set \ bool" - where "affine_dependent s \ (\x\s. x \ affine hull (s - {x}))" + where "affine_dependent S \ (\x\S. x \ affine hull (S - {x}))" -lemma affine_dependent_imp_dependent: "affine_dependent s \ dependent s" +lemma affine_dependent_imp_dependent: "affine_dependent S \ dependent S" unfolding affine_dependent_def dependent_def using affine_hull_subset_span by auto lemma affine_dependent_subset: - "\affine_dependent s; s \ t\ \ affine_dependent t" -apply (simp add: affine_dependent_def Bex_def) -apply (blast dest: hull_mono [OF Diff_mono [OF _ subset_refl]]) -done + "\affine_dependent S; S \ T\ \ affine_dependent T" + using hull_mono [OF Diff_mono [OF _ subset_refl]] + by (smt (verit) affine_dependent_def subsetD) lemma affine_independent_subset: - shows "\\ affine_dependent t; s \ t\ \ \ affine_dependent s" -by (metis affine_dependent_subset) + shows "\\ affine_dependent T; S \ T\ \ \ affine_dependent S" + by (metis affine_dependent_subset) lemma affine_independent_Diff: - "\ affine_dependent s \ \ affine_dependent(s - t)" + "\ affine_dependent S \ \ affine_dependent(S - T)" by (meson Diff_subset affine_dependent_subset) proposition affine_dependent_explicit: "affine_dependent p \ - (\S u. finite S \ S \ p \ sum u S = 0 \ (\v\S. u v \ 0) \ sum (\v. u v *\<^sub>R v) S = 0)" + (\S U. finite S \ S \ p \ sum U S = 0 \ (\v\S. U v \ 0) \ sum (\v. U v *\<^sub>R v) S = 0)" proof - - have "\S u. finite S \ S \ p \ sum u S = 0 \ (\v\S. u v \ 0) \ (\w\S. u w *\<^sub>R w) = 0" - if "(\w\S. u w *\<^sub>R w) = x" "x \ p" "finite S" "S \ {}" "S \ p - {x}" "sum u S = 1" for x S u + have "\S U. finite S \ S \ p \ sum U S = 0 \ (\v\S. U v \ 0) \ (\w\S. U w *\<^sub>R w) = 0" + if "(\w\S. U w *\<^sub>R w) = x" "x \ p" "finite S" "S \ {}" "S \ p - {x}" "sum U S = 1" for x S U proof (intro exI conjI) have "x \ S" using that by auto - then show "(\v \ insert x S. if v = x then - 1 else u v) = 0" + then show "(\v \ insert x S. if v = x then - 1 else U v) = 0" using that by (simp add: sum_delta_notmem) - show "(\w \ insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0" + show "(\w \ insert x S. (if w = x then - 1 else U w) *\<^sub>R w) = 0" using that \x \ S\ by (simp add: if_smult sum_delta_notmem cong: if_cong) qed (use that in auto) - moreover have "\x\p. \S u. finite S \ S \ {} \ S \ p - {x} \ sum u S = 1 \ (\v\S. u v *\<^sub>R v) = x" - if "(\v\S. u v *\<^sub>R v) = 0" "finite S" "S \ p" "sum u S = 0" "v \ S" "u v \ 0" for S u v + moreover have "\x\p. \S U. finite S \ S \ {} \ S \ p - {x} \ sum U S = 1 \ (\v\S. U v *\<^sub>R v) = x" + if "(\v\S. U v *\<^sub>R v) = 0" "finite S" "S \ p" "sum U S = 0" "v \ S" "U v \ 0" for S U v proof (intro bexI exI conjI) have "S \ {v}" using that by auto then show "S - {v} \ {}" using that by auto - show "(\x \ S - {v}. - (1 / u v) * u x) = 1" + show "(\x \ S - {v}. - (1 / U v) * U x) = 1" unfolding sum_distrib_left[symmetric] sum_diff1[OF \finite S\] by (simp add: that) - show "(\x\S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v" + show "(\x\S - {v}. (- (1 / U v) * U x) *\<^sub>R x) = v" unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_diff1[OF \finite S\] using that by auto @@ -720,90 +602,82 @@ fixes S :: "'a::real_vector set" assumes "finite S" shows "affine_dependent S \ - (\u. sum u S = 0 \ (\v\S. u v \ 0) \ sum (\v. u v *\<^sub>R v) S = 0)" + (\U. sum U S = 0 \ (\v\S. U v \ 0) \ sum (\v. U v *\<^sub>R v) S = 0)" (is "?lhs = ?rhs") proof - have *: "\vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else 0::'a)" + have *: "\vt U v. (if vt then U v else 0) *\<^sub>R v = (if vt then (U v) *\<^sub>R v else 0::'a)" by auto assume ?lhs - then obtain t u v where - "finite t" "t \ S" "sum u t = 0" "v\t" "u v \ 0" "(\v\t. u v *\<^sub>R v) = 0" + then obtain T U v where + "finite T" "T \ S" "sum U T = 0" "v\T" "U v \ 0" "(\v\T. U v *\<^sub>R v) = 0" unfolding affine_dependent_explicit by auto then show ?rhs - apply (rule_tac x="\x. if x\t then u x else 0" in exI) - apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \t\S\]) + apply (rule_tac x="\x. if x\T then U x else 0" in exI) + apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \T\S\]) done next assume ?rhs - then obtain u v where "sum u S = 0" "v\S" "u v \ 0" "(\v\S. u v *\<^sub>R v) = 0" + then obtain U v where "sum U S = 0" "v\S" "U v \ 0" "(\v\S. U v *\<^sub>R v) = 0" by auto then show ?lhs unfolding affine_dependent_explicit using assms by auto qed lemma dependent_imp_affine_dependent: - assumes "dependent {x - a| x . x \ s}" - and "a \ s" - shows "affine_dependent (insert a s)" + assumes "dependent {x - a| x . x \ S}" + and "a \ S" + shows "affine_dependent (insert a S)" proof - - from assms(1)[unfolded dependent_explicit] obtain S u v - where obt: "finite S" "S \ {x - a |x. x \ s}" "v\S" "u v \ 0" "(\v\S. u v *\<^sub>R v) = 0" + from assms(1)[unfolded dependent_explicit] obtain S' U v + where S: "finite S'" "S' \ {x - a |x. x \ S}" "v\S'" "U v \ 0" "(\v\S'. U v *\<^sub>R v) = 0" by auto - define t where "t = (\x. x + a) ` S" - - have inj: "inj_on (\x. x + a) S" + define T where "T = (\x. x + a) ` S'" + have inj: "inj_on (\x. x + a) S'" unfolding inj_on_def by auto - have "0 \ S" - using obt(2) assms(2) unfolding subset_eq by auto - have fin: "finite t" and "t \ s" - unfolding t_def using obt(1,2) by auto - then have "finite (insert a t)" and "insert a t \ insert a s" + have "0 \ S'" + using S(2) assms(2) unfolding subset_eq by auto + have fin: "finite T" and "T \ S" + unfolding T_def using S(1,2) by auto + then have "finite (insert a T)" and "insert a T \ insert a S" by auto - moreover have *: "\P Q. (\x\t. (if x = a then P x else Q x)) = (\x\t. Q x)" - apply (rule sum.cong) - using \a\s\ \t\s\ - apply auto - done - have "(\x\insert a t. if x = a then - (\x\t. u (x - a)) else u (x - a)) = 0" - unfolding sum_clauses(2)[OF fin] * using \a\s\ \t\s\ by auto - moreover have "\v\insert a t. (if v = a then - (\x\t. u (x - a)) else u (v - a)) \ 0" - using obt(3,4) \0\S\ - by (rule_tac x="v + a" in bexI) (auto simp: t_def) - moreover have *: "\P Q. (\x\t. (if x = a then P x else Q x) *\<^sub>R x) = (\x\t. Q x *\<^sub>R x)" - using \a\s\ \t\s\ by (auto intro!: sum.cong) - have "(\x\t. u (x - a)) *\<^sub>R a = (\v\t. u (v - a) *\<^sub>R v)" + moreover have *: "\P Q. (\x\T. (if x = a then P x else Q x)) = (\x\T. Q x)" + by (smt (verit, best) \T \ S\ assms(2) subsetD sum.cong) + have "(\x\insert a T. if x = a then - (\x\T. U (x - a)) else U (x - a)) = 0" + by (smt (verit) \T \ S\ assms(2) fin insert_absorb insert_subset sum.insert sum_mono) + moreover have "\v\insert a T. (if v = a then - (\x\T. U (x - a)) else U (v - a)) \ 0" + using S(3,4) \0\S'\ + by (rule_tac x="v + a" in bexI) (auto simp: T_def) + moreover have *: "\P Q. (\x\T. (if x = a then P x else Q x) *\<^sub>R x) = (\x\T. Q x *\<^sub>R x)" + using \a\S\ \T\S\ by (auto intro!: sum.cong) + have "(\x\T. U (x - a)) *\<^sub>R a = (\v\T. U (v - a) *\<^sub>R v)" unfolding scaleR_left.sum - unfolding t_def and sum.reindex[OF inj] and o_def - using obt(5) + unfolding T_def and sum.reindex[OF inj] and o_def + using S(5) by (auto simp: sum.distrib scaleR_right_distrib) - then have "(\v\insert a t. (if v = a then - (\x\t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0" - unfolding sum_clauses(2)[OF fin] - using \a\s\ \t\s\ - by (auto simp: *) + then have "(\v\insert a T. (if v = a then - (\x\T. U (x - a)) else U (v - a)) *\<^sub>R v) = 0" + unfolding sum_clauses(2)[OF fin] using \a\S\ \T\S\ by (auto simp: *) ultimately show ?thesis unfolding affine_dependent_explicit - apply (rule_tac x="insert a t" in exI, auto) - done + by (force intro!: exI[where x="insert a T"]) qed lemma affine_dependent_biggerset: - fixes s :: "'a::euclidean_space set" - assumes "finite s" "card s \ DIM('a) + 2" - shows "affine_dependent s" + fixes S :: "'a::euclidean_space set" + assumes "finite S" "card S \ DIM('a) + 2" + shows "affine_dependent S" proof - - have "s \ {}" using assms by auto - then obtain a where "a\s" by auto - have *: "{x - a |x. x \ s - {a}} = (\x. x - a) ` (s - {a})" + have "S \ {}" using assms by auto + then obtain a where "a\S" by auto + have *: "{x - a |x. x \ S - {a}} = (\x. x - a) ` (S - {a})" by auto - have "card {x - a |x. x \ s - {a}} = card (s - {a})" + have "card {x - a |x. x \ S - {a}} = card (S - {a})" unfolding * by (simp add: card_image inj_on_def) also have "\ > DIM('a)" using assms(2) - unfolding card_Diff_singleton[OF \a\s\] by auto - finally show ?thesis - apply (subst insert_Diff[OF \a\s\, symmetric]) - apply (rule dependent_imp_affine_dependent) - apply (rule dependent_biggerset, auto) - done + unfolding card_Diff_singleton[OF \a\S\] by auto + finally have "affine_dependent (insert a (S - {a}))" + using dependent_biggerset dependent_imp_affine_dependent by blast + then show ?thesis + by (simp add: \a \ S\ insert_absorb) qed lemma affine_dependent_biggerset_general: @@ -822,13 +696,10 @@ also have "\ < dim S + 1" by auto also have "\ \ card (S - {a})" using assms card_Diff_singleton[OF \a\S\] by auto - finally show ?thesis - apply (subst insert_Diff[OF \a\S\, symmetric]) - apply (rule dependent_imp_affine_dependent) - apply (rule dependent_biggerset_general) - unfolding ** - apply auto - done + finally have "affine_dependent (insert a (S - {a}))" + by (smt (verit) Collect_cong dependent_imp_affine_dependent dependent_biggerset_general ** Diff_iff insertCI) + then show ?thesis + by (simp add: \a \ S\ insert_absorb) qed @@ -882,16 +753,7 @@ lemma affine_dependent_translation_eq: "affine_dependent S \ affine_dependent ((\x. a + x) ` S)" -proof - - { - assume "affine_dependent ((\x. a + x) ` S)" - then have "affine_dependent S" - using affine_dependent_translation[of "((\x. a + x) ` S)" "-a"] translation_assoc[of "-a" a] - by auto - } - then show ?thesis - using affine_dependent_translation by auto -qed + by (metis affine_dependent_translation translation_galois) lemma affine_hull_0_dependent: assumes "0 \ affine hull S" @@ -919,14 +781,8 @@ ultimately have "x \ span (S - {x})" by auto then have "x \ 0 \ dependent S" using x dependent_def by auto - moreover - { - assume "x = 0" - then have "0 \ affine hull S" - using x hull_mono[of "S - {0}" S] by auto - then have "dependent S" - using affine_hull_0_dependent by auto - } + moreover have "dependent S" if "x = 0" + by (metis that affine_hull_0_dependent Diff_insert_absorb dependent_zero x) ultimately show ?thesis by auto qed @@ -945,60 +801,45 @@ lemma affine_dependent_iff_dependent2: assumes "a \ S" shows "affine_dependent S \ dependent ((\x. -a + x) ` (S-{a}))" -proof - - have "insert a (S - {a}) = S" - using assms by auto - then show ?thesis - using assms affine_dependent_iff_dependent[of a "S-{a}"] by auto -qed + by (metis Diff_iff affine_dependent_iff_dependent assms insert_Diff singletonI) lemma affine_hull_insert_span_gen: - "affine hull (insert a s) = (\x. a + x) ` span ((\x. - a + x) ` s)" + "affine hull (insert a S) = (\x. a + x) ` span ((\x. - a + x) ` S)" proof - - have h1: "{x - a |x. x \ s} = ((\x. -a+x) ` s)" + have h1: "{x - a |x. x \ S} = ((\x. -a+x) ` S)" by auto { - assume "a \ s" + assume "a \ S" then have ?thesis - using affine_hull_insert_span[of a s] h1 by auto + using affine_hull_insert_span[of a S] h1 by auto } moreover { - assume a1: "a \ s" - have "\x. x \ s \ -a+x=0" - apply (rule exI[of _ a]) - using a1 - apply auto - done - then have "insert 0 ((\x. -a+x) ` (s - {a})) = (\x. -a+x) ` s" + assume a1: "a \ S" + then have "insert 0 ((\x. -a+x) ` (S - {a})) = (\x. -a+x) ` S" by auto - then have "span ((\x. -a+x) ` (s - {a}))=span ((\x. -a+x) ` s)" - using span_insert_0[of "(+) (- a) ` (s - {a})"] by (auto simp del: uminus_add_conv_diff) - moreover have "{x - a |x. x \ (s - {a})} = ((\x. -a+x) ` (s - {a}))" + then have "span ((\x. -a+x) ` (S - {a})) = span ((\x. -a+x) ` S)" + using span_insert_0[of "(+) (- a) ` (S - {a})"] + by presburger + moreover have "{x - a |x. x \ (S - {a})} = ((\x. -a+x) ` (S - {a}))" by auto - moreover have "insert a (s - {a}) = insert a s" + moreover have "insert a (S - {a}) = insert a S" by auto ultimately have ?thesis - using affine_hull_insert_span[of "a" "s-{a}"] by auto + using affine_hull_insert_span[of "a" "S-{a}"] by auto } ultimately show ?thesis by auto qed lemma affine_hull_span2: - assumes "a \ s" - shows "affine hull s = (\x. a+x) ` span ((\x. -a+x) ` (s-{a}))" - using affine_hull_insert_span_gen[of a "s - {a}", unfolded insert_Diff[OF assms]] - by auto + assumes "a \ S" + shows "affine hull S = (\x. a+x) ` span ((\x. -a+x) ` (S-{a}))" + by (metis affine_hull_insert_span_gen assms insert_Diff) lemma affine_hull_span_gen: - assumes "a \ affine hull s" - shows "affine hull s = (\x. a+x) ` span ((\x. -a+x) ` s)" -proof - - have "affine hull (insert a s) = affine hull s" - using hull_redundant[of a affine s] assms by auto - then show ?thesis - using affine_hull_insert_span_gen[of a "s"] by auto -qed + assumes "a \ affine hull S" + shows "affine hull S = (\x. a+x) ` span ((\x. -a+x) ` S)" + by (metis affine_hull_insert_span_gen assms hull_redundant) lemma affine_hull_span_0: assumes "0 \ affine hull S" @@ -1044,29 +885,13 @@ lemma affine_basis_exists: fixes V :: "'n::real_vector set" shows "\B. B \ V \ \ affine_dependent B \ affine hull V = affine hull B" -proof (cases "V = {}") - case True - then show ?thesis - using affine_independent_0 by auto -next - case False - then obtain x where "x \ V" by auto - then show ?thesis - using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V] - by auto -qed + by (metis affine_dependent_def affine_independent_1 empty_subsetI extend_to_affine_basis_nonempty insert_subset order_refl) proposition extend_to_affine_basis: fixes S V :: "'n::real_vector set" assumes "\ affine_dependent S" "S \ V" obtains T where "\ affine_dependent T" "S \ T" "T \ V" "affine hull T = affine hull V" -proof (cases "S = {}") - case True then show ?thesis - using affine_basis_exists by (metis empty_subsetI that) -next - case False - then show ?thesis by (metis assms extend_to_affine_basis_nonempty that) -qed + by (metis affine_basis_exists assms(1) assms(2) bot.extremum extend_to_affine_basis_nonempty) subsection \Affine Dimension of a Set\ @@ -1095,7 +920,7 @@ by (metis affine_empty subset_empty subset_hull) lemma empty_eq_affine_hull[simp]: "{} = affine hull S \ S = {}" -by (metis affine_hull_eq_empty) + by (metis affine_hull_eq_empty) lemma aff_dim_parallel_subspace_aux: fixes B :: "'n::euclidean_space set" @@ -1146,7 +971,7 @@ define Lb where "Lb = span ((\x. -a+x) ` (B-{a}))" moreover have "affine_parallel (affine hull B) Lb" using Lb_def B assms affine_hull_span2[of a B] a - affine_parallel_commut[of "Lb" "(affine hull B)"] + affine_parallel_commute[of "Lb" "(affine hull B)"] unfolding affine_parallel_def by auto moreover have "subspace Lb" @@ -1168,15 +993,7 @@ fixes B :: "'n::euclidean_space set" assumes "\ affine_dependent B" shows "finite B" -proof - - { - assume "B \ {}" - then obtain a where "a \ B" by auto - then have ?thesis - using aff_dim_parallel_subspace_aux assms by auto - } - then show ?thesis by auto -qed + using aff_dim_parallel_subspace_aux assms finite.simps by fastforce lemma aff_dim_empty: @@ -1195,7 +1012,7 @@ qed lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1" - by (simp add: aff_dim_empty [symmetric]) + using aff_dim_empty by blast lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S" unfolding aff_dim_def using hull_hull[of _ S] by auto @@ -1224,7 +1041,7 @@ define Lb where "Lb = span ((\x. -a+x) ` (B-{a}))" have "affine_parallel (affine hull B) Lb" using Lb_def affine_hull_span2[of a B] a - affine_parallel_commut[of "Lb" "(affine hull B)"] + affine_parallel_commute[of "Lb" "(affine hull B)"] unfolding affine_parallel_def by auto moreover have "subspace Lb" using Lb_def subspace_span by auto @@ -1245,11 +1062,14 @@ using aff_dim_unique[of B B] assms by auto lemma affine_independent_iff_card: - fixes s :: "'a::euclidean_space set" - shows "\ affine_dependent s \ finite s \ aff_dim s = int(card s) - 1" - apply (rule iffI) - apply (simp add: aff_dim_affine_independent aff_independent_finite) - by (metis affine_basis_exists [of s] aff_dim_unique card_subset_eq diff_add_cancel of_nat_eq_iff) + fixes S :: "'a::euclidean_space set" + shows "\ affine_dependent S \ finite S \ aff_dim S = int(card S) - 1" (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + by (simp add: aff_dim_affine_independent aff_independent_finite) + show "?rhs \ ?lhs" + by (metis of_nat_eq_iff affine_basis_exists aff_dim_unique card_subset_eq diff_add_cancel) +qed lemma aff_dim_sing [simp]: fixes a :: "'n::euclidean_space" @@ -1272,78 +1092,39 @@ fixes V :: "('n::euclidean_space) set" shows "\B. B \ V \ affine hull B = affine hull V \ \ affine_dependent B \ of_nat (card B) = aff_dim V + 1" -proof - - obtain B where B: "\ affine_dependent B" "B \ V" "affine hull B = affine hull V" - using affine_basis_exists[of V] by auto - then have "of_nat(card B) = aff_dim V+1" using aff_dim_unique by auto - with B show ?thesis by auto -qed + by (metis aff_dim_unique affine_basis_exists) lemma aff_dim_le_card: fixes V :: "'n::euclidean_space set" assumes "finite V" shows "aff_dim V \ of_nat (card V) - 1" -proof - - obtain B where B: "B \ V" "of_nat (card B) = aff_dim V + 1" - using aff_dim_inner_basis_exists[of V] by auto - then have "card B \ card V" - using assms card_mono by auto - with B show ?thesis by auto + by (metis aff_dim_inner_basis_exists assms card_mono le_diff_eq of_nat_le_iff) + +lemma aff_dim_parallel_le: + fixes S T :: "'n::euclidean_space set" + assumes "affine_parallel (affine hull S) (affine hull T)" + shows "aff_dim S \ aff_dim T" +proof (cases "S={} \ T={}") + case True + then show ?thesis + by (smt (verit, best) aff_dim_affine_hull2 affine_hull_empty affine_parallel_def assms empty_is_image) +next + case False + then obtain L where L: "subspace L" "affine_parallel (affine hull T) L" + by (metis affine_affine_hull affine_hull_eq_empty affine_parallel_subspace) + with False show ?thesis + by (metis aff_dim_parallel_subspace affine_parallel_assoc assms dual_order.refl) qed lemma aff_dim_parallel_eq: fixes S T :: "'n::euclidean_space set" assumes "affine_parallel (affine hull S) (affine hull T)" shows "aff_dim S = aff_dim T" -proof - - { - assume "T \ {}" "S \ {}" - then obtain L where L: "subspace L \ affine_parallel (affine hull T) L" - using affine_parallel_subspace[of "affine hull T"] - affine_affine_hull[of T] - by auto - then have "aff_dim T = int (dim L)" - using aff_dim_parallel_subspace \T \ {}\ by auto - moreover have *: "subspace L \ affine_parallel (affine hull S) L" - using L affine_parallel_assoc[of "affine hull S" "affine hull T" L] assms by auto - moreover from * have "aff_dim S = int (dim L)" - using aff_dim_parallel_subspace \S \ {}\ by auto - ultimately have ?thesis by auto - } - moreover - { - assume "S = {}" - then have "S = {}" and "T = {}" - using assms - unfolding affine_parallel_def - by auto - then have ?thesis using aff_dim_empty by auto - } - moreover - { - assume "T = {}" - then have "S = {}" and "T = {}" - using assms - unfolding affine_parallel_def - by auto - then have ?thesis - using aff_dim_empty by auto - } - ultimately show ?thesis by blast -qed + by (smt (verit, del_insts) aff_dim_parallel_le affine_parallel_commute assms) lemma aff_dim_translation_eq: "aff_dim ((+) a ` S) = aff_dim S" for a :: "'n::euclidean_space" -proof - - have "affine_parallel (affine hull S) (affine hull ((\x. a + x) ` S))" - unfolding affine_parallel_def - apply (rule exI[of _ "a"]) - using affine_hull_translation[of a S] - apply auto - done - then show ?thesis - using aff_dim_parallel_eq[of S "(\x. a + x) ` S"] by auto -qed + by (metis aff_dim_parallel_eq affine_hull_translation affine_parallel_def) lemma aff_dim_translation_eq_subtract: "aff_dim ((\x. x - a) ` S) = aff_dim S" for a :: "'n::euclidean_space" @@ -1351,97 +1132,51 @@ lemma aff_dim_affine: fixes S L :: "'n::euclidean_space set" - assumes "S \ {}" - and "affine S" - and "subspace L" - and "affine_parallel S L" + assumes "affine S" "subspace L" "affine_parallel S L" "S \ {}" shows "aff_dim S = int (dim L)" -proof - - have *: "affine hull S = S" - using assms affine_hull_eq[of S] by auto - then have "affine_parallel (affine hull S) L" - using assms by (simp add: *) - then show ?thesis - using assms aff_dim_parallel_subspace[of S L] by blast -qed + by (simp add: aff_dim_parallel_subspace assms hull_same) -lemma dim_affine_hull: +lemma dim_affine_hull [simp]: fixes S :: "'n::euclidean_space set" shows "dim (affine hull S) = dim S" -proof - - have "dim (affine hull S) \ dim S" - using dim_subset by auto - moreover have "dim (span S) \ dim (affine hull S)" - using dim_subset affine_hull_subset_span by blast - moreover have "dim (span S) = dim S" - using dim_span by auto - ultimately show ?thesis by auto -qed + by (metis affine_hull_subset_span dim_eq_span dim_mono hull_subset span_eq_dim) lemma aff_dim_subspace: fixes S :: "'n::euclidean_space set" assumes "subspace S" shows "aff_dim S = int (dim S)" -proof (cases "S={}") - case True with assms show ?thesis - by (simp add: subspace_affine) -next - case False - with aff_dim_affine[of S S] assms subspace_imp_affine[of S] affine_parallel_reflex[of S] subspace_affine - show ?thesis by auto -qed + by (metis aff_dim_affine affine_parallel_subspace assms empty_iff parallel_subspace subspace_affine) lemma aff_dim_zero: fixes S :: "'n::euclidean_space set" assumes "0 \ affine hull S" shows "aff_dim S = int (dim S)" -proof - - have "subspace (affine hull S)" - using subspace_affine[of "affine hull S"] affine_affine_hull assms - by auto - then have "aff_dim (affine hull S) = int (dim (affine hull S))" - using assms aff_dim_subspace[of "affine hull S"] by auto - then show ?thesis - using aff_dim_affine_hull[of S] dim_affine_hull[of S] - by auto -qed + by (metis aff_dim_affine_hull aff_dim_subspace affine_hull_span_0 assms dim_span subspace_span) lemma aff_dim_eq_dim: - "aff_dim S = int (dim ((+) (- a) ` S))" if "a \ affine hull S" - for S :: "'n::euclidean_space set" -proof - - have "0 \ affine hull (+) (- a) ` S" - unfolding affine_hull_translation - using that by (simp add: ac_simps) - with aff_dim_zero show ?thesis - by (metis aff_dim_translation_eq) -qed + fixes S :: "'n::euclidean_space set" + assumes "a \ affine hull S" + shows "aff_dim S = int (dim ((+) (- a) ` S))" + by (metis ab_left_minus aff_dim_translation_eq aff_dim_zero affine_hull_translation image_eqI assms) lemma aff_dim_eq_dim_subtract: - "aff_dim S = int (dim ((\x. x - a) ` S))" if "a \ affine hull S" - for S :: "'n::euclidean_space set" - using aff_dim_eq_dim [of a] that by (simp cong: image_cong_simp) + fixes S :: "'n::euclidean_space set" + assumes "a \ affine hull S" + shows "aff_dim S = int (dim ((\x. x - a) ` S))" + using aff_dim_eq_dim assms by auto lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))" - using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"] - dim_UNIV[where 'a="'n::euclidean_space"] - by auto + by (simp add: aff_dim_subspace) lemma aff_dim_geq: fixes V :: "'n::euclidean_space set" shows "aff_dim V \ -1" -proof - - obtain B where "affine hull B = affine hull V" - and "\ affine_dependent B" - and "int (card B) = aff_dim V + 1" - using aff_dim_basis_exists by auto - then show ?thesis by auto -qed + by (metis add_le_cancel_right aff_dim_basis_exists diff_self of_nat_0_le_iff uminus_add_conv_diff) lemma aff_dim_negative_iff [simp]: fixes S :: "'n::euclidean_space set" - shows "aff_dim S < 0 \S = {}" -by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq) + shows "aff_dim S < 0 \ S = {}" + by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq) lemma aff_lowdim_subset_hyperplane: fixes S :: "'a::euclidean_space set" @@ -1482,83 +1217,48 @@ fixes S :: "'a :: euclidean_space set" assumes "\ affine_dependent S" "a \ S" shows "card S = dim ((\x. x - a) ` S) + 1" -proof - - have non: "\ affine_dependent (insert a S)" - by (simp add: assms insert_absorb) - have "finite S" - by (meson assms aff_independent_finite) - with \a \ S\ have "card S \ 0" by auto - moreover have "dim ((\x. x - a) ` S) = card S - 1" - using aff_dim_eq_dim_subtract aff_dim_unique \a \ S\ hull_inc insert_absorb non by fastforce - ultimately show ?thesis - by auto -qed + using aff_dim_affine_independent aff_dim_eq_dim_subtract assms hull_subset by fastforce lemma independent_card_le_aff_dim: fixes B :: "'n::euclidean_space set" assumes "B \ V" assumes "\ affine_dependent B" shows "int (card B) \ aff_dim V + 1" -proof - - obtain T where T: "\ affine_dependent T \ B \ T \ T \ V \ affine hull T = affine hull V" - by (metis assms extend_to_affine_basis[of B V]) - then have "of_nat (card T) = aff_dim V + 1" - using aff_dim_unique by auto - then show ?thesis - using T card_mono[of T B] aff_independent_finite[of T] by auto -qed + by (metis aff_dim_unique aff_independent_finite assms card_mono extend_to_affine_basis of_nat_mono) lemma aff_dim_subset: fixes S T :: "'n::euclidean_space set" assumes "S \ T" shows "aff_dim S \ aff_dim T" -proof - - obtain B where B: "\ affine_dependent B" "B \ S" "affine hull B = affine hull S" - "of_nat (card B) = aff_dim S + 1" - using aff_dim_inner_basis_exists[of S] by auto - then have "int (card B) \ aff_dim T + 1" - using assms independent_card_le_aff_dim[of B T] by auto - with B show ?thesis by auto -qed + by (metis add_le_cancel_right aff_dim_inner_basis_exists assms dual_order.trans independent_card_le_aff_dim) lemma aff_dim_le_DIM: fixes S :: "'n::euclidean_space set" shows "aff_dim S \ int (DIM('n))" -proof - - have "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))" - using aff_dim_UNIV by auto - then show "aff_dim (S:: 'n::euclidean_space set) \ int(DIM('n))" - using aff_dim_subset[of S "(UNIV :: ('n::euclidean_space) set)"] subset_UNIV by auto -qed + by (metis aff_dim_UNIV aff_dim_subset top_greatest) lemma affine_dim_equal: fixes S :: "'n::euclidean_space set" assumes "affine S" "affine T" "S \ {}" "S \ T" "aff_dim S = aff_dim T" shows "S = T" proof - - obtain a where "a \ S" using assms by auto - then have "a \ T" using assms by auto + obtain a where "a \ S" "a \ T" "T \ {}" using assms by auto define LS where "LS = {y. \x \ S. (-a) + x = y}" then have ls: "subspace LS" "affine_parallel S LS" using assms parallel_subspace_explicit[of S a LS] \a \ S\ by auto then have h1: "int(dim LS) = aff_dim S" using assms aff_dim_affine[of S LS] by auto - have "T \ {}" using assms by auto define LT where "LT = {y. \x \ T. (-a) + x = y}" then have lt: "subspace LT \ affine_parallel T LT" using assms parallel_subspace_explicit[of T a LT] \a \ T\ by auto - then have "int(dim LT) = aff_dim T" - using assms aff_dim_affine[of T LT] \T \ {}\ by auto then have "dim LS = dim LT" - using h1 assms by auto + using assms aff_dim_affine[of T LT] \T \ {}\ h1 by auto moreover have "LS \ LT" using LS_def LT_def assms by auto ultimately have "LS = LT" using subspace_dim_equal[of LS LT] ls lt by auto - moreover have "S = {x. \y \ LS. a+y=x}" - using LS_def by auto - moreover have "T = {x. \y \ LT. a+y=x}" - using LT_def by auto + moreover have "S = {x. \y \ LS. a+y=x}" "T = {x. \y \ LT. a+y=x}" + using LS_def LT_def by auto ultimately show ?thesis by auto qed @@ -1566,10 +1266,6 @@ fixes S :: "'a::euclidean_space set" shows "aff_dim S = 0 \ (\a. S = {a})" proof (cases "S = {}") - case True - then show ?thesis - by auto -next case False then obtain a where "a \ S" by auto show ?thesis @@ -1580,58 +1276,39 @@ then show "\a. S = {a}" using \a \ S\ by blast qed auto -qed +qed auto lemma affine_hull_UNIV: fixes S :: "'n::euclidean_space set" assumes "aff_dim S = int(DIM('n))" shows "affine hull S = (UNIV :: ('n::euclidean_space) set)" -proof - - have "S \ {}" - using assms aff_dim_empty[of S] by auto - have h0: "S \ affine hull S" - using hull_subset[of S _] by auto - have h1: "aff_dim (UNIV :: ('n::euclidean_space) set) = aff_dim S" - using aff_dim_UNIV assms by auto - then have h2: "aff_dim (affine hull S) \ aff_dim (UNIV :: ('n::euclidean_space) set)" - using aff_dim_le_DIM[of "affine hull S"] assms h0 by auto - have h3: "aff_dim S \ aff_dim (affine hull S)" - using h0 aff_dim_subset[of S "affine hull S"] assms by auto - then have h4: "aff_dim (affine hull S) = aff_dim (UNIV :: ('n::euclidean_space) set)" - using h0 h1 h2 by auto - then show ?thesis - using affine_dim_equal[of "affine hull S" "(UNIV :: ('n::euclidean_space) set)"] - affine_affine_hull[of S] affine_UNIV assms h4 h0 \S \ {}\ - by auto -qed + by (simp add: aff_dim_empty affine_dim_equal assms) lemma disjoint_affine_hull: - fixes s :: "'n::euclidean_space set" - assumes "\ affine_dependent s" "t \ s" "u \ s" "t \ u = {}" - shows "(affine hull t) \ (affine hull u) = {}" + fixes S :: "'n::euclidean_space set" + assumes "\ affine_dependent S" "T \ S" "U \ S" "T \ U = {}" + shows "(affine hull T) \ (affine hull U) = {}" proof - - from assms(1) have "finite s" - by (simp add: aff_independent_finite) - with assms(2,3) have "finite t" "finite u" - by (blast intro: finite_subset)+ - have False if "y \ affine hull t" and "y \ affine hull u" for y + obtain "finite S" "finite T" "finite U" + using assms by (simp add: aff_independent_finite finite_subset) + have False if "y \ affine hull T" and "y \ affine hull U" for y proof - from that obtain a b - where a1 [simp]: "sum a t = 1" - and [simp]: "sum (\v. a v *\<^sub>R v) t = y" - and [simp]: "sum b u = 1" "sum (\v. b v *\<^sub>R v) u = y" - by (auto simp: affine_hull_finite \finite t\ \finite u\) - define c where "c x = (if x \ t then a x else if x \ u then -(b x) else 0)" for x - from assms(2,3,4) have [simp]: "s \ t = t" "s \ - t \ u = u" - by auto - have "sum c s = 0" - by (simp add: c_def comm_monoid_add_class.sum.If_cases \finite s\ sum_negf) - moreover have "\ (\v\s. c v = 0)" - by (metis (no_types) IntD1 \s \ t = t\ a1 c_def sum.neutral zero_neq_one) - moreover have "(\v\s. c v *\<^sub>R v) = 0" - by (simp add: c_def if_smult sum_negf comm_monoid_add_class.sum.If_cases \finite s\) + where a1 [simp]: "sum a T = 1" + and [simp]: "sum (\v. a v *\<^sub>R v) T = y" + and [simp]: "sum b U = 1" "sum (\v. b v *\<^sub>R v) U = y" + by (auto simp: affine_hull_finite \finite T\ \finite U\) + define c where "c x = (if x \ T then a x else if x \ U then -(b x) else 0)" for x + have [simp]: "S \ T = T" "S \ - T \ U = U" + using assms by auto + have "sum c S = 0" + by (simp add: c_def comm_monoid_add_class.sum.If_cases \finite S\ sum_negf) + moreover have "\ (\v\S. c v = 0)" + by (metis (no_types) IntD1 \S \ T = T\ a1 c_def sum.neutral zero_neq_one) + moreover have "(\v\S. c v *\<^sub>R v) = 0" + by (simp add: c_def if_smult sum_negf comm_monoid_add_class.sum.If_cases \finite S\) ultimately show ?thesis - using assms(1) \finite s\ by (auto simp: affine_dependent_explicit) + using assms(1) \finite S\ by (auto simp: affine_dependent_explicit) qed then show ?thesis by blast qed diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Borel_Space.thy --- a/src/HOL/Analysis/Borel_Space.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Borel_Space.thy Mon Sep 11 22:59:34 2023 +0200 @@ -77,13 +77,7 @@ using of_rat_dense by blast assume * [rule_format]: "\d>0. \x\A. x \ a \ dist x a < d \ \ l < f x" from q2 have "real_of_rat q2 < f a \ (\x\A. x < a \ f x < real_of_rat q2)" - proof auto - fix x assume "x \ A" "x < a" - with q2 *[of "a - x"] show "f x < real_of_rat q2" - apply (auto simp add: dist_real_def not_less) - apply (subgoal_tac "f x \ f xa") - by (auto intro: mono) - qed + using q2 *[of "a - _"] dist_real_def mono by fastforce thus ?thesis by auto next fix u assume "u > f a" @@ -91,13 +85,7 @@ using of_rat_dense by blast assume *[rule_format]: "\d>0. \x\A. x \ a \ dist x a < d \ \ u > f x" from q2 have "real_of_rat q2 > f a \ (\x\A. x > a \ f x > real_of_rat q2)" - proof auto - fix x assume "x \ A" "x > a" - with q2 *[of "x - a"] show "f x > real_of_rat q2" - apply (auto simp add: dist_real_def) - apply (subgoal_tac "f x \ f xa") - by (auto intro: mono) - qed + using q2 *[of "_ - a"] dist_real_def mono by fastforce thus ?thesis by auto qed qed @@ -127,13 +115,8 @@ fixes A :: "real set" assumes "open A" "mono_on A f" shows "countable {a\A. \isCont f a}" -proof - - have "{a\A. \isCont f a} = {a\A. \(continuous (at a within A) f)}" - by (auto simp add: continuous_within_open [OF _ \open A\]) - thus ?thesis - apply (elim ssubst) - by (rule mono_on_ctble_discont, rule assms) -qed + using continuous_within_open [OF _ \open A\] \mono_on A f\ + by (smt (verit, ccfv_threshold) Collect_cong mono_on_ctble_discont) lemma mono_ctble_discont: fixes f :: "real \ real" @@ -144,8 +127,7 @@ lemma has_real_derivative_imp_continuous_on: assumes "\x. x \ A \ (f has_real_derivative f' x) (at x)" shows "continuous_on A f" - apply (intro differentiable_imp_continuous_on, unfold differentiable_on_def) - using assms differentiable_at_withinI real_differentiable_def by blast + by (meson DERIV_isCont assms continuous_at_imp_continuous_on) lemma continuous_interval_vimage_Int: assumes "continuous_on {a::real..b} g" and mono: "\x y. a \ x \ x \ y \ y \ b \ g x \ g y" @@ -173,14 +155,11 @@ intro!: mono) moreover have "c' \ d'" using c'd'_in_set(2) unfolding c'_def by (intro cInf_lower) auto moreover have "g c' \ c" "g d' \ d" - apply (insert c'' d'' c'd'_in_set) - apply (subst c''(2)[symmetric]) - apply (auto simp: c'_def intro!: mono cInf_lower c'') [] - apply (subst d''(2)[symmetric]) - apply (auto simp: d'_def intro!: mono cSup_upper d'') [] - done - with c'd'_in_set have "g c' = c" "g d' = d" by auto - ultimately show ?thesis using that by blast + using c'' d'' calculation by (metis IntE atLeastAtMost_iff mono order_class.order_eq_iff)+ + with c'd'_in_set have "g c' = c" "g d' = d" + by auto + ultimately show ?thesis + using that by blast qed subsection \Generic Borel spaces\ @@ -196,9 +175,7 @@ by (auto simp add: measurable_def borel_def) lemma in_borel_measurable_borel: - "f \ borel_measurable M \ - (\S \ sets borel. - f -` S \ space M \ sets M)" + "f \ borel_measurable M \ (\S \ sets borel. f -` S \ space M \ sets M)" by (auto simp add: measurable_def borel_def) lemma space_borel[simp]: "space borel = UNIV" @@ -219,10 +196,7 @@ lemma borel_open[measurable (raw generic)]: assumes "open A" shows "A \ sets borel" -proof - - have "A \ {S. open S}" unfolding mem_Collect_eq using assms . - thus ?thesis unfolding borel_def by auto -qed + by (simp add: assms sets_borel) lemma borel_closed[measurable (raw generic)]: assumes "closed A" shows "A \ sets borel" @@ -237,12 +211,7 @@ unfolding insert_def by (rule sets.Un) auto lemma sets_borel_eq_count_space: "sets (borel :: 'a::{countable, t2_space} measure) = count_space UNIV" -proof - - have "(\a\A. {a}) \ sets borel" for A :: "'a set" - by (intro sets.countable_UN') auto - then show ?thesis - by auto -qed + by (simp add: set_eq_iff sets.countable) lemma borel_comp[measurable]: "A \ sets borel \ - A \ sets borel" unfolding Compl_eq_Diff_UNIV by simp @@ -312,7 +281,7 @@ shows "f \ borel_measurable (restrict_space M \) \ (\x. f x * indicator \ x) \ borel_measurable M" by (subst measurable_restrict_space_iff) - (auto simp: indicator_def of_bool_def if_distrib[where f="\x. a * x" for a] cong del: if_weak_cong) + (auto simp: indicator_def of_bool_def if_distrib[where f="\x. a * x" for a] cong: if_cong) lemma borel_measurable_restrict_space_iff_ennreal: fixes f :: "'a \ ennreal" @@ -320,7 +289,7 @@ shows "f \ borel_measurable (restrict_space M \) \ (\x. f x * indicator \ x) \ borel_measurable M" by (subst measurable_restrict_space_iff) - (auto simp: indicator_def of_bool_def if_distrib[where f="\x. a * x" for a] cong del: if_weak_cong) + (auto simp: indicator_def of_bool_def if_distrib[where f="\x. a * x" for a] cong: if_cong) lemma borel_measurable_restrict_space_iff: fixes f :: "'a \ 'b::real_normed_vector" @@ -329,7 +298,7 @@ (\x. indicator \ x *\<^sub>R f x) \ borel_measurable M" by (subst measurable_restrict_space_iff) (auto simp: indicator_def of_bool_def if_distrib[where f="\x. x *\<^sub>R a" for a] ac_simps - cong del: if_weak_cong) + cong: if_cong) lemma cbox_borel[measurable]: "cbox a b \ sets borel" by (auto intro: borel_closed) @@ -338,7 +307,7 @@ by (auto intro: borel_open) lemma borel_compact: "compact (A::'a::t2_space set) \ A \ sets borel" - by (auto intro: borel_closed dest!: compact_imp_closed) + by (simp add: borel_closed compact_imp_closed) lemma borel_sigma_sets_subset: "A \ sets borel \ sigma_sets UNIV A \ sets borel" @@ -360,7 +329,7 @@ using X by (intro sigma_algebra.sigma_sets_subset[OF sigma_algebra_sigma_sets]) auto finally show "sigma_sets UNIV {S. open S} \ sigma_sets UNIV (F`A)" . show "sigma_sets UNIV (F`A) \ sigma_sets UNIV {S. open S}" - unfolding borel_rev_eq using F by (intro borel_sigma_sets_subset) auto + by (metis F image_subset_iff sets_borel sigma_sets_mono) qed auto lemma borel_eq_sigmaI2: @@ -371,7 +340,7 @@ assumes F: "\i j. (i, j) \ A \ F i j \ sets borel" shows "borel = sigma UNIV ((\(i, j). F i j) ` A)" using assms - by (intro borel_eq_sigmaI1[where X="(\(i, j). G i j) ` B" and F="(\(i, j). F i j)"]) auto + by (smt (verit, del_insts) borel_eq_sigmaI1 image_iff prod.collapse split_beta) lemma borel_eq_sigmaI3: fixes F :: "'i \ 'j \ 'a::topological_space set" and X :: "'a::topological_space set set" @@ -443,20 +412,15 @@ qed (auto simp: eq intro: generate_topology.Basis) lemma borel_eq_closed: "borel = sigma UNIV (Collect closed)" - unfolding borel_def -proof (intro sigma_eqI sigma_sets_eqI, safe) - fix x :: "'a set" assume "open x" - hence "x = UNIV - (UNIV - x)" by auto - also have "\ \ sigma_sets UNIV (Collect closed)" - by (force intro: sigma_sets.Compl simp: \open x\) - finally show "x \ sigma_sets UNIV (Collect closed)" by simp -next - fix x :: "'a set" assume "closed x" - hence "x = UNIV - (UNIV - x)" by auto - also have "\ \ sigma_sets UNIV (Collect open)" - by (force intro: sigma_sets.Compl simp: \closed x\) - finally show "x \ sigma_sets UNIV (Collect open)" by simp -qed simp_all +proof - + have "x \ sigma_sets UNIV (Collect closed)" + if "open x" for x :: "'a set" + by (metis that Compl_eq_Diff_UNIV closed_Compl double_complement mem_Collect_eq + sigma_sets.Basic sigma_sets.Compl) + then show ?thesis + unfolding borel_def + by (metis Pow_UNIV borel_closed mem_Collect_eq sets_borel sigma_eqI sigma_sets_eqI top_greatest) +qed proposition borel_eq_countable_basis: fixes B::"'a::topological_space set set" @@ -517,8 +481,7 @@ lemma borel_measurable_continuous_on_indicator: fixes f g :: "'a::topological_space \ 'b::real_normed_vector" shows "A \ sets borel \ continuous_on A f \ (\x. indicator A x *\<^sub>R f x) \ borel_measurable borel" - by (subst borel_measurable_restrict_space_iff[symmetric]) - (auto intro: borel_measurable_continuous_on_restrict) + using borel_measurable_continuous_on_restrict borel_measurable_restrict_space_iff inf_top.right_neutral by blast lemma borel_measurable_Pair[measurable (raw)]: fixes f :: "'a \ 'b::second_countable_topology" and g :: "'a \ 'c::second_countable_topology" @@ -720,7 +683,7 @@ shows "(\x. SUP i\I. F i x) \ borel_measurable M" proof cases assume "I = {}" then show ?thesis - unfolding \I = {}\ image_empty by simp + by (simp add: borel_measurable_const) next assume "I \ {}" show ?thesis @@ -742,7 +705,7 @@ shows "(\x. INF i\I. F i x) \ borel_measurable M" proof cases assume "I = {}" then show ?thesis - unfolding \I = {}\ image_empty by simp + by (simp add: borel_measurable_const) next assume "I \ {}" show ?thesis @@ -1045,25 +1008,23 @@ proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_le]) fix a :: real and i :: 'a assume "(a, i) \ UNIV \ Basis" then have i: "i \ Basis" by auto - have "{x::'a. x\i \ a} = UNIV - {x::'a. a < x\i}" by auto - also have *: "{x::'a. a < x\i} = - (\k::nat. {x. (\n\Basis. (if n = i then a else -real k) *\<^sub>R n) y. \j\Basis. j \ i \ - real y < x \ j" if "a < x \ i" for x + proof - obtain k where k: "Max ((\) (- x) ` Basis) < real k" using reals_Archimedean2 by blast { fix i :: 'a assume "i \ Basis" then have "-x\i < real k" using k by (subst (asm) Max_less_iff) auto then have "- real k < x\i" by simp } - then show "\k::nat. \ia\Basis. ia \ i \ -real k < x \ ia" + then show ?thesis by (auto intro!: exI[of _ k]) qed - finally show "{x. x\i \ a} \ ?SIGMA" - apply (simp only:) - apply (intro sets.countable_UN sets.Diff) - apply (auto intro: sigma_sets_top) - done + have "{x::'a. x\i \ a} = UNIV - {x::'a. a < x\i}" by auto + also have *: "{x::'a. a < x\i} = (\k::nat. {x. (\n\Basis. (if n = i then a else -k) *\<^sub>R n) i \ a} = UNIV - (\x. {xa. (\n\Basis. (if n = i then a else - real x) *\<^sub>R n) i \ a} \ ?SIGMA" + unfolding eq by (fastforce intro!: sigma_sets_top sets.Diff) qed auto lemma borel_eq_lessThan: @@ -1072,24 +1033,26 @@ proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_ge]) fix a :: real and i :: 'a assume "(a, i) \ UNIV \ Basis" then have i: "i \ Basis" by auto - have "{x::'a. a \ x\i} = UNIV - {x::'a. x\i < a}" by auto - also have *: "{x::'a. x\i < a} = (\k::nat. {x. x n\Basis. (if n = i then a else real k) *\<^sub>R n)})" using \i\ Basis\ - proof (safe, simp_all add: eucl_less_def split: if_split_asm) - fix x :: 'a + have **: "\y. \j\Basis. j \ i \ real y > x \ j" if "a > x \ i" for x + proof - obtain k where k: "Max ((\) x ` Basis) < real k" using reals_Archimedean2 by blast { fix i :: 'a assume "i \ Basis" then have "x\i < real k" using k by (subst (asm) Max_less_iff) auto then have "x\i < real k" by simp } - then show "\k::nat. \ia\Basis. ia \ i \ x \ ia < real k" + then show ?thesis by (auto intro!: exI[of _ k]) qed - finally show "{x. a \ x\i} \ ?SIGMA" - apply (simp only:) - apply (intro sets.countable_UN sets.Diff) - apply (auto intro: sigma_sets_top ) - done + have "{x::'a. a \ x\i} = UNIV - {x::'a. x\i < a}" by auto + also have *: "{x::'a. x\i < a} = (\k::nat. {x. x n\Basis. (if n = i then a else real k) *\<^sub>R n)})" using \i\ Basis\ + using i ** by (force simp add: eucl_less_def split: if_split_asm) + finally + have eq: "{x. a \ x \ i} = + UNIV - (\k. {x. x n\Basis. (if n = i then a else real k) *\<^sub>R n)})" . + + show "{x. a \ x\i} \ ?SIGMA" + unfolding eq by (fastforce intro!: sigma_sets_top sets.Diff) qed auto lemma borel_eq_atLeastAtMost: @@ -1276,9 +1239,7 @@ lemma borel_measurable_uminus_eq [simp]: fixes f :: "'a \ 'b::{second_countable_topology, real_normed_vector}" shows "(\x. - f x) \ borel_measurable M \ f \ borel_measurable M" (is "?l = ?r") -proof - assume ?l from borel_measurable_uminus[OF this] show ?r by simp -qed auto + by (smt (verit, ccfv_SIG) borel_measurable_uminus equation_minus_iff measurable_cong) lemma affine_borel_measurable_vector: fixes f :: "'a \ 'x::real_normed_vector" @@ -1294,8 +1255,10 @@ by (auto simp: algebra_simps) hence "?S \ sets borel" by auto moreover - from \b \ 0\ have "(\x. a + b *\<^sub>R f x) -` S = f -` ?S" - apply auto by (rule_tac x="a + b *\<^sub>R f x" in image_eqI, simp_all) + have "\x. \a + b *\<^sub>R f x \ S\ \ f x \ (\x. (x - a) /\<^sub>R b) ` S" + using \b \ 0\ image_iff by fastforce + with \b \ 0\ have "(\x. a + b *\<^sub>R f x) -` S = f -` ?S" + by auto ultimately show ?thesis using assms unfolding in_borel_measurable_borel by auto qed simp @@ -1313,10 +1276,12 @@ fixes f :: "'a \ 'b::real_normed_div_algebra" assumes f: "f \ borel_measurable M" shows "(\x. inverse (f x)) \ borel_measurable M" - apply (rule measurable_compose[OF f]) - apply (rule borel_measurable_continuous_countable_exceptions[of "{0}"]) - apply (auto intro!: continuous_on_inverse continuous_on_id) - done +proof - + have "countable {0::'b}" "continuous_on (- {0::'b}) inverse" + by (auto intro!: continuous_on_inverse continuous_on_id) + then show ?thesis + by (metis borel_measurable_continuous_countable_exceptions f measurable_compose) +qed lemma borel_measurable_divide[measurable (raw)]: "f \ borel_measurable M \ g \ borel_measurable M \ @@ -1341,10 +1306,8 @@ lemma borel_measurable_ln[measurable (raw)]: assumes f: "f \ borel_measurable M" shows "(\x. ln (f x :: real)) \ borel_measurable M" - apply (rule measurable_compose[OF f]) - apply (rule borel_measurable_continuous_countable_exceptions[of "{0}"]) - apply (auto intro!: continuous_on_ln continuous_on_id) - done + using borel_measurable_continuous_countable_exceptions[of "{0}"] measurable_compose[OF f] + by (auto intro!: continuous_on_ln continuous_on_id) lemma borel_measurable_log[measurable (raw)]: "f \ borel_measurable M \ g \ borel_measurable M \ (\x. log (g x) (f x)) \ borel_measurable M" @@ -1402,12 +1365,16 @@ lemma\<^marker>\tag important\ borel_measurable_complex_iff: "f \ borel_measurable M \ - (\x. Re (f x)) \ borel_measurable M \ (\x. Im (f x)) \ borel_measurable M" - apply auto - apply (subst fun_complex_eq) - apply (intro borel_measurable_add) - apply auto - done + (\x. Re (f x)) \ borel_measurable M \ (\x. Im (f x)) \ borel_measurable M" (is "?lhs \ ?rhs") +proof + show "?lhs \ ?rhs" + using borel_measurable_Im borel_measurable_Re measurable_compose by blast + assume R: ?rhs + then have "(\x. complex_of_real (Re (f x)) + \ * complex_of_real (Im (f x))) \ borel_measurable M" + by (intro borel_measurable_add) auto + then show ?lhs + using complex_eq by force +qed lemma powr_real_measurable [measurable]: assumes "f \ measurable M borel" "g \ measurable M borel" @@ -1427,10 +1394,8 @@ fixes f :: "'a \ ereal" assumes f: "f \ borel_measurable M" shows "(\x. real_of_ereal (f x)) \ borel_measurable M" - apply (rule measurable_compose[OF f]) - apply (rule borel_measurable_continuous_countable_exceptions[of "{\, -\ }"]) - apply (auto intro: continuous_on_real simp: Compl_eq_Diff_UNIV) - done + using measurable_compose[OF f] borel_measurable_continuous_countable_exceptions[of "{\, -\ }"] + by (auto intro: continuous_on_real simp: Compl_eq_Diff_UNIV) lemma borel_measurable_ereal_cases: fixes f :: "'a \ ereal" @@ -1451,10 +1416,8 @@ by (auto simp del: abs_real_of_ereal simp: borel_measurable_ereal_cases[OF f] measurable_If) lemma borel_measurable_uminus_eq_ereal[simp]: - "(\x. - f x :: ereal) \ borel_measurable M \ f \ borel_measurable M" (is "?l = ?r") -proof - assume ?l from borel_measurable_uminus_ereal[OF this] show ?r by simp -qed auto + "(\x. - f x :: ereal) \ borel_measurable M \ f \ borel_measurable M" + by (smt (verit, ccfv_SIG) borel_measurable_uminus_ereal ereal_uminus_uminus measurable_cong) lemma set_Collect_ereal2: fixes f g :: "'a \ ereal" @@ -1511,13 +1474,7 @@ lemma vimage_sets_compl_iff: "f -` A \ space M \ sets M \ f -` (- A) \ space M \ sets M" -proof - - { fix A assume "f -` A \ space M \ sets M" - moreover have "f -` (- A) \ space M = space M - f -` A \ space M" by auto - ultimately have "f -` (- A) \ space M \ sets M" by auto } - from this[of A] this[of "-A"] show ?thesis - by (metis double_complement) -qed + by (metis Diff_Compl Diff_Diff_Int diff_eq inf_aci(1) sets.Diff sets.top vimage_Compl) lemma borel_measurable_iff_Iic_ereal: "(f::'a\ereal) \ borel_measurable M \ (\a. f -` {..a} \ space M \ sets M)" @@ -1741,7 +1698,7 @@ lemma Collect_closed_imp_pred_borel: "closed {x. P x} \ Measurable.pred borel P" by (simp add: pred_def) -(* Proof by Jeremy Avigad and Luke Serafin *) +text \Proof by Jeremy Avigad and Luke Serafin\ lemma isCont_borel_pred[measurable]: fixes f :: "'b::metric_space \ 'a::metric_space" shows "Measurable.pred borel (isCont f)" @@ -1821,12 +1778,19 @@ fixes f :: "real \ real" and A :: "real set" assumes "mono_on A f" shows "f \ borel_measurable (restrict_space borel A)" - apply (rule measurable_restrict_countable[OF mono_on_ctble_discont[OF assms]]) - apply (auto intro!: image_eqI[where x="{x}" for x] simp: sets_restrict_space) - apply (auto simp add: sets_restrict_restrict_space continuous_on_eq_continuous_within - cong: measurable_cong_sets - intro!: borel_measurable_continuous_on_restrict intro: continuous_within_subset) - done +proof - + have "\x. x \ A \ {x} \ sets (restrict_space borel A)" + using sets_restrict_space by fastforce + moreover + have "continuous_on (A \ - {a \ A. \ continuous (at a within A) f}) f" + by (force simp: continuous_on_eq_continuous_within intro: continuous_within_subset) + then have "f \ borel_measurable (restrict_space (restrict_space borel A) + (- {a \ A. \ continuous (at a within A) f}))" + by (smt (verit, best) borel_measurable_continuous_on_restrict measurable_cong_sets sets_restrict_restrict_space) + ultimately show ?thesis + using measurable_restrict_countable[OF mono_on_ctble_discont[OF assms]] + by (smt (verit, del_insts) UNIV_I mem_Collect_eq space_borel) +qed lemma borel_measurable_piecewise_mono: fixes f::"real \ real" and C::"real set set" @@ -1920,7 +1884,6 @@ fixes f g::"_\ 'a::{second_countable_topology, t2_space}" assumes [measurable]: "f \ borel_measurable M" "g \ borel_measurable M" shows "{x \ space M. f x = g x} \ sets M" - proof - define A where "A = {x \ space M. f x = g x}" define B where "B = {y. \x::'a. y = (x,x)}" @@ -1931,33 +1894,16 @@ then show ?thesis unfolding A_def by simp qed -lemma measurable_inequality_set [measurable]: +text \Logically equivalent to those with the opposite orientation, still these are needed\ +lemma measurable_inequality_set_flipped: fixes f g::"_ \ 'a::{second_countable_topology, linorder_topology}" assumes [measurable]: "f \ borel_measurable M" "g \ borel_measurable M" - shows "{x \ space M. f x \ g x} \ sets M" - "{x \ space M. f x < g x} \ sets M" - "{x \ space M. f x \ g x} \ sets M" + shows "{x \ space M. f x \ g x} \ sets M" "{x \ space M. f x > g x} \ sets M" -proof - - define F where "F = (\x. (f x, g x))" - have * [measurable]: "F \ borel_measurable M" unfolding F_def by simp - - have "{x \ space M. f x \ g x} = F-`{(x, y) | x y. x \ y} \ space M" unfolding F_def by auto - moreover have "{(x, y) | x y. x \ (y::'a)} \ sets borel" using closed_subdiagonal borel_closed by blast - ultimately show "{x \ space M. f x \ g x} \ sets M" using * by (metis (mono_tags, lifting) measurable_sets) + by auto - have "{x \ space M. f x < g x} = F-`{(x, y) | x y. x < y} \ space M" unfolding F_def by auto - moreover have "{(x, y) | x y. x < (y::'a)} \ sets borel" using open_subdiagonal borel_open by blast - ultimately show "{x \ space M. f x < g x} \ sets M" using * by (metis (mono_tags, lifting) measurable_sets) - - have "{x \ space M. f x \ g x} = F-`{(x, y) | x y. x \ y} \ space M" unfolding F_def by auto - moreover have "{(x, y) | x y. x \ (y::'a)} \ sets borel" using closed_superdiagonal borel_closed by blast - ultimately show "{x \ space M. f x \ g x} \ sets M" using * by (metis (mono_tags, lifting) measurable_sets) - - have "{x \ space M. f x > g x} = F-`{(x, y) | x y. x > y} \ space M" unfolding F_def by auto - moreover have "{(x, y) | x y. x > (y::'a)} \ sets borel" using open_superdiagonal borel_open by blast - ultimately show "{x \ space M. f x > g x} \ sets M" using * by (metis (mono_tags, lifting) measurable_sets) -qed +lemmas measurable_inequality_set [measurable] = + borel_measurable_le borel_measurable_less measurable_inequality_set_flipped proposition measurable_limit [measurable]: fixes f::"nat \ 'a \ 'b::first_countable_topology" @@ -2051,8 +1997,8 @@ lemma measurable_restrict_mono: assumes f: "f \ restrict_space M A \\<^sub>M N" and "B \ A" shows "f \ restrict_space M B \\<^sub>M N" -by (rule measurable_compose[OF measurable_restrict_space3 f]) - (insert \B \ A\, auto) + by (rule measurable_compose[OF measurable_restrict_space3 f]) (use \B \ A\ in auto) + text \The next one is a variation around \measurable_piecewise_restrict\.\ @@ -2065,22 +2011,27 @@ fix B assume [measurable]: "B \ sets N" { fix n::nat - obtain h where [measurable]: "h \ measurable M N" and "\x \ A n. f x = h x" using assms(3) by blast + obtain h where [measurable]: "h \ measurable M N" and "\x \ A n. f x = h x" + using assms(3) by blast then have *: "f-`B \ A n = h-`B \ A n" by auto - have "h-`B \ A n = h-`B \ space M \ A n" using assms(2) sets.sets_into_space by auto - then have "h-`B \ A n \ sets M" by simp - then have "f-`B \ A n \ sets M" using * by simp + have "h-`B \ A n = h-`B \ space M \ A n" + using assms(2) sets.sets_into_space by auto + then have "f-`B \ A n \ sets M" + by (simp add: "*") } - then have "(\n. f-`B \ A n) \ sets M" by measurable - moreover have "f-`B \ space M = (\n. f-`B \ A n)" using assms(2) by blast + then have "(\n. f-`B \ A n) \ sets M" + by measurable + moreover have "f-`B \ space M = (\n. f-`B \ A n)" + using assms(2) by blast ultimately show "f-`B \ space M \ sets M" by simp next fix x assume "x \ space M" - then obtain n where "x \ A n" using assms(2) by blast - obtain h where [measurable]: "h \ measurable M N" and "\x \ A n. f x = h x" using assms(3) by blast - then have "f x = h x" using \x \ A n\ by blast - moreover have "h x \ space N" by (metis measurable_space \x \ space M\ \h \ measurable M N\) - ultimately show "f x \ space N" by simp + then obtain n where "x \ A n" + using assms(2) by blast + obtain h where [measurable]: "h \ measurable M N" and "\x \ A n. f x = h x" + using assms(3) by blast + then show "f x \ space N" + by (metis \x \ A n\ \x \ space M\ measurable_space) qed end diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Complex_Analysis_Basics.thy --- a/src/HOL/Analysis/Complex_Analysis_Basics.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Complex_Analysis_Basics.thy Mon Sep 11 22:59:34 2023 +0200 @@ -138,25 +138,23 @@ fixes l::complex assumes "(f \ l) F" and "\ trivial_limit F" and "eventually P F" and "\a. P a \ f a \ \" shows "l \ \" -proof (rule Lim_in_closed_set[OF closed_complex_Reals _ assms(2,1)]) - show "eventually (\x. f x \ \) F" - using assms(3, 4) by (auto intro: eventually_mono) -qed + using Lim_in_closed_set[OF closed_complex_Reals] assms + by (smt (verit) eventually_mono) lemma real_lim_sequentially: fixes l::complex shows "(f \ l) sequentially \ (\N. \n\N. f n \ \) \ l \ \" -by (rule real_lim [where F=sequentially]) (auto simp: eventually_sequentially) + by (rule real_lim [where F=sequentially]) (auto simp: eventually_sequentially) lemma real_series: fixes l::complex shows "f sums l \ (\n. f n \ \) \ l \ \" -unfolding sums_def -by (metis real_lim_sequentially sum_in_Reals) + unfolding sums_def + by (metis real_lim_sequentially sum_in_Reals) lemma Lim_null_comparison_Re: assumes "eventually (\x. norm(f x) \ Re(g x)) F" "(g \ 0) F" shows "(f \ 0) F" - by (rule Lim_null_comparison[OF assms(1)] tendsto_eq_intros assms(2))+ simp + using Lim_null_comparison assms tendsto_Re by fastforce subsection\Holomorphic functions\ @@ -191,25 +189,11 @@ lemma holomorphic_on_UN_open: assumes "\n. n \ I \ f holomorphic_on A n" "\n. n \ I \ open (A n)" shows "f holomorphic_on (\n\I. A n)" -proof - - have "f field_differentiable at z within (\n\I. A n)" if "z \ (\n\I. A n)" for z - proof - - from that obtain n where "n \ I" "z \ A n" - by blast - hence "f holomorphic_on A n" "open (A n)" - by (simp add: assms)+ - with \z \ A n\ have "f field_differentiable at z" - by (auto simp: holomorphic_on_open field_differentiable_def) - thus ?thesis - by (meson field_differentiable_at_within) - qed - thus ?thesis - by (auto simp: holomorphic_on_def) -qed + by (metis UN_E assms holomorphic_on_open open_UN) lemma holomorphic_on_imp_continuous_on: "f holomorphic_on s \ continuous_on s f" - by (metis field_differentiable_imp_continuous_at continuous_on_eq_continuous_within holomorphic_on_def) + using differentiable_imp_continuous_on holomorphic_on_imp_differentiable_on by blast lemma holomorphic_closedin_preimage_constant: assumes "f holomorphic_on D" @@ -247,22 +231,15 @@ lemma constant_on_imp_holomorphic_on: assumes "f constant_on A" shows "f holomorphic_on A" -proof - - from assms obtain c where c: "\x\A. f x = c" - unfolding constant_on_def by blast - have "f holomorphic_on A \ (\_. c) holomorphic_on A" - by (intro holomorphic_cong) (use c in auto) - thus ?thesis - by simp -qed + by (metis assms constant_on_def holomorphic_on_const holomorphic_transform) lemma holomorphic_on_compose: - "f holomorphic_on s \ g holomorphic_on (f ` s) \ (g o f) holomorphic_on s" + "f holomorphic_on s \ g holomorphic_on (f ` s) \ (g \ f) holomorphic_on s" using field_differentiable_compose_within[of f _ s g] by (auto simp: holomorphic_on_def) lemma holomorphic_on_compose_gen: - "f holomorphic_on s \ g holomorphic_on t \ f ` s \ t \ (g o f) holomorphic_on s" + "f holomorphic_on s \ g holomorphic_on t \ f ` s \ t \ (g \ f) holomorphic_on s" by (metis holomorphic_on_compose holomorphic_on_subset) lemma holomorphic_on_balls_imp_entire: @@ -284,15 +261,10 @@ lemma holomorphic_on_balls_imp_entire': assumes "\r. r > 0 \ f holomorphic_on ball c r" shows "f holomorphic_on B" -proof (rule holomorphic_on_balls_imp_entire) - { - fix M :: real - have "\x. x > max M 0" by (intro gt_ex) - hence "\x>0. x > M" by auto - } - thus "\bdd_above {(0::real)<..}" unfolding bdd_above_def - by (auto simp: not_le) -qed (insert assms, auto) +proof (rule holomorphic_on_balls_imp_entire) + show "\bdd_above {(0::real)<..}" unfolding bdd_above_def + by (meson greaterThan_iff gt_ex less_le_not_le order_le_less_trans) +qed (use assms in auto) lemma holomorphic_on_minus [holomorphic_intros]: "f holomorphic_on A \ (\z. -(f z)) holomorphic_on A" by (metis field_differentiable_minus holomorphic_on_def) @@ -357,8 +329,7 @@ lemma holomorphic_on_Un [holomorphic_intros]: assumes "f holomorphic_on A" "f holomorphic_on B" "open A" "open B" shows "f holomorphic_on (A \ B)" - using assms by (auto simp: holomorphic_on_def at_within_open[of _ A] - at_within_open[of _ B] at_within_open[of _ "A \ B"] open_Un) + by (metis Un_iff assms holomorphic_on_open open_Un) lemma holomorphic_on_If_Un [holomorphic_intros]: assumes "f holomorphic_on A" "g holomorphic_on B" "open A" "open B" @@ -374,19 +345,16 @@ also have "g holomorphic_on B \ ?h holomorphic_on B" using assms by (intro holomorphic_cong) auto finally show \ . -qed (insert assms, auto) +qed (use assms in auto) lemma holomorphic_derivI: - "\f holomorphic_on S; open S; x \ S\ - \ (f has_field_derivative deriv f x) (at x within T)" -by (metis DERIV_deriv_iff_field_differentiable at_within_open holomorphic_on_def has_field_derivative_at_within) + "\f holomorphic_on S; open S; x \ S\ \ (f has_field_derivative deriv f x) (at x within T)" + by (metis DERIV_deriv_iff_field_differentiable at_within_open holomorphic_on_def has_field_derivative_at_within) lemma complex_derivative_transform_within_open: "\f holomorphic_on s; g holomorphic_on s; open s; z \ s; \w. w \ s \ f w = g w\ \ deriv f z = deriv g z" - unfolding holomorphic_on_def - by (rule DERIV_imp_deriv) - (metis DERIV_deriv_iff_field_differentiable has_field_derivative_transform_within_open at_within_open) + by (smt (verit) DERIV_imp_deriv has_field_derivative_transform_within_open holomorphic_on_open) lemma holomorphic_on_compose_cnj_cnj: assumes "f holomorphic_on cnj ` A" "open A" @@ -408,13 +376,13 @@ subsection\Analyticity on a set\ definition\<^marker>\tag important\ analytic_on (infixl "(analytic'_on)" 50) - where "f analytic_on S \ \x \ S. \e. 0 < e \ f holomorphic_on (ball x e)" + where "f analytic_on S \ \x \ S. \\. 0 < \ \ f holomorphic_on (ball x \)" named_theorems\<^marker>\tag important\ analytic_intros "introduction rules for proving analyticity" lemma analytic_imp_holomorphic: "f analytic_on S \ f holomorphic_on S" - by (simp add: at_within_open [OF _ open_ball] analytic_on_def holomorphic_on_def) - (metis centre_in_ball field_differentiable_at_within) + unfolding analytic_on_def holomorphic_on_def + using centre_in_ball field_differentiable_at_within field_differentiable_within_open by blast lemma analytic_on_open: "open S \ f analytic_on S \ f holomorphic_on S" by (meson analytic_imp_holomorphic analytic_on_def holomorphic_on_subset openE) @@ -426,15 +394,12 @@ lemma analytic_at_imp_isCont: assumes "f analytic_on {z}" shows "isCont f z" - using assms by (meson analytic_on_imp_differentiable_at field_differentiable_imp_continuous_at insertI1) + by (meson analytic_on_imp_differentiable_at assms field_differentiable_imp_continuous_at insertCI) lemma analytic_at_neq_imp_eventually_neq: assumes "f analytic_on {x}" "f x \ c" shows "eventually (\y. f y \ c) (at x)" -proof (intro tendsto_imp_eventually_ne) - show "f \x\ f x" - using assms by (simp add: analytic_at_imp_isCont isContD) -qed (use assms in auto) + using analytic_at_imp_isCont assms isContD tendsto_imp_eventually_ne by blast lemma analytic_on_subset: "f analytic_on S \ T \ S \ f analytic_on T" by (auto simp: analytic_on_def) @@ -455,18 +420,21 @@ have "?lhs \ (\T. open T \ S \ T \ f analytic_on T)" proof safe assume "f analytic_on S" - then show "\T. open T \ S \ T \ f analytic_on T" - apply (simp add: analytic_on_def) - apply (rule exI [where x="\{U. open U \ f analytic_on U}"], auto) - apply (metis open_ball analytic_on_open centre_in_ball) - by (metis analytic_on_def) + then have "\x \ \{U. open U \ f analytic_on U}. \\>0. f holomorphic_on ball x \" + using analytic_on_def by force + moreover have "S \ \{U. open U \ f analytic_on U}" + using \f analytic_on S\ + by (smt (verit, best) open_ball Union_iff analytic_on_def analytic_on_open centre_in_ball mem_Collect_eq subsetI) + ultimately show "\T. open T \ S \ T \ f analytic_on T" + unfolding analytic_on_def + by (metis (mono_tags, lifting) mem_Collect_eq open_Union) next fix T assume "open T" "S \ T" "f analytic_on T" then show "f analytic_on S" by (metis analytic_on_subset) qed - also have "... \ ?rhs" + also have "\ \ ?rhs" by (auto simp: analytic_on_open) finally show ?thesis . qed @@ -486,7 +454,7 @@ lemma analytic_on_compose: assumes f: "f analytic_on S" and g: "g analytic_on (f ` S)" - shows "(g o f) analytic_on S" + shows "(g \ f) analytic_on S" unfolding analytic_on_def proof (intro ballI) fix x @@ -500,21 +468,19 @@ with e' obtain d where d: "0 < d" and fd: "f ` ball x d \ ball (f x) e'" by (auto simp: continuous_at_ball) have "g \ f holomorphic_on ball x (min d e)" - apply (rule holomorphic_on_compose) - apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball) - by (metis fd gh holomorphic_on_subset image_mono min.cobounded1 subset_ball) + by (meson fd fh gh holomorphic_on_compose_gen holomorphic_on_subset image_mono min.cobounded1 min.cobounded2 subset_ball) then show "\e>0. g \ f holomorphic_on ball x e" by (metis d e min_less_iff_conj) qed lemma analytic_on_compose_gen: "f analytic_on S \ g analytic_on T \ (\z. z \ S \ f z \ T) - \ g o f analytic_on S" -by (metis analytic_on_compose analytic_on_subset image_subset_iff) + \ g \ f analytic_on S" + by (metis analytic_on_compose analytic_on_subset image_subset_iff) lemma analytic_on_neg [analytic_intros]: "f analytic_on S \ (\z. -(f z)) analytic_on S" -by (metis analytic_on_holomorphic holomorphic_on_minus) + by (metis analytic_on_holomorphic holomorphic_on_minus) lemma analytic_on_add [analytic_intros]: assumes f: "f analytic_on S" @@ -529,33 +495,11 @@ obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g by (metis analytic_on_def g z) have "(\z. f z + g z) holomorphic_on ball z (min e e')" - apply (rule holomorphic_on_add) - apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball) - by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball) + by (metis fh gh holomorphic_on_add holomorphic_on_subset linorder_linear min_def subset_ball) then show "\e>0. (\z. f z + g z) holomorphic_on ball z e" by (metis e e' min_less_iff_conj) qed -lemma analytic_on_diff [analytic_intros]: - assumes f: "f analytic_on S" - and g: "g analytic_on S" - shows "(\z. f z - g z) analytic_on S" -unfolding analytic_on_def -proof (intro ballI) - fix z - assume z: "z \ S" - then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f - by (metis analytic_on_def) - obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g - by (metis analytic_on_def g z) - have "(\z. f z - g z) holomorphic_on ball z (min e e')" - apply (rule holomorphic_on_diff) - apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball) - by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball) - then show "\e>0. (\z. f z - g z) holomorphic_on ball z e" - by (metis e e' min_less_iff_conj) -qed - lemma analytic_on_mult [analytic_intros]: assumes f: "f analytic_on S" and g: "g analytic_on S" @@ -569,13 +513,23 @@ obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g by (metis analytic_on_def g z) have "(\z. f z * g z) holomorphic_on ball z (min e e')" - apply (rule holomorphic_on_mult) - apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball) - by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball) + by (metis fh gh holomorphic_on_mult holomorphic_on_subset min.absorb_iff2 min_def subset_ball) then show "\e>0. (\z. f z * g z) holomorphic_on ball z e" by (metis e e' min_less_iff_conj) qed +lemma analytic_on_diff [analytic_intros]: + assumes f: "f analytic_on S" and g: "g analytic_on S" + shows "(\z. f z - g z) analytic_on S" +proof - + have "(\z. - g z) analytic_on S" + by (simp add: analytic_on_neg g) + then have "(\z. f z + - g z) analytic_on S" + using analytic_on_add f by blast + then show ?thesis + by fastforce +qed + lemma analytic_on_inverse [analytic_intros]: assumes f: "f analytic_on S" and nz: "(\z. z \ S \ f z \ 0)" @@ -591,24 +545,20 @@ then obtain e' where e': "0 < e'" and nz': "\y. dist z y < e' \ f y \ 0" by (metis open_ball centre_in_ball continuous_on_open_avoid e z nz) have "(\z. inverse (f z)) holomorphic_on ball z (min e e')" - apply (rule holomorphic_on_inverse) - apply (metis fh holomorphic_on_subset min.cobounded2 min.commute subset_ball) - by (metis nz' mem_ball min_less_iff_conj) + using fh holomorphic_on_inverse holomorphic_on_open nz' by fastforce then show "\e>0. (\z. inverse (f z)) holomorphic_on ball z e" by (metis e e' min_less_iff_conj) qed lemma analytic_on_divide [analytic_intros]: - assumes f: "f analytic_on S" - and g: "g analytic_on S" - and nz: "(\z. z \ S \ g z \ 0)" - shows "(\z. f z / g z) analytic_on S" -unfolding divide_inverse -by (metis analytic_on_inverse analytic_on_mult f g nz) + assumes f: "f analytic_on S" and g: "g analytic_on S" + and nz: "(\z. z \ S \ g z \ 0)" + shows "(\z. f z / g z) analytic_on S" + unfolding divide_inverse by (metis analytic_on_inverse analytic_on_mult f g nz) lemma analytic_on_power [analytic_intros]: "f analytic_on S \ (\z. (f z) ^ n) analytic_on S" -by (induct n) (auto simp: analytic_on_mult) + by (induct n) (auto simp: analytic_on_mult) lemma analytic_on_power_int [analytic_intros]: assumes nz: "n \ 0 \ (\x\A. f x \ 0)" and f: "f analytic_on A" @@ -645,15 +595,15 @@ proof - have "deriv f w * deriv g (f w) = deriv g (f w) * deriv f w" by (simp add: algebra_simps) - also have "... = deriv (g o f) w" + also have "\ = deriv (g \ f) w" using assms by (metis analytic_on_imp_differentiable_at analytic_on_open deriv_chain image_subset_iff) - also have "... = deriv id w" + also have "\ = deriv id w" proof (rule complex_derivative_transform_within_open [where s=S]) show "g \ f holomorphic_on S" by (rule assms holomorphic_on_compose_gen holomorphic_intros)+ qed (use assms in auto) - also have "... = 1" + also have "\ = 1" by simp finally show ?thesis . qed @@ -679,19 +629,16 @@ lemma analytic_at_two: "f analytic_on {z} \ g analytic_on {z} \ - (\s. open s \ z \ s \ f holomorphic_on s \ g holomorphic_on s)" + (\S. open S \ z \ S \ f holomorphic_on S \ g holomorphic_on S)" (is "?lhs = ?rhs") proof assume ?lhs - then obtain s t - where st: "open s" "z \ s" "f holomorphic_on s" - "open t" "z \ t" "g holomorphic_on t" + then obtain S T + where st: "open S" "z \ S" "f holomorphic_on S" + "open T" "z \ T" "g holomorphic_on T" by (auto simp: analytic_at) - show ?rhs - apply (rule_tac x="s \ t" in exI) - using st - apply (auto simp: holomorphic_on_subset) - done + then show ?rhs + by (metis Int_iff holomorphic_on_subset inf_le1 inf_le2 open_Int) next assume ?rhs then show ?lhs @@ -707,32 +654,23 @@ and complex_derivative_mult_at: "deriv (\w. f w * g w) z = f z * deriv g z + deriv f z * g z" proof - - obtain s where s: "open s" "z \ s" "f holomorphic_on s" "g holomorphic_on s" - using assms by (metis analytic_at_two) show "deriv (\w. f w + g w) z = deriv f z + deriv g z" - apply (rule DERIV_imp_deriv [OF DERIV_add]) - using s - apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable) - done + using analytic_on_imp_differentiable_at assms by auto show "deriv (\w. f w - g w) z = deriv f z - deriv g z" - apply (rule DERIV_imp_deriv [OF DERIV_diff]) - using s - apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable) - done - show "deriv (\w. f w * g w) z = f z * deriv g z + deriv f z * g z" - apply (rule DERIV_imp_deriv [OF DERIV_mult']) - using s - apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable) - done + using analytic_on_imp_differentiable_at assms by force + obtain S where "open S" "z \ S" "f holomorphic_on S" "g holomorphic_on S" + using assms by (metis analytic_at_two) + then show "deriv (\w. f w * g w) z = f z * deriv g z + deriv f z * g z" + by (simp add: DERIV_imp_deriv [OF DERIV_mult'] holomorphic_derivI) qed lemma deriv_cmult_at: "f analytic_on {z} \ deriv (\w. c * f w) z = c * deriv f z" -by (auto simp: complex_derivative_mult_at) + by (auto simp: complex_derivative_mult_at) lemma deriv_cmult_right_at: "f analytic_on {z} \ deriv (\w. f w * c) z = deriv f z * c" -by (auto simp: complex_derivative_mult_at) + by (auto simp: complex_derivative_mult_at) subsection\<^marker>\tag unimportant\\Complex differentiation of sequences and series\ @@ -748,27 +686,16 @@ proof - from assms obtain x l where x: "x \ S" and tf: "((\n. f n x) \ l) sequentially" by blast - { fix e::real assume e: "e > 0" - then obtain N where N: "\n\N. \x. x \ S \ cmod (f' n x - g' x) \ e" - by (metis conv) - have "\N. \n\N. \x\S. \h. cmod (f' n x * h - g' x * h) \ e * cmod h" - proof (rule exI [of _ N], clarify) - fix n y h - assume "N \ n" "y \ S" - then have "cmod (f' n y - g' y) \ e" - by (metis N) - then have "cmod h * cmod (f' n y - g' y) \ cmod h * e" - by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2) - then show "cmod (f' n y * h - g' y * h) \ e * cmod h" - by (simp add: norm_mult [symmetric] field_simps) - qed - } note ** = this show ?thesis unfolding has_field_derivative_def proof (rule has_derivative_sequence [OF cvs _ _ x]) show "(\n. f n x) \ l" by (rule tf) - next show "\e. e > 0 \ \\<^sub>F n in sequentially. \x\S. \h. cmod (f' n x * h - g' x * h) \ e * cmod h" + next + have **: "\N. \n\N. \x\S. \h. cmod (f' n x * h - g' x * h) \ \ * cmod h" + if "\ > 0" for \::real + by (metis that left_diff_distrib mult_right_mono norm_ge_zero norm_mult conv) + show "\e. e > 0 \ \\<^sub>F n in sequentially. \x\S. \h. cmod (f' n x * h - g' x * h) \ e * cmod h" unfolding eventually_sequentially by (blast intro: **) qed (metis has_field_derivative_def df) qed @@ -784,19 +711,17 @@ proof - from assms obtain x l where x: "x \ S" and sf: "((\n. f n x) sums l)" by blast - { fix e::real assume e: "e > 0" + { fix \::real assume e: "\ > 0" then obtain N where N: "\n x. n \ N \ x \ S - \ cmod ((\i e" + \ cmod ((\i \" by (metis conv) - have "\N. \n\N. \x\S. \h. cmod ((\i e * cmod h" + have "\N. \n\N. \x\S. \h. cmod ((\i \ * cmod h" proof (rule exI [of _ N], clarify) fix n y h assume "N \ n" "y \ S" - then have "cmod ((\i e" - by (metis N) - then have "cmod h * cmod ((\i cmod h * e" - by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2) - then show "cmod ((\i e * cmod h" + have "cmod h * cmod ((\i cmod h * \" + by (simp add: N \N \ n\ \y \ S\ mult_le_cancel_left) + then show "cmod ((\i \ * cmod h" by (simp add: norm_mult [symmetric] field_simps sum_distrib_left) qed } note ** = this @@ -818,8 +743,8 @@ lemma sum_Suc_reindex: fixes f :: "nat \ 'a::ab_group_add" - shows "sum f {0..n} = f 0 - f (Suc n) + sum (\i. f (Suc i)) {0..n}" -by (induct n) auto + shows "sum f {0..n} = f 0 - f (Suc n) + sum (\i. f (Suc i)) {0..n}" + by (induct n) auto lemma field_Taylor: assumes S: "convex S" @@ -836,7 +761,7 @@ assume "u \ closed_segment w z" then have "u \ S" by (metis wzs subsetD) - have "(\i\n. f i u * (- of_nat i * (z-u)^(i - 1)) / (fact i) + + have *: "(\i\n. f i u * (- of_nat i * (z-u)^(i - 1)) / (fact i) + f (Suc i) u * (z-u)^i / (fact i)) = f (Suc n) u * (z-u) ^ n / (fact n)" proof (induction n) @@ -849,7 +774,7 @@ f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n) / (fact (Suc n)) - f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n) / (fact (Suc n))" using Suc by simp - also have "... = f (Suc (Suc n)) u * (z-u) ^ Suc n / (fact (Suc n))" + also have "\ = f (Suc (Suc n)) u * (z-u) ^ Suc n / (fact (Suc n))" proof - have "(fact(Suc n)) * (f(Suc n) u *(z-u) ^ n / (fact n) + @@ -859,29 +784,26 @@ ((fact(Suc n)) *(f(Suc(Suc n)) u *((z-u) *(z-u) ^ n)) / (fact(Suc n))) - ((fact(Suc n)) *(f(Suc n) u *(of_nat(Suc n) *(z-u) ^ n))) / (fact(Suc n))" by (simp add: algebra_simps del: fact_Suc) - also have "... = ((fact (Suc n)) * (f (Suc n) u * (z-u) ^ n)) / (fact n) + + also have "\ = ((fact (Suc n)) * (f (Suc n) u * (z-u) ^ n)) / (fact n) + (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) - (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))" by (simp del: fact_Suc) - also have "... = (of_nat (Suc n) * (f (Suc n) u * (z-u) ^ n)) + + also have "\ = (of_nat (Suc n) * (f (Suc n) u * (z-u) ^ n)) + (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) - (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))" by (simp only: fact_Suc of_nat_mult ac_simps) simp - also have "... = f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)" + also have "\ = f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)" by (simp add: algebra_simps) finally show ?thesis by (simp add: mult_left_cancel [where c = "(fact (Suc n))", THEN iffD1] del: fact_Suc) qed finally show ?case . qed - then have "((\v. (\i\n. f i v * (z - v)^i / (fact i))) + have "((\v. (\i\n. f i v * (z - v)^i / (fact i))) has_field_derivative f (Suc n) u * (z-u) ^ n / (fact n)) (at u within S)" - apply (intro derivative_eq_intros) - apply (blast intro: assms \u \ S\) - apply (rule refl)+ - apply (auto simp: field_simps) - done + unfolding * [symmetric] + by (rule derivative_eq_intros assms \u \ S\ refl | auto simp: field_simps)+ } note sum_deriv = this { fix u assume u: "u \ closed_segment w z" @@ -889,9 +811,9 @@ by (metis wzs subsetD) have "norm (f (Suc n) u) * norm (z - u) ^ n \ norm (f (Suc n) u) * norm (u - z) ^ n" by (metis norm_minus_commute order_refl) - also have "... \ norm (f (Suc n) u) * norm (z - w) ^ n" + also have "\ \ norm (f (Suc n) u) * norm (z - w) ^ n" by (metis mult_left_mono norm_ge_zero power_mono segment_bound [OF u]) - also have "... \ B * norm (z - w) ^ n" + also have "\ \ B * norm (z - w) ^ n" by (metis norm_ge_zero zero_le_power mult_right_mono B [OF us]) finally have "norm (f (Suc n) u) * norm (z - u) ^ n \ B * norm (z - w) ^ n" . } note cmod_bound = this @@ -903,14 +825,14 @@ \ norm ((\i\n. f i w * (z - w) ^ i / (fact i)) - (\i\n. f i z * (z - z) ^ i / (fact i)))" by (simp add: norm_minus_commute) - also have "... \ B * norm (z - w) ^ n / (fact n) * norm (w - z)" - apply (rule field_differentiable_bound - [where f' = "\w. f (Suc n) w * (z - w)^n / (fact n)" - and S = "closed_segment w z", OF convex_closed_segment]) - apply (auto simp: DERIV_subset [OF sum_deriv wzs] - norm_divide norm_mult norm_power divide_le_cancel cmod_bound) - done - also have "... \ B * norm (z - w) ^ Suc n / (fact n)" + also have "\ \ B * norm (z - w) ^ n / (fact n) * norm (w - z)" + proof (rule field_differentiable_bound) + show "\x. x \ closed_segment w z \ + ((\\. \i\n. f i \ * (z - \) ^ i / fact i) has_field_derivative f (Suc n) x * (z - x) ^ n / fact n) + (at x within closed_segment w z)" + using DERIV_subset sum_deriv wzs by blast + qed (auto simp: norm_divide norm_mult norm_power divide_le_cancel cmod_bound) + also have "\ \ B * norm (z - w) ^ Suc n / (fact n)" by (simp add: algebra_simps norm_minus_commute) finally show ?thesis . qed @@ -921,8 +843,7 @@ and B: "\x. x \ S \ cmod (f (Suc n) x) \ B" and w: "w \ S" and z: "z \ S" - shows "cmod(f 0 z - (\i\n. f i w * (z-w) ^ i / (fact i))) - \ B * cmod(z - w)^(Suc n) / fact n" + shows "cmod(f 0 z - (\i\n. f i w * (z-w) ^ i / (fact i))) \ B * cmod(z - w)^(Suc n) / fact n" using assms by (rule field_Taylor) @@ -932,20 +853,22 @@ assumes "\u. u \ closed_segment w z \ (f has_field_derivative f'(u)) (at u)" shows "\u. u \ closed_segment w z \ Re(f z) - Re(f w) = Re(f'(u) * (z - w))" proof - - have twz: "\t. (1 - t) *\<^sub>R w + t *\<^sub>R z = w + t *\<^sub>R (z - w)" - by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib) + define \ where "\ \ \t. (1 - t) *\<^sub>R w + t *\<^sub>R z" + have twz: "\t. \ t = w + t *\<^sub>R (z - w)" + by (simp add: \_def real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib) note assms[unfolded has_field_derivative_def, derivative_intros] - show ?thesis - apply (cut_tac mvt_simple - [of 0 1 "Re o f o (\t. (1 - t) *\<^sub>R w + t *\<^sub>R z)" - "\u. Re o (\h. f'((1 - u) *\<^sub>R w + u *\<^sub>R z) * h) o (\t. t *\<^sub>R (z - w))"]) - apply auto - apply (rule_tac x="(1 - x) *\<^sub>R w + x *\<^sub>R z" in exI) - apply (auto simp: closed_segment_def twz) [] - apply (intro derivative_eq_intros has_derivative_at_withinI, simp_all) - apply (simp add: fun_eq_iff real_vector.scale_right_diff_distrib) - apply (force simp: twz closed_segment_def) - done + have *: "\x. \0 \ x; x \ 1\ + \ (Re \ f \ \ has_derivative Re \ (*) (f' (\ x)) \ (\t. t *\<^sub>R (z - w))) + (at x within {0..1})" + unfolding \_def + by (intro derivative_eq_intros has_derivative_at_withinI) + (auto simp: in_segment scaleR_right_diff_distrib) + obtain x where "0 f \ \) 1 - + (Re \ f \ \) 0 = (Re \ (*) (f' (\ x)) \ (\t. t *\<^sub>R (z - w))) (1 - 0)" + using mvt_simple [OF zero_less_one *] by force + then show ?thesis + unfolding \_def + by (smt (verit) comp_apply in_segment(1) scaleR_left_distrib scaleR_one scaleR_zero_left) qed lemma complex_Taylor_mvt: @@ -967,30 +890,27 @@ (f (Suc (Suc i)) u * ((z-u) ^ Suc i) - of_nat (Suc i) * (f (Suc i) u * (z-u) ^ i)) / (fact (Suc i)))" by (subst sum_Suc_reindex) simp - also have "... = f (Suc 0) u - + also have "\ = f (Suc 0) u - (f (Suc (Suc n)) u * ((z-u) ^ Suc n) - (of_nat (Suc n)) * (z-u) ^ n * f (Suc n) u) / (fact (Suc n)) + (\i = 0..n. f (Suc (Suc i)) u * ((z-u) ^ Suc i) / (fact (Suc i)) - f (Suc i) u * (z-u) ^ i / (fact i))" by (simp only: diff_divide_distrib fact_cancel ac_simps) - also have "... = f (Suc 0) u - + also have "\ = f (Suc 0) u - (f (Suc (Suc n)) u * (z-u) ^ Suc n - of_nat (Suc n) * (z-u) ^ n * f (Suc n) u) / (fact (Suc n)) + f (Suc (Suc n)) u * (z-u) ^ Suc n / (fact (Suc n)) - f (Suc 0) u" by (subst sum_Suc_diff) auto - also have "... = f (Suc n) u * (z-u) ^ n / (fact n)" + also have "\ = f (Suc n) u * (z-u) ^ n / (fact n)" by (simp only: algebra_simps diff_divide_distrib fact_cancel) - finally have "(\i = 0..n. (f (Suc i) u * (z - u) ^ i + finally have *: "(\i = 0..n. (f (Suc i) u * (z - u) ^ i - of_nat i * (f i u * (z-u) ^ (i - Suc 0))) / (fact i)) = f (Suc n) u * (z - u) ^ n / (fact n)" . - then have "((\u. \i = 0..n. f i u * (z - u) ^ i / (fact i)) has_field_derivative + have "((\u. \i = 0..n. f i u * (z - u) ^ i / (fact i)) has_field_derivative f (Suc n) u * (z - u) ^ n / (fact n)) (at u)" - apply (intro derivative_eq_intros)+ - apply (force intro: u assms) - apply (rule refl)+ - apply (auto simp: ac_simps) - done + unfolding * [symmetric] + by (rule derivative_eq_intros assms u refl | auto simp: field_simps)+ } then show ?thesis apply (cut_tac complex_mvt_line [of w z "\u. \i = 0..n. f i u * (z-u) ^ i / (fact i)" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Convex.thy --- a/src/HOL/Analysis/Convex.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Convex.thy Mon Sep 11 22:59:34 2023 +0200 @@ -1773,6 +1773,368 @@ shows "cone (convex hull S)" by (metis (no_types, lifting) affine_hull_convex_hull affine_hull_eq_empty assms cone_iff convex_hull_scaling hull_inc) +section \Conic sets and conic hull\ + +definition conic :: "'a::real_vector set \ bool" + where "conic S \ \x c. x \ S \ 0 \ c \ (c *\<^sub>R x) \ S" + +lemma conicD: "\conic S; x \ S; 0 \ c\ \ (c *\<^sub>R x) \ S" + by (meson conic_def) + +lemma subspace_imp_conic: "subspace S \ conic S" + by (simp add: conic_def subspace_def) + +lemma conic_empty [simp]: "conic {}" + using conic_def by blast + +lemma conic_UNIV: "conic UNIV" + by (simp add: conic_def) + +lemma conic_Inter: "(\S. S \ \ \ conic S) \ conic(\\)" + by (simp add: conic_def) + +lemma conic_linear_image: + "\conic S; linear f\ \ conic(f ` S)" + by (smt (verit) conic_def image_iff linear.scaleR) + +lemma conic_linear_image_eq: + "\linear f; inj f\ \ conic (f ` S) \ conic S" + by (smt (verit) conic_def conic_linear_image inj_image_mem_iff linear_cmul) + +lemma conic_mul: "\conic S; x \ S; 0 \ c\ \ (c *\<^sub>R x) \ S" + using conic_def by blast + +lemma conic_conic_hull: "conic(conic hull S)" + by (metis (no_types, lifting) conic_Inter hull_def mem_Collect_eq) + +lemma conic_hull_eq: "(conic hull S = S) \ conic S" + by (metis conic_conic_hull hull_same) + +lemma conic_hull_UNIV [simp]: "conic hull UNIV = UNIV" + by simp + +lemma conic_negations: "conic S \ conic (image uminus S)" + by (auto simp: conic_def image_iff) + +lemma conic_span [iff]: "conic(span S)" + by (simp add: subspace_imp_conic) + +lemma conic_hull_explicit: + "conic hull S = {c *\<^sub>R x| c x. 0 \ c \ x \ S}" + proof (rule hull_unique) + show "S \ {c *\<^sub>R x |c x. 0 \ c \ x \ S}" + by (metis (no_types) cone_hull_expl hull_subset) + show "conic {c *\<^sub>R x |c x. 0 \ c \ x \ S}" + using mult_nonneg_nonneg by (force simp: conic_def) +qed (auto simp: conic_def) + +lemma conic_hull_as_image: + "conic hull S = (\z. fst z *\<^sub>R snd z) ` ({0..} \ S)" + by (force simp: conic_hull_explicit) + +lemma conic_hull_linear_image: + "linear f \ conic hull f ` S = f ` (conic hull S)" + by (force simp: conic_hull_explicit image_iff set_eq_iff linear_scale) + +lemma conic_hull_image_scale: + assumes "\x. x \ S \ 0 < c x" + shows "conic hull (\x. c x *\<^sub>R x) ` S = conic hull S" +proof + show "conic hull (\x. c x *\<^sub>R x) ` S \ conic hull S" + proof (rule hull_minimal) + show "(\x. c x *\<^sub>R x) ` S \ conic hull S" + using assms conic_hull_explicit by fastforce + qed (simp add: conic_conic_hull) + show "conic hull S \ conic hull (\x. c x *\<^sub>R x) ` S" + proof (rule hull_minimal) + show "S \ conic hull (\x. c x *\<^sub>R x) ` S" + proof clarsimp + fix x + assume "x \ S" + then have "x = inverse(c x) *\<^sub>R c x *\<^sub>R x" + using assms by fastforce + then show "x \ conic hull (\x. c x *\<^sub>R x) ` S" + by (smt (verit, best) \x \ S\ assms conic_conic_hull conic_mul hull_inc image_eqI inverse_nonpositive_iff_nonpositive) + qed + qed (simp add: conic_conic_hull) +qed + +lemma convex_conic_hull: + assumes "convex S" + shows "convex (conic hull S)" +proof (clarsimp simp add: conic_hull_explicit convex_alt) + fix c x d y and u :: real + assume \
: "(0::real) \ c" "x \ S" "(0::real) \ d" "y \ S" "0 \ u" "u \ 1" + show "\c'' x''. ((1 - u) * c) *\<^sub>R x + (u * d) *\<^sub>R y = c'' *\<^sub>R x'' \ 0 \ c'' \ x'' \ S" + proof (cases "(1 - u) * c = 0") + case True + with \0 \ d\ \y \ S\\0 \ u\ + show ?thesis by force + next + case False + define \ where "\ \ (1 - u) * c + u * d" + have *: "c * u \ c" + by (simp add: "\
" mult_left_le) + have "\ > 0" + using False \
by (smt (verit, best) \_def split_mult_pos_le) + then have **: "c + d * u = \ + c * u" + by (simp add: \_def mult.commute right_diff_distrib') + show ?thesis + proof (intro exI conjI) + show "0 \ \" + using \0 < \\ by auto + show "((1 - u) * c) *\<^sub>R x + (u * d) *\<^sub>R y = \ *\<^sub>R (((1 - u) * c / \) *\<^sub>R x + (u * d / \) *\<^sub>R y)" + using \\ > 0\ by (simp add: algebra_simps diff_divide_distrib) + show "((1 - u) * c / \) *\<^sub>R x + (u * d / \) *\<^sub>R y \ S" + using \0 < \\ + by (intro convexD [OF assms]) (auto simp: \
field_split_simps * **) + qed + qed +qed + +lemma conic_halfspace_le: "conic {x. a \ x \ 0}" + by (auto simp: conic_def mult_le_0_iff) + +lemma conic_halfspace_ge: "conic {x. a \ x \ 0}" + by (auto simp: conic_def mult_le_0_iff) + +lemma conic_hull_empty [simp]: "conic hull {} = {}" + by (simp add: conic_hull_eq) + +lemma conic_contains_0: "conic S \ (0 \ S \ S \ {})" + by (simp add: Convex.cone_def cone_contains_0 conic_def) + +lemma conic_hull_eq_empty: "conic hull S = {} \ (S = {})" + using conic_hull_explicit by fastforce + +lemma conic_sums: "\conic S; conic T\ \ conic (\x\ S. \y \ T. {x + y})" + by (simp add: conic_def) (metis scaleR_right_distrib) + +lemma conic_Times: "\conic S; conic T\ \ conic(S \ T)" + by (auto simp: conic_def) + +lemma conic_Times_eq: + "conic(S \ T) \ S = {} \ T = {} \ conic S \ conic T" (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + by (force simp: conic_def) + show "?rhs \ ?lhs" + by (force simp: conic_Times) +qed + +lemma conic_hull_0 [simp]: "conic hull {0} = {0}" + by (simp add: conic_hull_eq subspace_imp_conic) + +lemma conic_hull_contains_0 [simp]: "0 \ conic hull S \ (S \ {})" + by (simp add: conic_conic_hull conic_contains_0 conic_hull_eq_empty) + +lemma conic_hull_eq_sing: + "conic hull S = {x} \ S = {0} \ x = 0" +proof + show "conic hull S = {x} \ S = {0} \ x = 0" + by (metis conic_conic_hull conic_contains_0 conic_def conic_hull_eq hull_inc insert_not_empty singleton_iff) +qed simp + +lemma conic_hull_Int_affine_hull: + assumes "T \ S" "0 \ affine hull S" + shows "(conic hull T) \ (affine hull S) = T" +proof - + have TaffS: "T \ affine hull S" + using \T \ S\ hull_subset by fastforce + moreover + have "conic hull T \ affine hull S \ T" + proof (clarsimp simp: conic_hull_explicit) + fix c x + assume "c *\<^sub>R x \ affine hull S" + and "0 \ c" + and "x \ T" + show "c *\<^sub>R x \ T" + proof (cases "c=1") + case True + then show ?thesis + by (simp add: \x \ T\) + next + case False + then have "x /\<^sub>R (1 - c) = x + (c * inverse (1 - c)) *\<^sub>R x" + by (smt (verit, ccfv_SIG) diff_add_cancel mult.commute real_vector_affinity_eq scaleR_collapse scaleR_scaleR) + then have "0 = inverse(1 - c) *\<^sub>R c *\<^sub>R x + (1 - inverse(1 - c)) *\<^sub>R x" + by (simp add: algebra_simps) + then have "0 \ affine hull S" + by (smt (verit) \c *\<^sub>R x \ affine hull S\ \x \ T\ affine_affine_hull TaffS in_mono mem_affine) + then show ?thesis + using assms by auto + qed + qed + ultimately show ?thesis + by (auto simp: hull_inc) +qed + + +section \Convex cones and corresponding hulls\ + +definition convex_cone :: "'a::real_vector set \ bool" + where "convex_cone \ \S. S \ {} \ convex S \ conic S" + +lemma convex_cone_iff: + "convex_cone S \ + 0 \ S \ (\x \ S. \y \ S. x + y \ S) \ (\x \ S. \c\0. c *\<^sub>R x \ S)" + by (metis cone_def conic_contains_0 conic_def convex_cone convex_cone_def) + +lemma convex_cone_add: "\convex_cone S; x \ S; y \ S\ \ x+y \ S" + by (simp add: convex_cone_iff) + +lemma convex_cone_scaleR: "\convex_cone S; 0 \ c; x \ S\ \ c *\<^sub>R x \ S" + by (simp add: convex_cone_iff) + +lemma convex_cone_nonempty: "convex_cone S \ S \ {}" + by (simp add: convex_cone_def) + +lemma convex_cone_linear_image: + "convex_cone S \ linear f \ convex_cone(f ` S)" + by (simp add: conic_linear_image convex_cone_def convex_linear_image) + +lemma convex_cone_linear_image_eq: + "\linear f; inj f\ \ (convex_cone(f ` S) \ convex_cone S)" + by (simp add: conic_linear_image_eq convex_cone_def) + +lemma convex_cone_halfspace_ge: "convex_cone {x. a \ x \ 0}" + by (simp add: convex_cone_iff inner_simps(2)) + +lemma convex_cone_halfspace_le: "convex_cone {x. a \ x \ 0}" + by (simp add: convex_cone_iff inner_right_distrib mult_nonneg_nonpos) + +lemma convex_cone_contains_0: "convex_cone S \ 0 \ S" + using convex_cone_iff by blast + +lemma convex_cone_Inter: + "(\S. S \ f \ convex_cone S) \ convex_cone(\ f)" + by (simp add: convex_cone_iff) + +lemma convex_cone_convex_cone_hull: "convex_cone(convex_cone hull S)" + by (metis (no_types, lifting) convex_cone_Inter hull_def mem_Collect_eq) + +lemma convex_convex_cone_hull: "convex(convex_cone hull S)" + by (meson convex_cone_convex_cone_hull convex_cone_def) + +lemma conic_convex_cone_hull: "conic(convex_cone hull S)" + by (metis convex_cone_convex_cone_hull convex_cone_def) + +lemma convex_cone_hull_nonempty: "convex_cone hull S \ {}" + by (simp add: convex_cone_convex_cone_hull convex_cone_nonempty) + +lemma convex_cone_hull_contains_0: "0 \ convex_cone hull S" + by (simp add: convex_cone_contains_0 convex_cone_convex_cone_hull) + +lemma convex_cone_hull_add: + "\x \ convex_cone hull S; y \ convex_cone hull S\ \ x + y \ convex_cone hull S" + by (simp add: convex_cone_add convex_cone_convex_cone_hull) + +lemma convex_cone_hull_mul: + "\x \ convex_cone hull S; 0 \ c\ \ (c *\<^sub>R x) \ convex_cone hull S" + by (simp add: conic_convex_cone_hull conic_mul) + +thm convex_sums +lemma convex_cone_sums: + "\convex_cone S; convex_cone T\ \ convex_cone (\x\ S. \y \ T. {x + y})" + by (simp add: convex_cone_def conic_sums convex_sums) + +lemma convex_cone_Times: + "\convex_cone S; convex_cone T\ \ convex_cone(S \ T)" + by (simp add: conic_Times convex_Times convex_cone_def) + +lemma convex_cone_Times_D1: "convex_cone (S \ T) \ convex_cone S" + by (metis Times_empty conic_Times_eq convex_cone_def convex_convex_hull convex_hull_Times hull_same times_eq_iff) + +lemma convex_cone_Times_eq: + "convex_cone(S \ T) \ convex_cone S \ convex_cone T" +proof (cases "S={} \ T={}") + case True + then show ?thesis + by (auto dest: convex_cone_nonempty) +next + case False + then have "convex_cone (S \ T) \ convex_cone T" + by (metis conic_Times_eq convex_cone_def convex_convex_hull convex_hull_Times hull_same times_eq_iff) + then show ?thesis + using convex_cone_Times convex_cone_Times_D1 by blast +qed + + +lemma convex_cone_hull_Un: + "convex_cone hull(S \ T) = (\x \ convex_cone hull S. \y \ convex_cone hull T. {x + y})" + (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + proof (rule hull_minimal) + show "S \ T \ (\x\convex_cone hull S. \y\convex_cone hull T. {x + y})" + apply (clarsimp simp: subset_iff) + by (metis add_0 convex_cone_hull_contains_0 group_cancel.rule0 hull_inc) + show "convex_cone (\x\convex_cone hull S. \y\convex_cone hull T. {x + y})" + by (simp add: convex_cone_convex_cone_hull convex_cone_sums) + qed +next + show "?rhs \ ?lhs" + by clarify (metis convex_cone_hull_add hull_mono le_sup_iff subsetD subsetI) +qed + +lemma convex_cone_singleton [iff]: "convex_cone {0}" + by (simp add: convex_cone_iff) + +lemma convex_hull_subset_convex_cone_hull: + "convex hull S \ convex_cone hull S" + by (simp add: convex_convex_cone_hull hull_minimal hull_subset) + +lemma conic_hull_subset_convex_cone_hull: + "conic hull S \ convex_cone hull S" + by (simp add: conic_convex_cone_hull hull_minimal hull_subset) + +lemma subspace_imp_convex_cone: "subspace S \ convex_cone S" + by (simp add: convex_cone_iff subspace_def) + +lemma convex_cone_span: "convex_cone(span S)" + by (simp add: subspace_imp_convex_cone) + +lemma convex_cone_negations: + "convex_cone S \ convex_cone (image uminus S)" + by (simp add: convex_cone_linear_image module_hom_uminus) + +lemma subspace_convex_cone_symmetric: + "subspace S \ convex_cone S \ (\x \ S. -x \ S)" + by (smt (verit) convex_cone_iff scaleR_left.minus subspace_def subspace_neg) + +lemma convex_cone_hull_separate_nonempty: + assumes "S \ {}" + shows "convex_cone hull S = conic hull (convex hull S)" (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + by (metis assms conic_conic_hull convex_cone_def convex_conic_hull convex_convex_hull hull_subset subset_empty subset_hull) + show "?rhs \ ?lhs" + by (simp add: conic_convex_cone_hull convex_hull_subset_convex_cone_hull subset_hull) +qed + +lemma convex_cone_hull_empty [simp]: "convex_cone hull {} = {0}" + by (metis convex_cone_hull_contains_0 convex_cone_singleton hull_redundant hull_same) + +lemma convex_cone_hull_separate: + "convex_cone hull S = insert 0 (conic hull (convex hull S))" +proof(cases "S={}") + case False + then show ?thesis + using convex_cone_hull_contains_0 convex_cone_hull_separate_nonempty by blast +qed auto + +lemma convex_cone_hull_convex_hull_nonempty: + "S \ {} \ convex_cone hull S = (\x \ convex hull S. \c\{0..}. {c *\<^sub>R x})" + by (force simp: convex_cone_hull_separate_nonempty conic_hull_as_image) + +lemma convex_cone_hull_convex_hull: + "convex_cone hull S = insert 0 (\x \ convex hull S. \c\{0..}. {c *\<^sub>R x})" + by (force simp: convex_cone_hull_separate conic_hull_as_image) + +lemma convex_cone_hull_linear_image: + "linear f \ convex_cone hull (f ` S) = image f (convex_cone hull S)" + by (metis (no_types, lifting) conic_hull_linear_image convex_cone_hull_separate convex_hull_linear_image image_insert linear_0) + subsection \Radon's theorem\ text "Formalized by Lars Schewe." diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Analysis/Convex_Euclidean_Space.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy Mon Sep 11 22:59:34 2023 +0200 @@ -437,7 +437,7 @@ then obtain L where L: "subspace L" "affine_parallel S L" using assms affine_parallel_subspace[of S] by auto then obtain a where a: "S = ((+) a ` L)" - using affine_parallel_def[of L S] affine_parallel_commut by auto + using affine_parallel_def[of L S] affine_parallel_commute by auto from L have "closed L" using closed_subspace by auto then have "closed S" using closed_translation a by auto diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Elementary_Topology.thy --- a/src/HOL/Analysis/Elementary_Topology.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Elementary_Topology.thy Mon Sep 11 22:59:34 2023 +0200 @@ -1692,20 +1692,15 @@ (\f. (\n. f n \ S) \ (\l\S. \r::nat\nat. strict_mono r \ (f \ r) \ l))" lemma seq_compactI: - assumes "\f. \n. f n \ S \ \l\S. \r::nat\nat. strict_mono r \ ((f \ r) \ l) sequentially" + assumes "\f. \n. f n \ S \ \l\S. \r::nat\nat. strict_mono r \ (f \ r) \ l" shows "seq_compact S" unfolding seq_compact_def using assms by fast lemma seq_compactE: assumes "seq_compact S" "\n. f n \ S" - obtains l r where "l \ S" "strict_mono (r :: nat \ nat)" "((f \ r) \ l) sequentially" + obtains l r where "l \ S" "strict_mono (r :: nat \ nat)" "(f \ r) \ l" using assms unfolding seq_compact_def by fast -lemma closed_sequentially: (* TODO: move upwards *) - assumes "closed S" and "\n. f n \ S" and "f \ l" - shows "l \ S" - by (metis Lim_in_closed_set assms eventually_sequentially trivial_limit_sequentially) - lemma seq_compact_Int_closed: assumes "seq_compact S" and "closed T" shows "seq_compact (S \ T)" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy --- a/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy Mon Sep 11 22:59:34 2023 +0200 @@ -1373,7 +1373,7 @@ obtain a where "a \ interior (convex hull insert 0 B)" proof (rule interior_simplex_nonempty [OF indB]) show "finite B" - by (simp add: indB independent_finite) + by (simp add: indB independent_imp_finite) show "card B = DIM('N)" by (simp add: cardB 2) qed diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Finite_Product_Measure.thy --- a/src/HOL/Analysis/Finite_Product_Measure.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Finite_Product_Measure.thy Mon Sep 11 22:59:34 2023 +0200 @@ -8,9 +8,11 @@ imports Binary_Product_Measure Function_Topology begin -lemma PiE_choice: "(\f\Pi\<^sub>E I F. \i\I. P i (f i)) \ (\i\I. \x\F i. P i x)" - by (auto simp: Bex_def PiE_iff Ball_def dest!: choice_iff'[THEN iffD1]) - (force intro: exI[of _ "restrict f I" for f]) +lemma Pi_choice: "(\i\I. \x\F i. P i x) \ (\f\Pi I F. \i\I. P i (f i))" + by (metis Pi_iff) + +lemma PiE_choice: "(\i\I. \x\F i. P i x) \(\f\Pi\<^sub>E I F. \i\I. P i (f i))" + unfolding Pi_choice by (metis Int_iff PiE_def restrict_PiE restrict_apply) lemma case_prod_const: "(\(i, j). c) = (\_. c)" by auto @@ -97,7 +99,7 @@ then show "x \ A \ x \ B" using y x \J \ I\ PiE_cancel_merge[of "J" "I - J" x y S] by (auto simp del: PiE_cancel_merge simp add: Un_absorb1 eq) - qed (insert sets, auto) + qed (use sets in auto) qed lemma restrict_vimage: @@ -178,7 +180,7 @@ lemma Pi_cong_sets: "\I = J; \x. x \ I \ M x = N x\ \ Pi I M = Pi J N" - unfolding Pi_def by auto + by auto lemma PiM_cong: assumes "I = J" "\x. x \ I \ M x = N x" @@ -327,17 +329,11 @@ done qed proposition prod_algebra_cong: - assumes "I = J" and sets: "(\i. i \ I \ sets (M i) = sets (N i))" + assumes "I = J" and "(\i. i \ I \ sets (M i) = sets (N i))" shows "prod_algebra I M = prod_algebra J N" -proof - - have space: "\i. i \ I \ space (M i) = space (N i)" - using sets_eq_imp_space_eq[OF sets] by auto - with sets show ?thesis unfolding \I = J\ - by (intro antisym prod_algebra_mono) auto -qed + by (metis assms prod_algebra_mono sets_eq_imp_space_eq subsetI subset_antisym) -lemma space_in_prod_algebra: - "(\\<^sub>E i\I. space (M i)) \ prod_algebra I M" +lemma space_in_prod_algebra: "(\\<^sub>E i\I. space (M i)) \ prod_algebra I M" proof cases assume "I = {}" then show ?thesis by (auto simp add: prod_algebra_def image_iff prod_emb_def) @@ -346,9 +342,8 @@ then obtain i where "i \ I" by auto then have "(\\<^sub>E i\I. space (M i)) = prod_emb I M {i} (\\<^sub>E i\{i}. space (M i))" by (auto simp: prod_emb_def) - also have "\ \ prod_algebra I M" - using \i \ I\ by (intro prod_algebraI) auto - finally show ?thesis . + then show ?thesis + by (simp add: \i \ I\ prod_algebraI) qed lemma space_PiM: "space (\\<^sub>M i\I. M i) = (\\<^sub>E i\I. space (M i))" @@ -383,8 +378,8 @@ show "A \ sigma_sets ?\ ?R" proof cases assume "I = {}" - with X have "A = {\x. undefined}" by (auto simp: prod_emb_def) - with \I = {}\ show ?thesis by (auto intro!: sigma_sets_top) + with X show ?thesis + by (metis (no_types, lifting) PiE_cong R.top empty_iff prod_emb_PiE subset_eq) next assume "I \ {}" with X have "A = (\j\J. {f\(\\<^sub>E i\I. space (M i)). f j \ X j})" @@ -405,16 +400,25 @@ qed lemma sets_PiM_eq_proj: - "I \ {} \ sets (PiM I M) = sets (SUP i\I. vimage_algebra (\\<^sub>E i\I. space (M i)) (\x. x i) (M i))" - apply (simp add: sets_PiM_single) - apply (subst sets_Sup_eq[where X="\\<^sub>E i\I. space (M i)"]) - apply auto [] - apply auto [] - apply simp - apply (subst arg_cong [of _ _ Sup, OF image_cong, OF refl]) - apply (rule sets_vimage_algebra2) - apply (auto intro!: arg_cong2[where f=sigma_sets]) - done + assumes "I \ {}" + shows "sets (PiM I M) = sets (SUP i\I. vimage_algebra (\\<^sub>E i\I. space (M i)) (\x. x i) (M i))" + (is "?lhs = ?rhs") +proof - + have "?lhs = + sigma_sets (\\<^sub>E i\I. space (M i)) {{f \ \\<^sub>E i\I. space (M i). f i \ A} |i A. i \ I \ A \ sets (M i)}" + by (simp add: sets_PiM_single) + also have "\ = sigma_sets (\\<^sub>E i\I. space (M i)) + (\x\I. sets (vimage_algebra (\\<^sub>E i\I. space (M i)) (\xa. xa x) (M x)))" + apply (subst arg_cong [of _ _ Sup, OF image_cong, OF refl]) + apply (rule sets_vimage_algebra2) + by (auto intro!: arg_cong2[where f=sigma_sets]) + also have "... = sigma_sets (\\<^sub>E i\I. space (M i)) + (\ (sets ` (\i. vimage_algebra (\\<^sub>E i\I. space (M i)) (\x. x i) (M i)) ` I))" + by simp + also have "... = ?rhs" + by (subst sets_Sup_eq[where X="\\<^sub>E i\I. space (M i)"]) (use assms in auto) + finally show ?thesis . +qed lemma shows space_PiM_empty: "space (Pi\<^sub>M {} M) = {\k. undefined}" @@ -616,7 +620,7 @@ by (fastforce dest: Pi_mem simp: prod_emb_def space_PiM split: if_split_asm) then show "(\x. x i) -` A \ space (Pi\<^sub>M I M) \ sets (Pi\<^sub>M I M)" using \A \ sets (M i)\ \i \ I\ by (auto intro!: sets_PiM_I) -qed (insert \i \ I\, auto simp: space_PiM) +qed (use \i \ I\ in \auto simp: space_PiM\) lemma measurable_component_singleton'[measurable_dest]: assumes f: "f \ measurable N (Pi\<^sub>M I M)" @@ -696,7 +700,10 @@ by auto then show "{\ \ space N. (\i\I. X i \) i \ A} \ sets N" using A X by (auto intro!: measurable_sets) -qed (insert X, auto simp add: PiE_def dest: measurable_space) +next + show "(\x. \i\I. X i x) \ space N \ (\\<^sub>E i\I. space (M i))" + using X by (auto simp add: PiE_def dest: measurable_space) +qed lemma measurable_abs_UNIV: "(\n. (\\. f n \) \ measurable M (N n)) \ (\\ n. f n \) \ measurable M (PiM UNIV N)" @@ -708,13 +715,7 @@ lemma measurable_restrict_subset': assumes "J \ L" "\x. x \ J \ sets (M x) = sets (N x)" shows "(\f. restrict f J) \ measurable (Pi\<^sub>M L M) (Pi\<^sub>M J N)" -proof- - from assms(1) have "(\f. restrict f J) \ measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M)" - by (rule measurable_restrict_subset) - also from assms(2) have "measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M) = measurable (Pi\<^sub>M L M) (Pi\<^sub>M J N)" - by (intro sets_PiM_cong measurable_cong_sets) simp_all - finally show ?thesis . -qed + by (metis (no_types) assms measurable_cong_sets measurable_restrict_subset sets_PiM_cong) lemma measurable_prod_emb[intro, simp]: "J \ L \ X \ sets (Pi\<^sub>M J M) \ prod_emb L M J X \ sets (Pi\<^sub>M L M)" @@ -754,11 +755,7 @@ lemma sets_in_extensional_aux: "{x\space (PiM I M). x \ extensional I} \ sets (PiM I M)" -proof - - have "{x\space (PiM I M). x \ extensional I} = space (PiM I M)" - by (auto simp add: extensional_def space_PiM) - then show ?thesis by simp -qed + by (smt (verit) PiE_iff mem_Collect_eq sets.top space_PiM subsetI subset_antisym) lemma sets_in_extensional[measurable (raw)]: "f \ measurable N (PiM I M) \ Measurable.pred N (\x. f x \ extensional I)" @@ -772,7 +769,7 @@ then have "Pi\<^sub>E I E = (\i\I. prod_emb I M {i} (Pi\<^sub>E {i} E))" using E[THEN sets.sets_into_space] by (auto simp: PiE_iff prod_emb_def fun_eq_iff) also have "\ \ sets (PiM I M)" - using I \I \ {}\ by (safe intro!: sets.countable_INT' measurable_prod_emb sets_PiM_I_finite E) + using I \I \ {}\ by (simp add: E sets.countable_INT' sets_PiM_I subset_eq) finally show ?thesis . qed (simp add: sets_PiM_empty) @@ -805,8 +802,9 @@ and K: "\i. K i = prod_emb I M (J i) (X i)" by (metis Union.IH) show ?case - proof (intro exI[of _ "\i. J i"] bexI[of _ "\i. prod_emb (\i. J i) M (J i) (X i)"] conjI) - show "(\i. J i) \ I" "countable (\i. J i)" using J by auto + proof (intro exI bexI conjI) + show "(\i. J i) \ I" "countable (\i. J i)" + using J by auto with J show "\(K ` UNIV) = prod_emb I M (\i. J i) (\i. prod_emb (\i. J i) M (J i) (X i))" by (simp add: K[abs_def] SUP_upper) qed(auto intro: X) @@ -1010,7 +1008,7 @@ in_space: "\j. space (M j) = \(F j)" using sigma_finite_countable by (metis subset_eq) moreover have "(\(Pi\<^sub>E I ` Pi\<^sub>E I F)) = space (Pi\<^sub>M I M)" - using in_space by (auto simp: space_PiM PiE_iff intro!: PiE_choice[THEN iffD2]) + using in_space by (auto simp: space_PiM PiE_iff intro!: PiE_choice[THEN iffD1]) ultimately show "\A. countable A \ A \ sets (Pi\<^sub>M I M) \ \A = space (Pi\<^sub>M I M) \ (\a\A. emeasure (Pi\<^sub>M I M) a \ \)" by (intro exI[of _ "Pi\<^sub>E I ` Pi\<^sub>E I F"]) (auto intro!: countable_PiE sets_PiM_I_finite @@ -1042,26 +1040,26 @@ (\i\I \ J. emeasure (M i) (A i))" by (subst emeasure_distr) (auto simp: * J.emeasure_pair_measure_Times I.measure_times J.measure_times prod.union_disjoint) -qed (insert fin, simp_all) +qed (use fin in simp_all) proposition (in product_sigma_finite) product_nn_integral_fold: assumes IJ: "I \ J = {}" "finite I" "finite J" and f[measurable]: "f \ borel_measurable (Pi\<^sub>M (I \ J) M)" - shows "integral\<^sup>N (Pi\<^sub>M (I \ J) M) f = - (\\<^sup>+ x. (\\<^sup>+ y. f (merge I J (x, y)) \(Pi\<^sub>M J M)) \(Pi\<^sub>M I M))" +shows "integral\<^sup>N (Pi\<^sub>M (I \ J) M) f = (\\<^sup>+ x. (\\<^sup>+ y. f (merge I J (x, y)) \(Pi\<^sub>M J M)) \(Pi\<^sub>M I M))" + (is "?lhs = ?rhs") proof - interpret I: finite_product_sigma_finite M I by standard fact interpret J: finite_product_sigma_finite M J by standard fact interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by standard have P_borel: "(\x. f (merge I J x)) \ borel_measurable (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M)" using measurable_comp[OF measurable_merge f] by (simp add: comp_def) - show ?thesis - apply (subst distr_merge[OF IJ, symmetric]) - apply (subst nn_integral_distr[OF measurable_merge]) - apply measurable [] - apply (subst J.nn_integral_fst[symmetric, OF P_borel]) - apply simp - done + have "?lhs = integral\<^sup>N (distr (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \ J) M) (merge I J)) f" + by (simp add: I.finite_index J.finite_index assms(1) distr_merge) + also have "... = \\<^sup>+ x. f (merge I J x) \(Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M)" + by (simp add: nn_integral_distr) + also have "... = ?rhs" + using P.Fubini P.nn_integral_snd by force + finally show ?thesis . qed lemma (in product_sigma_finite) distr_singleton: @@ -1082,10 +1080,7 @@ proof - interpret I: finite_product_sigma_finite M "{i}" by standard simp from f show ?thesis - apply (subst distr_singleton[symmetric]) - apply (subst nn_integral_distr[OF measurable_component_singleton]) - apply simp_all - done + by (metis distr_singleton insert_iff measurable_component_singleton nn_integral_distr) qed proposition (in product_sigma_finite) product_nn_integral_insert: @@ -1118,8 +1113,7 @@ shows "integral\<^sup>N (Pi\<^sub>M (insert i I) M) f = (\\<^sup>+ y. (\\<^sup>+ x. f (x(i := y)) \(Pi\<^sub>M I M)) \(M i))" apply (subst product_nn_integral_insert[OF assms]) apply (rule pair_sigma_finite.Fubini') - apply intro_locales [] - apply (rule sigma_finite[OF I(1)]) + apply (simp add: local.sigma_finite pair_sigma_finite.intro sigma_finite_measures) apply measurable done @@ -1139,11 +1133,8 @@ measurable_comp[OF measurable_component_singleton, unfolded comp_def]) auto then show ?case - apply (simp add: product_nn_integral_insert[OF insert(1,2)]) - apply (simp add: insert(2-) * nn_integral_multc) - apply (subst nn_integral_cmult) - apply (auto simp add: insert(2-)) - done + using product_nn_integral_insert[OF insert(1,2)] + by (simp add: insert(2-) * nn_integral_multc nn_integral_cmult) qed (simp add: space_PiM) proposition (in product_sigma_finite) product_nn_integral_pair: @@ -1176,7 +1167,8 @@ lemma (in product_sigma_finite) assumes IJ: "I \ J = {}" "finite I" "finite J" and A: "A \ sets (Pi\<^sub>M (I \ J) M)" shows emeasure_fold_integral: - "emeasure (Pi\<^sub>M (I \ J) M) A = (\\<^sup>+x. emeasure (Pi\<^sub>M J M) ((\y. merge I J (x, y)) -` A \ space (Pi\<^sub>M J M)) \Pi\<^sub>M I M)" (is ?I) + "emeasure (Pi\<^sub>M (I \ J) M) A = (\\<^sup>+x. emeasure (Pi\<^sub>M J M) ((\y. merge I J (x, y)) -` A \ space (Pi\<^sub>M J M)) \Pi\<^sub>M I M)" + (is "?lhs = ?rhs") and emeasure_fold_measurable: "(\x. emeasure (Pi\<^sub>M J M) ((\y. merge I J (x, y)) -` A \ space (Pi\<^sub>M J M))) \ borel_measurable (Pi\<^sub>M I M)" (is ?B) proof - @@ -1185,13 +1177,14 @@ interpret IJ: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" .. have merge: "merge I J -` A \ space (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M) \ sets (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M)" by (intro measurable_sets[OF _ A] measurable_merge assms) - - show ?I - apply (subst distr_merge[symmetric, OF IJ]) - apply (subst emeasure_distr[OF measurable_merge A]) + have "?lhs = emeasure (distr (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \ J) M) (merge I J)) A" + by (simp add: I.finite_index J.finite_index assms(1) distr_merge) + also have "... = emeasure (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M) (merge I J -` A \ space (Pi\<^sub>M I M \\<^sub>M Pi\<^sub>M J M))" + by (meson A emeasure_distr measurable_merge) + also have "... = ?rhs" apply (subst J.emeasure_pair_measure_alt[OF merge]) - apply (auto intro!: nn_integral_cong arg_cong2[where f=emeasure] simp: space_pair_measure) - done + by (auto intro!: nn_integral_cong arg_cong2[where f=emeasure] simp: space_pair_measure) + finally show "?lhs = ?rhs" . show ?B using IJ.measurable_emeasure_Pair1[OF merge] @@ -1201,7 +1194,6 @@ lemma sets_Collect_single: "i \ I \ A \ sets (M i) \ { x \ space (Pi\<^sub>M I M). x i \ A } \ sets (Pi\<^sub>M I M)" by simp - lemma pair_measure_eq_distr_PiM: fixes M1 :: "'a measure" and M2 :: "'a measure" assumes "sigma_finite_measure M1" "sigma_finite_measure M2" @@ -1282,7 +1274,7 @@ {(\\<^sub>E i\I. X i) |X. (\i. X i \ sets (M i)) \ finite {i. X i \ space (M i)}}" proof have "{(\\<^sub>E i\I. X i) |X. (\i. X i \ sets (M i)) \ finite {i. X i \ space (M i)}} \ sets (Pi\<^sub>M I M)" - proof (auto) + proof clarify fix X assume H: "\i. X i \ sets (M i)" "finite {i. X i \ space (M i)}" then have *: "X i \ sets (M i)" for i by simp define J where "J = {i \ I. X i \ space (M i)}" @@ -1315,9 +1307,7 @@ qed show "sets (Pi\<^sub>M I M) \ sigma_sets (\\<^sub>E i\I. space (M i)) {(\\<^sub>E i\I. X i) |X. (\i. X i \ sets (M i)) \ finite {i. X i \ space (M i)}}" unfolding sets_PiM_single - apply (rule sigma_sets_mono') - apply (auto simp add: PiE_iff *) - done + by (intro sigma_sets_mono') (auto simp add: PiE_iff *) qed lemma sets_PiM_subset_borel: @@ -1361,7 +1351,7 @@ ultimately show ?thesis unfolding \U = (\B)\ by auto qed have "sigma_sets UNIV (Collect open) \ sets (Pi\<^sub>M UNIV (\i::'a. (borel::('b measure))))" - apply (rule sets.sigma_sets_subset') using ** by auto + by (metis "**" mem_Collect_eq open_UNIV sets.sigma_sets_subset' subsetI) then show "sets (borel::('a \ 'b) measure) \ sets (Pi\<^sub>M UNIV (\_. borel))" unfolding borel_def by auto qed (simp add: sets_PiM_subset_borel) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Further_Topology.thy --- a/src/HOL/Analysis/Further_Topology.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Further_Topology.thy Mon Sep 11 22:59:34 2023 +0200 @@ -30,9 +30,9 @@ proof have "\u. \u \ S; norm u *\<^sub>R f (u /\<^sub>R norm u) \ T\ \ u = 0" by (metis (mono_tags, lifting) DiffI subS01 subspace_mul [OF \subspace T\] fim image_subset_iff inf_le2 singletonD) - then have "g ` (S - {0}) \ T" + then have "g \ (S - {0}) \ T" using g_def by blast - moreover have "g ` (S - {0}) \ UNIV - {0}" + moreover have "g \ (S - {0}) \ UNIV - {0}" proof (clarsimp simp: g_def) fix y assume "y \ S" and f0: "f (y /\<^sub>R norm y) = 0" @@ -159,30 +159,24 @@ assumes ST: "subspace S" "subspace T" "dim S < dim T" and "S \ T" and contf: "continuous_on (sphere 0 1 \ S) f" - and fim: "f ` (sphere 0 1 \ S) \ sphere 0 1 \ T" + and fim: "f \ (sphere 0 1 \ S) \ sphere 0 1 \ T" shows "\c. homotopic_with_canon (\x. True) (sphere 0 1 \ S) (sphere 0 1 \ T) f (\x. c)" proof - have [simp]: "\x. \norm x = 1; x \ S\ \ norm (f x) = 1" - using fim by (simp add: image_subset_iff) + using fim by auto have "compact (sphere 0 1 \ S)" by (simp add: \subspace S\ closed_subspace compact_Int_closed) - then obtain g where pfg: "polynomial_function g" and gim: "g ` (sphere 0 1 \ S) \ T" + then obtain g where pfg: "polynomial_function g" and gim: "g \ (sphere 0 1 \ S) \ T" and g12: "\x. x \ sphere 0 1 \ S \ norm(f x - g x) < 1/2" - using Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \subspace T\, of "1/2"] fim by auto + using Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \subspace T\, of "1/2"] fim + by (auto simp: image_subset_iff_funcset) have gnz: "g x \ 0" if "x \ sphere 0 1 \ S" for x - proof - - have "norm (f x) = 1" - using fim that by (simp add: image_subset_iff) - then show ?thesis - using g12 [OF that] by auto - qed + using g12 that by fastforce have diffg: "g differentiable_on sphere 0 1 \ S" by (metis pfg differentiable_on_polynomial_function) define h where "h \ \x. inverse(norm(g x)) *\<^sub>R g x" have h: "x \ sphere 0 1 \ S \ h x \ sphere 0 1 \ T" for x - unfolding h_def - using gnz [of x] - by (auto simp: subspace_mul [OF \subspace T\] subsetD [OF gim]) + unfolding h_def using \subspace T\ gim gnz subspace_mul by fastforce have diffh: "h differentiable_on sphere 0 1 \ S" unfolding h_def using gnz by (fastforce intro: derivative_intros diffg differentiable_on_compose [OF diffg]) @@ -205,7 +199,7 @@ have "convex T" by (simp add: \subspace T\ subspace_imp_convex) then have "convex hull {f x, g x} \ T" - by (metis IntD2 closed_segment_subset fim gim image_subset_iff segment_convex_hull that) + by (metis IntD2 PiE closed_segment_subset fim gim segment_convex_hull that) then show ?thesis using that non0fg segment_convex_hull by fastforce qed @@ -279,14 +273,9 @@ then have affS_eq: "aff_dim S = aff_dim (ball 0 1 \ T)" using \aff_dim T = aff_dim S\ by simp have "rel_frontier S homeomorphic rel_frontier(ball 0 1 \ T)" - proof (rule homeomorphic_rel_frontiers_convex_bounded_sets [OF \convex S\ \bounded S\]) - show "convex (ball 0 1 \ T)" - by (simp add: \subspace T\ convex_Int subspace_imp_convex) - show "bounded (ball 0 1 \ T)" - by (simp add: bounded_Int) - show "aff_dim S = aff_dim (ball 0 1 \ T)" - by (rule affS_eq) - qed + using homeomorphic_rel_frontiers_convex_bounded_sets [OF \convex S\ \bounded S\] + by (simp add: \subspace T\ affS_eq assms bounded_Int convex_Int + homeomorphic_rel_frontiers_convex_bounded_sets subspace_imp_convex) also have "... = frontier (ball 0 1) \ T" proof (rule convex_affine_rel_frontier_Int [OF convex_ball]) show "affine T" @@ -318,10 +307,8 @@ then show ?thesis proof (cases "T = {}") case True - then have "rel_frontier S = {}" "rel_frontier T = {}" - using fim by fastforce+ then show ?thesis - using that by (simp add: homotopic_on_emptyI) + by (smt (verit, best) False affST aff_dim_negative_iff) next case False obtain T':: "'a set" @@ -383,16 +370,16 @@ assumes fin: "finite \" and "\S. S \ \ \ closed S" and "\S T. \S \ \; T \ \; S \ T\ \ S \ T \ K" - and "\S. S \ \ \ \g. continuous_on S g \ g ` S \ T \ (\x \ S \ K. g x = h x)" - shows "\g. continuous_on (\\) g \ g ` (\\) \ T \ (\x \ \\ \ K. g x = h x)" + and "\S. S \ \ \ \g. continuous_on S g \ g \ S \ T \ (\x \ S \ K. g x = h x)" + shows "\g. continuous_on (\\) g \ g \ (\\) \ T \ (\x \ \\ \ K. g x = h x)" using assms proof (induction \) case empty show ?case by simp next case (insert S \) - then obtain f where contf: "continuous_on (S) f" and fim: "f ` S \ T" and feq: "\x \ S \ K. f x = h x" - by (meson insertI1) - obtain g where contg: "continuous_on (\\) g" and gim: "g ` \\ \ T" and geq: "\x \ \\ \ K. g x = h x" + then obtain f where contf: "continuous_on S f" and fim: "f \ S \ T" and feq: "\x \ S \ K. f x = h x" + by (metis funcset_image insert_iff) + obtain g where contg: "continuous_on (\\) g" and gim: "g \ (\\) \ T" and geq: "\x \ \\ \ K. g x = h x" using insert by auto have fg: "f x = g x" if "x \ T" "T \ \" "x \ S" for x T proof - @@ -403,38 +390,38 @@ qed moreover have "continuous_on (S \ \ \) (\x. if x \ S then f x else g x)" by (auto simp: insert closed_Union contf contg intro: fg continuous_on_cases) + moreover have "S \ \ \ = \ (insert S \)" + by auto ultimately show ?case - by (smt (verit, del_insts) Int_iff UnE complete_lattice_class.Sup_insert feq fim geq gim image_subset_iff) + by (smt (verit) Int_iff Pi_iff UnE feq fim geq gim) qed lemma extending_maps_Union: assumes fin: "finite \" - and "\S. S \ \ \ \g. continuous_on S g \ g ` S \ T \ (\x \ S \ K. g x = h x)" - and "\S. S \ \ \ closed S" - and K: "\X Y. \X \ \; Y \ \; \ X \ Y; \ Y \ X\ \ X \ Y \ K" - shows "\g. continuous_on (\\) g \ g ` (\\) \ T \ (\x \ \\ \ K. g x = h x)" -apply (simp flip: Union_maximal_sets [OF fin]) -apply (rule extending_maps_Union_aux) -apply (simp_all add: Union_maximal_sets [OF fin] assms) -by (metis K psubsetI) - + and "\S. S \ \ \ \g. continuous_on S g \ g \ S \ T \ (\x \ S \ K. g x = h x)" + and "\S. S \ \ \ closed S" + and K: "\X Y. \X \ \; Y \ \; \ X \ Y; \ Y \ X\ \ X \ Y \ K" + shows "\g. continuous_on (\\) g \ g \ (\\) \ T \ (\x \ \\ \ K. g x = h x)" +proof - + have "\S T. \S \ \; \U\\. \ S \ U; T \ \; \U\\. \ T \ U; S \ T\ \ S \ T \ K" + by (metis K psubsetI) + then show ?thesis + apply (simp flip: Union_maximal_sets [OF fin]) + apply (rule extending_maps_Union_aux, simp_all add: Union_maximal_sets [OF fin] assms) + done +qed lemma extend_map_lemma: assumes "finite \" "\ \ \" "convex T" "bounded T" and poly: "\X. X \ \ \ polytope X" and aff: "\X. X \ \ - \ \ aff_dim X < aff_dim T" and face: "\S T. \S \ \; T \ \\ \ (S \ T) face_of S" - and contf: "continuous_on (\\) f" and fim: "f ` (\\) \ rel_frontier T" - obtains g where "continuous_on (\\) g" "g ` (\\) \ rel_frontier T" "\x. x \ \\ \ g x = f x" + and contf: "continuous_on (\\) f" and fim: "f \ (\\) \ rel_frontier T" + obtains g where "continuous_on (\\) g" "g \ (\\) \ rel_frontier T" "\x. x \ \\ \ g x = f x" proof (cases "\ - \ = {}") case True show ?thesis - proof - show "continuous_on (\ \) f" - using True \\ \ \\ contf by auto - show "f ` \ \ \ rel_frontier T" - using True fim by auto - qed auto + using True assms(2) contf fim that by force next case False then have "0 \ aff_dim T" @@ -467,14 +454,14 @@ using Suc.IH [OF ple] by auto let ?Faces = "{D. \C \ \. D face_of C \ aff_dim D \ p}" have extendh: "\g. continuous_on D g \ - g ` D \ rel_frontier T \ + g \ D \ rel_frontier T \ (\x \ D \ \(\ \ {D. \C \ \. D face_of C \ aff_dim D < p}). g x = h x)" if D: "D \ \ \ ?Faces" for D proof (cases "D \ \(\ \ {D. \C \ \. D face_of C \ aff_dim D < p})") case True have "continuous_on D h" using True conth continuous_on_subset by blast - moreover have "h ` D \ rel_frontier T" + moreover have "h \ D \ rel_frontier T" using True him by blast ultimately show ?thesis by blast @@ -574,7 +561,7 @@ show ?thesis using that apply clarsimp - by (smt (verit, ccfv_SIG) IntI face_of_aff_dim_lt face_of_imp_convex [of X] face_of_imp_convex [of Y] face_of_trans ff) + by (smt (verit) IntI face_of_aff_dim_lt face_of_imp_convex face_of_trans ff inf_commute) qed obtain g where "continuous_on (\(\ \ ?Faces)) g" "g ` \(\ \ ?Faces) \ rel_frontier T" @@ -589,23 +576,20 @@ show "\(\ \ {D. \C\\. D face_of C \ aff_dim D < int i}) \ \\" using \\ \ \\ face_of_imp_subset by fastforce show "\\ \ \(\ \ {D. \C\\. D face_of C \ aff_dim D < i})" - proof (rule Union_mono) - show "\ \ \ \ {D. \C\\. D face_of C \ aff_dim D < int i}" - using face by (fastforce simp: aff i) - qed + using face by (intro Union_mono) (fastforce simp: aff i) qed have "int i \ aff_dim T" by (simp add: i) then show ?thesis - using extendf [of i] unfolding eq by (metis that) + using extendf [of i] that unfolding eq by fastforce qed lemma extend_map_lemma_cofinite0: assumes "finite \" and "pairwise (\S T. S \ T \ K) \" - and "\S. S \ \ \ \a g. a \ U \ continuous_on (S - {a}) g \ g ` (S - {a}) \ T \ (\x \ S \ K. g x = h x)" + and "\S. S \ \ \ \a g. a \ U \ continuous_on (S - {a}) g \ g \ (S - {a}) \ T \ (\x \ S \ K. g x = h x)" and "\S. S \ \ \ closed S" shows "\C g. finite C \ disjnt C U \ card C \ card \ \ - continuous_on (\\ - C) g \ g ` (\\ - C) \ T + continuous_on (\\ - C) g \ g \ (\\ - C) \ T \ (\x \ (\\ - C) \ K. g x = h x)" using assms proof induction @@ -614,18 +598,18 @@ next case (insert X \) then have "closed X" and clo: "\X. X \ \ \ closed X" - and \: "\S. S \ \ \ \a g. a \ U \ continuous_on (S - {a}) g \ g ` (S - {a}) \ T \ (\x \ S \ K. g x = h x)" + and \: "\S. S \ \ \ \a g. a \ U \ continuous_on (S - {a}) g \ g \ (S - {a}) \ T \ (\x \ S \ K. g x = h x)" and pwX: "\Y. Y \ \ \ Y \ X \ X \ Y \ K \ Y \ X \ K" and pwF: "pairwise (\ S T. S \ T \ K) \" by (simp_all add: pairwise_insert) obtain C g where C: "finite C" "disjnt C U" "card C \ card \" and contg: "continuous_on (\\ - C) g" - and gim: "g ` (\\ - C) \ T" + and gim: "g \ (\\ - C) \ T" and gh: "\x. x \ (\\ - C) \ K \ g x = h x" using insert.IH [OF pwF \ clo] by auto obtain a f where "a \ U" and contf: "continuous_on (X - {a}) f" - and fim: "f ` (X - {a}) \ T" + and fim: "f \ (X - {a}) \ T" and fh: "(\x \ X \ K. f x = h x)" using insert.prems by (meson insertI1) show ?case @@ -652,19 +636,19 @@ by (blast intro: continuous_on_subset) show "\x\(\(insert X \) - insert a C) \ K. (if x \ X then f x else g x) = h x" using gh by (auto simp: fh) - show "(\a. if a \ X then f a else g a) ` (\(insert X \) - insert a C) \ T" - using fim gim by auto force + show "(\a. if a \ X then f a else g a) \ (\(insert X \) - insert a C) \ T" + using fim gim Pi_iff by fastforce qed qed lemma extend_map_lemma_cofinite1: assumes "finite \" - and \: "\X. X \ \ \ \a g. a \ U \ continuous_on (X - {a}) g \ g ` (X - {a}) \ T \ (\x \ X \ K. g x = h x)" + and \: "\X. X \ \ \ \a g. a \ U \ continuous_on (X - {a}) g \ g \ (X - {a}) \ T \ (\x \ X \ K. g x = h x)" and clo: "\X. X \ \ \ closed X" and K: "\X Y. \X \ \; Y \ \; \ X \ Y; \ Y \ X\ \ X \ Y \ K" obtains C g where "finite C" "disjnt C U" "card C \ card \" "continuous_on (\\ - C) g" - "g ` (\\ - C) \ T" + "g \ (\\ - C) \ T" "\x. x \ (\\ - C) \ K \ g x = h x" proof - let ?\ = "{X \ \. \Y\\. \ X \ Y}" @@ -678,7 +662,7 @@ by (simp add: \finite \\ card_mono) moreover obtain C g where "finite C \ disjnt C U \ card C \ card ?\ \ - continuous_on (\?\ - C) g \ g ` (\?\ - C) \ T + continuous_on (\?\ - C) g \ g \ (\?\ - C) \ T \ (\x \ (\?\ - C) \ K. g x = h x)" using extend_map_lemma_cofinite0 [OF fin pw, of U T h] by (fastforce intro!: clo \) ultimately show ?thesis @@ -689,12 +673,12 @@ lemma extend_map_lemma_cofinite: assumes "finite \" "\ \ \" and T: "convex T" "bounded T" and poly: "\X. X \ \ \ polytope X" - and contf: "continuous_on (\\) f" and fim: "f ` (\\) \ rel_frontier T" + and contf: "continuous_on (\\) f" and fim: "f \ (\\) \ rel_frontier T" and face: "\X Y. \X \ \; Y \ \\ \ (X \ Y) face_of X" and aff: "\X. X \ \ - \ \ aff_dim X \ aff_dim T" obtains C g where "finite C" "disjnt C (\\)" "card C \ card \" "continuous_on (\\ - C) g" - "g ` (\ \ - C) \ rel_frontier T" "\x. x \ \\ \ g x = f x" + "g \ (\ \ - C) \ rel_frontier T" "\x. x \ \\ \ g x = f x" proof - define \ where "\ \ \ \ {D. \C \ \ - \. D face_of C \ aff_dim D < aff_dim T}" have "finite \" @@ -707,7 +691,7 @@ by (metis face inf_commute) have *: "\X Y. \X \ \; Y \ \\ \ X \ Y face_of X" by (simp add: \_def) (smt (verit) \\ \ \\ DiffE face' face_of_Int_subface in_mono inf.idem) - obtain h where conth: "continuous_on (\\) h" and him: "h ` (\\) \ rel_frontier T" + obtain h where conth: "continuous_on (\\) h" and him: "h \ (\\) \ rel_frontier T" and hf: "\x. x \ \\ \ h x = f x" proof (rule extend_map_lemma [OF \finite \\ [unfolded \_def] Un_upper1 T]) show "\X. \X \ \ \ {D. \C\\ - \. D face_of C \ aff_dim D < aff_dim T}\ \ polytope X" @@ -720,11 +704,11 @@ then obtain a where a: "a \ \\" by blast have \: "\a g. a \ \\ \ continuous_on (D - {a}) g \ - g ` (D - {a}) \ rel_frontier T \ (\x \ D \ \\. g x = h x)" + g \ (D - {a}) \ rel_frontier T \ (\x \ D \ \\. g x = h x)" if "D \ \" for D proof (cases "D \ \\") case True - then have "h ` (D - {a}) \ rel_frontier T" "continuous_on (D - {a}) h" + then have "h \ (D - {a}) \ rel_frontier T" "continuous_on (D - {a}) h" using him by (blast intro!: \a \ \\\ continuous_on_subset [OF conth])+ then show ?thesis using a by blast @@ -755,7 +739,7 @@ by (simp add: rel_frontier_retract_of_punctured_affine_hull poly polytope_imp_bounded polytope_imp_convex that brelD) then obtain r where relfD: "rel_frontier D \ affine hull D - {b}" and contr: "continuous_on (affine hull D - {b}) r" - and rim: "r ` (affine hull D - {b}) \ rel_frontier D" + and rim: "r \ (affine hull D - {b}) \ rel_frontier D" and rid: "\x. x \ rel_frontier D \ r x = x" by (auto simp: retract_of_def retraction_def) show ?thesis @@ -774,7 +758,7 @@ have "r ` (D - {b}) \ r ` (affine hull D - {b})" by (simp add: Diff_mono hull_subset image_mono) also have "... \ rel_frontier D" - by (rule rim) + using rim by auto also have "... \ \{E. E face_of D \ aff_dim E < aff_dim T}" using affD by (force simp: rel_frontier_of_polyhedron [OF \polyhedron D\] facet_of_def) @@ -788,7 +772,7 @@ show "continuous_on (r ` (D - {b})) h" by (simp add: Diff_mono hull_subset continuous_on_subset [OF conth rsub]) qed - show "(h \ r) ` (D - {b}) \ rel_frontier T" + show "(h \ r) \ (D - {b}) \ rel_frontier T" using brelD him rsub by fastforce show "(h \ r) x = h x" if x: "x \ D \ \\" for x proof - @@ -825,7 +809,7 @@ have clo: "\S. S \ \ \ closed S" by (simp add: poly polytope_imp_closed) obtain C g where "finite C" "disjnt C (\\)" "card C \ card \" "continuous_on (\\ - C) g" - "g ` (\\ - C) \ rel_frontier T" + "g \ (\\ - C) \ rel_frontier T" and gh: "\x. x \ (\\ - C) \ \\ \ g x = h x" proof (rule extend_map_lemma_cofinite1 [OF \finite \\ \ clo]) show "X \ Y \ \\" if XY: "X \ \" "Y \ \" and "\ X \ Y" "\ Y \ X" for X Y @@ -856,7 +840,7 @@ and face: "\X Y. \X \ \; Y \ \\ \ (X \ Y) face_of X" and contf: "continuous_on S f" and fim: "f \ S \ rel_frontier T" obtains g where "continuous_on (\\) g" - "g ` (\\) \ rel_frontier T" "\x. x \ S \ g x = f x" + "g \ (\\) \ rel_frontier T" "\x. x \ S \ g x = f x" proof - obtain V g where "S \ V" "open V" "continuous_on V g" and gim: "g \ V \ rel_frontier T" and gf: "\x. x \ S \ g x = f x" using neighbourhood_extension_into_ANR [OF contf fim _ \closed S\] ANR_rel_frontier_convex T by blast @@ -877,12 +861,12 @@ proof (rule extend_map_lemma [of \ "\ \ Pow V" T g]) show "continuous_on (\(\ \ Pow V)) g" by (metis Union_Int_subset Union_Pow_eq \continuous_on V g\ continuous_on_subset le_inf_iff) - qed (use \finite \\ T polyG affG faceG gim in fastforce)+ + qed (use \finite \\ T polyG affG faceG gim image_subset_iff_funcset in auto) show ?thesis proof show "continuous_on (\\) h" using \\\ = \\\ conth by auto - show "h ` \\ \ rel_frontier T" + show "h \ \\ \ rel_frontier T" using \\\ = \\\ him by auto show "h x = f x" if "x \ S" for x proof - @@ -910,7 +894,7 @@ and face: "\X Y. \X \ \; Y \ \\ \ (X \ Y) face_of X" and contf: "continuous_on S f" and fim: "f \ S \ rel_frontier T" obtains C g where "finite C" "disjnt C S" "continuous_on (\\ - C) g" - "g ` (\\ - C) \ rel_frontier T" "\x. x \ S \ g x = f x" + "g \ (\\ - C) \ rel_frontier T" "\x. x \ S \ g x = f x" proof - obtain V g where "S \ V" "open V" "continuous_on V g" and gim: "g \ V \ rel_frontier T" and gf: "\x. x \ S \ g x = f x" using neighbourhood_extension_into_ANR [OF contf fim _ \closed S\] ANR_rel_frontier_convex T by blast @@ -926,15 +910,15 @@ by (rule cell_complex_subdivision_exists [OF \d>0\ \finite \\ poly aff face]) auto obtain C h where "finite C" and dis: "disjnt C (\(\ \ Pow V))" and card: "card C \ card \" and conth: "continuous_on (\\ - C) h" - and him: "h ` (\\ - C) \ rel_frontier T" + and him: "h \ (\\ - C) \ rel_frontier T" and hg: "\x. x \ \(\ \ Pow V) \ h x = g x" proof (rule extend_map_lemma_cofinite [of \ "\ \ Pow V" T g]) show "continuous_on (\(\ \ Pow V)) g" by (metis Union_Int_subset Union_Pow_eq \continuous_on V g\ continuous_on_subset le_inf_iff) - show "g ` \(\ \ Pow V) \ rel_frontier T" + show "g \ \(\ \ Pow V) \ rel_frontier T" using gim by force qed (auto intro: \finite \\ T polyG affG dest: faceG) - have Ssub: "S \ \(\ \ Pow V)" + have "S \ \(\ \ Pow V)" proof fix x assume "x \ S" @@ -948,23 +932,8 @@ then show "x \ \(\ \ Pow V)" using \X \ \\ \x \ X\ by blast qed - show ?thesis - proof - show "continuous_on (\\-C) h" - using \\\ = \\\ conth by auto - show "h ` (\\ - C) \ rel_frontier T" - using \\\ = \\\ him by auto - show "h x = f x" if "x \ S" for x - proof - - have "h x = g x" - using Ssub hg that by blast - also have "... = f x" - by (simp add: gf that) - finally show "h x = f x" . - qed - show "disjnt C S" - using dis Ssub by (meson disjnt_iff subset_eq) - qed (intro \finite C\) + then show ?thesis + by (metis PowI Union_Pow_eq \\ \ = \ \\ \finite C\ conth dis disjnt_Union2 gf hg him subsetD that) qed @@ -1021,7 +990,7 @@ by (metis aff aff_dim_subset inf_commute inf_le1 order_trans) obtain K g where K: "finite K" "disjnt K S" and contg: "continuous_on (\{bbox \ T} - K) g" - and gim: "g ` (\{bbox \ T} - K) \ rel_frontier U" + and gim: "g \ (\{bbox \ T} - K) \ rel_frontier U" and gf: "\x. x \ S \ g x = f x" proof (rule extend_map_cell_complex_to_sphere_cofinite [OF _ Ssub _ \convex U\ \bounded U\ _ _ _ contf fim]) @@ -1090,7 +1059,7 @@ have "(g \ closest_point (cbox (- c) c \ T)) ` (T - K) \ g ` (\{bbox \ T} - K)" by (metis image_comp image_mono cpt_subset) also have "... \ rel_frontier U" - by (rule gim) + using gim by blast finally show "(g \ closest_point (cbox (- c) c \ T)) \ (T - K) \ rel_frontier U" by blast show "(g \ closest_point (cbox (- c) c \ T)) x = f x" if "x \ S" for x @@ -1112,7 +1081,7 @@ order_trans [OF \S \ T\ hull_subset [of T affine]]) then obtain K g where "finite K" "disjnt K S" and contg: "continuous_on (T - K) g" - and gim: "g ` (T - K) \ rel_frontier U" + and gim: "g \ (T - K) \ rel_frontier U" and gf: "\x. x \ S \ g x = f x" by (rule_tac K=K and g=g in that) (auto simp: hull_inc elim: continuous_on_subset) then show ?thesis @@ -1195,7 +1164,7 @@ ultimately have "frontier (cball a d) \ U retract_of (U - {a})" by metis then obtain r where contr: "continuous_on (U - {a}) r" - and rim: "r ` (U - {a}) \ sphere a d" "r ` (U - {a}) \ U" + and rim: "r \ (U - {a}) \ sphere a d" "r \ (U - {a}) \ U" and req: "\x. x \ sphere a d \ U \ r x = x" using \affine U\ by (force simp: retract_of_def retraction_def hull_same) define j where "j \ \x. if x \ ball a d then r x else x" @@ -1212,8 +1181,7 @@ using rim by auto then show "j y \ S \ C - ball a d" unfolding j_def - using \r y \ sphere a d\ \y \ U - {a}\ \y \ S \ (C - {a})\ d rim - by (metis Diff_iff Int_iff Un_iff subsetD cball_diff_eq_sphere image_subset_iff) + using \y \ S \ (C - {a})\ \y \ U - {a}\ d rim(2) by auto qed have contj: "continuous_on (U - {a}) j" unfolding j_def Uaeq @@ -1437,7 +1405,7 @@ and gim: "g \ (T - K) \ rel_frontier U" and gf: "\x. x \ S \ g x = f x" using assms extend_map_affine_to_sphere_cofinite_simple by metis - have "(\y C. C \ components (T - S) \ x \ C \ y \ C \ y \ L)" if "x \ K" for x + have "\y C. C \ components (T - S) \ x \ C \ y \ C \ y \ L" if "x \ K" for x proof - have "x \ T-S" using \K \ T\ \disjnt K S\ disjnt_def that by fastforce @@ -1446,7 +1414,7 @@ with ovlap [of C] show ?thesis by blast qed - then obtain \ where \: "\x. x \ K \ \C. C \ components (T - S) \ x \ C \ \ x \ C \ \ x \ L" + then obtain \ where \: "\x. x \ K \ \C. C \ components (T - S) \ x \ C \ \ x \ C \ \ x \ L" by metis obtain h where conth: "continuous_on (T - \ ` K) h" and him: "h \ (T - \ ` K) \ rel_frontier U" @@ -1525,7 +1493,7 @@ define LU where "LU \ L \ (\ {C \ components (T - S). \bounded C} - cbox (-(b+One)) (b+One))" obtain K g where "finite K" "K \ LU" "K \ T" "disjnt K S" and contg: "continuous_on (T - K) g" - and gim: "g ` (T - K) \ rel_frontier U" + and gim: "g \ (T - K) \ rel_frontier U" and gf: "\x. x \ S \ g x = f x" proof (rule extend_map_affine_to_sphere2 [OF SUT aff contf fim]) show "C \ LU \ {}" if "C \ components (T - S)" for C @@ -1577,7 +1545,7 @@ proof (cases "x \ cbox (- c) c") case True with \x \ T\ show ?thesis - using cbsub(3) Knot by (force simp: closest_point_self) + using cbsub(3) Knot by (force simp: closest_point_self) next case False have clo_in_rf: "closest_point (cbox (- c) c \ T) x \ rel_frontier (cbox (- c) c \ T)" @@ -1617,7 +1585,7 @@ by (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg]; force) have "g (closest_point (cbox (- c) c \ T) x) \ rel_frontier U" if "x \ T" "x \ K \ x \ cbox (- b - One) (b + One)" for x - using gim [THEN subsetD] that cloTK by blast + using cloTK gim that by auto then show "(g \ closest_point (cbox (- c) c \ T)) \ (T - K \ cbox (- (b + One)) (b + One)) \ rel_frontier U" by force @@ -1663,8 +1631,7 @@ and "\C. \C \ components(- S); bounded C\ \ C \ L \ {}" obtains K g where "finite K" "K \ L" "disjnt K S" "continuous_on (- K) g" "g \ (- K) \ sphere a r" "\x. x \ S \ g x = f x" - using extend_map_affine_to_sphere_cofinite - [OF \compact S\ affine_UNIV subset_UNIV] assms + using assms extend_map_affine_to_sphere_cofinite [OF \compact S\ affine_UNIV subset_UNIV] by (metis Compl_eq_Diff_UNIV aff_dim_UNIV of_nat_le_iff) corollary extend_map_UNIV_to_sphere_no_bounded_component: @@ -1789,14 +1756,7 @@ by auto moreover have "connected (- S) = connected (- sphere a r)" - proof (rule homotopy_eqv_separation) - show "S homotopy_eqv sphere a r" - using hom homeomorphic_imp_homotopy_eqv by blast - show "compact (sphere a r)" - by simp - then show " compact S" - using hom homeomorphic_compactness by blast - qed + by (meson hom compact_sphere homeomorphic_compactness homeomorphic_imp_homotopy_eqv homotopy_eqv_separation) ultimately show ?thesis using connected_Int_frontier [of "- sphere a r" "ball a r"] by (auto simp: \0 < r\) qed @@ -1831,7 +1791,7 @@ using S by (auto simp: homeomorphic_def) show "connected (- T)" if "closed T" "T \ S" for T proof - - have "f ` T \ sphere a r" + have "f \ T \ sphere a r" using \T \ S\ hom homeomorphism_image1 by blast moreover have "f ` T \ sphere a r" using \T \ S\ hom @@ -1844,7 +1804,7 @@ moreover then have "compact (f ` T)" by (meson compact_continuous_image continuous_on_subset hom homeomorphism_def psubsetE \T \ S\) moreover have "T homotopy_eqv f ` T" - by (meson \f ` T \ sphere a r\ dual_order.strict_implies_order hom homeomorphic_def homeomorphic_imp_homotopy_eqv homeomorphism_of_subsets \T \ S\) + by (meson hom homeomorphic_def homeomorphic_imp_homotopy_eqv homeomorphism_of_subsets order.refl psubsetE that(2)) ultimately show ?thesis using homotopy_eqv_separation [of T "f`T"] by blast qed @@ -1986,7 +1946,7 @@ lemma inv_of_domain_ss0: fixes f :: "'a \ 'a::euclidean_space" - assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \ S" + assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f \ U \ S" and "subspace S" and dimS: "dim S = DIM('b::euclidean_space)" and ope: "openin (top_of_set S) U" shows "openin (top_of_set S) (f ` U)" @@ -2019,19 +1979,20 @@ show "open (k ` U)" by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope]) show "inj_on (k \ f \ h) (k ` U)" - by (smt (verit) comp_apply inj_on_def \U \ S\ fim homeomorphism_apply2 homhk image_iff injf subsetD) + unfolding inj_on_def + by (smt (verit, ccfv_threshold) PiE \U \ S\ assms(3) comp_apply homeomorphism_def homhk imageE inj_on_def injf subset_eq) qed moreover have eq: "f ` U = h ` (k \ f \ h \ k) ` U" unfolding image_comp [symmetric] using \U \ S\ fim - by (metis homeomorphism_image2 homeomorphism_of_subsets homkh subset_image_iff) + by (metis homeomorphism_image2 homeomorphism_of_subsets homhk homkh image_subset_iff_funcset top_greatest) ultimately show ?thesis by (metis (no_types, opaque_lifting) homeomorphism_imp_open_map homhk image_comp open_openin subtopology_UNIV) qed lemma inv_of_domain_ss1: fixes f :: "'a \ 'a::euclidean_space" - assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \ S" + assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f \ U \ S" and "subspace S" and ope: "openin (top_of_set S) U" shows "openin (top_of_set S) (f ` U)" @@ -2045,7 +2006,7 @@ show "continuous_on (U \ S') g" unfolding g_def by (auto intro!: continuous_intros continuous_on_compose2 [OF contf continuous_on_fst]) - show "g ` (U \ S') \ S \ S'" + show "g \ (U \ S') \ S \ S'" using fim by (auto simp: g_def) show "inj_on g (U \ S')" using injf by (auto simp: g_def inj_on_def) @@ -2073,7 +2034,7 @@ fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes ope: "openin (top_of_set U) S" and "subspace U" "subspace V" and VU: "dim V \ dim U" - and contf: "continuous_on S f" and fim: "f ` S \ V" + and contf: "continuous_on S f" and fim: "f \ S \ V" and injf: "inj_on f S" shows "openin (top_of_set V) (f ` S)" proof - @@ -2087,7 +2048,7 @@ have eq: "f ` S = k ` (h \ f) ` S" proof - have "k ` h ` f ` S = f ` S" - by (meson fim homeomorphism_def homeomorphism_of_subsets homhk subset_refl) + by (meson equalityD2 fim funcset_image homeomorphism_image2 homeomorphism_of_subsets homhk) then show ?thesis by (simp add: image_comp) qed @@ -2101,11 +2062,11 @@ moreover have "openin (top_of_set U) ((h \ f) ` S)" proof (rule inv_of_domain_ss1) show "continuous_on S (h \ f)" - by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk) + by (meson contf continuous_on_compose continuous_on_subset fim funcset_image homeomorphism_cont2 homkh) show "inj_on (h \ f) S" - by (smt (verit, ccfv_SIG) comp_apply fim inj_on_def homeomorphism_apply2 [OF homkh] image_subset_iff injf) - show "(h \ f) ` S \ U" - using \V' \ U\ hfV' by auto + by (smt (verit, ccfv_SIG) Pi_iff comp_apply fim homeomorphism_apply2 homkh inj_on_def injf) + show "h \ f \ S \ U" + using \V' \ U\ hfV' by blast qed (auto simp: assms) ultimately show "openin (top_of_set V') ((h \ f) ` S)" using openin_subset_trans \V' \ U\ by force @@ -2116,7 +2077,7 @@ fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes ope: "openin (top_of_set U) S" and "subspace U" "subspace V" - and contf: "continuous_on S f" and fim: "f ` S \ V" + and contf: "continuous_on S f" and fim: "f \ S \ V" and injf: "inj_on f S" and "S \ {}" shows "dim U \ dim V" proof - @@ -2130,11 +2091,12 @@ then obtain h k where homhk: "homeomorphism V T h k" using homeomorphic_def by blast have "continuous_on S (h \ f)" - by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk) + by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_def homhk image_subset_iff_funcset) moreover have "(h \ f) ` S \ U" using \T \ U\ fim homeomorphism_image1 homhk by fastforce moreover have "inj_on (h \ f) S" - by (smt (verit, best) comp_apply inj_on_def fim homeomorphism_apply1 homhk image_subset_iff injf) + unfolding inj_on_def + by (metis Pi_iff comp_apply fim homeomorphism_def homhk inj_on_def injf) ultimately have ope_hf: "openin (top_of_set U) ((h \ f) ` S)" using invariance_of_domain_subspaces [OF ope \subspace U\ \subspace U\] by blast have "(h \ f) ` S \ T" @@ -2155,7 +2117,7 @@ fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes ope: "openin (top_of_set U) S" and aff: "affine U" "affine V" "aff_dim V \ aff_dim U" - and contf: "continuous_on S f" and fim: "f ` S \ V" + and contf: "continuous_on S f" and fim: "f \ S \ V" and injf: "inj_on f S" shows "openin (top_of_set V) (f ` S)" proof (cases "S = {}") @@ -2177,7 +2139,7 @@ by (metis \a \ U\ \b \ V\ aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff) show "continuous_on ((+) (- a) ` S) ((+) (- b) \ f \ (+) a)" by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois) - show "((+) (- b) \ f \ (+) a) ` (+) (- a) ` S \ (+) (- b) ` V" + show "(+) (- b) \ f \ (+) a \ (+) (- a) ` S \ (+) (- b) ` V" using fim by auto show "inj_on ((+) (- b) \ f \ (+) a) ((+) (- a) ` S)" by (auto simp: inj_on_def) (meson inj_onD injf) @@ -2190,7 +2152,7 @@ fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes ope: "openin (top_of_set U) S" and aff: "affine U" "affine V" - and contf: "continuous_on S f" and fim: "f ` S \ V" + and contf: "continuous_on S f" and fim: "f \ S \ V" and injf: "inj_on f S" and "S \ {}" shows "aff_dim U \ aff_dim V" proof - @@ -2206,7 +2168,7 @@ by (simp add: \b \ V\ affine_diffs_subspace_subtract \affine V\ cong: image_cong_simp) show "continuous_on ((+) (- a) ` S) ((+) (- b) \ f \ (+) a)" by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois) - show "((+) (- b) \ f \ (+) a) ` (+) (- a) ` S \ (+) (- b) ` V" + show "(+) (- b) \ f \ (+) a \ (+) (- a) ` S \ (+) (- b) ` V" using fim by auto show "inj_on ((+) (- b) \ f \ (+) a) ((+) (- a) ` S)" by (auto simp: inj_on_def) (meson inj_onD injf) @@ -2227,7 +2189,7 @@ corollary continuous_injective_image_subspace_dim_le: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "subspace S" "subspace T" - and contf: "continuous_on S f" and fim: "f ` S \ T" + and contf: "continuous_on S f" and fim: "f \ S \ T" and injf: "inj_on f S" shows "dim S \ dim T" using invariance_of_dimension_subspaces [of S S _ f] assms by (auto simp: subspace_affine) @@ -2235,7 +2197,7 @@ lemma invariance_of_dimension_convex_domain: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "convex S" - and contf: "continuous_on S f" and fim: "f ` S \ affine hull T" + and contf: "continuous_on S f" and fim: "f \ S \ affine hull T" and injf: "inj_on f S" shows "aff_dim S \ aff_dim T" proof (cases "S = {}") @@ -2249,7 +2211,7 @@ by (simp add: openin_rel_interior) show "continuous_on (rel_interior S) f" using contf continuous_on_subset rel_interior_subset by blast - show "f ` rel_interior S \ affine hull T" + show "f \ rel_interior S \ affine hull T" using fim rel_interior_subset by blast show "inj_on f (rel_interior S)" using inj_on_subset injf rel_interior_subset by blast @@ -2271,8 +2233,8 @@ proof (rule invariance_of_dimension_convex_domain [OF \convex S\]) show "continuous_on S h" using homeomorphism_def homhk by blast - show "h ` S \ affine hull T" - by (metis homeomorphism_def homhk hull_subset) + show "h \ S \ affine hull T" + using homeomorphism_image1 homhk hull_subset by fastforce show "inj_on h S" by (meson homeomorphism_apply1 homhk inj_on_inverseI) qed @@ -2342,13 +2304,13 @@ lemma continuous_image_subset_interior: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "continuous_on S f" "inj_on f S" "DIM('b) \ DIM('a)" - shows "f ` (interior S) \ interior(f ` S)" + shows "f \ (interior S) \ interior(f ` S)" proof - have "open (f ` interior S)" using assms by (intro invariance_of_domain_gen) (auto simp: subset_inj_on interior_subset continuous_on_subset) then show ?thesis - by (simp add: image_mono interior_maximal interior_subset) + by (simp add: image_mono interiorI interior_subset) qed lemma homeomorphic_interiors_same_dimension: @@ -2363,9 +2325,9 @@ and contf: "continuous_on S f" and contg: "continuous_on T g" then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T" by (auto simp: inj_on_def intro: rev_image_eqI) metis+ - have fim: "f ` interior S \ interior T" + have fim: "f \ interior S \ interior T" using continuous_image_subset_interior [OF contf \inj_on f S\] dimeq fST by simp - have gim: "g ` interior T \ interior S" + have gim: "g \ interior T \ interior S" using continuous_image_subset_interior [OF contg \inj_on g T\] dimeq gTS by simp show "homeomorphism (interior S) (interior T) f g" unfolding homeomorphism_def @@ -2437,16 +2399,14 @@ and contf: "continuous_on S f" and contg: "continuous_on T g" then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T" by (auto simp: inj_on_def intro: rev_image_eqI) metis+ - have "g ` interior T \ interior S" + have "g \ interior T \ interior S" using continuous_image_subset_interior [OF contg \inj_on g T\] dimeq gTS by simp then have fim: "f ` frontier S \ frontier T" - unfolding frontier_def - using continuous_image_subset_interior assms(2) assms(3) S by auto - have "f ` interior S \ interior T" + unfolding frontier_def using Pi_mem S assms by fastforce + have "f \ interior S \ interior T" using continuous_image_subset_interior [OF contf \inj_on f S\] dimeq fST by simp then have gim: "g ` frontier T \ frontier S" - unfolding frontier_def - using continuous_image_subset_interior T assms(2) assms(3) by auto + unfolding frontier_def using Pi_mem T assms by fastforce show "homeomorphism (frontier S) (frontier T) f g" unfolding homeomorphism_def proof (intro conjI ballI) @@ -2500,9 +2460,10 @@ lemma continuous_image_subset_rel_interior: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \ T" + assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f \ S \ T" and TS: "aff_dim T \ aff_dim S" - shows "f ` (rel_interior S) \ rel_interior(f ` S)" + shows "f \ (rel_interior S) \ rel_interior(f ` S)" +unfolding image_subset_iff_funcset [symmetric] proof (rule rel_interior_maximal) show "f ` rel_interior S \ f ` S" by(simp add: image_mono rel_interior_subset) @@ -2511,9 +2472,9 @@ show "openin (top_of_set (affine hull S)) (rel_interior S)" by (simp add: openin_rel_interior) show "aff_dim (affine hull f ` S) \ aff_dim (affine hull S)" - by (metis aff_dim_affine_hull aff_dim_subset fim TS order_trans) - show "f ` rel_interior S \ affine hull f ` S" - by (meson \f ` rel_interior S \ f ` S\ hull_subset order_trans) + by (metis TS aff_dim_affine_hull aff_dim_subset fim image_subset_iff_funcset order_trans) + show "f \ rel_interior S \ affine hull f ` S" + using \f ` rel_interior S \ f ` S\ hull_subset by fastforce show "continuous_on (rel_interior S) f" using contf continuous_on_subset rel_interior_subset by blast show "inj_on f (rel_interior S)" @@ -2533,10 +2494,10 @@ and contf: "continuous_on S f" and contg: "continuous_on T g" then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T" by (auto simp: inj_on_def intro: rev_image_eqI) metis+ - have fim: "f ` rel_interior S \ rel_interior T" - by (metis \inj_on f S\ aff contf continuous_image_subset_rel_interior fST order_refl) - have gim: "g ` rel_interior T \ rel_interior S" - by (metis \inj_on g T\ aff contg continuous_image_subset_rel_interior gTS order_refl) + have fim: "f \ rel_interior S \ rel_interior T" + by (smt (verit, best) PiE Pi_I S \inj_on f S\ aff contf continuous_image_subset_rel_interior fST) + have gim: "g \ rel_interior T \ rel_interior S" + by (metis T \inj_on g T\ aff contg continuous_image_subset_rel_interior dual_order.refl funcsetI gTS) show "homeomorphism (rel_interior S) (rel_interior T) f g" unfolding homeomorphism_def proof (intro conjI ballI) @@ -2553,7 +2514,7 @@ by (metis fg \x \ rel_interior T\ imageI) qed moreover have "f ` rel_interior S \ rel_interior T" - by (metis \inj_on f S\ aff contf continuous_image_subset_rel_interior fST order_refl) + using fim by blast ultimately show "f ` rel_interior S = rel_interior T" by blast show "continuous_on (rel_interior S) f" @@ -2587,8 +2548,8 @@ proof (rule invariance_of_dimension_affine_sets) show "continuous_on (rel_interior S) f" using contf continuous_on_subset rel_interior_subset by blast - show "f ` rel_interior S \ affine hull T" - by (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD) + show "f \ rel_interior S \ affine hull T" + by (simp add: S hull_inc mem_rel_interior_ball) show "inj_on f (rel_interior S)" by (metis S inj_on_inverseI inj_on_subset rel_interior_subset) qed (simp_all add: openin_rel_interior assms) @@ -2625,10 +2586,10 @@ and contf: "continuous_on S f" and contg: "continuous_on T g" then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T" by (auto simp: inj_on_def intro: rev_image_eqI) metis+ - have fim: "f ` rel_interior S \ rel_interior T" - by (metis \inj_on f S\ aff contf continuous_image_subset_rel_interior fST order_refl) - have gim: "g ` rel_interior T \ rel_interior S" - by (metis \inj_on g T\ aff contg continuous_image_subset_rel_interior gTS order_refl) + have fim: "f \ rel_interior S \ rel_interior T" + by (metis \inj_on f S\ aff contf continuous_image_subset_rel_interior dual_order.refl fST image_subset_iff_funcset) + have gim: "g \ rel_interior T \ rel_interior S" + by (metis \inj_on g T\ aff contg continuous_image_subset_rel_interior dual_order.refl gTS image_subset_iff_funcset) show "homeomorphism (S - rel_interior S) (T - rel_interior T) f g" unfolding homeomorphism_def proof (intro conjI ballI) @@ -2637,11 +2598,11 @@ show fg: "\y. y \ T - rel_interior T \ f (g y) = y" using T mem_rel_interior_ball by blast show "f ` (S - rel_interior S) = T - rel_interior T" - using S fST fim gim by auto + using S fST fim gim image_subset_iff_funcset by fastforce show "continuous_on (S - rel_interior S) f" using contf continuous_on_subset rel_interior_subset by blast show "g ` (T - rel_interior T) = S - rel_interior S" - using T gTS gim fim by auto + using T gTS gim fim image_subset_iff_funcset by fastforce show "continuous_on (T - rel_interior T) g" using contg continuous_on_subset rel_interior_subset by blast qed @@ -2744,7 +2705,7 @@ (q \ (\z. (Arg2pi z / (2 * pi))))" proof - obtain h where conth: "continuous_on ({0..1::real} \ {0..1}) h" - and him: "h ` ({0..1} \ {0..1}) \ S" + and him: "h \ ({0..1} \ {0..1}) \ S" and h0: "(\x. h (0, x) = p x)" and h1: "(\x. h (1, x) = q x)" and h01: "(\t\{0..1}. h (t, 1) = h (t, 0)) " @@ -2795,13 +2756,13 @@ lemma simply_connected_eq_homotopic_circlemaps1: fixes f :: "complex \ 'a::topological_space" and g :: "complex \ 'a" assumes S: "simply_connected S" - and contf: "continuous_on (sphere 0 1) f" and fim: "f ` (sphere 0 1) \ S" - and contg: "continuous_on (sphere 0 1) g" and gim: "g ` (sphere 0 1) \ S" + and contf: "continuous_on (sphere 0 1) f" and fim: "f \ (sphere 0 1) \ S" + and contg: "continuous_on (sphere 0 1) g" and gim: "g \ (sphere 0 1) \ S" shows "homotopic_with_canon (\h. True) (sphere 0 1) S f g" proof - let ?h = "(\t. complex_of_real (2 * pi * t) * \)" have "homotopic_loops S (f \ exp \ ?h) (f \ exp \ ?h) \ homotopic_loops S (g \ exp \ ?h) (g \ exp \ ?h)" - by (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim) + by (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim image_subset_iff_funcset) then have "homotopic_loops S (f \ exp \ ?h) (g \ exp \ ?h)" using S simply_connected_homotopic_loops by blast then show ?thesis @@ -2812,19 +2773,19 @@ lemma simply_connected_eq_homotopic_circlemaps2a: fixes h :: "complex \ 'a::topological_space" - assumes conth: "continuous_on (sphere 0 1) h" and him: "h ` (sphere 0 1) \ S" + assumes conth: "continuous_on (sphere 0 1) h" and him: "h \ sphere 0 1 \ S" and hom: "\f g::complex \ 'a. - \continuous_on (sphere 0 1) f; f ` (sphere 0 1) \ S; - continuous_on (sphere 0 1) g; g ` (sphere 0 1) \ S\ + \continuous_on (sphere 0 1) f; f \ (sphere 0 1) \ S; + continuous_on (sphere 0 1) g; g \ (sphere 0 1) \ S\ \ homotopic_with_canon (\h. True) (sphere 0 1) S f g" shows "\a. homotopic_with_canon (\h. True) (sphere 0 1) S h (\x. a)" - by (metis conth continuous_on_const him hom image_subset_iff) + by (metis conth continuous_on_const him hom image_subset_iff image_subset_iff_funcset) lemma simply_connected_eq_homotopic_circlemaps2b: fixes S :: "'a::real_normed_vector set" assumes "\f g::complex \ 'a. - \continuous_on (sphere 0 1) f; f ` (sphere 0 1) \ S; - continuous_on (sphere 0 1) g; g ` (sphere 0 1) \ S\ + \continuous_on (sphere 0 1) f; f \ (sphere 0 1) \ S; + continuous_on (sphere 0 1) g; g \ (sphere 0 1) \ S\ \ homotopic_with_canon (\h. True) (sphere 0 1) S f g" shows "path_connected S" proof (clarsimp simp add: path_connected_eq_homotopic_points) @@ -2869,10 +2830,10 @@ fixes S :: "'a::real_normed_vector set" shows "simply_connected S \ (\f g::complex \ 'a. - continuous_on (sphere 0 1) f \ f ` (sphere 0 1) \ S \ - continuous_on (sphere 0 1) g \ g ` (sphere 0 1) \ S + continuous_on (sphere 0 1) f \ f \ (sphere 0 1) \ S \ + continuous_on (sphere 0 1) g \ g \ (sphere 0 1) \ S \ homotopic_with_canon (\h. True) (sphere 0 1) S f g)" - by (metis simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a + by (metis image_subset_iff_funcset simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b simply_connected_eq_homotopic_circlemaps3) proposition simply_connected_eq_contractible_circlemap: @@ -2882,7 +2843,7 @@ (\f::complex \ 'a. continuous_on (sphere 0 1) f \ f `(sphere 0 1) \ S \ (\a. homotopic_with_canon (\h. True) (sphere 0 1) S f (\x. a)))" - by (metis simply_connected_eq_homotopic_circlemaps simply_connected_eq_homotopic_circlemaps2a + by (metis image_subset_iff_funcset simply_connected_eq_homotopic_circlemaps simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps3 simply_connected_imp_path_connected) corollary homotopy_eqv_simple_connectedness: @@ -2966,12 +2927,7 @@ then obtain f g where hom: "homeomorphism S T f g" using homeomorphic_def by blast show "dim S = dim T" - proof (rule order_antisym) - show "dim S \ dim T" - by (metis assms dual_order.refl inj_onI homeomorphism_cont1 [OF hom] homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom] continuous_injective_image_subspace_dim_le) - show "dim T \ dim S" - by (metis assms dual_order.refl inj_onI homeomorphism_cont2 [OF hom] homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom] continuous_injective_image_subspace_dim_le) - qed + by (metis \S homeomorphic T\ aff_dim_subspace assms homeomorphic_convex_sets of_nat_eq_iff subspace_imp_convex) next assume "dim S = dim T" then show "S homeomorphic T" @@ -3034,11 +2990,11 @@ qed qed -subsection\more invariance of domain\(*FIX ME title? *) +subsection\more invariance of domain\ (*FIX ME title? *) proposition invariance_of_domain_sphere_affine_set_gen: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \ T" + assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f \ S \ T" and U: "bounded U" "convex U" and "affine T" and affTU: "aff_dim T < aff_dim U" and ope: "openin (top_of_set (rel_frontier U)) S" @@ -3085,8 +3041,8 @@ qed (use contf continuous_on_subset hgsub in blast) show "inj_on (f \ h) (g ` (S - {b}))" by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf gh Diff_iff comp_apply imageE subset_iff) - show "(f \ h) ` g ` (S - {b}) \ T" - by (metis fim image_comp image_mono hgsub subset_trans) + show "f \ h \ g ` (S - {b}) \ T" + using fim hgsub by fastforce qed (auto simp: assms) moreover have "openin (top_of_set T) ((f \ k) ` j ` (S - {c}))" @@ -3100,20 +3056,15 @@ qed (use contf continuous_on_subset kjsub in blast) show "inj_on (f \ k) (j ` (S - {c}))" by (smt (verit, del_insts) SU homeomorphism_def inj_on_def injf jk Diff_iff comp_apply imageE subset_iff) - show "(f \ k) ` j ` (S - {c}) \ T" - by (metis fim image_comp image_mono kjsub subset_trans) + show "f \ k \ j ` (S - {c}) \ T" + using fim kjsub by fastforce qed (auto simp: assms) ultimately have "openin (top_of_set T) ((f \ h) ` g ` (S - {b}) \ ((f \ k) ` j ` (S - {c})))" by (rule openin_Un) moreover have "(f \ h) ` g ` (S - {b}) = f ` (S - {b})" proof - have "h ` g ` (S - {b}) = (S - {b})" - proof - show "h ` g ` (S - {b}) \ S - {b}" - using homeomorphism_apply1 [OF gh] SU by (fastforce simp add: image_iff image_subset_iff) - show "S - {b} \ h ` g ` (S - {b})" - by (metis Diff_mono SU gh homeomorphism_image2 homeomorphism_of_subsets set_eq_subset) - qed + by (meson Diff_mono Diff_subset SU gh homeomorphism_def homeomorphism_of_subsets subset_singleton_iff) then show ?thesis by (metis image_comp) qed @@ -3134,7 +3085,7 @@ lemma invariance_of_domain_sphere_affine_set: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \ T" + assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f \ S \ T" and "r \ 0" "affine T" and affTU: "aff_dim T < DIM('a)" and ope: "openin (top_of_set (sphere a r)) S" shows "openin (top_of_set T) (f ` S)" @@ -3166,9 +3117,10 @@ then have "\ open (f ` sphere a r)" using compact_open by (metis assms(3) image_is_empty not_less_iff_gr_or_eq sphere_eq_empty) - then show False - using invariance_of_domain_sphere_affine_set [OF contf injf subset_UNIV] \r > 0\ - by (metis aff_dim_UNIV affine_UNIV less_irrefl of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that) + then have "r=0" + by (metis Pi_I UNIV_I aff_dim_UNIV affine_UNIV contf injf invariance_of_domain_sphere_affine_set + of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that) + with \r>0\ show False by auto qed then show ?thesis using not_less by blast @@ -3712,10 +3664,10 @@ assume L: ?lhs then obtain g where contg: "continuous_on S g" and g: "\x. x \ S \ f x = exp(g x)" using inessential_imp_continuous_logarithm_circle by blast - have "f ` S \ sphere 0 1" - by (metis L homotopic_with_imp_subset1) + have "f \ S \ sphere 0 1" + by (metis L image_subset_iff_funcset homotopic_with_imp_subset1) then have "\x. x \ S \ Re (g x) = 0" - using g by auto + using g by (simp add: Pi_iff) then show ?rhs by (rule_tac x="Im \ g" in exI) (auto simp: Euler g intro: contg continuous_intros) next @@ -3747,7 +3699,7 @@ shows "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. f x * h x) (\x. g x * h x)" proof - obtain k where contk: "continuous_on ({0..1::real} \ S) k" - and kim: "k ` ({0..1} \ S) \ sphere 0 1" + and kim: "k \ ({0..1} \ S) \ sphere 0 1" and k0: "\x. k(0, x) = f x" and k1: "\x. k(1, x) = g x" using hom by (auto simp: homotopic_with_def) @@ -3760,8 +3712,8 @@ proposition homotopic_circlemaps_divide: fixes f :: "'a::real_normed_vector \ complex" shows "homotopic_with_canon (\x. True) S (sphere 0 1) f g \ - continuous_on S f \ f ` S \ sphere 0 1 \ - continuous_on S g \ g ` S \ sphere 0 1 \ + continuous_on S f \ f \ S \ sphere 0 1 \ + continuous_on S g \ g \ S \ sphere 0 1 \ (\c. homotopic_with_canon (\x. True) S (sphere 0 1) (\x. f x / g x) (\x. c))" proof - have "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. f x / g x) (\x. 1)" @@ -3780,8 +3732,8 @@ homotopic_with_canon (\x. True) S (sphere 0 1) (\x. f x / g x) (\x. 1)" by auto have "homotopic_with_canon (\x. True) S (sphere 0 1) f g \ - continuous_on S f \ f ` S \ sphere 0 1 \ - continuous_on S g \ g ` S \ sphere 0 1 \ + continuous_on S f \ f \ S \ sphere 0 1 \ + continuous_on S g \ g \ S \ sphere 0 1 \ homotopic_with_canon (\x. True) S (sphere 0 1) (\x. f x / g x) (\x. 1)" (is "?lhs \ ?rhs") proof @@ -3802,7 +3754,7 @@ using homotopic_with_eq [OF homotopic_with_sphere_times [OF L cont]] by (auto simp: divide_inverse norm_inverse) with L show ?rhs - by (simp add: homotopic_with_imp_continuous homotopic_with_imp_subset1 homotopic_with_imp_subset2) + by (simp add: homotopic_with_imp_continuous homotopic_with_imp_funspace1) next assume ?rhs then show ?lhs by (elim conjE homotopic_with_eq [OF homotopic_with_sphere_times]; force) @@ -3882,7 +3834,7 @@ qed lemma open_map_iff_lower_hemicontinuous_preimage: - assumes "f ` S \ T" + assumes "f \ S \ T" shows "((\U. openin (top_of_set S) U \ openin (top_of_set T) (f ` U)) \ (\U. closedin (top_of_set S) U @@ -3913,7 +3865,7 @@ qed lemma closed_map_iff_upper_hemicontinuous_preimage: - assumes "f ` S \ T" + assumes "f \ S \ T" shows "((\U. closedin (top_of_set S) U \ closedin (top_of_set T) (f ` U)) \ (\U. openin (top_of_set S) U @@ -4519,11 +4471,11 @@ assume contf: "continuous_on (S \ T) f" and 0: "\i\S \ T. f i \ 0" then have contfS: "continuous_on S f" and contfT: "continuous_on T f" using continuous_on_subset by auto - have "\continuous_on S f; f ` S \ -{0}\ \ \g. continuous_on S g \ (\x \ S. f x = exp(g x))" + have "\continuous_on S f; f \ S \ -{0}\ \ \g. continuous_on S g \ (\x \ S. f x = exp(g x))" using BS by (auto simp: Borsukian_continuous_logarithm) then obtain g where contg: "continuous_on S g" and fg: "\x. x \ S \ f x = exp(g x)" using "0" contfS by force - have "\continuous_on T f; f ` T \ -{0}\ \ \g. continuous_on T g \ (\x \ T. f x = exp(g x))" + have "\continuous_on T f; f \ T \ -{0}\ \ \g. continuous_on T g \ (\x \ T. f x = exp(g x))" using BT by (auto simp: Borsukian_continuous_logarithm) then obtain h where conth: "continuous_on T h" and fh: "\x. x \ T \ f x = exp(h x)" using "0" contfT by force @@ -4718,12 +4670,12 @@ proof (rule upper_lower_hemicontinuous_explicit [of T "\y. {z \ S. f z = y}" S]) show "\U. openin (top_of_set S) U \ openin (top_of_set T) {x \ T. {z \ S. f z = x} \ U}" - using closed_map_iff_upper_hemicontinuous_preimage [OF fim [THEN equalityD1]] - by (simp add: Abstract_Topology_2.continuous_imp_closed_map \compact S\ contf fim) + using closed_map_iff_upper_hemicontinuous_preimage [of f S T] fim contf \compact S\ + using Abstract_Topology_2.continuous_imp_closed_map by blast show "\U. closedin (top_of_set S) U \ closedin (top_of_set T) {x \ T. {z \ S. f z = x} \ U}" - using ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]] - by meson + using ope open_map_iff_lower_hemicontinuous_preimage[of f S T] fim [THEN equalityD1] + by blast show "bounded {z \ S. f z = y}" by (metis (no_types, lifting) compact_imp_bounded [OF \compact S\] bounded_subset mem_Collect_eq subsetI) qed (use \y \ T\ \0 < d\ fk kTS in \force+\) @@ -4918,7 +4870,7 @@ assume "connected U" "connected V" and T: "T = U \ V" and cloU: "closedin (top_of_set T) U" and cloV: "closedin (top_of_set T) V" - have "f ` (g ` U \ g ` V) \ U" "f ` (g ` U \ g ` V) \ V" + have "f \ (g ` U \ g ` V) \ U" "f \ (g ` U \ g ` V) \ V" using gf fim T by auto (metis UnCI image_iff)+ moreover have "U \ V \ f ` (g ` U \ g ` V)" using gf fim by (force simp: image_iff T) @@ -5393,14 +5345,8 @@ lemma nonseparation_by_component_eq: fixes S :: "'a :: euclidean_space set" assumes "open S \ closed S" - shows "((\C \ components S. connected(-C)) \ connected(- S))" (is "?lhs = ?rhs") -proof - assume ?lhs with assms show ?rhs - by (meson separation_by_component_closed separation_by_component_open) -next - assume ?rhs with assms show ?lhs - using component_complement_connected by force -qed + shows "((\C \ components S. connected(-C)) \ connected(- S))" + by (metis assms component_complement_connected double_complement separation_by_component_closed separation_by_component_open) text\Another interesting equivalent of an inessential mapping into C-{0}\ @@ -5421,7 +5367,7 @@ case False have anr: "ANR (-{0::complex})" by (simp add: ANR_delete open_Compl open_imp_ANR) - obtain g where contg: "continuous_on UNIV g" and gim: "g ` UNIV \ -{0}" + obtain g where contg: "continuous_on UNIV g" and gim: "g \ UNIV \ -{0}" and gf: "\x. x \ S \ g x = f x" proof (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ homotopic_with_symD [OF a]]) show "closedin (top_of_set UNIV) S" @@ -5456,13 +5402,7 @@ by (auto intro: continuous_on_subset [OF contj] simp flip: homeomorphism_image2 [OF hk]) qed show "f x = exp ((j \ k) x)" if "x \ S" for x - proof - - have "f x = (g \ h) (k x)" - by (simp add: gf that) - also have "... = exp (j (k x))" - by (metis rangeI homeomorphism_image2 [OF hk] j) - finally show ?thesis by simp - qed + by (metis UNIV_I comp_apply gf hk homeomorphism_def image_eqI j that) qed then show ?lhs by (simp add: inessential_eq_continuous_logarithm) @@ -5487,7 +5427,7 @@ and ope: "openin (top_of_set (\\)) C" and "homotopic_with_canon (\x. True) C T f (\x. a)" using assms by blast - with \C \ {}\ have "f ` C \ T" "a \ T" + with \C \ {}\ have "f \ C \ T" "a \ T" using homotopic_with_imp_subset1 homotopic_with_imp_subset2 by blast+ have "homotopic_with_canon (\x. True) (\\) T f (\x. a)" proof (rule homotopic_on_clopen_Union) @@ -5514,15 +5454,9 @@ proposition Janiszewski_dual: fixes S :: "complex set" - assumes - "compact S" "compact T" "connected S" "connected T" "connected(- (S \ T))" + assumes "compact S" "compact T" "connected S" "connected T" "connected(- (S \ T))" shows "connected(S \ T)" -proof - - have ST: "compact (S \ T)" - by (simp add: assms compact_Un) - with Borsukian_imp_unicoherent [of "S \ T"] ST assms - show ?thesis - by (simp add: Borsukian_separation_compact closed_subset compact_imp_closed unicoherentD) -qed + by (meson Borsukian_imp_unicoherent Borsukian_separation_compact assms closed_subset compact_Un + compact_imp_closed sup_ge1 sup_ge2 unicoherentD) end diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Homotopy.thy --- a/src/HOL/Analysis/Homotopy.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Homotopy.thy Mon Sep 11 22:59:34 2023 +0200 @@ -2950,11 +2950,11 @@ obtain B where "B \ S" and Borth: "pairwise orthogonal B" and B1: "\x. x \ B \ norm x = 1" and "independent B" "finite B" "card B = dim S" "span B = S" - by (metis orthonormal_basis_subspace [OF S] independent_finite) + by (metis orthonormal_basis_subspace [OF S] independent_imp_finite) obtain C where "C \ T" and Corth: "pairwise orthogonal C" and C1:"\x. x \ C \ norm x = 1" and "independent C" "finite C" "card C = dim T" "span C = T" - by (metis orthonormal_basis_subspace [OF T] independent_finite) + by (metis orthonormal_basis_subspace [OF T] independent_imp_finite) obtain fb where "fb ` B \ C" "inj_on fb B" by (metis \card B = dim S\ \card C = dim T\ \finite B\ \finite C\ card_le_inj d) then have pairwise_orth_fb: "pairwise (\v j. orthogonal (fb v) (fb j)) B" @@ -3003,11 +3003,11 @@ obtain B where "B \ S" and Borth: "pairwise orthogonal B" and B1: "\x. x \ B \ norm x = 1" and "independent B" "finite B" "card B = dim S" "span B = S" - by (metis orthonormal_basis_subspace [OF S] independent_finite) + by (metis orthonormal_basis_subspace [OF S] independent_imp_finite) obtain C where "C \ T" and Corth: "pairwise orthogonal C" and C1:"\x. x \ C \ norm x = 1" and "independent C" "finite C" "card C = dim T" "span C = T" - by (metis orthonormal_basis_subspace [OF T] independent_finite) + by (metis orthonormal_basis_subspace [OF T] independent_imp_finite) obtain fb where "bij_betw fb B C" by (metis \finite B\ \finite C\ bij_betw_iff_card \card B = dim S\ \card C = dim T\ d) then have pairwise_orth_fb: "pairwise (\v j. orthogonal (fb v) (fb j)) B" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Lebesgue_Measure.thy --- a/src/HOL/Analysis/Lebesgue_Measure.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Lebesgue_Measure.thy Mon Sep 11 22:59:34 2023 +0200 @@ -1092,11 +1092,6 @@ shows "lebesgue = density (distr lebesgue lebesgue (\x. c * x)) (\x. ennreal \c\)" using assms by (subst lebesgue_affine_euclidean[of "\_. c" 0]) simp_all -lemma divideR_right: - fixes x y :: "'a::real_normed_vector" - shows "r \ 0 \ y = x /\<^sub>R r \ r *\<^sub>R y = x" - using scaleR_cancel_left[of r y "x /\<^sub>R r"] by simp - lemma lborel_has_bochner_integral_real_affine_iff: fixes x :: "'a :: {banach, second_countable_topology}" shows "c \ 0 \ diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Linear_Algebra.thy --- a/src/HOL/Analysis/Linear_Algebra.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Linear_Algebra.thy Mon Sep 11 22:59:34 2023 +0200 @@ -704,7 +704,7 @@ text \Low-dimensional subset is in a hyperplane (weak orthogonal complement).\ -lemma span_not_univ_orthogonal: +lemma span_not_UNIV_orthogonal: fixes S :: "'a::euclidean_space set" assumes sU: "span S \ UNIV" shows "\a::'a. a \ 0 \ (\x \ span S. a \ x = 0)" @@ -754,7 +754,7 @@ fixes S :: "'a::euclidean_space set" assumes SU: "span S \ UNIV" shows "\ a. a \0 \ span S \ {x. a \ x = 0}" - using span_not_univ_orthogonal[OF SU] by auto + using span_not_UNIV_orthogonal[OF SU] by auto lemma lowdim_subset_hyperplane: fixes S :: "'a::euclidean_space set" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Path_Connected.thy --- a/src/HOL/Analysis/Path_Connected.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Path_Connected.thy Mon Sep 11 22:59:34 2023 +0200 @@ -50,16 +50,6 @@ unfolding path_def path_image_def using continuous_on_compose by blast -lemma continuous_on_translation_eq: - fixes g :: "'a :: real_normed_vector \ 'b :: real_normed_vector" - shows "continuous_on A ((+) a \ g) = continuous_on A g" -proof - - have g: "g = (\x. -a + x) \ ((\x. a + x) \ g)" - by (rule ext) simp - show ?thesis - by (metis (no_types, opaque_lifting) g continuous_on_compose homeomorphism_def homeomorphism_translation) -qed - lemma path_translation_eq: fixes g :: "real \ 'a :: real_normed_vector" shows "path((\x. a + x) \ g) = path g" @@ -251,23 +241,11 @@ by auto lemma path_image_reversepath[simp]: "path_image (reversepath g) = path_image g" -proof - - have *: "\g. path_image (reversepath g) \ path_image g" - unfolding path_image_def subset_eq reversepath_def Ball_def image_iff - by force - show ?thesis - using *[of g] *[of "reversepath g"] - unfolding reversepath_reversepath - by auto -qed + by (metis cancel_comm_monoid_add_class.diff_cancel diff_zero image_comp + image_diff_atLeastAtMost path_image_def reversepath_o) lemma path_reversepath [simp]: "path (reversepath g) \ path g" -proof - - have *: "\g. path g \ path (reversepath g)" - by (metis cancel_comm_monoid_add_class.diff_cancel continuous_on_compose - continuous_on_op_minus diff_zero image_diff_atLeastAtMost path_def reversepath_o) - then show ?thesis by force -qed + by (metis continuous_on_compose continuous_on_op_minus image_comp image_ident path_def path_image_def path_image_reversepath reversepath_o reversepath_reversepath) lemma arc_reversepath: assumes "arc g" shows "arc(reversepath g)" @@ -375,8 +353,8 @@ by auto lemma subset_path_image_join: - assumes "path_image g1 \ s" and "path_image g2 \ s" - shows "path_image (g1 +++ g2) \ s" + assumes "path_image g1 \ S" and "path_image g2 \ S" + shows "path_image (g1 +++ g2) \ S" using path_image_join_subset[of g1 g2] and assms by auto @@ -495,16 +473,10 @@ "path_image g1 \ path_image g2 \ {pathstart g2}" shows "arc(g1 +++ g2)" proof - - have injg1: "inj_on g1 {0..1}" - using assms - by (simp add: arc_def) - have injg2: "inj_on g2 {0..1}" + have injg1: "inj_on g1 {0..1}" and injg2: "inj_on g2 {0..1}" + and g11: "g1 1 = g2 0" and sb: "g1 ` {0..1} \ g2 ` {0..1} \ {g2 0}" using assms - by (simp add: arc_def) - have g11: "g1 1 = g2 0" - and sb: "g1 ` {0..1} \ g2 ` {0..1} \ {g2 0}" - using assms - by (simp_all add: arc_def pathfinish_def pathstart_def path_image_def) + by (auto simp: arc_def pathfinish_def pathstart_def path_image_def) { fix x and y::real assume xy: "g2 (2 * x - 1) = g1 (2 * y)" "x \ 1" "0 \ y" " y * 2 \ 1" "\ x * 2 \ 1" then have "g1 (2 * y) = g2 0" @@ -660,9 +632,9 @@ lemma simple_path_join_loop_eq: assumes "pathfinish g2 = pathstart g1" "pathfinish g1 = pathstart g2" - shows "simple_path(g1 +++ g2) \ + shows "simple_path(g1 +++ g2) \ arc g1 \ arc g2 \ path_image g1 \ path_image g2 \ {pathstart g1, pathstart g2}" -by (metis assms simple_path_joinE simple_path_join_loop) + by (metis assms simple_path_joinE simple_path_join_loop) lemma arc_join_eq: assumes "pathfinish g1 = pathstart g2" @@ -672,8 +644,8 @@ proof assume ?lhs then show ?rhs using reversepath_simps assms - by (smt (verit, ccfv_threshold) Int_commute arc_distinct_ends arc_imp_simple_path arc_reversepath - in_mono insertE pathfinish_join reversepath_joinpaths simple_path_joinE subsetI) + by (smt (verit, best) Int_commute arc_reversepath arc_simple_path in_mono insertE pathstart_join + reversepath_joinpaths simple_path_joinE subsetI) next assume ?rhs then show ?lhs using assms @@ -681,18 +653,17 @@ qed lemma arc_join_eq_alt: - "pathfinish g1 = pathstart g2 - \ (arc(g1 +++ g2) \ - arc g1 \ arc g2 \ path_image g1 \ path_image g2 = {pathstart g2})" -using pathfinish_in_path_image by (fastforce simp: arc_join_eq) + "pathfinish g1 = pathstart g2 + \ arc(g1 +++ g2) \ arc g1 \ arc g2 \ path_image g1 \ path_image g2 = {pathstart g2}" + using pathfinish_in_path_image by (fastforce simp: arc_join_eq) subsection\<^marker>\tag unimportant\\The joining of paths is associative\ lemma path_assoc: - "\pathfinish p = pathstart q; pathfinish q = pathstart r\ + "\pathfinish p = pathstart q; pathfinish q = pathstart r\ \ path(p +++ (q +++ r)) \ path((p +++ q) +++ r)" -by simp + by simp lemma simple_path_assoc: assumes "pathfinish p = pathstart q" "pathfinish q = pathstart r" @@ -740,18 +711,18 @@ subsubsection\<^marker>\tag unimportant\\Symmetry and loops\ lemma path_sym: - "\pathfinish p = pathstart q; pathfinish q = pathstart p\ \ path(p +++ q) \ path(q +++ p)" + "\pathfinish p = pathstart q; pathfinish q = pathstart p\ \ path(p +++ q) \ path(q +++ p)" by auto lemma simple_path_sym: - "\pathfinish p = pathstart q; pathfinish q = pathstart p\ + "\pathfinish p = pathstart q; pathfinish q = pathstart p\ \ simple_path(p +++ q) \ simple_path(q +++ p)" -by (metis (full_types) inf_commute insert_commute simple_path_joinE simple_path_join_loop) + by (metis (full_types) inf_commute insert_commute simple_path_joinE simple_path_join_loop) lemma path_image_sym: - "\pathfinish p = pathstart q; pathfinish q = pathstart p\ + "\pathfinish p = pathstart q; pathfinish q = pathstart p\ \ path_image(p +++ q) = path_image(q +++ p)" -by (simp add: path_image_join sup_commute) + by (simp add: path_image_join sup_commute) subsection\Subpath\ @@ -821,7 +792,7 @@ lemma sum_le_prod1: fixes a::real shows "\a \ 1; b \ 1\ \ a + b \ 1 + a * b" -by (metis add.commute affine_ineq mult.right_neutral) + by (metis add.commute affine_ineq mult.right_neutral) lemma simple_path_subpath_eq: "simple_path(subpath u v g) \ @@ -871,9 +842,8 @@ assumes "simple_path g" "u \ {0..1}" "v \ {0..1}" "u \ v" shows "simple_path(subpath u v g)" using assms - apply (simp add: simple_path_subpath_eq simple_path_imp_path) - apply (simp add: simple_path_def loop_free_def closed_segment_real_eq image_affinity_atLeastAtMost, fastforce) - done + unfolding simple_path_subpath_eq + by (force simp: simple_path_def loop_free_def closed_segment_real_eq image_affinity_atLeastAtMost) lemma arc_simple_path_subpath: "\simple_path g; u \ {0..1}; v \ {0..1}; g u \ g v\ \ arc(subpath u v g)" @@ -1049,7 +1019,7 @@ shows "pathfinish (shiftpath a g) = g a" and "pathstart (shiftpath a g) = g a" using assms - by (auto intro!: pathfinish_shiftpath pathstart_shiftpath) + by (simp_all add: pathstart_shiftpath pathfinish_shiftpath) lemma closed_shiftpath: assumes "pathfinish g = pathstart g" @@ -1082,7 +1052,7 @@ proof (rule continuous_on_eq) show "continuous_on {1-a..1} (g \ (+) (a - 1))" by (intro continuous_intros continuous_on_subset [OF contg]) (use \a \ {0..1}\ in auto) - qed (auto simp: "**" add.commute add_diff_eq) + qed (auto simp: "**" add.commute add_diff_eq) qed auto qed @@ -1699,19 +1669,8 @@ lemma path_connected_path_component [simp]: "path_connected (path_component_set S x)" -proof (clarsimp simp: path_connected_def) - fix y z - assume pa: "path_component S x y" "path_component S x z" - then have pae: "path_component_set S x = path_component_set S y" - using path_component_eq by auto - obtain g where g: "path g \ path_image g \ S \ pathstart g = y \ pathfinish g = z" - using pa path_component_sym path_component_trans path_component_def by metis - then have "path_image g \ path_component_set S x" - using pae path_component_maximal path_connected_path_image by blast - then show "\g. path g \ path_image g \ path_component_set S x \ - pathstart g = y \ pathfinish g = z" - using g by blast -qed + by (smt (verit) mem_Collect_eq path_component_def path_component_eq path_component_maximal + path_connected_component path_connected_path_image pathstart_in_path_image) lemma path_component: "path_component S x y \ (\t. path_connected t \ t \ S \ x \ t \ y \ t)" @@ -1726,13 +1685,7 @@ lemma path_component_path_component [simp]: "path_component_set (path_component_set S x) x = path_component_set S x" -proof (cases "x \ S") - case True show ?thesis - by (metis True mem_Collect_eq path_component_refl path_connected_component_set path_connected_path_component) -next - case False then show ?thesis - by (metis False empty_iff path_component_eq_empty) -qed + by (metis (full_types) mem_Collect_eq path_component_eq_empty path_component_refl path_connected_component_set path_connected_path_component) lemma path_component_subset_connected_component: "(path_component_set S x) \ (connected_component_set S x)" @@ -1750,8 +1703,8 @@ lemma path_connected_linear_image: fixes f :: "'a::real_normed_vector \ 'b::real_normed_vector" assumes "path_connected S" "bounded_linear f" - shows "path_connected(f ` S)" -by (auto simp: linear_continuous_on assms path_connected_continuous_image) + shows "path_connected(f ` S)" + by (auto simp: linear_continuous_on assms path_connected_continuous_image) lemma is_interval_path_connected: "is_interval S \ path_connected S" by (simp add: convex_imp_path_connected is_interval_convex) @@ -1814,8 +1767,8 @@ lemma linear_homeomorphic_image: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "linear f" "inj f" - shows "S homeomorphic f ` S" -by (meson homeomorphic_def homeomorphic_sym linear_homeomorphism_image [OF assms]) + shows "S homeomorphic f ` S" + by (meson homeomorphic_def homeomorphic_sym linear_homeomorphism_image [OF assms]) lemma path_connected_Times: assumes "path_connected s" "path_connected t" @@ -1851,7 +1804,7 @@ lemma is_interval_path_connected_1: fixes s :: "real set" shows "is_interval s \ path_connected s" -using is_interval_connected_1 is_interval_path_connected path_connected_imp_connected by blast + using is_interval_connected_1 is_interval_path_connected path_connected_imp_connected by blast subsection\<^marker>\tag unimportant\\Path components\ @@ -1885,20 +1838,15 @@ qed lemma path_component_unique: - assumes "x \ c" "c \ S" "path_connected c" - "\c'. \x \ c'; c' \ S; path_connected c'\ \ c' \ c" - shows "path_component_set S x = c" - (is "?lhs = ?rhs") -proof - show "?lhs \ ?rhs" - using assms - by (metis mem_Collect_eq path_component_refl path_component_subset path_connected_path_component subsetD) -qed (simp add: assms path_component_maximal) + assumes "x \ C" "C \ S" "path_connected C" + "\C'. \x \ C'; C' \ S; path_connected C'\ \ C' \ C" + shows "path_component_set S x = C" + by (smt (verit, best) Collect_cong assms path_component path_component_of_subset path_connected_component_set) lemma path_component_intermediate_subset: - "path_component_set u a \ t \ t \ u - \ path_component_set t a = path_component_set u a" -by (metis (no_types) path_component_mono path_component_path_component subset_antisym) + "path_component_set U a \ T \ T \ U + \ path_component_set T a = path_component_set U a" + by (metis (no_types) path_component_mono path_component_path_component subset_antisym) lemma complement_path_component_Union: fixes x :: "'a :: topological_space" @@ -2078,9 +2026,8 @@ proof assume ?lhs then show ?rhs - apply (simp add: fun_eq_iff path_component_in_topspace) - apply (meson path_component_of_sym path_component_of_trans) - done + unfolding fun_eq_iff path_component_in_topspace + by (metis path_component_in_topspace path_component_of_sym path_component_of_trans) qed (simp add: path_component_of_refl) lemma path_component_of_disjoint: @@ -2105,7 +2052,7 @@ have "topspace (subtopology X (path_component_of_set X x)) = path_component_of_set X x" by (meson path_component_of_subset_topspace topspace_subtopology_subset) then have "path_connected_space (subtopology X (path_component_of_set X x))" - by (metis (full_types) path_component_of_aux mem_Collect_eq path_component_of_equiv path_connected_space_iff_path_component) + by (metis mem_Collect_eq path_component_of_aux path_component_of_equiv path_connected_space_iff_path_component) then show ?thesis by (simp add: path_component_of_subset_topspace path_connectedin_def) qed @@ -2152,13 +2099,14 @@ by (metis imageI nonempty_path_components_of path_component_of_eq_empty path_components_of_def) lemma path_connectedin_Union: - assumes \: "\S. S \ \ \ path_connectedin X S" "\\ \ {}" + assumes \: "\S. S \ \ \ path_connectedin X S" and "\\ \ {}" shows "path_connectedin X (\\)" proof - obtain a where "\S. S \ \ \ a \ S" using assms by blast then have "\x. x \ topspace (subtopology X (\\)) \ path_component_of (subtopology X (\\)) a x" - by simp (meson Union_upper \ path_component_of path_connectedin_subtopology) + unfolding topspace_subtopology path_component_of + by (metis (full_types) IntD2 Union_iff Union_upper \ path_connectedin_subtopology) then show ?thesis using \ unfolding path_connectedin_def by (metis Sup_le_iff path_component_of_equiv path_connected_space_iff_path_component) @@ -2462,8 +2410,8 @@ {PiE I B |B. \i \ I. B i \ path_components_of(X i)}" (is "?lhs=?rhs") proof show "?lhs \ ?rhs" - apply (simp add: path_components_of_def image_subset_iff) - by (smt (verit, best) PiE_iff image_eqI path_component_of_product_topology) + unfolding path_components_of_def image_subset_iff + by (smt (verit) image_iff mem_Collect_eq path_component_of_product_topology topspace_product_topology_alt) next show "?rhs \ ?lhs" proof @@ -2542,14 +2490,6 @@ assumes "2 \ DIM('a)" shows "path_connected(sphere a r)" proof (cases r "0::real" rule: linorder_cases) - case less - then show ?thesis - by simp -next - case equal - then show ?thesis - by simp -next case greater then have eq: "(sphere (0::'a) r) = (\x. (r / norm x) *\<^sub>R x) ` (- {0::'a})" by (force simp: image_iff split: if_split_asm) @@ -2557,13 +2497,11 @@ by (intro continuous_intros) auto then have "path_connected ((\x. (r / norm x) *\<^sub>R x) ` (- {0::'a}))" by (intro path_connected_continuous_image path_connected_punctured_universe assms) - with eq have "path_connected (sphere (0::'a) r)" - by auto - then have "path_connected((+) a ` (sphere (0::'a) r))" + with eq have "path_connected((+) a ` (sphere (0::'a) r))" by (simp add: path_connected_translation) then show ?thesis by (metis add.right_neutral sphere_translation) -qed +qed auto lemma connected_sphere: fixes a :: "'a :: euclidean_space" @@ -3000,14 +2938,13 @@ proof - obtain i::'a where i: "i \ Basis" using nonempty_Basis by blast - obtain B where B: "B>0" "-S \ ball 0 B" + obtain B where "B>0" and B: "-S \ ball 0 B" using bounded_subset_ballD [OF bs, of 0] by auto then have *: "\x. B \ norm x \ x \ S" by (force simp: ball_def dist_norm) - obtain x' where x': "connected_component S x x'" "norm x' > B" - using B(1) bo(1) bounded_pos by force - obtain y' where y': "connected_component S y y'" "norm y' > B" - using B(1) bo(2) bounded_pos by force + obtain x' y' where x': "connected_component S x x'" "norm x' > B" + and y': "connected_component S y y'" "norm y' > B" + using \B>0\ bo bounded_pos by (metis linorder_not_le mem_Collect_eq) have x'y': "connected_component S x' y'" unfolding connected_component_def proof (intro exI conjI) @@ -3197,8 +3134,8 @@ fixes S :: "'a::euclidean_space set" assumes S: "bounded S" "2 \ DIM('a)" shows "- (outside S) = {x. \B. \y. B \ norm(y) \ \ connected_component (- S) x y}" - apply (auto intro: less_imp_le simp: not_outside_connected_component_lt [OF assms]) - by (meson gt_ex less_le_trans) + unfolding not_outside_connected_component_lt [OF assms] + by (metis (no_types, opaque_lifting) dual_order.strict_trans1 gt_ex pinf(8)) lemma inside_connected_component_lt: fixes S :: "'a::euclidean_space set" @@ -3327,10 +3264,10 @@ qed lemma connected_component_UNIV [simp]: - fixes x :: "'a::real_normed_vector" - shows "connected_component_set UNIV x = UNIV" -using connected_iff_eq_connected_component_set [of "UNIV::'a set"] connected_UNIV -by auto + fixes x :: "'a::real_normed_vector" + shows "connected_component_set UNIV x = UNIV" + using connected_iff_eq_connected_component_set [of "UNIV::'a set"] connected_UNIV + by auto lemma connected_component_eq_UNIV: fixes x :: "'a::real_normed_vector" @@ -3484,10 +3421,8 @@ lemma inside_frontier_eq_interior: fixes S :: "'a :: {real_normed_vector, perfect_space} set" shows "\bounded S; convex S\ \ inside(frontier S) = interior S" - apply (simp add: inside_outside outside_frontier_eq_complement_closure) - using closure_subset interior_subset - apply (auto simp: frontier_def) - done + unfolding inside_outside outside_frontier_eq_complement_closure + using closure_subset interior_subset by (auto simp: frontier_def) lemma open_inside: fixes S :: "'a::real_normed_vector set" @@ -3527,10 +3462,10 @@ qed lemma closure_inside_subset: - fixes S :: "'a::real_normed_vector set" - assumes "closed S" - shows "closure(inside S) \ S \ inside S" -by (metis assms closure_minimal open_closed open_outside sup.cobounded2 union_with_inside) + fixes S :: "'a::real_normed_vector set" + assumes "closed S" + shows "closure(inside S) \ S \ inside S" + by (metis assms closure_minimal open_closed open_outside sup.cobounded2 union_with_inside) lemma frontier_inside_subset: fixes S :: "'a::real_normed_vector set" @@ -3594,7 +3529,7 @@ lemma inside_outside_intersect_connected: "\connected T; inside S \ T \ {}; outside S \ T \ {}\ \ S \ T \ {}" apply (simp add: inside_def outside_def ex_in_conv [symmetric] disjoint_eq_subset_Compl, clarify) - by (metis (no_types, opaque_lifting) Compl_anti_mono connected_component_eq connected_component_maximal contra_subsetD double_compl) + by (metis compl_le_swap1 connected_componentI connected_component_eq mem_Collect_eq) lemma outside_bounded_nonempty: fixes S :: "'a :: {real_normed_vector, perfect_space} set" @@ -4045,7 +3980,8 @@ have "embedding_map (top_of_set S) euclideanreal f" using that embedding_map_into_euclideanreal [of "top_of_set S" f] assms by auto then show ?thesis - by (simp add: embedding_map_def) (metis all_closedin_homeomorphic_image f homeomorphism_injective_closed_map that) + unfolding embedding_map_def topspace_euclidean_subtopology + by (metis f homeomorphic_map_closedness_eq homeomorphism_injective_closed_map that) qed qed (metis homeomorphism_def inj_onI) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Polytope.thy --- a/src/HOL/Analysis/Polytope.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Polytope.thy Mon Sep 11 22:59:34 2023 +0200 @@ -28,8 +28,12 @@ lemma face_of_linear_image: assumes "linear f" "inj f" - shows "(f ` c face_of f ` S) \ c face_of S" -by (simp add: face_of_def inj_image_subset_iff inj_image_mem_iff open_segment_linear_image assms) + shows "(f ` c face_of f ` S) \ c face_of S" + by (simp add: face_of_def inj_image_subset_iff inj_image_mem_iff open_segment_linear_image assms) + +lemma faces_of_linear_image: + "\linear f; inj f\ \ {T. T face_of (f ` S)} = (image f) ` {T. T face_of S}" + by (smt (verit) Collect_cong face_of_def face_of_linear_image setcompr_eq_image subset_imageE) lemma face_of_refl: "convex S \ S face_of S" by (auto simp: face_of_def) @@ -269,6 +273,39 @@ using \affine S\ xy by (auto simp: affine_alt) qed +proposition face_of_conic: + assumes "conic S" "f face_of S" + shows "conic f" + unfolding conic_def +proof (intro strip) + fix x and c::real + assume "x \ f" and "0 \ c" + have f: "\a b x. \a \ S; b \ S; x \ f; x \ open_segment a b\ \ a \ f \ b \ f" + using \f face_of S\ face_ofD by blast + show "c *\<^sub>R x \ f" + proof (cases "x=0 \ c=1") + case True + then show ?thesis + using \x \ f\ by auto + next + case False + with \0 \ c\ obtain d e where de: "0 \ d" "0 \ e" "d < 1" "1 < e" "d < e" "(d = c \ e = c)" + apply (simp add: neq_iff) + by (metis gt_ex less_eq_real_def order_less_le_trans zero_less_one) + then obtain [simp]: "c *\<^sub>R x \ S" "e *\<^sub>R x \ S" \x \ S\ + using \x \ f\ assms conic_mul face_of_imp_subset by blast + have "x \ open_segment (d *\<^sub>R x) (e *\<^sub>R x)" if "c *\<^sub>R x \ f" + using de False that + apply (simp add: in_segment) + apply (rule_tac x="(1 - d) / (e - d)" in exI) + apply (simp add: field_simps) + by (smt (verit, del_insts) add_divide_distrib divide_self scaleR_collapse) + then show ?thesis + using \conic S\ f [of "d *\<^sub>R x" "e *\<^sub>R x" x] de \x \ f\ + by (force simp: conic_def in_segment) + qed +qed + proposition face_of_convex_hulls: assumes S: "finite S" "T \ S" and disj: "affine hull T \ convex hull (S - T) = {}" shows "(convex hull T) face_of (convex hull S)" @@ -927,6 +964,18 @@ by (auto simp: face_of_singleton hull_same) qed (use assms in \simp add: hull_inc\) +lemma extreme_point_of_conic: + assumes "conic S" and x: "x extreme_point_of S" + shows "x = 0" +proof - + have "{x} face_of S" + by (simp add: face_of_singleton x) + then have "conic{x}" + using assms(1) face_of_conic by blast + then show ?thesis + by (force simp: conic_def) +qed + subsection\Facets\ definition\<^marker>\tag important\ facet_of :: "['a::euclidean_space set, 'a set] \ bool" @@ -3826,5 +3875,135 @@ using that by (auto simp: in\) qed qed +section \Finitely generated cone is polyhedral, and hence closed\ + +proposition polyhedron_convex_cone_hull: + fixes S :: "'a::euclidean_space set" + assumes "finite S" + shows "polyhedron(convex_cone hull S)" +proof (cases "S = {}") + case True + then show ?thesis + by (simp add: affine_imp_polyhedron) +next + case False + then have "polyhedron(convex hull (insert 0 S))" + by (simp add: assms polyhedron_convex_hull) + then obtain F a b where "finite F" + and F: "convex hull (insert 0 S) = \ F" + and ab: "\h. h \ F \ a h \ 0 \ h = {x. a h \ x \ b h}" + unfolding polyhedron_def by metis + then have "F \ {}" + by (metis bounded_convex_hull finite_imp_bounded Inf_empty assms finite_insert not_bounded_UNIV) + show ?thesis + unfolding polyhedron_def + proof (intro exI conjI) + show "convex_cone hull S = \ {h \ F. b h = 0}" (is "?lhs = ?rhs") + proof + show "?lhs \ ?rhs" + proof (rule hull_minimal) + show "S \ \ {h \ F. b h = 0}" + by (smt (verit, best) F InterE InterI hull_subset insert_subset mem_Collect_eq subset_eq) + have "\S. \S \ F; b S = 0\ \ convex_cone S" + by (metis ab convex_cone_halfspace_le) + then show "convex_cone (\ {h \ F. b h = 0})" + by (force intro: convex_cone_Inter) + qed + have "x \ convex_cone hull S" + if x: "\h. \h \ F; b h = 0\ \ x \ h" for x + proof - + have "\t. 0 < t \ (t *\<^sub>R x) \ h" if "h \ F" for h + proof (cases "b h = 0") + case True + then show ?thesis + by (metis x linordered_field_no_ub mult_1 scaleR_one that zero_less_mult_iff) + next + case False + then have "b h > 0" + by (smt (verit, del_insts) F InterE ab hull_subset inner_zero_right insert_subset mem_Collect_eq that) + then have "0 \ interior {x. a h \ x \ b h}" + by (simp add: ab that) + then have "0 \ interior h" + using ab that by auto + then obtain \ where "0 < \" and \: "ball 0 \ \ h" + using mem_interior by blast + show ?thesis + proof (cases "x=0") + case True + then show ?thesis + using \ \0 < \\ by auto + next + case False + with \ \0 < \\ show ?thesis + by (rule_tac x="\ / (2 * norm x)" in exI) (auto simp: divide_simps) + qed + qed + then obtain t where t: "\h. h \ F \ 0 < t h \ (t h *\<^sub>R x) \ h" + by metis + then have "Inf (t ` F) *\<^sub>R x /\<^sub>R Inf (t ` F) = x" + by (smt (verit) \F \ {}\ \finite F\ divideR_right finite_imageI finite_less_Inf_iff image_iff image_is_empty) + moreover have "Inf (t ` F) *\<^sub>R x /\<^sub>R Inf (t ` F) \ convex_cone hull S" + proof (rule conicD [OF conic_convex_cone_hull]) + have "Inf (t ` F) *\<^sub>R x \ \ F" + proof clarify + fix h + assume "h \ F" + have eq: "Inf (t ` F) *\<^sub>R x = (1 - Inf(t ` F) / t h) *\<^sub>R 0 + (Inf(t ` F) / t h) *\<^sub>R t h *\<^sub>R x" + using \h \ F\ t by force + show "Inf (t ` F) *\<^sub>R x \ h" + unfolding eq + proof (rule convexD_alt) + have "h = {x. a h \ x \ b h}" + by (simp add: \h \ F\ ab) + then show "convex h" + by (metis convex_halfspace_le) + show "0 \ h" + by (metis F InterE \h \ F\ hull_subset insertCI subsetD) + show "t h *\<^sub>R x \ h" + by (simp add: \h \ F\ t) + show "0 \ Inf (t ` F) / t h" + by (metis \F \ {}\ \h \ F\ cINF_greatest divide_nonneg_pos less_eq_real_def t) + show "Inf (t ` F) / t h \ 1" + by (simp add: \finite F\ \h \ F\ cInf_le_finite t) + qed + qed + moreover have "convex hull (insert 0 S) \ convex_cone hull S" + by (simp add: convex_cone_hull_contains_0 convex_convex_cone_hull hull_minimal hull_subset) + ultimately show "Inf (t ` F) *\<^sub>R x \ convex_cone hull S" + using F by blast + show "0 \ inverse (Inf (t ` F))" + using t by (simp add: \F \ {}\ \finite F\ finite_less_Inf_iff less_eq_real_def) + qed + ultimately show ?thesis + by auto + qed + then show "?rhs \ ?lhs" + by auto + qed + show "\h\{h \ F. b h = 0}. \a b. a \ 0 \ h = {x. a \ x \ b}" + using ab by blast + qed (auto simp: \finite F\) +qed + + +lemma closed_convex_cone_hull: + fixes S :: "'a::euclidean_space set" + shows "finite S \ closed(convex_cone hull S)" + by (simp add: polyhedron_convex_cone_hull polyhedron_imp_closed) + +lemma polyhedron_convex_cone_hull_polytope: + fixes S :: "'a::euclidean_space set" + shows "polytope S \ polyhedron(convex_cone hull S)" + by (metis convex_cone_hull_separate hull_hull polyhedron_convex_cone_hull polytope_def) + +lemma polyhedron_conic_hull_polytope: + fixes S :: "'a::euclidean_space set" + shows "polytope S \ polyhedron(conic hull S)" + by (metis conic_hull_eq_empty convex_cone_hull_separate_nonempty hull_hull polyhedron_convex_cone_hull_polytope polyhedron_empty polytope_def) + +lemma closed_conic_hull_strong: + fixes S :: "'a::euclidean_space set" + shows "0 \ rel_interior S \ polytope S \ compact S \ ~(0 \ S) \ closed(conic hull S)" + using closed_conic_hull polyhedron_conic_hull_polytope polyhedron_imp_closed by blast end diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Analysis/Starlike.thy --- a/src/HOL/Analysis/Starlike.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Analysis/Starlike.thy Mon Sep 11 22:59:34 2023 +0200 @@ -214,6 +214,84 @@ by (simp add: closure_mono interior_subset subset_antisym) qed +lemma openin_subset_relative_interior: + fixes S :: "'a::euclidean_space set" + shows "openin (top_of_set (affine hull T)) S \ (S \ rel_interior T) = (S \ T)" + by (meson order.trans rel_interior_maximal rel_interior_subset) + +lemma conic_hull_eq_span_affine_hull: + fixes S :: "'a::euclidean_space set" + assumes "0 \ rel_interior S" + shows "conic hull S = span S \ conic hull S = affine hull S" +proof - + obtain \ where "\>0" and \: "cball 0 \ \ affine hull S \ S" + using assms mem_rel_interior_cball by blast + have *: "affine hull S = span S" + by (meson affine_hull_span_0 assms hull_inc mem_rel_interior_cball) + moreover + have "conic hull S \ span S" + by (simp add: hull_minimal span_superset) + moreover + have "affine hull S \ conic hull S" + proof clarsimp + fix x + assume "x \ affine hull S" + show "x \ conic hull S" + proof (cases "x=0") + case True + then show ?thesis + using \x \ affine hull S\ by auto + next + case False + then have "(\ / norm x) *\<^sub>R x \ cball 0 \ \ affine hull S" + using \0 < \\ \x \ affine hull S\ * span_mul by fastforce + then have "(\ / norm x) *\<^sub>R x \ S" + by (meson \ subsetD) + then have "\c xa. x = c *\<^sub>R xa \ 0 \ c \ xa \ S" + by (smt (verit, del_insts) \0 < \\ divide_nonneg_nonneg eq_vector_fraction_iff norm_eq_zero norm_ge_zero) + then show ?thesis + by (simp add: conic_hull_explicit) + qed + qed + ultimately show ?thesis + by blast +qed + +lemma conic_hull_eq_span: + fixes S :: "'a::euclidean_space set" + assumes "0 \ rel_interior S" + shows "conic hull S = span S" + by (simp add: assms conic_hull_eq_span_affine_hull) + +lemma conic_hull_eq_affine_hull: + fixes S :: "'a::euclidean_space set" + assumes "0 \ rel_interior S" + shows "conic hull S = affine hull S" + using assms conic_hull_eq_span_affine_hull by blast + +lemma conic_hull_eq_span_eq: + fixes S :: "'a::euclidean_space set" + shows "0 \ rel_interior(conic hull S) \ conic hull S = span S" (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + by (metis conic_hull_eq_span conic_span hull_hull hull_minimal hull_subset span_eq) + show "?rhs \ ?lhs" + by (metis rel_interior_affine subspace_affine subspace_span) +qed + +lemma aff_dim_psubset: + "(affine hull S) \ (affine hull T) \ aff_dim S < aff_dim T" + by (metis aff_dim_affine_hull aff_dim_empty aff_dim_subset affine_affine_hull affine_dim_equal order_less_le) + +lemma aff_dim_eq_full_gen: + "S \ T \ (aff_dim S = aff_dim T \ affine hull S = affine hull T)" + by (smt (verit, del_insts) aff_dim_affine_hull2 aff_dim_psubset hull_mono psubsetI) + +lemma aff_dim_eq_full: + fixes S :: "'n::euclidean_space set" + shows "aff_dim S = (DIM('n)) \ affine hull S = UNIV" + by (metis aff_dim_UNIV aff_dim_affine_hull affine_hull_UNIV) + lemma closure_convex_Int_superset: fixes S :: "'a::euclidean_space set" assumes "convex S" "interior S \ {}" "interior S \ closure T" @@ -772,6 +850,61 @@ qed auto qed +lemma empty_interior_subset_hyperplane_aux: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "0 \ S" and empty_int: "interior S = {}" + shows "\a b. a\0 \ S \ {x. a \ x = b}" +proof - + have False if "\a. a = 0 \ (\b. \T \ S. a \ T \ b)" + proof - + have rel_int: "rel_interior S \ {}" + using assms rel_interior_eq_empty by auto + moreover + have "dim S \ dim (UNIV::'a set)" + by (metis aff_dim_zero affine_hull_UNIV \0 \ S\ dim_UNIV empty_int hull_inc rel_int rel_interior_interior) + then obtain a where "a \ 0" and a: "span S \ {x. a \ x = 0}" + using lowdim_subset_hyperplane + by (metis dim_UNIV dim_subset_UNIV order_less_le) + have "span UNIV = span S" + by (metis span_base span_not_UNIV_orthogonal that) + then have "UNIV \ affine hull S" + by (simp add: \0 \ S\ hull_inc affine_hull_span_0) + ultimately show False + using \rel_interior S \ {}\ empty_int rel_interior_interior by blast + qed + then show ?thesis + by blast +qed + +lemma empty_interior_subset_hyperplane: + fixes S :: "'a::euclidean_space set" + assumes "convex S" and int: "interior S = {}" + obtains a b where "a \ 0" "S \ {x. a \ x = b}" +proof (cases "S = {}") + case True + then show ?thesis + using that by blast +next + case False + then obtain u where "u \ S" + by blast + have "\a b. a \ 0 \ (\x. x - u) ` S \ {x. a \ x = b}" + proof (rule empty_interior_subset_hyperplane_aux) + show "convex ((\x. x - u) ` S)" + using \convex S\ by force + show "0 \ (\x. x - u) ` S" + by (simp add: \u \ S\) + show "interior ((\x. x - u) ` S) = {}" + by (simp add: int interior_translation_subtract) + qed + then obtain a b where "a \ 0" and ab: "(\x. x - u) ` S \ {x. a \ x = b}" + by metis + then have "S \ {x. a \ x = b + (a \ u)}" + using ab by (auto simp: algebra_simps) + then show ?thesis + using \a \ 0\ that by auto +qed + lemma rel_interior_same_affine_hull: fixes S :: "'n::euclidean_space set" assumes "convex S" @@ -1327,118 +1460,119 @@ then show ?thesis by auto qed -lemma convex_closure_rel_interior_inter: - assumes "\S\I. convex (S :: 'n::euclidean_space set)" - and "\{rel_interior S |S. S \ I} \ {}" - shows "\{closure S |S. S \ I} \ closure (\{rel_interior S |S. S \ I})" +lemma convex_closure_rel_interior_Int: + assumes "\S. S\\ \ convex (S :: 'n::euclidean_space set)" + and "\(rel_interior ` \) \ {}" + shows "\(closure ` \) \ closure (\(rel_interior ` \))" proof - - obtain x where x: "\S\I. x \ rel_interior S" + obtain x where x: "\S\\. x \ rel_interior S" using assms by auto - { + show ?thesis + proof fix y - assume "y \ \{closure S |S. S \ I}" - then have y: "\S \ I. y \ closure S" - by auto - { - assume "y = x" - then have "y \ closure (\{rel_interior S |S. S \ I})" - using x closure_subset[of "\{rel_interior S |S. S \ I}"] by auto - } - moreover - { - assume "y \ x" - { fix e :: real - assume e: "e > 0" - define e1 where "e1 = min 1 (e/norm (y - x))" - then have e1: "e1 > 0" "e1 \ 1" "e1 * norm (y - x) \ e" - using \y \ x\ \e > 0\ le_divide_eq[of e1 e "norm (y - x)"] + assume y: "y \ \ (closure ` \)" + show "y \ closure (\(rel_interior ` \))" + proof (cases "y=x") + case True + with closure_subset x show ?thesis + by fastforce + next + case False + show ?thesis + proof (clarsimp simp: closure_approachable_le) + fix \ :: real + assume e: "\ > 0" + define e1 where "e1 = min 1 (\/norm (y - x))" + then have e1: "e1 > 0" "e1 \ 1" "e1 * norm (y - x) \ \" + using \y \ x\ \\ > 0\ le_divide_eq[of e1 \ "norm (y - x)"] by simp_all define z where "z = y - e1 *\<^sub>R (y - x)" { fix S - assume "S \ I" + assume "S \ \" then have "z \ rel_interior S" using rel_interior_closure_convex_shrink[of S x y e1] assms x y e1 z_def by auto } - then have *: "z \ \{rel_interior S |S. S \ I}" + then have *: "z \ \(rel_interior ` \)" by auto - have "\z. z \ \{rel_interior S |S. S \ I} \ z \ y \ dist z y \ e" + show "\x\\ (rel_interior ` \). dist x y \ \" using \y \ x\ z_def * e1 e dist_norm[of z y] - by (rule_tac x="z" in exI) auto - } - then have "y islimpt \{rel_interior S |S. S \ I}" - unfolding islimpt_approachable_le by blast - then have "y \ closure (\{rel_interior S |S. S \ I})" - unfolding closure_def by auto - } - ultimately have "y \ closure (\{rel_interior S |S. S \ I})" - by auto - } - then show ?thesis by auto -qed - -lemma convex_closure_inter: - assumes "\S\I. convex (S :: 'n::euclidean_space set)" - and "\{rel_interior S |S. S \ I} \ {}" - shows "closure (\I) = \{closure S |S. S \ I}" + by force + qed + qed + qed +qed + + +lemma closure_Inter_convex: + fixes \ :: "'n::euclidean_space set set" + assumes "\S. S \ \ \ convex S" and "\(rel_interior ` \) \ {}" + shows "closure(\\) = \(closure ` \)" proof - - have "\{closure S |S. S \ I} \ closure (\{rel_interior S |S. S \ I})" - using convex_closure_rel_interior_inter assms by auto + have "\(closure ` \) \ closure (\(rel_interior ` \))" + by (meson assms convex_closure_rel_interior_Int) moreover - have "closure (\{rel_interior S |S. S \ I}) \ closure (\I)" - using rel_interior_inter_aux closure_mono[of "\{rel_interior S |S. S \ I}" "\I"] + have "closure (\(rel_interior ` \)) \ closure (\\)" + using rel_interior_inter_aux closure_mono[of "\(rel_interior ` \)" "\\"] by auto ultimately show ?thesis - using closure_Int[of I] by auto -qed - -lemma convex_inter_rel_interior_same_closure: - assumes "\S\I. convex (S :: 'n::euclidean_space set)" - and "\{rel_interior S |S. S \ I} \ {}" - shows "closure (\{rel_interior S |S. S \ I}) = closure (\I)" + using closure_Int[of \] by blast +qed + +lemma closure_Inter_convex_open: + "(\S::'n::euclidean_space set. S \ \ \ convex S \ open S) + \ closure(\\) = (if \\ = {} then {} else \(closure ` \))" + by (simp add: closure_Inter_convex rel_interior_open) + +lemma convex_Inter_rel_interior_same_closure: + fixes \ :: "'n::euclidean_space set set" + assumes "\S. S \ \ \ convex S" + and "\(rel_interior ` \) \ {}" + shows "closure (\(rel_interior ` \)) = closure (\\)" proof - - have "\{closure S |S. S \ I} \ closure (\{rel_interior S |S. S \ I})" - using convex_closure_rel_interior_inter assms by auto + have "\(closure ` \) \ closure (\(rel_interior ` \))" + by (meson assms convex_closure_rel_interior_Int) moreover - have "closure (\{rel_interior S |S. S \ I}) \ closure (\I)" - using rel_interior_inter_aux closure_mono[of "\{rel_interior S |S. S \ I}" "\I"] - by auto + have "closure (\(rel_interior ` \)) \ closure (\\)" + by (metis Setcompr_eq_image closure_mono rel_interior_inter_aux) ultimately show ?thesis - using closure_Int[of I] by auto -qed - -lemma convex_rel_interior_inter: - assumes "\S\I. convex (S :: 'n::euclidean_space set)" - and "\{rel_interior S |S. S \ I} \ {}" - shows "rel_interior (\I) \ \{rel_interior S |S. S \ I}" + by (simp add: assms closure_Inter_convex) +qed + +lemma convex_rel_interior_Inter: + fixes \ :: "'n::euclidean_space set set" + assumes "\S. S \ \ \ convex S" + and "\(rel_interior ` \) \ {}" + shows "rel_interior (\\) \ \(rel_interior ` \)" proof - - have "convex (\I)" + have "convex (\\)" using assms convex_Inter by auto moreover - have "convex (\{rel_interior S |S. S \ I})" - using assms convex_rel_interior by (force intro: convex_Inter) + have "convex (\(rel_interior ` \))" + using assms by (metis convex_rel_interior convex_INT) ultimately - have "rel_interior (\{rel_interior S |S. S \ I}) = rel_interior (\I)" - using convex_inter_rel_interior_same_closure assms - closure_eq_rel_interior_eq[of "\{rel_interior S |S. S \ I}" "\I"] + have "rel_interior (\(rel_interior ` \)) = rel_interior (\\)" + using convex_Inter_rel_interior_same_closure assms + closure_eq_rel_interior_eq[of "\(rel_interior ` \)" "\\"] by blast then show ?thesis - using rel_interior_subset[of "\{rel_interior S |S. S \ I}"] by auto -qed - -lemma convex_rel_interior_finite_inter: - assumes "\S\I. convex (S :: 'n::euclidean_space set)" - and "\{rel_interior S |S. S \ I} \ {}" - and "finite I" - shows "rel_interior (\I) = \{rel_interior S |S. S \ I}" + using rel_interior_subset[of "\(rel_interior ` \)"] by auto +qed + +lemma convex_rel_interior_finite_Inter: + fixes \ :: "'n::euclidean_space set set" + assumes "\S. S \ \ \ convex S" + and "\(rel_interior ` \) \ {}" + and "finite \" + shows "rel_interior (\\) = \(rel_interior ` \)" proof - - have "\I \ {}" - using assms rel_interior_inter_aux[of I] by auto - have "convex (\I)" + have "\\ \ {}" + using assms rel_interior_inter_aux[of \] by auto + have "convex (\\)" using convex_Inter assms by auto show ?thesis - proof (cases "I = {}") + proof (cases "\ = {}") case True then show ?thesis using Inter_empty rel_interior_UNIV by auto @@ -1446,43 +1580,43 @@ case False { fix z - assume z: "z \ \{rel_interior S |S. S \ I}" + assume z: "z \ \(rel_interior ` \)" { fix x - assume x: "x \ \I" + assume x: "x \ \\" { fix S - assume S: "S \ I" + assume S: "S \ \" then have "z \ rel_interior S" "x \ S" using z x by auto then have "\m. m > 1 \ (\e. e > 1 \ e \ m \ (1 - e)*\<^sub>R x + e *\<^sub>R z \ S)" using convex_rel_interior_if[of S z] S assms hull_subset[of S] by auto } then obtain mS where - mS: "\S\I. mS S > 1 \ (\e. e > 1 \ e \ mS S \ (1 - e) *\<^sub>R x + e *\<^sub>R z \ S)" by metis - define e where "e = Min (mS ` I)" - then have "e \ mS ` I" using assms \I \ {}\ by simp + mS: "\S\\. mS S > 1 \ (\e. e > 1 \ e \ mS S \ (1 - e) *\<^sub>R x + e *\<^sub>R z \ S)" by metis + define e where "e = Min (mS ` \)" + then have "e \ mS ` \" using assms \\ \ {}\ by simp then have "e > 1" using mS by auto - moreover have "\S\I. e \ mS S" + moreover have "\S\\. e \ mS S" using e_def assms by auto - ultimately have "\e > 1. (1 - e) *\<^sub>R x + e *\<^sub>R z \ \I" + ultimately have "\e > 1. (1 - e) *\<^sub>R x + e *\<^sub>R z \ \\" using mS by auto } - then have "z \ rel_interior (\I)" - using convex_rel_interior_iff[of "\I" z] \\I \ {}\ \convex (\I)\ by auto + then have "z \ rel_interior (\\)" + using convex_rel_interior_iff[of "\\" z] \\\ \ {}\ \convex (\\)\ by auto } then show ?thesis - using convex_rel_interior_inter[of I] assms by auto + using convex_rel_interior_Inter[of \] assms by auto qed qed -lemma convex_closure_inter_two: +lemma closure_Int_convex: fixes S T :: "'n::euclidean_space set" assumes "convex S" and "convex T" assumes "rel_interior S \ rel_interior T \ {}" shows "closure (S \ T) = closure S \ closure T" - using convex_closure_inter[of "{S,T}"] assms by auto + using closure_Inter_convex[of "{S,T}"] assms by auto lemma convex_rel_interior_inter_two: fixes S T :: "'n::euclidean_space set" @@ -1490,7 +1624,7 @@ and "convex T" and "rel_interior S \ rel_interior T \ {}" shows "rel_interior (S \ T) = rel_interior S \ rel_interior T" - using convex_rel_interior_finite_inter[of "{S,T}"] assms by auto + using convex_rel_interior_finite_Inter[of "{S,T}"] assms by auto lemma convex_affine_closure_Int: fixes S T :: "'n::euclidean_space set" @@ -1498,7 +1632,7 @@ and "affine T" and "rel_interior S \ T \ {}" shows "closure (S \ T) = closure S \ T" - by (metis affine_imp_convex assms convex_closure_inter_two rel_interior_affine rel_interior_eq_closure) + by (metis affine_imp_convex assms closure_Int_convex rel_interior_affine rel_interior_eq_closure) lemma connected_component_1_gen: fixes S :: "'a :: euclidean_space set" @@ -1749,22 +1883,21 @@ shows "convex (((*\<^sub>R) c) ` S) \ rel_open (((*\<^sub>R) c) ` S)" by (metis assms convex_scaling rel_interior_convex_scaleR rel_open_def) -lemma convex_rel_open_finite_inter: - assumes "\S\I. convex (S :: 'n::euclidean_space set) \ rel_open S" - and "finite I" - shows "convex (\I) \ rel_open (\I)" -proof (cases "\{rel_interior S |S. S \ I} = {}") +lemma convex_rel_open_finite_Inter: + fixes \ :: "'n::euclidean_space set set" + assumes "\S. S \ \ \ convex S \ rel_open S" + and "finite \" + shows "convex (\\) \ rel_open (\\)" +proof (cases "\{rel_interior S |S. S \ \} = {}") case True - then have "\I = {}" + then have "\\ = {}" using assms unfolding rel_open_def by auto then show ?thesis unfolding rel_open_def by auto next case False - then have "rel_open (\I)" - using assms unfolding rel_open_def - using convex_rel_interior_finite_inter[of I] - by auto + then have "rel_open (\\)" + using assms convex_rel_interior_finite_Inter[of \] by (force simp: rel_open_def) then show ?thesis using convex_Inter assms by auto qed @@ -2880,12 +3013,9 @@ by (auto simp: algebra_simps sum_subtractf sum.distrib) qed have "y \ rel_interior (convex hull S)" - using y - apply (simp add: mem_rel_interior) - apply (auto simp: convex_hull_finite [OF fs]) - apply (drule_tac x=u in spec) - apply (auto intro: *) - done + using y convex_hull_finite [OF fs] * + apply simp + by (metis (no_types, lifting) IntD1 affine_hull_convex_hull mem_rel_interior) } with rel_interior_subset show "?lhs \ ?rhs" by blast qed @@ -4022,6 +4152,133 @@ by (force simp: closedin_limpt) qed +subsection \Closure of conic hulls\ +proposition closedin_conic_hull: + fixes S :: "'a::euclidean_space set" + assumes "compact T" "0 \ T" "T \ S" + shows "closedin (top_of_set (conic hull S)) (conic hull T)" +proof - + have **: "compact ({0..} \ T \ (\z. fst z *\<^sub>R snd z) -` K)" (is "compact ?L") + if "K \ (\z. (fst z) *\<^sub>R snd z) ` ({0..} \ S)" "compact K" for K + proof - + obtain r where "r > 0" and r: "\x. x \ K \ norm x \ r" + by (metis \compact K\ bounded_normE compact_imp_bounded) + show ?thesis + unfolding compact_eq_bounded_closed + proof + have "bounded ({0..r / setdist{0}T} \ T)" + by (simp add: assms(1) bounded_Times compact_imp_bounded) + moreover have "?L \ ({0..r / setdist{0}T} \ T)" + proof clarsimp + fix a b + assume "a *\<^sub>R b \ K" and "b \ T" and "0 \ a" + have "setdist {0} T \ 0" + using \b \ T\ assms compact_imp_closed setdist_eq_0_closed by auto + then have T0: "setdist {0} T > 0" + using less_eq_real_def by fastforce + then have "a * setdist {0} T \ r" + by (smt (verit, ccfv_SIG) \0 \ a\ \a *\<^sub>R b \ K\ \b \ T\ dist_0_norm mult_mono' norm_scaleR r setdist_le_dist singletonI) + with T0 \r>0\ show "a \ r / setdist {0} T" + by (simp add: divide_simps) + qed + ultimately show "bounded ?L" + by (meson bounded_subset) + show "closed ?L" + proof (rule continuous_closed_preimage) + show "continuous_on ({0..} \ T) (\z. fst z *\<^sub>R snd z)" + by (intro continuous_intros) + show "closed ({0::real..} \ T)" + by (simp add: assms(1) closed_Times compact_imp_closed) + show "closed K" + by (simp add: compact_imp_closed that(2)) + qed + qed + qed + show ?thesis + unfolding conic_hull_as_image + proof (rule proper_map) + show "compact ({0..} \ T \ (\z. fst z *\<^sub>R snd z) -` K)" (is "compact ?L") + if "K \ (\z. (fst z) *\<^sub>R snd z) ` ({0..} \ S)" "compact K" for K + proof - + obtain r where "r > 0" and r: "\x. x \ K \ norm x \ r" + by (metis \compact K\ bounded_normE compact_imp_bounded) + show ?thesis + unfolding compact_eq_bounded_closed + proof + have "bounded ({0..r / setdist{0}T} \ T)" + by (simp add: assms(1) bounded_Times compact_imp_bounded) + moreover have "?L \ ({0..r / setdist{0}T} \ T)" + proof clarsimp + fix a b + assume "a *\<^sub>R b \ K" and "b \ T" and "0 \ a" + have "setdist {0} T \ 0" + using \b \ T\ assms compact_imp_closed setdist_eq_0_closed by auto + then have T0: "setdist {0} T > 0" + using less_eq_real_def by fastforce + then have "a * setdist {0} T \ r" + by (smt (verit, ccfv_SIG) \0 \ a\ \a *\<^sub>R b \ K\ \b \ T\ dist_0_norm mult_mono' norm_scaleR r setdist_le_dist singletonI) + with T0 \r>0\ show "a \ r / setdist {0} T" + by (simp add: divide_simps) + qed + ultimately show "bounded ?L" + by (meson bounded_subset) + show "closed ?L" + proof (rule continuous_closed_preimage) + show "continuous_on ({0..} \ T) (\z. fst z *\<^sub>R snd z)" + by (intro continuous_intros) + show "closed ({0::real..} \ T)" + by (simp add: assms(1) closed_Times compact_imp_closed) + show "closed K" + by (simp add: compact_imp_closed that(2)) + qed + qed + qed + show "(\z. fst z *\<^sub>R snd z) ` ({0::real..} \ T) \ (\z. fst z *\<^sub>R snd z) ` ({0..} \ S)" + using \T \ S\ by force + qed auto +qed + +lemma closed_conic_hull: + fixes S :: "'a::euclidean_space set" + assumes "0 \ rel_interior S \ compact S \ 0 \ S" + shows "closed(conic hull S)" + using assms +proof + assume "0 \ rel_interior S" + then show "closed (conic hull S)" + by (simp add: conic_hull_eq_span) +next + assume "compact S \ 0 \ S" + then have "closedin (top_of_set UNIV) (conic hull S)" + using closedin_conic_hull by force + then show "closed (conic hull S)" + by simp +qed + +lemma conic_closure: + fixes S :: "'a::euclidean_space set" + shows "conic S \ conic(closure S)" + by (meson Convex.cone_def cone_closure conic_def) + +lemma closure_conic_hull: + fixes S :: "'a::euclidean_space set" + assumes "0 \ rel_interior S \ bounded S \ ~(0 \ closure S)" + shows "closure(conic hull S) = conic hull (closure S)" + using assms +proof + assume "0 \ rel_interior S" + then show "closure (conic hull S) = conic hull closure S" + by (metis closed_affine_hull closure_closed closure_same_affine_hull closure_subset conic_hull_eq_affine_hull subsetD subset_rel_interior) +next + have "\x. x \ conic hull closure S \ x \ closure (conic hull S)" + by (metis (no_types, opaque_lifting) closure_mono conic_closure conic_conic_hull subset_eq subset_hull) + moreover + assume "bounded S \ 0 \ closure S" + then have "\x. x \ closure (conic hull S) \ x \ conic hull closure S" + by (metis closed_conic_hull closure_Un_frontier closure_closed closure_mono compact_closure hull_Un_subset le_sup_iff subsetD) + ultimately show "closure (conic hull S) = conic hull closure S" + by blast +qed lemma compact_continuous_image_eq: fixes f :: "'a::heine_borel \ 'b::heine_borel" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Binomial.thy --- a/src/HOL/Binomial.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Binomial.thy Mon Sep 11 22:59:34 2023 +0200 @@ -115,6 +115,9 @@ lemma binomial_1 [simp]: "n choose Suc 0 = n" by (induct n) simp_all +lemma choose_one: "n choose 1 = n" for n :: nat + by simp + lemma choose_reduce_nat: "0 < n \ 0 < k \ n choose k = ((n - 1) choose (k - 1)) + ((n - 1) choose k)" @@ -1084,109 +1087,190 @@ qed -subsection \More on Binomial Coefficients\ +subsection \Inclusion-exclusion principle\ + +lemma Inter_over_Union: + "\ {\ (\ x) |x. x \ S} = \ {\ (G ` S) |G. \x\S. G x \ \ x}" +proof - + have "\x. \s\S. \X \ \ s. x \ X \ \G. (\x\S. G x \ \ x) \ (\s\S. x \ G s)" + by metis + then show ?thesis + by (auto simp flip: all_simps ex_simps) +qed + +lemma subset_insert_lemma: + "{T. T \ (insert a S) \ P T} = {T. T \ S \ P T} \ {insert a T |T. T \ S \ P(insert a T)}" (is "?L=?R") +proof + show "?L \ ?R" + by (smt (verit) UnI1 UnI2 insert_Diff mem_Collect_eq subsetI subset_insert_iff) +qed blast + + +text\Versions for additive real functions, where the additivity applies only to some + specific subsets (e.g. cardinality of finite sets, measurable sets with bounded measure. + (From HOL Light)\ + +locale Incl_Excl = + fixes P :: "'a set \ bool" and f :: "'a set \ 'b::ring_1" + assumes disj_add: "\P S; P T; disjnt S T\ \ f(S \ T) = f S + f T" + and empty: "P{}" + and Int: "\P S; P T\ \ P(S \ T)" + and Un: "\P S; P T\ \ P(S \ T)" + and Diff: "\P S; P T\ \ P(S - T)" + +begin + +lemma f_empty [simp]: "f{} = 0" + using disj_add empty by fastforce + +lemma f_Un_Int: "\P S; P T\ \ f(S \ T) + f(S \ T) = f S + f T" + by (smt (verit, ccfv_threshold) Groups.add_ac(2) Incl_Excl.Diff Incl_Excl.Int Incl_Excl_axioms Int_Diff_Un Int_Diff_disjoint Int_absorb Un_Diff Un_Int_eq(2) disj_add disjnt_def group_cancel.add2 sup_bot.right_neutral) -lemma choose_one: "n choose 1 = n" for n :: nat - by simp +lemma restricted_indexed: + assumes "finite A" and X: "\a. a \ A \ P(X a)" + shows "f(\(X ` A)) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\ (X ` B)))" +proof - + have "\finite A; card A = n; \a \ A. P (X a)\ + \ f(\(X ` A)) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\ (X ` B)))" for n X and A :: "'c set" + proof (induction n arbitrary: A X rule: less_induct) + case (less n0 A0 X) + show ?case + proof (cases "n0=0") + case True + with less show ?thesis + by fastforce + next + case False + with less.prems obtain A n a where *: "n0 = Suc n" "A0 = insert a A" "a \ A" "card A = n" "finite A" + by (metis card_Suc_eq_finite not0_implies_Suc) + with less have "P (X a)" by blast + have APX: "\a \ A. P (X a)" + by (simp add: "*" less.prems) + have PUXA: "P (\ (X ` A))" + using \finite A\ APX + by (induction) (auto simp: empty Un) + have "f (\ (X ` A0)) = f (X a \ \ (X ` A))" + by (simp add: *) + also have "... = f (X a) + f (\ (X ` A)) - f (X a \ \ (X ` A))" + using f_Un_Int add_diff_cancel PUXA \P (X a)\ by metis + also have "... = f (X a) - (\B | B \ A \ B \ {}. (- 1) ^ card B * f (\ (X ` B))) + + (\B | B \ A \ B \ {}. (- 1) ^ card B * f (X a \ \ (X ` B)))" + proof - + have 1: "f (\i\A. X a \ X i) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\b\B. X a \ X b))" + using less.IH [of n A "\i. X a \ X i"] APX Int \P (X a)\ by (simp add: *) + have 2: "X a \ \ (X ` A) = (\i\A. X a \ X i)" + by auto + have 3: "f (\ (X ` A)) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\ (X ` B)))" + using less.IH [of n A X] APX Int \P (X a)\ by (simp add: *) + show ?thesis + unfolding 3 2 1 + by (simp add: sum_negf) + qed + also have "... = (\B | B \ A0 \ B \ {}. (- 1) ^ (card B + 1) * f (\ (X ` B)))" + proof - + have F: "{insert a B |B. B \ A} = insert a ` Pow A \ {B. B \ A \ B \ {}} = Pow A - {{}}" + by auto + have G: "(\B\Pow A. (- 1) ^ card (insert a B) * f (X a \ \ (X ` B))) = (\B\Pow A. - ((- 1) ^ card B * f (X a \ \ (X ` B))))" + proof (rule sum.cong [OF refl]) + fix B + assume B: "B \ Pow A" + then have "finite B" + using \finite A\ finite_subset by auto + show "(- 1) ^ card (insert a B) * f (X a \ \ (X ` B)) = - ((- 1) ^ card B * f (X a \ \ (X ` B)))" + using B * by (auto simp add: card_insert_if \finite B\) + qed + have disj: "{B. B \ A \ B \ {}} \ {insert a B |B. B \ A} = {}" + using * by blast + have inj: "inj_on (insert a) (Pow A)" + using "*" inj_on_def by fastforce + show ?thesis + apply (simp add: * subset_insert_lemma sum.union_disjoint disj sum_negf) + apply (simp add: F G sum_negf sum.reindex [OF inj] o_def sum_diff *) + done + qed + finally show ?thesis . + qed + qed + then show ?thesis + by (meson assms) +qed + +lemma restricted: + assumes "finite A" "\a. a \ A \ P a" + shows "f(\ A) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\ B))" + using restricted_indexed [of A "\x. x"] assms by auto + +end + +subsection\Versions for unrestrictedly additive functions\ + +lemma Incl_Excl_UN: + fixes f :: "'a set \ 'b::ring_1" + assumes "\S T. disjnt S T \ f(S \ T) = f S + f T" "finite A" + shows "f(\(G ` A)) = (\B | B \ A \ B \ {}. (-1) ^ (card B + 1) * f (\ (G ` B)))" +proof - + interpret Incl_Excl "\x. True" f + by (simp add: Incl_Excl.intro assms(1)) + show ?thesis + using restricted_indexed assms by blast +qed + +lemma Incl_Excl_Union: + fixes f :: "'a set \ 'b::ring_1" + assumes "\S T. disjnt S T \ f(S \ T) = f S + f T" "finite A" + shows "f(\ A) = (\B | B \ A \ B \ {}. (- 1) ^ (card B + 1) * f (\ B))" + using Incl_Excl_UN[of f A "\X. X"] assms by simp text \The famous inclusion-exclusion formula for the cardinality of a union\ lemma int_card_UNION: - assumes "finite A" - and "\k \ A. finite k" + assumes "finite A" "\K. K \ A \ finite K" shows "int (card (\A)) = (\I | I \ A \ I \ {}. (- 1) ^ (card I + 1) * int (card (\I)))" - (is "?lhs = ?rhs") +proof - + interpret Incl_Excl finite "int o card" + proof qed (auto simp add: card_Un_disjnt) + show ?thesis + using restricted assms by auto +qed + +text\A more conventional form\ +lemma inclusion_exclusion: + assumes "finite A" "\K. K \ A \ finite K" + shows "int(card(\ A)) = + (\n=1..card A. (-1) ^ (Suc n) * (\B | B \ A \ card B = n. int (card (\ B))))" (is "_=?R") proof - - have "?rhs = (\I | I \ A \ I \ {}. (- 1) ^ (card I + 1) * (\_\\I. 1))" - by simp - also have "\ = (\I | I \ A \ I \ {}. (\_\\I. (- 1) ^ (card I + 1)))" - by (subst sum_distrib_left) simp - also have "\ = (\(I, _)\Sigma {I. I \ A \ I \ {}} Inter. (- 1) ^ (card I + 1))" - using assms by (subst sum.Sigma) auto - also have "\ = (\(x, I)\(SIGMA x:UNIV. {I. I \ A \ I \ {} \ x \ \I}). (- 1) ^ (card I + 1))" - by (rule sum.reindex_cong [where l = "\(x, y). (y, x)"]) (auto intro: inj_onI) - also have "\ = (\(x, I)\(SIGMA x:\A. {I. I \ A \ I \ {} \ x \ \I}). (- 1) ^ (card I + 1))" - using assms - by (auto intro!: sum.mono_neutral_cong_right finite_SigmaI2 intro: finite_subset[where B="\A"]) - also have "\ = (\x\\A. (\I|I \ A \ I \ {} \ x \ \I. (- 1) ^ (card I + 1)))" - using assms by (subst sum.Sigma) auto - also have "\ = (\_\\A. 1)" (is "sum ?lhs _ = _") - proof (rule sum.cong[OF refl]) - fix x - assume x: "x \ \A" - define K where "K = {X \ A. x \ X}" - with \finite A\ have K: "finite K" - by auto - let ?I = "\i. {I. I \ A \ card I = i \ x \ \I}" - have "inj_on snd (SIGMA i:{1..card A}. ?I i)" - using assms by (auto intro!: inj_onI) - moreover have [symmetric]: "snd ` (SIGMA i:{1..card A}. ?I i) = {I. I \ A \ I \ {} \ x \ \I}" - using assms - by (auto intro!: rev_image_eqI[where x="(card a, a)" for a] - simp add: card_gt_0_iff[folded Suc_le_eq] - dest: finite_subset intro: card_mono) - ultimately have "?lhs x = (\(i, I)\(SIGMA i:{1..card A}. ?I i). (- 1) ^ (i + 1))" - by (rule sum.reindex_cong [where l = snd]) fastforce - also have "\ = (\i=1..card A. (\I|I \ A \ card I = i \ x \ \I. (- 1) ^ (i + 1)))" - using assms by (subst sum.Sigma) auto - also have "\ = (\i=1..card A. (- 1) ^ (i + 1) * (\I|I \ A \ card I = i \ x \ \I. 1))" - by (subst sum_distrib_left) simp - also have "\ = (\i=1..card K. (- 1) ^ (i + 1) * (\I|I \ K \ card I = i. 1))" - (is "_ = ?rhs") - proof (rule sum.mono_neutral_cong_right[rule_format]) - show "finite {1..card A}" - by simp - show "{1..card K} \ {1..card A}" - using \finite A\ by (auto simp add: K_def intro: card_mono) - next - fix i - assume "i \ {1..card A} - {1..card K}" - then have i: "i \ card A" "card K < i" - by auto - have "{I. I \ A \ card I = i \ x \ \I} = {I. I \ K \ card I = i}" - by (auto simp add: K_def) - also have "\ = {}" - using \finite A\ i by (auto simp add: K_def dest: card_mono[rotated 1]) - finally show "(- 1) ^ (i + 1) * (\I | I \ A \ card I = i \ x \ \I. 1 :: int) = 0" - by (metis mult_zero_right sum.empty) - next - fix i - have "(\I | I \ A \ card I = i \ x \ \I. 1) = (\I | I \ K \ card I = i. 1 :: int)" - (is "?lhs = ?rhs") - by (rule sum.cong) (auto simp add: K_def) - then show "(- 1) ^ (i + 1) * ?lhs = (- 1) ^ (i + 1) * ?rhs" - by simp - qed - also have "{I. I \ K \ card I = 0} = {{}}" - using assms by (auto simp add: card_eq_0_iff K_def dest: finite_subset) - then have "?rhs = (\i = 0..card K. (- 1) ^ (i + 1) * (\I | I \ K \ card I = i. 1 :: int)) + 1" - by (subst (2) sum.atLeast_Suc_atMost) simp_all - also have "\ = (\i = 0..card K. (- 1) * ((- 1) ^ i * int (card K choose i))) + 1" - using K by (subst n_subsets[symmetric]) simp_all - also have "\ = - (\i = 0..card K. (- 1) ^ i * int (card K choose i)) + 1" - by (subst sum_distrib_left[symmetric]) simp - also have "\ = - ((-1 + 1) ^ card K) + 1" - by (subst binomial_ring) (simp add: ac_simps atMost_atLeast0) - also have "\ = 1" - using x K by (auto simp add: K_def card_gt_0_iff) - finally show "?lhs x = 1" . + have fin: "finite {I. I \ A \ I \ {}}" + by (simp add: assms) + have "\k. \Suc 0 \ k; k \ card A\ \ \B\A. B \ {} \ k = card B" + by (metis (mono_tags, lifting) Suc_le_D Zero_neq_Suc card_eq_0_iff obtain_subset_with_card_n) + with \finite A\ finite_subset + have card_eq: "card ` {I. I \ A \ I \ {}} = {1..card A}" + using not_less_eq_eq card_mono by (fastforce simp: image_iff) + have "int(card(\ A)) + = (\y = 1..card A. \I\{x. x \ A \ x \ {} \ card x = y}. - ((- 1) ^ y * int (card (\ I))))" + by (simp add: int_card_UNION assms sum.image_gen [OF fin, where g=card] card_eq) + also have "... = ?R" + proof - + have "{B. B \ A \ B \ {} \ card B = k} = {B. B \ A \ card B = k}" + if "Suc 0 \ k" and "k \ card A" for k + using that by auto + then show ?thesis + by (clarsimp simp add: sum_negf simp flip: sum_distrib_left) qed - also have "\ = int (card (\A))" - by simp - finally show ?thesis .. + finally show ?thesis . qed lemma card_UNION: - assumes "finite A" - and "\k \ A. finite k" + assumes "finite A" and "\K. K \ A \ finite K" shows "card (\A) = nat (\I | I \ A \ I \ {}. (- 1) ^ (card I + 1) * int (card (\I)))" by (simp only: flip: int_card_UNION [OF assms]) lemma card_UNION_nonneg: - assumes "finite A" - and "\k \ A. finite k" + assumes "finite A" and "\K. K \ A \ finite K" shows "(\I | I \ A \ I \ {}. (- 1) ^ (card I + 1) * int (card (\I))) \ 0" using int_card_UNION [OF assms] by presburger +subsection \More on Binomial Coefficients\ + text \The number of nat lists of length \m\ summing to \N\ is \<^term>\(N + m - 1) choose N\:\ lemma card_length_sum_list_rec: assumes "m \ 1" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Cauchy_Integral_Formula.thy --- a/src/HOL/Complex_Analysis/Cauchy_Integral_Formula.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Cauchy_Integral_Formula.thy Mon Sep 11 22:59:34 2023 +0200 @@ -316,15 +316,13 @@ ((\u. f u / (u - w)) has_contour_integral (\x. 2 * of_real pi * \ * f x) w) (circlepath z r)" by (rule Cauchy_integral_circlepath [OF contf holf]) (simp add: dist_norm norm_minus_commute) show ?thes1 - apply (simp add: power2_eq_square) - apply (rule Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1, simplified]) - apply (blast intro: int) - done + unfolding power2_eq_square + using int Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1] + by fastforce have "((\x. 2 * of_real pi * \ * f x) has_field_derivative contour_integral (circlepath z r) (\u. f u / (u - w)^2)) (at w)" - apply (simp add: power2_eq_square) - apply (rule Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1 and g = "\x. 2 * of_real pi * \ * f x", simplified]) - apply (blast intro: int) - done + unfolding power2_eq_square + using int Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1 and g = "\x. 2 * of_real pi * \ * f x"] + by fastforce then have fder: "(f has_field_derivative contour_integral (circlepath z r) (\u. f u / (u - w)^2) / (2 * of_real pi * \)) (at w)" by (rule DERIV_cdivide [where f = "\x. 2 * of_real pi * \ * f x" and c = "2 * of_real pi * \", simplified]) show ?thes2 @@ -396,8 +394,7 @@ lemma has_field_derivative_higher_deriv: "\f holomorphic_on S; open S; x \ S\ \ ((deriv ^^ n) f has_field_derivative (deriv ^^ (Suc n)) f x) (at x)" -by (metis (no_types, opaque_lifting) DERIV_deriv_iff_field_differentiable at_within_open comp_apply - funpow.simps(2) holomorphic_higher_deriv holomorphic_on_def) + using holomorphic_derivI holomorphic_higher_deriv by fastforce lemma higher_deriv_cmult: assumes "f holomorphic_on A" "x \ A" "open A" @@ -644,7 +641,7 @@ by (meson f fg holomorphic_higher_deriv holomorphic_on_subset image_subset_iff T) have holo3: "(\z. u ^ n * (deriv ^^ n) f (u * z)) holomorphic_on S" by (intro holo2 holomorphic_on_compose [where g="(deriv ^^ n) f", unfolded o_def] holomorphic_intros) - have "(*) u holomorphic_on S" "f holomorphic_on (*) u ` S" + have u: "(*) u holomorphic_on S" "f holomorphic_on (*) u ` S" by (rule holo0 holomorphic_intros)+ then have holo1: "(\w. f (u * w)) holomorphic_on S" by (rule holomorphic_on_compose [where g=f, unfolded o_def]) @@ -658,12 +655,7 @@ have "(deriv ^^ n) f analytic_on T" by (simp add: analytic_on_open f holomorphic_higher_deriv T) then have "(\w. (deriv ^^ n) f (u * w)) analytic_on S" - proof - - have "(deriv ^^ n) f \ (*) u holomorphic_on S" - by (simp add: holo2 holomorphic_on_compose) - then show ?thesis - by (simp add: S analytic_on_open o_def) - qed + by (meson S u analytic_on_open holo2 holomorphic_on_compose holomorphic_transform o_def) then show ?thesis by (intro deriv_cmult analytic_on_imp_differentiable_at [OF _ Suc.prems]) qed @@ -1298,15 +1290,15 @@ lemma series_and_derivative_comparison_complex: fixes S :: "complex set" assumes S: "open S" - and hfd: "\n x. x \ S \ (f n has_field_derivative f' n x) (at x)" - and to_g: "\x. x \ S \ \d h. 0 < d \ summable h \ range h \ \\<^sub>\\<^sub>0 \ (\\<^sub>F n in sequentially. \y\ball x d \ S. cmod(f n y) \ cmod (h n))" + and hfd: "\n x. x \ S \ (f n has_field_derivative f' n x) (at x)" + and to_g: "\x. x \ S \ \d h. 0 < d \ summable h \ range h \ \\<^sub>\\<^sub>0 \ (\\<^sub>F n in sequentially. \y\ball x d \ S. cmod(f n y) \ cmod (h n))" shows "\g g'. \x \ S. ((\n. f n x) sums g x) \ ((\n. f' n x) sums g' x) \ (g has_field_derivative g' x) (at x)" -apply (rule series_and_derivative_comparison_local [OF S hfd], assumption) -apply (rule ex_forward [OF to_g], assumption) -apply (erule exE) -apply (rule_tac x="Re \ h" in exI) -apply (force simp: summable_Re o_def nonneg_Reals_cmod_eq_Re image_subset_iff) -done + apply (rule series_and_derivative_comparison_local [OF S hfd], assumption) + apply (rule ex_forward [OF to_g], assumption) + apply (erule exE) + apply (rule_tac x="Re \ h" in exI) + apply (force simp: summable_Re o_def nonneg_Reals_cmod_eq_Re image_subset_iff) + done text\Sometimes convenient to compare with a complex series of positive reals. (?)\ lemma series_differentiable_comparison_complex: @@ -1410,9 +1402,8 @@ corollary holomorphic_iff_power_series: "f holomorphic_on ball z r \ (\w \ ball z r. (\n. (deriv ^^ n) f z / (fact n) * (w - z)^n) sums f w)" - apply (intro iffI ballI holomorphic_power_series, assumption+) - apply (force intro: power_series_holomorphic [where a = "\n. (deriv ^^ n) f z / (fact n)"]) - done + using power_series_holomorphic [where a = "\n. (deriv ^^ n) f z / (fact n)"] holomorphic_power_series + by blast lemma power_series_analytic: "(\w. w \ ball z r \ (\n. a n*(w - z)^n) sums f w) \ f analytic_on ball z r" @@ -1670,12 +1661,8 @@ obtain \ where "\>0" and \: "cball w \ \ U" using open_contains_cball \open U\ \w \ U\ by force let ?TZ = "cball w \ \ closed_segment a b" have "uniformly_continuous_on ?TZ (\(x,y). F x y)" - proof (rule compact_uniformly_continuous) - show "continuous_on ?TZ (\(x,y). F x y)" - by (rule continuous_on_subset[OF cond_uu]) (use SigmaE \ abu in blast) - show "compact ?TZ" - by (simp add: compact_Times) - qed + by (metis Sigma_mono \ abu compact_Times compact_cball compact_segment compact_uniformly_continuous + cond_uu continuous_on_subset) then obtain \ where "\>0" and \: "\x x'. \x\?TZ; x'\?TZ; dist x' x < \\ \ dist ((\(x,y). F x y) x') ((\(x,y). F x y) x) < \/norm(b - a)" @@ -1992,16 +1979,10 @@ by (auto intro: continuous_on_swap_args cond_uu) qed have cont_cint_d\: "continuous_on {0..1} ((\w. contour_integral (linepath a b) (\z. d z w)) \ \)" - proof (rule continuous_on_compose) - show "continuous_on {0..1} \" - using \path \\ path_def by blast - show "continuous_on (\ ` {0..1}) (\w. contour_integral (linepath a b) (\z. d z w))" - using pasz unfolding path_image_def - by (auto intro!: continuous_on_subset [OF cont_cint_d]) - qed + by (metis Diff_subset \path \\ cont_cint_d continuous_on_compose continuous_on_subset pasz path_def path_image_def) have "continuous_on {0..1} (\x. vector_derivative \ (at x))" using pf\' by (simp add: continuous_on_polymonial_function vector_derivative_at [OF \']) - then have cint_cint: "(\w. contour_integral (linepath a b) (\z. d z w)) contour_integrable_on \" + then have cint_cint: "(\w. contour_integral (linepath a b) (\z. d z w)) contour_integrable_on \" apply (simp add: contour_integrable_on) apply (rule integrable_continuous_real) by (rule continuous_on_mult [OF cont_cint_d\ [unfolded o_def]]) @@ -2632,8 +2613,8 @@ have g_nz: "g \ 0" proof - define z :: complex where "z = (if r = \ then 1 else of_real (real_of_ereal r / 2))" - from \r > 0\ have "z \ eball 0 r" - by (cases r) (auto simp: z_def eball_def) + have "z \ eball 0 r" + using \r > 0\ ereal_less_real_iff z_def by fastforce moreover have "z \ 0" using \r > 0\ by (cases r) (auto simp: z_def) ultimately have "eval_fps g z \ 0" by (rule assms(6)) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Cauchy_Integral_Theorem.thy --- a/src/HOL/Complex_Analysis/Cauchy_Integral_Theorem.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Cauchy_Integral_Theorem.thy Mon Sep 11 22:59:34 2023 +0200 @@ -842,7 +842,7 @@ by (simp add: has_field_derivative_def has_derivative_at2 bounded_linear_mult_right) qed -(** Existence of a primitive.*) +text \Existence of a primitive\ lemma holomorphic_starlike_primitive: fixes f :: "complex \ complex" assumes contf: "continuous_on S f" @@ -1017,8 +1017,7 @@ assumes gpd: "g piecewise_differentiable_on {a..b}" and dh: "\x. x \ S \ (f has_field_derivative f' x) (at x within S)" and gs: "\x. x \ {a..b} \ g x \ S" - shows - "(\x. f' (g x) * vector_derivative g (at x within {a..b})) integrable_on {a..b}" + shows "(\x. f' (g x) * vector_derivative g (at x within {a..b})) integrable_on {a..b}" proof (cases "cbox a b = {}") case False then show ?thesis diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Complex_Singularities.thy --- a/src/HOL/Complex_Analysis/Complex_Singularities.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Complex_Singularities.thy Mon Sep 11 22:59:34 2023 +0200 @@ -74,10 +74,14 @@ assumes "open A" "x \ A" "f holomorphic_on A" shows "\is_pole f x" proof - - have "continuous_on A f" by (intro holomorphic_on_imp_continuous_on) fact - with assms have "isCont f x" by (simp add: continuous_on_eq_continuous_at) - hence "f \x\ f x" by (simp add: isCont_def) - thus "\is_pole f x" unfolding is_pole_def + have "continuous_on A f" + by (intro holomorphic_on_imp_continuous_on) fact + with assms have "isCont f x" + by (simp add: continuous_on_eq_continuous_at) + hence "f \x\ f x" + by (simp add: isCont_def) + thus "\is_pole f x" + unfolding is_pole_def using not_tendsto_and_filterlim_at_infinity[of "at x" f "f x"] by auto qed @@ -87,17 +91,19 @@ (auto simp: filterlim_at eventually_at intro!: exI[of _ 1] tendsto_eq_intros) lemma is_pole_cmult_iff [simp]: - "c \ 0 \ is_pole (\z. c * f z :: 'a :: real_normed_field) z \ is_pole f z" + assumes "c \ 0" + shows "is_pole (\z. c * f z :: 'a :: real_normed_field) z \ is_pole f z" proof - assume *: "c \ 0" "is_pole (\z. c * f z) z" - have "is_pole (\z. inverse c * (c * f z)) z" unfolding is_pole_def - by (rule tendsto_mult_filterlim_at_infinity tendsto_const)+ (use * in \auto simp: is_pole_def\) + assume "is_pole (\z. c * f z) z" + with \c\0\ have "is_pole (\z. inverse c * (c * f z)) z" + unfolding is_pole_def + by (force intro: tendsto_mult_filterlim_at_infinity) thus "is_pole f z" - using *(1) by (simp add: field_simps) + using \c\0\ by (simp add: field_simps) next - assume *: "c \ 0" "is_pole f z" - show "is_pole (\z. c * f z) z" unfolding is_pole_def - by (rule tendsto_mult_filterlim_at_infinity tendsto_const)+ (use * in \auto simp: is_pole_def\) + assume "is_pole f z" + with \c\0\ show "is_pole (\z. c * f z) z" + by (auto intro!: tendsto_mult_filterlim_at_infinity simp: is_pole_def) qed lemma is_pole_uminus_iff [simp]: "is_pole (\z. -f z :: 'a :: real_normed_field) z \ is_pole f z" @@ -184,7 +190,13 @@ lemma is_pole_mult_analytic_nonzero2: assumes "is_pole f x" "g analytic_on {x}" "g x \ 0" shows "is_pole (\x. f x * g x) x" - by (subst mult.commute, rule is_pole_mult_analytic_nonzero1) (use assms in auto) +proof - + have g: "g analytic_on {x}" + using assms by auto + show ?thesis + using is_pole_mult_analytic_nonzero1 [OF \is_pole f x\ g] \g x \ 0\ + by (simp add: mult.commute) +qed lemma is_pole_mult_analytic_nonzero1_iff: assumes "f analytic_on {x}" "f x \ 0" @@ -433,7 +445,8 @@ \ f w = g2 w * (w - z) powi n2 \ g2 w\0" using \fac n1 g1 r1\ \fac n2 g2 r2\ unfolding fac_def r_def by fastforce - ultimately show "n1=n2" using g1_holo g2_holo \g1 z\0\ \g2 z\0\ + ultimately show "n1=n2" + using g1_holo g2_holo \g1 z\0\ \g2 z\0\ apply (elim holomorphic_factor_unique) by (auto simp add:r_def) qed @@ -561,24 +574,7 @@ assumes "isolated_singularity_at g z" assumes "\\<^sub>F w in (at z). g w = f w" shows "isolated_singularity_at f z" -proof - - obtain r1 where "r1>0" and r1:"g analytic_on ball z r1 - {z}" - using assms(1) unfolding isolated_singularity_at_def by auto - obtain r2 where "r2>0" and r2:" \x. x \ z \ dist x z < r2 \ g x = f x" - using assms(2) unfolding eventually_at by auto - define r3 where "r3=min r1 r2" - have "r3>0" unfolding r3_def using \r1>0\ \r2>0\ by auto - moreover have "f analytic_on ball z r3 - {z}" - proof - - have "g holomorphic_on ball z r3 - {z}" - using r1 unfolding r3_def by (subst (asm) analytic_on_open,auto) - then have "f holomorphic_on ball z r3 - {z}" - using r2 unfolding r3_def - by (auto simp add:dist_commute elim!:holomorphic_transform) - then show ?thesis by (subst analytic_on_open,auto) - qed - ultimately show ?thesis unfolding isolated_singularity_at_def by auto -qed + using assms isolated_singularity_at_cong by blast lemma not_essential_powr[singularity_intros]: assumes "LIM w (at z). f w :> (at x)" @@ -704,8 +700,7 @@ have ?thesis when "\ ((\\<^sub>Fw in (at z). f w\0) \ (\\<^sub>Fw in (at z). g w\0))" proof - have "\\<^sub>Fw in (at z). fg w=0" - using that[unfolded frequently_def, simplified] unfolding fg_def - by (auto elim: eventually_rev_mp) + using fg_def frequently_elim1 not_eventually that by fastforce from tendsto_cong[OF this] have "fg \z\0" by auto then show ?thesis unfolding not_essential_def fg_def by auto qed @@ -787,9 +782,8 @@ proof - have "\\<^sub>Fw in (at z). f w=0" using that[unfolded frequently_def, simplified] by (auto elim: eventually_rev_mp) - then have "\\<^sub>Fw in (at z). vf w=0" - unfolding vf_def by auto - from tendsto_cong[OF this] have "vf \z\0" unfolding vf_def by auto + then have "vf \z\0" + unfolding vf_def by (simp add: tendsto_eventually) then show ?thesis unfolding not_essential_def vf_def by auto qed moreover have ?thesis when "is_pole f z" @@ -802,22 +796,18 @@ proof - from that obtain fz where fz:"f\z\fz" by auto have ?thesis when "fz=0" + proof - have "(\w. inverse (vf w)) \z\0" using fz that unfolding vf_def by auto moreover have "\\<^sub>F w in at z. inverse (vf w) \ 0" using non_zero_neighbour[OF f_iso f_ness f_nconst] unfolding vf_def by auto - ultimately have "is_pole vf z" - using filterlim_inverse_at_iff[of vf "at z"] unfolding filterlim_at is_pole_def by auto - then show ?thesis unfolding not_essential_def vf_def by auto + ultimately show ?thesis unfolding not_essential_def vf_def + using filterlim_atI filterlim_inverse_at_iff is_pole_def by blast qed moreover have ?thesis when "fz\0" - proof - - have "vf \z\inverse fz" - using fz that unfolding vf_def by (auto intro:tendsto_eq_intros) - then show ?thesis unfolding not_essential_def vf_def by auto - qed + using fz not_essential_def tendsto_inverse that by blast ultimately show ?thesis by auto qed ultimately show ?thesis using f_ness unfolding not_essential_def by auto @@ -856,7 +846,7 @@ moreover have "f analytic_on ball z d3 - {z}" by (smt (verit, best) Diff_iff analytic_on_analytic_at d2 d3_def mem_ball) - then have "vf analytic_on ball z d3 - {z}" + then have "vf analytic_on ball z d3 - {z}" unfolding vf_def by (intro analytic_on_inverse; simp add: d1(2) d3_def dist_commute) ultimately show ?thesis unfolding isolated_singularity_at_def vf_def by auto @@ -878,8 +868,8 @@ assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z" shows isolated_singularity_at_times[singularity_intros]: - "isolated_singularity_at (\w. f w * g w) z" and - isolated_singularity_at_add[singularity_intros]: + "isolated_singularity_at (\w. f w * g w) z" + and isolated_singularity_at_add[singularity_intros]: "isolated_singularity_at (\w. f w + g w) z" proof - obtain d1 d2 where "d1>0" "d2>0" @@ -912,19 +902,18 @@ unfolding isolated_singularity_at_def by (simp add: gt_ex) lemma isolated_singularity_at_minus[singularity_intros]: - assumes f_iso:"isolated_singularity_at f z" - and g_iso:"isolated_singularity_at g z" - shows "isolated_singularity_at (\w. f w - g w) z" - using isolated_singularity_at_uminus[THEN isolated_singularity_at_add[OF f_iso,of "\w. - g w"] - ,OF g_iso] by simp + assumes "isolated_singularity_at f z" and "isolated_singularity_at g z" + shows "isolated_singularity_at (\w. f w - g w) z" + unfolding diff_conv_add_uminus + using assms isolated_singularity_at_add isolated_singularity_at_uminus by blast lemma isolated_singularity_at_divide[singularity_intros]: - assumes f_iso:"isolated_singularity_at f z" - and g_iso:"isolated_singularity_at g z" - and g_ness:"not_essential g z" + assumes "isolated_singularity_at f z" + and "isolated_singularity_at g z" + and "not_essential g z" shows "isolated_singularity_at (\w. f w / g w) z" - using isolated_singularity_at_inverse[THEN isolated_singularity_at_times[OF f_iso, - of "\w. inverse (g w)"],OF g_iso g_ness] by (simp add:field_simps) + unfolding divide_inverse + by (simp add: assms isolated_singularity_at_inverse isolated_singularity_at_times) lemma isolated_singularity_at_const[singularity_intros]: "isolated_singularity_at (\w. c) z" @@ -1013,14 +1002,7 @@ lemma not_essential_holomorphic: assumes "f holomorphic_on A" "x \ A" "open A" shows "not_essential f x" -proof - - have "continuous_on A f" - using assms holomorphic_on_imp_continuous_on by blast - hence "f \x\ f x" - using assms continuous_on_eq_continuous_at isContD by blast - thus ?thesis - by (auto simp: not_essential_def) -qed + by (metis assms at_within_open continuous_on holomorphic_on_imp_continuous_on not_essential_def) lemma not_essential_analytic: assumes "f analytic_on {z}" @@ -1045,11 +1027,7 @@ then have "eventually (\w. w \ ball z r - {z}) (at z)" by (intro eventually_at_in_open) auto thus "eventually (\w. \is_pole f w) (at z)" - proof eventually_elim - case (elim w) - with r show ?case - using analytic_imp_holomorphic not_is_pole_holomorphic open_delete by blast - qed + by (metis (no_types, lifting) analytic_at analytic_on_analytic_at eventually_mono not_is_pole_holomorphic r) qed lemma not_islimpt_poles: @@ -1077,13 +1055,7 @@ lemma isolated_singularity_at_analytic: assumes "f analytic_on {z}" shows "isolated_singularity_at f z" -proof - - from assms obtain r where r: "r > 0" "f holomorphic_on ball z r" - by (auto simp: analytic_on_def) - show ?thesis - by (rule isolated_singularity_at_holomorphic[of f "ball z r"]) - (use \r > 0\ in \auto intro!: holomorphic_on_subset[OF r(2)]\) -qed + by (meson Diff_subset analytic_at assms holomorphic_on_subset isolated_singularity_at_holomorphic) subsection \The order of non-essential singularities (i.e. removable singularities or poles)\ @@ -1100,7 +1072,7 @@ lemma zorder_exist: fixes f::"complex \ complex" and z::complex - defines "n\zorder f z" and "g\zor_poly f z" + defines "n \ zorder f z" and "g \ zor_poly f z" assumes f_iso:"isolated_singularity_at f z" and f_ness:"not_essential f z" and f_nconst:"\\<^sub>Fw in (at z). f w\0" @@ -1109,7 +1081,7 @@ proof - define P where "P = (\n g r. 0 < r \ g holomorphic_on cball z r \ g z\0 \ (\w\cball z r - {z}. f w = g w * (w-z) powi n \ g w\0))" - have "\!n. \g r. P n g r" + have "\!k. \g r. P k g r" using holomorphic_factor_puncture[OF assms(3-)] unfolding P_def by auto then have "\g r. P n g r" unfolding n_def P_def zorder_def @@ -1168,8 +1140,8 @@ and fr_nz: "inverse (fp w) \ 0" when "w\ball z fr - {z}" for w proof - - have "f w = fp w * (w - z) powi fn" "fp w\0" - using fr(2)[rule_format,of w] that by auto + have "f w = fp w * (w - z) powi fn" "fp w \ 0" + using fr(2) that by auto then show "vf w = (inverse (fp w)) * (w - z) powi (-fn)" "inverse (fp w)\0" by (simp_all add: power_int_minus vf_def) qed @@ -1256,13 +1228,7 @@ define n where "n \ zorder f z" have "f w = zor_poly f z w * (w - z) powi n" - proof - - have "w\cball z r1 - {z}" - using r_def that by auto - from rball1[rule_format, OF this] - show ?thesis unfolding n_def by auto - qed - + using n_def r_def rball1 that by auto moreover have "f w = zor_poly ff 0 (w - z) * (w - z) powi n" proof - have "w-z\cball 0 r2 - {0}" @@ -1286,23 +1252,16 @@ then have "\\<^sub>F w in at z. zor_poly f z w = zor_poly ff 0 (w - z)" unfolding eventually_at - apply (rule_tac x=r in exI) - using \r>0\ by (auto simp:dist_commute) + by (metis DiffI \0 < r\ dist_commute mem_ball singletonD) moreover have "isCont (zor_poly f z) z" using holo1[THEN holomorphic_on_imp_continuous_on] - apply (elim continuous_on_interior) - using \r1>0\ by auto - moreover have "isCont (\w. zor_poly ff 0 (w - z)) z" - proof - - have "isCont (zor_poly ff 0) 0" - using holo2[THEN holomorphic_on_imp_continuous_on] - apply (elim continuous_on_interior) - using \r2>0\ by auto - then show ?thesis + by (simp add: \0 < r1\ continuous_on_interior) + moreover + have "isCont (zor_poly ff 0) 0" + using \0 < r2\ centre_in_ball continuous_on_interior holo2 holomorphic_on_imp_continuous_on interior_cball by blast + then have "isCont (\w. zor_poly ff 0 (w - z)) z" unfolding isCont_iff by simp - qed - ultimately show "\\<^sub>F w in nhds z. zor_poly f z w - = zor_poly ff 0 (w - z)" + ultimately show "\\<^sub>F w in nhds z. zor_poly f z w = zor_poly ff 0 (w - z)" by (elim at_within_isCont_imp_nhds;auto) qed @@ -1335,27 +1294,26 @@ have fg_times:"fg w = (fp w * gp w) * (w - z) powi (fn+gn)" and fgp_nz:"fp w*gp w\0" when "w\ball z r1 - {z}" for w proof - - have "f w = fp w * (w - z) powi fn" "fp w\0" + have "f w = fp w * (w - z) powi fn" "fp w \ 0" using fr(2)[rule_format,of w] that unfolding r1_def by auto moreover have "g w = gp w * (w - z) powi gn" "gp w \ 0" - using gr(2)[rule_format, of w] that unfolding r1_def by auto + using gr(2) that unfolding r1_def by auto ultimately show "fg w = (fp w * gp w) * (w - z) powi (fn+gn)" "fp w*gp w\0" - using that - unfolding fg_def by (auto simp add:power_int_add) + using that unfolding fg_def by (auto simp add:power_int_add) qed obtain fgr where [simp]:"fgp z \ 0" and "fgr > 0" and fgr: "fgp holomorphic_on cball z fgr" "\w\cball z fgr - {z}. fg w = fgp w * (w - z) powi fgn \ fgp w \ 0" proof - - have "fgp z \ 0 \ (\r>0. fgp holomorphic_on cball z r - \ (\w\cball z r - {z}. fg w = fgp w * (w - z) powi fgn \ fgp w \ 0))" - apply (rule zorder_exist[of fg z, folded fgn_def fgp_def]) - subgoal unfolding fg_def using isolated_singularity_at_times[OF f_iso g_iso] . - subgoal unfolding fg_def using not_essential_times[OF f_ness g_ness f_iso g_iso] . - subgoal unfolding fg_def using fg_nconst . - done - then show ?thesis using that by blast + have "isolated_singularity_at fg z" + unfolding fg_def using isolated_singularity_at_times[OF f_iso g_iso] . + moreover have "not_essential fg z" + by (simp add: f_iso f_ness fg_def g_iso g_ness not_essential_times) + moreover have "\\<^sub>F w in at z. fg w \ 0" + using fg_def fg_nconst by blast + ultimately show ?thesis + using that zorder_exist[of fg z] fgn_def fgp_def by fastforce qed define r2 where "r2 = min fgr r1" have "r2>0" using \r1>0\ \fgr>0\ unfolding r2_def by simp @@ -1368,9 +1326,9 @@ proof (rule ballI) fix w assume "w \ ball z r2 - {z}" then have "w \ ball z r1 - {z}" "w \ cball z fgr - {z}" unfolding r2_def by auto - from fg_times[OF this(1)] fgp_nz[OF this(1)] fgr(2)[rule_format,OF this(2)] - show "fg w = fgp w * (w - z) powi fgn \ fgp w \ 0 - \ fg w = fp w * gp w * (w - z) powi (fn + gn) \ fp w * gp w \ 0" by auto + then show "fg w = fgp w * (w - z) powi fgn \ fgp w \ 0 + \ fg w = fp w * gp w * (w - z) powi (fn + gn) \ fp w * gp w \ 0" + using fg_times fgp_nz fgr(2) by blast qed subgoal using fgr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros) subgoal using fr(1) gr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros) @@ -1398,22 +1356,20 @@ have f_nconst:"\\<^sub>Fw in (at z). f w \ 0" and g_nconst:"\\<^sub>Fw in (at z).g w\ 0" using fg_nconst by (auto elim!:frequently_elim1) define vg where "vg=(\w. inverse (g w))" - have "zorder (\w. f w * vg w) z = zorder f z + zorder vg z" - apply (rule zorder_times[OF f_iso _ f_ness,of vg]) - subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] . - subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] . - subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1) - done + have 1: "isolated_singularity_at vg z" + by (simp add: g_iso g_ness isolated_singularity_at_inverse vg_def) + moreover have 2: "not_essential vg z" + by (simp add: g_iso g_ness not_essential_inverse vg_def) + moreover have 3: "\\<^sub>F w in at z. f w * vg w \ 0" + using fg_nconst vg_def by auto + ultimately have "zorder (\w. f w * vg w) z = zorder f z + zorder vg z" + using zorder_times[OF f_iso _ f_ness] by blast then show "zorder (\w. f w / g w) z = zorder f z - zorder g z" using zorder_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def by (auto simp add:field_simps) have "\\<^sub>F w in at z. zor_poly (\w. f w * vg w) z w = zor_poly f z w * zor_poly vg z w" - apply (rule zor_poly_times[OF f_iso _ f_ness,of vg]) - subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] . - subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] . - subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1) - done + using zor_poly_times[OF f_iso _ f_ness,of vg] 1 2 3 by blast then show "\\<^sub>Fw in (at z). zor_poly (\w. f w / g w) z w = zor_poly f z w / zor_poly g z w" using zor_poly_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def by eventually_elim (auto simp add:field_simps) @@ -1447,15 +1403,14 @@ by (rule non_zero_neighbour_alt[OF holo \open s\ \connected s\ \z\s\]) qed then show "\\<^sub>F w in at z. f w \ 0" - apply (elim eventually_frequentlyE) - by auto + by (auto elim: eventually_frequentlyE) qed then obtain r1 where "g z \ 0" "r1>0" and r1:"g holomorphic_on cball z r1" "(\w\cball z r1 - {z}. f w = g w * (w - z) powi n \ g w \ 0)" by auto obtain r2 where r2: "r2>0" "cball z r2 \ s" using assms(4,6) open_contains_cball_eq by blast - define r3 where "r3=min r1 r2" + define r3 where "r3 \ min r1 r2" have "r3>0" "cball z r3 \ s" using \r1>0\ r2 unfolding r3_def by auto moreover have "g holomorphic_on cball z r3" using r1(1) unfolding r3_def by auto @@ -1517,7 +1472,7 @@ have "(\x. inverse ((x - z) ^ nat (- n)) * (x - z) ^ nat (- n)) \z\ 0" using tendsto_mult by fastforce then have "(\x. 1::complex) \z\ 0" - by (elim Lim_transform_within_open[where s=UNIV],auto) + using Lim_transform_within_open by fastforce then show False using LIM_const_eq by fastforce qed ultimately show ?thesis by fastforce @@ -1555,13 +1510,11 @@ lemma zorder_exist_pole: fixes f::"complex \ complex" and z::complex defines "n\zorder f z" and "g\zor_poly f z" - assumes holo: "f holomorphic_on s-{z}" and - "open s" "z\s" - and "is_pole f z" - shows "n < 0 \ g z\0 \ (\r. r>0 \ cball z r \ s \ g holomorphic_on cball z r + assumes holo: "f holomorphic_on S-{z}" and "open S" "z\S" and "is_pole f z" + shows "n < 0 \ g z\0 \ (\r. r>0 \ cball z r \ S \ g holomorphic_on cball z r \ (\w\cball z r - {z}. f w = g w / (w-z) ^ nat (- n) \ g w \0))" proof - - obtain r where "g z \ 0" and r: "r>0" "cball z r \ s" "g holomorphic_on cball z r" + obtain r where "g z \ 0" and r: "r>0" "cball z r \ S" "g holomorphic_on cball z r" "(\w\cball z r - {z}. f w = g w * (w - z) powi n \ g w \ 0)" proof - have "g z \ 0 \ (\r>0. g holomorphic_on cball z r @@ -1574,16 +1527,15 @@ using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on by fastforce from non_zero_neighbour_pole[OF \is_pole f z\] show "\\<^sub>F w in at z. f w \ 0" - apply (elim eventually_frequentlyE) - by auto + by (auto elim: eventually_frequentlyE) qed then obtain r1 where "g z \ 0" "r1>0" and r1:"g holomorphic_on cball z r1" "(\w\cball z r1 - {z}. f w = g w * (w - z) powi n \ g w \ 0)" by auto - obtain r2 where r2: "r2>0" "cball z r2 \ s" + obtain r2 where r2: "r2>0" "cball z r2 \ S" using assms(4,5) open_contains_cball_eq by metis define r3 where "r3=min r1 r2" - have "r3>0" "cball z r3 \ s" using \r1>0\ r2 unfolding r3_def by auto + have "r3>0" "cball z r3 \ S" using \r1>0\ r2 unfolding r3_def by auto moreover have "g holomorphic_on cball z r3" using r1(1) unfolding r3_def by auto moreover have "(\w\cball z r3 - {z}. f w = g w * (w - z) powi n \ g w \ 0)" @@ -1624,16 +1576,16 @@ qed lemma zorder_eqI: - assumes "open s" "z \ s" "g holomorphic_on s" "g z \ 0" - assumes fg_eq:"\w. \w \ s;w\z\ \ f w = g w * (w - z) powi n" + assumes "open S" "z \ S" "g holomorphic_on S" "g z \ 0" + assumes fg_eq:"\w. \w \ S;w\z\ \ f w = g w * (w - z) powi n" shows "zorder f z = n" proof - - have "continuous_on s g" by (rule holomorphic_on_imp_continuous_on) fact + have "continuous_on S g" by (rule holomorphic_on_imp_continuous_on) fact moreover have "open (-{0::complex})" by auto - ultimately have "open ((g -` (-{0})) \ s)" - unfolding continuous_on_open_vimage[OF \open s\] by blast - moreover from assms have "z \ (g -` (-{0})) \ s" by auto - ultimately obtain r where r: "r > 0" "cball z r \ s \ (g -` (-{0}))" + ultimately have "open ((g -` (-{0})) \ S)" + unfolding continuous_on_open_vimage[OF \open S\] by blast + moreover from assms have "z \ (g -` (-{0})) \ S" by auto + ultimately obtain r where r: "r > 0" "cball z r \ S \ (g -` (-{0}))" unfolding open_contains_cball by blast let ?gg= "(\w. g w * (w - z) powi n)" @@ -1644,18 +1596,18 @@ then have "\g r. P n g r" by auto moreover have unique: "\!n. \g r. P n g r" unfolding P_def proof (rule holomorphic_factor_puncture) - have "ball z r-{z} \ s" using r using ball_subset_cball by blast + have "ball z r-{z} \ S" using r using ball_subset_cball by blast then have "?gg holomorphic_on ball z r-{z}" - using \g holomorphic_on s\ r by (auto intro!: holomorphic_intros) + using \g holomorphic_on S\ r by (auto intro!: holomorphic_intros) then have "f holomorphic_on ball z r - {z}" - by (smt (verit, best) DiffD2 \ball z r-{z} \ s\ fg_eq holomorphic_cong singleton_iff subset_iff) + by (smt (verit, best) DiffD2 \ball z r-{z} \ S\ fg_eq holomorphic_cong singleton_iff subset_iff) then show "isolated_singularity_at f z" unfolding isolated_singularity_at_def using analytic_on_open open_delete r(1) by blast next have "not_essential ?gg z" proof (intro singularity_intros) show "not_essential g z" - by (meson \continuous_on s g\ assms continuous_on_eq_continuous_at + by (meson \continuous_on S g\ assms continuous_on_eq_continuous_at isCont_def not_essential_def) show " \\<^sub>F w in at z. w - z \ 0" by (simp add: eventually_at_filter) then show "LIM w at z. w - z :> at 0" @@ -1679,7 +1631,7 @@ proof (subst fg_eq[OF _ \z'\z\]) have "z' \ cball z r" unfolding z'_def using \r>0\ \d>0\ by (auto simp add:dist_norm) - then show " z' \ s" using r(2) by blast + then show " z' \ S" using r(2) by blast show "g z' * (z' - z) powi n \ 0" using P_def \P n g r\ \z' \ cball z r\ \z' \ z\ by auto qed @@ -1692,8 +1644,8 @@ qed lemma simple_zeroI: - assumes "open s" "z \ s" "g holomorphic_on s" "g z \ 0" - assumes "\w. w \ s \ f w = g w * (w - z)" + assumes "open S" "z \ S" "g holomorphic_on S" "g z \ 0" + assumes "\w. w \ S \ f w = g w * (w - z)" shows "zorder f z = 1" using assms zorder_eqI by force @@ -1726,13 +1678,13 @@ qed lemma zorder_zero_eqI: - assumes f_holo:"f holomorphic_on s" and "open s" "z \ s" + assumes f_holo:"f holomorphic_on S" and "open S" "z \ S" assumes zero: "\i. i < nat n \ (deriv ^^ i) f z = 0" assumes nz: "(deriv ^^ nat n) f z \ 0" and "n\0" shows "zorder f z = n" proof - - obtain r where [simp]:"r>0" and "ball z r \ s" - using \open s\ \z\s\ openE by blast + obtain r where [simp]:"r>0" and "ball z r \ S" + using \open S\ \z\S\ openE by blast have nz':"\w\ball z r. f w \ 0" proof (rule ccontr) assume "\ (\w\ball z r. f w \ 0)" @@ -1746,17 +1698,17 @@ qed define zn g where "zn = zorder f z" and "g = zor_poly f z" - obtain e where e_if:"if f z = 0 then 0 < zn else zn = 0" and - [simp]:"e>0" and "cball z e \ ball z r" and - g_holo:"g holomorphic_on cball z e" and - e_fac:"(\w\cball z e. f w = g w * (w - z) ^ nat zn \ g w \ 0)" + obtain e where e_if: "if f z = 0 then 0 < zn else zn = 0" and + [simp]: "e>0" and "cball z e \ ball z r" and + g_holo: "g holomorphic_on cball z e" and + e_fac: "(\w\cball z e. f w = g w * (w - z) ^ nat zn \ g w \ 0)" proof - have "f holomorphic_on ball z r" - using f_holo \ball z r \ s\ by auto + using f_holo \ball z r \ S\ by auto from that zorder_exist_zero[of f "ball z r" z,simplified,OF this nz',folded zn_def g_def] - show ?thesis by blast + show thesis by blast qed - then obtain "zn \ 0" "g z\0" + then obtain "zn \ 0" "g z \ 0" by (metis centre_in_cball less_le_not_le order_refl) define A where "A \ (\i. of_nat (i choose (nat zn)) * fact (nat zn) * (deriv ^^ (i - nat zn)) g z)" @@ -1850,10 +1802,7 @@ assumes "isolated_singularity_at f z" "not_essential f z" assumes "g analytic_on {z}" "frequently (\z. f z * g z \ 0) (at z)" shows "zorder (\x. f x * g x) z = zorder f z + zorder g z" -proof (rule zorder_times) - show "isolated_singularity_at g z" "not_essential g z" - by (intro isolated_singularity_at_analytic not_essential_analytic assms)+ -qed (use assms in auto) + using assms isolated_singularity_at_analytic not_essential_analytic zorder_times by blast lemma zorder_cmult: assumes "c \ 0" @@ -1874,7 +1823,7 @@ qed lemma zorder_nonzero_div_power: - assumes sz: "open s" "z \ s" "f holomorphic_on s" "f z \ 0" and "n > 0" + assumes sz: "open S" "z \ S" "f holomorphic_on S" "f z \ 0" and "n > 0" shows "zorder (\w. f w / (w - z) ^ n) z = - n" by (intro zorder_eqI [OF sz]) (simp add: inverse_eq_divide power_int_minus) @@ -1893,7 +1842,7 @@ qed lemma zor_poly_zero_eq: - assumes "f holomorphic_on s" "open s" "connected s" "z \ s" "\w\s. f w \ 0" + assumes "f holomorphic_on S" "open S" "connected S" "z \ S" "\w\S. f w \ 0" shows "eventually (\w. zor_poly f z w = f w / (w - z) ^ nat (zorder f z)) (at z)" proof - obtain r where r:"r>0" @@ -2104,7 +2053,7 @@ have *: "x \ ball x r" "open (ball x r)" "open (ball x r - {x})" using \r > 0\ by auto show "is_pole (deriv f) x" "zorder (deriv f) x = zorder f x - 1" - by (rule is_pole_deriv' zorder_deriv', (rule assms * holomorphic_derivI holo | assumption)+)+ + by (meson "*" assms(1) holo holomorphic_derivI is_pole_deriv' zorder_deriv')+ qed lemma removable_singularity_deriv': @@ -2271,11 +2220,7 @@ have "eventually (\w. w \ ball z r - {z}) (at z)" using r by (intro eventually_at_in_open) auto thus "eventually (\w. f w = 0) (at z)" - proof eventually_elim - case (elim w) - thus ?case using g_eq_0[of w] - by (auto simp: g_def) - qed + by (metis freq non_zero_neighbour not_eventually not_frequently sing) qed lemma pole_imp_not_constant: @@ -2337,8 +2282,7 @@ qed moreover have "\\<^sub>F w in at z. f w = P w * (w - z) powi n" unfolding eventually_at_le - apply (rule exI[where x=r]) - using w_Pn \r>0\ by (simp add: dist_commute) + using w_Pn \r>0\ by (force simp add: dist_commute) ultimately show ?thesis using is_pole_cong by fast qed @@ -2387,34 +2331,20 @@ using is_pole_deriv[OF \is_pole f z\ f_iso,THEN non_zero_neighbour_pole] . ultimately have "\\<^sub>F w in at z. False" - apply eventually_elim - by auto + by eventually_elim auto then show False by auto qed lemma isolated_pole_imp_neg_zorder: - assumes f_iso:"isolated_singularity_at f z" - and "is_pole f z" - shows "zorder f z<0" -proof - - obtain e where [simp]:"e>0" and f_holo:"f holomorphic_on ball z e - {z}" - using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by blast - show ?thesis - using zorder_exist_pole[OF f_holo,simplified,OF \is_pole f z\] - by auto -qed + assumes "isolated_singularity_at f z" and "is_pole f z" + shows "zorder f z < 0" + using analytic_imp_holomorphic assms centre_in_ball isolated_singularity_at_def zorder_exist_pole by blast + lemma isolated_singularity_at_deriv[singularity_intros]: assumes "isolated_singularity_at f x" shows "isolated_singularity_at (deriv f) x" -proof - - obtain r where "r>0" "f analytic_on ball x r - {x}" - using assms unfolding isolated_singularity_at_def by auto - from analytic_deriv[OF this(2)] - have "deriv f analytic_on ball x r - {x}" . - with \r>0\ show ?thesis - unfolding isolated_singularity_at_def by auto -qed + by (meson analytic_deriv assms isolated_singularity_at_def) lemma zorder_deriv_minus_1: fixes f g::"complex \ complex" and z::complex @@ -2501,13 +2431,9 @@ have "zorder ff z = zorder (deriv f) z - zorder f z" unfolding ff_def using f_iso f_ness fg_nconst - apply (rule_tac zorder_divide) - by (auto intro:singularity_intros) + using isolated_singularity_at_deriv not_essential_deriv zorder_divide by blast moreover have "zorder (deriv f) z = zorder f z - 1" - proof (rule zorder_deriv_minus_1) - show " \\<^sub>F w in at z. f w \ 0" - using fg_nconst frequently_elim1 by fastforce - qed (use f_iso f_ness f_ord in auto) + using f_iso f_ness f_ord fg_nconst frequently_elim1 zorder_deriv_minus_1 by fastforce ultimately show "zorder ff z < 0" by auto show "\\<^sub>F w in at z. ff w \ 0" @@ -2523,8 +2449,7 @@ show "not_essential f z" using \is_pole f z\ unfolding not_essential_def by auto show "\\<^sub>F w in at z. deriv f w * f w \ 0" - apply (rule isolated_pole_imp_nzero_times) - using assms by auto + using assms f_iso isolated_pole_imp_nzero_times by blast show "zorder f z \ 0" using isolated_pole_imp_neg_zorder assms by fastforce qed @@ -2541,7 +2466,7 @@ assumes "isolated_zero f x" "isolated_zero g x" shows "isolated_zero (\x. f x * g x) x" proof - - have "eventually (\x. f x \ 0) (at x)" "eventually (\x. g x \ 0) (at x)" + have "\\<^sub>F x in at x. f x \ 0" "\\<^sub>F x in at x. g x \ 0" using assms unfolding isolated_zero_def by auto hence "eventually (\x. f x * g x \ 0) (at x)" by eventually_elim auto @@ -2576,10 +2501,7 @@ lemma non_isolated_zero': assumes "isolated_singularity_at f z" "not_essential f z" "f z = 0" "\isolated_zero f z" shows "eventually (\z. f z = 0) (at z)" -proof (rule not_essential_frequently_0_imp_eventually_0) - from assms show "frequently (\z. f z = 0) (at z)" - by (auto simp: frequently_def isolated_zero_def) -qed fact+ + by (metis assms isolated_zero_def non_zero_neighbour not_eventually) lemma non_isolated_zero: assumes "\isolated_zero f z" "f analytic_on {z}" "f z = 0" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Conformal_Mappings.thy --- a/src/HOL/Complex_Analysis/Conformal_Mappings.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Conformal_Mappings.thy Mon Sep 11 22:59:34 2023 +0200 @@ -30,8 +30,7 @@ by (metis \m \ 0\ dist_norm mem_ball norm_minus_commute not_gr_zero) have "0 < min r s" by (simp add: \0 < r\ \0 < s\) then show thesis - apply (rule that) - using r s by auto + proof qed (use r s in auto) qed proposition analytic_continuation: @@ -166,7 +165,7 @@ then have "0 < norm (f \)" by (simp add: \0 < r\) have fnz': "\w. w \ cball \ r \ f w \ 0" - by (metis norm_less dist_norm fnz less_eq_real_def mem_ball mem_cball norm_not_less_zero norm_zero) + using dist_complex_def fnz norm_less order_le_less by fastforce have "frontier(cball \ r) \ {}" using \0 < r\ by simp define g where [abs_def]: "g z = inverse (f z)" for z @@ -204,7 +203,7 @@ by (metis (no_types) dist_norm frontier_cball mem_sphere w) ultimately obtain wr: "norm (\ - w) = r" and nfw: "norm (f w) \ norm (f \)" unfolding g_def - by (metis (no_types) \0 < cmod (f \)\ less_imp_inverse_less norm_inverse not_le now order_trans v) + by (smt (verit, del_insts) \0 < cmod (f \)\ inverse_le_imp_le norm_inverse now v) with fw have False using norm_less by force } @@ -339,13 +338,10 @@ qed corollary\<^marker>\tag unimportant\ open_mapping_thm3: - assumes holf: "f holomorphic_on S" - and "open S" and injf: "inj_on f S" + assumes "f holomorphic_on S" + and "open S" and "inj_on f S" shows "open (f ` S)" -proof (rule open_mapping_thm2 [OF holf]) - show "\X. \open X; X \ S; X \ {}\ \ \ f constant_on X" - using inj_on_subset injective_not_constant injf by blast -qed (use assms in auto) + by (meson assms inj_on_subset injective_not_constant open_mapping_thm2 order.refl) subsection\Maximum modulus principle\ @@ -423,7 +419,7 @@ then obtain w where w: "w \ frontier(connected_component_set (interior S) z)" by auto then have "norm (f z) = norm (f w)" by (simp add: "2" c cc frontier_def) - also have "... \ B" + also have "\ \ B" using w frontier_interior_subset frontier_of_connected_component_subset by (blast intro: leB) finally show ?thesis . @@ -434,14 +430,14 @@ corollary\<^marker>\tag unimportant\ maximum_real_frontier: assumes holf: "f holomorphic_on (interior S)" - and contf: "continuous_on (closure S) f" - and bos: "bounded S" - and leB: "\z. z \ frontier S \ Re(f z) \ B" - and "\ \ S" - shows "Re(f \) \ B" -using maximum_modulus_frontier [of "exp o f" S "exp B"] - Transcendental.continuous_on_exp holomorphic_on_compose holomorphic_on_exp assms -by auto + and contf: "continuous_on (closure S) f" + and bos: "bounded S" + and leB: "\z. z \ frontier S \ Re(f z) \ B" + and "\ \ S" + shows "Re(f \) \ B" + using maximum_modulus_frontier [of "exp o f" S "exp B"] + Transcendental.continuous_on_exp holomorphic_on_compose holomorphic_on_exp assms + by auto subsection\<^marker>\tag unimportant\ \Factoring out a zero according to its order\ @@ -541,9 +537,10 @@ by (metis open_ball holomorphic_on_imp_continuous_on holomorphic_on_open) then have con: "continuous_on (ball \ r) (\x. exp (h x) / g x)" by (auto intro!: continuous_intros simp add: holg holomorphic_on_imp_continuous_on gne) + have gfd: "dist \ x < r \ g field_differentiable at x" if "dist \ x < r" for x + using holg holomorphic_on_imp_differentiable_at by auto have 0: "dist \ x < r \ ((\x. exp (h x) / g x) has_field_derivative 0) (at x)" for x - apply (rule h derivative_eq_intros DERIV_deriv_iff_field_differentiable [THEN iffD2] | simp)+ - using holg by (auto simp: holomorphic_on_imp_differentiable_at gne h) + by (rule gfd h derivative_eq_intros DERIV_deriv_iff_field_differentiable [THEN iffD2] | simp add: gne)+ obtain c where c: "\x. x \ ball \ r \ exp (h x) / g x = c" by (rule DERIV_zero_connected_constant [of "ball \ r" "{}" "\x. exp(h x) / g x"]) (auto simp: con 0) have hol: "(\z. exp ((Ln (inverse c) + h z) / of_nat n)) holomorphic_on ball \ r" @@ -564,8 +561,8 @@ fixes k :: "'a::wellorder" assumes a_def: "a == LEAST x. P x" and P: "P k" shows def_LeastI: "P a" and def_Least_le: "a \ k" -unfolding a_def -by (rule LeastI Least_le; rule P)+ + unfolding a_def + by (rule LeastI Least_le; rule P)+ lemma holomorphic_factor_zero_nonconstant: assumes holf: "f holomorphic_on S" and S: "open S" "connected S" @@ -646,8 +643,8 @@ then have leg: "\w. w \ cball \ d \ norm x \ norm (g w)" by auto have "ball \ d \ cball \ d" by auto - also have "... \ ball \ e" using \0 < d\ d_def by auto - also have "... \ S" by (rule e) + also have "\ \ ball \ e" using \0 < d\ d_def by auto + also have "\ \ S" by (rule e) finally have dS: "ball \ d \ S" . have "x \ 0" using gnz x \d < r\ by auto show thesis @@ -687,20 +684,20 @@ using continuous_on_interior continuous_within holg holomorphic_on_imp_continuous_on by blast then have "(g \ g \) (at \)" by (simp add: \) + then have "\\<^sub>F z in at \. cmod (f z) \ cmod (g \) + 1" + by (rule eventually_mp [OF * tendstoD [where e=1]], auto) then show ?thesis - apply (rule_tac x="norm(g \) + 1" in exI) - apply (rule eventually_mp [OF * tendstoD [where e=1]], auto) - done + by blast qed moreover have "?Q" if "\\<^sub>F z in at \. cmod (f z) \ B" for B by (rule lim_null_mult_right_bounded [OF _ that]) (simp add: LIM_zero) moreover have "?P" if "(\z. (z - \) * f z) \\\ 0" proof - define h where [abs_def]: "h z = (z - \)^2 * f z" for z - have h0: "(h has_field_derivative 0) (at \)" - apply (simp add: h_def has_field_derivative_iff) - apply (auto simp: field_split_simps power2_eq_square Lim_transform_within [OF that, of 1]) - done + have "(\y. (y - \)\<^sup>2 * f y / (y - \)) \\\ 0" + by (simp add: LIM_cong power2_eq_square that) + then have h0: "(h has_field_derivative 0) (at \)" + by (simp add: h_def has_field_derivative_iff) have holh: "h holomorphic_on S" proof (simp add: holomorphic_on_def, clarify) fix z assume "z \ S" @@ -755,22 +752,20 @@ by (rule holomorphic_on_compose holomorphic_intros holomorphic_on_subset [OF holf] | force simp: r)+ have 2: "0 \ interior (ball 0 r)" using \0 < r\ by simp - have "\B. 0 eventually (\z. cmod ((inverse \ f \ inverse) z) \ B) (at 0)" - apply (rule exI [where x=1]) - using tendstoD [OF lim [unfolded lim_at_infinity_0] zero_less_one] - by (simp add: eventually_mono) - with holomorphic_on_extend_bounded [OF 1 2] obtain g where holg: "g holomorphic_on ball 0 r" and geq: "\z. z \ ball 0 r - {0} \ g z = (inverse \ f \ inverse) z" - by meson + using tendstoD [OF lim [unfolded lim_at_infinity_0] zero_less_one] holomorphic_on_extend_bounded [OF 1 2] + by (smt (verit, del_insts) \l = 0\ eventually_mono norm_conv_dist) have ifi0: "(inverse \ f \ inverse) \0\ 0" using \l = 0\ lim lim_at_infinity_0 by blast have g2g0: "g \0\ g 0" using \0 < r\ centre_in_ball continuous_at continuous_on_eq_continuous_at holg by (blast intro: holomorphic_on_imp_continuous_on) have g2g1: "g \0\ 0" - apply (rule Lim_transform_within_open [OF ifi0 open_ball [of 0 r]]) - using \0 < r\ by (auto simp: geq) + proof (rule Lim_transform_within_open [OF ifi0 open_ball]) + show "\x. \x \ ball 0 r; x \ 0\ \ (inverse \ f \ inverse) x = g x" + by (auto simp: geq) + qed (auto simp: \0 < r\) have [simp]: "g 0 = 0" by (rule tendsto_unique [OF _ g2g0 g2g1]) simp have "ball 0 r - {0::complex} \ {}" @@ -831,7 +826,7 @@ using **[of w] fi0 \0 < r\ that by force then show ?thesis unfolding lim_at_infinity_0 - using eventually_at \r > 0\ by (force simp add: intro: tendsto_eventually) + using eventually_at \r > 0\ by (force simp: intro: tendsto_eventually) qed obtain w where "w \ ball 0 r - {0}" and "f (inverse w) = 0" using False \0 < r\ by blast @@ -916,7 +911,7 @@ with k m show ?thesis by (rule_tac x=m in exI) (auto simp: that comm_monoid_add_class.sum.mono_neutral_right) qed - have \
: "((inverse \ f) \ 0) at_infinity" + have *: "((inverse \ f) \ 0) at_infinity" proof (rule Lim_at_infinityI) fix e::real assume "0 < e" with compf [of "cball 0 (inverse e)"] @@ -927,7 +922,7 @@ qed then obtain a n where "\z. f z = (\i\n. a i * z^i)" using assms pole_at_infinity by blast - with \
2 show ?rhs by blast + with * 2 show ?rhs by blast next assume ?rhs then obtain c n where "0 < n" "c n \ 0" "f = (\z. \i\n. c i * z ^ i)" by blast @@ -967,11 +962,12 @@ using dnz by simp then obtain g' where g': "linear g'" "g' \ (*) (deriv f \) = id" using linear_injective_left_inverse [of "(*) (deriv f \)"] by auto + + have fder: "\x. x \ S \ (f has_derivative (*) (deriv f x)) (at x)" + using \open S\ has_field_derivative_imp_has_derivative holf holomorphic_derivI by blast show ?thesis apply (rule has_derivative_locally_injective [OF S, where f=f and f' = "\z h. deriv f z * h" and g' = g']) - using g' * - apply (simp_all add: linear_conv_bounded_linear that) - using \open S\ has_field_derivative_imp_has_derivative holf holomorphic_derivI by blast + using g' * by (simp_all add: fder linear_conv_bounded_linear that) qed lemma has_complex_derivative_locally_invertible: @@ -1175,7 +1171,7 @@ using continuous_openin_preimage [OF contg gim] by (meson \open V\ contg continuous_openin_preimage_eq) ultimately obtain \ where "\>0" and e: "ball z \ \ U \ g -` V" - by (force simp add: openin_contains_ball) + by (force simp: openin_contains_ball) show "g field_differentiable at z within U" proof (rule field_differentiable_transform_within) show "(0::real) < \" @@ -1398,7 +1394,7 @@ show "convex (S \ {x. d \ x \ k})" by (rule convex_Int [OF \convex S\ convex_halfspace_le]) qed - also have "... \ {z \ S. d \ z < k}" + also have "\ \ {z \ S. d \ z < k}" by (force simp: interior_open [OF \open S\] \d \ 0\) finally have *: "interior (convex hull {a, b, c}) \ {z \ S. d \ z < k}" . have "continuous_on (convex hull {a,b,c}) f" @@ -1584,16 +1580,17 @@ using \p \ S\ openE S by blast then have "continuous_on (ball p e) f" using contf continuous_on_subset by blast - moreover have "f holomorphic_on {z. dist p z < e \ d \ z < k}" - apply (rule holomorphic_on_subset [OF holf1]) + moreover + have "{z. dist p z < e \ d \ z < k} \ S \ {z. d \ z < k}" + "{z. dist p z < e \ k < d \ z} \ S \ {z. k < d \ z}" using e by auto - moreover have "f holomorphic_on {z. dist p z < e \ k < d \ z}" - apply (rule holomorphic_on_subset [OF holf2]) - using e by auto + then have "f holomorphic_on {z. dist p z < e \ d \ z < k}" + "f holomorphic_on {z. dist p z < e \ k < d \ z}" + using holomorphic_on_subset holf1 holf2 by presburger+ ultimately show ?thesis apply (rule_tac x="ball p e" in exI) - using \e > 0\ e \d \ 0\ hol_pal_lem4 [of "ball p e" _ _ _ d _ k] - by (force simp add: subset_hull) + using \e > 0\ e \d \ 0\ hol_pal_lem4 [of "ball p e" _ _ _ d _ k] + by (force simp: subset_hull) qed show ?thesis by (blast intro: * Morera_local_triangle analytic_imp_holomorphic) @@ -1730,12 +1727,12 @@ proof - have [simp]: "x * norm z < r" using r x by (meson le_less_trans mult_le_cancel_right2 norm_not_less_zero) - have "norm (deriv f (x *\<^sub>R z) - deriv f 0) \ norm (x *\<^sub>R z) / (r - norm (x *\<^sub>R z)) * C" - apply (rule Le1) using r x \0 < r\ by simp - also have "... \ norm (x *\<^sub>R z) / (r - norm z) * C" - using r x \0 < r\ - apply (simp add: field_split_simps) - by (simp add: \0 < C\ mult.assoc mult_left_le_one_le ordered_comm_semiring_class.comm_mult_left_mono) + then have "cmod (x *\<^sub>R z) < r" + by (simp add: x) + then have "norm (deriv f (x *\<^sub>R z) - deriv f 0) \ norm (x *\<^sub>R z) / (r - norm (x *\<^sub>R z)) * C" + by (metis Le1) + also have "\ \ norm (x *\<^sub>R z) / (r - norm z) * C" + using r x \0 < r\ \0 < C\ by (simp add: frac_le mult_left_le_one_le) finally have "norm (deriv f (x *\<^sub>R z) - deriv f 0) * norm z \ norm (x *\<^sub>R z) / (r - norm z) * C * norm z" by (rule mult_right_mono) simp with x show ?thesis by (simp add: algebra_simps) @@ -1762,9 +1759,8 @@ then have \
: "(norm z * (r - norm z) - norm z * norm z) * norm (deriv f 0) \ norm (deriv f 0) * norm z * (r - norm z) - norm z * norm z * norm (deriv f 0)" by (simp add: algebra_simps) show ?thesis - apply (rule le_norm [OF _ int_le]) - using \norm z < r\ - by (simp add: power2_eq_square divide_simps C_def norm_mult \
) + using \norm z < r\ + by (force simp add: power2_eq_square divide_simps C_def norm_mult \
intro!: le_norm [OF _ int_le]) qed have sq201 [simp]: "0 < (1 - sqrt 2 / 2)" "(1 - sqrt 2 / 2) < 1" by (auto simp: sqrt2_less_2) @@ -1788,20 +1784,20 @@ have "ball 0 ((3 - 2 * sqrt 2) * r * norm (deriv f 0)) = ball (f 0) ((3 - 2 * sqrt 2) * r * norm (deriv f 0))" by simp - also have "... \ f ` ball 0 ((1 - sqrt 2 / 2) * r)" + also have "\ \ f ` ball 0 ((1 - sqrt 2 / 2) * r)" proof - have 3: "(3 - 2 * sqrt 2) * r * norm (deriv f 0) \ norm (f z)" if "norm z = (1 - sqrt 2 / 2) * r" for z - apply (rule order_trans [OF _ *]) - using \0 < r\ - apply (simp_all add: field_simps power2_eq_square that) - apply (simp add: mult.assoc [symmetric]) - done + proof (rule order_trans [OF _ *]) + show "(3 - 2 * sqrt 2) * r * cmod (deriv f 0) + \ (cmod z - (cmod z)\<^sup>2 / (r - cmod z)) * cmod (deriv f 0)" + by (simp add: le_less algebra_simps divide_simps power2_eq_square that) + qed (use \0 < r\ that in auto) show ?thesis - apply (rule ball_subset_open_map_image [OF 1 2 _ bounded_ball]) - using \0 < r\ sq201 3 C_def \0 < C\ sq3 by auto + using \0 < r\ sq201 3 C_def \0 < C\ sq3 + by (intro ball_subset_open_map_image [OF 1 2 _ bounded_ball]) auto qed - also have "... \ f ` ball 0 r" + also have "\ \ f ` ball 0 r" proof - have "\x. (1 - sqrt 2 / 2) * r \ r" using \0 < r\ by (auto simp: field_simps) @@ -1833,7 +1829,7 @@ \ (\z. f (a + z) - f a) ` ball 0 r" apply (rule Bloch_lemma_0) using \0 < r\ - apply (simp_all add: \0 < r\) + apply (simp_all add: \0 < r\ ) apply (simp add: fz deriv_chain dist_norm le) done show ?thesis @@ -1892,7 +1888,7 @@ using gen_le_dfp [of a] \r > 0\ by auto have 1: "f holomorphic_on cball p t" using cpt \r < 1\ order_subst1 subset_ball - by (force simp add: intro!: holomorphic_on_subset [OF holf]) + by (force simp: intro!: holomorphic_on_subset [OF holf]) have 2: "norm (deriv f z) \ 2 * norm (deriv f p)" if "z \ ball p t" for z proof - have z: "z \ cball a r" @@ -1904,7 +1900,7 @@ with \norm (z - a) < r\ \norm (p - a) < r\ have "norm (deriv f z) \ (r - norm (p - a)) / (r - norm (z - a)) * norm (deriv f p)" by (simp add: field_simps) - also have "... \ 2 * norm (deriv f p)" + also have "\ \ 2 * norm (deriv f p)" proof (rule mult_right_mono) show "(r - cmod (p - a)) / (r - cmod (z - a)) \ 2" using that \norm (p - a) < r\ \norm(z - a) < r\ dist_triangle3 [of z a p] @@ -1917,7 +1913,7 @@ then have sq3: "0 < 3 - 2 * sqrt 2" by simp have "1 / 12 / ((3 - 2 * sqrt 2) / 2) < r" using sq3 sqrt2 by (auto simp: field_simps r_def) - also have "... \ cmod (deriv f p) * (r - cmod (p - a))" + also have "\ \ cmod (deriv f p) * (r - cmod (p - a))" using \norm (p - a) < r\ le_norm_dfp by (simp add: pos_divide_le_eq) finally have "1 / 12 < cmod (deriv f p) * (r - cmod (p - a)) * ((3 - 2 * sqrt 2) / 2)" using pos_divide_less_eq half_gt_zero_iff sq3 by blast @@ -1925,13 +1921,8 @@ using sq3 by (simp add: mult.commute t_def) have "ball (f p) ((3 - 2 * sqrt 2) * t * norm (deriv f p)) \ f ` ball p t" by (rule Bloch_lemma [OF 1 \0 < t\ 2]) - also have "... \ f ` ball a 1" - proof - - have "ball a r \ ball a 1" - using \0 < t\ \r < 1\ by (simp add: ball_subset_ball_iff dist_norm) - then show ?thesis - using ball_subset_cball cpt by blast - qed + also have "\ \ f ` ball a 1" + by (meson \r < 1\ ball_subset_cball cpt dual_order.trans image_mono less_le_not_le subset_ball) finally have "ball (f p) ((3 - 2 * sqrt 2) * t * norm (deriv f p)) \ f ` ball a 1" . with ** show ?thesis by (rule that) @@ -1970,11 +1961,17 @@ apply (rule derivative_eq_intros * | simp)+ using \0 < r\ by (auto simp: C_def False) qed - have "deriv (\z. f (a + of_real r * z) / (C * of_real r)) 0 = deriv (\z. f (a + complex_of_real r * z)) 0 / - (C * complex_of_real r)" - apply (rule deriv_cdivide_right) - by (metis (no_types) DERIV_chain2 add.right_neutral dfa field_differentiable_add_const field_differentiable_def field_differentiable_linear fo mult_zero_right) - also have "... = 1" + obtain f' where "(f has_field_derivative f') (at a)" + using dfa field_differentiable_def by blast + then have "\c. ((\c. f (a + complex_of_real r * c)) has_field_derivative c) (at 0)" + by (metis (no_types) DERIV_chain2 add_cancel_left_right field_differentiable_add_const + field_differentiable_def field_differentiable_linear mult_eq_0_iff) + then have "(\w. f (a + complex_of_real r * w)) field_differentiable at 0" + by (simp add: field_differentiable_def) + then have "deriv (\z. f (a + of_real r * z) / (C * of_real r)) 0 + = deriv (\z. f (a + of_real r * z)) 0 / (C * of_real r)" + by (rule deriv_cdivide_right) + also have "\ = 1" using \0 < r\ by (simp add: C_def False fo derivative_intros dfa deriv_chain) finally have 2: "deriv (\z. f (a + of_real r * z) / (C * of_real r)) 0 = 1" . have sb1: "(*) (C * r) ` (\z. f (a + of_real r * z) / (C * r)) ` ball 0 1 diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Contour_Integration.thy --- a/src/HOL/Complex_Analysis/Contour_Integration.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Contour_Integration.thy Mon Sep 11 22:59:34 2023 +0200 @@ -44,14 +44,14 @@ unfolding contour_integrable_on_def contour_integral_def by blast lemma contour_integral_unique: "(f has_contour_integral i) g \ contour_integral g f = i" - apply (simp add: contour_integral_def has_contour_integral_def contour_integrable_on_def) + unfolding contour_integral_def has_contour_integral_def contour_integrable_on_def using has_integral_unique by blast lemma has_contour_integral_eqpath: - "\(f has_contour_integral y) p; f contour_integrable_on \; + "\(f has_contour_integral y) p; f contour_integrable_on \; contour_integral p f = contour_integral \ f\ \ (f has_contour_integral y) \" -using contour_integrable_on_def contour_integral_unique by auto + using contour_integrable_on_def contour_integral_unique by auto lemma has_contour_integral_integral: "f contour_integrable_on i \ (f has_contour_integral (contour_integral i f)) i" @@ -329,12 +329,12 @@ qed lemma contour_integrable_join [simp]: - "\valid_path g1; valid_path g2\ + "\valid_path g1; valid_path g2\ \ f contour_integrable_on (g1 +++ g2) \ f contour_integrable_on g1 \ f contour_integrable_on g2" -using contour_integrable_joinD1 contour_integrable_joinD2 contour_integrable_joinI by blast + using contour_integrable_joinD1 contour_integrable_joinD2 contour_integrable_joinI by blast lemma contour_integral_join [simp]: - "\f contour_integrable_on g1; f contour_integrable_on g2; valid_path g1; valid_path g2\ + "\f contour_integrable_on g1; f contour_integrable_on g2; valid_path g1; valid_path g2\ \ contour_integral (g1 +++ g2) f = contour_integral g1 f + contour_integral g2 f" by (simp add: has_contour_integral_integral has_contour_integral_join contour_integral_unique) @@ -353,11 +353,7 @@ using assms by (auto simp: has_contour_integral) then have i: "i = integral {a..1} (\x. f (g x) * vector_derivative g (at x)) + integral {0..a} (\x. f (g x) * vector_derivative g (at x))" - apply (rule has_integral_unique) - apply (subst add.commute) - apply (subst Henstock_Kurzweil_Integration.integral_combine) - using assms * integral_unique by auto - + by (smt (verit, ccfv_threshold) Henstock_Kurzweil_Integration.integral_combine a add.commute atLeastAtMost_iff has_integral_iff) have vd1: "vector_derivative (shiftpath a g) (at x) = vector_derivative g (at (x + a))" if "0 \ x" "x + a < 1" "x \ (\x. x - a) ` S" for x unfolding shiftpath_def @@ -371,8 +367,7 @@ then show "(g has_vector_derivative vector_derivative g (at (a + x))) (at (x + a))" by (metis add.commute vector_derivative_works) qed - then - show "((\x. g (a + x)) has_vector_derivative vector_derivative g (at (x + a))) (at x)" + then show "((\x. g (a + x)) has_vector_derivative vector_derivative g (at (x + a))) (at x)" by (auto simp: field_simps) show "0 < dist (1 - a) x" using that by auto @@ -474,8 +469,8 @@ lemma contour_integrable_on_shiftpath_eq: assumes "valid_path g" "pathfinish g = pathstart g" "a \ {0..1}" - shows "f contour_integrable_on (shiftpath a g) \ f contour_integrable_on g" -using assms contour_integrable_on_def has_contour_integral_shiftpath_eq by auto + shows "f contour_integrable_on (shiftpath a g) \ f contour_integrable_on g" + using assms contour_integrable_on_def has_contour_integral_shiftpath_eq by auto lemma contour_integral_shiftpath: assumes "valid_path g" "pathfinish g = pathstart g" "a \ {0..1}" @@ -556,26 +551,17 @@ lemma contour_integrable_subpath: assumes "f contour_integrable_on g" "valid_path g" "u \ {0..1}" "v \ {0..1}" shows "f contour_integrable_on (subpath u v g)" -proof (cases u v rule: linorder_class.le_cases) - case le - then show ?thesis - by (metis contour_integrable_on_def has_contour_integral_subpath [OF assms]) -next - case ge - with assms show ?thesis - by (metis (no_types, lifting) contour_integrable_on_def contour_integrable_reversepath_eq has_contour_integral_subpath reversepath_subpath valid_path_subpath) -qed + by (smt (verit, ccfv_threshold) assms contour_integrable_on_def contour_integrable_reversepath_eq + has_contour_integral_subpath reversepath_subpath valid_path_subpath) lemma has_integral_contour_integral_subpath: assumes "f contour_integrable_on g" "valid_path g" "u \ {0..1}" "v \ {0..1}" "u \ v" - shows "(((\x. f(g x) * vector_derivative g (at x))) + shows "((\x. f(g x) * vector_derivative g (at x)) has_integral contour_integral (subpath u v g) f) {u..v}" - using assms + (is "(?fg has_integral _)_") proof - - have "(\r. f (g r) * vector_derivative g (at r)) integrable_on {u..v}" - by (metis (full_types) assms(1) assms(3) assms(4) atLeastAtMost_iff atLeastatMost_subset_iff contour_integrable_on integrable_on_subinterval) - then have "((\r. f (g r) * vector_derivative g (at r)) has_integral integral {u..v} (\r. f (g r) * vector_derivative g (at r))) {u..v}" - by blast + have "(?fg has_integral integral {u..v} ?fg) {u..v}" + using assms contour_integrable_on integrable_on_subinterval by fastforce then show ?thesis by (metis (full_types) assms contour_integral_unique has_contour_integral_subpath) qed @@ -653,9 +639,9 @@ next fix x assume "x \ {0..1} - ({0, 1} \ g -` A \ {0<..<1})" hence "g x \ path_image g - A" by (auto simp: path_image_def) - from assms(4)[OF this] and assms(3) - show "f' (g' x) * vector_derivative g' (at x) = f (g x) * vector_derivative g (at x)" by simp - qed + with assms show "f' (g' x) * vector_derivative g' (at x) = f (g x) * vector_derivative g (at x)" + by simp +qed text \Contour integral along a segment on the real axis\ @@ -664,7 +650,7 @@ fixes a b :: complex and f :: "complex \ complex" assumes "a \ Reals" "b \ Reals" "Re a < Re b" shows "(f has_contour_integral I) (linepath a b) \ - ((\x. f (of_real x)) has_integral I) {Re a..Re b}" + ((\x. f (of_real x)) has_integral I) {Re a..Re b}" proof - from assms have [simp]: "of_real (Re a) = a" "of_real (Re b) = b" by (simp_all add: complex_eq_iff) @@ -738,9 +724,8 @@ have "((\x. f (g x)) has_vector_derivative f' (g x) * vector_derivative g (at x within {a..b})) (at x within {a..b})" using diff_chain_within [OF gdiff fdiff] by (simp add: has_vector_derivative_def scaleR_conv_of_real o_def mult_ac) - } note * = this - show ?thesis - using assms cfg * + } then show ?thesis + using assms cfg by (force simp: at_within_Icc_at intro: fundamental_theorem_of_calculus_interior_strong [OF \finite K\]) qed @@ -759,7 +744,7 @@ shows "(f' has_contour_integral 0) g" using assms by (metis diff_self contour_integral_primitive) -text\Existence of path integral for continuous function\ + lemma contour_integrable_continuous_linepath: assumes "continuous_on (closed_segment a b) f" shows "f contour_integrable_on (linepath a b)" @@ -951,10 +936,9 @@ by fastforce lemma contour_integrable_sum: - "\finite s; \a. a \ s \ (f a) contour_integrable_on p\ + "\finite s; \a. a \ s \ (f a) contour_integrable_on p\ \ (\x. sum (\a. f a x) s) contour_integrable_on p" - unfolding contour_integrable_on_def - by (metis has_contour_integral_sum) + unfolding contour_integrable_on_def by (metis has_contour_integral_sum) lemma contour_integrable_neg_iff: "(\x. -f x) contour_integrable_on g \ f contour_integrable_on g" @@ -1027,10 +1011,10 @@ apply (simp add: divide_simps mult.commute [of _ "1-k"] image_affinity_atLeastAtMost ** bc) apply (auto dest: has_integral_cmul [where k = "(1 - k) *\<^sub>R j" and c = "inverse (1 - k)"]) done - } note fj = this - show ?thesis + } + then show ?thesis using f k unfolding has_contour_integral_linepath - by (simp add: linepath_def has_integral_combine [OF _ _ fi fj]) + by (simp add: linepath_def has_integral_combine [OF _ _ fi]) qed lemma continuous_on_closed_segment_transform: @@ -1107,10 +1091,10 @@ then have gvcon': "continuous_on (cbox (0, 0) (1, 1::real)) (\z. vector_derivative g (at (fst z)))" and hvcon': "continuous_on (cbox (0, 0) (1::real, 1)) (\x. vector_derivative h (at (snd x)))" by auto - have "continuous_on (cbox (0, 0) (1, 1)) ((\(y1, y2). f y1 y2) \ (\w. ((g \ fst) w, (h \ snd) w)))" - apply (intro gcon hcon continuous_intros | simp)+ - apply (auto simp: path_image_def intro: continuous_on_subset [OF fcon]) - done + have "continuous_on ((\x. (g (fst x), h (snd x))) ` cbox (0,0) (1,1)) (\(y1, y2). f y1 y2)" + by (auto simp: path_image_def intro: continuous_on_subset [OF fcon]) + then have "continuous_on (cbox (0, 0) (1, 1)) ((\(y1, y2). f y1 y2) \ (\w. ((g \ fst) w, (h \ snd) w)))" + by (intro gcon hcon continuous_intros | simp)+ then have fgh: "continuous_on (cbox (0, 0) (1, 1)) (\x. f (g (fst x)) (h (snd x)))" by auto have "integral {0..1} (\x. contour_integral h (f (g x)) * vector_derivative g (at x)) = @@ -1186,7 +1170,7 @@ lemma valid_path_polynomial_function: fixes p :: "real \ 'a::euclidean_space" shows "polynomial_function p \ valid_path p" -by (force simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_polymonial_function C1_differentiable_polynomial_function) + by (force simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_polymonial_function C1_differentiable_polynomial_function) lemma valid_path_subpath_trivial [simp]: fixes g :: "real \ 'a::euclidean_space" @@ -1199,15 +1183,15 @@ where "part_circlepath z r s t \ \x. z + of_real r * exp (\ * of_real (linepath s t x))" lemma pathstart_part_circlepath [simp]: - "pathstart(part_circlepath z r s t) = z + r*exp(\ * s)" -by (metis part_circlepath_def pathstart_def pathstart_linepath) + "pathstart(part_circlepath z r s t) = z + r*exp(\ * s)" + by (metis part_circlepath_def pathstart_def pathstart_linepath) lemma pathfinish_part_circlepath [simp]: - "pathfinish(part_circlepath z r s t) = z + r*exp(\*t)" -by (metis part_circlepath_def pathfinish_def pathfinish_linepath) + "pathfinish(part_circlepath z r s t) = z + r*exp(\*t)" + by (metis part_circlepath_def pathfinish_def pathfinish_linepath) lemma reversepath_part_circlepath[simp]: - "reversepath (part_circlepath z r s t) = part_circlepath z r t s" + "reversepath (part_circlepath z r s t) = part_circlepath z r t s" unfolding part_circlepath_def reversepath_def linepath_def by (auto simp:algebra_simps) @@ -1284,24 +1268,12 @@ lemma in_path_image_part_circlepath: assumes "w \ path_image(part_circlepath z r s t)" "s \ t" "0 \ r" shows "norm(w - z) = r" -proof - - have "w \ {c. dist z c = r}" - by (metis (no_types) path_image_part_circlepath_subset sphere_def subset_eq assms) - thus ?thesis - by (simp add: dist_norm norm_minus_commute) -qed + by (smt (verit) assms dist_norm mem_Collect_eq norm_minus_commute path_image_part_circlepath_subset sphere_def subsetD) lemma path_image_part_circlepath_subset': assumes "r \ 0" shows "path_image (part_circlepath z r s t) \ sphere z r" -proof (cases "s \ t") - case True - thus ?thesis using path_image_part_circlepath_subset[of s t r z] assms by simp -next - case False - thus ?thesis using path_image_part_circlepath_subset[of t s r z] assms - by (subst reversepath_part_circlepath [symmetric], subst path_image_reversepath) simp_all -qed + by (smt (verit) assms path_image_part_circlepath_subset reversepath_part_circlepath reversepath_simps(2)) lemma part_circlepath_cnj: "cnj (part_circlepath c r a b x) = part_circlepath (cnj c) r (-a) (-b) x" by (simp add: part_circlepath_def exp_cnj linepath_def algebra_simps) @@ -1458,7 +1430,7 @@ have *: "\x. \0 \ x; x \ 1; part_circlepath z r s t x \ k\ \ cmod (f (part_circlepath z r s t x)) \ B" by (auto intro!: B [unfolded path_image_def image_def]) show ?thesis - apply (rule has_integral_bound [where 'a=real, simplified, OF _ **, simplified]) + using has_integral_bound [where 'a=real, simplified, OF _ **] using assms le * "2" \r > 0\ by (auto simp add: norm_mult vector_derivative_part_circlepath) qed qed @@ -1520,13 +1492,16 @@ qed have abs_away: "\P. (\x\{0..1}. \y\{0..1}. P \x - y\) \ (\x::real. 0 \ x \ x \ 1 \ P x)" by force + have "\x n. \s \ t; \s - t\ \ 2 * pi; 0 \ x; x < 1; + x * (t - s) = 2 * (real_of_int n * pi)\ + \ x = 0" + by (rule ccontr) (auto simp: 2 field_split_simps abs_mult dest: of_int_leD) + then show ?thesis using False apply (simp add: simple_path_def loop_free_def) apply (simp add: part_circlepath_def linepath_def exp_eq * ** abs01 del: Set.insert_iff) apply (subst abs_away) apply (auto simp: 1) - apply (rule ccontr) - apply (auto simp: 2 field_split_simps abs_mult dest: of_int_leD) done qed @@ -1719,16 +1694,18 @@ and inta: "(\t. f a (\ t) * vector_derivative \ (at t)) integrable_on {0..1}" using eventually_happens [OF eventually_conj] by (fastforce simp: contour_integrable_on path_image_def) - have Ble: "B * e / (\B\ + 1) \ e" - using \0 \ B\ \0 < e\ by (simp add: field_split_simps) have "\h. (\x\{0..1}. cmod (l (\ x) * vector_derivative \ (at x) - h x) \ e) \ h integrable_on {0..1}" proof (intro exI conjI ballI) show "cmod (l (\ x) * vector_derivative \ (at x) - f a (\ x) * vector_derivative \ (at x)) \ e" if "x \ {0..1}" for x - apply (rule order_trans [OF _ Ble]) - using noleB [OF that] fga [OF that] \0 \ B\ \0 < e\ - apply (fastforce simp: mult_ac dest: mult_mono [OF less_imp_le] simp add: norm_mult left_diff_distrib [symmetric] norm_minus_commute divide_simps) - done + proof - + have "cmod (l (\ x) * vector_derivative \ (at x) - f a (\ x) * vector_derivative \ (at x)) \ B * e / (\B\ + 1)" + using noleB [OF that] fga [OF that] \0 \ B\ \0 < e\ + by (fastforce simp: mult_ac dest: mult_mono [OF less_imp_le] simp add: norm_mult left_diff_distrib [symmetric] norm_minus_commute divide_simps) + also have "\ \ e" + using \0 \ B\ \0 < e\ by (simp add: field_split_simps) + finally show ?thesis . + qed qed (rule inta) } then show lintg: "l contour_integrable_on \" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Laurent_Convergence.thy --- a/src/HOL/Complex_Analysis/Laurent_Convergence.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Laurent_Convergence.thy Mon Sep 11 22:59:34 2023 +0200 @@ -7,17 +7,17 @@ (* TODO: Move *) text \TODO: Better than @{thm deriv_compose_linear}?\ lemma deriv_compose_linear': - assumes "f field_differentiable at (c * z+a)" - shows "deriv (\w. f (c * w+a)) z = c * deriv f (c * z+a)" - apply (subst deriv_chain[where f="\w. c * w+a",unfolded comp_def]) + assumes "f field_differentiable at (c*z + a)" + shows "deriv (\w. f (c*w + a)) z = c * deriv f (c*z + a)" + apply (subst deriv_chain[where f="\w. c*w + a",unfolded comp_def]) using assms by (auto intro:derivative_intros) text \TODO: Better than @{thm higher_deriv_compose_linear}?\ lemma higher_deriv_compose_linear': fixes z::complex assumes f: "f holomorphic_on T" and S: "open S" and T: "open T" and z: "z \ S" - and fg: "\w. w \ S \ u * w+c \ T" - shows "(deriv ^^ n) (\w. f (u * w+c)) z = u^n * (deriv ^^ n) f (u * z+c)" + and fg: "\w. w \ S \ u*w + c \ T" + shows "(deriv ^^ n) (\w. f (u*w + c)) z = u^n * (deriv ^^ n) f (u*z + c)" using z proof (induction n arbitrary: z) case 0 then show ?case by simp @@ -116,14 +116,7 @@ instance fls :: (semiring_char_0) semiring_char_0 proof show "inj (of_nat :: nat \ 'a fls)" - proof - fix m n :: nat - assume "of_nat m = (of_nat n :: 'a fls)" - hence "fls_nth (of_nat m) 0 = (fls_nth (of_nat n) 0 :: 'a)" - by (simp only: ) - thus "m = n" - by (simp add: fls_of_nat_nth) - qed + by (metis fls_regpart_of_nat injI of_nat_eq_iff) qed lemma fls_const_eq_0_iff [simp]: "fls_const c = 0 \ c = 0" @@ -547,20 +540,14 @@ assumes "g holomorphic_on A" assumes "g ` A \ eball 0 (fls_conv_radius f) - (if fls_subdegree f \ 0 then {} else {0})" shows "(\x. eval_fls f (g x)) holomorphic_on A" -proof - - have "eval_fls f \ g holomorphic_on A" - by (intro holomorphic_on_compose[OF assms(1) holomorphic_on_eval_fls]) (use assms in auto) - thus ?thesis - by (simp add: o_def) -qed + by (meson assms holomorphic_on_compose holomorphic_on_eval_fls holomorphic_transform o_def) lemma continuous_on_eval_fls: fixes f defines "n \ fls_subdegree f" assumes "A \ eball 0 (fls_conv_radius f) - (if n \ 0 then {} else {0})" shows "continuous_on A (eval_fls f)" - by (intro holomorphic_on_imp_continuous_on holomorphic_on_eval_fls) - (use assms in auto) + using assms holomorphic_on_eval_fls holomorphic_on_imp_continuous_on by blast lemma continuous_on_eval_fls' [continuous_intros]: fixes f @@ -568,9 +555,7 @@ assumes "g ` A \ eball 0 (fls_conv_radius f) - (if n \ 0 then {} else {0})" assumes "continuous_on A g" shows "continuous_on A (\x. eval_fls f (g x))" - using assms(3) - by (intro continuous_on_compose2[OF continuous_on_eval_fls _ assms(2)]) - (auto simp: n_def) + by (metis assms continuous_on_compose2 continuous_on_eval_fls order.refl) lemmas has_field_derivative_eval_fps' [derivative_intros] = DERIV_chain2[OF has_field_derivative_eval_fps] @@ -621,7 +606,7 @@ lemma eval_fls_deriv: assumes "z \ eball 0 (fls_conv_radius F) - {0}" shows "eval_fls (fls_deriv F) z = deriv (eval_fls F) z" - by (rule sym, rule DERIV_imp_deriv, rule has_field_derivative_eval_fls, rule assms) + by (metis DERIV_imp_deriv assms has_field_derivative_eval_fls) lemma analytic_on_eval_fls: assumes "A \ eball 0 (fls_conv_radius f) - (if fls_subdegree f \ 0 then {} else {0})" @@ -781,8 +766,12 @@ lemma is_pole_imp_neg_fls_subdegree: assumes F: "(\x. f (z + x)) has_laurent_expansion F" and "is_pole f z" shows "fls_subdegree F < 0" - apply (rule is_pole_0_imp_neg_fls_subdegree[OF F]) - using assms(2) is_pole_shift_0 by blast +proof - + have "is_pole (\x. f (z + x)) 0" + using assms(2) is_pole_shift_0 by blast + then show ?thesis + using F is_pole_0_imp_neg_fls_subdegree by blast +qed lemma is_pole_fls_subdegree_iff: assumes "(\x. f (z + x)) has_laurent_expansion F" @@ -2587,13 +2576,8 @@ by auto qed -lemma analytic_on_prod [analytic_intros]: - assumes "\x. x \ A \ f x analytic_on B" - shows "(\z. \x\A. f x z) analytic_on B" - using assms by (induction A rule: infinite_finite_induct) (auto intro!: analytic_intros) - lemma zorder_const [simp]: "c \ 0 \ zorder (\_. c) z = 0" - by (intro zorder_eqI[where s = UNIV]) auto + by (intro zorder_eqI[where S = UNIV]) auto lemma zorder_prod_analytic: assumes "\x. x \ A \ f x analytic_on {z}" @@ -2613,12 +2597,7 @@ lemma zorder_eq_0I: assumes "g analytic_on {z}" "g z \ 0" shows "zorder g z = 0" -proof - - from assms obtain r where r: "r > 0" "g holomorphic_on ball z r" - unfolding analytic_on_def by blast - thus ?thesis using assms - by (intro zorder_eqI[of "ball z r" _ g]) auto -qed + using analytic_at assms zorder_eqI by fastforce lemma zorder_pos_iff: assumes "f holomorphic_on A" "open A" "z \ A" "frequently (\z. f z \ 0) (at z)" @@ -2651,12 +2630,7 @@ lemma zorder_pos_iff': assumes "f analytic_on {z}" "frequently (\z. f z \ 0) (at z)" shows "zorder f z > 0 \ f z = 0" -proof - - from assms(1) obtain A where A: "open A" "{z} \ A" "f holomorphic_on A" - unfolding analytic_on_holomorphic by auto - with zorder_pos_iff [OF A(3,1), of z] assms show ?thesis - by auto -qed + using analytic_at assms zorder_pos_iff by blast lemma zorder_ge_0: assumes "f analytic_on {z}" "frequently (\z. f z \ 0) (at z)" @@ -2673,15 +2647,7 @@ lemma zorder_eq_0_iff: assumes "f analytic_on {z}" "frequently (\w. f w \ 0) (at z)" shows "zorder f z = 0 \ f z \ 0" -proof - assume "f z \ 0" - thus "zorder f z = 0" - using assms zorder_eq_0I by blast -next - assume "zorder f z = 0" - thus "f z \ 0" - using assms zorder_pos_iff' by fastforce -qed + using assms zorder_eq_0I zorder_pos_iff' by fastforce lemma dist_mult_left: "dist (a * b) (a * c :: 'a :: real_normed_field) = norm a * dist b c" @@ -2835,15 +2801,7 @@ qed lemma fps_to_fls_eq_fls_const_iff [simp]: "fps_to_fls F = fls_const c \ F = fps_const c" -proof - assume "F = fps_const c" - thus "fps_to_fls F = fls_const c" - by simp -next - assume "fps_to_fls F = fls_const c" - thus "F = fps_const c" - by (metis fls_regpart_const fls_regpart_fps_trivial) -qed + using fps_to_fls_eq_iff by fastforce lemma zorder_compose': assumes "isolated_singularity_at f (g z)" "not_essential f (g z)" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Residue_Theorem.thy --- a/src/HOL/Complex_Analysis/Residue_Theorem.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Residue_Theorem.thy Mon Sep 11 22:59:34 2023 +0200 @@ -10,19 +10,16 @@ fixes f :: "real \ 'a :: real_normed_field" assumes "f \ O[at_bot](\_. 1)" assumes "f \ O[at_top](\_. 1)" - assumes "continuous_on UNIV f" + assumes cf: "continuous_on UNIV f" shows "bounded (range f)" proof - - from assms(1) obtain c1 where "eventually (\x. norm (f x) \ c1) at_bot" - by (auto elim!: landau_o.bigE) - then obtain x1 where x1: "\x. x \ x1 \ norm (f x) \ c1" - by (auto simp: eventually_at_bot_linorder) - from assms(2) obtain c2 where "eventually (\x. norm (f x) \ c2) at_top" - by (auto elim!: landau_o.bigE) - then obtain x2 where x2: "\x. x \ x2 \ norm (f x) \ c2" - by (auto simp: eventually_at_top_linorder) + obtain c1 c2 + where "eventually (\x. norm (f x) \ c1) at_bot" "eventually (\x. norm (f x) \ c2) at_top" + using assms by (auto elim!: landau_o.bigE) + then obtain x1 x2 where x1: "\x. x \ x1 \ norm (f x) \ c1" and x2: "\x. x \ x2 \ norm (f x) \ c2" + by (auto simp: eventually_at_bot_linorder eventually_at_top_linorder) have "compact (f ` {x1..x2})" - by (intro compact_continuous_image continuous_on_subset[OF assms(3)]) auto + by (intro compact_continuous_image continuous_on_subset[OF cf]) auto hence "bounded (f ` {x1..x2})" by (rule compact_imp_bounded) then obtain c3 where c3: "\x. x \ {x1..x2} \ norm (f x) \ c3" @@ -67,7 +64,7 @@ also have "f \ O[at z0'](\_. 1)" using z0' by (intro insert.prems) auto finally show "g \ \" . - qed (insert insert.prems g, auto) + qed (use insert.prems g in auto) then obtain h where "h holomorphic_on S" "\z\S - X. h z = g z" by blast with g have "h holomorphic_on S" "\z\S - insert z0 X. h z = f z" by auto thus ?case by blast @@ -96,96 +93,94 @@ subsection \Cauchy's residue theorem\ lemma get_integrable_path: - assumes "open s" "connected (s-pts)" "finite pts" "f holomorphic_on (s-pts) " "a\s-pts" "b\s-pts" + assumes "open S" "connected (S-pts)" "finite pts" "f holomorphic_on (S-pts) " "a\S-pts" "b\S-pts" obtains g where "valid_path g" "pathstart g = a" "pathfinish g = b" - "path_image g \ s-pts" "f contour_integrable_on g" using assms -proof (induct arbitrary:s thesis a rule:finite_induct[OF \finite pts\]) + "path_image g \ S-pts" "f contour_integrable_on g" using assms +proof (induct arbitrary:S thesis a rule:finite_induct[OF \finite pts\]) case 1 - obtain g where "valid_path g" "path_image g \ s" "pathstart g = a" "pathfinish g = b" - using connected_open_polynomial_connected[OF \open s\,of a b ] \connected (s - {})\ + obtain g where "valid_path g" "path_image g \ S" "pathstart g = a" "pathfinish g = b" + using connected_open_polynomial_connected[OF \open S\,of a b ] \connected (S - {})\ valid_path_polynomial_function "1.prems"(6) "1.prems"(7) by auto moreover have "f contour_integrable_on g" - using contour_integrable_holomorphic_simple[OF _ \open s\ \valid_path g\ \path_image g \ s\,of f] - \f holomorphic_on s - {}\ + using contour_integrable_holomorphic_simple[OF _ \open S\ \valid_path g\ \path_image g \ S\,of f] + \f holomorphic_on S - {}\ by auto ultimately show ?case using "1"(1)[of g] by auto next case idt:(2 p pts) - obtain e where "e>0" and e:"\w\ball a e. w \ s \ (w \ a \ w \ insert p pts)" - using finite_ball_avoid[OF \open s\ \finite (insert p pts)\, of a] - \a \ s - insert p pts\ + obtain e where "e>0" and e:"\w\ball a e. w \ S \ (w \ a \ w \ insert p pts)" + using finite_ball_avoid[OF \open S\ \finite (insert p pts)\, of a] + \a \ S - insert p pts\ by auto define a' where "a' \ a+e/2" - have "a'\s-{p} -pts" using e[rule_format,of "a+e/2"] \e>0\ + have "a'\S-{p} -pts" using e[rule_format,of "a+e/2"] \e>0\ by (auto simp add:dist_complex_def a'_def) then obtain g' where g'[simp]:"valid_path g'" "pathstart g' = a'" "pathfinish g' = b" - "path_image g' \ s - {p} - pts" "f contour_integrable_on g'" - using idt.hyps(3)[of a' "s-{p}"] idt.prems idt.hyps(1) + "path_image g' \ S - {p} - pts" "f contour_integrable_on g'" + using idt.hyps(3)[of a' "S-{p}"] idt.prems idt.hyps(1) by (metis Diff_insert2 open_delete) define g where "g \ linepath a a' +++ g'" have "valid_path g" unfolding g_def by (auto intro: valid_path_join) moreover have "pathstart g = a" and "pathfinish g = b" unfolding g_def by auto - moreover have "path_image g \ s - insert p pts" unfolding g_def - proof (rule subset_path_image_join) - have "closed_segment a a' \ ball a e" using \e>0\ - by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute) - then show "path_image (linepath a a') \ s - insert p pts" using e idt(9) - by auto - next - show "path_image g' \ s - insert p pts" using g'(4) by blast - qed + moreover have "path_image g \ S - insert p pts" + unfolding g_def + proof (rule subset_path_image_join) + have "closed_segment a a' \ ball a e" using \e>0\ + by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute) + then show "path_image (linepath a a') \ S - insert p pts" using e idt(9) + by auto + next + show "path_image g' \ S - insert p pts" using g'(4) by blast + qed moreover have "f contour_integrable_on g" - proof - - have "closed_segment a a' \ ball a e" using \e>0\ - by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute) - then have "continuous_on (closed_segment a a') f" - using e idt.prems(6) holomorphic_on_imp_continuous_on[OF idt.prems(5)] - apply (elim continuous_on_subset) - by auto - then have "f contour_integrable_on linepath a a'" - using contour_integrable_continuous_linepath by auto - then show ?thesis unfolding g_def - apply (rule contour_integrable_joinI) - by (auto simp add: \e>0\) - qed + proof - + have "closed_segment a a' \ ball a e" using \e>0\ + by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute) + then have "closed_segment a a' \ S - insert p pts" + using e idt.prems(6) by auto + then have "continuous_on (closed_segment a a') f" + using holomorphic_on_imp_continuous_on holomorphic_on_subset idt.prems(5) by presburger + then show ?thesis + using contour_integrable_continuous_linepath by (simp add: g_def) + qed ultimately show ?case using idt.prems(1)[of g] by auto qed lemma Cauchy_theorem_aux: - assumes "open s" "connected (s-pts)" "finite pts" "pts \ s" "f holomorphic_on s-pts" - "valid_path g" "pathfinish g = pathstart g" "path_image g \ s-pts" - "\z. (z \ s) \ winding_number g z = 0" - "\p\s. h p>0 \ (\w\cball p (h p). w\s \ (w\p \ w \ pts))" + assumes "open S" "connected (S-pts)" "finite pts" "pts \ S" "f holomorphic_on S-pts" + "valid_path g" "pathfinish g = pathstart g" "path_image g \ S-pts" + "\z. (z \ S) \ winding_number g z = 0" + "\p\S. h p>0 \ (\w\cball p (h p). w\S \ (w\p \ w \ pts))" shows "contour_integral g f = (\p\pts. winding_number g p * contour_integral (circlepath p (h p)) f)" using assms -proof (induct arbitrary:s g rule:finite_induct[OF \finite pts\]) +proof (induct arbitrary:S g rule:finite_induct[OF \finite pts\]) case 1 then show ?case by (simp add: Cauchy_theorem_global contour_integral_unique) next case (2 p pts) note fin[simp] = \finite (insert p pts)\ - and connected = \connected (s - insert p pts)\ + and connected = \connected (S - insert p pts)\ and valid[simp] = \valid_path g\ and g_loop[simp] = \pathfinish g = pathstart g\ - and holo[simp]= \f holomorphic_on s - insert p pts\ - and path_img = \path_image g \ s - insert p pts\ - and winding = \\z. z \ s \ winding_number g z = 0\ - and h = \\pa\s. 0 < h pa \ (\w\cball pa (h pa). w \ s \ (w \ pa \ w \ insert p pts))\ - have "h p>0" and "p\s" - and h_p: "\w\cball p (h p). w \ s \ (w \ p \ w \ insert p pts)" - using h \insert p pts \ s\ by auto + and holo[simp]= \f holomorphic_on S - insert p pts\ + and path_img = \path_image g \ S - insert p pts\ + and winding = \\z. z \ S \ winding_number g z = 0\ + and h = \\pa\S. 0 < h pa \ (\w\cball pa (h pa). w \ S \ (w \ pa \ w \ insert p pts))\ + have "h p>0" and "p\S" + and h_p: "\w\cball p (h p). w \ S \ (w \ p \ w \ insert p pts)" + using h \insert p pts \ S\ by auto obtain pg where pg[simp]: "valid_path pg" "pathstart pg = pathstart g" "pathfinish pg=p+h p" - "path_image pg \ s-insert p pts" "f contour_integrable_on pg" - proof - - have "p + h p\cball p (h p)" using h[rule_format,of p] - by (simp add: \p \ s\ dist_norm) - then have "p + h p \ s - insert p pts" using h[rule_format,of p] \insert p pts \ s\ - by fastforce - moreover have "pathstart g \ s - insert p pts " using path_img by auto - ultimately show ?thesis - using get_integrable_path[OF \open s\ connected fin holo,of "pathstart g" "p+h p"] that - by blast - qed + "path_image pg \ S-insert p pts" "f contour_integrable_on pg" + proof - + have "p + h p\cball p (h p)" using h[rule_format,of p] + by (simp add: \p \ S\ dist_norm) + then have "p + h p \ S - insert p pts" using h[rule_format,of p] \insert p pts \ S\ + by fastforce + moreover have "pathstart g \ S - insert p pts " using path_img by auto + ultimately show ?thesis + using get_integrable_path[OF \open S\ connected fin holo,of "pathstart g" "p+h p"] that + by blast + qed obtain n::int where "n=winding_number g p" using integer_winding_number[OF _ g_loop,of p] valid path_img by (metis DiffD2 Ints_cases insertI1 subset_eq valid_path_imp_path) @@ -193,12 +188,13 @@ define p_circ_pt where "p_circ_pt \ linepath (p+h p) (p+h p)" define n_circ where "n_circ \ \n. ((+++) p_circ ^^ n) p_circ_pt" define cp where "cp \ if n\0 then reversepath (n_circ (nat n)) else n_circ (nat (- n))" + have n_circ:"valid_path (n_circ k)" "winding_number (n_circ k) p = k" "pathstart (n_circ k) = p + h p" "pathfinish (n_circ k) = p + h p" "path_image (n_circ k) = (if k=0 then {p + h p} else sphere p (h p))" "p \ path_image (n_circ k)" - "\p'. p'\s - pts \ winding_number (n_circ k) p'=0 \ p'\path_image (n_circ k)" + "\p'. p'\S - pts \ winding_number (n_circ k) p'=0 \ p'\path_image (n_circ k)" "f contour_integrable_on (n_circ k)" "contour_integral (n_circ k) f = k * contour_integral p_circ f" for k @@ -212,7 +208,7 @@ and "p \ path_image (n_circ 0)" unfolding n_circ_def p_circ_pt_def using \h p > 0\ by (auto simp add: dist_norm) - show "winding_number (n_circ 0) p'=0 \ p'\path_image (n_circ 0)" when "p'\s- pts" for p' + show "winding_number (n_circ 0) p'=0 \ p'\path_image (n_circ 0)" when "p'\S- pts" for p' unfolding n_circ_def p_circ_pt_def apply (auto intro!:winding_number_trivial) by (metis Diff_iff pathfinish_in_path_image pg(3) pg(4) subsetCE subset_insertI that)+ @@ -226,7 +222,7 @@ have n_Suc:"n_circ (Suc k) = p_circ +++ n_circ k" unfolding n_circ_def by auto have pcirc:"p \ path_image p_circ" "valid_path p_circ" "pathfinish p_circ = pathstart (n_circ k)" using Suc(3) unfolding p_circ_def using \h p > 0\ by (auto simp add: p_circ_def) - have pcirc_image:"path_image p_circ \ s - insert p pts" + have pcirc_image:"path_image p_circ \ S - insert p pts" proof - have "path_image p_circ \ cball p (h p)" using \0 < h p\ p_circ_def by auto then show ?thesis using h_p pcirc(1) by auto @@ -263,59 +259,59 @@ by (simp add: n_circ_def p_circ_def) show "pathfinish (n_circ (Suc k)) = p + h p" using Suc(4) unfolding n_circ_def by auto - show "winding_number (n_circ (Suc k)) p'=0 \ p'\path_image (n_circ (Suc k))" when "p'\s-pts" for p' + show "winding_number (n_circ (Suc k)) p'=0 \ p'\path_image (n_circ (Suc k))" when "p'\S-pts" for p' proof - - have " p' \ path_image p_circ" using \p \ s\ h p_circ_def that using pcirc_image by blast + have " p' \ path_image p_circ" using \p \ S\ h p_circ_def that using pcirc_image by blast moreover have "p' \ path_image (n_circ k)" using Suc.hyps(7) that by blast moreover have "winding_number p_circ p' = 0" proof - have "path_image p_circ \ cball p (h p)" - using h unfolding p_circ_def using \p \ s\ by fastforce - moreover have "p'\cball p (h p)" using \p \ s\ h that "2.hyps"(2) by fastforce - ultimately show ?thesis unfolding p_circ_def - apply (intro winding_number_zero_outside) - by auto + using h unfolding p_circ_def using \p \ S\ by fastforce + moreover have "p'\cball p (h p)" using \p \ S\ h that "2.hyps"(2) by fastforce + ultimately show ?thesis + unfolding p_circ_def + by (intro winding_number_zero_outside) auto qed ultimately show ?thesis - unfolding n_Suc - apply (subst winding_number_join) - by (auto simp: valid_path_imp_path pcirc Suc that not_in_path_image_join Suc.hyps(7)[OF that]) + unfolding n_Suc using Suc.hyps pcirc + by (metis add.right_neutral not_in_path_image_join that valid_path_imp_path winding_number_join) qed show "f contour_integrable_on (n_circ (Suc k))" unfolding n_Suc by (rule contour_integrable_joinI[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)]) show "contour_integral (n_circ (Suc k)) f = (Suc k) * contour_integral p_circ f" - unfolding n_Suc - by (auto simp add:contour_integral_join[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)] - Suc(9) algebra_simps) + by (simp add: Rings.ring_distribs(2) Suc.hyps n_Suc pcirc pcirc_integrable) qed have cp[simp]:"pathstart cp = p + h p" "pathfinish cp = p + h p" - "valid_path cp" "path_image cp \ s - insert p pts" + "valid_path cp" "path_image cp \ S - insert p pts" "winding_number cp p = - n" - "\p'. p'\s - pts \ winding_number cp p'=0 \ p' \ path_image cp" + "\p'. p'\S - pts \ winding_number cp p'=0 \ p' \ path_image cp" "f contour_integrable_on cp" "contour_integral cp f = - n * contour_integral p_circ f" proof - show "pathstart cp = p + h p" and "pathfinish cp = p + h p" and "valid_path cp" using n_circ unfolding cp_def by auto next - have "sphere p (h p) \ s - insert p pts" - using h[rule_format,of p] \insert p pts \ s\ by force - moreover have "p + complex_of_real (h p) \ s - insert p pts" + have "sphere p (h p) \ S - insert p pts" + using h[rule_format,of p] \insert p pts \ S\ by force + moreover have "p + complex_of_real (h p) \ S - insert p pts" using pg(3) pg(4) by (metis pathfinish_in_path_image subsetCE) - ultimately show "path_image cp \ s - insert p pts" unfolding cp_def + ultimately show "path_image cp \ S - insert p pts" unfolding cp_def using n_circ(5) by auto next show "winding_number cp p = - n" unfolding cp_def using winding_number_reversepath n_circ \h p>0\ by (auto simp: valid_path_imp_path) next - show "winding_number cp p'=0 \ p' \ path_image cp" when "p'\s - pts" for p' - unfolding cp_def - apply (auto) - apply (subst winding_number_reversepath) - by (auto simp add: valid_path_imp_path n_circ(7)[OF that] n_circ(1)) + show "winding_number cp p'=0 \ p' \ path_image cp" when "p'\S - pts" for p' + proof - + have "winding_number (reversepath (n_circ (nat n))) p' = 0" + using n_circ that + by (metis add.inverse_neutral valid_path_imp_path winding_number_reversepath) + then show ?thesis + using cp_def n_circ(7) that by force + qed next show "f contour_integrable_on cp" unfolding cp_def using contour_integrable_reversepath_eq n_circ(1,8) by auto @@ -326,30 +322,31 @@ qed define g' where "g' \ g +++ pg +++ cp +++ (reversepath pg)" have "contour_integral g' f = (\p\pts. winding_number g' p * contour_integral (circlepath p (h p)) f)" - proof (rule "2.hyps"(3)[of "s-{p}" "g'",OF _ _ \finite pts\ ]) - show "connected (s - {p} - pts)" using connected by (metis Diff_insert2) - show "open (s - {p})" using \open s\ by auto - show " pts \ s - {p}" using \insert p pts \ s\ \ p \ pts\ by blast - show "f holomorphic_on s - {p} - pts" using holo \p \ pts\ by (metis Diff_insert2) + proof (rule "2.hyps"(3)[of "S-{p}" "g'",OF _ _ \finite pts\ ]) + show "connected (S - {p} - pts)" using connected by (metis Diff_insert2) + show "open (S - {p})" using \open S\ by auto + show " pts \ S - {p}" using \insert p pts \ S\ \ p \ pts\ by blast + show "f holomorphic_on S - {p} - pts" using holo \p \ pts\ by (metis Diff_insert2) show "valid_path g'" unfolding g'_def cp_def using n_circ valid pg g_loop - by (auto intro!:valid_path_join ) + by (auto intro!:valid_path_join) show "pathfinish g' = pathstart g'" unfolding g'_def cp_def using pg(2) by simp - show "path_image g' \ s - {p} - pts" + show "path_image g' \ S - {p} - pts" proof - - define s' where "s' \ s - {p} - pts" - have s':"s' = s-insert p pts " unfolding s'_def by auto + define s' where "s' \ S - {p} - pts" + have s':"s' = S-insert p pts " unfolding s'_def by auto then show ?thesis using path_img pg(4) cp(4) - unfolding g'_def - apply (fold s'_def s') - apply (intro subset_path_image_join) - by auto + by (simp add: g'_def s'_def subset_path_image_join) qed note path_join_imp[simp] - show "\z. z \ s - {p} \ winding_number g' z = 0" + show "\z. z \ S - {p} \ winding_number g' z = 0" proof clarify - fix z assume z:"z\s - {p}" + fix z assume z:"z\S - {p}" + have z_notin_cp: "z \ path_image cp" + using cp(6) cp_def n_circ(6) z by auto + have z_notin_pg: "z \ path_image pg" + by (metis Diff_iff Diff_insert2 pg(4) subsetD z) have "winding_number (g +++ pg +++ cp +++ reversepath pg) z = winding_number g z + winding_number (pg +++ cp +++ (reversepath pg)) z" proof (rule winding_number_join) @@ -358,13 +355,13 @@ show "path (pg +++ cp +++ reversepath pg)" using pg(3) cp by (simp add: valid_path_imp_path) next - have "path_image (pg +++ cp +++ reversepath pg) \ s - insert p pts" + have "path_image (pg +++ cp +++ reversepath pg) \ S - insert p pts" using pg(4) cp(4) by (auto simp:subset_path_image_join) then show "z \ path_image (pg +++ cp +++ reversepath pg)" using z by auto next show "pathfinish g = pathstart (pg +++ cp +++ reversepath pg)" using g_loop by auto qed - also have "... = winding_number g z + (winding_number pg z + also have "\ = winding_number g z + (winding_number pg z + winding_number (cp +++ (reversepath pg)) z)" proof (subst add_left_cancel,rule winding_number_join) show "path pg" and "path (cp +++ reversepath pg)" @@ -375,167 +372,129 @@ by (metis Diff_iff \z \ path_image pg\ contra_subsetD cp(4) insertI1 not_in_path_image_join path_image_reversepath singletonD) qed - also have "... = winding_number g z + (winding_number pg z + also have "\ = winding_number g z + (winding_number pg z + (winding_number cp z + winding_number (reversepath pg) z))" - apply (auto intro!:winding_number_join simp: valid_path_imp_path) - apply (metis Diff_iff contra_subsetD cp(4) insertI1 singletonD z) - by (metis Diff_insert2 Diff_subset contra_subsetD pg(4) z) - also have "... = winding_number g z + winding_number cp z" - apply (subst winding_number_reversepath) - apply (auto simp: valid_path_imp_path) - by (metis Diff_iff contra_subsetD insertI1 pg(4) singletonD z) + by (simp add: valid_path_imp_path winding_number_join z_notin_cp z_notin_pg) + also have "\ = winding_number g z + winding_number cp z" + by (simp add: valid_path_imp_path winding_number_reversepath z_notin_pg) finally have "winding_number g' z = winding_number g z + winding_number cp z" unfolding g'_def . moreover have "winding_number g z + winding_number cp z = 0" using winding z \n=winding_number g p\ by auto ultimately show "winding_number g' z = 0" unfolding g'_def by auto qed - show "\pa\s - {p}. 0 < h pa \ (\w\cball pa (h pa). w \ s - {p} \ (w \ pa \ w \ pts))" + show "\pa \ S - {p}. 0 < h pa \ (\w\cball pa (h pa). w \ S - {p} \ (w \ pa \ w \ pts))" using h by fastforce qed moreover have "contour_integral g' f = contour_integral g f - winding_number g p * contour_integral p_circ f" - proof - - have "contour_integral g' f = contour_integral g f - + contour_integral (pg +++ cp +++ reversepath pg) f" - unfolding g'_def - apply (subst contour_integral_join) - by (auto simp add:open_Diff[OF \open s\,OF finite_imp_closed[OF fin]] - intro!: contour_integrable_holomorphic_simple[OF holo _ _ path_img] - contour_integrable_reversepath) - also have "... = contour_integral g f + contour_integral pg f - + contour_integral (cp +++ reversepath pg) f" - apply (subst contour_integral_join) - by (auto simp add:contour_integrable_reversepath) - also have "... = contour_integral g f + contour_integral pg f + proof - + have *: "f contour_integrable_on g" "f contour_integrable_on pg" "f contour_integrable_on cp" + by (auto simp add: open_Diff[OF \open S\,OF finite_imp_closed[OF fin]] + intro!: contour_integrable_holomorphic_simple[OF holo _ _ path_img]) + have "contour_integral g' f = contour_integral g f + contour_integral pg f + contour_integral cp f + contour_integral (reversepath pg) f" - apply (subst contour_integral_join) - by (auto simp add:contour_integrable_reversepath) - also have "... = contour_integral g f + contour_integral cp f" + using * by (simp add: g'_def contour_integrable_reversepath_eq) + also have "\ = contour_integral g f + contour_integral cp f" using contour_integral_reversepath by (auto simp add:contour_integrable_reversepath) - also have "... = contour_integral g f - winding_number g p * contour_integral p_circ f" + also have "\ = contour_integral g f - winding_number g p * contour_integral p_circ f" using \n=winding_number g p\ by auto finally show ?thesis . qed moreover have "winding_number g' p' = winding_number g p'" when "p'\pts" for p' proof - - have [simp]: "p' \ path_image g" "p' \ path_image pg" "p'\path_image cp" - using "2.prems"(8) that - apply blast - apply (metis Diff_iff Diff_insert2 contra_subsetD pg(4) that) - by (meson DiffD2 cp(4) rev_subsetD subset_insertI that) - have "winding_number g' p' = winding_number g p' - + winding_number (pg +++ cp +++ reversepath pg) p'" unfolding g'_def - apply (subst winding_number_join) - apply (simp_all add: valid_path_imp_path) - apply (intro not_in_path_image_join) - by auto - also have "... = winding_number g p' + winding_number pg p' + obtain [simp]: "p' \ path_image g" "p' \ path_image pg" "p'\path_image cp" + using "2.prems"(8) that by (metis Diff_iff Diff_insert2 \p' \ pts\ cp(4) pg(4) subsetD) + have "winding_number g' p' = winding_number g p' + winding_number pg p' + winding_number (cp +++ reversepath pg) p'" - apply (subst winding_number_join) - apply (simp_all add: valid_path_imp_path) - apply (intro not_in_path_image_join) - by auto - also have "... = winding_number g p' + winding_number pg p'+ winding_number cp p' - + winding_number (reversepath pg) p'" - apply (subst winding_number_join) - by (simp_all add: valid_path_imp_path) - also have "... = winding_number g p' + winding_number cp p'" - apply (subst winding_number_reversepath) - by (simp_all add: valid_path_imp_path) - also have "... = winding_number g p'" using that by auto + by (simp add: g'_def not_in_path_image_join valid_path_imp_path winding_number_join) + also have "\ = winding_number g p'" using that + by (simp add: valid_path_imp_path winding_number_join winding_number_reversepath) finally show ?thesis . qed ultimately show ?case unfolding p_circ_def apply (subst (asm) sum.cong[OF refl, of pts _ "\p. winding_number g p * contour_integral (circlepath p (h p)) f"]) - by (auto simp add:sum.insert[OF \finite pts\ \p\pts\] algebra_simps) + by (auto simp: sum.insert[OF \finite pts\ \p\pts\] algebra_simps) qed lemma Cauchy_theorem_singularities: - assumes "open s" "connected s" "finite pts" and - holo:"f holomorphic_on s-pts" and + assumes "open S" "connected S" "finite pts" and + holo: "f holomorphic_on S-pts" and "valid_path g" and loop:"pathfinish g = pathstart g" and - "path_image g \ s-pts" and - homo:"\z. (z \ s) \ winding_number g z = 0" and - avoid:"\p\s. h p>0 \ (\w\cball p (h p). w\s \ (w\p \ w \ pts))" + "path_image g \ S-pts" and + homo:"\z. (z \ S) \ winding_number g z = 0" and + avoid:"\p\S. h p>0 \ (\w\cball p (h p). w\S \ (w\p \ w \ pts))" shows "contour_integral g f = (\p\pts. winding_number g p * contour_integral (circlepath p (h p)) f)" (is "?L=?R") proof - define circ where "circ \ \p. winding_number g p * contour_integral (circlepath p (h p)) f" - define pts1 where "pts1 \ pts \ s" + define pts1 where "pts1 \ pts \ S" define pts2 where "pts2 \ pts - pts1" - have "pts=pts1 \ pts2" "pts1 \ pts2 = {}" "pts2 \ s={}" "pts1\s" + have "pts=pts1 \ pts2" "pts1 \ pts2 = {}" "pts2 \ S={}" "pts1\S" unfolding pts1_def pts2_def by auto have "contour_integral g f = (\p\pts1. circ p)" unfolding circ_def - proof (rule Cauchy_theorem_aux[OF \open s\ _ _ \pts1\s\ _ \valid_path g\ loop _ homo]) + proof (rule Cauchy_theorem_aux[OF \open S\ _ _ \pts1\S\ _ \valid_path g\ loop _ homo]) have "finite pts1" unfolding pts1_def using \finite pts\ by auto - then show "connected (s - pts1)" - using \open s\ \connected s\ connected_open_delete_finite[of s] by auto + then show "connected (S - pts1)" + using \open S\ \connected S\ connected_open_delete_finite[of S] by auto next show "finite pts1" using \pts = pts1 \ pts2\ assms(3) by auto - show "f holomorphic_on s - pts1" by (metis Diff_Int2 Int_absorb holo pts1_def) - show "path_image g \ s - pts1" using assms(7) pts1_def by auto - show "\p\s. 0 < h p \ (\w\cball p (h p). w \ s \ (w \ p \ w \ pts1))" + show "f holomorphic_on S - pts1" by (metis Diff_Int2 Int_absorb holo pts1_def) + show "path_image g \ S - pts1" using assms(7) pts1_def by auto + show "\p\S. 0 < h p \ (\w\cball p (h p). w \ S \ (w \ p \ w \ pts1))" by (simp add: avoid pts1_def) qed - moreover have "sum circ pts2=0" - proof - - have "winding_number g p=0" when "p\pts2" for p - using \pts2 \ s={}\ that homo[rule_format,of p] by auto - thus ?thesis unfolding circ_def - apply (intro sum.neutral) - by auto - qed + moreover have "sum circ pts2 = 0" + by (metis \pts2 \ S = {}\ circ_def disjoint_iff_not_equal homo mult_zero_left sum.neutral) moreover have "?R=sum circ pts1 + sum circ pts2" unfolding circ_def using sum.union_disjoint[OF _ _ \pts1 \ pts2 = {}\] \finite pts\ \pts=pts1 \ pts2\ by blast ultimately show ?thesis - apply (fold circ_def) - by auto + by simp qed theorem Residue_theorem: - fixes s pts::"complex set" and f::"complex \ complex" + fixes S pts::"complex set" and f::"complex \ complex" and g::"real \ complex" - assumes "open s" "connected s" "finite pts" and - holo:"f holomorphic_on s-pts" and + assumes "open S" "connected S" "finite pts" and + holo:"f holomorphic_on S-pts" and "valid_path g" and loop:"pathfinish g = pathstart g" and - "path_image g \ s-pts" and - homo:"\z. (z \ s) \ winding_number g z = 0" + "path_image g \ S-pts" and + homo:"\z. (z \ S) \ winding_number g z = 0" shows "contour_integral g f = 2 * pi * \ *(\p\pts. winding_number g p * residue f p)" proof - define c where "c \ 2 * pi * \" - obtain h where avoid:"\p\s. h p>0 \ (\w\cball p (h p). w\s \ (w\p \ w \ pts))" - using finite_cball_avoid[OF \open s\ \finite pts\] by metis + obtain h where avoid:"\p\S. h p>0 \ (\w\cball p (h p). w\S \ (w\p \ w \ pts))" + using finite_cball_avoid[OF \open S\ \finite pts\] by metis have "contour_integral g f = (\p\pts. winding_number g p * contour_integral (circlepath p (h p)) f)" using Cauchy_theorem_singularities[OF assms avoid] . - also have "... = (\p\pts. c * winding_number g p * residue f p)" + also have "\ = (\p\pts. c * winding_number g p * residue f p)" proof (intro sum.cong) show "pts = pts" by simp next fix x assume "x \ pts" show "winding_number g x * contour_integral (circlepath x (h x)) f = c * winding_number g x * residue f x" - proof (cases "x\s") + proof (cases "x\S") case False then have "winding_number g x=0" using homo by auto thus ?thesis by auto next case True have "contour_integral (circlepath x (h x)) f = c* residue f x" - using \x\pts\ \finite pts\ avoid[rule_format,OF True] - apply (intro base_residue[of "s-(pts-{x})",THEN contour_integral_unique,folded c_def]) - by (auto intro:holomorphic_on_subset[OF holo] open_Diff[OF \open s\ finite_imp_closed]) + using \x\pts\ \finite pts\ avoid[rule_format, OF True] + apply (intro base_residue[of "S-(pts-{x})",THEN contour_integral_unique,folded c_def]) + by (auto intro:holomorphic_on_subset[OF holo] open_Diff[OF \open S\ finite_imp_closed]) then show ?thesis by auto qed qed - also have "... = c * (\p\pts. winding_number g p * residue f p)" + also have "\ = c * (\p\pts. winding_number g p * residue f p)" by (simp add: sum_distrib_left algebra_simps) finally show ?thesis unfolding c_def . qed @@ -543,17 +502,17 @@ subsection \The argument principle\ theorem argument_principle: - fixes f::"complex \ complex" and poles s:: "complex set" - defines "pz \ {w\s. f w = 0 \ w \ poles}" \ \\<^term>\pz\ is the set of poles and zeros\ - assumes "open s" "connected s" and - f_holo:"f holomorphic_on s-poles" and - h_holo:"h holomorphic_on s" and + fixes f::"complex \ complex" and poles S:: "complex set" + defines "pz \ {w\S. f w = 0 \ w \ poles}" \ \\<^term>\pz\ is the set of poles and zeros\ + assumes "open S" "connected S" and + f_holo:"f holomorphic_on S-poles" and + h_holo:"h holomorphic_on S" and "valid_path g" and loop:"pathfinish g = pathstart g" and - path_img:"path_image g \ s - pz" and - homo:"\z. (z \ s) \ winding_number g z = 0" and + path_img:"path_image g \ S - pz" and + homo:"\z. (z \ S) \ winding_number g z = 0" and finite:"finite pz" and - poles:"\p\s\poles. is_pole f p" + poles:"\p\S\poles. is_pole f p" shows "contour_integral g (\x. deriv f x * h x / f x) = 2 * pi * \ * (\p\pz. winding_number g p * h p * zorder f p)" (is "?L=?R") @@ -561,12 +520,12 @@ define c where "c \ 2 * complex_of_real pi * \ " define ff where "ff \ (\x. deriv f x * h x / f x)" define cont where "cont \ \ff p e. (ff has_contour_integral c * zorder f p * h p ) (circlepath p e)" - define avoid where "avoid \ \p e. \w\cball p e. w \ s \ (w \ p \ w \ pz)" + define avoid where "avoid \ \p e. \w\cball p e. w \ S \ (w \ p \ w \ pz)" - have "\e>0. avoid p e \ (p\pz \ cont ff p e)" when "p\s" for p + have "\e>0. avoid p e \ (p\pz \ cont ff p e)" when "p\S" for p proof - obtain e1 where "e1>0" and e1_avoid:"avoid p e1" - using finite_cball_avoid[OF \open s\ finite] \p\s\ unfolding avoid_def by auto + using finite_cball_avoid[OF \open S\ finite] \p\S\ unfolding avoid_def by auto have "\e2>0. cball p e2 \ ball p e1 \ cont ff p e2" when "p\pz" proof - define po where "po \ zorder f p" @@ -580,9 +539,10 @@ proof - have "isolated_singularity_at f p" proof - - have "f holomorphic_on ball p e1 - {p}" - apply (intro holomorphic_on_subset[OF f_holo]) - using e1_avoid \p\pz\ unfolding avoid_def pz_def by force + have "ball p e1 - {p} \ S - poles" + using avoid_def e1_avoid pz_def by fastforce + then have "f holomorphic_on ball p e1 - {p}" + by (intro holomorphic_on_subset[OF f_holo]) then show ?thesis unfolding isolated_singularity_at_def using \e1>0\ analytic_on_open open_delete by blast qed @@ -592,13 +552,13 @@ then show ?thesis unfolding not_essential_def by auto next case False - then have "p\s-poles" using \p\s\ poles unfolding pz_def by auto - moreover have "open (s-poles)" + then have "p\S-poles" using \p\S\ poles unfolding pz_def by auto + moreover have "open (S-poles)" proof - - have "closed (s \ poles)" + have "closed (S \ poles)" using finite by (simp add: pz_def finite_imp_closed rev_finite_subset subset_eq) then show ?thesis - by (metis Diff_Compl Diff_Diff_Int Diff_eq \open s\ open_Diff) + by (metis Diff_Compl Diff_Diff_Int Diff_eq \open S\ open_Diff) qed ultimately have "isCont f p" using holomorphic_on_imp_continuous_on[OF f_holo] continuous_on_eq_continuous_at @@ -611,17 +571,17 @@ then have "\\<^sub>F w in at p. f w= 0" unfolding frequently_def by auto then obtain r1 where "r1>0" and r1:"\w\ball p r1 - {p}. f w =0" unfolding eventually_at by (auto simp add:dist_commute) - obtain r2 where "r2>0" and r2: "ball p r2 \ s" - using \p\s\ \open s\ openE by blast + obtain r2 where "r2>0" and r2: "ball p r2 \ S" + using \p\S\ \open S\ openE by blast define rr where "rr=min r1 r2" from r1 r2 - have "ball p rr - {p} \ {w\ s \ ball p rr-{p}. f w=0}" + have "ball p rr - {p} \ {w\ S \ ball p rr-{p}. f w=0}" unfolding rr_def by auto moreover have "infinite (ball p rr - {p})" using \r1>0\ \r2>0\ finite_imp_not_open unfolding rr_def by fastforce - ultimately have "infinite {w\s \ ball p rr-{p}. f w=0}" using infinite_super by blast + ultimately have "infinite {w\S \ ball p rr-{p}. f w=0}" using infinite_super by blast then have "infinite pz" unfolding pz_def by (smt (verit) infinite_super Collect_mono_iff DiffE Int_iff) then show False using \finite pz\ by auto @@ -643,9 +603,9 @@ define prin where "prin \ \w. po * h w / (w - p)" have "((\w. prin w + anal w) has_contour_integral c * po * h p) (circlepath p e2)" proof (rule has_contour_integral_add[of _ _ _ _ 0,simplified]) - have "ball p r \ s" + have "ball p r \ S" using \r avoid_def ball_subset_cball e1_avoid by (simp add: subset_eq) - then have "cball p e2 \ s" + then have "cball p e2 \ S" using \r>0\ unfolding e2_def by auto then have "(\w. po * h w) holomorphic_on cball p e2" using h_holo by (auto intro!: holomorphic_intros) @@ -653,7 +613,7 @@ using Cauchy_integral_circlepath_simple[folded c_def, of "\w. po * h w"] \e2>0\ unfolding prin_def by (auto simp add: mult.assoc) have "anal holomorphic_on ball p r" unfolding anal_def - using pp_holo h_holo pp_po \ball p r \ s\ \pp p\0\ + using pp_holo h_holo pp_po \ball p r \ S\ \pp p\0\ by (auto intro!: holomorphic_intros) then show "(anal has_contour_integral 0) (circlepath p e2)" using e2_def \r>0\ @@ -677,11 +637,8 @@ by (auto intro!: derivative_eq_intros DERIV_cong[OF has_field_derivative_powr_of_int]) qed ultimately show "prin w + anal w = ff' w" - unfolding ff'_def prin_def anal_def - apply simp - apply (unfold f'_def) - apply (fold wp_def) - apply (auto simp add:field_simps) + unfolding f'_def ff'_def prin_def anal_def + apply (simp add: field_simps flip: wp_def) by (metis (no_types, lifting) mult.commute power_int_minus_mult) qed then have "cont ff p e2" unfolding cont_def @@ -693,12 +650,11 @@ show "f' holomorphic_on ball p r - {p}" unfolding f'_def using pp_holo by (auto intro!: holomorphic_intros) next - have "ball p e1 - {p} \ s - poles" + have "ball p e1 - {p} \ S - poles" using ball_subset_cball e1_avoid[unfolded avoid_def] unfolding pz_def by auto - then have "ball p r - {p} \ s - poles" - apply (elim dual_order.trans) - using \r by auto + then have "ball p r - {p} \ S - poles" + using \r by force then show "f holomorphic_on ball p r - {p}" using f_holo by auto next @@ -728,38 +684,38 @@ by (auto simp add: e2 e4_def) ultimately show ?thesis by auto qed - then obtain get_e where get_e:"\p\s. get_e p>0 \ avoid p (get_e p) + then obtain get_e where get_e:"\p\S. get_e p>0 \ avoid p (get_e p) \ (p\pz \ cont ff p (get_e p))" by metis define ci where "ci \ \p. contour_integral (circlepath p (get_e p)) ff" define w where "w \ \p. winding_number g p" have "contour_integral g ff = (\p\pz. w p * ci p)" unfolding ci_def w_def - proof (rule Cauchy_theorem_singularities[OF \open s\ \connected s\ finite _ \valid_path g\ loop + proof (rule Cauchy_theorem_singularities[OF \open S\ \connected S\ finite _ \valid_path g\ loop path_img homo]) - have "open (s - pz)" using open_Diff[OF _ finite_imp_closed[OF finite]] \open s\ by auto - then show "ff holomorphic_on s - pz" unfolding ff_def using f_holo h_holo + have "open (S - pz)" using open_Diff[OF _ finite_imp_closed[OF finite]] \open S\ by auto + then show "ff holomorphic_on S - pz" unfolding ff_def using f_holo h_holo by (auto intro!: holomorphic_intros simp add:pz_def) next - show "\p\s. 0 < get_e p \ (\w\cball p (get_e p). w \ s \ (w \ p \ w \ pz))" + show "\p\S. 0 < get_e p \ (\w\cball p (get_e p). w \ S \ (w \ p \ w \ pz))" using get_e using avoid_def by blast qed - also have "... = (\p\pz. c * w p * h p * zorder f p)" + also have "\ = (\p\pz. c * w p * h p * zorder f p)" proof (rule sum.cong[of pz pz,simplified]) fix p assume "p \ pz" show "w p * ci p = c * w p * h p * (zorder f p)" - proof (cases "p\s") - assume "p \ s" - have "ci p = c * h p * (zorder f p)" unfolding ci_def - apply (rule contour_integral_unique) - using get_e \p\s\ \p\pz\ unfolding cont_def by (metis mult.assoc mult.commute) + proof (cases "p\S") + assume "p \ S" + have "ci p = c * h p * (zorder f p)" + unfolding ci_def + using \p \ S\ \p \ pz\ cont_def contour_integral_unique get_e by fastforce thus ?thesis by auto next - assume "p\s" + assume "p\S" then have "w p=0" using homo unfolding w_def by auto then show ?thesis by auto qed qed - also have "... = c*(\p\pz. w p * h p * zorder f p)" + also have "\ = c*(\p\pz. w p * h p * zorder f p)" unfolding sum_distrib_left by (simp add:algebra_simps) finally have "contour_integral g ff = c * (\p\pz. w p * h p * of_int (zorder f p))" . then show ?thesis unfolding ff_def c_def w_def by simp @@ -945,7 +901,8 @@ proof - have "cmod (g p/f p) <1" by (smt (verit) divide_less_eq_1_pos norm_divide norm_ge_zero path_less that) - then show ?thesis unfolding h_def by (auto simp add:dist_complex_def) + then show ?thesis + unfolding h_def by (auto simp add:dist_complex_def) qed then have "path_image (h o \) \ ball 1 1" by (simp add: image_subset_iff path_image_compose) @@ -999,8 +956,7 @@ then have " ((/) 1 has_contour_integral 0) (h \ \) = ((\x. deriv h x / h x) has_contour_integral 0) \" unfolding has_contour_integral - apply (intro has_integral_spike_eq[OF negligible_finite, OF \finite spikes\]) - by auto + by (force intro!: has_integral_spike_eq[OF negligible_finite, OF \finite spikes\]) ultimately show ?thesis by auto qed then have "contour_integral \ (\x. deriv h x / h x) = 0" @@ -1010,8 +966,8 @@ proof - have "(\p. deriv f p / f p) contour_integrable_on \" proof (rule contour_integrable_holomorphic_simple[OF _ _ \valid_path \\ path_f]) - show "open (s - zeros_f)" using finite_imp_closed[OF \finite zeros_f\] \open s\ - by auto + show "open (s - zeros_f)" + using finite_imp_closed[OF \finite zeros_f\] \open s\ by auto then show "(\p. deriv f p / f p) holomorphic_on s - zeros_f" using f_holo by (auto intro!: holomorphic_intros simp add:zeros_f_def) @@ -1026,16 +982,15 @@ moreover have "deriv fg p / fg p = deriv f p / f p + deriv h p / h p" when "p\ path_image \" for p proof - - have "fg p\0" and "f p\0" using path_f path_fg that unfolding zeros_f_def zeros_fg_def - by auto - have "h p\0" + have "fg p \ 0" and "f p \ 0" + using path_f path_fg that unfolding zeros_f_def zeros_fg_def by auto + have "h p \ 0" proof (rule ccontr) assume "\ h p \ 0" - then have "g p / f p= -1" unfolding h_def by (simp add: add_eq_0_iff2) - then have "cmod (g p/f p) = 1" by auto - moreover have "cmod (g p/f p) <1" - by (simp add: \f p \ 0\ norm_divide path_less that) - ultimately show False by auto + then have "cmod (g p/f p) = 1" + by (simp add: add_eq_0_iff2 h_def) + then show False + by (smt (verit) divide_eq_1_iff norm_divide path_less that) qed have der_fg:"deriv fg p = deriv f p + deriv g p" unfolding fg_def using f_holo g_holo holomorphic_on_imp_differentiable_at[OF _ \open s\] path_img that @@ -1050,9 +1005,10 @@ then show ?thesis unfolding der_def using DERIV_imp_deriv by auto qed show ?thesis - apply (simp only:der_fg der_h) - apply (auto simp add:field_simps \h p\0\ \f p\0\ \fg p\0\) - by (auto simp add:field_simps h_def \f p\0\ fg_def) + using \h p\0\ \f p\0\ \fg p\0\ + unfolding der_fg der_h + apply (simp add: divide_simps h_def fg_def) + by (simp add: mult.commute mult.left_commute ring_class.ring_distribs(1)) qed then have "contour_integral \ (\p. deriv fg p / fg p) = contour_integral \ (\p. deriv f p / f p + deriv h p / h p)" @@ -1061,11 +1017,14 @@ qed moreover have "contour_integral \ (\x. deriv fg x / fg x) = c * (\p\zeros_fg. w p * zorder fg p)" proof - - have "fg holomorphic_on s" unfolding fg_def using f_holo g_holo holomorphic_on_add by auto + have "fg holomorphic_on s" + unfolding fg_def using f_holo g_holo holomorphic_on_add by auto moreover - have "path_image \ \ s - {p\s. fg p = 0}" using path_fg unfolding zeros_fg_def . + have "path_image \ \ s - {p\s. fg p = 0}" + using path_fg unfolding zeros_fg_def . moreover - have " finite {p\s. fg p = 0}" using \finite zeros_fg\ unfolding zeros_fg_def . + have " finite {p\s. fg p = 0}" + using \finite zeros_fg\ unfolding zeros_fg_def . ultimately show ?thesis unfolding c_def zeros_fg_def w_def using argument_principle[OF \open s\ \connected s\ _ _ \valid_path \\ loop _ homo, of _ "{}" "\_. 1"] @@ -1075,9 +1034,12 @@ unfolding c_def zeros_f_def w_def proof (rule argument_principle[OF \open s\ \connected s\ _ _ \valid_path \\ loop _ homo , of _ "{}" "\_. 1",simplified]) - show "f holomorphic_on s" using f_holo g_holo holomorphic_on_add by auto - show "path_image \ \ s - {p\s. f p = 0}" using path_f unfolding zeros_f_def . - show " finite {p\s. f p = 0}" using \finite zeros_f\ unfolding zeros_f_def . + show "f holomorphic_on s" + using f_holo g_holo holomorphic_on_add by auto + show "path_image \ \ s - {p\s. f p = 0}" + using path_f unfolding zeros_f_def . + show " finite {p\s. f p = 0}" + using \finite zeros_f\ unfolding zeros_f_def . qed ultimately have " c* (\p\zeros_fg. w p * (zorder fg p)) = c* (\p\zeros_f. w p * (zorder f p))" by auto diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Complex_Analysis/Riemann_Mapping.thy --- a/src/HOL/Complex_Analysis/Riemann_Mapping.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Complex_Analysis/Riemann_Mapping.thy Mon Sep 11 22:59:34 2023 +0200 @@ -62,10 +62,9 @@ then show ?thesis by auto qed show ?thesis - apply (simp add: Moebius_function_def) - apply (intro holomorphic_intros) - using assms * - by (metis complex_cnj_cnj complex_cnj_mult complex_cnj_one complex_mod_cnj mem_ball_0 mult.commute right_minus_eq) + unfolding Moebius_function_def + apply (intro holomorphic_intros) + by (metis "*" mult.commute complex_cnj_cnj complex_cnj_mult complex_cnj_one complex_mod_cnj mem_ball_0 right_minus_eq) qed lemma Moebius_function_compose: @@ -154,9 +153,7 @@ if "z \ ball 0 1" for z::complex proof (rule DERIV_chain' [where g=f]) show "(f has_field_derivative deriv f (of_real r * z)) (at (of_real r * z))" - apply (rule holomorphic_derivI [OF holF \open S\]) - apply (rule \f \ F\) - by (meson imageI r01 subset_iff that) + by (metis holomorphic_derivI [OF holF \open S\] \f \ F\ image_subset_iff r01 that) qed simp have df0: "((\w. f (r * w)) has_field_derivative deriv f 0 * r) (at 0)" using * [of 0] by simp @@ -170,16 +167,18 @@ qed define l where "l \ SUP h\F. norm (deriv h 0)" have eql: "norm (deriv f 0) = l" if le: "l \ norm (deriv f 0)" and "f \ F" for f - apply (rule order_antisym [OF _ le]) - using \f \ F\ bdd cSUP_upper by (fastforce simp: l_def) + proof (rule order_antisym [OF _ le]) + show "cmod (deriv f 0) \ l" + using \f \ F\ bdd cSUP_upper by (fastforce simp: l_def) + qed obtain \ where \in: "\n. \ n \ F" and \lim: "(\n. norm (deriv (\ n) 0)) \ l" proof - have "\f. f \ F \ \norm (deriv f 0) - l\ < 1 / (Suc n)" for n proof - obtain f where "f \ F" and f: "l < norm (deriv f 0) + 1/(Suc n)" - using cSup_least [OF imF_ne, of "l - 1/(Suc n)"] by (fastforce simp add: l_def) + using cSup_least [OF imF_ne, of "l - 1/(Suc n)"] by (fastforce simp: l_def) then have "\norm (deriv f 0) - l\ < 1 / (Suc n)" - by (fastforce simp add: abs_if not_less eql) + by (fastforce simp: abs_if not_less eql) with \f \ F\ show ?thesis by blast qed @@ -197,7 +196,7 @@ fix n assume "N \ n" have "dist (norm (deriv (\ n) 0)) l < 1 / (Suc n)" using fless by (simp add: dist_norm) - also have "... < e" + also have "\ < e" using N \N \ n\ inverse_of_nat_le le_less_trans by blast finally show "dist (norm (deriv (\ n) 0)) l < e" . qed @@ -230,18 +229,8 @@ with LIMSEQ_subseq_LIMSEQ [OF \lim r] have no_df0: "norm(deriv f 0) = l" by (force simp: o_def intro: tendsto_unique) have nonconstf: "\ f constant_on S" - proof - - have False if "\x. x \ S \ f x = c" for c - proof - - have "deriv f 0 = 0" - by (metis that \open S\ \0 \ S\ DERIV_imp_deriv [OF has_field_derivative_transform_within_open [OF DERIV_const]]) - with no_df0 have "l = 0" - by auto - with eql [OF _ idF] show False by auto - qed - then show ?thesis - by (meson constant_on_def) - qed + using \open S\ \0 \ S\ no_df0 holomorphic_nonconstant [OF holf] eql [OF _ idF] + by force show ?thesis proof show "f \ F" @@ -316,26 +305,14 @@ show "(\ \ g \ k) holomorphic_on (h \ f) ` S" proof (intro holomorphic_on_compose) show "k holomorphic_on (h \ f) ` S" - apply (rule holomorphic_on_subset [OF holk]) - using f01 h01 by force + using holomorphic_on_subset [OF holk] f01 h01 by force show "g holomorphic_on k ` (h \ f) ` S" - apply (rule holomorphic_on_subset [OF holg]) - by (auto simp: kh nf1) + using holomorphic_on_subset [OF holg] by (force simp: kh nf1) show "\ holomorphic_on g ` k ` (h \ f) ` S" - apply (rule holomorphic_on_subset [OF hol\]) - by (auto simp: gf kh nf1) + using holomorphic_on_subset [OF hol\] by (force simp: gf kh nf1) qed show "((\ \ g \ k) (h (f z)))\<^sup>2 = h (f z)" if "z \ S" for z - proof - - have "f z \ ball 0 1" - by (simp add: nf1 that) - then have "(\ (g (k (h (f z)))))\<^sup>2 = (\ (g (f z)))\<^sup>2" - by (metis kh) - also have "... = h (f z)" - using \2 gf that by auto - finally show ?thesis - by (simp add: o_def) - qed + using \2 gf kh nf1 that by fastforce qed qed have norm\1: "norm(\ (h (f z))) < 1" if "z \ S" for z @@ -359,18 +336,14 @@ show "p \ \ \ h \ f holomorphic_on S" proof (intro holomorphic_on_compose holf) show "h holomorphic_on f ` S" - apply (rule holomorphic_on_subset [OF holh]) - using f01 by force + using holomorphic_on_subset [OF holh] f01 by fastforce show "\ holomorphic_on h ` f ` S" - apply (rule holomorphic_on_subset [OF hol\]) - by auto + using holomorphic_on_subset [OF hol\] by fastforce show "p holomorphic_on \ ` h ` f ` S" - apply (rule holomorphic_on_subset [OF holp]) - by (auto simp: norm\1) + using holomorphic_on_subset [OF holp] by (simp add: image_subset_iff norm\1) qed show "(p \ \ \ h \ f) ` S \ ball 0 1" - apply clarsimp - by (meson norm\1 p01 image_subset_iff mem_ball_0) + using norm\1 p01 by fastforce show "(p \ \ \ h \ f) 0 = 0" by (simp add: \p (\ (h (f 0))) = 0\) show "inj_on (p \ \ \ h \ f) S" @@ -385,8 +358,8 @@ using holomorphic_on_subset holomorphic_on_power by (blast intro: holomorphic_on_ident) show "k holomorphic_on power2 ` q ` ball 0 1" - apply (rule holomorphic_on_subset [OF holk]) - using q01 by (auto simp: norm_power abs_square_less_1) + using q01 holomorphic_on_subset [OF holk] + by (force simp: norm_power abs_square_less_1) qed have 2: "(k \ power2 \ q) 0 = 0" using p0 F_def \f \ F\ \01 \2 \0 \ S\ kh qp by force @@ -442,12 +415,12 @@ then show "a \ f ` S" by blast qed - then have "f ` S = ball 0 1" + then have fS: "f ` S = ball 0 1" using F_def \f \ F\ by blast - then show ?thesis - apply (rule_tac x=f in exI) - apply (rule_tac x=g in exI) - using holf holg derg gf by safe force+ + then have "\z\ball 0 1. g z \ S \ f (g z) = z" + by (metis gf imageE) + with fS show ?thesis + by (metis gf holf holg image_eqI) qed @@ -526,7 +499,7 @@ qed (use \e > 0\ in auto) with \e > 0\ have "inverse (norm (y - x)) * norm (z - f x * (y - x)) \ e/2" by (simp add: field_split_simps) - also have "... < e" + also have "\ < e" using \e > 0\ by simp finally show ?thesis by (simp add: contour_integral_unique [OF z]) @@ -593,11 +566,10 @@ by (simp add: openS holf holomorphic_deriv holomorphic_on_divide nz) then obtain g where g: "\z. z \ S \ (g has_field_derivative deriv f z / f z) (at z)" using prev [of "\z. deriv f z / f z"] by metis + have Df: "\x. x \ S \ DERIV f x :> deriv f x" + using holf holomorphic_derivI openS by force have hfd: "\x. x \ S \ ((\z. exp (g z) / f z) has_field_derivative 0) (at x)" - apply (rule derivative_eq_intros g| simp)+ - apply (subst DERIV_deriv_iff_field_differentiable) - using openS holf holomorphic_on_imp_differentiable_at nz apply auto - done + by (rule derivative_eq_intros Df g nz| simp)+ obtain c where c: "\x. x \ S \ exp (g x) / f x = c" proof (rule DERIV_zero_connected_constant[OF \connected S\ openS finite.emptyI]) show "continuous_on S (\z. exp (g z) / f z)" @@ -607,9 +579,10 @@ qed auto show ?thesis proof (intro exI ballI conjI) - show "(\z. Ln(inverse c) + g z) holomorphic_on S" - apply (intro holomorphic_intros) + have "g holomorphic_on S" using openS g holomorphic_on_open by blast + then show "(\z. Ln(inverse c) + g z) holomorphic_on S" + by (intro holomorphic_intros) fix z :: complex assume "z \ S" then have "exp (g z) / c = f z" @@ -675,18 +648,14 @@ by blast then obtain w where w: "- g z = g w" "dist a w < \" by auto - then have "w \ ball a \" - by simp - then have "w \ S" - using \ by blast + with \ have "w \ S" + by force then have "w = z" by (metis diff_add_cancel eqg power_minus_Bit0 that w(1)) then have "g z = 0" using \- g z = g w\ by auto - with eqg [OF that] have "z = b" - by auto - with that \b \ S\ show False - by simp + with eqg that \b \ S\ show False + by force qed then have nz: "\z. z \ S \ g z + g a \ 0" by (metis \0 < r\ add.commute add_diff_cancel_left' centre_in_ball diff_0) @@ -723,23 +692,11 @@ if holf: "f holomorphic_on h ` S" and nz: "\z. z \ h ` S \ f z \ 0" "inj_on f (h ` S)" for f proof - obtain g where holg: "g holomorphic_on S" and eqg: "\z. z \ S \ (f \ h) z = (g z)\<^sup>2" - proof - - have "f \ h holomorphic_on S" - by (simp add: holh holomorphic_on_compose holf) - moreover have "\z\S. (f \ h) z \ 0" - by (simp add: nz) - ultimately show thesis - using prev that by blast - qed + by (smt (verit) comp_def holf holh holomorphic_on_compose image_eqI nz(1) prev) show ?thesis proof (intro exI conjI) show "g \ k holomorphic_on h ` S" - proof - - have "k ` h ` S \ S" - by (simp add: \\z. z \ S \ k (h z) = z\ image_subset_iff) - then show ?thesis - by (meson holg holk holomorphic_on_compose holomorphic_on_subset) - qed + by (smt (verit) holg holk holomorphic_on_compose holomorphic_on_subset imageE image_subset_iff kh) show "\z\h ` S. f z = ((g \ k) z)\<^sup>2" using eqg kh by auto qed @@ -845,10 +802,15 @@ corollary contractible_eq_simply_connected_2d: fixes S :: "complex set" - shows "open S \ (contractible S \ simply_connected S)" - apply safe - apply (simp add: contractible_imp_simply_connected) - using convex_imp_contractible homeomorphic_contractible_eq simply_connected_eq_homeomorphic_to_disc by auto + assumes "open S" + shows "contractible S \ simply_connected S" +proof + show "contractible S \ simply_connected S" + by (simp add: contractible_imp_simply_connected) + show "simply_connected S \ contractible S" + using assms convex_imp_contractible homeomorphic_contractible_eq + simply_connected_eq_homeomorphic_to_disc by auto +qed subsection\A further chain of equivalences about components of the complement of a simply connected set\ @@ -867,9 +829,7 @@ then show ?thesis proof assume "S = {}" - then have "bounded S" - by simp - with \S = {}\ show ?thesis + then show ?thesis by simp next assume S01: "S homeomorphic ball (0::complex) 1" @@ -889,12 +849,11 @@ by (simp add: X_def) have Xsubclo: "X n \ closure S" for n unfolding X_def by (metis A01 closure_mono fim image_mono) - have connX: "connected(X n)" for n + have "connected (A n)" for n + using connected_annulus [of _ "0::complex"] by (simp add: A_def) + then have connX: "connected(X n)" for n unfolding X_def - apply (rule connected_imp_connected_closure) - apply (rule connected_continuous_image) - apply (simp add: continuous_on_subset [OF contf A01]) - using connected_annulus [of _ "0::complex"] by (simp add: A_def) + by (metis A01 connected_continuous_image connected_imp_connected_closure contf continuous_on_subset) have nestX: "X n \ X m" if "m \ n" for m n proof - have "1 - 1 / (real m + 2) \ 1 - 1 / (real n + 2)" @@ -923,22 +882,13 @@ have *: "(f ` cball 0 (1 - 1 / (real n + 2))) \ S" by (force simp: D_def Seq) show "x \ X n" - using \x \ closure S\ unfolding X_def Seq - using \x \ S\ * D_def clo_fim by auto + using Seq X_def \x \ closure S\ \x \ S\ clo_fim by fastforce qed qed moreover have "(\n. X n) \ closure S - S" proof - have "(\n. X n) \ closure S" - proof - - have "(\n. X n) \ X 0" - by blast - also have "... \ closure S" - apply (simp add: X_def fim [symmetric]) - apply (rule closure_mono) - by (auto simp: A_def) - finally show "(\n. X n) \ closure S" . - qed + using Xsubclo by blast moreover have "(\n. X n) \ S \ {}" proof (clarify, clarsimp simp: X_def fim [symmetric]) fix x assume x [rule_format]: "\n. f x \ closure (f ` A n)" and "cmod x < 1" @@ -984,13 +934,9 @@ proof (cases "bounded S") case True have bouX: "bounded (X n)" for n - apply (simp add: X_def) - apply (rule bounded_closure) - by (metis A01 fim image_mono bounded_subset [OF True]) + by (meson True Xsubclo bounded_closure bounded_subset) have compaX: "compact (X n)" for n - apply (simp add: compact_eq_bounded_closed bouX) - apply (auto simp: X_def) - done + by (simp add: bouX cloX compact_eq_bounded_closed) have "connected (\n. X n)" by (metis nestX compaX connX connected_nest) then show ?thesis @@ -1085,10 +1031,8 @@ by (simp add: j_def \finite J\) have "\ ((\n. X n \ closure U) ` J) = X j \ closure U" using False jmax nestX \j \ J\ by auto - then have "X j \ closure U = X j \ U" - apply safe - using DiffI J empty apply auto[1] - using closure_subset by blast + then have XU: "X j \ closure U = X j \ U" + using J closure_subset empty by fastforce then have "openin (top_of_set (X j)) (X j \ closure U)" by (simp add: openin_open_Int \open U\) moreover have "closedin (top_of_set (X j)) (X j \ closure U)" @@ -1096,13 +1040,7 @@ moreover have "X j \ closure U \ X j" by (metis unboundedX \compact (closure U)\ bounded_subset compact_eq_bounded_closed inf.order_iff) moreover have "X j \ closure U \ {}" - proof - - have "C \ {}" - using C in_components_nonempty by blast - moreover have "C \ X j \ closure U" - using \C \ K\ \K \ U\ Ksub closure_subset by blast - ultimately show ?thesis by blast - qed + by (metis Cco Ksub UNIV_I \C \ K\ \K \ U\ XU bot.extremum_uniqueI in_components_maximal le_INF_iff le_inf_iff) ultimately show False using connX [of j] by (force simp: connected_clopen) qed @@ -1115,7 +1053,7 @@ have "x \ V" using \U \ V = {}\ \open V\ closure_iff_nhds_not_empty that(2) by blast then show ?thesis - by (metis (no_types) Diff_iff INT_I V \K \ U\ contra_subsetD that(1)) + by (metis (no_types) Diff_iff INT_I V \K \ U\ subsetD that(1)) qed ultimately show False by (auto simp: open_Int_closure_eq_empty [OF \open V\, of U]) @@ -1160,8 +1098,11 @@ proof - have "C \ frontier S = {}" using that by (simp add: C_ccsw) - then show False - by (metis C_ccsw ComplI Compl_eq_Compl_iff Diff_subset False \w \ S\ clo_ccs closure_closed compl_bot_eq connected_component_eq_UNIV connected_component_eq_empty empty_subsetI frontier_complement frontier_def frontier_not_empty frontier_of_connected_component_subset le_inf_iff subset_antisym) + moreover have "closed C" + using C_ccsw clo_ccs by blast + ultimately show False + by (metis C False \S \ UNIV\ C_ccsw bot_eq_sup_iff connected_component_eq_UNIV frontier_Int_closed + frontier_closed frontier_complement frontier_eq_empty frontier_of_components_subset in_components_maximal inf.orderE) qed then show "connected_component_set (- S) w \ frontier S \ {}" by auto @@ -1176,15 +1117,13 @@ have "\ bounded (-S)" by (simp add: True cobounded_imp_unbounded) then have "connected_component_set (- S) z \ {}" - apply (simp only: connected_component_eq_empty) + unfolding connected_component_eq_empty using confr openS \bounded C\ \w \ S\ apply (simp add: frontier_def interior_open C_ccsw) by (metis ComplI Compl_eq_Diff_UNIV connected_UNIV closed_closure closure_subset connected_component_eq_self connected_diff_open_from_closed subset_UNIV) then show "frontier (connected_component_set (- S) z) \ {}" - apply (simp add: frontier_eq_empty connected_component_eq_UNIV) - apply (metis False compl_top_eq double_compl) - done + by (metis False \S \ UNIV\ connected_component_eq_UNIV frontier_complement frontier_eq_empty) qed then show "connected_component_set (- S) z \ frontier S \ {}" by auto @@ -1205,15 +1144,14 @@ by (metis C C_ccsw False bounded_empty compl_top_eq connected_component_eq_UNIV double_compl frontier_not_empty in_components_nonempty) ultimately obtain z where zin: "z \ frontier S" and z: "z \ connected_component_set (- S) w" by blast - have *: "connected_component_set (frontier S) z \ components(frontier S)" + have "connected_component_set (frontier S) z \ components(frontier S)" by (simp add: \z \ frontier S\ componentsI) with prev False have "\ bounded (connected_component_set (frontier S) z)" by simp moreover have "connected_component (- S) w = connected_component (- S) z" using connected_component_eq [OF z] by force ultimately show ?thesis - by (metis C_ccsw * zin bounded_subset closed_Compl closure_closed connected_component_maximal - connected_component_refl connected_connected_component frontier_closures in_components_subset le_inf_iff mem_Collect_eq openS) + by (metis C_ccsw SC_Chain.openS SC_Chain_axioms bounded_subset closed_Compl connected_component_mono frontier_complement frontier_subset_eq) qed lemma empty_inside: @@ -1245,7 +1183,8 @@ interpret SC_Chain using assms by (simp add: SC_Chain_def) have "?fp \ ?ucc \ ?ei" - using empty_inside empty_inside_imp_simply_connected frontier_properties unbounded_complement_components winding_number_zero by blast + using empty_inside empty_inside_imp_simply_connected frontier_properties + unbounded_complement_components winding_number_zero by blast then show ?fp ?ucc ?ei by blast+ qed @@ -1253,16 +1192,20 @@ lemma simply_connected_iff_simple: fixes S :: "complex set" assumes "open S" "bounded S" - shows "simply_connected S \ connected S \ connected(- S)" - apply (simp add: simply_connected_eq_unbounded_complement_components assms, safe) - apply (metis DIM_complex assms(2) cobounded_has_bounded_component double_compl order_refl) - by (meson assms inside_bounded_complement_connected_empty simply_connected_eq_empty_inside simply_connected_eq_unbounded_complement_components) + shows "simply_connected S \ connected S \ connected(- S)" (is "?lhs = ?rhs") +proof + show "?lhs \ ?rhs" + by (metis DIM_complex assms cobounded_has_bounded_component double_complement dual_order.order_iff_strict + simply_connected_eq_unbounded_complement_components) + show "?rhs \ ?lhs" + by (simp add: assms connected_frontier_simple simply_connected_eq_frontier_properties) +qed lemma subset_simply_connected_imp_inside_subset: fixes A :: "complex set" assumes "simply_connected A" "open A" "B \ A" shows "inside B \ A" -by (metis assms Diff_eq_empty_iff inside_mono subset_empty simply_connected_eq_empty_inside) + by (metis assms Diff_eq_empty_iff inside_mono subset_empty simply_connected_eq_empty_inside) subsection\Further equivalences based on continuous logs and sqrts\ @@ -1305,7 +1248,7 @@ lemma continuous_sqrt: fixes f :: "complex\complex" assumes contf: "continuous_on S f" and nz: "\z. z \ S \ f z \ 0" - and prev: "\f::complex\complex. + and prev: "\f::complex\complex. \continuous_on S f; \z. z \ S \ f z \ 0\ \ \g. continuous_on S g \ (\z \ S. f z = exp(g z))" shows "\g. continuous_on S g \ (\z \ S. f z = (g z)\<^sup>2)" @@ -1313,8 +1256,8 @@ obtain g where contg: "continuous_on S g" and geq: "\z. z \ S \ f z = exp(g z)" using contf nz prev by metis show ?thesis -proof (intro exI ballI conjI) - show "continuous_on S (\z. exp(g z/2))" + proof (intro exI ballI conjI) + show "continuous_on S (\z. exp(g z/2))" by (intro continuous_intros) (auto simp: contg) show "\z. z \ S \ f z = (exp (g z/2))\<^sup>2" by (metis (no_types, lifting) divide_inverse exp_double geq mult.left_commute mult.right_neutral right_inverse zero_neq_numeral) @@ -1343,12 +1286,14 @@ using contg [unfolded continuous_on_iff] by (metis \g z \ 0\ \z \ S\ zero_less_norm_iff) then have \: "\w. \w \ S; w \ ball z \\ \ g w + g z \ 0" apply (clarsimp simp: dist_norm) - by (metis \g z \ 0\ add_diff_cancel_left' diff_0_right norm_eq_zero norm_increases_online norm_minus_commute norm_not_less_zero not_less_iff_gr_or_eq) + by (metis add_diff_cancel_left' dist_0_norm dist_complex_def less_le_not_le norm_increases_online norm_minus_commute) have *: "(\x. (f x - f z) / (x - z) / (g x + g z)) \z\ deriv f z / (g z + g z)" - apply (intro tendsto_intros) - using SC_Chain.openS SC_Chain_axioms \f holomorphic_on S\ \z \ S\ has_field_derivativeD holomorphic_derivI apply fastforce - using \z \ S\ contg continuous_on_eq_continuous_at isCont_def openS apply blast - by (simp add: \g z \ 0\) + proof (intro tendsto_intros) + show "(\x. (f x - f z) / (x - z)) \z\ deriv f z" + using \f holomorphic_on S\ \z \ S\ has_field_derivative_iff holomorphic_derivI openS by blast + show "g \z\ g z" + using \z \ S\ contg continuous_on_eq_continuous_at isCont_def openS by blast + qed (simp add: \g z \ 0\) then have "(g has_field_derivative deriv f z / (g z + g z)) (at z)" unfolding has_field_derivative_iff proof (rule Lim_transform_within_open) @@ -1386,20 +1331,9 @@ proof - interpret SC_Chain using assms by (simp add: SC_Chain_def) - have "?log \ ?sqrt" -proof - - have *: "\\ \ \; \ \ \; \ \ \\ - \ (\ \ \) \ (\ \ \)" for \ \ \ - by blast - show ?thesis - apply (rule *) - apply (simp add: local.continuous_log winding_number_zero) - apply (simp add: continuous_sqrt) - apply (simp add: continuous_sqrt_imp_simply_connected) - done -qed - then show ?log ?sqrt - by safe + show ?log ?sqrt + using local.continuous_log winding_number_zero continuous_sqrt continuous_sqrt_imp_simply_connected + by auto qed @@ -1550,21 +1484,24 @@ apply (clarsimp simp add: path_image_subpath_gen) by (metis subsetD le_less_trans \dist u t < d\ d dist_commute dist_in_closed_segment) have *: "path (g \ subpath t u p)" - apply (rule path_continuous_image) - using \path p\ t that apply auto[1] - using piB contg continuous_on_subset by blast + proof (rule path_continuous_image) + show "path (subpath t u p)" + using \path p\ t that by auto + show "continuous_on (path_image (subpath t u p)) g" + using piB contg continuous_on_subset by blast + qed have "(g (subpath t u p 1) - g (subpath t u p 0)) / (2 * of_real pi * \) = winding_number (exp \ g \ subpath t u p) 0" using winding_number_compose_exp [OF *] by (simp add: pathfinish_def pathstart_def o_assoc) - also have "... = winding_number (\w. subpath t u p w - \) 0" + also have "\ = winding_number (\w. subpath t u p w - \) 0" proof (rule winding_number_cong) have "exp(g y) = y - \" if "y \ (subpath t u p) ` {0..1}" for y by (metis that geq path_image_def piB subset_eq) then show "\x. \0 \ x; x \ 1\ \ (exp \ g \ subpath t u p) x = subpath t u p x - \" by auto qed - also have "... = winding_number (\w. subpath 0 u p w - \) 0 - + also have "\ = winding_number (\w. subpath 0 u p w - \) 0 - winding_number (\w. subpath 0 t p w - \) 0" apply (simp add: winding_number_offset [symmetric]) using winding_number_subpath_combine [OF \path p\ \, of 0 t u] \t \ {0..1}\ \u \ {0..1}\ @@ -1637,9 +1574,8 @@ then obtain a where "homotopic_loops (-{\}) p (\t. a)" .. then have "winding_number p \ = winding_number (\t. a) \" "a \ \" using winding_number_homotopic_loops homotopic_loops_imp_subset by (force simp:)+ - moreover have "winding_number (\t. a) \ = 0" - by (metis winding_number_zero_const \a \ \\) - ultimately show ?lhs by metis + then show ?lhs + using winding_number_zero_const by auto qed lemma winding_number_homotopic_paths_null_explicit_eq: @@ -1650,7 +1586,7 @@ assume ?lhs then show ?rhs using homotopic_loops_imp_homotopic_paths_null - by (force simp add: linepath_refl winding_number_homotopic_loops_null_eq [OF assms]) + by (force simp: linepath_refl winding_number_homotopic_loops_null_eq [OF assms]) next assume ?rhs then show ?lhs @@ -1688,7 +1624,7 @@ using winding_number_homotopic_paths_null_explicit_eq by blast then show ?rhs using homotopic_paths_imp_pathstart assms - by (fastforce simp add: dest: homotopic_paths_imp_homotopic_loops homotopic_paths_loop_parts) + by (fastforce simp: dest: homotopic_paths_imp_homotopic_loops homotopic_paths_loop_parts) qed (simp add: winding_number_homotopic_paths) lemma winding_number_homotopic_loops_eq: diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Data_Structures/Array_Braun.thy --- a/src/HOL/Data_Structures/Array_Braun.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Data_Structures/Array_Braun.thy Mon Sep 11 22:59:34 2023 +0200 @@ -3,50 +3,49 @@ section "Arrays via Braun Trees" theory Array_Braun -imports - Array_Specs - Braun_Tree + imports + Array_Specs + Braun_Tree begin subsection "Array" fun lookup1 :: "'a tree \ nat \ 'a" where -"lookup1 (Node l x r) n = (if n=1 then x else lookup1 (if even n then l else r) (n div 2))" + "lookup1 (Node l x r) n = (if n=1 then x else lookup1 (if even n then l else r) (n div 2))" fun update1 :: "nat \ 'a \ 'a tree \ 'a tree" where -"update1 n x Leaf = Node Leaf x Leaf" | -"update1 n x (Node l a r) = + "update1 n x Leaf = Node Leaf x Leaf" | + "update1 n x (Node l a r) = (if n=1 then Node l x r else if even n then Node (update1 (n div 2) x l) a r else Node l a (update1 (n div 2) x r))" fun adds :: "'a list \ nat \ 'a tree \ 'a tree" where -"adds [] n t = t" | -"adds (x#xs) n t = adds xs (n+1) (update1 (n+1) x t)" + "adds [] n t = t" | + "adds (x#xs) n t = adds xs (n+1) (update1 (n+1) x t)" fun list :: "'a tree \ 'a list" where -"list Leaf = []" | -"list (Node l x r) = x # splice (list l) (list r)" + "list Leaf = []" | + "list (Node l x r) = x # splice (list l) (list r)" subsubsection "Functional Correctness" lemma size_list: "size(list t) = size t" -by(induction t)(auto) + by(induction t)(auto) lemma minus1_div2: "(n - Suc 0) div 2 = (if odd n then n div 2 else n div 2 - 1)" -by auto arith + by auto arith lemma nth_splice: "\ n < size xs + size ys; size ys \ size xs; size xs \ size ys + 1 \ \ splice xs ys ! n = (if even n then xs else ys) ! (n div 2)" -apply(induction xs ys arbitrary: n rule: splice.induct) -apply (auto simp: nth_Cons' minus1_div2) -done +proof(induction xs ys arbitrary: n rule: splice.induct) +qed (auto simp: nth_Cons' minus1_div2) lemma div2_in_bounds: "\ braun (Node l x r); n \ {1..size(Node l x r)}; n > 1 \ \ (odd n \ n div 2 \ {1..size r}) \ (even n \ n div 2 \ {1..size l})" -by auto arith + by auto arith declare upt_Suc[simp del] @@ -63,7 +62,7 @@ qed lemma list_eq_map_lookup1: "braun t \ list t = map (lookup1 t) [1..\<^const>\update1\\ @@ -96,18 +95,18 @@ qed lemma list_update1: "\ braun t; n \ {1.. size t} \ \ list(update1 n x t) = (list t)[n-1 := x]" -by(auto simp add: list_eq_map_lookup1 list_eq_iff_nth_eq lookup1_update1 size_update1 braun_update1) + by(auto simp add: list_eq_map_lookup1 list_eq_iff_nth_eq lookup1_update1 size_update1 braun_update1) text \A second proof of @{thm list_update1}:\ lemma diff1_eq_iff: "n > 0 \ n - Suc 0 = m \ n = m+1" -by arith + by arith lemma list_update_splice: "\ n < size xs + size ys; size ys \ size xs; size xs \ size ys + 1 \ \ (splice xs ys) [n := x] = (if even n then splice (xs[n div 2 := x]) ys else splice xs (ys[n div 2 := x]))" -by(induction xs ys arbitrary: n rule: splice.induct) (auto split: nat.split) + by(induction xs ys arbitrary: n rule: splice.induct) (auto split: nat.split) lemma list_update2: "\ braun t; n \ {1.. size t} \ \ list(update1 n x t) = (list t)[n-1 := x]" proof(induction t arbitrary: n) @@ -122,35 +121,35 @@ lemma splice_last: shows "size ys \ size xs \ splice (xs @ [x]) ys = splice xs ys @ [x]" -and "size ys+1 \ size xs \ splice xs (ys @ [y]) = splice xs ys @ [y]" -by(induction xs ys arbitrary: x y rule: splice.induct) (auto) + and "size ys+1 \ size xs \ splice xs (ys @ [y]) = splice xs ys @ [y]" + by(induction xs ys arbitrary: x y rule: splice.induct) (auto) lemma list_add_hi: "braun t \ list(update1 (Suc(size t)) x t) = list t @ [x]" -by(induction t)(auto simp: splice_last size_list) + by(induction t)(auto simp: splice_last size_list) lemma size_add_hi: "braun t \ m = size t \ size(update1 (Suc m) x t) = size t + 1" -by(induction t arbitrary: m)(auto) + by(induction t arbitrary: m)(auto) lemma braun_add_hi: "braun t \ braun(update1 (Suc(size t)) x t)" -by(induction t)(auto simp: size_add_hi) + by(induction t)(auto simp: size_add_hi) lemma size_braun_adds: "\ braun t; size t = n \ \ size(adds xs n t) = size t + length xs \ braun (adds xs n t)" -by(induction xs arbitrary: t n)(auto simp: braun_add_hi size_add_hi) + by(induction xs arbitrary: t n)(auto simp: braun_add_hi size_add_hi) lemma list_adds: "\ braun t; size t = n \ \ list(adds xs n t) = list t @ xs" -by(induction xs arbitrary: t n)(auto simp: size_braun_adds list_add_hi size_add_hi braun_add_hi) + by(induction xs arbitrary: t n)(auto simp: size_braun_adds list_add_hi size_add_hi braun_add_hi) subsubsection "Array Implementation" interpretation A: Array -where lookup = "\(t,l) n. lookup1 t (n+1)" -and update = "\n x (t,l). (update1 (n+1) x t, l)" -and len = "\(t,l). l" -and array = "\xs. (adds xs 0 Leaf, length xs)" -and invar = "\(t,l). braun t \ l = size t" -and list = "\(t,l). list t" + where lookup = "\(t,l) n. lookup1 t (n+1)" + and update = "\n x (t,l). (update1 (n+1) x t, l)" + and len = "\(t,l). l" + and array = "\xs. (adds xs 0 Leaf, length xs)" + and invar = "\(t,l). braun t \ l = size t" + and list = "\(t,l). list t" proof (standard, goal_cases) case 1 thus ?case by (simp add: nth_list_lookup1 split: prod.splits) next @@ -169,20 +168,20 @@ subsection "Flexible Array" fun add_lo where -"add_lo x Leaf = Node Leaf x Leaf" | -"add_lo x (Node l a r) = Node (add_lo a r) x l" + "add_lo x Leaf = Node Leaf x Leaf" | + "add_lo x (Node l a r) = Node (add_lo a r) x l" fun merge where -"merge Leaf r = r" | -"merge (Node l a r) rr = Node rr a (merge l r)" + "merge Leaf r = r" | + "merge (Node l a r) rr = Node rr a (merge l r)" fun del_lo where -"del_lo Leaf = Leaf" | -"del_lo (Node l a r) = merge l r" + "del_lo Leaf = Leaf" | + "del_lo (Node l a r) = merge l r" fun del_hi :: "nat \ 'a tree \ 'a tree" where -"del_hi n Leaf = Leaf" | -"del_hi n (Node l x r) = + "del_hi n Leaf = Leaf" | + "del_hi n (Node l x r) = (if n = 1 then Leaf else if even n then Node (del_hi (n div 2) l) x r @@ -195,58 +194,56 @@ paragraph \\<^const>\add_lo\\ lemma list_add_lo: "braun t \ list (add_lo a t) = a # list t" -by(induction t arbitrary: a) auto + by(induction t arbitrary: a) auto lemma braun_add_lo: "braun t \ braun(add_lo x t)" -by(induction t arbitrary: x) (auto simp add: list_add_lo simp flip: size_list) + by(induction t arbitrary: x) (auto simp add: list_add_lo simp flip: size_list) paragraph \\<^const>\del_lo\\ lemma list_merge: "braun (Node l x r) \ list(merge l r) = splice (list l) (list r)" -by (induction l r rule: merge.induct) auto + by (induction l r rule: merge.induct) auto lemma braun_merge: "braun (Node l x r) \ braun(merge l r)" -by (induction l r rule: merge.induct)(auto simp add: list_merge simp flip: size_list) + by (induction l r rule: merge.induct)(auto simp add: list_merge simp flip: size_list) lemma list_del_lo: "braun t \ list(del_lo t) = tl (list t)" -by (cases t) (simp_all add: list_merge) + by (cases t) (simp_all add: list_merge) lemma braun_del_lo: "braun t \ braun(del_lo t)" -by (cases t) (simp_all add: braun_merge) + by (cases t) (simp_all add: braun_merge) paragraph \\<^const>\del_hi\\ lemma list_Nil_iff: "list t = [] \ t = Leaf" -by(cases t) simp_all + by(cases t) simp_all lemma butlast_splice: "butlast (splice xs ys) = (if size xs > size ys then splice (butlast xs) ys else splice xs (butlast ys))" -by(induction xs ys rule: splice.induct) (auto) + by(induction xs ys rule: splice.induct) (auto) lemma list_del_hi: "braun t \ size t = st \ list(del_hi st t) = butlast(list t)" -apply(induction t arbitrary: st) -by(auto simp: list_Nil_iff size_list butlast_splice) + by (induction t arbitrary: st) (auto simp: list_Nil_iff size_list butlast_splice) lemma braun_del_hi: "braun t \ size t = st \ braun(del_hi st t)" -apply(induction t arbitrary: st) -by(auto simp: list_del_hi simp flip: size_list) + by (induction t arbitrary: st) (auto simp: list_del_hi simp flip: size_list) subsubsection "Flexible Array Implementation" interpretation AF: Array_Flex -where lookup = "\(t,l) n. lookup1 t (n+1)" -and update = "\n x (t,l). (update1 (n+1) x t, l)" -and len = "\(t,l). l" -and array = "\xs. (adds xs 0 Leaf, length xs)" -and invar = "\(t,l). braun t \ l = size t" -and list = "\(t,l). list t" -and add_lo = "\x (t,l). (add_lo x t, l+1)" -and del_lo = "\(t,l). (del_lo t, l-1)" -and add_hi = "\x (t,l). (update1 (Suc l) x t, l+1)" -and del_hi = "\(t,l). (del_hi l t, l-1)" + where lookup = "\(t,l) n. lookup1 t (n+1)" + and update = "\n x (t,l). (update1 (n+1) x t, l)" + and len = "\(t,l). l" + and array = "\xs. (adds xs 0 Leaf, length xs)" + and invar = "\(t,l). braun t \ l = size t" + and list = "\(t,l). list t" + and add_lo = "\x (t,l). (add_lo x t, l+1)" + and del_lo = "\(t,l). (del_lo t, l-1)" + and add_hi = "\x (t,l). (update1 (Suc l) x t, l+1)" + and del_hi = "\(t,l). (del_hi l t, l-1)" proof (standard, goal_cases) case 1 thus ?case by (simp add: list_add_lo split: prod.splits) next @@ -272,37 +269,37 @@ subsubsection \Size\ fun diff :: "'a tree \ nat \ nat" where -"diff Leaf _ = 0" | -"diff (Node l x r) n = (if n=0 then 1 else if even n then diff r (n div 2 - 1) else diff l (n div 2))" + "diff Leaf _ = 0" | + "diff (Node l x r) n = (if n=0 then 1 else if even n then diff r (n div 2 - 1) else diff l (n div 2))" fun size_fast :: "'a tree \ nat" where -"size_fast Leaf = 0" | -"size_fast (Node l x r) = (let n = size_fast r in 1 + 2*n + diff l n)" + "size_fast Leaf = 0" | + "size_fast (Node l x r) = (let n = size_fast r in 1 + 2*n + diff l n)" declare Let_def[simp] lemma diff: "braun t \ size t : {n, n + 1} \ diff t n = size t - n" -by(induction t arbitrary: n) auto + by (induction t arbitrary: n) auto lemma size_fast: "braun t \ size_fast t = size t" -by(induction t) (auto simp add: diff) + by (induction t) (auto simp add: diff) subsubsection \Initialization with 1 element\ fun braun_of_naive :: "'a \ nat \ 'a tree" where -"braun_of_naive x n = (if n=0 then Leaf + "braun_of_naive x n = (if n=0 then Leaf else let m = (n-1) div 2 in if odd n then Node (braun_of_naive x m) x (braun_of_naive x m) else Node (braun_of_naive x (m + 1)) x (braun_of_naive x m))" fun braun2_of :: "'a \ nat \ 'a tree * 'a tree" where -"braun2_of x n = (if n = 0 then (Leaf, Node Leaf x Leaf) + "braun2_of x n = (if n = 0 then (Leaf, Node Leaf x Leaf) else let (s,t) = braun2_of x ((n-1) div 2) in if odd n then (Node s x s, Node t x s) else (Node t x s, Node t x t))" definition braun_of :: "'a \ nat \ 'a tree" where -"braun_of x n = fst (braun2_of x n)" + "braun_of x n = fst (braun2_of x n)" declare braun2_of.simps [simp del] @@ -325,10 +322,10 @@ qed corollary braun_braun_of: "braun(braun_of x n)" -unfolding braun_of_def by (metis eq_fst_iff braun2_of_size_braun) + unfolding braun_of_def by (metis eq_fst_iff braun2_of_size_braun) corollary list_braun_of: "list(braun_of x n) = replicate n x" -unfolding braun_of_def by (metis eq_fst_iff braun2_of_replicate) + unfolding braun_of_def by (metis eq_fst_iff braun2_of_replicate) subsubsection "Proof Infrastructure" @@ -338,8 +335,8 @@ paragraph \\take_nths\\ fun take_nths :: "nat \ nat \ 'a list \ 'a list" where -"take_nths i k [] = []" | -"take_nths i k (x # xs) = (if i = 0 then x # take_nths (2^k - 1) k xs + "take_nths i k [] = []" | + "take_nths i k (x # xs) = (if i = 0 then x # take_nths (2^k - 1) k xs else take_nths (i - 1) k xs)" text \This is the more concise definition but seems to complicate the proofs:\ @@ -353,60 +350,62 @@ show ?case proof cases assume [simp]: "i = 0" - have "(\n. {(n+1) * 2 ^ k - 1}) = {m. \n. Suc m = n * 2 ^ k}" - apply (auto simp del: mult_Suc) + have "\x n. Suc x = n * 2 ^ k \ \xa. x = Suc xa * 2 ^ k - Suc 0" by (metis diff_Suc_Suc diff_zero mult_eq_0_iff not0_implies_Suc) + then have "(\n. {(n+1) * 2 ^ k - 1}) = {m. \n. Suc m = n * 2 ^ k}" + by (auto simp del: mult_Suc) thus ?thesis by (simp add: Cons.IH ac_simps nths_Cons) next assume [arith]: "i \ 0" - have "(\n. {n * 2 ^ k + i - 1}) = {m. \n. Suc m = n * 2 ^ k + i}" - apply auto + have "\x n. Suc x = n * 2 ^ k + i \ \xa. x = xa * 2 ^ k + i - Suc 0" by (metis diff_Suc_Suc diff_zero) + then have "(\n. {n * 2 ^ k + i - 1}) = {m. \n. Suc m = n * 2 ^ k + i}" + by auto thus ?thesis by (simp add: Cons.IH nths_Cons) qed qed lemma take_nths_drop: "take_nths i k (drop j xs) = take_nths (i + j) k xs" -by (induct xs arbitrary: i j; simp add: drop_Cons split: nat.split) + by (induct xs arbitrary: i j; simp add: drop_Cons split: nat.split) lemma take_nths_00: "take_nths 0 0 xs = xs" -by (induct xs; simp) + by (induct xs; simp) lemma splice_take_nths: "splice (take_nths 0 (Suc 0) xs) (take_nths (Suc 0) (Suc 0) xs) = xs" -by (induct xs; simp) + by (induct xs; simp) lemma take_nths_take_nths: "take_nths i m (take_nths j n xs) = take_nths ((i * 2^n) + j) (m + n) xs" -by (induct xs arbitrary: i j; simp add: algebra_simps power_add) + by (induct xs arbitrary: i j; simp add: algebra_simps power_add) lemma take_nths_empty: "(take_nths i k xs = []) = (length xs \ i)" -by (induction xs arbitrary: i k) auto + by (induction xs arbitrary: i k) auto lemma hd_take_nths: "i < length xs \ hd(take_nths i k xs) = xs ! i" -by (induction xs arbitrary: i k) auto + by (induction xs arbitrary: i k) auto lemma take_nths_01_splice: "\ length xs = length ys \ length xs = length ys + 1 \ \ take_nths 0 (Suc 0) (splice xs ys) = xs \ take_nths (Suc 0) (Suc 0) (splice xs ys) = ys" -by (induct xs arbitrary: ys; case_tac ys; simp) + by (induct xs arbitrary: ys; case_tac ys; simp) lemma length_take_nths_00: "length (take_nths 0 (Suc 0) xs) = length (take_nths (Suc 0) (Suc 0) xs) \ length (take_nths 0 (Suc 0) xs) = length (take_nths (Suc 0) (Suc 0) xs) + 1" -by (induct xs) auto + by (induct xs) auto paragraph \\braun_list\\ fun braun_list :: "'a tree \ 'a list \ bool" where -"braun_list Leaf xs = (xs = [])" | -"braun_list (Node l x r) xs = (xs \ [] \ x = hd xs \ + "braun_list Leaf xs = (xs = [])" | + "braun_list (Node l x r) xs = (xs \ [] \ x = hd xs \ braun_list l (take_nths 1 1 xs) \ braun_list r (take_nths 2 1 xs))" @@ -426,14 +425,14 @@ subsubsection \Converting a list of elements into a Braun tree\ fun nodes :: "'a tree list \ 'a list \ 'a tree list \ 'a tree list" where -"nodes (l#ls) (x#xs) (r#rs) = Node l x r # nodes ls xs rs" | -"nodes (l#ls) (x#xs) [] = Node l x Leaf # nodes ls xs []" | -"nodes [] (x#xs) (r#rs) = Node Leaf x r # nodes [] xs rs" | -"nodes [] (x#xs) [] = Node Leaf x Leaf # nodes [] xs []" | -"nodes ls [] rs = []" + "nodes (l#ls) (x#xs) (r#rs) = Node l x r # nodes ls xs rs" | + "nodes (l#ls) (x#xs) [] = Node l x Leaf # nodes ls xs []" | + "nodes [] (x#xs) (r#rs) = Node Leaf x r # nodes [] xs rs" | + "nodes [] (x#xs) [] = Node Leaf x Leaf # nodes [] xs []" | + "nodes ls [] rs = []" fun brauns :: "nat \ 'a list \ 'a tree list" where -"brauns k xs = (if xs = [] then [] else + "brauns k xs = (if xs = [] then [] else let ys = take (2^k) xs; zs = drop (2^k) xs; ts = brauns (k+1) zs @@ -442,10 +441,10 @@ declare brauns.simps[simp del] definition brauns1 :: "'a list \ 'a tree" where -"brauns1 xs = (if xs = [] then Leaf else brauns 0 xs ! 0)" + "brauns1 xs = (if xs = [] then Leaf else brauns 0 xs ! 0)" fun T_brauns :: "nat \ 'a list \ nat" where -"T_brauns k xs = (if xs = [] then 0 else + "T_brauns k xs = (if xs = [] then 0 else let ys = take (2^k) xs; zs = drop (2^k) xs; ts = brauns (k+1) zs @@ -458,14 +457,14 @@ lemma length_nodes: "length (nodes ls xs rs) = length xs" -by (induct ls xs rs rule: nodes.induct; simp) + by (induct ls xs rs rule: nodes.induct; simp) lemma nth_nodes: "i < length xs \ nodes ls xs rs ! i = Node (if i < length ls then ls ! i else Leaf) (xs ! i) (if i < length rs then rs ! i else Leaf)" -by (induct ls xs rs arbitrary: i rule: nodes.induct; - simp add: nth_Cons split: nat.split) + by (induct ls xs rs arbitrary: i rule: nodes.induct; + simp add: nth_Cons split: nat.split) theorem length_brauns: "length (brauns k xs) = min (length xs) (2 ^ k)" @@ -487,13 +486,13 @@ show ?case using less.prems by (auto simp: brauns.simps[of k xs] nth_nodes take_nths_take_nths - IH take_nths_empty hd_take_nths length_brauns) + IH take_nths_empty hd_take_nths length_brauns) qed corollary brauns1_correct: "braun (brauns1 xs) \ list (brauns1 xs) = xs" -using brauns_correct[of 0 xs 0] -by (simp add: brauns1_def braun_list_eq take_nths_00) + using brauns_correct[of 0 xs 0] + by (simp add: brauns1_def braun_list_eq take_nths_00) paragraph "Running Time Analysis" @@ -510,7 +509,7 @@ assume "xs \ []" let ?zs = "drop (2^k) xs" have "T_brauns k xs = T_brauns (k+1) ?zs + 4 * min (2^k) (length xs)" - using \xs \ []\ by(simp) + using \xs \ []\ by(simp) also have "\ = 4 * length ?zs + 4 * min (2^k) (length xs)" using less[of ?zs "k+1"] \xs \ []\ by (simp) @@ -526,10 +525,10 @@ text \The code and the proof are originally due to Thomas Sewell (except running time).\ function list_fast_rec :: "'a tree list \ 'a list" where -"list_fast_rec ts = (let us = filter (\t. t \ Leaf) ts in + "list_fast_rec ts = (let us = filter (\t. t \ Leaf) ts in if us = [] then [] else map value us @ list_fast_rec (map left us @ map right us))" -by (pat_completeness, auto) + by (pat_completeness, auto) lemma list_fast_rec_term1: "ts \ [] \ Leaf \ set ts \ sum_list (map (size o left) ts) + sum_list (map (size o right) ts) < sum_list (map size ts)" @@ -545,27 +544,21 @@ done termination - apply (relation "measure (sum_list o map size)") - apply simp - apply (simp add: list_fast_rec_term) - done + by (relation "measure (sum_list o map size)"; simp add: list_fast_rec_term) declare list_fast_rec.simps[simp del] definition list_fast :: "'a tree \ 'a list" where -"list_fast t = list_fast_rec [t]" + "list_fast t = list_fast_rec [t]" function T_list_fast_rec :: "'a tree list \ nat" where -"T_list_fast_rec ts = (let us = filter (\t. t \ Leaf) ts + "T_list_fast_rec ts = (let us = filter (\t. t \ Leaf) ts in length ts + (if us = [] then 0 else 5 * length us + T_list_fast_rec (map left us @ map right us)))" -by (pat_completeness, auto) + by (pat_completeness, auto) termination - apply (relation "measure (sum_list o map size)") - apply simp - apply (simp add: list_fast_rec_term) - done + by (relation "measure (sum_list o map size)"; simp add: list_fast_rec_term) declare T_list_fast_rec.simps[simp del] @@ -573,22 +566,22 @@ lemma list_fast_rec_all_Leaf: "\t \ set ts. t = Leaf \ list_fast_rec ts = []" -by (simp add: filter_empty_conv list_fast_rec.simps) + by (simp add: filter_empty_conv list_fast_rec.simps) lemma take_nths_eq_single: "length xs - i < 2^n \ take_nths i n xs = take 1 (drop i xs)" -by (induction xs arbitrary: i n; simp add: drop_Cons') + by (induction xs arbitrary: i n; simp add: drop_Cons') lemma braun_list_Nil: "braun_list t [] = (t = Leaf)" -by (cases t; simp) + by (cases t; simp) lemma braun_list_not_Nil: "xs \ [] \ braun_list t xs = - (\l x r. t = Node l x r \ x = hd xs \ - braun_list l (take_nths 1 1 xs) \ - braun_list r (take_nths 2 1 xs))" -by(cases t; simp) + (\l x r. t = Node l x r \ x = hd xs \ + braun_list l (take_nths 1 1 xs) \ + braun_list r (take_nths 2 1 xs))" + by(cases t; simp) theorem list_fast_rec_correct: "\ length ts = 2 ^ k; \i < 2 ^ k. braun_list (ts ! i) (take_nths i k xs) \ @@ -615,13 +608,13 @@ \ (\ys. ys = take_nths (i + 2 * 2 ^ k) (Suc k) xs \ braun_list (right (ts ! i)) ys)" by (auto simp: take_nths_empty hd_take_nths braun_list_not_Nil take_nths_take_nths - algebra_simps) + algebra_simps) have 1: "map value ts = take (2 ^ k) xs" using less.prems(1) False by (simp add: list_eq_iff_nth_eq *) have 2: "list_fast_rec (map left ts @ map right ts) = drop (2 ^ k) xs" using less.prems(1) False by (auto intro!: Nat.diff_less less.hyps[where k= "Suc k"] - simp: nth_append * take_nths_drop algebra_simps) + simp: nth_append * take_nths_drop algebra_simps) from less.prems(1) False show ?thesis by (auto simp: list_fast_rec.simps[of ts] 1 2 * all_set_conv_all_nth) qed @@ -629,13 +622,13 @@ corollary list_fast_correct: "braun t \ list_fast t = list t" -by (simp add: list_fast_def take_nths_00 braun_list_eq list_fast_rec_correct[where k=0]) + by (simp add: list_fast_def take_nths_00 braun_list_eq list_fast_rec_correct[where k=0]) paragraph "Running Time Analysis" lemma sum_tree_list_children: "\t \ set ts. t \ Leaf \ (\t\ts. k * size t) = (\t \ map left ts @ map right ts. k * size t) + k * length ts" -by(induction ts)(auto simp add: neq_Leaf_iff algebra_simps) + by(induction ts)(auto simp add: neq_Leaf_iff algebra_simps) theorem T_list_fast_rec_ub: "T_list_fast_rec ts \ sum_list (map (\t. 7*size t + 1) ts)" @@ -647,11 +640,11 @@ assume "?us = []" thus ?thesis using T_list_fast_rec.simps[of ts] by(simp add: sum_list_Suc) - next + next assume "?us \ []" let ?children = "map left ?us @ map right ?us" have "T_list_fast_rec ts = T_list_fast_rec ?children + 5 * length ?us + length ts" - using \?us \ []\ T_list_fast_rec.simps[of ts] by(simp) + using \?us \ []\ T_list_fast_rec.simps[of ts] by(simp) also have "\ \ (\t\?children. 7 * size t + 1) + 5 * length ?us + length ts" using less[of "?children"] list_fast_rec_term[of "?us"] \?us \ []\ by (simp) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Data_Structures/Brother12_Set.thy --- a/src/HOL/Data_Structures/Brother12_Set.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Data_Structures/Brother12_Set.thy Mon Sep 11 22:59:34 2023 +0200 @@ -3,10 +3,10 @@ section \1-2 Brother Tree Implementation of Sets\ theory Brother12_Set -imports - Cmp - Set_Specs - "HOL-Number_Theory.Fib" + imports + Cmp + Set_Specs + "HOL-Number_Theory.Fib" begin subsection \Data Type and Operations\ @@ -20,28 +20,28 @@ N3 "'a bro" 'a "'a bro" 'a "'a bro" definition empty :: "'a bro" where -"empty = N0" + "empty = N0" fun inorder :: "'a bro \ 'a list" where -"inorder N0 = []" | -"inorder (N1 t) = inorder t" | -"inorder (N2 l a r) = inorder l @ a # inorder r" | -"inorder (L2 a) = [a]" | -"inorder (N3 t1 a1 t2 a2 t3) = inorder t1 @ a1 # inorder t2 @ a2 # inorder t3" + "inorder N0 = []" | + "inorder (N1 t) = inorder t" | + "inorder (N2 l a r) = inorder l @ a # inorder r" | + "inorder (L2 a) = [a]" | + "inorder (N3 t1 a1 t2 a2 t3) = inorder t1 @ a1 # inorder t2 @ a2 # inorder t3" fun isin :: "'a bro \ 'a::linorder \ bool" where -"isin N0 x = False" | -"isin (N1 t) x = isin t x" | -"isin (N2 l a r) x = + "isin N0 x = False" | + "isin (N1 t) x = isin t x" | + "isin (N2 l a r) x = (case cmp x a of LT \ isin l x | EQ \ True | GT \ isin r x)" fun n1 :: "'a bro \ 'a bro" where -"n1 (L2 a) = N2 N0 a N0" | -"n1 (N3 t1 a1 t2 a2 t3) = N2 (N2 t1 a1 t2) a2 (N1 t3)" | -"n1 t = N1 t" + "n1 (L2 a) = N2 N0 a N0" | + "n1 (N3 t1 a1 t2 a2 t3) = N2 (N2 t1 a1 t2) a2 (N1 t3)" | + "n1 t = N1 t" hide_const (open) insert @@ -49,30 +49,30 @@ begin fun n2 :: "'a bro \ 'a \ 'a bro \ 'a bro" where -"n2 (L2 a1) a2 t = N3 N0 a1 N0 a2 t" | -"n2 (N3 t1 a1 t2 a2 t3) a3 (N1 t4) = N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)" | -"n2 (N3 t1 a1 t2 a2 t3) a3 t4 = N3 (N2 t1 a1 t2) a2 (N1 t3) a3 t4" | -"n2 t1 a1 (L2 a2) = N3 t1 a1 N0 a2 N0" | -"n2 (N1 t1) a1 (N3 t2 a2 t3 a3 t4) = N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)" | -"n2 t1 a1 (N3 t2 a2 t3 a3 t4) = N3 t1 a1 (N1 t2) a2 (N2 t3 a3 t4)" | -"n2 t1 a t2 = N2 t1 a t2" + "n2 (L2 a1) a2 t = N3 N0 a1 N0 a2 t" | + "n2 (N3 t1 a1 t2 a2 t3) a3 (N1 t4) = N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)" | + "n2 (N3 t1 a1 t2 a2 t3) a3 t4 = N3 (N2 t1 a1 t2) a2 (N1 t3) a3 t4" | + "n2 t1 a1 (L2 a2) = N3 t1 a1 N0 a2 N0" | + "n2 (N1 t1) a1 (N3 t2 a2 t3 a3 t4) = N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)" | + "n2 t1 a1 (N3 t2 a2 t3 a3 t4) = N3 t1 a1 (N1 t2) a2 (N2 t3 a3 t4)" | + "n2 t1 a t2 = N2 t1 a t2" fun ins :: "'a::linorder \ 'a bro \ 'a bro" where -"ins x N0 = L2 x" | -"ins x (N1 t) = n1 (ins x t)" | -"ins x (N2 l a r) = + "ins x N0 = L2 x" | + "ins x (N1 t) = n1 (ins x t)" | + "ins x (N2 l a r) = (case cmp x a of LT \ n2 (ins x l) a r | EQ \ N2 l a r | GT \ n2 l a (ins x r))" fun tree :: "'a bro \ 'a bro" where -"tree (L2 a) = N2 N0 a N0" | -"tree (N3 t1 a1 t2 a2 t3) = N2 (N2 t1 a1 t2) a2 (N1 t3)" | -"tree t = t" + "tree (L2 a) = N2 N0 a N0" | + "tree (N3 t1 a1 t2 a2 t3) = N2 (N2 t1 a1 t2) a2 (N1 t3)" | + "tree t = t" definition insert :: "'a::linorder \ 'a bro \ 'a bro" where -"insert x t = tree(ins x t)" + "insert x t = tree(ins x t)" end @@ -80,36 +80,36 @@ begin fun n2 :: "'a bro \ 'a \ 'a bro \ 'a bro" where -"n2 (N1 t1) a1 (N1 t2) = N1 (N2 t1 a1 t2)" | -"n2 (N1 (N1 t1)) a1 (N2 (N1 t2) a2 (N2 t3 a3 t4)) = + "n2 (N1 t1) a1 (N1 t2) = N1 (N2 t1 a1 t2)" | + "n2 (N1 (N1 t1)) a1 (N2 (N1 t2) a2 (N2 t3 a3 t4)) = N1 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4))" | -"n2 (N1 (N1 t1)) a1 (N2 (N2 t2 a2 t3) a3 (N1 t4)) = + "n2 (N1 (N1 t1)) a1 (N2 (N2 t2 a2 t3) a3 (N1 t4)) = N1 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4))" | -"n2 (N1 (N1 t1)) a1 (N2 (N2 t2 a2 t3) a3 (N2 t4 a4 t5)) = + "n2 (N1 (N1 t1)) a1 (N2 (N2 t2 a2 t3) a3 (N2 t4 a4 t5)) = N2 (N2 (N1 t1) a1 (N2 t2 a2 t3)) a3 (N1 (N2 t4 a4 t5))" | -"n2 (N2 (N1 t1) a1 (N2 t2 a2 t3)) a3 (N1 (N1 t4)) = + "n2 (N2 (N1 t1) a1 (N2 t2 a2 t3)) a3 (N1 (N1 t4)) = N1 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4))" | -"n2 (N2 (N2 t1 a1 t2) a2 (N1 t3)) a3 (N1 (N1 t4)) = + "n2 (N2 (N2 t1 a1 t2) a2 (N1 t3)) a3 (N1 (N1 t4)) = N1 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4))" | -"n2 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)) a5 (N1 (N1 t5)) = + "n2 (N2 (N2 t1 a1 t2) a2 (N2 t3 a3 t4)) a5 (N1 (N1 t5)) = N2 (N1 (N2 t1 a1 t2)) a2 (N2 (N2 t3 a3 t4) a5 (N1 t5))" | -"n2 t1 a1 t2 = N2 t1 a1 t2" + "n2 t1 a1 t2 = N2 t1 a1 t2" fun split_min :: "'a bro \ ('a \ 'a bro) option" where -"split_min N0 = None" | -"split_min (N1 t) = + "split_min N0 = None" | + "split_min (N1 t) = (case split_min t of None \ None | Some (a, t') \ Some (a, N1 t'))" | -"split_min (N2 t1 a t2) = + "split_min (N2 t1 a t2) = (case split_min t1 of None \ Some (a, N1 t2) | Some (b, t1') \ Some (b, n2 t1' a t2))" fun del :: "'a::linorder \ 'a bro \ 'a bro" where -"del _ N0 = N0" | -"del x (N1 t) = N1 (del x t)" | -"del x (N2 l a r) = + "del _ N0 = N0" | + "del x (N1 t) = N1 (del x t)" | + "del x (N2 l a r) = (case cmp x a of LT \ n2 (del x l) a r | GT \ n2 l a (del x r) | @@ -118,35 +118,35 @@ Some (b, r') \ n2 l b r'))" fun tree :: "'a bro \ 'a bro" where -"tree (N1 t) = t" | -"tree t = t" + "tree (N1 t) = t" | + "tree t = t" definition delete :: "'a::linorder \ 'a bro \ 'a bro" where -"delete a t = tree (del a t)" + "delete a t = tree (del a t)" end subsection \Invariants\ fun B :: "nat \ 'a bro set" -and U :: "nat \ 'a bro set" where -"B 0 = {N0}" | -"B (Suc h) = { N2 t1 a t2 | t1 a t2. + and U :: "nat \ 'a bro set" where + "B 0 = {N0}" | + "B (Suc h) = { N2 t1 a t2 | t1 a t2. t1 \ B h \ U h \ t2 \ B h \ t1 \ B h \ t2 \ B h \ U h}" | -"U 0 = {}" | -"U (Suc h) = N1 ` B h" + "U 0 = {}" | + "U (Suc h) = N1 ` B h" abbreviation "T h \ B h \ U h" fun Bp :: "nat \ 'a bro set" where -"Bp 0 = B 0 \ L2 ` UNIV" | -"Bp (Suc 0) = B (Suc 0) \ {N3 N0 a N0 b N0|a b. True}" | -"Bp (Suc(Suc h)) = B (Suc(Suc h)) \ + "Bp 0 = B 0 \ L2 ` UNIV" | + "Bp (Suc 0) = B (Suc 0) \ {N3 N0 a N0 b N0|a b. True}" | + "Bp (Suc(Suc h)) = B (Suc(Suc h)) \ {N3 t1 a t2 b t3 | t1 a t2 b t3. t1 \ B (Suc h) \ t2 \ U (Suc h) \ t3 \ B (Suc h)}" fun Um :: "nat \ 'a bro set" where -"Um 0 = {}" | -"Um (Suc h) = N1 ` T h" + "Um 0 = {}" | + "Um (Suc h) = N1 ` T h" subsection "Functional Correctness Proofs" @@ -155,29 +155,29 @@ lemma isin_set: "t \ T h \ sorted(inorder t) \ isin t x = (x \ set(inorder t))" -by(induction h arbitrary: t) (fastforce simp: isin_simps split: if_splits)+ + by(induction h arbitrary: t) (fastforce simp: isin_simps split: if_splits)+ subsubsection "Proofs for insertion" lemma inorder_n1: "inorder(n1 t) = inorder t" -by(cases t rule: n1.cases) (auto simp: sorted_lems) + by(cases t rule: n1.cases) (auto simp: sorted_lems) context insert begin lemma inorder_n2: "inorder(n2 l a r) = inorder l @ a # inorder r" -by(cases "(l,a,r)" rule: n2.cases) (auto simp: sorted_lems) + by(cases "(l,a,r)" rule: n2.cases) (auto simp: sorted_lems) lemma inorder_tree: "inorder(tree t) = inorder t" -by(cases t) auto + by(cases t) auto lemma inorder_ins: "t \ T h \ sorted(inorder t) \ inorder(ins a t) = ins_list a (inorder t)" -by(induction h arbitrary: t) (auto simp: ins_list_simps inorder_n1 inorder_n2) + by(induction h arbitrary: t) (auto simp: ins_list_simps inorder_n1 inorder_n2) lemma inorder_insert: "t \ T h \ sorted(inorder t) \ inorder(insert a t) = ins_list a (inorder t)" -by(simp add: insert_def inorder_ins inorder_tree) + by(simp add: insert_def inorder_ins inorder_tree) end @@ -187,27 +187,27 @@ begin lemma inorder_tree: "inorder(tree t) = inorder t" -by(cases t) auto + by(cases t) auto lemma inorder_n2: "inorder(n2 l a r) = inorder l @ a # inorder r" -by(cases "(l,a,r)" rule: n2.cases) (auto) + by(cases "(l,a,r)" rule: n2.cases) (auto) lemma inorder_split_min: "t \ T h \ (split_min t = None \ inorder t = []) \ (split_min t = Some(a,t') \ inorder t = a # inorder t')" -by(induction h arbitrary: t a t') (auto simp: inorder_n2 split: option.splits) + by(induction h arbitrary: t a t') (auto simp: inorder_n2 split: option.splits) lemma inorder_del: "t \ T h \ sorted(inorder t) \ inorder(del x t) = del_list x (inorder t)" apply (induction h arbitrary: t) apply (auto simp: del_list_simps inorder_n2 split: option.splits) apply (auto simp: del_list_simps inorder_n2 - inorder_split_min[OF UnI1] inorder_split_min[OF UnI2] split: option.splits) + inorder_split_min[OF UnI1] inorder_split_min[OF UnI2] split: option.splits) done lemma inorder_delete: "t \ T h \ sorted(inorder t) \ inorder(delete x t) = del_list x (inorder t)" -by(simp add: delete_def inorder_del inorder_tree) + by(simp add: delete_def inorder_del inorder_tree) end @@ -217,38 +217,41 @@ subsubsection \Proofs for insertion\ lemma n1_type: "t \ Bp h \ n1 t \ T (Suc h)" -by(cases h rule: Bp.cases) auto + by(cases h rule: Bp.cases) auto context insert begin lemma tree_type: "t \ Bp h \ tree t \ B h \ B (Suc h)" -by(cases h rule: Bp.cases) auto + by(cases h rule: Bp.cases) auto lemma n2_type: "(t1 \ Bp h \ t2 \ T h \ n2 t1 a t2 \ Bp (Suc h)) \ (t1 \ T h \ t2 \ Bp h \ n2 t1 a t2 \ Bp (Suc h))" -apply(cases h rule: Bp.cases) -apply (auto)[2] -apply(rule conjI impI | erule conjE exE imageE | simp | erule disjE)+ -done + apply(cases h rule: Bp.cases) + apply (auto)[2] + apply(rule conjI impI | erule conjE exE imageE | simp | erule disjE)+ + done lemma Bp_if_B: "t \ B h \ t \ Bp h" -by (cases h rule: Bp.cases) simp_all + by (cases h rule: Bp.cases) simp_all text\An automatic proof:\ lemma "(t \ B h \ ins x t \ Bp h) \ (t \ U h \ ins x t \ T h)" -apply(induction h arbitrary: t) - apply (simp) -apply (fastforce simp: Bp_if_B n2_type dest: n1_type) -done +proof (induction h arbitrary: t) + case 0 + then show ?case by simp +next + case (Suc h) + then show ?case by (fastforce simp: Bp_if_B n2_type dest: n1_type) +qed text\A detailed proof:\ lemma ins_type: -shows "t \ B h \ ins x t \ Bp h" and "t \ U h \ ins x t \ T h" + shows "t \ B h \ ins x t \ Bp h" and "t \ U h \ ins x t \ T h" proof(induction h arbitrary: t) case 0 { case 1 thus ?case by simp @@ -300,7 +303,7 @@ lemma insert_type: "t \ B h \ insert x t \ B h \ B (Suc h)" -unfolding insert_def by (metis ins_type(1) tree_type) + unfolding insert_def by (metis ins_type(1) tree_type) end @@ -311,37 +314,38 @@ "L2 y \ B h = False" "(N3 t1 a1 t2 a2 t3) \ B h = False" "N0 \ B h \ h = 0" -by (cases h, auto)+ + by (cases h, auto)+ context delete begin lemma n2_type1: "\t1 \ Um h; t2 \ B h\ \ n2 t1 a t2 \ T (Suc h)" -apply(cases h rule: Bp.cases) -apply auto[2] -apply(erule exE bexE conjE imageE | simp | erule disjE)+ -done + apply(cases h rule: Bp.cases) + apply auto[2] + apply(erule exE bexE conjE imageE | simp | erule disjE)+ + done lemma n2_type2: "\t1 \ B h ; t2 \ Um h \ \ n2 t1 a t2 \ T (Suc h)" -apply(cases h rule: Bp.cases) -apply auto[2] -apply(erule exE bexE conjE imageE | simp | erule disjE)+ -done + apply(cases h rule: Bp.cases) + using Um.simps(1) apply blast + apply force + apply(erule exE bexE conjE imageE | simp | erule disjE)+ + done lemma n2_type3: "\t1 \ T h ; t2 \ T h \ \ n2 t1 a t2 \ T (Suc h)" -apply(cases h rule: Bp.cases) -apply auto[2] -apply(erule exE bexE conjE imageE | simp | erule disjE)+ -done + apply(cases h rule: Bp.cases) + apply auto[2] + apply(erule exE bexE conjE imageE | simp | erule disjE)+ + done lemma split_minNoneN0: "\t \ B h; split_min t = None\ \ t = N0" -by (cases t) (auto split: option.splits) + by (cases t) (auto split: option.splits) lemma split_minNoneN1 : "\t \ U h; split_min t = None\ \ t = N1 N0" -by (cases h) (auto simp: split_minNoneN0 split: option.splits) + by (cases h) (auto simp: split_minNoneN0 split: option.splits) lemma split_min_type: "t \ B h \ split_min t = Some (a, t') \ t' \ T h" @@ -459,11 +463,11 @@ qed auto lemma tree_type: "t \ T (h+1) \ tree t \ B (h+1) \ B h" -by(auto) + by(auto) lemma delete_type: "t \ B h \ delete x t \ B h \ B(h-1)" -unfolding delete_def -by (cases h) (simp, metis del_type(1) tree_type Suc_eq_plus1 diff_Suc_1) + unfolding delete_def + by (cases h) (simp, metis del_type(1) tree_type Suc_eq_plus1 diff_Suc_1) end @@ -471,8 +475,8 @@ subsection "Overall correctness" interpretation Set_by_Ordered -where empty = empty and isin = isin and insert = insert.insert -and delete = delete.delete and inorder = inorder and inv = "\t. \h. t \ B h" + where empty = empty and isin = isin and insert = insert.insert + and delete = delete.delete and inorder = inorder and inv = "\t. \h. t \ B h" proof (standard, goal_cases) case 2 thus ?case by(auto intro!: isin_set) next @@ -506,27 +510,27 @@ | "size (N2 t1 _ t2) = 1 + size t1 + size t2" lemma fib_tree_B: "fib_tree h \ B h" -by (induction h rule: fib_tree.induct) auto + by (induction h rule: fib_tree.induct) auto declare [[names_short]] lemma size_fib': "size (fib_tree h) = fib' h" -by (induction h rule: fib_tree.induct) auto + by (induction h rule: fib_tree.induct) auto lemma fibfib: "fib' h + 1 = fib (Suc(Suc h))" -by (induction h rule: fib_tree.induct) auto + by (induction h rule: fib_tree.induct) auto lemma B_N2_cases[consumes 1]: -assumes "N2 t1 a t2 \ B (Suc n)" -obtains - (BB) "t1 \ B n" and "t2 \ B n" | - (UB) "t1 \ U n" and "t2 \ B n" | - (BU) "t1 \ B n" and "t2 \ U n" -using assms by auto + assumes "N2 t1 a t2 \ B (Suc n)" + obtains + (BB) "t1 \ B n" and "t2 \ B n" | + (UB) "t1 \ U n" and "t2 \ B n" | + (BU) "t1 \ B n" and "t2 \ U n" + using assms by auto lemma size_bounded: "t \ B h \ size t \ size (fib_tree h)" -unfolding size_fib' proof (induction h arbitrary: t rule: fib'.induct) -case (3 h t') + unfolding size_fib' proof (induction h arbitrary: t rule: fib'.induct) + case (3 h t') note main = 3 then obtain t1 a t2 where t': "t' = N2 t1 a t2" by auto with main have "N2 t1 a t2 \ B (Suc (Suc h))" by auto @@ -546,7 +550,7 @@ qed auto theorem "t \ B h \ fib (h + 2) \ size t + 1" -using size_bounded -by (simp add: size_fib' fibfib[symmetric] del: fib.simps) + using size_bounded + by (simp add: size_fib' fibfib[symmetric] del: fib.simps) end diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Data_Structures/Sorting.thy --- a/src/HOL/Data_Structures/Sorting.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Data_Structures/Sorting.thy Mon Sep 11 22:59:34 2023 +0200 @@ -3,9 +3,9 @@ section "Sorting" theory Sorting -imports - Complex_Main - "HOL-Library.Multiset" + imports + Complex_Main + "HOL-Library.Multiset" begin hide_const List.insort @@ -16,40 +16,31 @@ subsection "Insertion Sort" fun insort1 :: "'a::linorder \ 'a list \ 'a list" where -"insort1 x [] = [x]" | -"insort1 x (y#ys) = + "insort1 x [] = [x]" | + "insort1 x (y#ys) = (if x \ y then x#y#ys else y#(insort1 x ys))" fun insort :: "'a::linorder list \ 'a list" where -"insort [] = []" | -"insort (x#xs) = insort1 x (insort xs)" + "insort [] = []" | + "insort (x#xs) = insort1 x (insort xs)" subsubsection "Functional Correctness" lemma mset_insort1: "mset (insort1 x xs) = {#x#} + mset xs" -apply(induction xs) -apply auto -done + by (induction xs) auto lemma mset_insort: "mset (insort xs) = mset xs" -apply(induction xs) -apply simp -apply (simp add: mset_insort1) -done + by (induction xs) (auto simp: mset_insort1) lemma set_insort1: "set (insort1 x xs) = {x} \ set xs" -by(simp add: mset_insort1 flip: set_mset_mset) + by(simp add: mset_insort1 flip: set_mset_mset) lemma sorted_insort1: "sorted (insort1 a xs) = sorted xs" -apply(induction xs) -apply(auto simp add: set_insort1) -done + by (induction xs) (auto simp: set_insort1) lemma sorted_insort: "sorted (insort xs)" -apply(induction xs) -apply(auto simp: sorted_insort1) -done + by (induction xs) (auto simp: sorted_insort1) subsubsection "Time Complexity" @@ -62,8 +53,8 @@ (if x \ y then x#y#ys else y#(insort1 x ys))\ \ fun T_insort1 :: "'a::linorder \ 'a list \ nat" where -"T_insort1 x [] = 1" | -"T_insort1 x (y#ys) = + "T_insort1 x [] = 1" | + "T_insort1 x (y#ys) = (if x \ y then 0 else T_insort1 x ys) + 1" text\ @@ -71,24 +62,18 @@ \insort (x#xs) = insort1 x (insort xs)\ \ fun T_insort :: "'a::linorder list \ nat" where -"T_insort [] = 1" | -"T_insort (x#xs) = T_insort xs + T_insort1 x (insort xs) + 1" + "T_insort [] = 1" | + "T_insort (x#xs) = T_insort xs + T_insort1 x (insort xs) + 1" lemma T_insort1_length: "T_insort1 x xs \ length xs + 1" -apply(induction xs) -apply auto -done + by (induction xs) auto lemma length_insort1: "length (insort1 x xs) = length xs + 1" -apply(induction xs) -apply auto -done + by (induction xs) auto lemma length_insort: "length (insort xs) = length xs" -apply(induction xs) -apply (auto simp: length_insort1) -done + by (metis Sorting.mset_insort size_mset) lemma T_insort_length: "T_insort xs \ (length xs + 1) ^ 2" proof(induction xs) @@ -109,12 +94,12 @@ subsection "Merge Sort" fun merge :: "'a::linorder list \ 'a list \ 'a list" where -"merge [] ys = ys" | -"merge xs [] = xs" | -"merge (x#xs) (y#ys) = (if x \ y then x # merge xs (y#ys) else y # merge (x#xs) ys)" + "merge [] ys = ys" | + "merge xs [] = xs" | + "merge (x#xs) (y#ys) = (if x \ y then x # merge xs (y#ys) else y # merge (x#xs) ys)" fun msort :: "'a::linorder list \ 'a list" where -"msort xs = (let n = length xs in + "msort xs = (let n = length xs in if n \ 1 then xs else merge (msort (take (n div 2) xs)) (msort (drop (n div 2) xs)))" @@ -124,7 +109,7 @@ subsubsection "Functional Correctness" lemma mset_merge: "mset(merge xs ys) = mset xs + mset ys" -by(induction xs ys rule: merge.induct) auto + by(induction xs ys rule: merge.induct) auto lemma mset_msort: "mset (msort xs) = mset xs" proof(induction xs rule: msort.induct) @@ -151,13 +136,13 @@ text \Via the previous lemma or directly:\ lemma set_merge: "set(merge xs ys) = set xs \ set ys" -by (metis mset_merge set_mset_mset set_mset_union) + by (metis mset_merge set_mset_mset set_mset_union) lemma "set(merge xs ys) = set xs \ set ys" -by(induction xs ys rule: merge.induct) (auto) + by(induction xs ys rule: merge.induct) (auto) lemma sorted_merge: "sorted (merge xs ys) \ (sorted xs \ sorted ys)" -by(induction xs ys rule: merge.induct) (auto simp: set_merge) + by(induction xs ys rule: merge.induct) (auto simp: set_merge) lemma sorted_msort: "sorted (msort xs)" proof(induction xs rule: msort.induct) @@ -180,15 +165,15 @@ text \We only count the number of comparisons between list elements.\ fun C_merge :: "'a::linorder list \ 'a list \ nat" where -"C_merge [] ys = 0" | -"C_merge xs [] = 0" | -"C_merge (x#xs) (y#ys) = 1 + (if x \ y then C_merge xs (y#ys) else C_merge (x#xs) ys)" + "C_merge [] ys = 0" | + "C_merge xs [] = 0" | + "C_merge (x#xs) (y#ys) = 1 + (if x \ y then C_merge xs (y#ys) else C_merge (x#xs) ys)" lemma C_merge_ub: "C_merge xs ys \ length xs + length ys" -by (induction xs ys rule: C_merge.induct) auto + by (induction xs ys rule: C_merge.induct) auto fun C_msort :: "'a::linorder list \ nat" where -"C_msort xs = + "C_msort xs = (let n = length xs; ys = take (n div 2) xs; zs = drop (n div 2) xs @@ -198,9 +183,7 @@ declare C_msort.simps [simp del] lemma length_merge: "length(merge xs ys) = length xs + length ys" -apply (induction xs ys rule: merge.induct) -apply auto -done + by (induction xs ys rule: merge.induct) auto lemma length_msort: "length(msort xs) = length xs" proof (induction xs rule: msort.induct) @@ -245,78 +228,77 @@ (* Beware of implicit conversions: *) lemma C_msort_log: "length xs = 2^k \ C_msort xs \ length xs * log 2 (length xs)" -using C_msort_le[of xs k] apply (simp add: log_nat_power algebra_simps) -by (metis (mono_tags) numeral_power_eq_of_nat_cancel_iff of_nat_le_iff of_nat_mult) + using C_msort_le[of xs k] + by (metis log2_of_power_eq mult.commute of_nat_mono of_nat_mult) subsection "Bottom-Up Merge Sort" fun merge_adj :: "('a::linorder) list list \ 'a list list" where -"merge_adj [] = []" | -"merge_adj [xs] = [xs]" | -"merge_adj (xs # ys # zss) = merge xs ys # merge_adj zss" + "merge_adj [] = []" | + "merge_adj [xs] = [xs]" | + "merge_adj (xs # ys # zss) = merge xs ys # merge_adj zss" text \For the termination proof of \merge_all\ below.\ lemma length_merge_adjacent[simp]: "length (merge_adj xs) = (length xs + 1) div 2" -by (induction xs rule: merge_adj.induct) auto + by (induction xs rule: merge_adj.induct) auto fun merge_all :: "('a::linorder) list list \ 'a list" where -"merge_all [] = []" | -"merge_all [xs] = xs" | -"merge_all xss = merge_all (merge_adj xss)" + "merge_all [] = []" | + "merge_all [xs] = xs" | + "merge_all xss = merge_all (merge_adj xss)" definition msort_bu :: "('a::linorder) list \ 'a list" where -"msort_bu xs = merge_all (map (\x. [x]) xs)" + "msort_bu xs = merge_all (map (\x. [x]) xs)" subsubsection "Functional Correctness" abbreviation mset_mset :: "'a list list \ 'a multiset" where -"mset_mset xss \ \\<^sub># (image_mset mset (mset xss))" + "mset_mset xss \ \\<^sub># (image_mset mset (mset xss))" lemma mset_merge_adj: "mset_mset (merge_adj xss) = mset_mset xss" -by(induction xss rule: merge_adj.induct) (auto simp: mset_merge) + by(induction xss rule: merge_adj.induct) (auto simp: mset_merge) lemma mset_merge_all: "mset (merge_all xss) = mset_mset xss" -by(induction xss rule: merge_all.induct) (auto simp: mset_merge mset_merge_adj) + by(induction xss rule: merge_all.induct) (auto simp: mset_merge mset_merge_adj) lemma mset_msort_bu: "mset (msort_bu xs) = mset xs" -by(simp add: msort_bu_def mset_merge_all multiset.map_comp comp_def) + by(simp add: msort_bu_def mset_merge_all multiset.map_comp comp_def) lemma sorted_merge_adj: "\xs \ set xss. sorted xs \ \xs \ set (merge_adj xss). sorted xs" -by(induction xss rule: merge_adj.induct) (auto simp: sorted_merge) + by(induction xss rule: merge_adj.induct) (auto simp: sorted_merge) lemma sorted_merge_all: "\xs \ set xss. sorted xs \ sorted (merge_all xss)" -apply(induction xss rule: merge_all.induct) -using [[simp_depth_limit=3]] by (auto simp add: sorted_merge_adj) + by (induction xss rule: merge_all.induct) (auto simp add: sorted_merge_adj) lemma sorted_msort_bu: "sorted (msort_bu xs)" -by(simp add: msort_bu_def sorted_merge_all) + by(simp add: msort_bu_def sorted_merge_all) subsubsection "Time Complexity" fun C_merge_adj :: "('a::linorder) list list \ nat" where -"C_merge_adj [] = 0" | -"C_merge_adj [xs] = 0" | -"C_merge_adj (xs # ys # zss) = C_merge xs ys + C_merge_adj zss" + "C_merge_adj [] = 0" | + "C_merge_adj [xs] = 0" | + "C_merge_adj (xs # ys # zss) = C_merge xs ys + C_merge_adj zss" fun C_merge_all :: "('a::linorder) list list \ nat" where -"C_merge_all [] = 0" | -"C_merge_all [xs] = 0" | -"C_merge_all xss = C_merge_adj xss + C_merge_all (merge_adj xss)" + "C_merge_all [] = 0" | + "C_merge_all [xs] = 0" | + "C_merge_all xss = C_merge_adj xss + C_merge_all (merge_adj xss)" definition C_msort_bu :: "('a::linorder) list \ nat" where -"C_msort_bu xs = C_merge_all (map (\x. [x]) xs)" + "C_msort_bu xs = C_merge_all (map (\x. [x]) xs)" lemma length_merge_adj: "\ even(length xss); \xs \ set xss. length xs = m \ \ \xs \ set (merge_adj xss). length xs = 2*m" -by(induction xss rule: merge_adj.induct) (auto simp: length_merge) + by(induction xss rule: merge_adj.induct) (auto simp: length_merge) lemma C_merge_adj: "\xs \ set xss. length xs = m \ C_merge_adj xss \ m * length xss" proof(induction xss rule: C_merge_adj.induct) @@ -354,27 +336,24 @@ qed corollary C_msort_bu: "length xs = 2 ^ k \ C_msort_bu xs \ k * 2 ^ k" -using C_merge_all[of "map (\x. [x]) xs" 1] by (simp add: C_msort_bu_def) + using C_merge_all[of "map (\x. [x]) xs" 1] by (simp add: C_msort_bu_def) subsection "Quicksort" fun quicksort :: "('a::linorder) list \ 'a list" where -"quicksort [] = []" | -"quicksort (x#xs) = quicksort (filter (\y. y < x) xs) @ [x] @ quicksort (filter (\y. x \ y) xs)" + "quicksort [] = []" | + "quicksort (x#xs) = quicksort (filter (\y. y < x) xs) @ [x] @ quicksort (filter (\y. x \ y) xs)" lemma mset_quicksort: "mset (quicksort xs) = mset xs" -apply (induction xs rule: quicksort.induct) -apply (auto simp: not_le) -done + by (induction xs rule: quicksort.induct) (auto simp: not_le) lemma set_quicksort: "set (quicksort xs) = set xs" -by(rule mset_eq_setD[OF mset_quicksort]) + by(rule mset_eq_setD[OF mset_quicksort]) lemma sorted_quicksort: "sorted (quicksort xs)" -apply (induction xs rule: quicksort.induct) -apply (auto simp add: sorted_append set_quicksort) -done +proof (induction xs rule: quicksort.induct) +qed (auto simp: sorted_append set_quicksort) subsection "Insertion Sort w.r.t. Keys and Stability" @@ -382,45 +361,45 @@ hide_const List.insort_key fun insort1_key :: "('a \ 'k::linorder) \ 'a \ 'a list \ 'a list" where -"insort1_key f x [] = [x]" | -"insort1_key f x (y # ys) = (if f x \ f y then x # y # ys else y # insort1_key f x ys)" + "insort1_key f x [] = [x]" | + "insort1_key f x (y # ys) = (if f x \ f y then x # y # ys else y # insort1_key f x ys)" fun insort_key :: "('a \ 'k::linorder) \ 'a list \ 'a list" where -"insort_key f [] = []" | -"insort_key f (x # xs) = insort1_key f x (insort_key f xs)" + "insort_key f [] = []" | + "insort_key f (x # xs) = insort1_key f x (insort_key f xs)" subsubsection "Standard functional correctness" lemma mset_insort1_key: "mset (insort1_key f x xs) = {#x#} + mset xs" -by(induction xs) simp_all + by(induction xs) simp_all lemma mset_insort_key: "mset (insort_key f xs) = mset xs" -by(induction xs) (simp_all add: mset_insort1_key) + by(induction xs) (simp_all add: mset_insort1_key) (* Inductive proof simpler than derivation from mset lemma: *) lemma set_insort1_key: "set (insort1_key f x xs) = {x} \ set xs" -by (induction xs) auto + by (induction xs) auto lemma sorted_insort1_key: "sorted (map f (insort1_key f a xs)) = sorted (map f xs)" -by(induction xs)(auto simp: set_insort1_key) + by(induction xs)(auto simp: set_insort1_key) lemma sorted_insort_key: "sorted (map f (insort_key f xs))" -by(induction xs)(simp_all add: sorted_insort1_key) + by(induction xs)(simp_all add: sorted_insort1_key) subsubsection "Stability" lemma insort1_is_Cons: "\x\set xs. f a \ f x \ insort1_key f a xs = a # xs" -by (cases xs) auto + by (cases xs) auto lemma filter_insort1_key_neg: "\ P x \ filter P (insort1_key f x xs) = filter P xs" -by (induction xs) simp_all + by (induction xs) simp_all lemma filter_insort1_key_pos: "sorted (map f xs) \ P x \ filter P (insort1_key f x xs) = insort1_key f x (filter P xs)" -by (induction xs) (auto, subst insort1_is_Cons, auto) + by (induction xs) (auto, subst insort1_is_Cons, auto) lemma sort_key_stable: "filter (\y. f y = k) (insort_key f xs) = filter (\y. f y = k) xs" proof (induction xs) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Data_Structures/Tries_Binary.thy --- a/src/HOL/Data_Structures/Tries_Binary.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Data_Structures/Tries_Binary.thy Mon Sep 11 22:59:34 2023 +0200 @@ -3,7 +3,7 @@ section "Binary Tries and Patricia Tries" theory Tries_Binary -imports Set_Specs + imports Set_Specs begin hide_const (open) insert @@ -11,10 +11,10 @@ declare Let_def[simp] fun sel2 :: "bool \ 'a * 'a \ 'a" where -"sel2 b (a1,a2) = (if b then a2 else a1)" + "sel2 b (a1,a2) = (if b then a2 else a1)" fun mod2 :: "('a \ 'a) \ bool \ 'a * 'a \ 'a * 'a" where -"mod2 f b (a1,a2) = (if b then (a1,f a2) else (f a1,a2))" + "mod2 f b (a1,a2) = (if b then (a1,f a2) else (f a1,a2))" subsection "Trie" @@ -22,82 +22,78 @@ datatype trie = Lf | Nd bool "trie * trie" definition empty :: trie where -[simp]: "empty = Lf" + [simp]: "empty = Lf" fun isin :: "trie \ bool list \ bool" where -"isin Lf ks = False" | -"isin (Nd b lr) ks = + "isin Lf ks = False" | + "isin (Nd b lr) ks = (case ks of [] \ b | k#ks \ isin (sel2 k lr) ks)" fun insert :: "bool list \ trie \ trie" where -"insert [] Lf = Nd True (Lf,Lf)" | -"insert [] (Nd b lr) = Nd True lr" | -"insert (k#ks) Lf = Nd False (mod2 (insert ks) k (Lf,Lf))" | -"insert (k#ks) (Nd b lr) = Nd b (mod2 (insert ks) k lr)" + "insert [] Lf = Nd True (Lf,Lf)" | + "insert [] (Nd b lr) = Nd True lr" | + "insert (k#ks) Lf = Nd False (mod2 (insert ks) k (Lf,Lf))" | + "insert (k#ks) (Nd b lr) = Nd b (mod2 (insert ks) k lr)" lemma isin_insert: "isin (insert xs t) ys = (xs = ys \ isin t ys)" -apply(induction xs t arbitrary: ys rule: insert.induct) -apply (auto split: list.splits if_splits) -done +proof (induction xs t arbitrary: ys rule: insert.induct) +qed (auto split: list.splits if_splits) text \A simple implementation of delete; does not shrink the trie!\ fun delete0 :: "bool list \ trie \ trie" where -"delete0 ks Lf = Lf" | -"delete0 ks (Nd b lr) = + "delete0 ks Lf = Lf" | + "delete0 ks (Nd b lr) = (case ks of [] \ Nd False lr | k#ks' \ Nd b (mod2 (delete0 ks') k lr))" lemma isin_delete0: "isin (delete0 as t) bs = (as \ bs \ isin t bs)" -apply(induction as t arbitrary: bs rule: delete0.induct) -apply (auto split: list.splits if_splits) -done +proof (induction as t arbitrary: bs rule: delete0.induct) +qed (auto split: list.splits if_splits) text \Now deletion with shrinking:\ fun node :: "bool \ trie * trie \ trie" where -"node b lr = (if \ b \ lr = (Lf,Lf) then Lf else Nd b lr)" + "node b lr = (if \ b \ lr = (Lf,Lf) then Lf else Nd b lr)" fun delete :: "bool list \ trie \ trie" where -"delete ks Lf = Lf" | -"delete ks (Nd b lr) = + "delete ks Lf = Lf" | + "delete ks (Nd b lr) = (case ks of [] \ node False lr | k#ks' \ node b (mod2 (delete ks') k lr))" lemma isin_delete: "isin (delete xs t) ys = (xs \ ys \ isin t ys)" -apply(induction xs t arbitrary: ys rule: delete.induct) - apply simp -apply (auto split: list.splits if_splits) - apply (metis isin.simps(1)) - apply (metis isin.simps(1)) + apply(induction xs t arbitrary: ys rule: delete.induct) + apply (auto split: list.splits if_splits) + apply (metis isin.simps(1))+ done definition set_trie :: "trie \ bool list set" where -"set_trie t = {xs. isin t xs}" + "set_trie t = {xs. isin t xs}" lemma set_trie_empty: "set_trie empty = {}" -by(simp add: set_trie_def) + by(simp add: set_trie_def) lemma set_trie_isin: "isin t xs = (xs \ set_trie t)" -by(simp add: set_trie_def) + by(simp add: set_trie_def) lemma set_trie_insert: "set_trie(insert xs t) = set_trie t \ {xs}" -by(auto simp add: isin_insert set_trie_def) + by(auto simp add: isin_insert set_trie_def) lemma set_trie_delete: "set_trie(delete xs t) = set_trie t - {xs}" -by(auto simp add: isin_delete set_trie_def) + by(auto simp add: isin_delete set_trie_def) text \Invariant: tries are fully shrunk:\ fun invar where -"invar Lf = True" | -"invar (Nd b (l,r)) = (invar l \ invar r \ (l = Lf \ r = Lf \ b))" + "invar Lf = True" | + "invar (Nd b (l,r)) = (invar l \ invar r \ (l = Lf \ r = Lf \ b))" lemma insert_Lf: "insert xs t \ Lf" -using insert.elims by blast + using insert.elims by blast lemma invar_insert: "invar t \ invar(insert xs t)" proof(induction xs t rule: insert.induct) @@ -122,23 +118,10 @@ qed interpretation S: Set -where empty = empty and isin = isin and insert = insert and delete = delete -and set = set_trie and invar = invar -proof (standard, goal_cases) - case 1 show ?case by (rule set_trie_empty) -next - case 2 show ?case by(rule set_trie_isin) -next - case 3 thus ?case by(auto simp: set_trie_insert) -next - case 4 show ?case by(rule set_trie_delete) -next - case 5 show ?case by(simp) -next - case 6 thus ?case by(rule invar_insert) -next - case 7 thus ?case by(rule invar_delete) -qed + where empty = empty and isin = isin and insert = insert and delete = delete + and set = set_trie and invar = invar + unfolding Set_def + by (smt (verit, best) Tries_Binary.empty_def invar.simps(1) invar_delete invar_insert set_trie_delete set_trie_empty set_trie_insert set_trie_isin) subsection "Patricia Trie" @@ -147,24 +130,24 @@ text \Fully shrunk:\ fun invarP where -"invarP LfP = True" | -"invarP (NdP ps b (l,r)) = (invarP l \ invarP r \ (l = LfP \ r = LfP \ b))" + "invarP LfP = True" | + "invarP (NdP ps b (l,r)) = (invarP l \ invarP r \ (l = LfP \ r = LfP \ b))" fun isinP :: "trieP \ bool list \ bool" where -"isinP LfP ks = False" | -"isinP (NdP ps b lr) ks = + "isinP LfP ks = False" | + "isinP (NdP ps b lr) ks = (let n = length ps in if ps = take n ks then case drop n ks of [] \ b | k#ks' \ isinP (sel2 k lr) ks' else False)" definition emptyP :: trieP where -[simp]: "emptyP = LfP" + [simp]: "emptyP = LfP" fun lcp :: "'a list \ 'a list \ 'a list \ 'a list \ 'a list" where -"lcp [] ys = ([],[],ys)" | -"lcp xs [] = ([],xs,[])" | -"lcp (x#xs) (y#ys) = + "lcp [] ys = ([],[],ys)" | + "lcp xs [] = ([],xs,[])" | + "lcp (x#xs) (y#ys) = (if x\y then ([],x#xs,y#ys) else let (ps,xs',ys') = lcp xs ys in (x#ps,xs',ys'))" @@ -172,12 +155,12 @@ lemma mod2_cong[fundef_cong]: "\ lr = lr'; k = k'; \a b. lr'=(a,b) \ f (a) = f' (a) ; \a b. lr'=(a,b) \ f (b) = f' (b) \ \ mod2 f k lr= mod2 f' k' lr'" -by(cases lr, cases lr', auto) + by(cases lr, cases lr', auto) fun insertP :: "bool list \ trieP \ trieP" where -"insertP ks LfP = NdP ks True (LfP,LfP)" | -"insertP ks (NdP ps b lr) = + "insertP ks LfP = NdP ks True (LfP,LfP)" | + "insertP ks (NdP ps b lr) = (case lcp ks ps of (qs, k#ks', p#ps') \ let tp = NdP ps' b lr; tk = NdP ks' True (LfP,LfP) in @@ -192,7 +175,7 @@ text \Smart constructor that shrinks:\ definition nodeP :: "bool list \ bool \ trieP * trieP \ trieP" where -"nodeP ps b lr = + "nodeP ps b lr = (if b then NdP ps b lr else case lr of (LfP,LfP) \ LfP | @@ -201,8 +184,8 @@ _ \ NdP ps b lr)" fun deleteP :: "bool list \ trieP \ trieP" where -"deleteP ks LfP = LfP" | -"deleteP ks (NdP ps b lr) = + "deleteP ks LfP = LfP" | + "deleteP ks (NdP ps b lr) = (case lcp ks ps of (_, _, _#_) \ NdP ps b lr | (_, k#ks', []) \ nodeP ps b (mod2 (deleteP ks') k lr) | @@ -215,13 +198,13 @@ text \First step: @{typ trieP} implements @{typ trie} via the abstraction function \abs_trieP\:\ fun prefix_trie :: "bool list \ trie \ trie" where -"prefix_trie [] t = t" | -"prefix_trie (k#ks) t = + "prefix_trie [] t = t" | + "prefix_trie (k#ks) t = (let t' = prefix_trie ks t in Nd False (if k then (Lf,t') else (t',Lf)))" fun abs_trieP :: "trieP \ trie" where -"abs_trieP LfP = Lf" | -"abs_trieP (NdP ps b (l,r)) = prefix_trie ps (Nd b (abs_trieP l, abs_trieP r))" + "abs_trieP LfP = Lf" | + "abs_trieP (NdP ps b (l,r)) = prefix_trie ps (Nd b (abs_trieP l, abs_trieP r))" text \Correctness of @{const isinP}:\ @@ -229,96 +212,82 @@ lemma isin_prefix_trie: "isin (prefix_trie ps t) ks = (ps = take (length ps) ks \ isin t (drop (length ps) ks))" -apply(induction ps arbitrary: ks) -apply(auto split: list.split) -done + by (induction ps arbitrary: ks) (auto split: list.split) lemma abs_trieP_isinP: "isinP t ks = isin (abs_trieP t) ks" -apply(induction t arbitrary: ks rule: abs_trieP.induct) - apply(auto simp: isin_prefix_trie split: list.split) -done +proof (induction t arbitrary: ks rule: abs_trieP.induct) +qed (auto simp: isin_prefix_trie split: list.split) text \Correctness of @{const insertP}:\ lemma prefix_trie_Lfs: "prefix_trie ks (Nd True (Lf,Lf)) = insert ks Lf" -apply(induction ks) -apply auto -done + by (induction ks) auto lemma insert_prefix_trie_same: "insert ps (prefix_trie ps (Nd b lr)) = prefix_trie ps (Nd True lr)" -apply(induction ps) -apply auto -done + by (induction ps) auto lemma insert_append: "insert (ks @ ks') (prefix_trie ks t) = prefix_trie ks (insert ks' t)" -apply(induction ks) -apply auto -done + by (induction ks) auto lemma prefix_trie_append: "prefix_trie (ps @ qs) t = prefix_trie ps (prefix_trie qs t)" -apply(induction ps) -apply auto -done + by (induction ps) auto lemma lcp_if: "lcp ks ps = (qs, ks', ps') \ ks = qs @ ks' \ ps = qs @ ps' \ (ks' \ [] \ ps' \ [] \ hd ks' \ hd ps')" -apply(induction ks ps arbitrary: qs ks' ps' rule: lcp.induct) -apply(auto split: prod.splits if_splits) -done +proof (induction ks ps arbitrary: qs ks' ps' rule: lcp.induct) +qed (auto split: prod.splits if_splits) lemma abs_trieP_insertP: "abs_trieP (insertP ks t) = insert ks (abs_trieP t)" -apply(induction t arbitrary: ks) -apply(auto simp: prefix_trie_Lfs insert_prefix_trie_same insert_append prefix_trie_append - dest!: lcp_if split: list.split prod.split if_splits) -done +proof (induction t arbitrary: ks) +qed (auto simp: prefix_trie_Lfs insert_prefix_trie_same insert_append prefix_trie_append + dest!: lcp_if split: list.split prod.split if_splits) text \Correctness of @{const deleteP}:\ lemma prefix_trie_Lf: "prefix_trie xs t = Lf \ xs = [] \ t = Lf" -by(cases xs)(auto) + by(cases xs)(auto) lemma abs_trieP_Lf: "abs_trieP t = Lf \ t = LfP" -by(cases t) (auto simp: prefix_trie_Lf) + by(cases t) (auto simp: prefix_trie_Lf) lemma delete_prefix_trie: "delete xs (prefix_trie xs (Nd b (l,r))) = (if (l,r) = (Lf,Lf) then Lf else prefix_trie xs (Nd False (l,r)))" -by(induction xs)(auto simp: prefix_trie_Lf) + by(induction xs)(auto simp: prefix_trie_Lf) lemma delete_append_prefix_trie: "delete (xs @ ys) (prefix_trie xs t) = (if delete ys t = Lf then Lf else prefix_trie xs (delete ys t))" -by(induction xs)(auto simp: prefix_trie_Lf) + by(induction xs)(auto simp: prefix_trie_Lf) lemma nodeP_LfP2: "nodeP xs False (LfP, LfP) = LfP" -by(simp add: nodeP_def) + by(simp add: nodeP_def) text \Some non-inductive aux. lemmas:\ lemma abs_trieP_nodeP: "a\LfP \ b \ LfP \ abs_trieP (nodeP xs f (a, b)) = prefix_trie xs (Nd f (abs_trieP a, abs_trieP b))" -by(auto simp add: nodeP_def prefix_trie_append split: trieP.split) + by(auto simp add: nodeP_def prefix_trie_append split: trieP.split) lemma nodeP_True: "nodeP ps True lr = NdP ps True lr" -by(simp add: nodeP_def) + by(simp add: nodeP_def) lemma delete_abs_trieP: "delete ks (abs_trieP t) = abs_trieP (deleteP ks t)" -apply(induction t arbitrary: ks) -apply(auto simp: delete_prefix_trie delete_append_prefix_trie - prefix_trie_append prefix_trie_Lf abs_trieP_Lf nodeP_LfP2 abs_trieP_nodeP nodeP_True - dest!: lcp_if split: if_splits list.split prod.split) -done +proof (induction t arbitrary: ks) +qed (auto simp: delete_prefix_trie delete_append_prefix_trie + prefix_trie_append prefix_trie_Lf abs_trieP_Lf nodeP_LfP2 abs_trieP_nodeP nodeP_True + dest!: lcp_if split: if_splits list.split prod.split) text \Invariant preservation:\ lemma insertP_LfP: "insertP xs t \ LfP" -by(cases t)(auto split: prod.split list.split) + by(cases t)(auto split: prod.split list.split) lemma invarP_insertP: "invarP t \ invarP(insertP xs t)" proof(induction t arbitrary: xs) @@ -331,7 +300,7 @@ (* Inlining this proof leads to nontermination *) lemma invarP_nodeP: "\ invarP t1; invarP t2\ \ invarP (nodeP xs b (t1, t2))" -by (auto simp add: nodeP_def split: trieP.split) + by (auto simp add: nodeP_def split: trieP.split) lemma invarP_deleteP: "invarP t \ invarP(deleteP xs t)" proof(induction t arbitrary: xs) @@ -345,20 +314,20 @@ text \The overall correctness proof. Simply composes correctness lemmas.\ definition set_trieP :: "trieP \ bool list set" where -"set_trieP = set_trie o abs_trieP" + "set_trieP = set_trie o abs_trieP" lemma isinP_set_trieP: "isinP t xs = (xs \ set_trieP t)" -by(simp add: abs_trieP_isinP set_trie_isin set_trieP_def) + by(simp add: abs_trieP_isinP set_trie_isin set_trieP_def) lemma set_trieP_insertP: "set_trieP (insertP xs t) = set_trieP t \ {xs}" -by(simp add: abs_trieP_insertP set_trie_insert set_trieP_def) + by(simp add: abs_trieP_insertP set_trie_insert set_trieP_def) lemma set_trieP_deleteP: "set_trieP (deleteP xs t) = set_trieP t - {xs}" -by(auto simp: set_trie_delete set_trieP_def simp flip: delete_abs_trieP) + by(auto simp: set_trie_delete set_trieP_def simp flip: delete_abs_trieP) interpretation SP: Set -where empty = emptyP and isin = isinP and insert = insertP and delete = deleteP -and set = set_trieP and invar = invarP + where empty = emptyP and isin = isinP and insert = insertP and delete = deleteP + and set = set_trieP and invar = invarP proof (standard, goal_cases) case 1 show ?case by (simp add: set_trieP_def set_trie_def) next diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Number_Theory/Eratosthenes.thy --- a/src/HOL/Number_Theory/Eratosthenes.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Number_Theory/Eratosthenes.thy Mon Sep 11 22:59:34 2023 +0200 @@ -109,8 +109,7 @@ with q have a: "a = Suc n * q - 2" by simp with B have "q + n * q < n + n + 2" by auto then have "m * q < m * 2" by (simp add: m_def) - with \m > 0\ have "q < 2" by simp - with \q > 0\ have "q = 1" by simp + with \m > 0\ \q > 0\ have "q = 1" by simp with a have "a = n - 1" by simp with \n > 0\ C show False by simp qed @@ -212,7 +211,6 @@ from \m dvd Suc n\ obtain q where "Suc n = m * q" .. with \Suc (Suc n) \ m\ have "Suc (m * q) \ m" by simp then have "m * q < m" by arith - then have "q = 0" by simp with \Suc n = m * q\ show ?thesis by simp qed have aux2: "m dvd q" @@ -303,15 +301,7 @@ lemma primes_upto_sieve [code]: "primes_upto n = map fst (filter snd (enumerate 2 (sieve 1 (replicate (n - 1) True))))" -proof - - have "primes_upto n = sorted_list_of_set (numbers_of_marks 2 (sieve 1 (replicate (n - 1) True)))" - apply (rule sorted_distinct_set_unique) - apply (simp_all only: set_primes_upto_sieve numbers_of_marks_def) - apply auto - done - then show ?thesis - by (simp add: sorted_list_of_set_numbers_of_marks) -qed + using primes_upto_def set_primes_upto set_primes_upto_sieve sorted_list_of_set_numbers_of_marks by presburger lemma prime_in_primes_upto: "prime n \ n \ set (primes_upto n)" by (simp add: set_primes_upto) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Number_Theory/Residues.thy --- a/src/HOL/Number_Theory/Residues.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Number_Theory/Residues.thy Mon Sep 11 22:59:34 2023 +0200 @@ -59,12 +59,18 @@ qed lemma comm_monoid: "comm_monoid R" - unfolding R_m_def residue_ring_def - apply (rule comm_monoidI) - using m_gt_one apply auto - apply (metis mod_mult_right_eq mult.assoc mult.commute) - apply (metis mult.commute) - done +proof - + have "\x y z. \x \ carrier R; y \ carrier R; z \ carrier R\ \ x \ y \ z = x \ (y \ z)" + "\x y. \x \ carrier R; y \ carrier R\ \ x \ y = y \ x" + unfolding R_m_def residue_ring_def + by (simp_all add: algebra_simps mod_mult_right_eq) + then show ?thesis + unfolding R_m_def residue_ring_def + by unfold_locales (use m_gt_one in simp_all) +qed + +interpretation comm_monoid R + using comm_monoid by blast lemma cring: "cring R" apply (intro cringI abelian_group comm_monoid) @@ -101,21 +107,31 @@ lemma res_one_eq: "\ = 1" by (auto simp: R_m_def residue_ring_def units_of_def) -lemma res_units_eq: "Units R = {x. 0 < x \ x < m \ coprime x m}" - using m_gt_one - apply (auto simp add: Units_def R_m_def residue_ring_def ac_simps invertible_coprime intro: ccontr) - apply (subst (asm) coprime_iff_invertible'_int) - apply (auto simp add: cong_def) - done +lemma res_units_eq: "Units R = {x. 0 < x \ x < m \ coprime x m}" (is "_ = ?rhs") +proof + show "Units R \ ?rhs" + using zero_less_mult_iff invertible_coprime + by (fastforce simp: Units_def R_m_def residue_ring_def) +next + show "?rhs \ Units R" + unfolding Units_def R_m_def residue_ring_def + by (force simp add: cong_def coprime_iff_invertible'_int mult.commute) +qed lemma res_neg_eq: "\ x = (- x) mod m" - using m_gt_one unfolding R_m_def a_inv_def m_inv_def residue_ring_def - apply simp - apply (rule the_equality) - apply (simp add: mod_add_right_eq) - apply (simp add: add.commute mod_add_right_eq) - apply (metis add.right_neutral minus_add_cancel mod_add_right_eq mod_pos_pos_trivial) - done +proof - + have "\ x = (THE y. 0 \ y \ y < m \ (x + y) mod m = 0 \ (y + x) mod m = 0)" + by (simp add: R_m_def a_inv_def m_inv_def residue_ring_def) + also have "\ = (- x) mod m" + proof - + have "\y. 0 \ y \ y < m \ (x + y) mod m = 0 \ (y + x) mod m = 0 \ + y = - x mod m" + by (metis minus_add_cancel mod_add_eq plus_int_code(1) zmod_trivial_iff) + then show ?thesis + by (intro the_equality) (use m_gt_one in \simp add: add.commute mod_add_right_eq\) + qed + finally show ?thesis . +qed lemma finite [iff]: "finite (carrier R)" by (simp add: res_carrier_eq) @@ -148,10 +164,15 @@ (* FIXME revise algebra library to use 1? *) lemma pow_cong: "(x mod m) [^] n = x^n mod m" using m_gt_one - apply (induct n) - apply (auto simp add: nat_pow_def one_cong) - apply (metis mult.commute mult_cong) - done +proof (induct n) + case 0 + then show ?case + by (simp add: one_cong) +next + case (Suc n) + then show ?case + by (simp add: mult_cong power_commutes) +qed lemma neg_cong: "\ (x mod m) = (- x) mod m" by (metis mod_minus_eq res_neg_eq) @@ -189,10 +210,7 @@ text \Other useful facts about the residue ring.\ lemma one_eq_neg_one: "\ = \ \ \ m = 2" - apply (simp add: res_one_eq res_neg_eq) - apply (metis add.commute add_diff_cancel mod_mod_trivial one_add_one uminus_add_conv_diff - zero_neq_one zmod_zminus1_eq_if) - done + using one_cong res_neg_eq res_one_eq zmod_zminus1_eq_if by fastforce end @@ -206,9 +224,7 @@ sublocale residues_prime < residues p unfolding R_def residues_def - using p_prime apply auto - apply (metis (full_types) of_nat_1 of_nat_less_iff prime_gt_1_nat) - done + by (auto simp: p_prime prime_gt_1_int) context residues_prime begin @@ -227,7 +243,7 @@ lemma p_coprime_right_int: "coprime a (int p) \ \ int p dvd a" - using p_coprime_left_int [of a] by (simp add: ac_simps) + using coprime_commute p_coprime_left_int by blast lemma is_field: "field R" proof - @@ -239,9 +255,7 @@ qed lemma res_prime_units_eq: "Units R = {1..p - 1}" - apply (subst res_units_eq) - apply (auto simp add: p_coprime_right_int zdvd_not_zless) - done + by (auto simp add: res_units_eq p_coprime_right_int zdvd_not_zless) end @@ -277,7 +291,7 @@ qed lemma (in residues_prime) prime_totient_eq: "totient p = p - 1" - using totient_eq by (simp add: res_prime_units_eq) + using p_prime totient_prime by blast lemma (in residues) euler_theorem: assumes "coprime a m" @@ -322,9 +336,8 @@ lemma (in field) inv_pair_lemma: "x \ Units R \ y \ Units R \ {x, inv x} \ {y, inv y} \ {x, inv x} \ {y, inv y} = {}" - apply auto - apply (metis Units_inv_inv)+ - done + by auto + lemma (in residues_prime) wilson_theorem1: assumes a: "p > 2" @@ -333,27 +346,20 @@ let ?Inverse_Pairs = "{{x, inv x}| x. x \ Units R - {\, \ \}}" have UR: "Units R = {\, \ \} \ \?Inverse_Pairs" by auto + have 11: "\ \ \ \" + using a one_eq_neg_one by force have "(\i\Units R. i) = (\i\{\, \ \}. i) \ (\i\\?Inverse_Pairs. i)" apply (subst UR) apply (subst finprod_Un_disjoint) - apply (auto intro: funcsetI) - using inv_one apply auto[1] - using inv_eq_neg_one_eq apply auto + using inv_one inv_eq_neg_one_eq apply (auto intro!: funcsetI)+ done also have "(\i\{\, \ \}. i) = \ \" - apply (subst finprod_insert) - apply auto - apply (frule one_eq_neg_one) - using a apply force - done + by (simp add: 11) also have "(\i\(\?Inverse_Pairs). i) = (\A\?Inverse_Pairs. (\y\A. y))" - apply (subst finprod_Union_disjoint) - apply (auto simp: pairwise_def disjnt_def) - apply (metis Units_inv_inv)+ - done + by (rule finprod_Union_disjoint) (auto simp: pairwise_def disjnt_def dest!: inv_eq_imp_eq) also have "\ = \" apply (rule finprod_one_eqI) - apply auto + apply clarsimp apply (subst finprod_insert) apply auto apply (metis inv_eq_self) @@ -365,11 +371,8 @@ also have "\ = (\i\Units R. i) mod p" by (rule prod_cong) auto also have "\ = fact (p - 1) mod p" - apply (simp add: fact_prod) using assms - apply (subst res_prime_units_eq) - apply (simp add: int_prod zmod_int prod_int_eq) - done + by (simp add: res_prime_units_eq int_prod zmod_int prod_int_eq fact_prod) finally have "fact (p - 1) mod p = \ \" . then show ?thesis by (simp add: cong_def res_neg_eq res_one_eq zmod_int) @@ -396,7 +399,7 @@ lemma mod_nat_int_pow_eq: fixes n :: nat and p a :: int shows "a \ 0 \ p \ 0 \ (nat a ^ n) mod (nat p) = nat ((a ^ n) mod p)" - by (simp add: int_one_le_iff_zero_less nat_mod_distrib order_less_imp_le nat_power_eq[symmetric]) + by (simp add: nat_mod_as_int) theorem residue_prime_mult_group_has_gen: fixes p :: nat diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Probability/Giry_Monad.thy --- a/src/HOL/Probability/Giry_Monad.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Probability/Giry_Monad.thy Mon Sep 11 22:59:34 2023 +0200 @@ -31,7 +31,7 @@ qed lemma (in subprob_space) emeasure_subprob_space_less_top: "emeasure M A \ top" - using emeasure_finite[of A] . + by simp lemma prob_space_imp_subprob_space: "prob_space M \ subprob_space M" @@ -44,10 +44,10 @@ by (rule subprob_spaceI) (simp_all add: emeasure_space_1 not_empty) lemma subprob_space_sigma [simp]: "\ \ {} \ subprob_space (sigma \ X)" -by(rule subprob_spaceI)(simp_all add: emeasure_sigma space_measure_of_conv) + by(rule subprob_spaceI)(simp_all add: emeasure_sigma space_measure_of_conv) lemma subprob_space_null_measure: "space M \ {} \ subprob_space (null_measure M)" -by(simp add: null_measure_def) + by(simp add: null_measure_def) lemma (in subprob_space) subprob_space_distr: assumes f: "f \ measurable M M'" and "space M' \ {}" shows "subprob_space (distr M M' f)" @@ -343,7 +343,7 @@ assumes [measurable]: "f \ measurable M N" shows "(\M'. distr M' N f) \ measurable (subprob_algebra M) (subprob_algebra N)" proof (cases "space N = {}") - assume not_empty: "space N \ {}" + case False show ?thesis proof (rule measurable_subprob_algebra) fix A assume A: "A \ sets N" @@ -355,8 +355,8 @@ also have "\" using A by (intro measurable_emeasure_subprob_algebra) simp finally show "(\M'. emeasure (distr M' N f) A) \ borel_measurable (subprob_algebra M)" . - qed (auto intro!: subprob_space.subprob_space_distr simp: space_subprob_algebra not_empty cong: measurable_cong_sets) -qed (insert assms, auto simp: measurable_empty_iff space_subprob_algebra_empty_iff) + qed (auto intro!: subprob_space.subprob_space_distr simp: space_subprob_algebra False cong: measurable_cong_sets) +qed (use assms in \auto simp: measurable_empty_iff space_subprob_algebra_empty_iff\) lemma emeasure_space_subprob_algebra[measurable]: "(\a. emeasure a (space a)) \ borel_measurable (subprob_algebra N)" @@ -565,10 +565,7 @@ lemma subprob_space_return_ne: assumes "space M \ {}" shows "subprob_space (return M x)" -proof - show "emeasure (return M x) (space (return M x)) \ 1" - by (subst emeasure_return) (auto split: split_indicator) -qed (simp, fact) + by (metis assms emeasure_return indicator_simps(2) sets.top space_return subprob_spaceI subprob_space_return zero_le) lemma measure_return: assumes X: "X \ sets M" shows "measure (return M x) X = indicator X x" unfolding measure_def emeasure_return[OF X, of x] by (simp split: split_indicator) @@ -654,8 +651,7 @@ by (auto simp add: emeasure_distr f_M' cong: measurable_cong_sets) also have "\ = (\\<^sup>+M''. emeasure (g x) (f M'' -` A \ space M) \?R)" apply (subst emeasure_pair_measure_alt) - apply (rule measurable_sets[OF _ A]) - apply (auto simp add: f_M' cong: measurable_cong_sets) + apply (force simp add: f_M' cong: measurable_cong_sets intro!: measurable_sets[OF _ A]) apply (intro nn_integral_cong arg_cong[where f="emeasure (g x)"]) apply (auto simp: space_subprob_algebra space_pair_measure) done @@ -668,10 +664,10 @@ qed qed also have "\" - apply (intro measurable_compose[OF measurable_pair_measure measurable_distr]) - apply (rule return_measurable) - apply measurable - done + proof (intro measurable_compose[OF measurable_pair_measure measurable_distr]) + show "return L \ L \\<^sub>M subprob_algebra L" + by (rule return_measurable) + qed measurable finally show ?thesis . qed @@ -703,19 +699,15 @@ have *: "\x. fst x \ space M \ snd x \ A (fst x) \ x \ (SIGMA x:space M. A x)" by (auto simp: fun_eq_iff) - have "(\(x, y). indicator (A x) y::ennreal) \ borel_measurable (M \\<^sub>M N)" + have MN: "Measurable.pred (M \\<^sub>M N) (\w. w \ Sigma (space M) A)" + by auto + then have "(\(x, y). indicator (A x) y::ennreal) \ borel_measurable (M \\<^sub>M N)" apply measurable - apply (subst measurable_cong) - apply (rule *) - apply (auto simp: space_pair_measure) - done + by (smt (verit, best) MN measurable_cong mem_Sigma_iff prod.collapse space_pair_measure) then have "(\x. integral\<^sup>N (L x) (indicator (A x))) \ borel_measurable M" by (intro nn_integral_measurable_subprob_algebra2[where N=N] L) then show "(\x. emeasure (L x) (A x)) \ borel_measurable M" - apply (rule measurable_cong[THEN iffD1, rotated]) - apply (rule nn_integral_indicator) - apply (simp add: subprob_measurableD[OF L] **) - done + by (smt (verit) "**" L measurable_cong_simp nn_integral_indicator sets_kernel) qed lemma measure_measurable_subprob_algebra2: @@ -751,7 +743,7 @@ next assume "space (subprob_algebra N) \ {}" with eq show ?thesis - by (fastforce simp add: space_subprob_algebra) + by (smt (verit) equals0I mem_Collect_eq space_subprob_algebra) qed qed @@ -807,10 +799,11 @@ assume [simp]: "space N \ {}" fix M assume M: "M \ space (subprob_algebra (subprob_algebra N))" then have "(\\<^sup>+M'. emeasure M' (space N) \M) \ (\\<^sup>+M'. 1 \M)" - apply (intro nn_integral_mono) - apply (auto simp: space_subprob_algebra - dest!: sets_eq_imp_space_eq subprob_space.emeasure_space_le_1) - done + proof (intro nn_integral_mono) + show "\x. \M \ space (subprob_algebra (subprob_algebra N)); x \ space M\ + \ emeasure x (space N) \ 1" + by (smt (verit) mem_Collect_eq sets_eq_imp_space_eq space_subprob_algebra subprob_space.subprob_emeasure_le_1) + qed with M show "subprob_space (join M)" by (intro subprob_spaceI) (auto simp: emeasure_join space_subprob_algebra M dest: subprob_space.emeasure_space_le_1) @@ -888,7 +881,7 @@ lemma measurable_join1: "\ f \ measurable N K; sets M = sets (subprob_algebra N) \ \ f \ measurable (join M) K" -by(simp add: measurable_def) + by(simp add: measurable_def) lemma fixes f :: "_ \ real" @@ -1051,12 +1044,15 @@ lemma join_return': assumes "sets N = sets M" shows "join (distr M (subprob_algebra N) (return N)) = M" -apply (rule measure_eqI) -apply (simp add: assms) -apply (subgoal_tac "return N \ measurable M (subprob_algebra N)") -apply (simp add: emeasure_join nn_integral_distr measurable_emeasure_subprob_algebra assms) -apply (subst measurable_cong_sets, rule assms[symmetric], rule refl, rule return_measurable) -done +proof (rule measure_eqI) + fix A + have "return N \ measurable M (subprob_algebra N)" + using assms by auto + moreover + assume "A \ sets (join (distr M (subprob_algebra N) (return N)))" + ultimately show "emeasure (join (distr M (subprob_algebra N) (return N))) A = emeasure M A" + by (simp add: emeasure_join nn_integral_distr measurable_emeasure_subprob_algebra assms) +qed (simp add: assms) lemma join_distr_distr: fixes f :: "'a \ 'b" and M :: "'a measure measure" and N :: "'b measure" @@ -1107,7 +1103,7 @@ by (simp add: bind_def) lemma sets_bind_empty: "sets M = {} \ sets (bind M f) = {{}}" - by (auto simp: bind_def) + by auto lemma space_bind_empty: "space M = {} \ space (bind M f) = {}" by (simp add: bind_def) @@ -1139,11 +1135,12 @@ lemma bind_nonempty': assumes "f \ measurable M (subprob_algebra N)" "x \ space M" shows "bind M f = join (distr M (subprob_algebra N) f)" - using assms - apply (subst bind_nonempty, blast) - apply (subst subprob_algebra_cong[OF sets_kernel[OF assms(1) someI_ex]], blast) - apply (simp add: subprob_algebra_cong[OF sets_kernel[OF assms]]) - done +proof - + have "join (distr M (subprob_algebra (f (SOME x. x \ space M))) f) = join (distr M (subprob_algebra N) f)" + by (metis assms someI_ex subprob_algebra_cong subprob_measurableD(2)) + with assms show ?thesis + by (metis bind_nonempty empty_iff) +qed lemma bind_nonempty'': assumes "f \ measurable M (subprob_algebra N)" "space M \ {}" @@ -1182,14 +1179,15 @@ have "(AE x in M \ N. P x) \ (\\<^sup>+ x. integral\<^sup>N (N x) (indicator {x \ space B. \ P x}) \M) = 0" by (simp add: AE_iff_nn_integral sets_bind[OF _ M] space_bind[OF _ M] * nn_integral_bind[where B=B] del: nn_integral_indicator) - also have "\ = (AE x in M. AE y in N x. P y)" - apply (subst nn_integral_0_iff_AE) + also have "... = (AE x in M. integral\<^sup>N (N x) (indicator {x \ space B. \ P x}) = 0)" + proof (rule nn_integral_0_iff_AE) + show "(\x. integral\<^sup>N (N x) (indicator {x \ space B. \ P x})) \ borel_measurable M" apply (rule measurable_compose[OF N nn_integral_measurable_subprob_algebra]) - apply measurable + by measurable + qed + also have "\ = (AE x in M. AE y in N x. P y)" apply (intro eventually_subst AE_I2) - apply (auto simp add: subprob_measurableD(1)[OF N] - intro!: AE_iff_measurable[symmetric]) - done + by (auto simp add: subprob_measurableD(1)[OF N] intro!: AE_iff_measurable[symmetric]) finally show ?thesis . qed @@ -1351,13 +1349,14 @@ assumes N: "N \ measurable M (subprob_algebra K)" "space M \ {}" assumes f: "f \ measurable K R" shows "distr (M \ N) R f = (M \ (\x. distr (N x) R f))" - unfolding bind_nonempty''[OF N] - apply (subst bind_nonempty''[OF measurable_compose[OF N(1) measurable_distr] N(2)]) - apply (rule f) - apply (simp add: join_distr_distr[OF _ f, symmetric]) - apply (subst distr_distr[OF measurable_distr, OF f N(1)]) - apply (simp add: comp_def) - done +proof - + have "distr (join (distr M (subprob_algebra K) N)) R f = + join (distr M (subprob_algebra R) (\x. distr (N x) R f))" + by (simp add: assms distr_distr[OF measurable_distr] comp_def flip: join_distr_distr) + with assms show ?thesis + unfolding bind_nonempty''[OF N] + by (smt (verit) bind_nonempty sets_distr subprob_algebra_cong) +qed lemma bind_distr: assumes f[measurable]: "f \ measurable M X" @@ -1393,16 +1392,20 @@ show "sets (restrict_space (bind M N) X) = sets (bind M (\x. restrict_space (N x) X))" by (simp add: sets_restrict_space assms(2) sets_bind[OF sets_kernel[OF restrict_space_measurable[OF assms(4,3,1)]]]) fix A assume "A \ sets (restrict_space (M \ N) X)" - with X have "A \ sets K" "A \ X" + with X have A: "A \ sets K" "A \ X" by (auto simp: sets_restrict_space) - then show "emeasure (restrict_space (M \ N) X) A = emeasure (M \ (\x. restrict_space (N x) X)) A" - using assms - apply (subst emeasure_restrict_space) - apply (simp_all add: emeasure_bind[OF assms(2,1)]) - apply (subst emeasure_bind[OF _ restrict_space_measurable[OF _ _ N]]) - apply (auto simp: sets_restrict_space emeasure_restrict_space space_subprob_algebra - intro!: nn_integral_cong dest!: measurable_space) + then have "emeasure (restrict_space (M \ N) X) A = emeasure (M \ N) A" + by (simp add: emeasure_restrict_space) + also have "\ = \\<^sup>+ x. emeasure (N x) A \M" + by (metis \A \ sets K\ N \space M \ {}\ emeasure_bind) + also have "... = \\<^sup>+ x. emeasure (restrict_space (N x) X) A \M" + using A assms by (smt (verit, best) emeasure_restrict_space nn_integral_cong sets.Int_space_eq2 subprob_measurableD(2)) + also have "\ = emeasure (M \ (\x. restrict_space (N x) X)) A" + using A assms + apply (subst emeasure_bind[OF _ restrict_space_measurable]) + apply (auto simp: sets_restrict_space) done + finally show "emeasure (restrict_space (M \ N) X) A = emeasure (M \ (\x. restrict_space (N x) X)) A" . qed lemma bind_restrict_space: @@ -1442,13 +1445,18 @@ (simp_all add: space_subprob_algebra prob_space.not_empty emeasure_bind_const_prob_space) lemma bind_return_distr: - "space M \ {} \ f \ measurable M N \ bind M (return N \ f) = distr M N f" - apply (simp add: bind_nonempty) - apply (subst subprob_algebra_cong) - apply (rule sets_return) - apply (subst distr_distr[symmetric]) - apply (auto intro!: return_measurable simp: distr_distr[symmetric] join_return') - done + assumes "space M \ {}" "f \ measurable M N" + shows "bind M (return N \ f) = distr M N f" +proof - + have "bind M (return N \ f) + = join (distr M (subprob_algebra (return N (f (SOME x. x \ space M)))) (return N \ f))" + by (simp add: Giry_Monad.bind_def assms) + also have "\ = join (distr M (subprob_algebra N) (return N \ f))" + by (metis sets_return subprob_algebra_cong) + also have "\ = distr M N f" + by (metis assms(2) distr_distr join_return' return_measurable sets_distr) + finally show ?thesis . +qed lemma bind_return_distr': "space M \ {} \ f \ measurable M N \ bind M (\x. return N (f x)) = distr M N f" @@ -1469,6 +1477,9 @@ sets_kernel[OF M2 someI_ex[OF ex_in[OF \space N \ {}\]]] note space_some[simp] = sets_eq_imp_space_eq[OF this(1)] sets_eq_imp_space_eq[OF this(2)] + + have *: "(\x. distr x (subprob_algebra R) g) \ f \ M \\<^sub>M subprob_algebra (subprob_algebra R)" + using M1 M2 measurable_comp measurable_distr by blast have "bind M (\x. bind (f x) g) = join (distr M (subprob_algebra R) (join \ (\x. (distr x (subprob_algebra R) g)) \ f))" by (simp add: sets_eq_imp_space_eq[OF sets_fx] bind_nonempty o_def @@ -1478,10 +1489,7 @@ (subprob_algebra (subprob_algebra R)) (\x. distr x (subprob_algebra R) g)) (subprob_algebra R) join" - apply (subst distr_distr, - (blast intro: measurable_comp measurable_distr measurable_join M1 M2)+)+ - apply (simp add: o_assoc) - done + by (simp add: distr_distr M1 M2 measurable_distr measurable_join fun.map_comp *) also have "join ... = bind (bind M f) g" by (simp add: join_assoc join_distr_distr M2 bind_nonempty cong: subprob_algebra_cong) finally show ?thesis .. @@ -1637,7 +1645,7 @@ using measurable_space[OF g] by (auto simp: measurable_restrict_space2_iff prob_algebra_def space_pair_measure Pi_iff intro!: prob_space.prob_space_bind[where S=R] AE_I2) -qed (insert g, simp) +qed (use g in simp) lemma measurable_prob_algebra_generated: @@ -1659,7 +1667,7 @@ by (intro measurable_cong) auto then show "(\a. emeasure (K a) \) \ borel_measurable M" by simp qed -qed (insert subsp, auto) +qed (use subsp in auto) lemma in_space_prob_algebra: "x \ space (prob_algebra M) \ emeasure x (space M) = 1" @@ -1668,13 +1676,7 @@ lemma prob_space_pair: assumes "prob_space M" "prob_space N" shows "prob_space (M \\<^sub>M N)" -proof - - interpret M: prob_space M by fact - interpret N: prob_space N by fact - interpret P: pair_prob_space M N proof qed - show ?thesis - by unfold_locales -qed + by (metis assms measurable_fst prob_space.distr_pair_fst prob_space_distrD) lemma measurable_pair_prob[measurable]: "f \ M \\<^sub>M prob_algebra N \ g \ M \\<^sub>M prob_algebra L \ (\x. f x \\<^sub>M g x) \ M \\<^sub>M prob_algebra (N \\<^sub>M L)" @@ -1738,7 +1740,7 @@ also from assms(3) x have "... = emeasure (distr (density M f') (count_space A) g) {x}" by (subst emeasure_distr) simp_all finally show "f x = emeasure (distr (density M f') (count_space A) g) {x}" . -qed (insert assms, auto) +qed (use assms in auto) lemma bind_cong_AE: assumes "M = N" @@ -1796,7 +1798,6 @@ by eventually_elim auto thus "y \ space M" by simp - show "M = return M y" proof (rule measure_eqI) fix X assume X: "X \ sets M" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Probability/Infinite_Product_Measure.thy --- a/src/HOL/Probability/Infinite_Product_Measure.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Probability/Infinite_Product_Measure.thy Mon Sep 11 22:59:34 2023 +0200 @@ -102,13 +102,11 @@ lemma sets_Collect_single': "i \ I \ {x\space (M i). P x} \ sets (M i) \ {x\space (PiM I M). P (x i)} \ sets (PiM I M)" - using sets_Collect_single[of i I "{x\space (M i). P x}" M] - by (simp add: space_PiM PiE_iff cong: conj_cong) + by auto lemma (in finite_product_prob_space) finite_measure_PiM_emb: "(\i. i \ I \ A i \ sets (M i)) \ measure (PiM I M) (Pi\<^sub>E I A) = (\i\I. measure (M i) (A i))" - using measure_PiM_emb[of I A] finite_index prod_emb_PiE_same_index[OF sets.sets_into_space, of I A M] - by auto + by (rule prob_times) lemma (in product_prob_space) PiM_component: assumes "i \ I" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Probability/Information.thy --- a/src/HOL/Probability/Information.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Probability/Information.thy Mon Sep 11 22:59:34 2023 +0200 @@ -11,10 +11,10 @@ begin lemma log_le: "1 < a \ 0 < x \ x \ y \ log a x \ log a y" - by (subst log_le_cancel_iff) auto + by simp lemma log_less: "1 < a \ 0 < x \ x < y \ log a x < log a y" - by (subst log_less_cancel_iff) auto + by simp lemma sum_cartesian_product': "(\x\A \ B. f x) = (\x\A. sum (\y. f (x, y)) B)" @@ -94,13 +94,11 @@ using f nn by (intro density_RN_deriv_density) auto then have eq: "AE x in M. RN_deriv M (density M f) x = f x" using f nn by (intro density_unique) auto - show "(\x. f x * entropy_density b M (density M (\x. ennreal (f x))) x \M) = (\x. f x * log b (f x) \M)" - apply (intro integral_cong_AE) - apply measurable - using eq nn - apply eventually_elim - apply (auto simp: entropy_density_def) - done + have "AE x in M. f x * entropy_density b M (density M (\x. ennreal (f x))) x = + f x * log b (f x)" + using eq nn by (auto simp: entropy_density_def) + then show "(\x. f x * entropy_density b M (density M (\x. ennreal (f x))) x \M) = (\x. f x * log b (f x) \M)" + by (intro integral_cong_AE) measurable qed fact+ lemma (in sigma_finite_measure) KL_density_density: @@ -240,10 +238,7 @@ have "AE x in M. 1 = RN_deriv M M x" proof (rule RN_deriv_unique) show "density M (\x. 1) = M" - apply (auto intro!: measure_eqI emeasure_density) - apply (subst emeasure_density) - apply auto - done + by (simp add: density_1) qed auto then have "AE x in M. log b (enn2real (RN_deriv M M x)) = 0" by (elim AE_mp) simp @@ -373,9 +368,7 @@ by (simp add: emeasure_pair_measure_Times) } then show ?thesis unfolding absolutely_continuous_def - apply (auto simp: null_sets_distr_iff) - apply (auto simp: null_sets_def intro!: measurable_sets) - done + by (metis emeasure_distr measurable_fst null_setsD1 null_setsD2 null_setsI sets_distr subsetI) qed lemma ac_snd: @@ -390,9 +383,7 @@ by (simp add: emeasure_pair_measure_Times) } then show ?thesis unfolding absolutely_continuous_def - apply (auto simp: null_sets_distr_iff) - apply (auto simp: null_sets_def intro!: measurable_sets) - done + by (metis emeasure_distr measurable_snd null_setsD1 null_setsD2 null_setsI sets_distr subsetI) qed lemma (in information_space) finite_entropy_integrable: @@ -473,7 +464,7 @@ unfolding \Q = P\ by (intro measure_eqI) (auto simp: emeasure_density) qed auto then have ae_0: "AE x in P. entropy_density b P Q x = 0" - by eventually_elim (auto simp: entropy_density_def) + by (auto simp: entropy_density_def) then have "integrable P (entropy_density b P Q) \ integrable Q (\x. 0::real)" using ed unfolding \Q = P\ by (intro integrable_cong_AE) auto then show "integrable Q (entropy_density b P Q)" by simp @@ -579,7 +570,7 @@ have B: "(AE x in ?P. Py (snd x) = 0 \ Pxy x = 0)" by (rule subdensity_real[OF measurable_snd Pxy Py]) (insert Py_nn Pxy_nn, auto simp: space_pair_measure) ultimately have ac: "AE x in ?P. Px (fst x) * Py (snd x) = 0 \ Pxy x = 0" - by eventually_elim auto + by auto show "?M = ?R" unfolding M f_def using Pxy_nn Px_nn Py_nn @@ -599,9 +590,8 @@ intro!: borel_measurable_times borel_measurable_log borel_measurable_divide) ultimately have int: "integrable (S \\<^sub>M T) f" apply (rule integrable_cong_AE_imp) - using A B AE_space - by eventually_elim - (auto simp: f_def log_divide_eq log_mult_eq field_simps space_pair_measure Px_nn Py_nn Pxy_nn + using A B + by (auto simp: f_def log_divide_eq log_mult_eq field_simps space_pair_measure Px_nn Py_nn Pxy_nn less_le) show "0 \ ?M" unfolding M @@ -683,7 +673,7 @@ have "(AE x in ?P. Py (snd x) = 0 \ Pxy x = 0)" by (rule subdensity_real[OF measurable_snd Pxy Py]) (insert Py_nn Pxy_nn, auto simp: space_pair_measure) ultimately have ac: "AE x in ?P. Px (fst x) * Py (snd x) = 0 \ Pxy x = 0" - by eventually_elim auto + by auto show "?M = ?R" unfolding M f_def @@ -784,17 +774,10 @@ assumes X: "distributed M S X Px" shows "AE x in S. RN_deriv S (density S Px) x = Px x" proof - - note D = distributed_measurable[OF X] distributed_borel_measurable[OF X] - interpret X: prob_space "distr M S X" - using D(1) by (rule prob_space_distr) - - have sf: "sigma_finite_measure (distr M S X)" by standard - show ?thesis - using D - apply (subst eq_commute) - apply (intro RN_deriv_unique_sigma_finite) - apply (auto simp: distributed_distr_eq_density[symmetric, OF X] sf) - done + have "distributed M S X (RN_deriv S (density S Px))" + by (metis RN_derivI assms borel_measurable_RN_deriv distributed_def) + then show ?thesis + using assms distributed_unique by blast qed lemma (in information_space) @@ -806,14 +789,9 @@ note ae = distributed_RN_deriv[OF X] note distributed_real_measurable[OF nn X, measurable] - have ae_eq: "AE x in distr M MX X. log b (enn2real (RN_deriv MX (distr M MX X) x)) = - log b (f x)" + have ae_eq: "AE x in distr M MX X. log b (enn2real (RN_deriv MX (distr M MX X) x)) = log b (f x)" unfolding distributed_distr_eq_density[OF X] - apply (subst AE_density) - using D apply simp - using ae apply eventually_elim - apply auto - done + using D ae by (auto simp: AE_density) have int_eq: "(\ x. f x * log b (f x) \MX) = (\ x. log b (f x) \distr M MX X)" unfolding distributed_distr_eq_density[OF X] @@ -1078,14 +1056,16 @@ by (subst STP.nn_integral_snd[symmetric]) (auto simp add: split_beta' ennreal_mult[symmetric] space_pair_measure intro!: nn_integral_cong) also have "\ = (\\<^sup>+x. ennreal (Pyz x) * 1 \T \\<^sub>M P)" - apply (rule nn_integral_cong_AE) - using aeX1 aeX2 aeX3 AE_space - apply eventually_elim - proof (case_tac x, simp add: space_pair_measure) - fix a b assume "Pz b = 0 \ Pyz (a, b) = 0" "a \ space T \ b \ space P" - "(\\<^sup>+ x. ennreal (Pxz (x, b)) \S) = ennreal (Pz b)" - then show "(\\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \S) = ennreal (Pyz (a, b))" - by (subst nn_integral_multc) (auto split: prod.split simp: ennreal_mult[symmetric]) + proof - + have D: "(\\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \S) = ennreal (Pyz (a, b))" + if "Pz b = 0 \ Pyz (a, b) = 0" "a \ space T \ b \ space P" + "(\\<^sup>+ x. ennreal (Pxz (x, b)) \S) = ennreal (Pz b)" + for a b + using that by (subst nn_integral_multc) (auto split: prod.split simp: ennreal_mult[symmetric]) + show ?thesis + apply (rule nn_integral_cong_AE) + using aeX1 aeX2 aeX3 + by (force simp add: space_pair_measure D) qed also have "\ = 1" using Q.emeasure_space_1 distributed_distr_eq_density[OF Pyz] @@ -1103,8 +1083,8 @@ then have "AE x in S \\<^sub>M T \\<^sub>M P. ?g x = 0" by (intro nn_integral_0_iff_AE[THEN iffD1]) auto then have "AE x in S \\<^sub>M T \\<^sub>M P. Pxyz x = 0" - using ae1 ae2 ae3 ae4 AE_space - by eventually_elim (auto split: if_split_asm simp: mult_le_0_iff divide_le_0_iff space_pair_measure) + using ae1 ae2 ae3 ae4 + by (auto split: if_split_asm simp: mult_le_0_iff divide_le_0_iff space_pair_measure) then have "(\\<^sup>+ x. ennreal (Pxyz x) \S \\<^sub>M T \\<^sub>M P) = 0" by (subst nn_integral_cong_AE[of _ "\x. 0"]) auto with P.emeasure_space_1 show False @@ -1112,11 +1092,7 @@ qed have neg: "(\\<^sup>+ x. - ?f x \?P) = 0" - apply (rule nn_integral_0_iff_AE[THEN iffD2]) - apply simp - apply (subst AE_density) - apply (auto simp: space_pair_measure ennreal_neg) - done + by (subst nn_integral_0_iff_AE) (auto simp: space_pair_measure ennreal_neg) have I3: "integrable (S \\<^sub>M T \\<^sub>M P) (\(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z))))" apply (rule integrable_cong_AE[THEN iffD1, OF _ _ _ Bochner_Integration.integrable_diff[OF I1 I2]]) @@ -1136,8 +1112,6 @@ qed simp then have "(\\<^sup>+ x. ?f x \?P) = (\x. ?f x \?P)" apply (rule nn_integral_eq_integral) - apply (subst AE_density) - apply simp apply (auto simp: space_pair_measure ennreal_neg) done with pos le1 @@ -1148,35 +1122,31 @@ proof (rule P.jensens_inequality[where a=0 and b=1 and I="{0<..}"]) show "AE x in ?P. ?f x \ {0<..}" unfolding AE_density[OF distributed_borel_measurable[OF Pxyz]] - using ae1 ae2 ae3 ae4 AE_space - by eventually_elim (auto simp: space_pair_measure less_le) + using ae1 ae2 ae3 ae4 + by (auto simp: space_pair_measure less_le) show "integrable ?P ?f" unfolding real_integrable_def using fin neg by (auto simp: split_beta') - show "integrable ?P (\x. - log b (?f x))" - apply (subst integrable_real_density) - apply simp - apply (auto simp: space_pair_measure) [] - apply simp + have "integrable (S \\<^sub>M T \\<^sub>M P) (\x. Pxyz x * - log b (?f x))" apply (rule integrable_cong_AE[THEN iffD1, OF _ _ _ I3]) - apply simp - apply simp - using ae1 ae2 ae3 ae4 AE_space - apply eventually_elim + using ae1 ae2 ae3 ae4 apply (auto simp: log_divide_eq log_mult_eq zero_le_mult_iff zero_less_mult_iff zero_less_divide_iff field_simps - less_le space_pair_measure) + less_le space_pair_measure) done + then + show "integrable ?P (\x. - log b (?f x))" + by (subst integrable_real_density) (auto simp: space_pair_measure) qed (auto simp: b_gt_1 minus_log_convex) also have "\ = conditional_mutual_information b S T P X Y Z" unfolding \?eq\ apply (subst integral_real_density) - apply simp - apply (auto simp: space_pair_measure) [] - apply simp + apply simp + apply (force simp: space_pair_measure) + apply simp apply (intro integral_cong_AE) using ae1 ae2 ae3 ae4 - apply (auto simp: log_divide_eq zero_less_mult_iff zero_less_divide_iff field_simps - space_pair_measure less_le) + apply (auto simp: log_divide_eq zero_less_mult_iff zero_less_divide_iff field_simps + space_pair_measure less_le) done finally show ?nonneg by simp @@ -1276,10 +1246,8 @@ using Pxyz Px Pyz by simp ultimately have I1: "integrable (S \\<^sub>M T \\<^sub>M P) (\(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Px x * Pyz (y, z))))" apply (rule integrable_cong_AE_imp) - using ae1 ae4 AE_space - by eventually_elim - (insert Px_nn Pyz_nn Pxyz_nn, - auto simp: log_divide_eq log_mult_eq field_simps zero_less_mult_iff space_pair_measure less_le) + using ae1 ae4 Px_nn Pyz_nn Pxyz_nn + by (auto simp: log_divide_eq log_mult_eq field_simps zero_less_mult_iff space_pair_measure less_le) have "integrable (S \\<^sub>M T \\<^sub>M P) (\x. Pxyz x * log b (Pxz (fst x, snd (snd x))) - Pxyz x * log b (Px (fst x)) - Pxyz x * log b (Pz (snd (snd x))))" @@ -1292,20 +1260,14 @@ by auto ultimately have I2: "integrable (S \\<^sub>M T \\<^sub>M P) (\(x, y, z). Pxyz (x, y, z) * log b (Pxz (x, z) / (Px x * Pz z)))" apply (rule integrable_cong_AE_imp) - using ae1 ae2 ae3 ae4 AE_space - by eventually_elim - (insert Px_nn Pz_nn Pxz_nn Pyz_nn Pxyz_nn, - auto simp: log_divide_eq log_mult_eq field_simps zero_less_mult_iff less_le space_pair_measure) + using ae1 ae2 ae3 ae4 Px_nn Pz_nn Pxz_nn Pyz_nn Pxyz_nn + by (auto simp: log_divide_eq log_mult_eq field_simps zero_less_mult_iff less_le space_pair_measure) from ae I1 I2 show ?eq - unfolding conditional_mutual_information_def - apply (subst mi_eq) - apply (subst mutual_information_distr[OF S TP Px Px_nn Pyz Pyz_nn Pxyz Pxyz_nn]) - apply simp - apply simp - apply (simp add: space_pair_measure) + unfolding conditional_mutual_information_def mi_eq + apply (subst mutual_information_distr[OF S TP Px Px_nn Pyz Pyz_nn Pxyz Pxyz_nn]; simp add: space_pair_measure) apply (subst Bochner_Integration.integral_diff[symmetric]) - apply (auto intro!: integral_cong_AE simp: split_beta' simp del: Bochner_Integration.integral_diff) + apply (auto intro!: integral_cong_AE simp: split_beta' simp del: Bochner_Integration.integral_diff) done let ?P = "density (S \\<^sub>M T \\<^sub>M P) Pxyz" @@ -1335,15 +1297,15 @@ by (subst STP.nn_integral_snd[symmetric]) (auto simp add: split_beta' ennreal_mult[symmetric] space_pair_measure intro!: nn_integral_cong) also have "\ = (\\<^sup>+x. ennreal (Pyz x) * 1 \T \\<^sub>M P)" - apply (rule nn_integral_cong_AE) - using aeX1 aeX2 aeX3 AE_space - apply eventually_elim - proof (case_tac x, simp add: space_pair_measure) - fix a b assume "Pz b = 0 \ Pyz (a, b) = 0" "0 \ Pz b" "a \ space T \ b \ space P" - "(\\<^sup>+ x. ennreal (Pxz (x, b)) \S) = ennreal (Pz b)" - then show "(\\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \S) = ennreal (Pyz (a, b))" - using Pyz_nn[of "(a,b)"] + proof - + have *: "(\\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \S) = ennreal (Pyz (a, b))" + if "Pz b = 0 \ Pyz (a, b) = 0" "0 \ Pz b" "a \ space T \ b \ space P" + "(\\<^sup>+ x. ennreal (Pxz (x, b)) \S) = ennreal (Pz b)" for a b + using Pyz_nn[of "(a,b)"] that by (subst nn_integral_multc) (auto simp: space_pair_measure ennreal_mult[symmetric]) + show ?thesis + using aeX1 aeX2 aeX3 AE_space + by (force simp: * space_pair_measure intro: nn_integral_cong_AE) qed also have "\ = 1" using Q.emeasure_space_1 Pyz_nn distributed_distr_eq_density[OF Pyz] @@ -1362,9 +1324,8 @@ then have "AE x in S \\<^sub>M T \\<^sub>M P. ?g x = 0" by (intro nn_integral_0_iff_AE[THEN iffD1]) auto then have "AE x in S \\<^sub>M T \\<^sub>M P. Pxyz x = 0" - using ae1 ae2 ae3 ae4 AE_space - by eventually_elim - (insert Px_nn Pz_nn Pxz_nn Pyz_nn, + using ae1 ae2 ae3 ae4 + by (insert Px_nn Pz_nn Pxz_nn Pyz_nn, auto split: if_split_asm simp: mult_le_0_iff divide_le_0_iff space_pair_measure) then have "(\\<^sup>+ x. ennreal (Pxyz x) \S \\<^sub>M T \\<^sub>M P) = 0" by (subst nn_integral_cong_AE[of _ "\x. 0"]) auto @@ -1382,19 +1343,12 @@ have I3: "integrable (S \\<^sub>M T \\<^sub>M P) (\(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z))))" apply (rule integrable_cong_AE[THEN iffD1, OF _ _ _ Bochner_Integration.integrable_diff[OF I1 I2]]) using ae - apply (auto simp: split_beta') - done + by (auto simp: split_beta') have "- log b 1 \ - log b (integral\<^sup>L ?P ?f)" proof (intro le_imp_neg_le log_le[OF b_gt_1]) have If: "integrable ?P ?f" - unfolding real_integrable_def - proof (intro conjI) - from neg show "(\\<^sup>+ x. - ?f x \?P) \ \" - by simp - from fin show "(\\<^sup>+ x. ?f x \?P) \ \" - by simp - qed simp + using neg fin by (force simp add: real_integrable_def) then have "(\\<^sup>+ x. ?f x \?P) = (\x. ?f x \?P)" using Pz_nn Pxz_nn Pyz_nn Pxyz_nn by (intro nn_integral_eq_integral) @@ -1407,25 +1361,19 @@ proof (rule P.jensens_inequality[where a=0 and b=1 and I="{0<..}"]) show "AE x in ?P. ?f x \ {0<..}" unfolding AE_density[OF distributed_borel_measurable[OF Pxyz]] - using ae1 ae2 ae3 ae4 AE_space - by eventually_elim (insert Pxyz_nn Pyz_nn Pz_nn Pxz_nn, auto simp: space_pair_measure less_le) + using ae1 ae2 ae3 ae4 + by (insert Pxyz_nn Pyz_nn Pz_nn Pxz_nn, auto simp: space_pair_measure less_le) show "integrable ?P ?f" unfolding real_integrable_def using fin neg by (auto simp: split_beta') - show "integrable ?P (\x. - log b (?f x))" - using Pz_nn Pxz_nn Pyz_nn Pxyz_nn - apply (subst integrable_real_density) - apply simp - apply simp - apply simp + have "integrable (S \\<^sub>M T \\<^sub>M P) (\x. Pxyz x * - log b (?f x))" apply (rule integrable_cong_AE[THEN iffD1, OF _ _ _ I3]) - apply simp - apply simp - using ae1 ae2 ae3 ae4 AE_space - apply eventually_elim - apply (auto simp: log_divide_eq log_mult_eq zero_le_mult_iff zero_less_mult_iff - zero_less_divide_iff field_simps space_pair_measure less_le) - done + using Pz_nn Pxz_nn Pyz_nn Pxyz_nn ae2 ae3 ae4 + by (auto simp: log_divide_eq log_mult_eq zero_le_mult_iff zero_less_mult_iff + zero_less_divide_iff field_simps space_pair_measure less_le) + then + show "integrable ?P (\x. - log b (?f x))" + using Pxyz_nn by (auto simp: integrable_real_density) qed (auto simp: b_gt_1 minus_log_convex) also have "\ = conditional_mutual_information b S T P X Y Z" unfolding \?eq\ @@ -1435,9 +1383,9 @@ apply simp apply simp apply (intro integral_cong_AE) - using ae1 ae2 ae3 ae4 AE_space + using ae1 ae2 ae3 ae4 apply (auto simp: log_divide_eq zero_less_mult_iff zero_less_divide_iff - field_simps space_pair_measure less_le) + field_simps space_pair_measure less_le integral_cong_AE) done finally show ?nonneg by simp @@ -1504,24 +1452,18 @@ note sd = simple_distributedI[OF _ _ refl] note sp = simple_function_Pair show ?thesis - apply (rule conditional_mutual_information_generic_nonneg[OF sf[OF X] sf[OF Y] sf[OF Z]]) - apply (rule simple_distributed[OF sd[OF X]]) - apply simp - apply simp - apply (rule simple_distributed[OF sd[OF Z]]) - apply simp - apply simp - apply (rule simple_distributed_joint[OF sd[OF sp[OF Y Z]]]) - apply simp - apply simp - apply (rule simple_distributed_joint[OF sd[OF sp[OF X Z]]]) - apply simp - apply simp - apply (rule simple_distributed_joint2[OF sd[OF sp[OF X sp[OF Y Z]]]]) - apply simp - apply simp - apply (auto intro!: integrable_count_space simp: X Y Z simple_functionD) - done + apply (rule conditional_mutual_information_generic_nonneg[OF sf[OF X] sf[OF Y] sf[OF Z]]) + apply (force intro: simple_distributed[OF sd[OF X]]) + apply simp + apply (force intro: simple_distributed[OF sd[OF Z]]) + apply simp + apply (force intro: simple_distributed_joint[OF sd[OF sp[OF Y Z]]]) + apply simp + apply (force intro: simple_distributed_joint[OF sd[OF sp[OF X Z]]]) + apply simp + apply (fastforce intro: simple_distributed_joint2[OF sd[OF sp[OF X sp[OF Y Z]]]]) + apply (auto intro!: integrable_count_space simp: X Y Z simple_functionD) + done qed subsection \Conditional Entropy\ @@ -1560,11 +1502,8 @@ have "AE x in density (S \\<^sub>M T) (\x. ennreal (Pxy x)). Py (snd x) = enn2real (RN_deriv T (distr M T Y) (snd x))" unfolding AE_density[OF distributed_borel_measurable, OF Pxy] unfolding distributed_distr_eq_density[OF Py] - apply (rule ST.AE_pair_measure) - apply auto using distributed_RN_deriv[OF Py] - apply auto - done + by (force intro: ST.AE_pair_measure) ultimately have "conditional_entropy b S T X Y = - (\x. Pxy x * log b (Pxy x / Py (snd x)) \(S \\<^sub>M T))" unfolding conditional_entropy_def neg_equal_iff_equal @@ -1613,17 +1552,14 @@ using Py by (intro ST.AE_pair_measure) (auto simp: comp_def intro!: measurable_snd'') ultimately have "AE x in S \\<^sub>M T. 0 \ Pxy x \ 0 \ Py (snd x) \ (Pxy x = 0 \ (Pxy x \ 0 \ 0 < Pxy x \ 0 < Py (snd x)))" - using AE_space by eventually_elim (auto simp: space_pair_measure less_le) + by (auto simp: space_pair_measure less_le) then have ae: "AE x in S \\<^sub>M T. Pxy x * log b (Pxy x) - Pxy x * log b (Py (snd x)) = Pxy x * log b (Pxy x / Py (snd x))" - by eventually_elim (auto simp: log_simps field_simps b_gt_1) + by (auto simp: log_simps field_simps b_gt_1) have "conditional_entropy b S T X Y = - (\x. Pxy x * log b (Pxy x) - Pxy x * log b (Py (snd x)) \(S \\<^sub>M T))" unfolding conditional_entropy_generic_eq[OF S T Py Py_nn Pxy Pxy_nn, simplified] neg_equal_iff_equal - apply (intro integral_cong_AE) - using ae - apply auto - done + using ae by (force intro: integral_cong_AE) also have "\ = - (\x. Pxy x * log b (Pxy x) \(S \\<^sub>M T)) - - (\x. Pxy x * log b (Py (snd x)) \(S \\<^sub>M T))" by (simp add: Bochner_Integration.integral_diff[OF I1 I2]) finally show ?thesis @@ -1671,7 +1607,7 @@ from Y show "- (\ (x, y). ?f (x, y) * log b (?f (x, y) / Py y) \?P) = - (\(x, y)\(\x. (X x, Y x)) ` space M. Pxy (x, y) * log b (Pxy (x, y) / Py y))" by (auto intro!: sum.cong simp add: \?P = ?C\ lebesgue_integral_count_space_finite simple_distributed_finite eq sum.If_cases split_beta') -qed (insert Y XY, auto) +qed (use Y XY in auto) lemma (in information_space) conditional_mutual_information_eq_conditional_entropy: assumes X: "simple_function M X" and Y: "simple_function M Y" @@ -1891,7 +1827,7 @@ have "0 \ mutual_information b S T X Y" by (rule mutual_information_nonneg') fact+ also have "\ = entropy b S X - conditional_entropy b S T X Y" - apply (rule mutual_information_eq_entropy_conditional_entropy') + apply (intro mutual_information_eq_entropy_conditional_entropy') using assms by (auto intro!: finite_entropy_integrable finite_entropy_distributed finite_entropy_integrable_transform[OF Px] @@ -1933,14 +1869,22 @@ have eq: "(\x. ((f \ X) x, X x)) ` space M = (\x. (f x, x)) ` X ` space M" by auto have inj: "\A. inj_on (\x. (f x, x)) A" by (auto simp: inj_on_def) - show ?thesis - apply (subst entropy_chain_rule[symmetric, OF fX X]) - apply (subst entropy_simple_distributed[OF simple_distributedI[OF simple_function_Pair[OF fX X] measure_nonneg refl]]) - apply (subst entropy_simple_distributed[OF simple_distributedI[OF X measure_nonneg refl]]) + + have "\(X) = - (\x\X ` space M. prob (X -` {x} \ space M) * log b (prob (X -` {x} \ space M)))" + by (simp add: entropy_simple_distributed[OF simple_distributedI[OF X measure_nonneg refl]]) + also have "\ = - (\x\(\x. ((f \ X) x, X x)) ` space M. + prob ((\x. ((f \ X) x, X x)) -` {x} \ space M) * + log b (prob ((\x. ((f \ X) x, X x)) -` {x} \ space M)))" unfolding eq apply (subst sum.reindex[OF inj]) apply (auto intro!: sum.cong arg_cong[where f="\A. prob A * log b (prob A)"]) done + also have "... = \(\x. ((f \ X) x, X x))" + using entropy_simple_distributed[OF simple_distributedI[OF simple_function_Pair[OF fX X] measure_nonneg refl]] + by fastforce + also have "\ = \(f \ X) + \(X|f \ X)" + using X entropy_chain_rule by blast + finally show ?thesis . qed corollary (in information_space) entropy_data_processing: diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Probability/Levy.thy --- a/src/HOL/Probability/Levy.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Probability/Levy.thy Mon Sep 11 22:59:34 2023 +0200 @@ -32,13 +32,8 @@ by (simp add: norm_divide norm_mult) also have "cmod ?one / abs t + cmod ?two / abs t \ ((- (a * t))^2 / 2) / abs t + ((- (b * t))^2 / 2) / abs t" - apply (rule add_mono) - apply (rule divide_right_mono) - using iexp_approx1 [of "-(t * a)" 1] apply (simp add: field_simps eval_nat_numeral) - apply force - apply (rule divide_right_mono) - using iexp_approx1 [of "-(t * b)" 1] apply (simp add: field_simps eval_nat_numeral) - by force + using iexp_approx1 [of "-(t * _)" 1] + by (intro add_mono divide_right_mono abs_ge_zero) (auto simp: field_simps eval_nat_numeral) also have "\ = a^2 / 2 * abs t + b^2 / 2 * abs t" using \t \ 0\ apply (case_tac "t \ 0", simp add: field_simps power2_eq_square) using \t \ 0\ by (subst (1 2) abs_of_neg, auto simp add: field_simps power2_eq_square) @@ -88,6 +83,8 @@ assume "T \ 0" let ?f' = "\(t, x). indicator {-T<..R ?f t x" { fix x + have int: "interval_lebesgue_integrable lborel (ereal 0) (ereal T) (\t. 2 * (sin (t * (x-w)) / t))" for w + using integrable_sinc' interval_lebesgue_integrable_mult_right by blast have 1: "complex_interval_lebesgue_integrable lborel u v (\t. ?f t x)" for u v :: real using Levy_Inversion_aux2[of "x - b" "x - a"] apply (simp add: interval_lebesgue_integrable_def set_integrable_def del: times_divide_eq_left) @@ -110,21 +107,18 @@ also have "\ = (CLBINT t=(0::real)..T. complex_of_real( 2 * (sin (t * (x - a)) / t) - 2 * (sin (t * (x - b)) / t)))" using \T \ 0\ - apply (intro interval_integral_cong) - apply (simp add: field_simps cis.ctr Im_divide Re_divide Im_exp Re_exp complex_eq_iff) - unfolding minus_diff_eq[symmetric, of "y * x" "y * a" for y a] sin_minus cos_minus - apply (simp add: field_simps power2_eq_square) - done + by (intro interval_integral_cong) (simp add: divide_simps Im_divide Re_divide Im_exp Re_exp complex_eq_iff) also have "\ = complex_of_real (LBINT t=(0::real)..T. 2 * (sin (t * (x - a)) / t) - 2 * (sin (t * (x - b)) / t))" by (rule interval_lebesgue_integral_of_real) + also have "\ = complex_of_real ((LBINT t=ereal 0..ereal T. 2 * (sin (t * (x - a)) / t)) - + (LBINT t=ereal 0..ereal T. 2 * (sin (t * (x - b)) / t)))" + unfolding interval_lebesgue_integral_diff + using int by auto also have "\ = complex_of_real (2 * (sgn (x - a) * Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b))))" - apply (subst interval_lebesgue_integral_diff) - apply (rule interval_lebesgue_integrable_mult_right, rule integrable_sinc')+ - apply (subst interval_lebesgue_integral_mult_right)+ - apply (simp add: zero_ereal_def[symmetric] LBINT_I0c_sin_scale_divide[OF \T \ 0\]) - done + unfolding interval_lebesgue_integral_mult_right + by (simp add: zero_ereal_def[symmetric] LBINT_I0c_sin_scale_divide[OF \T \ 0\]) finally have "(CLBINT t. ?f' (t, x)) = 2 * (sgn (x - a) * Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b)))" . } note main_eq = this @@ -287,22 +281,15 @@ assume "u > 0" and "x \ 0" hence "(CLBINT t:{-u..u}. 1 - iexp (t * x)) = (CLBINT t=-u..u. 1 - iexp (t * x))" by (subst interval_integral_Icc, auto) - also have "\ = (CLBINT t=-u..0. 1 - iexp (t * x)) + (CLBINT t=0..u. 1 - iexp (t * x))" + also have "\ = (CLBINT t=-u..ereal 0. 1 - iexp (t * x)) + (CLBINT t= ereal 0..u. 1 - iexp (t * x))" using \u > 0\ - apply (subst interval_integral_sum) - apply (simp add: min_absorb1 min_absorb2 max_absorb1 max_absorb2) - apply (rule interval_integrable_isCont) - apply auto - done + by (subst interval_integral_sum; force simp add: interval_integrable_isCont) also have "\ = (CLBINT t=ereal 0..u. 1 - iexp (t * -x)) + (CLBINT t=ereal 0..u. 1 - iexp (t * x))" - apply (subgoal_tac "0 = ereal 0", erule ssubst) by (subst interval_integral_reflect, auto) + also have "... = CLBINT xa=ereal 0..ereal u. 1 - iexp (xa * - x) + (1 - iexp (xa * x))" + by (subst interval_lebesgue_integral_add (2) [symmetric]) (auto simp: interval_integrable_isCont) also have "\ = (LBINT t=ereal 0..u. 2 - 2 * cos (t * x))" - apply (subst interval_lebesgue_integral_add (2) [symmetric]) - apply ((rule interval_integrable_isCont, auto)+) [2] - unfolding exp_Euler cos_of_real - apply (simp add: of_real_mult interval_lebesgue_integral_of_real[symmetric]) - done + unfolding exp_Euler cos_of_real by (simp flip: interval_lebesgue_integral_of_real) also have "\ = 2 * u - 2 * sin (u * x) / x" by (subst interval_lebesgue_integral_diff) (auto intro!: interval_integrable_isCont @@ -375,13 +362,11 @@ proof - fix \ :: real assume "\ > 0" - note M'.isCont_char [of 0] - hence "\d>0. \t. abs t < d \ cmod (char M' t - 1) < \ / 4" - apply (subst (asm) continuous_at_eps_delta) - apply (drule_tac x = "\ / 4" in spec) - using \\ > 0\ by (auto simp add: dist_real_def dist_complex_def M'.char_zero) - then obtain d where "d > 0 \ (\t. (abs t < d \ cmod (char M' t - 1) < \ / 4))" .. - hence d0: "d > 0" and d1: "\t. abs t < d \ cmod (char M' t - 1) < \ / 4" by auto + with M'.isCont_char [of 0] + obtain d where d0: "d>0" and "\x'. dist x' 0 < d \ dist (char M' x') (char M' 0) < \/4" + unfolding continuous_at_eps_delta by (metis \0 < \\ divide_pos_pos zero_less_numeral) + then have d1: "\t. abs t < d \ cmod (char M' t - 1) < \ / 4" + by (simp add: M'.char_zero dist_norm) have 1: "\x. cmod (1 - char M' x) \ 2" by (rule order_trans [OF norm_triangle_ineq4], auto simp add: M'.cmod_char_le_1) then have 2: "\u v. complex_set_integrable lborel {u..v} (\x. 1 - char M' x)" @@ -395,15 +380,18 @@ using integral_norm_bound[of _ "\x. indicator {u..v} x *\<^sub>R (1 - char M' x)" for u v] by simp also have 4: "\ \ LBINT t:{-d/2..d/2}. \ / 4" unfolding set_lebesgue_integral_def - apply (rule integral_mono [OF 3]) - apply (simp add: emeasure_lborel_Icc_eq) - apply (case_tac "x \ {-d/2..d/2}") - apply auto - apply (subst norm_minus_commute) - apply (rule less_imp_le) - apply (rule d1 [simplified]) - using d0 apply auto - done + proof (rule integral_mono [OF 3]) + + show "indicat_real {- d / 2..d / 2} x *\<^sub>R cmod (1 - char M' x) + \ indicat_real {- d / 2..d / 2} x *\<^sub>R (\ / 4)" + if "x \ space lborel" for x + proof (cases "x \ {-d/2..d/2}") + case True + show ?thesis + using d0 d1 that True [simplified] + by (smt (verit, best) field_sum_of_halves minus_diff_eq norm_minus_cancel indicator_pos_le scaleR_left_mono) + qed auto + qed (simp add: emeasure_lborel_Icc_eq) also from d0 4 have "\ = d * \ / 4" unfolding set_lebesgue_integral_def by simp finally have bound: "cmod (CLBINT t:{-d/2..d/2}. 1 - char M' t) \ d * \ / 4" . @@ -450,14 +438,7 @@ apply (subst Mn.borel_UNIV [symmetric]) by (subst Mn.prob_compl, auto) also have "UNIV - {x. abs x \ 2 / (d / 2)} = {x. -(4 / d) < x \ x < (4 / d)}" - using d0 apply (auto simp add: field_simps) - (* very annoying -- this should be automatic *) - apply (case_tac "x \ 0", auto simp add: field_simps) - apply (subgoal_tac "0 \ x * d", arith, rule mult_nonneg_nonneg, auto) - apply (case_tac "x \ 0", auto simp add: field_simps) - apply (subgoal_tac "x * d \ 0", arith) - apply (rule mult_nonpos_nonneg, auto) - by (case_tac "x \ 0", auto simp add: field_simps) + using d0 by (simp add: set_eq_iff divide_simps abs_if) (smt (verit, best) mult_less_0_iff) finally have "measure (M n) {x. -(4 / d) < x \ x < (4 / d)} > 1 - \" by auto } note 6 = this @@ -470,8 +451,7 @@ hence "(\k. measure (M n) {- real k<..real k}) \ 1" using Mn.prob_space unfolding * Mn.borel_UNIV by simp hence "eventually (\k. measure (M n) {- real k<..real k} > 1 - \) sequentially" - apply (elim order_tendstoD (1)) - using \\ > 0\ by auto + using \\ > 0\ order_tendstoD by fastforce } note 7 = this { fix n :: nat have "eventually (\k. \m < n. measure (M m) {- real k<..real k} > 1 - \) sequentially" @@ -490,20 +470,18 @@ hence K: "\m. m < N \ 1 - \ < Sigma_Algebra.measure (M m) {- real K<..real K}" by auto let ?K' = "max K (4 / d)" - have "-?K' < ?K' \ (\n. 1 - \ < measure (M n) {-?K'<..?K'})" - using d0 apply auto - apply (rule max.strict_coboundedI2, auto) - proof - - fix n - show " 1 - \ < measure (M n) {- max (real K) (4 / d)<..max (real K) (4 / d)}" - apply (case_tac "n < N") - apply (rule order_less_le_trans) - apply (erule K) - apply (rule Mn.finite_measure_mono, auto) - apply (rule order_less_le_trans) - apply (rule 6, erule leI) - by (rule Mn.finite_measure_mono, auto) + have "1 - \ < measure (M n) {- max (real K) (4 / d)<..max (real K) (4 / d)}" for n + proof (cases "n < N") + case True + then show ?thesis + by (force intro: order_less_le_trans [OF K Mn.finite_measure_mono]) + next + case False + then show ?thesis + by (force intro: order_less_le_trans [OF 6 Mn.finite_measure_mono]) qed + then have "-?K' < ?K' \ (\n. 1 - \ < measure (M n) {-?K'<..?K'})" + using d0 by (simp add: less_max_iff_disj minus_less_iff) thus "\a b. a < b \ (\n. 1 - \ < measure (M n) {a<..b})" by (intro exI) qed have tight: "tight M" diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Probability/SPMF.thy --- a/src/HOL/Probability/SPMF.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Probability/SPMF.thy Mon Sep 11 22:59:34 2023 +0200 @@ -11,20 +11,20 @@ subsection \Auxiliary material\ lemma cSUP_singleton [simp]: "(SUP x\{x}. f x :: _ :: conditionally_complete_lattice) = f x" -by (metis cSup_singleton image_empty image_insert) + by (metis cSup_singleton image_empty image_insert) subsubsection \More about extended reals\ lemma [simp]: shows ennreal_max_0: "ennreal (max 0 x) = ennreal x" - and ennreal_max_0': "ennreal (max x 0) = ennreal x" -by(simp_all add: max_def ennreal_eq_0_iff) + and ennreal_max_0': "ennreal (max x 0) = ennreal x" + by(simp_all add: max_def ennreal_eq_0_iff) lemma e2ennreal_0 [simp]: "e2ennreal 0 = 0" -by(simp add: zero_ennreal_def) + by(simp add: zero_ennreal_def) lemma enn2real_bot [simp]: "enn2real \ = 0" -by(simp add: bot_ennreal_def) + by(simp add: bot_ennreal_def) lemma continuous_at_ennreal[continuous_intros]: "continuous F f \ continuous F (\x. ennreal (f x))" unfolding continuous_def by auto @@ -42,24 +42,24 @@ lemma ennreal_SUP: "\ (SUP a\A. ennreal (f a)) \ \; A \ {} \ \ ennreal (SUP a\A. f a) = (SUP a\A. ennreal (f a))" -using ennreal_Sup[of "f ` A"] by (auto simp add: image_comp) + using ennreal_Sup[of "f ` A"] by (auto simp: image_comp) lemma ennreal_lt_0: "x < 0 \ ennreal x = 0" -by(simp add: ennreal_eq_0_iff) + by(simp add: ennreal_eq_0_iff) subsubsection \More about \<^typ>\'a option\\ lemma None_in_map_option_image [simp]: "None \ map_option f ` A \ None \ A" -by auto + by auto lemma Some_in_map_option_image [simp]: "Some x \ map_option f ` A \ (\y. x = f y \ Some y \ A)" -by(auto intro: rev_image_eqI dest: sym) + by (smt (verit, best) imageE imageI map_option_eq_Some) lemma case_option_collapse: "case_option x (\_. x) = (\_. x)" -by(simp add: fun_eq_iff split: option.split) + by(simp add: fun_eq_iff split: option.split) lemma case_option_id: "case_option None Some = id" -by(rule ext)(simp split: option.split) + by(rule ext)(simp split: option.split) inductive ord_option :: "('a \ 'b \ bool) \ 'a option \ 'b option \ bool" for ord :: "'a \ 'b \ bool" @@ -78,65 +78,66 @@ "ord_option (=) (Some x) y" lemma ord_option_reflI: "(\y. y \ set_option x \ ord y y) \ ord_option ord x x" -by(cases x) simp_all + by(cases x) simp_all lemma reflp_ord_option: "reflp ord \ reflp (ord_option ord)" -by(simp add: reflp_def ord_option_reflI) + by(simp add: reflp_def ord_option_reflI) lemma ord_option_trans: "\ ord_option ord x y; ord_option ord y z; \a b c. \ a \ set_option x; b \ set_option y; c \ set_option z; ord a b; ord b c \ \ ord a c \ \ ord_option ord x z" -by(auto elim!: ord_option.cases) + by(auto elim!: ord_option.cases) lemma transp_ord_option: "transp ord \ transp (ord_option ord)" -unfolding transp_def by(blast intro: ord_option_trans) + unfolding transp_def by(blast intro: ord_option_trans) lemma antisymp_ord_option: "antisymp ord \ antisymp (ord_option ord)" -by(auto intro!: antisympI elim!: ord_option.cases dest: antisympD) + by(auto intro!: antisympI elim!: ord_option.cases dest: antisympD) lemma ord_option_chainD: "Complete_Partial_Order.chain (ord_option ord) Y \ Complete_Partial_Order.chain ord {x. Some x \ Y}" -by(rule chainI)(auto dest: chainD) + by(rule chainI)(auto dest: chainD) definition lub_option :: "('a set \ 'b) \ 'a option set \ 'b option" -where "lub_option lub Y = (if Y \ {None} then None else Some (lub {x. Some x \ Y}))" + where "lub_option lub Y = (if Y \ {None} then None else Some (lub {x. Some x \ Y}))" lemma map_lub_option: "map_option f (lub_option lub Y) = lub_option (f \ lub) Y" -by(simp add: lub_option_def) + by(simp add: lub_option_def) lemma lub_option_upper: assumes "Complete_Partial_Order.chain (ord_option ord) Y" "x \ Y" - and lub_upper: "\Y x. \ Complete_Partial_Order.chain ord Y; x \ Y \ \ ord x (lub Y)" + and lub_upper: "\Y x. \ Complete_Partial_Order.chain ord Y; x \ Y \ \ ord x (lub Y)" shows "ord_option ord x (lub_option lub Y)" -using assms(1-2) -by(cases x)(auto simp add: lub_option_def intro: lub_upper[OF ord_option_chainD]) + using assms(1-2) + by(cases x)(auto simp: lub_option_def intro: lub_upper[OF ord_option_chainD]) lemma lub_option_least: assumes Y: "Complete_Partial_Order.chain (ord_option ord) Y" - and upper: "\x. x \ Y \ ord_option ord x y" + and upper: "\x. x \ Y \ ord_option ord x y" assumes lub_least: "\Y y. \ Complete_Partial_Order.chain ord Y; \x. x \ Y \ ord x y \ \ ord (lub Y) y" shows "ord_option ord (lub_option lub Y) y" -using Y -by(cases y)(auto 4 3 simp add: lub_option_def intro: lub_least[OF ord_option_chainD] dest: upper) + using Y + by(cases y)(auto 4 3 simp add: lub_option_def intro: lub_least[OF ord_option_chainD] dest: upper) lemma lub_map_option: "lub_option lub (map_option f ` Y) = lub_option (lub \ (`) f) Y" -apply(auto simp add: lub_option_def) -apply(erule notE) -apply(rule arg_cong[where f=lub]) -apply(auto intro: rev_image_eqI dest: sym) -done +proof - + have "\u y. \Some u \ Y; y \ Y\ \ {f y |y. Some y \ Y} = f ` {x. Some x \ Y}" + by blast + then show ?thesis + by (auto simp: lub_option_def) +qed lemma ord_option_mono: "\ ord_option A x y; \x y. A x y \ B x y \ \ ord_option B x y" -by(auto elim: ord_option.cases) + by(auto elim: ord_option.cases) lemma ord_option_mono' [mono]: "(\x y. A x y \ B x y) \ ord_option A x y \ ord_option B x y" -by(blast intro: ord_option_mono) + by(blast intro: ord_option_mono) lemma ord_option_compp: "ord_option (A OO B) = ord_option A OO ord_option B" -by(auto simp add: fun_eq_iff elim!: ord_option.cases intro: ord_option.intros) + by(auto simp: fun_eq_iff elim!: ord_option.cases intro: ord_option.intros) lemma ord_option_inf: "inf (ord_option A) (ord_option B) = ord_option (inf A B)" (is "?lhs = ?rhs") proof(rule antisym) @@ -144,13 +145,13 @@ qed(auto elim: ord_option_mono) lemma ord_option_map2: "ord_option ord x (map_option f y) = ord_option (\x y. ord x (f y)) x y" -by(auto elim: ord_option.cases) + by(auto elim: ord_option.cases) lemma ord_option_map1: "ord_option ord (map_option f x) y = ord_option (\x y. ord (f x) y) x y" -by(auto elim: ord_option.cases) + by(auto elim: ord_option.cases) lemma option_ord_Some1_iff: "option_ord (Some x) y \ y = Some x" -by(auto simp add: flat_ord_def) + by(auto simp: flat_ord_def) subsubsection \A relator for sets that treats sets like predicates\ @@ -158,46 +159,46 @@ begin definition rel_pred :: "('a \ 'b \ bool) \ 'a set \ 'b set \ bool" -where "rel_pred R A B = (R ===> (=)) (\x. x \ A) (\y. y \ B)" + where "rel_pred R A B = (R ===> (=)) (\x. x \ A) (\y. y \ B)" lemma rel_predI: "(R ===> (=)) (\x. x \ A) (\y. y \ B) \ rel_pred R A B" -by(simp add: rel_pred_def) + by(simp add: rel_pred_def) lemma rel_predD: "\ rel_pred R A B; R x y \ \ x \ A \ y \ B" -by(simp add: rel_pred_def rel_fun_def) + by(simp add: rel_pred_def rel_fun_def) lemma Collect_parametric: "((A ===> (=)) ===> rel_pred A) Collect Collect" \ \Declare this rule as @{attribute transfer_rule} only locally because it blows up the search space for @{method transfer} (in combination with @{thm [source] Collect_transfer})\ -by(simp add: rel_funI rel_predI) + by(simp add: rel_funI rel_predI) end subsubsection \Monotonicity rules\ lemma monotone_gfp_eadd1: "monotone (\) (\) (\x. x + y :: enat)" -by(auto intro!: monotoneI) + by(auto intro!: monotoneI) lemma monotone_gfp_eadd2: "monotone (\) (\) (\y. x + y :: enat)" -by(auto intro!: monotoneI) + by(auto intro!: monotoneI) lemma mono2mono_gfp_eadd[THEN gfp.mono2mono2, cont_intro, simp]: shows monotone_eadd: "monotone (rel_prod (\) (\)) (\) (\(x, y). x + y :: enat)" -by(simp add: monotone_gfp_eadd1 monotone_gfp_eadd2) + by(simp add: monotone_gfp_eadd1 monotone_gfp_eadd2) lemma eadd_gfp_partial_function_mono [partial_function_mono]: "\ monotone (fun_ord (\)) (\) f; monotone (fun_ord (\)) (\) g \ \ monotone (fun_ord (\)) (\) (\x. f x + g x :: enat)" -by(rule mono2mono_gfp_eadd) + by(rule mono2mono_gfp_eadd) lemma mono2mono_ereal[THEN lfp.mono2mono]: shows monotone_ereal: "monotone (\) (\) ereal" -by(rule monotoneI) simp + by(rule monotoneI) simp lemma mono2mono_ennreal[THEN lfp.mono2mono]: shows monotone_ennreal: "monotone (\) (\) ennreal" -by(rule monotoneI)(simp add: ennreal_leI) + by(rule monotoneI)(simp add: ennreal_leI) subsubsection \Bijections\ @@ -207,20 +208,17 @@ shows "\f. bij_betw f A B \ (\x\A. R x (f x))" proof - from assms obtain f where f: "\x. x \ A \ R x (f x)" and B: "\x. x \ A \ f x \ B" - apply(atomize_elim) - apply(fold all_conj_distrib) - apply(subst choice_iff[symmetric]) - apply(auto dest: rel_setD1) - done - have "inj_on f A" by(rule inj_onI)(auto dest!: f dest: bi_uniqueDl[OF unique]) + by (metis bi_unique_rel_set_lemma image_eqI) + have "inj_on f A" + by (metis (no_types, lifting) bi_unique_def f inj_on_def unique) moreover have "f ` A = B" using rel - by(auto 4 3 intro: B dest: rel_setD2 f bi_uniqueDr[OF unique]) + by (smt (verit) bi_unique_def bi_unique_rel_set_lemma f image_cong unique) ultimately have "bij_betw f A B" unfolding bij_betw_def .. thus ?thesis using f by blast qed lemma bij_betw_rel_setD: "bij_betw f A B \ rel_set (\x y. y = f x) A B" -by(rule rel_setI)(auto dest: bij_betwE bij_betw_imp_surj_on[symmetric]) + by(rule rel_setI)(auto dest: bij_betwE bij_betw_imp_surj_on[symmetric]) subsection \Subprobability mass function\ @@ -228,33 +226,29 @@ translations (type) "'a spmf" \ (type) "'a option pmf" definition measure_spmf :: "'a spmf \ 'a measure" -where "measure_spmf p = distr (restrict_space (measure_pmf p) (range Some)) (count_space UNIV) the" + where "measure_spmf p = distr (restrict_space (measure_pmf p) (range Some)) (count_space UNIV) the" abbreviation spmf :: "'a spmf \ 'a \ real" -where "spmf p x \ pmf p (Some x)" + where "spmf p x \ pmf p (Some x)" lemma space_measure_spmf: "space (measure_spmf p) = UNIV" -by(simp add: measure_spmf_def) + by(simp add: measure_spmf_def) lemma sets_measure_spmf [simp, measurable_cong]: "sets (measure_spmf p) = sets (count_space UNIV)" -by(simp add: measure_spmf_def) + by(simp add: measure_spmf_def) lemma measure_spmf_not_bot [simp]: "measure_spmf p \ \" -proof - assume "measure_spmf p = \" - hence "space (measure_spmf p) = space \" by simp - thus False by(simp add: space_measure_spmf) -qed + by (metis empty_not_UNIV space_bot space_measure_spmf) lemma measurable_the_measure_pmf_Some [measurable, simp]: "the \ measurable (restrict_space (measure_pmf p) (range Some)) (count_space UNIV)" -by(auto simp add: measurable_def sets_restrict_space space_restrict_space integral_restrict_space) + by(auto simp: measurable_def sets_restrict_space space_restrict_space integral_restrict_space) lemma measurable_spmf_measure1[simp]: "measurable (measure_spmf M) N = UNIV \ space N" -by(auto simp: measurable_def space_measure_spmf) + by(auto simp: measurable_def space_measure_spmf) lemma measurable_spmf_measure2[simp]: "measurable N (measure_spmf M) = measurable N (count_space UNIV)" -by(intro measurable_cong_sets) simp_all + by(intro measurable_cong_sets) simp_all lemma subprob_space_measure_spmf [simp, intro!]: "subprob_space (measure_spmf p)" proof @@ -263,36 +257,37 @@ qed(simp add: space_measure_spmf) interpretation measure_spmf: subprob_space "measure_spmf p" for p -by(rule subprob_space_measure_spmf) + by(rule subprob_space_measure_spmf) lemma finite_measure_spmf [simp]: "finite_measure (measure_spmf p)" -by unfold_locales + by unfold_locales lemma spmf_conv_measure_spmf: "spmf p x = measure (measure_spmf p) {x}" -by(auto simp add: measure_spmf_def measure_distr measure_restrict_space pmf.rep_eq space_restrict_space intro: arg_cong2[where f=measure]) + by(auto simp: measure_spmf_def measure_distr measure_restrict_space pmf.rep_eq space_restrict_space intro: arg_cong2[where f=measure]) lemma emeasure_measure_spmf_conv_measure_pmf: "emeasure (measure_spmf p) A = emeasure (measure_pmf p) (Some ` A)" -by(auto simp add: measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure]) + by(auto simp: measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure]) lemma measure_measure_spmf_conv_measure_pmf: "measure (measure_spmf p) A = measure (measure_pmf p) (Some ` A)" -using emeasure_measure_spmf_conv_measure_pmf[of p A] -by(simp add: measure_spmf.emeasure_eq_measure measure_pmf.emeasure_eq_measure) + using emeasure_measure_spmf_conv_measure_pmf[of p A] + by(simp add: measure_spmf.emeasure_eq_measure measure_pmf.emeasure_eq_measure) lemma emeasure_spmf_map_pmf_Some [simp]: "emeasure (measure_spmf (map_pmf Some p)) A = emeasure (measure_pmf p) A" -by(auto simp add: measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure]) + by(auto simp: measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure]) lemma measure_spmf_map_pmf_Some [simp]: "measure (measure_spmf (map_pmf Some p)) A = measure (measure_pmf p) A" -using emeasure_spmf_map_pmf_Some[of p A] by(simp add: measure_spmf.emeasure_eq_measure measure_pmf.emeasure_eq_measure) + using emeasure_spmf_map_pmf_Some[of p A] by(simp add: measure_spmf.emeasure_eq_measure measure_pmf.emeasure_eq_measure) lemma nn_integral_measure_spmf: "(\\<^sup>+ x. f x \measure_spmf p) = \\<^sup>+ x. ennreal (spmf p x) * f x \count_space UNIV" (is "?lhs = ?rhs") proof - have "?lhs = \\<^sup>+ x. pmf p x * f (the x) \count_space (range Some)" - by(simp add: measure_spmf_def nn_integral_distr nn_integral_restrict_space nn_integral_measure_pmf nn_integral_count_space_indicator ac_simps times_ereal.simps(1)[symmetric] del: times_ereal.simps(1)) + by(simp add: measure_spmf_def nn_integral_distr nn_integral_restrict_space nn_integral_measure_pmf nn_integral_count_space_indicator ac_simps + flip: times_ereal.simps [symmetric]) also have "\ = \\<^sup>+ x. ennreal (spmf p (the x)) * f (the x) \count_space (range Some)" by(rule nn_integral_cong) auto also have "\ = \\<^sup>+ x. spmf p (the (Some x)) * f (the (Some x)) \count_space UNIV" @@ -312,69 +307,65 @@ qed lemma emeasure_spmf_single: "emeasure (measure_spmf p) {x} = spmf p x" -by(simp add: measure_spmf.emeasure_eq_measure spmf_conv_measure_spmf) + by(simp add: measure_spmf.emeasure_eq_measure spmf_conv_measure_spmf) lemma measurable_measure_spmf[measurable]: "(\x. measure_spmf (M x)) \ measurable (count_space UNIV) (subprob_algebra (count_space UNIV))" -by (auto simp: space_subprob_algebra) + by (auto simp: space_subprob_algebra) lemma nn_integral_measure_spmf_conv_measure_pmf: assumes [measurable]: "f \ borel_measurable (count_space UNIV)" shows "nn_integral (measure_spmf p) f = nn_integral (restrict_space (measure_pmf p) (range Some)) (f \ the)" -by(simp add: measure_spmf_def nn_integral_distr o_def) + by(simp add: measure_spmf_def nn_integral_distr o_def) lemma measure_spmf_in_space_subprob_algebra [simp]: "measure_spmf p \ space (subprob_algebra (count_space UNIV))" -by(simp add: space_subprob_algebra) + by(simp add: space_subprob_algebra) lemma nn_integral_spmf_neq_top: "(\\<^sup>+ x. spmf p x \count_space UNIV) \ \" -using nn_integral_measure_spmf[where f="\_. 1", of p, symmetric] by simp + using nn_integral_measure_spmf[where f="\_. 1", of p, symmetric] + by simp lemma SUP_spmf_neq_top': "(SUP p\Y. ennreal (spmf p x)) \ \" -proof(rule neq_top_trans) - show "(SUP p\Y. ennreal (spmf p x)) \ 1" by(rule SUP_least)(simp add: pmf_le_1) -qed simp + by (metis SUP_least ennreal_le_1 ennreal_one_neq_top neq_top_trans pmf_le_1) lemma SUP_spmf_neq_top: "(SUP i. ennreal (spmf (Y i) x)) \ \" -proof(rule neq_top_trans) - show "(SUP i. ennreal (spmf (Y i) x)) \ 1" by(rule SUP_least)(simp add: pmf_le_1) -qed simp + by (meson SUP_eq_top_iff ennreal_le_1 ennreal_one_less_top linorder_not_le pmf_le_1) lemma SUP_emeasure_spmf_neq_top: "(SUP p\Y. emeasure (measure_spmf p) A) \ \" -proof(rule neq_top_trans) - show "(SUP p\Y. emeasure (measure_spmf p) A) \ 1" - by(rule SUP_least)(simp add: measure_spmf.subprob_emeasure_le_1) -qed simp + by (metis ennreal_one_less_top less_SUP_iff linorder_not_le measure_spmf.subprob_emeasure_le_1) subsection \Support\ definition set_spmf :: "'a spmf \ 'a set" -where "set_spmf p = set_pmf p \ set_option" + where "set_spmf p = set_pmf p \ set_option" lemma set_spmf_rep_eq: "set_spmf p = {x. measure (measure_spmf p) {x} \ 0}" proof - have "\x :: 'a. the -` {x} \ range Some = {Some x}" by auto then show ?thesis - by(auto simp add: set_spmf_def set_pmf.rep_eq measure_spmf_def measure_distr measure_restrict_space space_restrict_space intro: rev_image_eqI) + unfolding set_spmf_def measure_spmf_def + by(auto simp: set_pmf.rep_eq measure_distr measure_restrict_space space_restrict_space) qed lemma in_set_spmf: "x \ set_spmf p \ Some x \ set_pmf p" -by(simp add: set_spmf_def) + by(simp add: set_spmf_def) lemma AE_measure_spmf_iff [simp]: "(AE x in measure_spmf p. P x) \ (\x\set_spmf p. P x)" -by(auto 4 3 simp add: measure_spmf_def AE_distr_iff AE_restrict_space_iff AE_measure_pmf_iff set_spmf_def cong del: AE_cong) + unfolding set_spmf_def measure_spmf_def + by(force simp: AE_distr_iff AE_restrict_space_iff AE_measure_pmf_iff cong del: AE_cong) lemma spmf_eq_0_set_spmf: "spmf p x = 0 \ x \ set_spmf p" -by(auto simp add: pmf_eq_0_set_pmf set_spmf_def intro: rev_image_eqI) + by(auto simp: pmf_eq_0_set_pmf set_spmf_def) lemma in_set_spmf_iff_spmf: "x \ set_spmf p \ spmf p x \ 0" -by(auto simp add: set_spmf_def set_pmf_iff intro: rev_image_eqI) + by(auto simp: set_spmf_def set_pmf_iff) lemma set_spmf_return_pmf_None [simp]: "set_spmf (return_pmf None) = {}" -by(auto simp add: set_spmf_def) + by(auto simp: set_spmf_def) lemma countable_set_spmf [simp]: "countable (set_spmf p)" -by(simp add: set_spmf_def bind_UNION) + by(simp add: set_spmf_def bind_UNION) lemma spmf_eqI: assumes "\i. spmf p i = spmf q i" @@ -389,147 +380,146 @@ case None have "ennreal (pmf p i) = measure (measure_pmf p) {i}" by(simp add: pmf_def) also have "{i} = space (measure_pmf p) - range Some" - by(auto simp add: None intro: ccontr) + by(auto simp: None intro: ccontr) also have "measure (measure_pmf p) \ = ennreal 1 - measure (measure_pmf p) (range Some)" by(simp add: measure_pmf.prob_compl ennreal_minus[symmetric] del: space_measure_pmf) also have "range Some = (\x\set_spmf p. {Some x}) \ Some ` (- set_spmf p)" by auto also have "measure (measure_pmf p) \ = measure (measure_pmf p) (\x\set_spmf p. {Some x})" - by(rule measure_pmf.measure_zero_union)(auto simp add: measure_pmf.prob_eq_0 AE_measure_pmf_iff in_set_spmf_iff_spmf set_pmf_iff) + by(rule measure_pmf.measure_zero_union)(auto simp: measure_pmf.prob_eq_0 AE_measure_pmf_iff in_set_spmf_iff_spmf set_pmf_iff) also have "ennreal \ = \\<^sup>+ x. measure (measure_pmf p) {Some x} \count_space (set_spmf p)" unfolding measure_pmf.emeasure_eq_measure[symmetric] by(simp_all add: emeasure_UN_countable disjoint_family_on_def) also have "\ = \\<^sup>+ x. spmf p x \count_space (set_spmf p)" by(simp add: pmf_def) also have "\ = \\<^sup>+ x. spmf q x \count_space (set_spmf p)" by(simp add: assms) - also have "set_spmf p = set_spmf q" by(auto simp add: in_set_spmf_iff_spmf assms) + also have "set_spmf p = set_spmf q" by(auto simp: in_set_spmf_iff_spmf assms) also have "(\\<^sup>+ x. spmf q x \count_space (set_spmf q)) = \\<^sup>+ x. measure (measure_pmf q) {Some x} \count_space (set_spmf q)" by(simp add: pmf_def) also have "\ = measure (measure_pmf q) (\x\set_spmf q. {Some x})" unfolding measure_pmf.emeasure_eq_measure[symmetric] by(simp_all add: emeasure_UN_countable disjoint_family_on_def) also have "\ = measure (measure_pmf q) ((\x\set_spmf q. {Some x}) \ Some ` (- set_spmf q))" - by(rule ennreal_cong measure_pmf.measure_zero_union[symmetric])+(auto simp add: measure_pmf.prob_eq_0 AE_measure_pmf_iff in_set_spmf_iff_spmf set_pmf_iff) + by(rule ennreal_cong measure_pmf.measure_zero_union[symmetric])+(auto simp: measure_pmf.prob_eq_0 AE_measure_pmf_iff in_set_spmf_iff_spmf set_pmf_iff) also have "((\x\set_spmf q. {Some x}) \ Some ` (- set_spmf q)) = range Some" by auto also have "ennreal 1 - measure (measure_pmf q) \ = measure (measure_pmf q) (space (measure_pmf q) - range Some)" by(simp add: one_ereal_def measure_pmf.prob_compl ennreal_minus[symmetric] del: space_measure_pmf) also have "space (measure_pmf q) - range Some = {i}" - by(auto simp add: None intro: ccontr) + by(auto simp: None intro: ccontr) also have "measure (measure_pmf q) \ = pmf q i" by(simp add: pmf_def) finally show ?thesis by simp qed qed lemma integral_measure_spmf_restrict: - fixes f :: "'a \ 'b :: {banach, second_countable_topology}" shows - "(\ x. f x \measure_spmf M) = (\ x. f x \restrict_space (measure_spmf M) (set_spmf M))" -by(auto intro!: integral_cong_AE simp add: integral_restrict_space) + fixes f :: "'a \ 'b :: {banach, second_countable_topology}" + shows "(\ x. f x \measure_spmf M) = (\ x. f x \restrict_space (measure_spmf M) (set_spmf M))" + by(auto intro!: integral_cong_AE simp add: integral_restrict_space) lemma nn_integral_measure_spmf': "(\\<^sup>+ x. f x \measure_spmf p) = \\<^sup>+ x. ennreal (spmf p x) * f x \count_space (set_spmf p)" -by(auto simp add: nn_integral_measure_spmf nn_integral_count_space_indicator in_set_spmf_iff_spmf intro!: nn_integral_cong split: split_indicator) + by(auto simp: nn_integral_measure_spmf nn_integral_count_space_indicator in_set_spmf_iff_spmf intro!: nn_integral_cong split: split_indicator) subsection \Functorial structure\ abbreviation map_spmf :: "('a \ 'b) \ 'a spmf \ 'b spmf" -where "map_spmf f \ map_pmf (map_option f)" + where "map_spmf f \ map_pmf (map_option f)" context begin local_setup \Local_Theory.map_background_naming (Name_Space.mandatory_path "spmf")\ lemma map_comp: "map_spmf f (map_spmf g p) = map_spmf (f \ g) p" -by(simp add: pmf.map_comp o_def option.map_comp) + by(simp add: pmf.map_comp o_def option.map_comp) lemma map_id0: "map_spmf id = id" -by(simp add: pmf.map_id option.map_id0) + by(simp add: pmf.map_id option.map_id0) lemma map_id [simp]: "map_spmf id p = p" -by(simp add: map_id0) + by(simp add: map_id0) lemma map_ident [simp]: "map_spmf (\x. x) p = p" -by(simp add: id_def[symmetric]) + by(simp add: id_def[symmetric]) end lemma set_map_spmf [simp]: "set_spmf (map_spmf f p) = f ` set_spmf p" -by(simp add: set_spmf_def image_bind bind_image o_def Option.option.set_map) + by(simp add: set_spmf_def image_bind bind_image o_def Option.option.set_map) lemma map_spmf_cong: - "\ p = q; \x. x \ set_spmf q \ f x = g x \ - \ map_spmf f p = map_spmf g q" -by(auto intro: pmf.map_cong option.map_cong simp add: in_set_spmf) + "\ p = q; \x. x \ set_spmf q \ f x = g x \ \ map_spmf f p = map_spmf g q" + by(auto intro: pmf.map_cong option.map_cong simp add: in_set_spmf) lemma map_spmf_cong_simp: "\ p = q; \x. x \ set_spmf q =simp=> f x = g x \ \ map_spmf f p = map_spmf g q" -unfolding simp_implies_def by(rule map_spmf_cong) + unfolding simp_implies_def by(rule map_spmf_cong) lemma map_spmf_idI: "(\x. x \ set_spmf p \ f x = x) \ map_spmf f p = p" -by(rule map_pmf_idI map_option_idI)+(simp add: in_set_spmf) + by(rule map_pmf_idI map_option_idI)+(simp add: in_set_spmf) lemma emeasure_map_spmf: "emeasure (measure_spmf (map_spmf f p)) A = emeasure (measure_spmf p) (f -` A)" -by(auto simp add: measure_spmf_def emeasure_distr measurable_restrict_space1 space_restrict_space emeasure_restrict_space intro: arg_cong2[where f=emeasure]) + by(auto simp: measure_spmf_def emeasure_distr measurable_restrict_space1 space_restrict_space emeasure_restrict_space intro: arg_cong2[where f=emeasure]) lemma measure_map_spmf: "measure (measure_spmf (map_spmf f p)) A = measure (measure_spmf p) (f -` A)" -using emeasure_map_spmf[of f p A] by(simp add: measure_spmf.emeasure_eq_measure) + using emeasure_map_spmf[of f p A] by(simp add: measure_spmf.emeasure_eq_measure) lemma measure_map_spmf_conv_distr: "measure_spmf (map_spmf f p) = distr (measure_spmf p) (count_space UNIV) f" -by(rule measure_eqI)(simp_all add: emeasure_map_spmf emeasure_distr) + by(rule measure_eqI)(simp_all add: emeasure_map_spmf emeasure_distr) lemma spmf_map_pmf_Some [simp]: "spmf (map_pmf Some p) i = pmf p i" -by(simp add: pmf_map_inj') + by(simp add: pmf_map_inj') lemma spmf_map_inj: "\ inj_on f (set_spmf M); x \ set_spmf M \ \ spmf (map_spmf f M) (f x) = spmf M x" -by(subst option.map(2)[symmetric, where f=f])(rule pmf_map_inj, auto simp add: in_set_spmf inj_on_def elim!: option.inj_map_strong[rotated]) + by (smt (verit) elem_set in_set_spmf inj_on_def option.inj_map_strong option.map(2) pmf_map_inj) lemma spmf_map_inj': "inj f \ spmf (map_spmf f M) (f x) = spmf M x" -by(subst option.map(2)[symmetric, where f=f])(rule pmf_map_inj'[OF option.inj_map]) + by(subst option.map(2)[symmetric, where f=f])(rule pmf_map_inj'[OF option.inj_map]) lemma spmf_map_outside: "x \ f ` set_spmf M \ spmf (map_spmf f M) x = 0" -unfolding spmf_eq_0_set_spmf by simp + unfolding spmf_eq_0_set_spmf by simp lemma ennreal_spmf_map: "ennreal (spmf (map_spmf f p) x) = emeasure (measure_spmf p) (f -` {x})" -by(auto simp add: ennreal_pmf_map measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure]) + by (metis emeasure_map_spmf emeasure_spmf_single) lemma spmf_map: "spmf (map_spmf f p) x = measure (measure_spmf p) (f -` {x})" -using ennreal_spmf_map[of f p x] by(simp add: measure_spmf.emeasure_eq_measure) + using ennreal_spmf_map[of f p x] by(simp add: measure_spmf.emeasure_eq_measure) lemma ennreal_spmf_map_conv_nn_integral: "ennreal (spmf (map_spmf f p) x) = integral\<^sup>N (measure_spmf p) (indicator (f -` {x}))" -by(auto simp add: ennreal_pmf_map measure_spmf_def emeasure_distr space_restrict_space emeasure_restrict_space intro: arg_cong2[where f=emeasure]) + by (simp add: ennreal_spmf_map) subsection \Monad operations\ subsubsection \Return\ abbreviation return_spmf :: "'a \ 'a spmf" -where "return_spmf x \ return_pmf (Some x)" + where "return_spmf x \ return_pmf (Some x)" lemma pmf_return_spmf: "pmf (return_spmf x) y = indicator {y} (Some x)" -by(fact pmf_return) + by(fact pmf_return) lemma measure_spmf_return_spmf: "measure_spmf (return_spmf x) = Giry_Monad.return (count_space UNIV) x" -by(rule measure_eqI)(simp_all add: measure_spmf_def emeasure_distr space_restrict_space emeasure_restrict_space indicator_def) + by(rule measure_eqI)(simp_all add: measure_spmf_def emeasure_distr space_restrict_space emeasure_restrict_space indicator_def) lemma measure_spmf_return_pmf_None [simp]: "measure_spmf (return_pmf None) = null_measure (count_space UNIV)" -by(rule measure_eqI)(auto simp add: measure_spmf_def emeasure_distr space_restrict_space emeasure_restrict_space indicator_eq_0_iff) + by (simp add: emeasure_measure_spmf_conv_measure_pmf measure_eqI) lemma set_return_spmf [simp]: "set_spmf (return_spmf x) = {x}" -by(auto simp add: set_spmf_def) + by(auto simp: set_spmf_def) subsubsection \Bind\ definition bind_spmf :: "'a spmf \ ('a \ 'b spmf) \ 'b spmf" -where "bind_spmf x f = bind_pmf x (\a. case a of None \ return_pmf None | Some a' \ f a')" + where "bind_spmf x f = bind_pmf x (\a. case a of None \ return_pmf None | Some a' \ f a')" adhoc_overloading Monad_Syntax.bind bind_spmf lemma return_None_bind_spmf [simp]: "return_pmf None \ (f :: 'a \ _) = return_pmf None" -by(simp add: bind_spmf_def bind_return_pmf) + by(simp add: bind_spmf_def bind_return_pmf) lemma return_bind_spmf [simp]: "return_spmf x \ f = f x" -by(simp add: bind_spmf_def bind_return_pmf) + by(simp add: bind_spmf_def bind_return_pmf) lemma bind_return_spmf [simp]: "x \ return_spmf = x" proof - @@ -542,7 +532,8 @@ lemma bind_spmf_assoc [simp]: fixes x :: "'a spmf" and f :: "'a \ 'b spmf" and g :: "'b \ 'c spmf" shows "(x \ f) \ g = x \ (\y. f y \ g)" -by(auto simp add: bind_spmf_def bind_assoc_pmf fun_eq_iff bind_return_pmf split: option.split intro: arg_cong[where f="bind_pmf x"]) + unfolding bind_spmf_def + by (smt (verit, best) bind_assoc_pmf bind_pmf_cong bind_return_pmf option.case_eq_if) lemma pmf_bind_spmf_None: "pmf (p \ f) None = pmf p None + \ x. pmf (f x) None \measure_spmf p" (is "?lhs = ?rhs") @@ -551,28 +542,40 @@ have "?lhs = \ x. ?f x \measure_pmf p" by(simp add: bind_spmf_def pmf_bind) also have "\ = \ x. ?f None * indicator {None} x + ?f x * indicator (range Some) x \measure_pmf p" - by(rule Bochner_Integration.integral_cong)(auto simp add: indicator_def) + by(rule Bochner_Integration.integral_cong)(auto simp: indicator_def) also have "\ = (\ x. ?f None * indicator {None} x \measure_pmf p) + (\ x. ?f x * indicator (range Some) x \measure_pmf p)" by(rule Bochner_Integration.integral_add)(auto 4 3 intro: integrable_real_mult_indicator measure_pmf.integrable_const_bound[where B=1] simp add: AE_measure_pmf_iff pmf_le_1) also have "\ = pmf p None + \ x. indicator (range Some) x * pmf (f (the x)) None \measure_pmf p" - by(auto simp add: measure_measure_pmf_finite indicator_eq_0_iff intro!: Bochner_Integration.integral_cong) - also have "\ = ?rhs" unfolding measure_spmf_def - by(subst integral_distr)(auto simp add: integral_restrict_space) + by(auto simp: measure_measure_pmf_finite indicator_eq_0_iff intro!: Bochner_Integration.integral_cong) + also have "\ = ?rhs" + unfolding measure_spmf_def + by(subst integral_distr)(auto simp: integral_restrict_space) finally show ?thesis . qed lemma spmf_bind: "spmf (p \ f) y = \ x. spmf (f x) y \measure_spmf p" -unfolding measure_spmf_def -by(subst integral_distr)(auto simp add: bind_spmf_def pmf_bind integral_restrict_space indicator_eq_0_iff intro!: Bochner_Integration.integral_cong split: option.split) +proof - + have "\x. spmf (case x of None \ return_pmf None | Some x \ f x) y = + indicat_real (range Some) x * spmf (f (the x)) y" + by (simp add: split: option.split) + then show ?thesis + by (simp add: measure_spmf_def integral_distr bind_spmf_def pmf_bind integral_restrict_space) +qed lemma ennreal_spmf_bind: "ennreal (spmf (p \ f) x) = \\<^sup>+ y. spmf (f y) x \measure_spmf p" -by(auto simp add: bind_spmf_def ennreal_pmf_bind nn_integral_measure_spmf_conv_measure_pmf nn_integral_restrict_space intro: nn_integral_cong split: split_indicator option.split) +proof - + have "\y. ennreal (spmf (case y of None \ return_pmf None | Some x \ f x) x) = + ennreal (spmf (f (the y)) x) * indicator (range Some) y" + by (simp add: split: option.split) + then show ?thesis + by (simp add: bind_spmf_def ennreal_pmf_bind nn_integral_measure_spmf_conv_measure_pmf nn_integral_restrict_space) +qed lemma measure_spmf_bind_pmf: "measure_spmf (p \ f) = measure_pmf p \ measure_spmf \ f" (is "?lhs = ?rhs") proof(rule measure_eqI) show "sets ?lhs = sets ?rhs" - by(simp add: sets_bind[where N="count_space UNIV"] space_measure_spmf) + by (simp add: Giry_Monad.bind_def) next fix A :: "'a set" have "emeasure ?lhs A = \\<^sup>+ x. emeasure (measure_spmf (f x)) A \measure_pmf p" @@ -602,41 +605,43 @@ qed lemma map_spmf_bind_spmf: "map_spmf f (bind_spmf p g) = bind_spmf p (map_spmf f \ g)" -by(auto simp add: bind_spmf_def map_bind_pmf fun_eq_iff split: option.split intro: arg_cong2[where f=bind_pmf]) + by(auto simp: bind_spmf_def map_bind_pmf fun_eq_iff split: option.split intro: arg_cong2[where f=bind_pmf]) lemma bind_map_spmf: "map_spmf f p \ g = p \ g \ f" -by(simp add: bind_spmf_def bind_map_pmf o_def cong del: option.case_cong_weak) + by(simp add: bind_spmf_def bind_map_pmf o_def cong del: option.case_cong_weak) lemma spmf_bind_leI: assumes "\y. y \ set_spmf p \ spmf (f y) x \ r" and "0 \ r" shows "spmf (bind_spmf p f) x \ r" proof - - have "ennreal (spmf (bind_spmf p f) x) = \\<^sup>+ y. spmf (f y) x \measure_spmf p" by(rule ennreal_spmf_bind) - also have "\ \ \\<^sup>+ y. r \measure_spmf p" by(rule nn_integral_mono_AE)(simp add: assms) - also have "\ \ r" using assms measure_spmf.emeasure_space_le_1 - by(auto simp add: measure_spmf.emeasure_eq_measure intro!: mult_left_le) + have "ennreal (spmf (bind_spmf p f) x) = \\<^sup>+ y. spmf (f y) x \measure_spmf p" + by(rule ennreal_spmf_bind) + also have "\ \ \\<^sup>+ y. r \measure_spmf p" + by(rule nn_integral_mono_AE)(simp add: assms) + also have "\ \ r" + using assms measure_spmf.emeasure_space_le_1 + by(auto simp: measure_spmf.emeasure_eq_measure intro!: mult_left_le) finally show ?thesis using assms(2) by(simp) qed lemma map_spmf_conv_bind_spmf: "map_spmf f p = (p \ (\x. return_spmf (f x)))" -by(simp add: map_pmf_def bind_spmf_def)(rule bind_pmf_cong, simp_all split: option.split) + by(simp add: map_pmf_def bind_spmf_def)(rule bind_pmf_cong, simp_all split: option.split) lemma bind_spmf_cong: - "\ p = q; \x. x \ set_spmf q \ f x = g x \ - \ bind_spmf p f = bind_spmf q g" -by(auto simp add: bind_spmf_def in_set_spmf intro: bind_pmf_cong option.case_cong) + "\ p = q; \x. x \ set_spmf q \ f x = g x \ \ bind_spmf p f = bind_spmf q g" + by(auto simp: bind_spmf_def in_set_spmf intro: bind_pmf_cong option.case_cong) lemma bind_spmf_cong_simp: "\ p = q; \x. x \ set_spmf q =simp=> f x = g x \ \ bind_spmf p f = bind_spmf q g" -by(simp add: simp_implies_def cong: bind_spmf_cong) + by(simp add: simp_implies_def cong: bind_spmf_cong) lemma set_bind_spmf: "set_spmf (M \ f) = set_spmf M \ (set_spmf \ f)" -by(auto simp add: set_spmf_def bind_spmf_def bind_UNION split: option.splits) + by(auto simp: set_spmf_def bind_spmf_def bind_UNION split: option.splits) lemma bind_spmf_const_return_None [simp]: "bind_spmf p (\_. return_pmf None) = return_pmf None" -by(simp add: bind_spmf_def case_option_collapse) + by(simp add: bind_spmf_def case_option_collapse) lemma bind_commute_spmf: "bind_spmf p (\x. bind_spmf q (f x)) = bind_spmf q (\y. bind_spmf p (\x. f x y))" @@ -654,32 +659,24 @@ subsection \Relator\ abbreviation rel_spmf :: "('a \ 'b \ bool) \ 'a spmf \ 'b spmf \ bool" -where "rel_spmf R \ rel_pmf (rel_option R)" - -lemma rel_pmf_mono: - "\rel_pmf A f g; \x y. A x y \ B x y \ \ rel_pmf B f g" -using pmf.rel_mono[of A B] by(simp add: le_fun_def) + where "rel_spmf R \ rel_pmf (rel_option R)" lemma rel_spmf_mono: "\rel_spmf A f g; \x y. A x y \ B x y \ \ rel_spmf B f g" -apply(erule rel_pmf_mono) -using option.rel_mono[of A B] by(simp add: le_fun_def) + by (metis option.rel_sel pmf.rel_mono_strong) lemma rel_spmf_mono_strong: "\ rel_spmf A f g; \x y. \ A x y; x \ set_spmf f; y \ set_spmf g \ \ B x y \ \ rel_spmf B f g" -apply(erule pmf.rel_mono_strong) -apply(erule option.rel_mono_strong) -apply(auto simp add: in_set_spmf) -done + by (metis elem_set in_set_spmf option.rel_mono_strong pmf.rel_mono_strong) lemma rel_spmf_reflI: "(\x. x \ set_spmf p \ P x x) \ rel_spmf P p p" -by(rule rel_pmf_reflI)(auto simp add: set_spmf_def intro: rel_option_reflI) + by (metis (mono_tags, lifting) option.rel_eq pmf.rel_eq rel_spmf_mono_strong) lemma rel_spmfI [intro?]: "\ \x y. (x, y) \ set_spmf pq \ P x y; map_spmf fst pq = p; map_spmf snd pq = q \ \ rel_spmf P p q" by(rule rel_pmf.intros[where pq="map_pmf (\x. case x of None \ (None, None) | Some (a, b) \ (Some a, Some b)) pq"]) - (auto simp add: pmf.map_comp o_def in_set_spmf split: option.splits intro: pmf.map_cong) + (auto simp: pmf.map_comp o_def in_set_spmf split: option.splits intro: pmf.map_cong) lemma rel_spmfE [elim?, consumes 1, case_names rel_spmf]: assumes "rel_spmf P p q" @@ -687,76 +684,76 @@ "\x y. (x, y) \ set_spmf pq \ P x y" "p = map_spmf fst pq" "q = map_spmf snd pq" -using assms + using assms proof(cases rule: rel_pmf.cases[consumes 1, case_names rel_pmf]) case (rel_pmf pq) let ?pq = "map_pmf (\(a, b). case (a, b) of (Some x, Some y) \ Some (x, y) | _ \ None) pq" have "\x y. (x, y) \ set_spmf ?pq \ P x y" - by(auto simp add: in_set_spmf split: option.split_asm dest: rel_pmf(1)) + by(auto simp: in_set_spmf split: option.split_asm dest: rel_pmf(1)) moreover have "\x. (x, None) \ set_pmf pq \ x = None" by(auto dest!: rel_pmf(1)) then have "p = map_spmf fst ?pq" using rel_pmf(2) - by(auto simp add: pmf.map_comp split_beta intro!: pmf.map_cong split: option.split) + by(auto simp: pmf.map_comp split_beta intro!: pmf.map_cong split: option.split) moreover have "\y. (None, y) \ set_pmf pq \ y = None" by(auto dest!: rel_pmf(1)) then have "q = map_spmf snd ?pq" using rel_pmf(3) - by(auto simp add: pmf.map_comp split_beta intro!: pmf.map_cong split: option.split) + by(auto simp: pmf.map_comp split_beta intro!: pmf.map_cong split: option.split) ultimately show thesis .. qed lemma rel_spmf_simps: "rel_spmf R p q \ (\pq. (\(x, y)\set_spmf pq. R x y) \ map_spmf fst pq = p \ map_spmf snd pq = q)" -by(auto intro: rel_spmfI elim!: rel_spmfE) + by(auto intro: rel_spmfI elim!: rel_spmfE) lemma spmf_rel_map: shows spmf_rel_map1: "\R f x. rel_spmf R (map_spmf f x) = rel_spmf (\x. R (f x)) x" - and spmf_rel_map2: "\R x g y. rel_spmf R x (map_spmf g y) = rel_spmf (\x y. R x (g y)) x y" -by(simp_all add: fun_eq_iff pmf.rel_map option.rel_map[abs_def]) + and spmf_rel_map2: "\R x g y. rel_spmf R x (map_spmf g y) = rel_spmf (\x y. R x (g y)) x y" + by(simp_all add: fun_eq_iff pmf.rel_map option.rel_map[abs_def]) lemma spmf_rel_conversep: "rel_spmf R\\ = (rel_spmf R)\\" -by(simp add: option.rel_conversep pmf.rel_conversep) + by(simp add: option.rel_conversep pmf.rel_conversep) lemma spmf_rel_eq: "rel_spmf (=) = (=)" -by(simp add: pmf.rel_eq option.rel_eq) + by(simp add: pmf.rel_eq option.rel_eq) context includes lifting_syntax begin lemma bind_spmf_parametric [transfer_rule]: "(rel_spmf A ===> (A ===> rel_spmf B) ===> rel_spmf B) bind_spmf bind_spmf" -unfolding bind_spmf_def[abs_def] by transfer_prover + unfolding bind_spmf_def[abs_def] by transfer_prover lemma return_spmf_parametric: "(A ===> rel_spmf A) return_spmf return_spmf" -by transfer_prover + by transfer_prover lemma map_spmf_parametric: "((A ===> B) ===> rel_spmf A ===> rel_spmf B) map_spmf map_spmf" -by transfer_prover + by transfer_prover lemma rel_spmf_parametric: "((A ===> B ===> (=)) ===> rel_spmf A ===> rel_spmf B ===> (=)) rel_spmf rel_spmf" -by transfer_prover + by transfer_prover lemma set_spmf_parametric [transfer_rule]: "(rel_spmf A ===> rel_set A) set_spmf set_spmf" -unfolding set_spmf_def[abs_def] by transfer_prover + unfolding set_spmf_def[abs_def] by transfer_prover lemma return_spmf_None_parametric: "(rel_spmf A) (return_pmf None) (return_pmf None)" -by simp + by simp end lemma rel_spmf_bindI: "\ rel_spmf R p q; \x y. R x y \ rel_spmf P (f x) (g y) \ \ rel_spmf P (p \ f) (q \ g)" -by(fact bind_spmf_parametric[THEN rel_funD, THEN rel_funD, OF _ rel_funI]) + by(fact bind_spmf_parametric[THEN rel_funD, THEN rel_funD, OF _ rel_funI]) lemma rel_spmf_bind_reflI: "(\x. x \ set_spmf p \ rel_spmf P (f x) (g x)) \ rel_spmf P (p \ f) (p \ g)" -by(rule rel_spmf_bindI[where R="\x y. x = y \ x \ set_spmf p"])(auto intro: rel_spmf_reflI) + by(rule rel_spmf_bindI[where R="\x y. x = y \ x \ set_spmf p"])(auto intro: rel_spmf_reflI) lemma rel_pmf_return_pmfI: "P x y \ rel_pmf P (return_pmf x) (return_pmf y)" -by(rule rel_pmf.intros[where pq="return_pmf (x, y)"])(simp_all) + by simp context includes lifting_syntax begin @@ -770,97 +767,99 @@ from this(1) obtain pq where A: "\x y. (x, y) \ set_pmf pq \ A x y" and p: "p = map_pmf fst pq" and q: "q = map_pmf snd pq" by cases auto show "measure p X = measure q Y" unfolding p q measure_map_pmf - by(rule measure_pmf.finite_measure_eq_AE)(auto simp add: AE_measure_pmf_iff dest!: A rel_predD[OF \rel_pred _ _ _\]) + by(rule measure_pmf.finite_measure_eq_AE)(auto simp: AE_measure_pmf_iff dest!: A rel_predD[OF \rel_pred _ _ _\]) qed lemma measure_spmf_parametric: "(rel_spmf A ===> rel_pred A ===> (=)) (\p. measure (measure_spmf p)) (\q. measure (measure_spmf q))" -unfolding measure_measure_spmf_conv_measure_pmf[abs_def] -apply(rule rel_funI)+ -apply(erule measure_pmf_parametric[THEN rel_funD, THEN rel_funD]) -apply(auto simp add: rel_pred_def rel_fun_def elim: option.rel_cases) -done +proof - + have "\x y xa ya. rel_pred A xa ya \ rel_pred (rel_option A) (Some ` xa) (Some ` ya)" + by(auto simp: rel_pred_def rel_fun_def elim: option.rel_cases) + then show ?thesis + unfolding measure_measure_spmf_conv_measure_pmf[abs_def] + by (intro rel_funI) (force elim!: measure_pmf_parametric[THEN rel_funD, THEN rel_funD]) +qed end subsection \From \<^typ>\'a pmf\ to \<^typ>\'a spmf\\ definition spmf_of_pmf :: "'a pmf \ 'a spmf" -where "spmf_of_pmf = map_pmf Some" + where "spmf_of_pmf = map_pmf Some" lemma set_spmf_spmf_of_pmf [simp]: "set_spmf (spmf_of_pmf p) = set_pmf p" -by(auto simp add: spmf_of_pmf_def set_spmf_def bind_image o_def) + by(auto simp: spmf_of_pmf_def set_spmf_def bind_image o_def) lemma spmf_spmf_of_pmf [simp]: "spmf (spmf_of_pmf p) x = pmf p x" -by(simp add: spmf_of_pmf_def) + by(simp add: spmf_of_pmf_def) lemma pmf_spmf_of_pmf_None [simp]: "pmf (spmf_of_pmf p) None = 0" -using ennreal_pmf_map[of Some p None] by(simp add: spmf_of_pmf_def) + using ennreal_pmf_map[of Some p None] by(simp add: spmf_of_pmf_def) lemma emeasure_spmf_of_pmf [simp]: "emeasure (measure_spmf (spmf_of_pmf p)) A = emeasure (measure_pmf p) A" -by(simp add: emeasure_measure_spmf_conv_measure_pmf spmf_of_pmf_def inj_vimage_image_eq) + by(simp add: emeasure_measure_spmf_conv_measure_pmf spmf_of_pmf_def inj_vimage_image_eq) lemma measure_spmf_spmf_of_pmf [simp]: "measure_spmf (spmf_of_pmf p) = measure_pmf p" -by(rule measure_eqI) simp_all + by(rule measure_eqI) simp_all lemma map_spmf_of_pmf [simp]: "map_spmf f (spmf_of_pmf p) = spmf_of_pmf (map_pmf f p)" -by(simp add: spmf_of_pmf_def pmf.map_comp o_def) + by(simp add: spmf_of_pmf_def pmf.map_comp o_def) lemma rel_spmf_spmf_of_pmf [simp]: "rel_spmf R (spmf_of_pmf p) (spmf_of_pmf q) = rel_pmf R p q" -by(simp add: spmf_of_pmf_def pmf.rel_map) + by(simp add: spmf_of_pmf_def pmf.rel_map) lemma spmf_of_pmf_return_pmf [simp]: "spmf_of_pmf (return_pmf x) = return_spmf x" -by(simp add: spmf_of_pmf_def) + by(simp add: spmf_of_pmf_def) lemma bind_spmf_of_pmf [simp]: "bind_spmf (spmf_of_pmf p) f = bind_pmf p f" -by(simp add: spmf_of_pmf_def bind_spmf_def bind_map_pmf) + by(simp add: spmf_of_pmf_def bind_spmf_def bind_map_pmf) lemma set_spmf_bind_pmf: "set_spmf (bind_pmf p f) = Set.bind (set_pmf p) (set_spmf \ f)" -unfolding bind_spmf_of_pmf[symmetric] by(subst set_bind_spmf) simp + unfolding bind_spmf_of_pmf[symmetric] by(subst set_bind_spmf) simp lemma spmf_of_pmf_bind: "spmf_of_pmf (bind_pmf p f) = bind_pmf p (\x. spmf_of_pmf (f x))" -by(simp add: spmf_of_pmf_def map_bind_pmf) + by(simp add: spmf_of_pmf_def map_bind_pmf) lemma bind_pmf_return_spmf: "p \ (\x. return_spmf (f x)) = spmf_of_pmf (map_pmf f p)" -by(simp add: map_pmf_def spmf_of_pmf_bind) + by(simp add: map_pmf_def spmf_of_pmf_bind) subsection \Weight of a subprobability\ abbreviation weight_spmf :: "'a spmf \ real" -where "weight_spmf p \ measure (measure_spmf p) (space (measure_spmf p))" + where "weight_spmf p \ measure (measure_spmf p) (space (measure_spmf p))" lemma weight_spmf_def: "weight_spmf p = measure (measure_spmf p) UNIV" -by(simp add: space_measure_spmf) + by(simp add: space_measure_spmf) lemma weight_spmf_le_1: "weight_spmf p \ 1" -by(simp add: measure_spmf.subprob_measure_le_1) + by(rule measure_spmf.subprob_measure_le_1) lemma weight_return_spmf [simp]: "weight_spmf (return_spmf x) = 1" -by(simp add: measure_spmf_return_spmf measure_return) + by(simp add: measure_spmf_return_spmf measure_return) lemma weight_return_pmf_None [simp]: "weight_spmf (return_pmf None) = 0" -by(simp) + by(simp) lemma weight_map_spmf [simp]: "weight_spmf (map_spmf f p) = weight_spmf p" -by(simp add: weight_spmf_def measure_map_spmf) + by(simp add: weight_spmf_def measure_map_spmf) lemma weight_spmf_of_pmf [simp]: "weight_spmf (spmf_of_pmf p) = 1" -using measure_pmf.prob_space[of p] by(simp add: spmf_of_pmf_def weight_spmf_def) + by simp lemma weight_spmf_nonneg: "weight_spmf p \ 0" -by(fact measure_nonneg) + by(fact measure_nonneg) lemma (in finite_measure) integrable_weight_spmf [simp]: "(\x. weight_spmf (f x)) \ borel_measurable M \ integrable M (\x. weight_spmf (f x))" -by(rule integrable_const_bound[where B=1])(simp_all add: weight_spmf_nonneg weight_spmf_le_1) + by(rule integrable_const_bound[where B=1])(simp_all add: weight_spmf_nonneg weight_spmf_le_1) lemma weight_spmf_eq_nn_integral_spmf: "weight_spmf p = \\<^sup>+ x. spmf p x \count_space UNIV" -by(simp add: measure_measure_spmf_conv_measure_pmf space_measure_spmf measure_pmf.emeasure_eq_measure[symmetric] nn_integral_pmf[symmetric] embed_measure_count_space[symmetric] inj_on_def nn_integral_embed_measure measurable_embed_measure1) + by (metis NO_MATCH_def measure_spmf.emeasure_eq_measure nn_integral_count_space_indicator nn_integral_indicator nn_integral_measure_spmf sets_UNIV sets_measure_spmf space_measure_spmf) lemma weight_spmf_eq_nn_integral_support: "weight_spmf p = \\<^sup>+ x. spmf p x \count_space (set_spmf p)" -unfolding weight_spmf_eq_nn_integral_spmf -by(auto simp add: nn_integral_count_space_indicator in_set_spmf_iff_spmf intro!: nn_integral_cong split: split_indicator) + unfolding weight_spmf_eq_nn_integral_spmf + by(auto simp: nn_integral_count_space_indicator in_set_spmf_iff_spmf intro!: nn_integral_cong split: split_indicator) lemma pmf_None_eq_weight_spmf: "pmf p None = 1 - weight_spmf p" proof - @@ -876,30 +875,23 @@ qed lemma weight_spmf_conv_pmf_None: "weight_spmf p = 1 - pmf p None" -by(simp add: pmf_None_eq_weight_spmf) - -lemma weight_spmf_le_0: "weight_spmf p \ 0 \ weight_spmf p = 0" -by(rule measure_le_0_iff) + by(simp add: pmf_None_eq_weight_spmf) lemma weight_spmf_lt_0: "\ weight_spmf p < 0" -by(simp add: not_less weight_spmf_nonneg) + by(simp add: not_less weight_spmf_nonneg) lemma spmf_le_weight: "spmf p x \ weight_spmf p" -proof - - have "ennreal (spmf p x) \ weight_spmf p" - unfolding weight_spmf_eq_nn_integral_spmf by(rule nn_integral_ge_point) simp - then show ?thesis by simp -qed + by (simp add: measure_spmf.bounded_measure spmf_conv_measure_spmf) lemma weight_spmf_eq_0: "weight_spmf p = 0 \ p = return_pmf None" -by(auto intro!: pmf_eqI simp add: pmf_None_eq_weight_spmf split: split_indicator)(metis not_Some_eq pmf_le_0_iff spmf_le_weight) + by (metis measure_le_0_iff measure_spmf.bounded_measure spmf_conv_measure_spmf spmf_eqI weight_return_pmf_None) lemma weight_bind_spmf: "weight_spmf (x \ f) = lebesgue_integral (measure_spmf x) (weight_spmf \ f)" -unfolding weight_spmf_def -by(simp add: measure_spmf_bind o_def measure_spmf.measure_bind[where N="count_space UNIV"]) + unfolding weight_spmf_def + by(simp add: measure_spmf_bind o_def measure_spmf.measure_bind[where N="count_space UNIV"]) lemma rel_spmf_weightD: "rel_spmf A p q \ weight_spmf p = weight_spmf q" -by(erule rel_spmfE) simp + by(erule rel_spmfE) simp lemma rel_spmf_bij_betw: assumes f: "bij_betw f (set_spmf p) (set_spmf q)" @@ -914,14 +906,22 @@ then have "None \ set_pmf p \ None \ set_pmf q" by(simp add: pmf_None_eq_weight_spmf set_pmf_iff) with f have "bij_betw (map_option f) (set_pmf p) (set_pmf q)" - apply(auto simp add: bij_betw_def in_set_spmf inj_on_def intro: option.expand) + apply(auto simp: bij_betw_def in_set_spmf inj_on_def intro: option.expand split: option.split) apply(rename_tac [!] x) apply(case_tac [!] x) apply(auto iff: in_set_spmf) done then have "rel_pmf (\x y. ?f x = y) p q" - by(rule rel_pmf_bij_betw)(case_tac x, simp_all add: weq[simplified] eq in_set_spmf pmf_None_eq_weight_spmf) - thus ?thesis by(rule pmf.rel_mono_strong)(auto intro!: rel_optionI simp add: Option.is_none_def) + proof (rule rel_pmf_bij_betw) + show "pmf p x = pmf q (map_option f x)" if "x \ set_pmf p" for x + proof (cases x) + case None + then show ?thesis + by (metis ennreal_inj measure_nonneg option.map_disc_iff pmf_None_eq_weight_spmf weq) + qed (use eq in_set_spmf that in force) + qed + thus ?thesis + by (smt (verit, ccfv_SIG) None_eq_map_option_iff option.map_sel option.rel_sel pmf.rel_mono_strong) qed subsection \From density to spmfs\ @@ -929,7 +929,7 @@ context fixes f :: "'a \ real" begin definition embed_spmf :: "'a spmf" -where "embed_spmf = embed_pmf (\x. case x of None \ 1 - enn2real (\\<^sup>+ x. ennreal (f x) \count_space UNIV) | Some x' \ max 0 (f x'))" + where "embed_spmf = embed_pmf (\x. case x of None \ 1 - enn2real (\\<^sup>+ x. ennreal (f x) \count_space UNIV) | Some x' \ max 0 (f x'))" context assumes prob: "(\\<^sup>+ x. ennreal (f x) \count_space UNIV) \ 1" @@ -951,32 +951,25 @@ also have "(\\<^sup>+ x. ?f x \\) = \\<^sup>+ x. ennreal (f x) \count_space UNIV" by(subst nn_integral_embed_measure)(simp_all add: measurable_embed_measure1) also have "?None + \ = 1" using prob - by(auto simp add: ennreal_minus[symmetric] ennreal_1[symmetric] ennreal_enn2real_if top_unique simp del: ennreal_1)(simp add: diff_add_self_ennreal) + by(auto simp: ennreal_minus[symmetric] ennreal_1[symmetric] ennreal_enn2real_if top_unique simp del: ennreal_1)(simp add: diff_add_self_ennreal) finally show ?thesis . qed lemma pmf_embed_spmf_None: "pmf embed_spmf None = 1 - enn2real (\\<^sup>+ x. ennreal (f x) \count_space UNIV)" unfolding embed_spmf_def -apply(subst pmf_embed_pmf) - subgoal using prob by(simp add: field_simps enn2real_leI split: option.split) - apply(rule nn_integral_embed_spmf_eq_1) -apply simp -done + by (smt (verit, del_insts) enn2real_leI ennreal_1 nn_integral_cong nn_integral_embed_spmf_eq_1 + option.case_eq_if pmf_embed_pmf prob) lemma spmf_embed_spmf [simp]: "spmf embed_spmf x = max 0 (f x)" -unfolding embed_spmf_def -apply(subst pmf_embed_pmf) - subgoal using prob by(simp add: field_simps enn2real_leI split: option.split) - apply(rule nn_integral_embed_spmf_eq_1) -apply simp -done + unfolding embed_spmf_def + by (smt (verit, best) enn2real_leI ennreal_1 nn_integral_cong nn_integral_embed_spmf_eq_1 option.case_eq_if option.simps(5) pmf_embed_pmf prob) end end -lemma embed_spmf_K_0[simp]: "embed_spmf (\_. 0) = return_pmf None" (is "?lhs = ?rhs") -by(rule spmf_eqI)(simp add: zero_ereal_def[symmetric]) +lemma embed_spmf_K_0[simp]: "embed_spmf (\_. 0) = return_pmf None" + by(rule spmf_eqI)(simp add: zero_ereal_def[symmetric]) subsection \Ordering on spmfs\ @@ -996,20 +989,20 @@ \ abbreviation ord_spmf :: "('a \ 'a \ bool) \ 'a spmf \ 'a spmf \ bool" -where "ord_spmf ord \ rel_pmf (ord_option ord)" + where "ord_spmf ord \ rel_pmf (ord_option ord)" locale ord_spmf_syntax begin notation ord_spmf (infix "\\" 60) end lemma ord_spmf_map_spmf1: "ord_spmf R (map_spmf f p) = ord_spmf (\x. R (f x)) p" -by(simp add: pmf.rel_map[abs_def] ord_option_map1[abs_def]) + by(simp add: pmf.rel_map[abs_def] ord_option_map1[abs_def]) lemma ord_spmf_map_spmf2: "ord_spmf R p (map_spmf f q) = ord_spmf (\x y. R x (f y)) p q" -by(simp add: pmf.rel_map ord_option_map2) + by(simp add: pmf.rel_map ord_option_map2) lemma ord_spmf_map_spmf12: "ord_spmf R (map_spmf f p) (map_spmf f q) = ord_spmf (\x y. R (f x) (f y)) p q" -by(simp add: pmf.rel_map ord_option_map1[abs_def] ord_option_map2) + by(simp add: pmf.rel_map ord_option_map1[abs_def] ord_option_map2) lemmas ord_spmf_map_spmf = ord_spmf_map_spmf1 ord_spmf_map_spmf2 ord_spmf_map_spmf12 @@ -1019,14 +1012,14 @@ lemma ord_spmfI: "\ \x y. (x, y) \ set_spmf pq \ ord x y; map_spmf fst pq = p; map_spmf snd pq = q \ \ p \ q" -by(rule rel_pmf.intros[where pq="map_pmf (\x. case x of None \ (None, None) | Some (a, b) \ (Some a, Some b)) pq"]) - (auto simp add: pmf.map_comp o_def in_set_spmf split: option.splits intro: pmf.map_cong) + by(rule rel_pmf.intros[where pq="map_pmf (\x. case x of None \ (None, None) | Some (a, b) \ (Some a, Some b)) pq"]) + (auto simp: pmf.map_comp o_def in_set_spmf split: option.splits intro: pmf.map_cong) lemma ord_spmf_None [simp]: "return_pmf None \ x" -by(rule rel_pmf.intros[where pq="map_pmf (Pair None) x"])(auto simp add: pmf.map_comp o_def) + by(rule rel_pmf.intros[where pq="map_pmf (Pair None) x"])(auto simp: pmf.map_comp o_def) lemma ord_spmf_reflI: "(\x. x \ set_spmf p \ ord x x) \ p \ p" -by(rule rel_pmf_reflI ord_option_reflI)+(auto simp add: in_set_spmf) + by (metis elem_set in_set_spmf ord_option_reflI pmf.rel_refl_strong) lemma rel_spmf_inf: assumes "p \ q" @@ -1037,34 +1030,33 @@ proof - from \p \ q\ \q \ p\ have "rel_pmf (inf (ord_option ord) (ord_option ord)\\) p q" - by(rule rel_pmf_inf)(blast intro: reflp_ord_option transp_ord_option refl trans)+ + using local.refl local.trans reflp_ord_option rel_pmf_inf transp_ord_option by blast also have "inf (ord_option ord) (ord_option ord)\\ = rel_option (inf ord ord\\)" - by(auto simp add: fun_eq_iff elim: ord_option.cases option.rel_cases) + by(auto simp: fun_eq_iff elim: ord_option.cases option.rel_cases) finally show ?thesis . qed end lemma ord_spmf_return_spmf2: "ord_spmf R p (return_spmf y) \ (\x\set_spmf p. R x y)" -by(auto simp add: rel_pmf_return_pmf2 in_set_spmf ord_option.simps intro: ccontr) + by(auto simp: rel_pmf_return_pmf2 in_set_spmf ord_option.simps intro: ccontr) lemma ord_spmf_mono: "\ ord_spmf A p q; \x y. A x y \ B x y \ \ ord_spmf B p q" -by(erule rel_pmf_mono)(erule ord_option_mono) + by(erule pmf.rel_mono_strong)(erule ord_option_mono) lemma ord_spmf_compp: "ord_spmf (A OO B) = ord_spmf A OO ord_spmf B" -by(simp add: ord_option_compp pmf.rel_compp) + by(simp add: ord_option_compp pmf.rel_compp) lemma ord_spmf_bindI: assumes pq: "ord_spmf R p q" - and fg: "\x y. R x y \ ord_spmf P (f x) (g y)" + and fg: "\x y. R x y \ ord_spmf P (f x) (g y)" shows "ord_spmf P (p \ f) (q \ g)" -unfolding bind_spmf_def using pq -by(rule rel_pmf_bindI)(auto split: option.split intro: fg) + unfolding bind_spmf_def using pq + by(rule rel_pmf_bindI)(auto split: option.split intro: fg) lemma ord_spmf_bind_reflI: - "(\x. x \ set_spmf p \ ord_spmf R (f x) (g x)) - \ ord_spmf R (p \ f) (p \ g)" -by(rule ord_spmf_bindI[where R="\x y. x = y \ x \ set_spmf p"])(auto intro: ord_spmf_reflI) + "(\x. x \ set_spmf p \ ord_spmf R (f x) (g x)) \ ord_spmf R (p \ f) (p \ g)" + by(rule ord_spmf_bindI[where R="\x y. x = y \ x \ set_spmf p"])(auto intro: ord_spmf_reflI) lemma ord_pmf_increaseI: assumes le: "\x. spmf p x \ spmf q x" @@ -1098,12 +1090,13 @@ also have "?Some = \\<^sup>+ x. spmf p x \count_space UNIV" by(simp add: nn_integral_count_space_indicator[symmetric] embed_measure_count_space[symmetric] inj_on_def nn_integral_embed_measure measurable_embed_measure1) also have "pmf q None + (?Some2' - ?Some2'') + \ = pmf q None + ?Some2'" - by(auto simp add: diff_add_self_ennreal le intro!: nn_integral_mono) + by(auto simp: diff_add_self_ennreal le intro!: nn_integral_mono) also have "\ = \\<^sup>+ x. ennreal (pmf q x) * indicator {None} x + ennreal (pmf q x) * indicator (range Some) x \count_space UNIV" by(subst nn_integral_add)(simp_all add: nn_integral_count_space_indicator[symmetric] embed_measure_count_space[symmetric] nn_integral_embed_measure measurable_embed_measure1) also have "\ = \\<^sup>+ x. pmf q x \count_space UNIV" by(rule nn_integral_cong)(auto split: split_indicator) - also have "\ = 1" by(simp add: nn_integral_pmf) + also have "\ = 1" + by(simp add: nn_integral_pmf) finally show ?thesis . qed note f = nonneg integral @@ -1115,18 +1108,17 @@ by(simp add: spmf_eq_0_set_spmf refl split: option.split_asm if_split_asm) } have weight_le: "weight_spmf p \ weight_spmf q" - by(subst ennreal_le_iff[symmetric])(auto simp add: weight_spmf_eq_nn_integral_spmf intro!: nn_integral_mono le) + by(subst ennreal_le_iff[symmetric])(auto simp: weight_spmf_eq_nn_integral_spmf intro!: nn_integral_mono le) show "map_pmf fst pq = p" proof(rule pmf_eqI) - fix i + fix i :: "'a option" + have bi: "bij_betw (Pair i) UNIV (fst -` {i})" + by(auto simp: bij_betw_def inj_on_def) have "ennreal (pmf (map_pmf fst pq) i) = (\\<^sup>+ y. pmf pq (i, y) \count_space UNIV)" unfolding pq_def ennreal_pmf_map - apply(simp add: embed_pmf.rep_eq[OF f] o_def emeasure_density nn_integral_count_space_indicator[symmetric]) - apply(subst pmf_embed_pmf[OF f]) - apply(rule nn_integral_bij_count_space[symmetric]) - apply(auto simp add: bij_betw_def inj_on_def) - done + apply (simp add: embed_pmf.rep_eq[OF f] o_def emeasure_density flip: nn_integral_count_space_indicator) + by (smt (verit, best) nn_integral_bij_count_space [OF bi] integral nn_integral_cong nonneg pmf_embed_pmf) also have "\ = pmf p i" proof(cases i) case (Some x) @@ -1150,21 +1142,20 @@ by(simp add: pmf_None_eq_weight_spmf weight_spmf_eq_nn_integral_spmf[symmetric] ennreal_minus) also have "\ = ennreal (pmf p None) - ennreal (pmf q None)" by(simp add: ennreal_minus) finally show ?thesis using None weight_le - by(auto simp add: diff_add_self_ennreal pmf_None_eq_weight_spmf intro: ennreal_leI) + by(auto simp: diff_add_self_ennreal pmf_None_eq_weight_spmf intro: ennreal_leI) qed finally show "pmf (map_pmf fst pq) i = pmf p i" by simp qed show "map_pmf snd pq = q" proof(rule pmf_eqI) - fix i + fix i :: "'a option" + have bi: "bij_betw (\x. (x, i)) UNIV (snd -` {i})" + by (auto simp: bij_betw_def inj_on_def) have "ennreal (pmf (map_pmf snd pq) i) = (\\<^sup>+ x. pmf pq (x, i) \count_space UNIV)" unfolding pq_def ennreal_pmf_map apply(simp add: embed_pmf.rep_eq[OF f] o_def emeasure_density nn_integral_count_space_indicator[symmetric]) - apply(subst pmf_embed_pmf[OF f]) - apply(rule nn_integral_bij_count_space[symmetric]) - apply(auto simp add: bij_betw_def inj_on_def) - done + by (smt (verit, best) nn_integral_bij_count_space [OF bi] integral nn_integral_cong nonneg pmf_embed_pmf) also have "\ = ennreal (pmf q i)" proof(cases i) case None @@ -1180,7 +1171,7 @@ also have "\ = (\\<^sup>+ x. ennreal (pmf pq (x, Some y)) * indicator (range Some) x \count_space UNIV) + pmf pq (None, Some y)" by(subst nn_integral_add)(simp_all) also have "\ = (\\<^sup>+ x. ennreal (spmf p y) * indicator {Some y} x \count_space UNIV) + (spmf q y - spmf p y)" - by(auto simp add: pq_def pmf_embed_pmf[OF f] one_ereal_def[symmetric] simp del: nn_integral_indicator_singleton intro!: arg_cong2[where f="(+)"] nn_integral_cong split: option.split) + by(auto simp: pq_def pmf_embed_pmf[OF f] one_ereal_def[symmetric] simp del: nn_integral_indicator_singleton intro!: arg_cong2[where f="(+)"] nn_integral_cong split: option.split) also have "\ = spmf q y" by(simp add: ennreal_minus[symmetric] le) finally show ?thesis using Some by simp qed @@ -1203,7 +1194,7 @@ have "ennreal (spmf p x) = integral\<^sup>N pq (indicator (fst -` {Some x}))" using p by(simp add: ennreal_pmf_map) also have "\ = integral\<^sup>N pq (indicator {(Some x, Some x)})" - by(rule nn_integral_cong_AE)(auto simp add: AE_measure_pmf_iff split: split_indicator dest: pq) + by(rule nn_integral_cong_AE)(auto simp: AE_measure_pmf_iff split: split_indicator dest: pq) also have "\ \ integral\<^sup>N pq (indicator (snd -` {Some x}))" by(rule nn_integral_mono) simp also have "\ = ennreal (spmf q x)" using q by(simp add: ennreal_pmf_map) @@ -1211,11 +1202,11 @@ qed lemma ord_spmf_eqD_set_spmf: "ord_spmf (=) p q \ set_spmf p \ set_spmf q" -by(rule subsetI)(drule_tac x=x in ord_spmf_eq_leD, auto simp add: in_set_spmf_iff_spmf) + by (metis ord_spmf_eq_leD pmf_le_0_iff spmf_eq_0_set_spmf subsetI) lemma ord_spmf_eqD_emeasure: "ord_spmf (=) p q \ emeasure (measure_spmf p) A \ emeasure (measure_spmf q) A" -by(auto intro!: nn_integral_mono split: split_indicator dest: ord_spmf_eq_leD simp add: nn_integral_measure_spmf nn_integral_indicator[symmetric]) + by(auto intro!: nn_integral_mono split: split_indicator dest: ord_spmf_eq_leD simp add: nn_integral_measure_spmf nn_integral_indicator[symmetric]) lemma ord_spmf_eqD_measure_spmf: "ord_spmf (=) p q \ measure_spmf p \ measure_spmf q" by (subst le_measure) (auto simp: ord_spmf_eqD_emeasure) @@ -1229,9 +1220,10 @@ \ \We go through \<^typ>\ennreal\ to have a sensible definition even if \<^term>\Y\ is empty.\ lemma lub_spmf_empty [simp]: "SPMF.lub_spmf {} = return_pmf None" -by(simp add: SPMF.lub_spmf_def bot_ereal_def) - -context assumes chain: "Complete_Partial_Order.chain (ord_spmf (=)) Y" begin + by(simp add: SPMF.lub_spmf_def bot_ereal_def) + +context assumes chain: "Complete_Partial_Order.chain (ord_spmf (=)) Y" +begin lemma chain_ord_spmf_eqD: "Complete_Partial_Order.chain (\) ((\p x. ennreal (spmf p x)) ` Y)" (is "Complete_Partial_Order.chain _ (?f ` _)") @@ -1241,17 +1233,7 @@ then obtain p q where f: "f = ?f p" "p \ Y" and g: "g = ?f q" "q \ Y" by blast from chain \p \ Y\ \q \ Y\ have "ord_spmf (=) p q \ ord_spmf (=) q p" by(rule chainD) thus "f \ g \ g \ f" - proof - assume "ord_spmf (=) p q" - hence "\x. spmf p x \ spmf q x" by(rule ord_spmf_eq_leD) - hence "f \ g" unfolding f g by(auto intro: le_funI) - thus ?thesis .. - next - assume "ord_spmf (=) q p" - hence "\x. spmf q x \ spmf p x" by(rule ord_spmf_eq_leD) - hence "g \ f" unfolding f g by(auto intro: le_funI) - thus ?thesis .. - qed + by (metis ennreal_leI f(1) g(1) le_funI ord_spmf_eq_leD) qed lemma ord_spmf_eq_pmf_None_eq: @@ -1275,11 +1257,11 @@ lemma ord_spmf_eqD_pmf_None: assumes "ord_spmf (=) x y" shows "pmf x None \ pmf y None" -using assms -apply cases -apply(clarsimp simp only: ennreal_le_iff[symmetric, OF pmf_nonneg] ennreal_pmf_map) -apply(fastforce simp add: AE_measure_pmf_iff intro!: nn_integral_mono_AE) -done + using assms + apply cases + apply(clarsimp simp only: ennreal_le_iff[symmetric, OF pmf_nonneg] ennreal_pmf_map) + apply(fastforce simp: AE_measure_pmf_iff intro!: nn_integral_mono_AE) + done text \ Chains on \<^typ>\'a spmf\ maintain countable support. @@ -1302,7 +1284,7 @@ using chainD[OF chain, of x y] ord_spmf_eqD_pmf_None[of x y] ord_spmf_eqD_pmf_None[of y x] by (auto simp: N_def) have N_eq_imp_eq: "\ x \ Y; y \ Y; N y = N x \ \ x = y" for x y - using chainD[OF chain, of x y] by(auto simp add: N_def dest: ord_spmf_eq_pmf_None_eq) + using chainD[OF chain, of x y] by(auto simp: N_def dest: ord_spmf_eq_pmf_None_eq) have NC: "N ` Y \ {}" "bdd_below (N ` Y)" using \Y \ {}\ by(auto intro!: bdd_belowI[of _ 0] simp: N_def) @@ -1311,7 +1293,7 @@ assume **: "\ (\y\N ` Y. y < N x)" { fix y assume "y \ Y" - with ** consider "N x < N y" | "N x = N y" by(auto simp add: not_less le_less) + with ** consider "N x < N y" | "N x = N y" by(auto simp: not_less le_less) hence "ord_spmf (=) y x" using \y \ Y\ \x \ Y\ by cases(auto dest: N_less_imp_le_spmf N_eq_imp_eq intro: ord_spmf_reflI) } with False \x \ Y\ show False by blast @@ -1387,7 +1369,7 @@ qed lemma ennreal_spmf_lub_spmf: "Y \ {} \ ennreal (spmf lub_spmf x) = (SUP p\Y. ennreal (spmf p x))" -unfolding spmf_lub_spmf by(subst ennreal_SUP)(simp_all add: SUP_spmf_neq_top' del: SUP_eq_top_iff Sup_eq_top_iff) + by (metis SUP_spmf_neq_top' ennreal_SUP spmf_lub_spmf) lemma lub_spmf_upper: assumes p: "p \ Y" @@ -1397,7 +1379,7 @@ from p have [simp]: "Y \ {}" by auto from p have "ennreal (spmf p x) \ (SUP p\Y. ennreal (spmf p x))" by(rule SUP_upper) also have "\ = ennreal (spmf lub_spmf x)" using p - by(subst spmf_lub_spmf)(auto simp add: ennreal_SUP SUP_spmf_neq_top' simp del: SUP_eq_top_iff Sup_eq_top_iff) + by(subst spmf_lub_spmf)(auto simp: ennreal_SUP SUP_spmf_neq_top' simp del: SUP_eq_top_iff Sup_eq_top_iff) finally show "spmf p x \ spmf lub_spmf x" by simp qed simp @@ -1411,7 +1393,7 @@ fix x from nonempty obtain p where p: "p \ Y" by auto have "ennreal (spmf lub_spmf x) = (SUP p\Y. ennreal (spmf p x))" - by(subst spmf_lub_spmf)(auto simp add: ennreal_SUP SUP_spmf_neq_top' nonempty simp del: SUP_eq_top_iff Sup_eq_top_iff) + by(subst spmf_lub_spmf)(auto simp: ennreal_SUP SUP_spmf_neq_top' nonempty simp del: SUP_eq_top_iff Sup_eq_top_iff) also have "\ \ ennreal (spmf z x)" by(rule SUP_least)(simp add: ord_spmf_eq_leD z) finally show "spmf lub_spmf x \ spmf z x" by simp qed simp @@ -1428,7 +1410,7 @@ also have "\ \ (\p\Y. ennreal (spmf p x) > 0)" by(simp add: ennreal_spmf_lub_spmf less_SUP_iff) also have "\ \ x \ ?rhs" - by(auto simp add: in_set_spmf_iff_spmf less_le) + by(auto simp: in_set_spmf_iff_spmf less_le) finally show "x \ ?lhs \ x \ ?rhs" . qed qed simp @@ -1440,7 +1422,7 @@ proof - let ?M = "count_space (set_spmf lub_spmf)" have "?lhs = \\<^sup>+ x. ennreal (spmf lub_spmf x) * indicator A x \?M" - by(auto simp add: nn_integral_indicator[symmetric] nn_integral_measure_spmf') + by(auto simp: nn_integral_indicator[symmetric] nn_integral_measure_spmf') also have "\ = \\<^sup>+ x. (SUP y\Y. ennreal (spmf y x) * indicator A x) \?M" unfolding ennreal_indicator[symmetric] by(simp add: spmf_lub_spmf assms ennreal_SUP[OF SUP_spmf_neq_top'] SUP_mult_right_ennreal) @@ -1449,13 +1431,13 @@ have "(\i x. ennreal (spmf i x) * indicator A x) ` Y = (\f x. f x * indicator A x) ` (\p x. ennreal (spmf p x)) ` Y" by(simp add: image_image) also have "Complete_Partial_Order.chain (\) \" using chain_ord_spmf_eqD - by(rule chain_imageI)(auto simp add: le_fun_def split: split_indicator) + by(rule chain_imageI)(auto simp: le_fun_def split: split_indicator) finally show "Complete_Partial_Order.chain (\) ((\i x. ennreal (spmf i x) * indicator A x) ` Y)" . qed simp also have "\ = (SUP y\Y. \\<^sup>+ x. ennreal (spmf y x) * indicator A x \count_space UNIV)" - by(auto simp add: nn_integral_count_space_indicator set_lub_spmf spmf_eq_0_set_spmf split: split_indicator intro!: arg_cong [of _ _ Sup] image_cong nn_integral_cong) + by(auto simp: nn_integral_count_space_indicator set_lub_spmf spmf_eq_0_set_spmf split: split_indicator intro!: arg_cong [of _ _ Sup] image_cong nn_integral_cong) also have "\ = ?rhs" - by(auto simp add: nn_integral_indicator[symmetric] nn_integral_measure_spmf) + by(auto simp: nn_integral_indicator[symmetric] nn_integral_measure_spmf) finally show ?thesis . qed @@ -1474,7 +1456,7 @@ lemma weight_lub_spmf: assumes Y: "Y \ {}" shows "weight_spmf lub_spmf = (SUP y\Y. weight_spmf y)" -unfolding weight_spmf_def by(rule measure_lub_spmf) fact + by (smt (verit, best) SUP_cong assms measure_lub_spmf space_measure_spmf) lemma measure_spmf_lub_spmf: assumes Y: "Y \ {}" @@ -1519,11 +1501,11 @@ qed lemma ccpo_spmf: "class.ccpo lub_spmf (ord_spmf (=)) (mk_less (ord_spmf (=)))" -by(rule ccpo partial_function_definitions_spmf)+ + by(metis ccpo partial_function_definitions_spmf) interpretation spmf: partial_function_definitions "ord_spmf (=)" "lub_spmf" rewrites "lub_spmf {} \ return_pmf None" -by(rule partial_function_definitions_spmf) simp + by(rule partial_function_definitions_spmf) simp declaration \Partial_Function.init "spmf" \<^term>\spmf.fixp_fun\ \<^term>\spmf.mono_body\ @{thm spmf.fixp_rule_uc} @{thm spmf.fixp_induct_uc} @@ -1535,14 +1517,14 @@ abbreviation "mono_spmf \ monotone (fun_ord (ord_spmf (=))) (ord_spmf (=))" lemma lub_spmf_const [simp]: "lub_spmf {p} = p" -by(rule spmf_eqI)(simp add: spmf_lub_spmf[OF ccpo.chain_singleton[OF ccpo_spmf]]) + by(rule spmf_eqI)(simp add: spmf_lub_spmf[OF ccpo.chain_singleton[OF ccpo_spmf]]) lemma bind_spmf_mono': assumes fg: "ord_spmf (=) f g" - and hk: "\x :: 'a. ord_spmf (=) (h x) (k x)" + and hk: "\x :: 'a. ord_spmf (=) (h x) (k x)" shows "ord_spmf (=) (f \ h) (g \ k)" -unfolding bind_spmf_def using assms(1) -by(rule rel_pmf_bindI)(auto split: option.split simp add: hk) + unfolding bind_spmf_def using assms(1) + by(rule rel_pmf_bindI)(auto split: option.split simp add: hk) lemma bind_spmf_mono [partial_function_mono]: assumes mf: "mono_spmf B" and mg: "\y. mono_spmf (\f. C y f)" @@ -1558,12 +1540,12 @@ qed lemma monotone_bind_spmf1: "monotone (ord_spmf (=)) (ord_spmf (=)) (\y. bind_spmf y g)" -by(rule monotoneI)(simp add: bind_spmf_mono' ord_spmf_reflI) + by(rule monotoneI)(simp add: bind_spmf_mono' ord_spmf_reflI) lemma monotone_bind_spmf2: assumes g: "\x. monotone ord (ord_spmf (=)) (\y. g y x)" shows "monotone ord (ord_spmf (=)) (\y. bind_spmf p (g y))" -by(rule monotoneI)(auto intro: bind_spmf_mono' monotoneD[OF g] ord_spmf_reflI) + by(rule monotoneI)(auto intro: bind_spmf_mono' monotoneD[OF g] ord_spmf_reflI) lemma bind_lub_spmf: assumes chain: "Complete_Partial_Order.chain (ord_spmf (=)) Y" @@ -1574,18 +1556,18 @@ proof(rule spmf_eqI) fix i have chain': "Complete_Partial_Order.chain (\) ((\p x. ennreal (spmf p x * spmf (f x) i)) ` Y)" - using chain by(rule chain_imageI)(auto simp add: le_fun_def dest: ord_spmf_eq_leD intro: mult_right_mono) + using chain by(rule chain_imageI)(auto simp: le_fun_def dest: ord_spmf_eq_leD intro: mult_right_mono) have chain'': "Complete_Partial_Order.chain (ord_spmf (=)) ((\p. p \ f) ` Y)" using chain by(rule chain_imageI)(auto intro!: monotoneI bind_spmf_mono' ord_spmf_reflI) let ?M = "count_space (set_spmf (lub_spmf Y))" have "ennreal (spmf ?lhs i) = \\<^sup>+ x. ennreal (spmf (lub_spmf Y) x) * ennreal (spmf (f x) i) \?M" - by(auto simp add: ennreal_spmf_lub_spmf ennreal_spmf_bind nn_integral_measure_spmf') + by(auto simp: ennreal_spmf_lub_spmf ennreal_spmf_bind nn_integral_measure_spmf') also have "\ = \\<^sup>+ x. (SUP p\Y. ennreal (spmf p x * spmf (f x) i)) \?M" by(subst ennreal_spmf_lub_spmf[OF chain Y])(subst SUP_mult_right_ennreal, simp_all add: ennreal_mult Y) also have "\ = (SUP p\Y. \\<^sup>+ x. ennreal (spmf p x * spmf (f x) i) \?M)" using Y chain' by(rule nn_integral_monotone_convergence_SUP_countable) simp also have "\ = (SUP p\Y. ennreal (spmf (bind_spmf p f) i))" - by(auto simp add: ennreal_spmf_bind nn_integral_measure_spmf nn_integral_count_space_indicator set_lub_spmf[OF chain] in_set_spmf_iff_spmf ennreal_mult intro!: arg_cong [of _ _ Sup] image_cong nn_integral_cong split: split_indicator) + by(auto simp: ennreal_spmf_bind nn_integral_measure_spmf nn_integral_count_space_indicator set_lub_spmf[OF chain] in_set_spmf_iff_spmf ennreal_mult intro!: arg_cong [of _ _ Sup] image_cong nn_integral_cong split: split_indicator) also have "\ = ennreal (spmf ?rhs i)" using chain'' by(simp add: ennreal_spmf_lub_spmf Y image_comp) finally show "spmf ?lhs i = spmf ?rhs i" by simp qed @@ -1594,16 +1576,17 @@ lemma map_lub_spmf: "Complete_Partial_Order.chain (ord_spmf (=)) Y \ map_spmf f (lub_spmf Y) = lub_spmf (map_spmf f ` Y)" -unfolding map_spmf_conv_bind_spmf[abs_def] by(simp add: bind_lub_spmf o_def) + unfolding map_spmf_conv_bind_spmf[abs_def] by(simp add: bind_lub_spmf o_def) lemma mcont_bind_spmf1: "mcont lub_spmf (ord_spmf (=)) lub_spmf (ord_spmf (=)) (\y. bind_spmf y f)" -using monotone_bind_spmf1 by(rule mcontI)(rule contI, simp add: bind_lub_spmf) + using monotone_bind_spmf1 + by(intro contI mcontI) (auto simp: bind_lub_spmf) lemma bind_lub_spmf2: assumes chain: "Complete_Partial_Order.chain ord Y" - and g: "\y. monotone ord (ord_spmf (=)) (g y)" + and g: "\y. monotone ord (ord_spmf (=)) (g y)" shows "bind_spmf x (\y. lub_spmf (g y ` Y)) = lub_spmf ((\p. bind_spmf x (\y. g y p)) ` Y)" - (is "?lhs = ?rhs") + (is "?lhs = ?rhs") proof(cases "Y = {}") case Y: False show ?thesis @@ -1612,7 +1595,7 @@ have chain': "\y. Complete_Partial_Order.chain (ord_spmf (=)) (g y ` Y)" using chain g[THEN monotoneD] by(rule chain_imageI) have chain'': "Complete_Partial_Order.chain (\) ((\p y. ennreal (spmf x y * spmf (g y p) i)) ` Y)" - using chain by(rule chain_imageI)(auto simp add: le_fun_def dest: ord_spmf_eq_leD monotoneD[OF g] intro!: mult_left_mono) + using chain by(rule chain_imageI)(auto simp: le_fun_def dest: ord_spmf_eq_leD monotoneD[OF g] intro!: mult_left_mono) have chain''': "Complete_Partial_Order.chain (ord_spmf (=)) ((\p. bind_spmf x (\y. g y p)) ` Y)" using chain by(rule chain_imageI)(rule monotone_bind_spmf2[OF g, THEN monotoneD]) @@ -1624,7 +1607,7 @@ also have "\ = (SUP p\Y. ennreal (spmf (bind_spmf x (\y. g y p)) i))" by(simp add: ennreal_spmf_bind nn_integral_measure_spmf' ennreal_mult) also have "\ = ennreal (spmf ?rhs i)" using chain''' - by(auto simp add: ennreal_spmf_lub_spmf Y image_comp) + by(auto simp: ennreal_spmf_lub_spmf Y image_comp) finally show "spmf ?lhs i = spmf ?rhs i" by simp qed qed simp @@ -1656,44 +1639,44 @@ lemma bind_pmf_mono [partial_function_mono]: "(\y. mono_spmf (\f. C y f)) \ mono_spmf (\f. bind_pmf p (\x. C x f))" -using bind_spmf_mono[of "\_. spmf_of_pmf p" C] by simp + using bind_spmf_mono[of "\_. spmf_of_pmf p" C] by simp lemma map_spmf_mono [partial_function_mono]: "mono_spmf B \ mono_spmf (\g. map_spmf f (B g))" -unfolding map_spmf_conv_bind_spmf by(rule bind_spmf_mono) simp_all + unfolding map_spmf_conv_bind_spmf by(rule bind_spmf_mono) simp_all lemma mcont_map_spmf [cont_intro]: "mcont luba orda lub_spmf (ord_spmf (=)) g \ mcont luba orda lub_spmf (ord_spmf (=)) (\x. map_spmf f (g x))" -unfolding map_spmf_conv_bind_spmf by(rule mcont_bind_spmf) simp_all + unfolding map_spmf_conv_bind_spmf by(rule mcont_bind_spmf) simp_all lemma monotone_set_spmf: "monotone (ord_spmf (=)) (\) set_spmf" -by(rule monotoneI)(rule ord_spmf_eqD_set_spmf) + by(rule monotoneI)(rule ord_spmf_eqD_set_spmf) lemma cont_set_spmf: "cont lub_spmf (ord_spmf (=)) Union (\) set_spmf" -by(rule contI)(subst set_lub_spmf; simp) + by(rule contI)(subst set_lub_spmf; simp) lemma mcont2mcont_set_spmf[THEN mcont2mcont, cont_intro]: shows mcont_set_spmf: "mcont lub_spmf (ord_spmf (=)) Union (\) set_spmf" -by(rule mcontI monotone_set_spmf cont_set_spmf)+ + by(rule mcontI monotone_set_spmf cont_set_spmf)+ lemma monotone_spmf: "monotone (ord_spmf (=)) (\) (\p. spmf p x)" -by(rule monotoneI)(simp add: ord_spmf_eq_leD) + by(rule monotoneI)(simp add: ord_spmf_eq_leD) lemma cont_spmf: "cont lub_spmf (ord_spmf (=)) Sup (\) (\p. spmf p x)" -by(rule contI)(simp add: spmf_lub_spmf) + by(rule contI)(simp add: spmf_lub_spmf) lemma mcont_spmf: "mcont lub_spmf (ord_spmf (=)) Sup (\) (\p. spmf p x)" -by(rule mcontI monotone_spmf cont_spmf)+ + by(metis mcontI monotone_spmf cont_spmf) lemma cont_ennreal_spmf: "cont lub_spmf (ord_spmf (=)) Sup (\) (\p. ennreal (spmf p x))" -by(rule contI)(simp add: ennreal_spmf_lub_spmf) + by(rule contI)(simp add: ennreal_spmf_lub_spmf) lemma mcont2mcont_ennreal_spmf [THEN mcont2mcont, cont_intro]: shows mcont_ennreal_spmf: "mcont lub_spmf (ord_spmf (=)) Sup (\) (\p. ennreal (spmf p x))" -by(rule mcontI mono2mono_ennreal monotone_spmf cont_ennreal_spmf)+ + by(metis mcontI mono2mono_ennreal monotone_spmf cont_ennreal_spmf) lemma nn_integral_map_spmf [simp]: "nn_integral (measure_spmf (map_spmf f p)) g = nn_integral (measure_spmf p) (g \ f)" -by(auto 4 3 simp add: measure_spmf_def nn_integral_distr nn_integral_restrict_space intro: nn_integral_cong split: split_indicator) + by(force simp: measure_spmf_def nn_integral_distr nn_integral_restrict_space intro: nn_integral_cong split: split_indicator) subsubsection \Admissibility of \<^term>\rel_spmf\\ @@ -1705,7 +1688,7 @@ also have "\ \ measure (measure_pmf q) {y. \x\Some ` A. rel_option R x y}" using assms by(rule rel_pmf_measureD) also have "\ = ?rhs" unfolding measure_measure_spmf_conv_measure_pmf - by(rule arg_cong2[where f=measure])(auto simp add: option_rel_Some1) + by(rule arg_cong2[where f=measure])(auto simp: option_rel_Some1) finally show ?thesis . qed @@ -1728,7 +1711,7 @@ define A' where "A' = the ` (A \ range Some)" define A'' where "A'' = A \ {None}" have A: "A = Some ` A' \ A''" "Some ` A' \ A'' = {}" - unfolding A'_def A''_def by(auto 4 3 intro: rev_image_eqI) + unfolding A'_def A''_def by(auto simp: image_iff) have "measure (measure_pmf p) A = measure (measure_pmf p) (Some ` A') + measure (measure_pmf p) A''" by(simp add: A measure_pmf.finite_measure_Union) also have "measure (measure_pmf p) (Some ` A') = measure (measure_spmf p) A'" @@ -1737,7 +1720,7 @@ also (ord_eq_le_trans[OF _ add_right_mono]) have "\ = measure (measure_pmf q) {y. \x\A'. rel_option R (Some x) y}" unfolding measure_measure_spmf_conv_measure_pmf - by(rule arg_cong2[where f=measure])(auto simp add: A'_def option_rel_Some1) + by(rule arg_cong2[where f=measure])(auto simp: A'_def option_rel_Some1) also { have "weight_spmf p \ measure (measure_spmf q) {y. \x. R x y}" using eq1[of UNIV] unfolding weight_spmf_def by simp @@ -1769,7 +1752,7 @@ have "rel_spmf R (lub_spmf (fst ` Y)) (lub_spmf (snd ` Y))" proof(rule rel_spmf_measureI) show "weight_spmf (lub_spmf (snd ` Y)) \ weight_spmf (lub_spmf (fst ` Y))" - by(auto simp add: weight_lub_spmf chain1 chain2 Y rel_spmf_weightD[OF R, symmetric] intro!: cSUP_least intro: cSUP_upper2[OF bdd_aboveI2[OF weight_spmf_le_1]]) + by(auto simp: weight_lub_spmf chain1 chain2 Y rel_spmf_weightD[OF R, symmetric] intro!: cSUP_least intro: cSUP_upper2[OF bdd_aboveI2[OF weight_spmf_le_1]]) fix A have "measure (measure_spmf (lub_spmf (fst ` Y))) A = (SUP y\fst ` Y. measure (measure_spmf y) A)" @@ -1786,17 +1769,17 @@ lemma admissible_rel_spmf_mcont [cont_intro]: "\ mcont lub ord lub_spmf (ord_spmf (=)) f; mcont lub ord lub_spmf (ord_spmf (=)) g \ \ ccpo.admissible lub ord (\x. rel_spmf R (f x) (g x))" -by(rule admissible_subst[OF admissible_rel_spmf, where f="\x. (f x, g x)", simplified])(rule mcont_Pair) + by(rule admissible_subst[OF admissible_rel_spmf, where f="\x. (f x, g x)", simplified])(rule mcont_Pair) context includes lifting_syntax begin lemma fixp_spmf_parametric': assumes f: "\x. monotone (ord_spmf (=)) (ord_spmf (=)) F" - and g: "\x. monotone (ord_spmf (=)) (ord_spmf (=)) G" - and param: "(rel_spmf R ===> rel_spmf R) F G" + and g: "\x. monotone (ord_spmf (=)) (ord_spmf (=)) G" + and param: "(rel_spmf R ===> rel_spmf R) F G" shows "(rel_spmf R) (ccpo.fixp lub_spmf (ord_spmf (=)) F) (ccpo.fixp lub_spmf (ord_spmf (=)) G)" -by(rule parallel_fixp_induct[OF ccpo_spmf ccpo_spmf _ f g])(auto intro: param[THEN rel_funD]) + by(rule parallel_fixp_induct[OF ccpo_spmf ccpo_spmf _ f g])(auto intro: param[THEN rel_funD]) lemma fixp_spmf_parametric: assumes f: "\x. mono_spmf (\f. F f x)" @@ -1807,13 +1790,9 @@ proof(rule parallel_fixp_induct_1_1[OF partial_function_definitions_spmf partial_function_definitions_spmf _ _ reflexive reflexive, where P="(A ===> rel_spmf R)"]) show "ccpo.admissible (prod_lub (fun_lub lub_spmf) (fun_lub lub_spmf)) (rel_prod (fun_ord (ord_spmf (=))) (fun_ord (ord_spmf (=)))) (\x. (A ===> rel_spmf R) (fst x) (snd x))" unfolding rel_fun_def - apply(rule admissible_all admissible_imp admissible_rel_spmf_mcont)+ - apply(rule spmf.mcont2mcont[OF mcont_call]) - apply(rule mcont_fst) - apply(rule spmf.mcont2mcont[OF mcont_call]) - apply(rule mcont_snd) - done - show "(A ===> rel_spmf R) (\_. lub_spmf {}) (\_. lub_spmf {})" by auto + by(fastforce intro: admissible_all admissible_imp admissible_rel_spmf_mcont) + show "(A ===> rel_spmf R) (\_. lub_spmf {}) (\_. lub_spmf {})" + by auto show "(A ===> rel_spmf R) (F f) (G g)" if "(A ===> rel_spmf R) f g" for f g using that by(rule rel_funD[OF param]) qed @@ -1827,40 +1806,46 @@ subsection \Restrictions on spmfs\ definition restrict_spmf :: "'a spmf \ 'a set \ 'a spmf" (infixl "\" 110) -where "p \ A = map_pmf (\x. x \ (\y. if y \ A then Some y else None)) p" + where "p \ A = map_pmf (\x. x \ (\y. if y \ A then Some y else None)) p" lemma set_restrict_spmf [simp]: "set_spmf (p \ A) = set_spmf p \ A" -by(fastforce simp add: restrict_spmf_def set_spmf_def split: bind_splits if_split_asm) + by(fastforce simp: restrict_spmf_def set_spmf_def split: bind_splits if_split_asm) lemma restrict_map_spmf: "map_spmf f p \ A = map_spmf f (p \ (f -` A))" -by(simp add: restrict_spmf_def pmf.map_comp o_def map_option_bind bind_map_option if_distrib cong del: if_weak_cong) + by(simp add: restrict_spmf_def pmf.map_comp o_def map_option_bind bind_map_option if_distrib cong del: if_weak_cong) lemma restrict_restrict_spmf [simp]: "p \ A \ B = p \ (A \ B)" -by(auto simp add: restrict_spmf_def pmf.map_comp o_def intro!: pmf.map_cong bind_option_cong) + by(auto simp: restrict_spmf_def pmf.map_comp o_def intro!: pmf.map_cong bind_option_cong) lemma restrict_spmf_empty [simp]: "p \ {} = return_pmf None" -by(simp add: restrict_spmf_def) + by(simp add: restrict_spmf_def) lemma restrict_spmf_UNIV [simp]: "p \ UNIV = p" -by(simp add: restrict_spmf_def) + by(simp add: restrict_spmf_def) lemma spmf_restrict_spmf_outside [simp]: "x \ A \ spmf (p \ A) x = 0" -by(simp add: spmf_eq_0_set_spmf) - -lemma emeasure_restrict_spmf [simp]: - "emeasure (measure_spmf (p \ A)) X = emeasure (measure_spmf p) (X \ A)" -by(auto simp add: restrict_spmf_def measure_spmf_def emeasure_distr measurable_restrict_space1 emeasure_restrict_space space_restrict_space intro: arg_cong2[where f=emeasure] split: bind_splits if_split_asm) + by(simp add: spmf_eq_0_set_spmf) + +lemma emeasure_restrict_spmf [simp]: "emeasure (measure_spmf (p \ A)) X = emeasure (measure_spmf p) (X \ A)" +proof - + have "(\x. x \ (\y. if y \ A then Some y else None)) -` the -` X \ + (\x. x \ (\y. if y \ A then Some y else None)) -` range Some = + the -` X \ the -` A \ range Some" + by(auto split: bind_splits if_split_asm) + then show ?thesis + by (simp add: restrict_spmf_def measure_spmf_def emeasure_distr emeasure_restrict_space) +qed lemma measure_restrict_spmf [simp]: "measure (measure_spmf (p \ A)) X = measure (measure_spmf p) (X \ A)" -using emeasure_restrict_spmf[of p A X] -by(simp only: measure_spmf.emeasure_eq_measure ennreal_inj measure_nonneg) + using emeasure_restrict_spmf[of p A X] + by(simp only: measure_spmf.emeasure_eq_measure ennreal_inj measure_nonneg) lemma spmf_restrict_spmf: "spmf (p \ A) x = (if x \ A then spmf p x else 0)" -by(simp add: spmf_conv_measure_spmf) + by(simp add: spmf_conv_measure_spmf) lemma spmf_restrict_spmf_inside [simp]: "x \ A \ spmf (p \ A) x = spmf p x" -by(simp add: spmf_restrict_spmf) + by(simp add: spmf_restrict_spmf) lemma pmf_restrict_spmf_None: "pmf (p \ A) None = pmf p None + measure (measure_spmf p) (- A)" proof - @@ -1873,37 +1858,37 @@ qed lemma restrict_spmf_trivial: "(\x. x \ set_spmf p \ x \ A) \ p \ A = p" -by(rule spmf_eqI)(auto simp add: spmf_restrict_spmf spmf_eq_0_set_spmf) + by(rule spmf_eqI)(auto simp: spmf_restrict_spmf spmf_eq_0_set_spmf) lemma restrict_spmf_trivial': "set_spmf p \ A \ p \ A = p" -by(rule restrict_spmf_trivial) blast + by(rule restrict_spmf_trivial) blast lemma restrict_return_spmf: "return_spmf x \ A = (if x \ A then return_spmf x else return_pmf None)" -by(simp add: restrict_spmf_def) + by(simp add: restrict_spmf_def) lemma restrict_return_spmf_inside [simp]: "x \ A \ return_spmf x \ A = return_spmf x" -by(simp add: restrict_return_spmf) + by(simp add: restrict_return_spmf) lemma restrict_return_spmf_outside [simp]: "x \ A \ return_spmf x \ A = return_pmf None" -by(simp add: restrict_return_spmf) + by(simp add: restrict_return_spmf) lemma restrict_spmf_return_pmf_None [simp]: "return_pmf None \ A = return_pmf None" -by(simp add: restrict_spmf_def) + by(simp add: restrict_spmf_def) lemma restrict_bind_pmf: "bind_pmf p g \ A = p \ (\x. g x \ A)" -by(simp add: restrict_spmf_def map_bind_pmf o_def) + by(simp add: restrict_spmf_def map_bind_pmf o_def) lemma restrict_bind_spmf: "bind_spmf p g \ A = p \ (\x. g x \ A)" -by(auto simp add: bind_spmf_def restrict_bind_pmf cong del: option.case_cong_weak cong: option.case_cong intro!: bind_pmf_cong split: option.split) + by(auto simp: bind_spmf_def restrict_bind_pmf cong del: option.case_cong_weak cong: option.case_cong intro!: bind_pmf_cong split: option.split) lemma bind_restrict_pmf: "bind_pmf (p \ A) g = p \ (\x. if x \ Some ` A then g x else g None)" -by(auto simp add: restrict_spmf_def bind_map_pmf fun_eq_iff split: bind_split intro: arg_cong2[where f=bind_pmf]) + by(auto simp: restrict_spmf_def bind_map_pmf fun_eq_iff split: bind_split intro: arg_cong2[where f=bind_pmf]) lemma bind_restrict_spmf: "bind_spmf (p \ A) g = p \ (\x. if x \ A then g x else return_pmf None)" -by(auto simp add: bind_spmf_def bind_restrict_pmf fun_eq_iff intro: arg_cong2[where f=bind_pmf] split: option.split) + by(auto simp: bind_spmf_def bind_restrict_pmf fun_eq_iff intro: arg_cong2[where f=bind_pmf] split: option.split) lemma spmf_map_restrict: "spmf (map_spmf fst (p \ (snd -` {y}))) x = spmf p (x, y)" -by(subst spmf_map)(auto intro: arg_cong2[where f=measure] simp add: spmf_conv_measure_spmf) + by(subst spmf_map)(auto intro: arg_cong2[where f=measure] simp add: spmf_conv_measure_spmf) lemma measure_eqI_restrict_spmf: assumes "rel_spmf R (restrict_spmf p A) (restrict_spmf q B)" @@ -1920,55 +1905,55 @@ "spmf_of_set A = (if finite A \ A \ {} then spmf_of_pmf (pmf_of_set A) else return_pmf None)" lemma spmf_of_set: "spmf (spmf_of_set A) x = indicator A x / card A" -by(auto simp add: spmf_of_set_def) + by(auto simp: spmf_of_set_def) lemma pmf_spmf_of_set_None [simp]: "pmf (spmf_of_set A) None = indicator {A. infinite A \ A = {}} A" -by(simp add: spmf_of_set_def) + by(simp add: spmf_of_set_def) lemma set_spmf_of_set: "set_spmf (spmf_of_set A) = (if finite A then A else {})" -by(simp add: spmf_of_set_def) + by(simp add: spmf_of_set_def) lemma set_spmf_of_set_finite [simp]: "finite A \ set_spmf (spmf_of_set A) = A" -by(simp add: set_spmf_of_set) + by(simp add: set_spmf_of_set) lemma spmf_of_set_singleton: "spmf_of_set {x} = return_spmf x" -by(simp add: spmf_of_set_def pmf_of_set_singleton) + by(simp add: spmf_of_set_def pmf_of_set_singleton) lemma map_spmf_of_set_inj_on [simp]: "inj_on f A \ map_spmf f (spmf_of_set A) = spmf_of_set (f ` A)" -by(auto simp add: spmf_of_set_def map_pmf_of_set_inj dest: finite_imageD) + by(auto simp: spmf_of_set_def map_pmf_of_set_inj dest: finite_imageD) lemma spmf_of_pmf_pmf_of_set [simp]: "\ finite A; A \ {} \ \ spmf_of_pmf (pmf_of_set A) = spmf_of_set A" -by(simp add: spmf_of_set_def) + by(simp add: spmf_of_set_def) lemma weight_spmf_of_set: "weight_spmf (spmf_of_set A) = (if finite A \ A \ {} then 1 else 0)" -by(auto simp only: spmf_of_set_def weight_spmf_of_pmf weight_return_pmf_None split: if_split) + by(auto simp only: spmf_of_set_def weight_spmf_of_pmf weight_return_pmf_None split: if_split) lemma weight_spmf_of_set_finite [simp]: "\ finite A; A \ {} \ \ weight_spmf (spmf_of_set A) = 1" -by(simp add: weight_spmf_of_set) + by(simp add: weight_spmf_of_set) lemma weight_spmf_of_set_infinite [simp]: "infinite A \ weight_spmf (spmf_of_set A) = 0" -by(simp add: weight_spmf_of_set) + by(simp add: weight_spmf_of_set) lemma measure_spmf_spmf_of_set: "measure_spmf (spmf_of_set A) = (if finite A \ A \ {} then measure_pmf (pmf_of_set A) else null_measure (count_space UNIV))" -by(simp add: spmf_of_set_def del: spmf_of_pmf_pmf_of_set) + by(simp add: spmf_of_set_def del: spmf_of_pmf_pmf_of_set) lemma emeasure_spmf_of_set: "emeasure (measure_spmf (spmf_of_set S)) A = card (S \ A) / card S" -by(auto simp add: measure_spmf_spmf_of_set emeasure_pmf_of_set) + by(auto simp: measure_spmf_spmf_of_set emeasure_pmf_of_set) lemma measure_spmf_of_set: "measure (measure_spmf (spmf_of_set S)) A = card (S \ A) / card S" -by(auto simp add: measure_spmf_spmf_of_set measure_pmf_of_set) + by(auto simp: measure_spmf_spmf_of_set measure_pmf_of_set) lemma nn_integral_spmf_of_set: "nn_integral (measure_spmf (spmf_of_set A)) f = sum f A / card A" -by(cases "finite A")(auto simp add: spmf_of_set_def nn_integral_pmf_of_set card_gt_0_iff simp del: spmf_of_pmf_pmf_of_set) + by(cases "finite A")(auto simp: spmf_of_set_def nn_integral_pmf_of_set card_gt_0_iff simp del: spmf_of_pmf_pmf_of_set) lemma integral_spmf_of_set: "integral\<^sup>L (measure_spmf (spmf_of_set A)) f = sum f A / card A" -by(clarsimp simp add: spmf_of_set_def integral_pmf_of_set card_gt_0_iff simp del: spmf_of_pmf_pmf_of_set) + by (metis card.infinite div_0 division_ring_divide_zero integral_null_measure integral_pmf_of_set measure_spmf_spmf_of_set of_nat_0 sum.empty) notepad begin \ \\<^const>\pmf_of_set\ is not fully parametric.\ define R :: "nat \ nat \ bool" where "R x y \ (x \ 0 \ y = 0)" for x y @@ -1991,7 +1976,7 @@ also have "\ = emeasure (measure_pmf pq) (snd -` {2, 1})" unfolding 2[symmetric] measure_pmf.emeasure_eq_measure[symmetric] by(simp) also have "\ = emeasure (measure_pmf pq) {(0, 2), (0, 1)}" - by(rule emeasure_eq_AE)(auto simp add: AE_measure_pmf_iff R_def dest!: pq) + by(rule emeasure_eq_AE)(auto simp: AE_measure_pmf_iff R_def dest!: pq) also have "\ \ emeasure (measure_pmf pq) (fst -` {0})" by(rule emeasure_mono) auto also have "\ = emeasure (measure_pmf (pmf_of_set A)) {0}" @@ -2013,7 +1998,7 @@ define AB where "AB = (\x. (x, f x)) ` A" define R' where "R' x y \ (x, y) \ AB" for x y have "(x, y) \ AB" if "(x, y) \ set_pmf (pmf_of_set AB)" for x y - using that by(auto simp add: AB_def A) + using that by(auto simp: AB_def A) moreover have "map_pmf fst (pmf_of_set AB) = pmf_of_set A" by(simp add: AB_def map_pmf_of_set_inj[symmetric] inj_on_def A pmf.map_comp o_def) moreover @@ -2030,10 +2015,11 @@ and R: "\x. x \ A \ R x (f x)" shows "rel_spmf R (spmf_of_set A) (spmf_of_set B)" proof - - have "finite A \ finite B" using f by(rule bij_betw_finite) - moreover have "A = {} \ B = {}" using f by(auto dest: bij_betw_empty2 bij_betw_empty1) - ultimately show ?thesis using assms - by(auto simp add: spmf_of_set_def simp del: spmf_of_pmf_pmf_of_set intro: rel_pmf_of_set_bij) + obtain "finite A \ finite B" "A = {} \ B = {}" + using bij_betw_empty1 bij_betw_empty2 bij_betw_finite f by blast + then show ?thesis + using assms + by (metis rel_pmf_of_set_bij rel_spmf_spmf_of_pmf return_spmf_None_parametric spmf_of_set_def) qed context includes lifting_syntax @@ -2047,7 +2033,8 @@ assume R: "rel_set R A B" with assms obtain f where "bij_betw f A B" and f: "\x. x \ A \ R x (f x)" by(auto dest: bi_unique_rel_set_bij_betw) - then show "rel_spmf R (spmf_of_set A) (spmf_of_set B)" by(rule rel_spmf_of_set_bij) + then show "rel_spmf R (spmf_of_set A) (spmf_of_set B)" + by(rule rel_spmf_of_set_bij) qed end @@ -2063,7 +2050,7 @@ also have "\ = (if i then card (B \ A) / card B else card (B - A) / card B)" by(auto intro: arg_cong[where f=card]) also have "\ = (if i then card (B \ A) / card B else (card B - card (B \ A)) / card B)" - by(auto simp add: card_Diff_subset_Int assms) + by(auto simp: card_Diff_subset_Int assms) also have "\ = ennreal (spmf ?rhs i)" by(simp add: assms card_gt_0_iff field_simps card_mono Int_commute of_nat_diff) finally show "spmf ?lhs i = spmf ?rhs i" by simp @@ -2079,48 +2066,48 @@ qed lemma bind_coin_spmf_eq_const: "coin_spmf \ (\x :: bool. return_spmf (b = x)) = coin_spmf" -using map_eq_const_coin_spmf unfolding map_spmf_conv_bind_spmf by simp + using map_eq_const_coin_spmf unfolding map_spmf_conv_bind_spmf by simp lemma bind_coin_spmf_eq_const': "coin_spmf \ (\x :: bool. return_spmf (x = b)) = coin_spmf" -by(rewrite in "_ = \" bind_coin_spmf_eq_const[symmetric, of b])(auto intro: bind_spmf_cong) + by(rewrite in "_ = \" bind_coin_spmf_eq_const[symmetric, of b])(auto intro: bind_spmf_cong) subsection \Losslessness\ definition lossless_spmf :: "'a spmf \ bool" -where "lossless_spmf p \ weight_spmf p = 1" + where "lossless_spmf p \ weight_spmf p = 1" lemma lossless_iff_pmf_None: "lossless_spmf p \ pmf p None = 0" -by(simp add: lossless_spmf_def pmf_None_eq_weight_spmf) + by(simp add: lossless_spmf_def pmf_None_eq_weight_spmf) lemma lossless_return_spmf [iff]: "lossless_spmf (return_spmf x)" -by(simp add: lossless_iff_pmf_None) + by(simp add: lossless_iff_pmf_None) lemma lossless_return_pmf_None [iff]: "\ lossless_spmf (return_pmf None)" -by(simp add: lossless_iff_pmf_None) + by(simp add: lossless_iff_pmf_None) lemma lossless_map_spmf [simp]: "lossless_spmf (map_spmf f p) \ lossless_spmf p" -by(auto simp add: lossless_iff_pmf_None pmf_eq_0_set_pmf) + by(auto simp: lossless_iff_pmf_None pmf_eq_0_set_pmf) lemma lossless_bind_spmf [simp]: "lossless_spmf (p \ f) \ lossless_spmf p \ (\x\set_spmf p. lossless_spmf (f x))" -by(simp add: lossless_iff_pmf_None pmf_bind_spmf_None add_nonneg_eq_0_iff integral_nonneg_AE integral_nonneg_eq_0_iff_AE measure_spmf.integrable_const_bound[where B=1] pmf_le_1) + by(simp add: lossless_iff_pmf_None pmf_bind_spmf_None add_nonneg_eq_0_iff integral_nonneg_AE integral_nonneg_eq_0_iff_AE measure_spmf.integrable_const_bound[where B=1] pmf_le_1) lemma lossless_weight_spmfD: "lossless_spmf p \ weight_spmf p = 1" -by(simp add: lossless_spmf_def) + by(simp add: lossless_spmf_def) lemma lossless_iff_set_pmf_None: "lossless_spmf p \ None \ set_pmf p" -by (simp add: lossless_iff_pmf_None pmf_eq_0_set_pmf) + by (simp add: lossless_iff_pmf_None pmf_eq_0_set_pmf) lemma lossless_spmf_of_set [simp]: "lossless_spmf (spmf_of_set A) \ finite A \ A \ {}" -by(auto simp add: lossless_spmf_def weight_spmf_of_set) + by(auto simp: lossless_spmf_def weight_spmf_of_set) lemma lossless_spmf_spmf_of_spmf [simp]: "lossless_spmf (spmf_of_pmf p)" -by(simp add: lossless_spmf_def) + by(simp add: lossless_spmf_def) lemma lossless_spmf_bind_pmf [simp]: "lossless_spmf (bind_pmf p f) \ (\x\set_pmf p. lossless_spmf (f x))" -by(simp add: lossless_iff_pmf_None pmf_bind integral_nonneg_AE integral_nonneg_eq_0_iff_AE measure_pmf.integrable_const_bound[where B=1] AE_measure_pmf_iff pmf_le_1) + by(simp add: lossless_iff_pmf_None pmf_bind integral_nonneg_AE integral_nonneg_eq_0_iff_AE measure_pmf.integrable_const_bound[where B=1] AE_measure_pmf_iff pmf_le_1) lemma lossless_spmf_conv_spmf_of_pmf: "lossless_spmf p \ (\p'. p = spmf_of_pmf p')" proof @@ -2134,7 +2121,7 @@ fix i have "ennreal (pmf (map_pmf the p) i) = \\<^sup>+ x. indicator (the -` {i}) x \p" by(simp add: ennreal_pmf_map) also have "\ = \\<^sup>+ x. indicator {i} x \measure_spmf p" unfolding measure_spmf_def - by(subst nn_integral_distr)(auto simp add: nn_integral_restrict_space AE_measure_pmf_iff simp del: nn_integral_indicator intro!: nn_integral_cong_AE split: split_indicator dest!: * ) + by(subst nn_integral_distr)(auto simp: nn_integral_restrict_space AE_measure_pmf_iff simp del: nn_integral_indicator intro!: nn_integral_cong_AE split: split_indicator dest!: * ) also have "\ = spmf p i" by(simp add: emeasure_spmf_single) finally show "spmf p i = spmf (spmf_of_pmf ?p) i" by simp qed @@ -2142,22 +2129,24 @@ qed auto lemma spmf_False_conv_True: "lossless_spmf p \ spmf p False = 1 - spmf p True" -by(clarsimp simp add: lossless_spmf_conv_spmf_of_pmf pmf_False_conv_True) + by(clarsimp simp add: lossless_spmf_conv_spmf_of_pmf pmf_False_conv_True) lemma spmf_True_conv_False: "lossless_spmf p \ spmf p True = 1 - spmf p False" -by(simp add: spmf_False_conv_True) + by(simp add: spmf_False_conv_True) lemma bind_eq_return_spmf: "bind_spmf p f = return_spmf x \ (\y\set_spmf p. f y = return_spmf x) \ lossless_spmf p" -by(auto simp add: bind_spmf_def bind_eq_return_pmf in_set_spmf lossless_iff_pmf_None pmf_eq_0_set_pmf iff del: not_None_eq split: option.split) + apply (simp add: bind_spmf_def bind_eq_return_pmf split: option.split) + by (metis in_set_spmf lossless_iff_set_pmf_None not_None_eq) lemma rel_spmf_return_spmf2: "rel_spmf R p (return_spmf x) \ lossless_spmf p \ (\a\set_spmf p. R a x)" -by(auto simp add: lossless_iff_set_pmf_None rel_pmf_return_pmf2 option_rel_Some2 in_set_spmf, metis in_set_spmf not_None_eq) + apply (simp add: lossless_iff_set_pmf_None rel_pmf_return_pmf2 option_rel_Some2 in_set_spmf) + by (metis in_set_spmf not_None_eq option.sel) lemma rel_spmf_return_spmf1: "rel_spmf R (return_spmf x) p \ lossless_spmf p \ (\a\set_spmf p. R x a)" -using rel_spmf_return_spmf2[of "R\\"] by(simp add: spmf_rel_conversep) + using rel_spmf_return_spmf2[of "R\\"] by(simp add: spmf_rel_conversep) lemma rel_spmf_bindI1: assumes f: "\x. x \ set_spmf p \ rel_spmf R (f x) q" @@ -2173,7 +2162,7 @@ lemma rel_spmf_bindI2: "\ \x. x \ set_spmf q \ rel_spmf R p (f x); lossless_spmf q \ \ rel_spmf R p (bind_spmf q f)" -using rel_spmf_bindI1[of q "conversep R" f p] by(simp add: spmf_rel_conversep) + using rel_spmf_bindI1[of q "conversep R" f p] by(simp add: spmf_rel_conversep) subsection \Scaling\ @@ -2192,71 +2181,72 @@ qed lemma spmf_scale_spmf: "spmf (scale_spmf r p) x = max 0 (min (inverse (weight_spmf p)) r) * spmf p x" (is "?lhs = ?rhs") -unfolding scale_spmf_def -apply(subst spmf_embed_spmf[OF scale_spmf_le_1]) -apply(simp add: max_def min_def weight_spmf_le_0 field_simps weight_spmf_nonneg not_le order.strict_iff_order) -apply(metis antisym_conv order_trans weight_spmf_nonneg zero_le_mult_iff zero_le_one) -done + unfolding scale_spmf_def + apply(subst spmf_embed_spmf[OF scale_spmf_le_1]) + apply(simp add: max_def min_def measure_le_0_iff field_simps weight_spmf_nonneg not_le order.strict_iff_order) + apply(metis antisym_conv order_trans weight_spmf_nonneg zero_le_mult_iff zero_le_one) + done lemma real_inverse_le_1_iff: fixes x :: real shows "\ 0 \ x; x \ 1 \ \ 1 / x \ 1 \ x = 1 \ x = 0" -by auto + by auto lemma spmf_scale_spmf': "r \ 1 \ spmf (scale_spmf r p) x = max 0 r * spmf p x" -using real_inverse_le_1_iff[OF weight_spmf_nonneg weight_spmf_le_1, of p] -by(auto simp add: spmf_scale_spmf max_def min_def field_simps)(metis pmf_le_0_iff spmf_le_weight) + using real_inverse_le_1_iff[OF weight_spmf_nonneg weight_spmf_le_1, of p] + by(auto simp: spmf_scale_spmf max_def min_def field_simps)(metis pmf_le_0_iff spmf_le_weight) lemma scale_spmf_neg: "r \ 0 \ scale_spmf r p = return_pmf None" -by(rule spmf_eqI)(simp add: spmf_scale_spmf' max_def) + by(rule spmf_eqI)(simp add: spmf_scale_spmf' max_def) lemma scale_spmf_return_None [simp]: "scale_spmf r (return_pmf None) = return_pmf None" -by(rule spmf_eqI)(simp add: spmf_scale_spmf) + by(rule spmf_eqI)(simp add: spmf_scale_spmf) lemma scale_spmf_conv_bind_bernoulli: assumes "r \ 1" shows "scale_spmf r p = bind_pmf (bernoulli_pmf r) (\b. if b then p else return_pmf None)" (is "?lhs = ?rhs") proof(rule spmf_eqI) fix x - have "ennreal (spmf ?lhs x) = ennreal (spmf ?rhs x)" using assms + have "\weight_spmf p = 0\ \ spmf p x = 0" + by (metis pmf_le_0_iff spmf_le_weight) + moreover have "\weight_spmf p \ 0; 1 / weight_spmf p < 1\ \ weight_spmf p = 1" + by (smt (verit) divide_less_eq_1 measure_spmf.subprob_measure_le_1 weight_spmf_lt_0) + ultimately have "ennreal (spmf ?lhs x) = ennreal (spmf ?rhs x)" + using assms unfolding spmf_scale_spmf ennreal_pmf_bind nn_integral_measure_pmf UNIV_bool bernoulli_pmf.rep_eq - apply(auto simp add: nn_integral_count_space_finite max_def min_def field_simps real_inverse_le_1_iff[OF weight_spmf_nonneg weight_spmf_le_1] weight_spmf_lt_0 not_le ennreal_mult[symmetric]) - apply (metis pmf_le_0_iff spmf_le_weight) - apply (metis pmf_le_0_iff spmf_le_weight) - apply (meson le_divide_eq_1_pos measure_spmf.subprob_measure_le_1 not_less order_trans weight_spmf_le_0) - by (meson divide_le_0_1_iff less_imp_le order_trans weight_spmf_le_0) + by(auto simp: nn_integral_count_space_finite max_def min_def field_simps + real_inverse_le_1_iff[OF weight_spmf_nonneg weight_spmf_le_1] ennreal_mult[symmetric]) thus "spmf ?lhs x = spmf ?rhs x" by simp qed lemma nn_integral_spmf: "(\\<^sup>+ x. spmf p x \count_space A) = emeasure (measure_spmf p) A" -apply(simp add: measure_spmf_def emeasure_distr emeasure_restrict_space space_restrict_space nn_integral_pmf[symmetric]) -apply(rule nn_integral_bij_count_space[where g=Some]) -apply(auto simp add: bij_betw_def) -done +proof - + have "bij_betw Some A (the -` A \ range Some)" + by(auto simp: bij_betw_def) + then show ?thesis + by (metis bij_betw_def emeasure_measure_spmf_conv_measure_pmf nn_integral_pmf') +qed lemma measure_spmf_scale_spmf: "measure_spmf (scale_spmf r p) = scale_measure (min (inverse (weight_spmf p)) r) (measure_spmf p)" -apply(rule measure_eqI) - apply simp -apply(simp add: nn_integral_spmf[symmetric] spmf_scale_spmf) -apply(subst nn_integral_cmult[symmetric]) -apply(auto simp add: max_def min_def ennreal_mult[symmetric] not_le ennreal_lt_0) -done + by(rule measure_eqI; simp add: spmf_scale_spmf ennreal_mult' flip: nn_integral_spmf nn_integral_cmult) lemma measure_spmf_scale_spmf': - "r \ 1 \ measure_spmf (scale_spmf r p) = scale_measure r (measure_spmf p)" -unfolding measure_spmf_scale_spmf -apply(cases "weight_spmf p > 0") - apply(simp add: min.absorb2 field_simps weight_spmf_le_1 mult_le_one) -apply(clarsimp simp add: weight_spmf_le_0 min_def scale_spmf_neg weight_spmf_eq_0 not_less) -done + assumes "r \ 1" + shows "measure_spmf (scale_spmf r p) = scale_measure r (measure_spmf p)" +proof(cases "weight_spmf p > 0") + case True + with assms show ?thesis + by(simp add: measure_spmf_scale_spmf field_simps weight_spmf_le_1 mult_le_one) +next + case False + then show ?thesis + by (simp add: order_less_le weight_spmf_eq_0) +qed lemma scale_spmf_1 [simp]: "scale_spmf 1 p = p" -apply(rule spmf_eqI) -apply(simp add: spmf_scale_spmf max_def min_def order.strict_iff_order field_simps weight_spmf_nonneg) -apply(metis antisym_conv divide_le_eq_1 less_imp_le pmf_nonneg spmf_le_weight weight_spmf_nonneg weight_spmf_le_1) -done + by (simp add: spmf_eqI spmf_scale_spmf') lemma scale_spmf_0 [simp]: "scale_spmf 0 p = return_pmf None" -by(rule spmf_eqI)(simp add: spmf_scale_spmf min_def max_def weight_spmf_le_0) + by (simp add: scale_spmf_neg) lemma bind_scale_spmf: assumes r: "r \ 1" @@ -2264,9 +2254,10 @@ (is "?lhs = ?rhs") proof(rule spmf_eqI) fix x - have "ennreal (spmf ?lhs x) = ennreal (spmf ?rhs x)" using r - by(simp add: ennreal_spmf_bind measure_spmf_scale_spmf' nn_integral_scale_measure spmf_scale_spmf') - (simp add: ennreal_mult ennreal_lt_0 nn_integral_cmult max_def min_def) + have "ennreal (spmf ?lhs x) = ennreal (spmf ?rhs x)" + using r + by(simp add: ennreal_spmf_bind measure_spmf_scale_spmf' nn_integral_scale_measure spmf_scale_spmf' + ennreal_mult nn_integral_cmult) thus "spmf ?lhs x = spmf ?rhs x" by simp qed @@ -2295,45 +2286,50 @@ proof(rule spmf_eqI) fix i show "spmf ?lhs i = spmf ?rhs i" unfolding spmf_scale_spmf - by(subst (1 2) spmf_map)(auto simp add: measure_spmf_scale_spmf max_def min_def ennreal_lt_0) + by(subst (1 2) spmf_map)(auto simp: measure_spmf_scale_spmf max_def min_def ennreal_lt_0) qed lemma set_scale_spmf: "set_spmf (scale_spmf r p) = (if r > 0 then set_spmf p else {})" -apply(auto simp add: in_set_spmf_iff_spmf spmf_scale_spmf) -apply(simp add: max_def min_def not_le weight_spmf_lt_0 weight_spmf_eq_0 split: if_split_asm) -done + apply(auto simp: in_set_spmf_iff_spmf spmf_scale_spmf) + apply(simp add: min_def weight_spmf_eq_0 split: if_split_asm) + done lemma set_scale_spmf' [simp]: "0 < r \ set_spmf (scale_spmf r p) = set_spmf p" -by(simp add: set_scale_spmf) + by(simp add: set_scale_spmf) lemma rel_spmf_scaleI: assumes "r > 0 \ rel_spmf A p q" shows "rel_spmf A (scale_spmf r p) (scale_spmf r q)" proof(cases "r > 0") case True - from assms[OF this] show ?thesis - by(rule rel_spmfE)(auto simp add: map_scale_spmf[symmetric] spmf_rel_map True intro: rel_spmf_reflI) + from assms[OF True] show ?thesis + by(rule rel_spmfE)(auto simp: map_scale_spmf[symmetric] spmf_rel_map True intro: rel_spmf_reflI) qed(simp add: not_less scale_spmf_neg) lemma weight_scale_spmf: "weight_spmf (scale_spmf r p) = min 1 (max 0 r * weight_spmf p)" proof - + have "\1 / weight_spmf p \ r; ennreal r * ennreal (weight_spmf p) < 1\ \ weight_spmf p = 0" + by (smt (verit) ennreal_less_one_iff ennreal_mult'' measure_le_0_iff mult_imp_less_div_pos) + moreover + have "\r < 1 / weight_spmf p; 1 \ ennreal r * ennreal (weight_spmf p)\ \ weight_spmf p = 0" + by (smt (verit, ccfv_threshold) ennreal_ge_1 ennreal_mult'' mult_imp_div_pos_le weight_spmf_lt_0) + ultimately have "ennreal (weight_spmf (scale_spmf r p)) = min 1 (max 0 r * ennreal (weight_spmf p))" unfolding weight_spmf_eq_nn_integral_spmf apply(simp add: spmf_scale_spmf ennreal_mult zero_ereal_def[symmetric] nn_integral_cmult) - apply(auto simp add: weight_spmf_eq_nn_integral_spmf[symmetric] field_simps min_def max_def not_le weight_spmf_lt_0 ennreal_mult[symmetric]) - subgoal by(subst (asm) ennreal_mult[symmetric], meson divide_less_0_1_iff le_less_trans not_le weight_spmf_lt_0, simp+, meson not_le pos_divide_le_eq weight_spmf_le_0) - subgoal by(cases "r \ 0")(simp_all add: ennreal_mult[symmetric] weight_spmf_nonneg ennreal_lt_0, meson le_less_trans not_le pos_divide_le_eq zero_less_divide_1_iff) + apply(auto simp: weight_spmf_eq_nn_integral_spmf[symmetric] field_simps min_def max_def not_le weight_spmf_lt_0 ennreal_mult[symmetric]) done - thus ?thesis by(auto simp add: min_def max_def ennreal_mult[symmetric] split: if_split_asm) + thus ?thesis + by(auto simp: min_def max_def ennreal_mult[symmetric] split: if_split_asm) qed lemma weight_scale_spmf' [simp]: "\ 0 \ r; r \ 1 \ \ weight_spmf (scale_spmf r p) = r * weight_spmf p" -by(simp add: weight_scale_spmf max_def min_def)(metis antisym_conv mult_left_le order_trans weight_spmf_le_1) + by(simp add: weight_scale_spmf max_def min_def)(metis antisym_conv mult_left_le order_trans weight_spmf_le_1) lemma pmf_scale_spmf_None: "pmf (scale_spmf k p) None = 1 - min 1 (max 0 k * (1 - pmf p None))" -unfolding pmf_None_eq_weight_spmf by(simp add: weight_scale_spmf) + unfolding pmf_None_eq_weight_spmf by(simp add: weight_scale_spmf) lemma scale_scale_spmf: "scale_spmf r (scale_spmf r' p) = scale_spmf (r * max 0 (min (inverse (weight_spmf p)) r')) p" @@ -2347,25 +2343,29 @@ show ?thesis proof(rule spmf_eqI) fix i - have "max 0 (min (1 / weight_spmf p) r') * max 0 (min (1 / min 1 (weight_spmf p * max 0 r')) r) = + have *: "max 0 (min (1 / weight_spmf p) r') * max 0 (min (1 / min 1 (weight_spmf p * max 0 r')) r) = max 0 (min (1 / weight_spmf p) (r * max 0 (min (1 / weight_spmf p) r')))" using True - by(simp add: field_simps max_def min.absorb_iff2[symmetric])(auto simp add: min_def field_simps zero_le_mult_iff) - then show "spmf ?lhs i = spmf ?rhs i" - apply (subst spmf_scale_spmf)+ (*FOR SOME REASON we now get linarith_split_limit exceeded if simp is used*) - by (metis (no_types, opaque_lifting) inverse_eq_divide mult.commute mult.left_commute weight_scale_spmf) + by (simp add: max_def) (auto simp: min_def field_simps zero_le_mult_iff) + show "spmf ?lhs i = spmf ?rhs i" + by (simp add: spmf_scale_spmf) (metis * inverse_eq_divide mult.commute weight_scale_spmf) qed qed lemma scale_scale_spmf' [simp]: - "\ 0 \ r; r \ 1; 0 \ r'; r' \ 1 \ - \ scale_spmf r (scale_spmf r' p) = scale_spmf (r * r') p" -apply(cases "weight_spmf p > 0") -apply(auto simp add: scale_scale_spmf min_def max_def field_simps not_le weight_spmf_lt_0 weight_spmf_eq_0 not_less weight_spmf_le_0) -apply(subgoal_tac "1 = r'") - apply (metis (no_types) div_by_1 eq_iff measure_spmf.subprob_measure_le_1 mult.commute mult_cancel_right1) -apply(meson eq_iff le_divide_eq_1_pos measure_spmf.subprob_measure_le_1 mult_imp_div_pos_le order.trans) -done + assumes "0 \ r" "r \ 1" "0 \ r'" "r' \ 1" + shows "scale_spmf r (scale_spmf r' p) = scale_spmf (r * r') p" +proof(cases "weight_spmf p > 0") + case True + with assms have "r' = 1" if "1 \ r' * weight_spmf p" + by (smt (verit, best) measure_spmf.subprob_measure_le_1 mult_eq_1 mult_le_one that) + with assms True show ?thesis + by (smt (verit, best) eq_divide_imp measure_le_0_iff mult.assoc mult_nonneg_nonneg scale_scale_spmf weight_scale_spmf') +next + case False + with assms show ?thesis + by (simp add: weight_spmf_eq_0 zero_less_measure_iff) +qed lemma scale_spmf_eq_same: "scale_spmf r p = p \ weight_spmf p = 0 \ r = 1 \ r \ 1 \ weight_spmf p = 1" (is "?lhs \ ?rhs") @@ -2373,53 +2373,59 @@ assume ?lhs hence "weight_spmf (scale_spmf r p) = weight_spmf p" by simp hence *: "min 1 (max 0 r * weight_spmf p) = weight_spmf p" by(simp add: weight_scale_spmf) - hence **: "weight_spmf p = 0 \ r \ 1" by(auto simp add: min_def max_def split: if_split_asm) + hence **: "weight_spmf p = 0 \ r \ 1" by(auto simp: min_def max_def split: if_split_asm) show ?rhs proof(cases "weight_spmf p = 0") case False - with ** have "r \ 1" by simp - with * False have "r = 1 \ weight_spmf p = 1" by(simp add: max_def min_def not_le split: if_split_asm) - with \r \ 1\ show ?thesis by simp + with ** have "r \ 1" + by simp + with * False have "r = 1 \ weight_spmf p = 1" + by(simp add: max_def min_def not_le split: if_split_asm) + with \r \ 1\ show ?thesis + by simp qed simp -qed(auto intro!: spmf_eqI simp add: spmf_scale_spmf, metis pmf_le_0_iff spmf_le_weight) +next + show "weight_spmf p = 0 \ r = 1 \ 1 \ r \ weight_spmf p = 1 \ scale_spmf r p = p" + by (smt (verit) div_by_1 inverse_eq_divide inverse_positive_iff_positive scale_scale_spmf scale_spmf_1) +qed lemma map_const_spmf_of_set: "\ finite A; A \ {} \ \ map_spmf (\_. c) (spmf_of_set A) = return_spmf c" -by(simp add: map_spmf_conv_bind_spmf bind_spmf_const) + by(simp add: map_spmf_conv_bind_spmf bind_spmf_const) subsection \Conditional spmfs\ lemma set_pmf_Int_Some: "set_pmf p \ Some ` A = {} \ set_spmf p \ A = {}" -by(auto simp add: in_set_spmf) + by(auto simp: in_set_spmf) lemma measure_spmf_zero_iff: "measure (measure_spmf p) A = 0 \ set_spmf p \ A = {}" -unfolding measure_measure_spmf_conv_measure_pmf by(simp add: measure_pmf_zero_iff set_pmf_Int_Some) + unfolding measure_measure_spmf_conv_measure_pmf by(simp add: measure_pmf_zero_iff set_pmf_Int_Some) definition cond_spmf :: "'a spmf \ 'a set \ 'a spmf" -where "cond_spmf p A = (if set_spmf p \ A = {} then return_pmf None else cond_pmf p (Some ` A))" + where "cond_spmf p A = (if set_spmf p \ A = {} then return_pmf None else cond_pmf p (Some ` A))" lemma set_cond_spmf [simp]: "set_spmf (cond_spmf p A) = set_spmf p \ A" -by(auto 4 4 simp add: cond_spmf_def in_set_spmf iff: set_cond_pmf[THEN set_eq_iff[THEN iffD1], THEN spec, rotated]) + by(auto 4 4 simp add: cond_spmf_def in_set_spmf iff: set_cond_pmf[THEN set_eq_iff[THEN iffD1], THEN spec, rotated]) lemma cond_map_spmf [simp]: "cond_spmf (map_spmf f p) A = map_spmf f (cond_spmf p (f -` A))" proof - have "map_option f -` Some ` A = Some ` f -` A" by auto moreover have "set_pmf p \ map_option f -` Some ` A \ {}" if "Some x \ set_pmf p" "f x \ A" for x using that by auto - ultimately show ?thesis by(auto simp add: cond_spmf_def in_set_spmf cond_map_pmf) + ultimately show ?thesis by(auto simp: cond_spmf_def in_set_spmf cond_map_pmf) qed lemma spmf_cond_spmf [simp]: "spmf (cond_spmf p A) x = (if x \ A then spmf p x / measure (measure_spmf p) A else 0)" -by(auto simp add: cond_spmf_def pmf_cond set_pmf_Int_Some[symmetric] measure_measure_spmf_conv_measure_pmf measure_pmf_zero_iff) + by(auto simp: cond_spmf_def pmf_cond set_pmf_Int_Some[symmetric] measure_measure_spmf_conv_measure_pmf measure_pmf_zero_iff) lemma bind_eq_return_pmf_None: "bind_spmf p f = return_pmf None \ (\x\set_spmf p. f x = return_pmf None)" -by(auto simp add: bind_spmf_def bind_eq_return_pmf in_set_spmf split: option.splits) + by(auto simp: bind_spmf_def bind_eq_return_pmf in_set_spmf split: option.splits) lemma return_pmf_None_eq_bind: "return_pmf None = bind_spmf p f \ (\x\set_spmf p. f x = return_pmf None)" -using bind_eq_return_pmf_None[of p f] by auto + using bind_eq_return_pmf_None[of p f] by auto (* Conditional probabilities do not seem to interact nicely with bind. *) @@ -2429,27 +2435,29 @@ where "pair_spmf p q = bind_pmf (pair_pmf p q) (\xy. case xy of (Some x, Some y) \ return_spmf (x, y) | _ \ return_pmf None)" lemma map_fst_pair_spmf [simp]: "map_spmf fst (pair_spmf p q) = scale_spmf (weight_spmf q) p" -unfolding bind_spmf_const[symmetric] -apply(simp add: pair_spmf_def map_bind_pmf pair_pmf_def bind_assoc_pmf option.case_distrib) -apply(subst bind_commute_pmf) -apply(auto intro!: bind_pmf_cong[OF refl] simp add: bind_return_pmf bind_spmf_def bind_return_pmf' case_option_collapse option.case_distrib[where h="map_spmf _"] option.case_distrib[symmetric] case_option_id split: option.split cong del: option.case_cong_weak) -done + unfolding bind_spmf_const[symmetric] + apply(simp add: pair_spmf_def map_bind_pmf pair_pmf_def bind_assoc_pmf option.case_distrib) + apply(subst bind_commute_pmf) + apply(force intro!: bind_pmf_cong[OF refl] simp add: bind_return_pmf bind_spmf_def bind_return_pmf' case_option_collapse + option.case_distrib[where h="map_spmf _"] option.case_distrib[symmetric] case_option_id split: option.split cong: option.case_cong) + done lemma map_snd_pair_spmf [simp]: "map_spmf snd (pair_spmf p q) = scale_spmf (weight_spmf p) q" -unfolding bind_spmf_const[symmetric] + unfolding bind_spmf_const[symmetric] apply(simp add: pair_spmf_def map_bind_pmf pair_pmf_def bind_assoc_pmf option.case_distrib - cong del: option.case_cong_weak) -apply(auto intro!: bind_pmf_cong[OF refl] simp add: bind_return_pmf bind_spmf_def bind_return_pmf' case_option_collapse option.case_distrib[where h="map_spmf _"] option.case_distrib[symmetric] case_option_id split: option.split cong del: option.case_cong_weak) -done + cong del: option.case_cong_weak) + apply(auto intro!: bind_pmf_cong[OF refl] simp add: bind_return_pmf bind_spmf_def bind_return_pmf' case_option_collapse + option.case_distrib[where h="map_spmf _"] option.case_distrib[symmetric] case_option_id split: option.split cong del: option.case_cong_weak) + done lemma set_pair_spmf [simp]: "set_spmf (pair_spmf p q) = set_spmf p \ set_spmf q" -by(auto 4 3 simp add: pair_spmf_def set_spmf_bind_pmf bind_UNION in_set_spmf intro: rev_bexI split: option.splits) + by(force simp add: pair_spmf_def set_spmf_bind_pmf bind_UNION in_set_spmf split: option.splits) lemma spmf_pair [simp]: "spmf (pair_spmf p q) (x, y) = spmf p x * spmf q y" (is "?lhs = ?rhs") proof - have "ennreal ?lhs = \\<^sup>+ a. \\<^sup>+ b. indicator {(x, y)} (a, b) \measure_spmf q \measure_spmf p" unfolding measure_spmf_def pair_spmf_def ennreal_pmf_bind nn_integral_pair_pmf' - by(auto simp add: zero_ereal_def[symmetric] nn_integral_distr nn_integral_restrict_space nn_integral_multc[symmetric] intro!: nn_integral_cong split: option.split split_indicator) + by(auto simp: zero_ereal_def[symmetric] nn_integral_distr nn_integral_restrict_space nn_integral_multc[symmetric] intro!: nn_integral_cong split: option.split split_indicator) also have "\ = \\<^sup>+ a. (\\<^sup>+ b. indicator {y} b \measure_spmf q) * indicator {x} a \measure_spmf p" by(subst nn_integral_multc[symmetric])(auto intro!: nn_integral_cong split: split_indicator) also have "\ = ennreal ?rhs" by(simp add: emeasure_spmf_single max_def ennreal_mult mult.commute) @@ -2457,42 +2465,46 @@ qed lemma pair_map_spmf2: "pair_spmf p (map_spmf f q) = map_spmf (apsnd f) (pair_spmf p q)" -by(auto simp add: pair_spmf_def pair_map_pmf2 bind_map_pmf map_bind_pmf intro: bind_pmf_cong split: option.split) + unfolding pair_spmf_def pair_map_pmf2 bind_map_pmf map_bind_pmf + by (intro bind_pmf_cong refl) (auto split: option.split) lemma pair_map_spmf1: "pair_spmf (map_spmf f p) q = map_spmf (apfst f) (pair_spmf p q)" -by(auto simp add: pair_spmf_def pair_map_pmf1 bind_map_pmf map_bind_pmf intro: bind_pmf_cong split: option.split) + unfolding pair_spmf_def pair_map_pmf1 bind_map_pmf map_bind_pmf + by (intro bind_pmf_cong refl) (auto split: option.split) lemma pair_map_spmf: "pair_spmf (map_spmf f p) (map_spmf g q) = map_spmf (map_prod f g) (pair_spmf p q)" -unfolding pair_map_spmf2 pair_map_spmf1 spmf.map_comp by(simp add: apfst_def apsnd_def o_def prod.map_comp) + unfolding pair_map_spmf2 pair_map_spmf1 spmf.map_comp + by(simp add: apfst_def apsnd_def o_def prod.map_comp) lemma pair_spmf_alt_def: "pair_spmf p q = bind_spmf p (\x. bind_spmf q (\y. return_spmf (x, y)))" -by(auto simp add: pair_spmf_def pair_pmf_def bind_spmf_def bind_assoc_pmf bind_return_pmf split: option.split intro: bind_pmf_cong) + unfolding pair_spmf_def pair_pmf_def bind_spmf_def bind_assoc_pmf bind_return_pmf + by (intro bind_pmf_cong refl) (auto split: option.split) lemma weight_pair_spmf [simp]: "weight_spmf (pair_spmf p q) = weight_spmf p * weight_spmf q" -unfolding pair_spmf_alt_def by(simp add: weight_bind_spmf o_def) + unfolding pair_spmf_alt_def by(simp add: weight_bind_spmf o_def) lemma pair_scale_spmf1: (* FIXME: generalise to arbitrary r *) "r \ 1 \ pair_spmf (scale_spmf r p) q = scale_spmf r (pair_spmf p q)" -by(simp add: pair_spmf_alt_def scale_bind_spmf bind_scale_spmf) + by(simp add: pair_spmf_alt_def scale_bind_spmf bind_scale_spmf) lemma pair_scale_spmf2: (* FIXME: generalise to arbitrary r *) "r \ 1 \ pair_spmf p (scale_spmf r q) = scale_spmf r (pair_spmf p q)" -by(simp add: pair_spmf_alt_def scale_bind_spmf bind_scale_spmf) + by(simp add: pair_spmf_alt_def scale_bind_spmf bind_scale_spmf) lemma pair_spmf_return_None1 [simp]: "pair_spmf (return_pmf None) p = return_pmf None" -by(rule spmf_eqI)(clarsimp) + by(rule spmf_eqI)(clarsimp) lemma pair_spmf_return_None2 [simp]: "pair_spmf p (return_pmf None) = return_pmf None" -by(rule spmf_eqI)(clarsimp) + by(rule spmf_eqI)(clarsimp) lemma pair_spmf_return_spmf1: "pair_spmf (return_spmf x) q = map_spmf (Pair x) q" -by(rule spmf_eqI)(auto split: split_indicator simp add: spmf_map_inj' inj_on_def intro: spmf_map_outside) + by(rule spmf_eqI)(auto split: split_indicator simp add: spmf_map_inj' inj_on_def intro: spmf_map_outside) lemma pair_spmf_return_spmf2: "pair_spmf p (return_spmf y) = map_spmf (\x. (x, y)) p" -by(rule spmf_eqI)(auto split: split_indicator simp add: inj_on_def intro!: spmf_map_outside spmf_map_inj'[symmetric]) + by(rule spmf_eqI)(auto split: split_indicator simp add: inj_on_def intro!: spmf_map_outside spmf_map_inj'[symmetric]) lemma pair_spmf_return_spmf [simp]: "pair_spmf (return_spmf x) (return_spmf y) = return_spmf (x, y)" -by(simp add: pair_spmf_return_spmf1) + by(simp add: pair_spmf_return_spmf1) lemma rel_pair_spmf_prod: "rel_spmf (rel_prod A B) (pair_spmf p q) (pair_spmf p' q') \ @@ -2532,7 +2544,7 @@ by(simp add: pair_map_spmf[symmetric] p q map_scale_spmf spmf.map_comp) also have "\ = pair_spmf p q" using full[of p q] by(simp add: pair_scale_spmf1 pair_scale_spmf2 weight_spmf_le_1 weight_spmf_nonneg) - (auto simp add: scale_scale_spmf max_def min_def field_simps weight_spmf_nonneg weight_spmf_eq_0) + (auto simp: scale_scale_spmf max_def min_def field_simps weight_spmf_nonneg weight_spmf_eq_0) finally show "map_spmf fst ?pq = \" . have [simp]: "snd \ ?f = map_prod snd snd" by(simp add: fun_eq_iff) @@ -2543,9 +2555,9 @@ by(simp add: pair_map_spmf[symmetric] p' q' map_scale_spmf spmf.map_comp) also have "\ = pair_spmf p' q'" using full[of p' q'] eq by(simp add: pair_scale_spmf1 pair_scale_spmf2 weight_spmf_le_1 weight_spmf_nonneg) - (auto simp add: scale_scale_spmf max_def min_def field_simps weight_spmf_nonneg weight_spmf_eq_0) + (auto simp: scale_scale_spmf max_def min_def field_simps weight_spmf_nonneg weight_spmf_eq_0) finally show "map_spmf snd ?pq = \" . - qed(auto simp add: set_scale_spmf split: if_split_asm dest: * ** ) + qed(auto simp: set_scale_spmf split: if_split_asm dest: * ** ) next assume ?lhs then obtain pq where pq: "map_spmf fst pq = pair_spmf p q" @@ -2582,30 +2594,30 @@ lemma pair_pair_spmf: "pair_spmf (pair_spmf p q) r = map_spmf (\(x, (y, z)). ((x, y), z)) (pair_spmf p (pair_spmf q r))" -by(simp add: pair_spmf_alt_def map_spmf_conv_bind_spmf) + by(simp add: pair_spmf_alt_def map_spmf_conv_bind_spmf) lemma pair_commute_spmf: "pair_spmf p q = map_spmf (\(y, x). (x, y)) (pair_spmf q p)" -unfolding pair_spmf_alt_def by(subst bind_commute_spmf)(simp add: map_spmf_conv_bind_spmf) + unfolding pair_spmf_alt_def by(subst bind_commute_spmf)(simp add: map_spmf_conv_bind_spmf) subsection \Assertions\ definition assert_spmf :: "bool \ unit spmf" -where "assert_spmf b = (if b then return_spmf () else return_pmf None)" + where "assert_spmf b = (if b then return_spmf () else return_pmf None)" lemma assert_spmf_simps [simp]: "assert_spmf True = return_spmf ()" "assert_spmf False = return_pmf None" -by(simp_all add: assert_spmf_def) + by(simp_all add: assert_spmf_def) lemma in_set_assert_spmf [simp]: "x \ set_spmf (assert_spmf p) \ p" -by(cases p) simp_all + by(cases p) simp_all lemma set_spmf_assert_spmf_eq_empty [simp]: "set_spmf (assert_spmf b) = {} \ \ b" -by(cases b) simp_all + by auto lemma lossless_assert_spmf [iff]: "lossless_spmf (assert_spmf b) \ b" -by(cases b) simp_all + by(cases b) simp_all subsection \Try\ @@ -2617,59 +2629,59 @@ shows "TRY p ELSE q = p" proof - have "TRY p ELSE q = bind_pmf p return_pmf" unfolding try_spmf_def using assms - by(auto simp add: lossless_iff_set_pmf_None split: option.split intro: bind_pmf_cong) + by(auto simp: lossless_iff_set_pmf_None split: option.split intro: bind_pmf_cong) thus ?thesis by(simp add: bind_return_pmf') qed lemma try_spmf_return_spmf1: "TRY return_spmf x ELSE q = return_spmf x" -by(simp add: try_spmf_def bind_return_pmf) + by simp lemma try_spmf_return_None [simp]: "TRY return_pmf None ELSE q = q" -by(simp add: try_spmf_def bind_return_pmf) + by(simp add: try_spmf_def bind_return_pmf) lemma try_spmf_return_pmf_None2 [simp]: "TRY p ELSE return_pmf None = p" -by(simp add: try_spmf_def option.case_distrib[symmetric] bind_return_pmf' case_option_id) + by(simp add: try_spmf_def option.case_distrib[symmetric] bind_return_pmf' case_option_id) lemma map_try_spmf: "map_spmf f (try_spmf p q) = try_spmf (map_spmf f p) (map_spmf f q)" -by(simp add: try_spmf_def map_bind_pmf bind_map_pmf option.case_distrib[where h="map_spmf f"] o_def cong del: option.case_cong_weak) + by(simp add: try_spmf_def map_bind_pmf bind_map_pmf option.case_distrib[where h="map_spmf f"] o_def cong del: option.case_cong_weak) lemma try_spmf_bind_pmf: "TRY (bind_pmf p f) ELSE q = bind_pmf p (\x. TRY (f x) ELSE q)" -by(simp add: try_spmf_def bind_assoc_pmf) + by(simp add: try_spmf_def bind_assoc_pmf) lemma try_spmf_bind_spmf_lossless: "lossless_spmf p \ TRY (bind_spmf p f) ELSE q = bind_spmf p (\x. TRY (f x) ELSE q)" -by(auto simp add: try_spmf_def bind_spmf_def bind_assoc_pmf bind_return_pmf lossless_iff_set_pmf_None intro!: bind_pmf_cong split: option.split) + by (metis (mono_tags, lifting) bind_spmf_of_pmf lossless_spmf_conv_spmf_of_pmf try_spmf_bind_pmf) lemma try_spmf_bind_out: "lossless_spmf p \ bind_spmf p (\x. TRY (f x) ELSE q) = TRY (bind_spmf p f) ELSE q" -by(simp add: try_spmf_bind_spmf_lossless) + by(simp add: try_spmf_bind_spmf_lossless) lemma lossless_try_spmf [simp]: "lossless_spmf (TRY p ELSE q) \ lossless_spmf p \ lossless_spmf q" -by(auto simp add: try_spmf_def in_set_spmf lossless_iff_set_pmf_None split: option.splits) + by(auto simp: try_spmf_def in_set_spmf lossless_iff_set_pmf_None split: option.splits) context includes lifting_syntax begin lemma try_spmf_parametric [transfer_rule]: "(rel_spmf A ===> rel_spmf A ===> rel_spmf A) try_spmf try_spmf" -unfolding try_spmf_def[abs_def] by transfer_prover + unfolding try_spmf_def[abs_def] by transfer_prover end lemma try_spmf_cong: "\ p = p'; \ lossless_spmf p' \ q = q' \ \ TRY p ELSE q = TRY p' ELSE q'" -unfolding try_spmf_def -by(rule bind_pmf_cong)(auto split: option.split simp add: lossless_iff_set_pmf_None) + unfolding try_spmf_def + by(rule bind_pmf_cong)(auto split: option.split simp add: lossless_iff_set_pmf_None) lemma rel_spmf_try_spmf: "\ rel_spmf R p p'; \ lossless_spmf p' \ rel_spmf R q q' \ \ rel_spmf R (TRY p ELSE q) (TRY p' ELSE q')" -unfolding try_spmf_def -apply(rule rel_pmf_bindI[where R="\x y. rel_option R x y \ x \ set_pmf p \ y \ set_pmf p'"]) - apply(erule pmf.rel_mono_strong; simp) -apply(auto split: option.split simp add: lossless_iff_set_pmf_None) -done + unfolding try_spmf_def + apply(rule rel_pmf_bindI[where R="\x y. rel_option R x y \ x \ set_pmf p \ y \ set_pmf p'"]) + apply (simp add: pmf.rel_mono_strong) + apply(auto split: option.split simp add: lossless_iff_set_pmf_None) + done lemma spmf_try_spmf: "spmf (TRY p ELSE q) x = spmf p x + pmf p None * spmf q x" @@ -2679,11 +2691,11 @@ also have "\ = (\\<^sup>+ y. ennreal (spmf q x) * indicator {None} y \measure_pmf p) + \\<^sup>+ y. indicator {Some x} y \measure_pmf p" by(simp add: nn_integral_add) also have "\ = ennreal (spmf q x) * pmf p None + spmf p x" by(simp add: emeasure_pmf_single) - finally show ?thesis by(simp add: ennreal_mult[symmetric] ennreal_plus[symmetric] del: ennreal_plus) + finally show ?thesis by(simp flip: ennreal_plus ennreal_mult) qed lemma try_scale_spmf_same [simp]: "lossless_spmf p \ TRY scale_spmf k p ELSE p = p" -by(rule spmf_eqI)(auto simp add: spmf_try_spmf spmf_scale_spmf pmf_scale_spmf_None lossless_iff_pmf_None weight_spmf_conv_pmf_None min_def max_def field_simps) + by(rule spmf_eqI)(auto simp: spmf_try_spmf spmf_scale_spmf pmf_scale_spmf_None lossless_iff_pmf_None weight_spmf_conv_pmf_None min_def max_def field_simps) lemma pmf_try_spmf_None [simp]: "pmf (TRY p ELSE q) None = pmf p None * pmf q None" (is "?lhs = ?rhs") proof - @@ -2714,7 +2726,7 @@ and fundamental_lemma: "\measure (measure_spmf p) {x. A x} - measure (measure_spmf q) {y. B y}\ \ measure (measure_spmf p) {x. bad1 x}" (is ?fundamental) proof - - have good: "rel_fun ?A (=) (\x. A x \ \ bad1 x) (\y. B y \ \ bad2 y)" by(auto simp add: rel_fun_def) + have good: "rel_fun ?A (=) (\x. A x \ \ bad1 x) (\y. B y \ \ bad2 y)" by(auto simp: rel_fun_def) from assms have 1: "measure (measure_spmf p) {x. A x \ \ bad1 x} = measure (measure_spmf q) {y. B y \ \ bad2 y}" by(rule measure_spmf_parametric[THEN rel_funD, THEN rel_funD])(rule Collect_parametric[THEN rel_funD, OF good]) @@ -2731,7 +2743,7 @@ by(subst (1 2) measure_Union)(auto) also have "\ = \?\p {x. A x \ bad1 x} - ?\q {y. B y \ bad2 y}\" using 1 by simp also have "\ \ max (?\p {x. A x \ bad1 x}) (?\q {y. B y \ bad2 y})" - by(rule abs_leI)(auto simp add: max_def not_le, simp_all only: add_increasing measure_nonneg mult_2) + by(rule abs_leI)(auto simp: max_def not_le, simp_all only: add_increasing measure_nonneg mult_2) also have "\ \ max (?\p {x. bad1 x}) (?\q {y. bad2 y})" by(rule max.mono; rule measure_spmf.finite_measure_mono; auto) also note 2[symmetric] diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Real_Vector_Spaces.thy --- a/src/HOL/Real_Vector_Spaces.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Real_Vector_Spaces.thy Mon Sep 11 22:59:34 2023 +0200 @@ -142,7 +142,7 @@ lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x" for x :: "'a::real_vector" - using scaleR_minus_left [of 1 x] by simp + by simp lemma scaleR_2: fixes x :: "'a::real_vector" @@ -786,6 +786,11 @@ class real_normed_div_algebra = real_div_algebra + real_normed_vector + assumes norm_mult: "norm (x * y) = norm x * norm y" +lemma divideR_right: + fixes x y :: "'a::real_normed_vector" + shows "r \ 0 \ y = x /\<^sub>R r \ r *\<^sub>R y = x" + by auto + class real_normed_field = real_field + real_normed_div_algebra instance real_normed_div_algebra < real_normed_algebra_1 diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Tools/ATP/system_on_tptp.scala --- a/src/HOL/Tools/ATP/system_on_tptp.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Tools/ATP/system_on_tptp.scala Mon Sep 11 22:59:34 2023 +0200 @@ -70,7 +70,7 @@ object Run_System extends Scala.Fun_Strings("SystemOnTPTP.run_system", thread = true) { val here = Scala_Project.here def apply(args: List[String]): List[String] = { - val List(url, system, problem_path, extra, Value.Int(timeout)) = args + val List(url, system, problem_path, extra, Value.Int(timeout)) = args : @unchecked val problem = File.read(Path.explode(problem_path)) val res = run_system(Url(url), system, problem, extra = extra, timeout = Time.ms(timeout)) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Tools/Sledgehammer/async_manager_legacy.ML --- a/src/HOL/Tools/Sledgehammer/async_manager_legacy.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Tools/Sledgehammer/async_manager_legacy.ML Mon Sep 11 22:59:34 2023 +0200 @@ -19,34 +19,28 @@ struct fun make_thread interrupts body = - Thread.fork - (fn () => - Runtime.debugging NONE body () handle exn => - if Exn.is_interrupt exn then () - else writeln ("## INTERNAL ERROR ##\n" ^ Runtime.exn_message exn), - Isabelle_Thread.attributes - {name = "async_manager", stack_limit = NONE, interrupts = interrupts}); + Isabelle_Thread.fork {name = "async_manager", stack_limit = NONE, interrupts = interrupts} body; fun implode_message (workers, work) = space_implode " " (Try.serial_commas "and" workers) ^ work structure Thread_Heap = Heap ( - type elem = Time.time * Thread.thread + type elem = Time.time * Isabelle_Thread.T fun ord ((a, _), (b, _)) = Time.compare (a, b) ) -fun lookup_thread xs = AList.lookup Thread.equal xs -fun delete_thread xs = AList.delete Thread.equal xs -fun update_thread xs = AList.update Thread.equal xs +fun lookup_thread xs = AList.lookup Isabelle_Thread.equal xs +fun delete_thread xs = AList.delete Isabelle_Thread.equal xs +fun update_thread xs = AList.update Isabelle_Thread.equal xs type state = - {manager: Thread.thread option, + {manager: Isabelle_Thread.T option, timeout_heap: Thread_Heap.T, active: - (Thread.thread + (Isabelle_Thread.T * (string * Time.time * Time.time * (string * string))) list, - canceling: (Thread.thread * (string * Time.time * (string * string))) list, + canceling: (Isabelle_Thread.T * (string * Time.time * (string * string))) list, messages: (bool * (string * (string * string))) list} fun make_state manager timeout_heap active canceling messages : state = @@ -91,7 +85,7 @@ fun check_thread_manager () = Synchronized.change global_state (fn state as {manager, timeout_heap, active, canceling, messages} => - if (case manager of SOME thread => Thread.isActive thread | NONE => false) then state + if (case manager of SOME thread => Isabelle_Thread.is_active thread | NONE => false) then state else let val manager = SOME (make_thread false (fn () => let fun time_limit timeout_heap = @@ -102,14 +96,14 @@ (*action: find threads whose timeout is reached, and interrupt canceling threads*) fun action {manager, timeout_heap, active, canceling, messages} = let val (timeout_threads, timeout_heap') = - Thread_Heap.upto (Time.now (), Thread.self ()) timeout_heap + Thread_Heap.upto (Time.now (), Isabelle_Thread.self ()) timeout_heap in if null timeout_threads andalso null canceling then NONE else let val _ = List.app (Isabelle_Thread.interrupt_unsynchronized o #1) canceling - val canceling' = filter (Thread.isActive o #1) canceling + val canceling' = filter (Isabelle_Thread.is_active o #1) canceling val state' = make_state manager timeout_heap' active canceling' messages in SOME (map #2 timeout_threads, state') end end @@ -144,7 +138,7 @@ (make_thread true (fn () => let - val self = Thread.self () + val self = Isabelle_Thread.self () val _ = register tool birth_time death_time desc self in unregister (f ()) self end); ()) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Tools/Sledgehammer/sledgehammer.ML --- a/src/HOL/Tools/Sledgehammer/sledgehammer.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer.ML Mon Sep 11 22:59:34 2023 +0200 @@ -262,7 +262,7 @@ | facts => "The goal is falsified by these facts: " ^ commas facts) else "Derived \"False\" from these facts alone: " ^ - commas (map fst used_facts))) + space_implode " " (map fst used_facts))) fun check_expected_outcome ctxt prover_name expect outcome = let @@ -464,7 +464,7 @@ end fun run_sledgehammer (params as {verbose, spy, provers, falsify, induction_rules, max_facts, - max_proofs, slices, ...}) mode writeln_result i (fact_override as {only, ...}) state = + max_proofs, slices, timeout, ...}) mode writeln_result i (fact_override as {only, ...}) state = if null provers then error "No prover is set" else @@ -513,7 +513,7 @@ fun massage_message proof_or_inconsistency s = let val s' = strip_time s in if member (op =) (Synchronized.value seen_messages) s' then - "Found duplicate " ^ proof_or_inconsistency + "Duplicate " ^ proof_or_inconsistency else (Synchronized.change seen_messages (cons s'); s) end @@ -577,6 +577,8 @@ val launch = launch_prover_and_preplay params mode has_already_found_something found_something massage_message writeln_result learn + val timer = Timer.startRealTimer () + val schedule = if mode = Auto_Try then provers else schedule_of_provers provers slices @@ -597,7 +599,8 @@ else (learn chained_thms; Par_List.map (fn (prover, slice) => - if Synchronized.value found_proofs_and_falsifications < max_proofs then + if Synchronized.value found_proofs_and_falsifications < max_proofs + andalso Timer.checkRealTimer timer < timeout then launch problem slice prover else (SH_None, "")) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML --- a/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Mon Sep 11 22:59:34 2023 +0200 @@ -289,7 +289,8 @@ val _ = if mode = Normal andalso not (is_conjecture_used_in_proof atp_proof) andalso not (Logic.get_goal (Thm.prop_of goal) subgoal aconv @{prop False}) then - warning ("Derived \"False\" from these facts alone: " ^ commas (map fst used_facts)) + warning ("Derived \"False\" from these facts alone: " ^ + space_implode " " (map fst used_facts)) else () diff -r 0d2ea608d223 -r 5930c89d3bf2 src/HOL/Topological_Spaces.thy --- a/src/HOL/Topological_Spaces.thy Mon Sep 11 19:31:09 2023 +0200 +++ b/src/HOL/Topological_Spaces.thy Mon Sep 11 22:59:34 2023 +0200 @@ -1220,6 +1220,11 @@ "f \ f0 \ (\S. open S \ f0 \ S \ (\N. \n\N. f n \ S))" unfolding tendsto_def eventually_sequentially by auto +lemma closed_sequentially: + assumes "closed S" and "\n. f n \ S" and "f \ l" + shows "l \ S" + by (metis Lim_in_closed_set assms eventually_sequentially trivial_limit_sequentially) + subsection \Monotone sequences and subsequences\ diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/afp.scala --- a/src/Pure/Admin/afp.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/afp.scala Mon Sep 11 22:59:34 2023 +0200 @@ -21,8 +21,6 @@ val chapter: String = "AFP" - val force_partition1: List[String] = List("Category3", "HOL-ODE") - val BASE: Path = Path.explode("$AFP_BASE") def main_dir(base_dir: Path = BASE): Path = base_dir + Path.explode("thys") @@ -207,19 +205,4 @@ } }""" }).mkString("[", ", ", "\n]\n") - - - /* partition sessions */ - - def partition(n: Int): List[String] = - n match { - case 0 => Nil - case 1 | 2 => - val graph = sessions_structure.build_graph.restrict(sessions.toSet) - val force_part1 = - graph.all_preds(graph.all_succs(AFP.force_partition1.filter(graph.defined))).toSet - val (part1, part2) = graph.keys.partition(a => force_part1(a) || graph.is_isolated(a)) - if (n == 1) part1 else part2 - case _ => error("Bad AFP partition: " + n + " (should be 0, 1, 2)") - } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/build_history.scala --- a/src/Pure/Admin/build_history.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/build_history.scala Mon Sep 11 22:59:34 2023 +0200 @@ -112,12 +112,11 @@ root: Path, progress: Progress = new Progress, afp: Boolean = false, - afp_partition: Int = 0, isabelle_identifier: String = default_isabelle_identifier, ml_statistics_step: Int = 1, component_repository: String = Components.static_component_repository, components_base: String = Components.dynamic_components_base, - clean_platforms: Option[List[Platform.Family.Value]] = None, + clean_platforms: Option[List[Platform.Family]] = None, clean_archives: Boolean = false, fresh: Boolean = false, hostname: String = "", @@ -167,22 +166,9 @@ } val isabelle_directory = directory(root) - val afp_directory = if (afp) Some(directory(root + Path.explode("AFP"))) else None - - val (afp_build_args, afp_sessions) = - if (afp_directory.isEmpty) (Nil, Nil) - else { - val (opt, sessions) = { - if (afp_partition == 0) ("-d", Nil) - else { - try { - val afp_info = AFP.init(options, base_dir = afp_directory.get.root) - ("-d", afp_info.partition(afp_partition)) - } catch { case ERROR(_) => ("-D", Nil) } - } - } - (List(opt, "~~/AFP/thys"), sessions) - } + val (afp_directory, afp_build_args) = + if (afp) (Some(directory(root + Path.explode("AFP"))), List("-d", "~~/AFP/thys")) + else (None, Nil) /* main */ @@ -266,7 +252,7 @@ val build_result = Other_Isabelle(root, isabelle_identifier = isabelle_identifier, progress = build_out_progress) - .bash("bin/isabelle build " + Bash.strings(build_args1 ::: afp_sessions), + .bash("bin/isabelle build " + Bash.strings(build_args1), redirect = true, echo = true, strict = false) val build_end = Date.now() @@ -423,8 +409,7 @@ var max_heap: Option[Int] = None var multicore_list = List(default_multicore) var isabelle_identifier = default_isabelle_identifier - var clean_platforms: Option[List[Platform.Family.Value]] = None - var afp_partition = 0 + var clean_platforms: Option[List[Platform.Family]] = None var clean_archives = false var component_repository = Components.static_component_repository var arch_apple = false @@ -453,7 +438,6 @@ -N NAME alternative ISABELLE_IDENTIFIER (default: """ + default_isabelle_identifier + """) -O PLATFORMS clean resolved components, retaining only the given list platform families (separated by commas; default: do nothing) - -P NUMBER AFP partition number (0, 1, 2, default: 0=unrestricted) -Q clean archives of downloaded components -R URL remote repository for Isabelle components (default: """ + Components.static_component_repository + """) @@ -485,7 +469,6 @@ "M:" -> (arg => multicore_list = space_explode(',', arg).map(Multicore.parse)), "N:" -> (arg => isabelle_identifier = arg), "O:" -> (arg => clean_platforms = Some(space_explode(',',arg).map(Platform.Family.parse))), - "P:" -> (arg => afp_partition = Value.Int.parse(arg)), "Q" -> (_ => clean_archives = true), "R:" -> (arg => component_repository = arg), "U:" -> (arg => max_heap = Some(Value.Int.parse(arg))), @@ -516,8 +499,7 @@ val progress = new Console_Progress(stderr = true) val results = - local_build(Options.init(), root, progress = progress, - afp = afp, afp_partition = afp_partition, + local_build(Options.init(), root, progress = progress, afp = afp, isabelle_identifier = isabelle_identifier, ml_statistics_step = ml_statistics_step, component_repository = component_repository, components_base = components_base, clean_platforms = clean_platforms, clean_archives = clean_archives, diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/build_log.scala --- a/src/Pure/Admin/build_log.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/build_log.scala Mon Sep 11 22:59:34 2023 +0200 @@ -201,7 +201,7 @@ /* inlined text */ def filter(Marker: Protocol_Message.Marker): List[String] = - for (Marker(text) <- lines) yield text + for (case Marker(text) <- lines) yield text def find(Marker: Protocol_Message.Marker): Option[String] = lines.collectFirst({ case Marker(text) => text }) @@ -395,9 +395,7 @@ val SESSION_NAME = "session_name" - object Session_Status extends Enumeration { - val existing, finished, failed, cancelled = Value - } + enum Session_Status { case existing, finished, failed, cancelled } sealed case class Session_Entry( chapter: String = "", @@ -407,7 +405,7 @@ ml_timing: Timing = Timing.zero, sources: Option[String] = None, heap_size: Option[Space] = None, - status: Option[Session_Status.Value] = None, + status: Option[Session_Status] = None, errors: List[String] = Nil, theory_timings: Map[String, Timing] = Map.empty, ml_statistics: List[Properties.T] = Nil @@ -445,7 +443,7 @@ val Session_Timing = new Regex("""^Timing (\S+) \((\d+) threads, (\d+\.\d+)s elapsed time, (\d+\.\d+)s cpu time, (\d+\.\d+)s GC time.*$""") val Session_Started1 = new Regex("""^(?:Running|Building) (\S+) \.\.\.$""") - val Session_Started2 = new Regex("""^(?:Running|Building) (\S+) on \S+ \.\.\.$""") + val Session_Started2 = new Regex("""^(?:Running|Building) (\S+) \(?on \S+\)? \.\.\.$""") val Sources = new Regex("""^Sources (\S+) (\S{""" + SHA1.digest_length + """})$""") val Heap = new Regex("""^Heap (\S+) \((\d+) bytes\)$""") @@ -1040,13 +1038,13 @@ Par_List.map[JFile, Exn.Result[Log_File]]( file => Exn.capture { Log_File(file) }, file_group) db.transaction { - for (Exn.Res(log_file) <- log_files) { + for (case Exn.Res(log_file) <- log_files) { progress.echo("Log " + quote(log_file.name), verbose = true) try { status.foreach(_.update(log_file)) } catch { case exn: Throwable => add_error(log_file.name, exn) } } } - for ((file, Exn.Exn(exn)) <- file_group.zip(log_files)) { + for (case (file, Exn.Exn(exn)) <- file_group.zip(log_files)) { add_error(Log_File.plain_name(file), exn) } } @@ -1071,8 +1069,8 @@ else res.get_string(c))) val n = Prop.all_props.length - val props = for ((x, Some(y)) <- results.take(n)) yield (x, y) - val settings = for ((x, Some(y)) <- results.drop(n)) yield (x, y) + val props = for (case (x, Some(y)) <- results.take(n)) yield (x, y) + val settings = for (case (x, Some(y)) <- results.drop(n)) yield (x, y) Meta_Info(props, settings) } ) @@ -1129,7 +1127,7 @@ Data.ml_timing_gc), sources = res.get_string(Data.sources), heap_size = res.get_long(Data.heap_size).map(Space.bytes), - status = res.get_string(Data.status).map(Session_Status.withName), + status = res.get_string(Data.status).map(Session_Status.valueOf), errors = uncompress_errors(res.bytes(Data.errors), cache = cache), ml_statistics = if (ml_statistics) { diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/build_release.scala --- a/src/Pure/Admin/build_release.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/build_release.scala Mon Sep 11 22:59:34 2023 +0200 @@ -71,7 +71,7 @@ """) } - def bundle_info(platform: Platform.Family.Value): Bundle_Info = + def bundle_info(platform: Platform.Family): Bundle_Info = platform match { case Platform.Family.linux_arm => Bundle_Info(platform, "Linux (ARM)", dist_name + "_linux_arm.tar.gz") @@ -82,7 +82,7 @@ } sealed case class Bundle_Info( - platform: Platform.Family.Value, + platform: Platform.Family, platform_description: String, name: String ) { @@ -150,7 +150,7 @@ /* bundled components */ - class Bundled(platform: Option[Platform.Family.Value] = None) { + class Bundled(platform: Option[Platform.Family] = None) { def detect(s: String): Boolean = s.startsWith("#bundled") && !s.startsWith("#bundled ") @@ -186,17 +186,16 @@ } yield bundled(line)).toList)) } - def get_bundled_components(dir: Path, platform: Platform.Family.Value): (List[String], String) = { + def get_bundled_components(dir: Path, platform: Platform.Family): (List[String], String) = { val Bundled = new Bundled(platform = Some(platform)) val components = - for { Bundled(name) <- Components.Directory(dir).read_components() } yield name + for { case Bundled(name) <- Components.Directory(dir).read_components() } yield name val jdk_component = components.find(_.startsWith("jdk")) getOrElse error("Missing jdk component") (components, jdk_component) } - def activate_components( - dir: Path, platform: Platform.Family.Value, more_names: List[String]): Unit = { + def activate_components(dir: Path, platform: Platform.Family, more_names: List[String]): Unit = { def contrib_name(name: String): String = Components.contrib(name = name).implode @@ -219,7 +218,7 @@ private def build_heaps( options: Options, - platform: Platform.Family.Value, + platform: Platform.Family, build_sessions: List[String], local_dir: Path, progress: Progress = new Progress, @@ -275,7 +274,7 @@ } def make_isabelle_app( - platform: Platform.Family.Value, + platform: Platform.Family, isabelle_target: Path, isabelle_name: String, jdk_component: String, @@ -491,13 +490,13 @@ } } - def default_platform_families: List[Platform.Family.Value] = Platform.Family.list0 + def default_platform_families: List[Platform.Family] = Platform.Family.list0 def build_release( options: Options, context: Release_Context, afp_rev: String = "", - platform_families: List[Platform.Family.Value] = default_platform_families, + platform_families: List[Platform.Family] = default_platform_families, more_components: List[Path] = Nil, website: Option[Path] = None, build_sessions: List[String] = Nil, diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/build_status.scala --- a/src/Pure/Admin/build_status.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/build_status.scala Mon Sep 11 22:59:34 2023 +0200 @@ -196,7 +196,7 @@ maximum_heap: Space, average_heap: Space, stored_heap: Space, - status: Build_Log.Session_Status.Value, + status: Build_Log.Session_Status, errors: List[String] ) { val date: Long = (afp_pull_date getOrElse pull_date).unix_epoch @@ -323,7 +323,7 @@ maximum_heap = Space.B(ml_stats.maximum(ML_Statistics.HEAP_SIZE)), average_heap = Space.B(ml_stats.average(ML_Statistics.HEAP_SIZE)), stored_heap = Space.bytes(res.long(Build_Log.Data.heap_size)), - status = Build_Log.Session_Status.withName(res.string(Build_Log.Data.status)), + status = Build_Log.Session_Status.valueOf(res.string(Build_Log.Data.status)), errors = Build_Log.uncompress_errors( res.bytes(Build_Log.Data.errors), cache = store.cache)) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Admin/isabelle_cronjob.scala --- a/src/Pure/Admin/isabelle_cronjob.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Admin/isabelle_cronjob.scala Mon Sep 11 22:59:34 2023 +0200 @@ -307,14 +307,6 @@ } } - val remote_build_mini3 = - Remote_Build("macOS 13 Ventura (ARM64)", "mini3", - history_base = "8e590adaac5e", - options = "-a -m32 -B -M1x4,2x2,4 -p pide_session=false" + - " -e ISABELLE_MLTON=/opt/homebrew/bin/mlton -e ISABELLE_MLTON_OPTIONS=" + - " -e ISABELLE_SWIPL=/opt/homebrew/bin/swipl", - args = "-a -d '~~/src/Benchmarks'") - val remote_builds1: List[List[Remote_Build]] = { List( List(Remote_Build("Linux A", "augsburg1", @@ -355,7 +347,13 @@ Remote_Build("macOS, skip_proofs", "mini2", options = "-m32 -M4 -t skip_proofs -p pide_session=false", args = "-a -o skip_proofs", detect = Build_Log.Prop.build_tags.toString + " = " + SQL.string("skip_proofs"))), - List(remote_build_mini3, remote_build_mini3, remote_build_mini3), + List( + Remote_Build("macOS 13 Ventura (ARM64)", "mini3", + history_base = "8e590adaac5e", + options = "-a -m32 -B -M1x4,2x2,4 -p pide_session=false" + + " -e ISABELLE_MLTON=/opt/homebrew/bin/mlton -e ISABELLE_MLTON_OPTIONS=" + + " -e ISABELLE_SWIPL=/opt/homebrew/bin/swipl", + args = "-a -d '~~/src/Benchmarks'")), List( Remote_Build("macOS 12 Monterey", "monterey", user = "makarius", options = "-m32 -M4 -e ISABELLE_GHC_SETUP=true -p pide_session=false", diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/consumer_thread.scala --- a/src/Pure/Concurrent/consumer_thread.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/consumer_thread.scala Mon Sep 11 22:59:34 2023 +0200 @@ -89,7 +89,7 @@ val (results, cont) = consume(reqs.map(_.arg)) for { - (Some(req), Some(res)) <- reqs.map(Some(_)).zipAll(results.map(Some(_)), None, None) + case (Some(req), Some(res)) <- reqs.map(Some(_)).zipAll(results.map(Some(_)), None, None) } { (req.ack, res) match { case (Some(a), _) => a.change(_ => Some(res)) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/event_timer.ML --- a/src/Pure/Concurrent/event_timer.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/event_timer.ML Mon Sep 11 22:59:34 2023 +0200 @@ -92,7 +92,7 @@ datatype status = Normal | Shutdown_Req | Shutdown_Ack; datatype state = - State of {requests: requests, status: status, manager: Thread.thread option}; + State of {requests: requests, status: status, manager: Isabelle_Thread.T option}; fun make_state (requests, status, manager) = State {requests = requests, status = status, manager = manager}; @@ -128,7 +128,7 @@ then manager_loop () else (); fun manager_check manager = - if is_some manager andalso Thread.isActive (the manager) then manager + if is_some manager andalso Isabelle_Thread.is_active (the manager) then manager else SOME (Isabelle_Thread.fork {name = "event_timer", stack_limit = NONE, interrupts = false} manager_loop); diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/future.ML --- a/src/Pure/Concurrent/future.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/future.ML Mon Sep 11 22:59:34 2023 +0200 @@ -121,12 +121,12 @@ (* synchronization *) -val scheduler_event = ConditionVar.conditionVar (); -val work_available = ConditionVar.conditionVar (); -val work_finished = ConditionVar.conditionVar (); +val scheduler_event = Thread.ConditionVar.conditionVar (); +val work_available = Thread.ConditionVar.conditionVar (); +val work_finished = Thread.ConditionVar.conditionVar (); local - val lock = Mutex.mutex (); + val lock = Thread.Mutex.mutex (); in fun SYNCHRONIZED name = Multithreading.synchronized name lock; @@ -138,10 +138,10 @@ Multithreading.sync_wait (SOME (Time.now () + timeout)) cond lock; fun signal cond = (*requires SYNCHRONIZED*) - ConditionVar.signal cond; + Thread.ConditionVar.signal cond; fun broadcast cond = (*requires SYNCHRONIZED*) - ConditionVar.broadcast cond; + Thread.ConditionVar.broadcast cond; end; @@ -150,7 +150,7 @@ val queue = Unsynchronized.ref Task_Queue.empty; val next = Unsynchronized.ref 0; -val scheduler = Unsynchronized.ref (NONE: Thread.thread option); +val scheduler = Unsynchronized.ref (NONE: Isabelle_Thread.T option); val canceled = Unsynchronized.ref ([]: group list); val do_shutdown = Unsynchronized.ref false; val max_workers = Unsynchronized.ref 0; @@ -161,7 +161,7 @@ val next_round = seconds 0.05; datatype worker_state = Working | Waiting | Sleeping; -val workers = Unsynchronized.ref ([]: (Thread.thread * worker_state Unsynchronized.ref) list); +val workers = Unsynchronized.ref ([]: (Isabelle_Thread.T * worker_state Unsynchronized.ref) list); fun count_workers state = (*requires SYNCHRONIZED*) fold (fn (_, state_ref) => fn i => if ! state_ref = state then i + 1 else i) (! workers) 0; @@ -245,18 +245,19 @@ in () end; fun worker_wait worker_state cond = (*requires SYNCHRONIZED*) - (case AList.lookup Thread.equal (! workers) (Thread.self ()) of + (case AList.lookup Isabelle_Thread.equal (! workers) (Isabelle_Thread.self ()) of SOME state => Unsynchronized.setmp state worker_state wait cond | NONE => wait cond); fun worker_next () = (*requires SYNCHRONIZED*) if length (! workers) > ! max_workers then - (Unsynchronized.change workers (AList.delete Thread.equal (Thread.self ())); + (Unsynchronized.change workers (AList.delete Isabelle_Thread.equal (Isabelle_Thread.self ())); signal work_available; NONE) else let val urgent_only = count_workers Working > ! max_active in - (case Unsynchronized.change_result queue (Task_Queue.dequeue (Thread.self ()) urgent_only) of + (case Unsynchronized.change_result queue + (Task_Queue.dequeue (Isabelle_Thread.self ()) urgent_only) of NONE => (worker_wait Sleeping work_available; worker_next ()) | some => (signal work_available; some)) end; @@ -297,10 +298,10 @@ then ML_statistics () else (); val _ = - if not tick orelse forall (Thread.isActive o #1) (! workers) then () + if not tick orelse forall (Isabelle_Thread.is_active o #1) (! workers) then () else let - val (alive, dead) = List.partition (Thread.isActive o #1) (! workers); + val (alive, dead) = List.partition (Isabelle_Thread.is_active o #1) (! workers); val _ = workers := alive; in Multithreading.tracing 0 (fn () => @@ -374,7 +375,7 @@ do (); last_round := Time.zeroTime); fun scheduler_active () = (*requires SYNCHRONIZED*) - (case ! scheduler of NONE => false | SOME thread => Thread.isActive thread); + (case ! scheduler of NONE => false | SOME thread => Isabelle_Thread.is_active thread); fun scheduler_check () = (*requires SYNCHRONIZED*) (do_shutdown := false; @@ -509,7 +510,8 @@ fun join_next atts deps = (*requires SYNCHRONIZED*) if null deps then NONE else - (case Unsynchronized.change_result queue (Task_Queue.dequeue_deps (Thread.self ()) deps) of + (case Unsynchronized.change_result queue + (Task_Queue.dequeue_deps (Isabelle_Thread.self ()) deps) of (NONE, []) => NONE | (NONE, deps') => (worker_waiting deps' (fn () => @@ -571,7 +573,7 @@ val (result, job) = future_job group orig_atts (fn () => f x); val task = SYNCHRONIZED "enroll" (fn () => - Unsynchronized.change_result queue (Task_Queue.enroll (Thread.self ()) name group)); + Unsynchronized.change_result queue (Task_Queue.enroll (Isabelle_Thread.self ()) name group)); val _ = worker_exec (task, [job]); in (case Single_Assignment.peek result of @@ -670,7 +672,7 @@ val passive_job = SYNCHRONIZED "fulfill_result" (fn () => Unsynchronized.change_result queue - (Task_Queue.dequeue_passive (Thread.self ()) task)); + (Task_Queue.dequeue_passive (Isabelle_Thread.self ()) task)); in (case passive_job of SOME true => worker_exec (task, [job]) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/future.scala --- a/src/Pure/Concurrent/future.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/future.scala Mon Sep 11 22:59:34 2023 +0200 @@ -65,30 +65,32 @@ /* task future via thread pool */ private class Task_Future[A](body: => A) extends Future[A] { - private sealed abstract class Status - private case object Ready extends Status - private case class Running(thread: Thread) extends Status - private case object Terminated extends Status - private case class Finished(result: Exn.Result[A]) extends Status + private enum Status { + case Ready extends Status + case Running(thread: Thread) extends Status + case Terminated extends Status + case Finished(result: Exn.Result[A]) extends Status + } - private val status = Synchronized[Status](Ready) + private val status = Synchronized[Status](Status.Ready) def peek: Option[Exn.Result[A]] = status.value match { - case Finished(result) => Some(result) + case Status.Finished(result) => Some(result) case _ => None } private def try_run(): Unit = { val do_run = status.change_result { - case Ready => (true, Running(Thread.currentThread)) + case Status.Ready => (true, Status.Running(Thread.currentThread)) case st => (false, st) } if (do_run) { val result = Exn.capture(body) - status.change(_ => Terminated) - status.change(_ => Finished(if (Thread.interrupted()) Exn.Exn(Exn.Interrupt()) else result)) + status.change(_ => Status.Terminated) + status.change(_ => + Status.Finished(if (Thread.interrupted()) Exn.Exn(Exn.Interrupt()) else result)) } } private val task = Isabelle_Thread.pool.submit(new Callable[Unit] { def call = try_run() }) @@ -96,15 +98,15 @@ def join_result: Exn.Result[A] = { try_run() status.guarded_access { - case st @ Finished(result) => Some((result, st)) + case st @ Status.Finished(result) => Some((result, st)) case _ => None } } def cancel(): Unit = { status.change { - case Ready => task.cancel(false); Finished(Exn.Exn(Exn.Interrupt())) - case st @ Running(thread) => thread.interrupt(); st + case Status.Ready => task.cancel(false); Status.Finished(Exn.Exn(Exn.Interrupt())) + case st @ Status.Running(thread) => thread.interrupt(); st case st => st } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/isabelle_thread.ML --- a/src/Pure/Concurrent/isabelle_thread.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/isabelle_thread.ML Mon Sep 11 22:59:34 2023 +0200 @@ -6,38 +6,63 @@ signature ISABELLE_THREAD = sig - val is_self: Thread.thread -> bool - val get_name: unit -> string + type T + val get_thread: T -> Thread.Thread.thread + val get_name: T -> string + val get_id: T -> int + val equal: T * T -> bool + val print: T -> string + val self: unit -> T + val is_self: T -> bool val stack_limit: unit -> int option type params = {name: string, stack_limit: int option, interrupts: bool} - val attributes: params -> Thread.threadAttribute list - val fork: params -> (unit -> unit) -> Thread.thread - val join: Thread.thread -> unit - val interrupt_unsynchronized: Thread.thread -> unit + val attributes: params -> Thread.Thread.threadAttribute list + val fork: params -> (unit -> unit) -> T + val is_active: T -> bool + val join: T -> unit + val interrupt_unsynchronized: T -> unit end; structure Isabelle_Thread: ISABELLE_THREAD = struct +(* abstract type *) + +abstype T = T of {thread: Thread.Thread.thread, name: string, id: int} +with + val make = T; + fun dest (T args) = args; +end; + +val get_thread = #thread o dest; +val get_name = #name o dest; +val get_id = #id o dest; + +val equal = Thread.Thread.equal o apply2 get_thread; + +fun print t = + (case get_name t of "" => "ML" | a => "Isabelle." ^ a) ^ + "-" ^ string_of_int (get_id t); + + (* self *) -fun is_self thread = Thread.equal (Thread.self (), thread); - - -(* unique name *) +val make_id = Counter.make (); local - val name_var = Thread_Data.var () : string Thread_Data.var; - val count = Counter.make (); + val self_var = Thread_Data.var () : T Thread_Data.var; in -fun get_name () = - (case Thread_Data.get name_var of - SOME name => name - | NONE => raise Fail "Isabelle-specific thread required"); +fun set_self t = Thread_Data.put self_var (SOME t); -fun set_name base = - Thread_Data.put name_var (SOME ("Isabelle." ^ base ^ "-" ^ string_of_int (count ()))); +fun self () = + (case Thread_Data.get self_var of + SOME t => t + | NONE => + let val t = make {thread = Thread.Thread.self (), name = "", id = make_id ()} + in set_self t; t end); + +fun is_self t = equal (t, self ()); end; @@ -53,28 +78,31 @@ type params = {name: string, stack_limit: int option, interrupts: bool}; fun attributes ({stack_limit, interrupts, ...}: params) = - Thread.MaximumMLStack stack_limit :: + Thread.Thread.MaximumMLStack stack_limit :: Thread_Attributes.convert_attributes (if interrupts then Thread_Attributes.public_interrupts else Thread_Attributes.no_interrupts); fun fork (params: params) body = - Thread.fork (fn () => - Exn.trace General.exnMessage tracing (fn () => - (set_name (#name params); body ()) - handle exn => if Exn.is_interrupt exn then () (*sic!*) else Exn.reraise exn), - attributes params); + let + val name = #name params; + val id = make_id (); + fun main () = (set_self (make {thread = Thread.Thread.self (), name = name, id = id}); body ()); + val thread = Thread.Thread.fork (main, attributes params); + in make {thread = thread, name = name, id = id} end; (* join *) -fun join thread = - while Thread.isActive thread +val is_active = Thread.Thread.isActive o get_thread; + +fun join t = + while is_active t do OS.Process.sleep (seconds 0.1); (* interrupt *) -fun interrupt_unsynchronized thread = - Thread.interrupt thread handle Thread _ => (); +fun interrupt_unsynchronized t = + Thread.Thread.interrupt (get_thread t) handle Thread.Thread _ => (); end; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/multithreading.ML --- a/src/Pure/Concurrent/multithreading.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/multithreading.ML Mon Sep 11 22:59:34 2023 +0200 @@ -9,11 +9,12 @@ val max_threads: unit -> int val max_threads_update: int -> unit val parallel_proofs: int ref - val sync_wait: Time.time option -> ConditionVar.conditionVar -> Mutex.mutex -> bool Exn.result + val sync_wait: Time.time option -> Thread.ConditionVar.conditionVar -> Thread.Mutex.mutex -> + bool Exn.result val trace: int ref val tracing: int -> (unit -> string) -> unit val tracing_time: bool -> Time.time -> (unit -> string) -> unit - val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a + val synchronized: string -> Thread.Mutex.mutex -> (unit -> 'a) -> 'a end; structure Multithreading: MULTITHREADING = @@ -24,9 +25,9 @@ local fun num_processors () = - (case Thread.numPhysicalProcessors () of + (case Thread.Thread.numPhysicalProcessors () of SOME n => n - | NONE => Thread.numProcessors ()); + | NONE => Thread.Thread.numProcessors ()); fun max_threads_result m = if Thread_Data.is_virtual then 1 @@ -55,8 +56,8 @@ (Thread_Attributes.sync_interrupts (Thread_Attributes.get_attributes ())) (fn _ => (case time of - SOME t => Exn.Res (ConditionVar.waitUntil (cond, lock, t)) - | NONE => (ConditionVar.wait (cond, lock); Exn.Res true)) + SOME t => Exn.Res (Thread.ConditionVar.waitUntil (cond, lock, t)) + | NONE => (Thread.ConditionVar.wait (cond, lock); Exn.Res true)) handle exn => Exn.Exn exn); @@ -86,24 +87,24 @@ if ! trace > 0 then let val immediate = - if Mutex.trylock lock then true + if Thread.Mutex.trylock lock then true else let val _ = tracing 5 (fn () => name ^ ": locking ..."); val timer = Timer.startRealTimer (); - val _ = Mutex.lock lock; + val _ = Thread.Mutex.lock lock; val time = Timer.checkRealTimer timer; val _ = tracing_time true time (fn () => name ^ ": locked after " ^ Time.toString time); in false end; val result = Exn.capture (restore_attributes e) (); val _ = if immediate then () else tracing 5 (fn () => name ^ ": unlocking ..."); - val _ = Mutex.unlock lock; + val _ = Thread.Mutex.unlock lock; in result end else let - val _ = Mutex.lock lock; + val _ = Thread.Mutex.lock lock; val result = Exn.capture (restore_attributes e) (); - val _ = Mutex.unlock lock; + val _ = Thread.Mutex.unlock lock; in result end) ()); end; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/single_assignment.ML --- a/src/Pure/Concurrent/single_assignment.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/single_assignment.ML Mon Sep 11 22:59:34 2023 +0200 @@ -18,10 +18,10 @@ datatype 'a state = Set of 'a - | Unset of {lock: Mutex.mutex, cond: ConditionVar.conditionVar}; + | Unset of {lock: Thread.Mutex.mutex, cond: Thread.ConditionVar.conditionVar}; fun init_state () = - Unset {lock = Mutex.mutex (), cond = ConditionVar.conditionVar ()}; + Unset {lock = Thread.Mutex.mutex (), cond = Thread.ConditionVar.conditionVar ()}; abstype 'a var = Var of {name: string, state: 'a state Unsynchronized.ref} with @@ -62,7 +62,8 @@ Set _ => assign_fail name | Unset _ => Thread_Attributes.uninterruptible (fn _ => fn () => - (state := Set x; RunCall.clearMutableBit state; ConditionVar.broadcast cond)) ()))); + (state := Set x; RunCall.clearMutableBit state; + Thread.ConditionVar.broadcast cond)) ()))); end; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/synchronized.ML --- a/src/Pure/Concurrent/synchronized.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/synchronized.ML Mon Sep 11 22:59:34 2023 +0200 @@ -27,10 +27,10 @@ datatype 'a state = Immutable of 'a - | Mutable of {lock: Mutex.mutex, cond: ConditionVar.conditionVar, content: 'a}; + | Mutable of {lock: Thread.Mutex.mutex, cond: Thread.ConditionVar.conditionVar, content: 'a}; fun init_state x = - Mutable {lock = Mutex.mutex (), cond = ConditionVar.conditionVar (), content = x}; + Mutable {lock = Thread.Mutex.mutex (), cond = Thread.ConditionVar.conditionVar (), content = x}; fun immutable_fail name = raise Fail ("Illegal access to immutable value " ^ name); @@ -59,7 +59,7 @@ | Mutable _ => Thread_Attributes.uninterruptible (fn _ => fn () => (state := Immutable x; RunCall.clearMutableBit state; - ConditionVar.broadcast cond)) ()))); + Thread.ConditionVar.broadcast cond)) ()))); (* synchronized access *) @@ -83,7 +83,7 @@ | SOME (y, x') => Thread_Attributes.uninterruptible (fn _ => fn () => (state := Mutable {lock = lock, cond = cond, content = x'}; - ConditionVar.broadcast cond; SOME y)) ())); + Thread.ConditionVar.broadcast cond; SOME y)) ())); in try_change () end)); fun guarded_access var f = the (timed_access var (fn _ => NONE) f); diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/task_queue.ML --- a/src/Pure/Concurrent/task_queue.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/task_queue.ML Mon Sep 11 22:59:34 2023 +0200 @@ -35,16 +35,16 @@ val all_passive: queue -> bool val total_jobs: queue -> int val status: queue -> {ready: int, pending: int, running: int, passive: int, urgent: int} - val cancel: queue -> group -> Thread.thread list - val cancel_all: queue -> group list * Thread.thread list + val cancel: queue -> group -> Isabelle_Thread.T list + val cancel_all: queue -> group list * Isabelle_Thread.T list val finish: task -> queue -> bool * queue - val enroll: Thread.thread -> string -> group -> queue -> task * queue + val enroll: Isabelle_Thread.T -> string -> group -> queue -> task * queue val enqueue_passive: group -> string -> (unit -> bool) -> queue -> task * queue val enqueue: string -> group -> task list -> int -> (bool -> bool) -> queue -> task * queue val extend: task -> (bool -> bool) -> queue -> queue option - val dequeue_passive: Thread.thread -> task -> queue -> bool option * queue - val dequeue: Thread.thread -> bool -> queue -> (task * (bool -> bool) list) option * queue - val dequeue_deps: Thread.thread -> task list -> queue -> + val dequeue_passive: Isabelle_Thread.T -> task -> queue -> bool option * queue + val dequeue: Isabelle_Thread.T -> bool -> queue -> (task * (bool -> bool) list) option * queue + val dequeue_deps: Isabelle_Thread.T -> task list -> queue -> (((task * (bool -> bool) list) option * task list) * queue) end; @@ -88,7 +88,7 @@ the_list (! status) @ (case parent of NONE => [] | SOME group => group_status_unsynchronized group); -val lock = Mutex.mutex (); +val lock = Thread.Mutex.mutex (); fun SYNCHRONIZED e = Multithreading.synchronized "group_status" lock e; in @@ -224,7 +224,7 @@ datatype job = Job of (bool -> bool) list | - Running of Thread.thread | + Running of Isabelle_Thread.T | Passive of unit -> bool; type jobs = job Task_Graph.T; @@ -299,7 +299,7 @@ val _ = cancel_group group Exn.Interrupt; val running = Tasks.fold (fn task => - (case get_job jobs task of Running thread => insert Thread.equal thread | _ => I)) + (case get_job jobs task of Running thread => insert Isabelle_Thread.equal thread | _ => I)) (get_tasks groups (group_id group)) []; in running end; @@ -311,7 +311,7 @@ val _ = cancel_group group Exn.Interrupt; in (case job of - Running t => (insert eq_group group groups, insert Thread.equal t running) + Running t => (insert eq_group group groups, insert Isabelle_Thread.equal t running) | _ => (groups, running)) end; val running = Task_Graph.fold cancel_job jobs ([], []); diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Concurrent/timeout.ML --- a/src/Pure/Concurrent/timeout.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Concurrent/timeout.ML Mon Sep 11 22:59:34 2023 +0200 @@ -35,7 +35,7 @@ else Thread_Attributes.with_attributes Thread_Attributes.no_interrupts (fn orig_atts => let - val self = Thread.self (); + val self = Isabelle_Thread.self (); val start = Time.now (); val request = diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/json.scala --- a/src/Pure/General/json.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/json.scala Mon Sep 11 22:59:34 2023 +0200 @@ -41,11 +41,9 @@ /* lexer */ - object Kind extends Enumeration { - val KEYWORD, STRING, NUMBER, ERROR = this.Value - } + enum Kind { case KEYWORD, STRING, NUMBER, ERROR } - sealed case class Token(kind: Kind.Value, text: String) { + sealed case class Token(kind: Kind, text: String) { def is_keyword: Boolean = kind == Kind.KEYWORD def is_keyword(name: String): Boolean = kind == Kind.KEYWORD && text == name def is_string: Boolean = kind == Kind.STRING diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/json_api.scala --- a/src/Pure/General/json_api.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/json_api.scala Mon Sep 11 22:59:34 2023 +0200 @@ -69,7 +69,7 @@ sealed case class Links(json: JSON.T) { def get_next: Option[Service] = for { - JSON.Value.String(next) <- JSON.value(json, "next") + case JSON.Value.String(next) <- JSON.value(json, "next") if Url.is_wellformed(next) } yield new Service(Url(next)) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/mercurial.scala --- a/src/Pure/General/mercurial.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/mercurial.scala Mon Sep 11 22:59:34 2023 +0200 @@ -100,7 +100,7 @@ sealed case class Archive_Info(lines: List[String]) { def id: Option[String] = lines.collectFirst({ case Archive_Node(a) => a }) - def tags: List[String] = for (Archive_Tag(tag) <- lines if tag != "tip") yield tag + def tags: List[String] = for (case Archive_Tag(tag) <- lines if tag != "tip") yield tag } def archive_info(root: Path): Option[Archive_Info] = { diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/sql.scala --- a/src/Pure/General/sql.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/sql.scala Mon Sep 11 22:59:34 2023 +0200 @@ -95,26 +95,26 @@ /* types */ - object Type extends Enumeration { - val Boolean = Value("BOOLEAN") - val Int = Value("INTEGER") - val Long = Value("BIGINT") - val Double = Value("DOUBLE PRECISION") - val String = Value("TEXT") - val Bytes = Value("BLOB") - val Date = Value("TIMESTAMP WITH TIME ZONE") - } + enum Type { case Boolean, Int, Long, Double, String, Bytes, Date } - def sql_type_default(T: Type.Value): Source = T.toString + val sql_type_postgresql: Type => Source = + { + case Type.Boolean => "BOOLEAN" + case Type.Int => "INTEGER" + case Type.Long => "BIGINT" + case Type.Double => "DOUBLE PRECISION" + case Type.String => "TEXT" + case Type.Bytes => "BYTEA" + case Type.Date => "TIMESTAMP WITH TIME ZONE" + } - def sql_type_sqlite(T: Type.Value): Source = - if (T == Type.Boolean) "INTEGER" - else if (T == Type.Date) "TEXT" - else sql_type_default(T) - - def sql_type_postgresql(T: Type.Value): Source = - if (T == Type.Bytes) "BYTEA" - else sql_type_default(T) + val sql_type_sqlite: Type => Source = + { + case Type.Boolean => "INTEGER" + case Type.Bytes => "BLOB" + case Type.Date => "TEXT" + case t => sql_type_postgresql(t) + } /* columns */ @@ -138,7 +138,7 @@ sealed case class Column( name: String, - T: Type.Value, + T: Type, strict: Boolean = false, primary_key: Boolean = false, expr: SQL.Source = "" @@ -152,7 +152,7 @@ if (expr == "") SQL.ident(name) else enclose(expr) + " AS " + SQL.ident(name) - def decl(sql_type: Type.Value => Source): Source = + def decl(sql_type: Type => Source): Source = ident + " " + sql_type(T) + (if (strict || primary_key) " NOT NULL" else "") def defined: String = ident + " IS NOT NULL" @@ -194,7 +194,7 @@ def query_named: Source = query + " AS " + SQL.ident(name) - def create(sql_type: Type.Value => Source): Source = { + def create(sql_type: Type => Source): Source = { val primary_key = columns.filter(_.primary_key).map(_.name) match { case Nil => Nil @@ -407,7 +407,7 @@ /* types */ - def sql_type(T: Type.Value): Source + def sql_type(T: Type): Source /* connection */ @@ -627,7 +627,7 @@ override def now(): Date = Date.now() - def sql_type(T: SQL.Type.Value): SQL.Source = SQL.sql_type_sqlite(T) + def sql_type(T: SQL.Type): SQL.Source = SQL.sql_type_sqlite(T) def update_date(stmt: SQL.Statement, i: Int, date: Date): Unit = if (date == null) stmt.string(i) = (null: String) @@ -751,7 +751,7 @@ .getOrElse(error("Failed to get current date/time from database server " + toString)) } - def sql_type(T: SQL.Type.Value): SQL.Source = SQL.sql_type_postgresql(T) + def sql_type(T: SQL.Type): SQL.Source = SQL.sql_type_postgresql(T) // see https://jdbc.postgresql.org/documentation/head/8-date-time.html def update_date(stmt: SQL.Statement, i: Int, date: Date): Unit = diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/ssh.scala --- a/src/Pure/General/ssh.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/ssh.scala Mon Sep 11 22:59:34 2023 +0200 @@ -493,7 +493,7 @@ def isabelle_platform: Isabelle_Platform = Isabelle_Platform() - def isabelle_platform_family: Platform.Family.Value = + def isabelle_platform_family: Platform.Family = Platform.Family.parse(isabelle_platform.ISABELLE_PLATFORM_FAMILY) } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/symbol.scala --- a/src/Pure/General/symbol.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/symbol.scala Mon Sep 11 22:59:34 2023 +0200 @@ -286,13 +286,13 @@ /** defined symbols **/ - object Argument extends Enumeration { - val none, cartouche, space_cartouche = Value + object Argument { + def unapply(s: String): Option[Argument] = + try { Some(valueOf(s)) } + catch { case _: IllegalArgumentException => None} + } - def unapply(s: String): Option[Value] = - try { Some(withName(s)) } - catch { case _: NoSuchElementException => None} - } + enum Argument { case none, cartouche, space_cartouche } object Entry { private val Name = new Regex("""\\<\^?([A-Za-z][A-Za-z0-9_']*)>""") @@ -327,9 +327,10 @@ case _ => None } - val groups = proper_list(for ((Group.name, a) <- props) yield a).getOrElse(List("unsorted")) + val groups = + proper_list(for (case (Group.name, a) <- props) yield a).getOrElse(List("unsorted")) - val abbrevs = for ((Abbrev.name, a) <- props) yield a + val abbrevs = for (case (Abbrev.name, a) <- props) yield a new Entry(symbol, name, argument, code, Font.unapply(props), groups, abbrevs) } @@ -338,7 +339,7 @@ class Entry private( val symbol: Symbol, val name: String, - val argument: Symbol.Argument.Value, + val argument: Symbol.Argument, val code: Option[Int], val font: Option[String], val groups: List[String], diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/toml.scala --- a/src/Pure/General/toml.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/toml.scala Mon Sep 11 22:59:34 2023 +0200 @@ -133,11 +133,9 @@ /* lexer */ - object Kind extends Enumeration { - val KEYWORD, VALUE, STRING, MULTILINE_STRING, LINE_SEP, ERROR = Value - } + enum Kind { case KEYWORD, VALUE, STRING, MULTILINE_STRING, LINE_SEP, ERROR } - sealed case class Token(kind: Kind.Value, text: Str) { + sealed case class Token(kind: Kind, text: Str) { def is_keyword(name: Str): Bool = kind == Kind.KEYWORD && text == name def is_value: Bool = kind == Kind.VALUE def is_string: Bool = kind == Kind.STRING diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/General/word.scala --- a/src/Pure/General/word.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/General/word.scala Mon Sep 11 22:59:34 2023 +0200 @@ -25,44 +25,41 @@ def lowercase(str: String): String = str.toLowerCase(Locale.ROOT) def uppercase(str: String): String = str.toUpperCase(Locale.ROOT) - def capitalize(str: String): String = + def capitalized(str: String): String = if (str.length == 0) str else { val n = Character.charCount(str.codePointAt(0)) uppercase(str.substring(0, n)) + lowercase(str.substring(n)) } - def perhaps_capitalize(str: String): String = + def perhaps_capitalized(str: String): String = if (Codepoint.iterator(str).forall(c => Character.isLowerCase(c) || Character.isDigit(c))) - capitalize(str) + capitalized(str) else str - sealed abstract class Case - case object Lowercase extends Case - case object Uppercase extends Case - case object Capitalized extends Case - object Case { def apply(c: Case, str: String): String = c match { - case Lowercase => lowercase(str) - case Uppercase => uppercase(str) - case Capitalized => capitalize(str) + case Case.lowercase => Word.lowercase(str) + case Case.uppercase => Word.uppercase(str) + case Case.capitalized => Word.capitalized(str) } def unapply(str: String): Option[Case] = if (str.nonEmpty) { - if (Codepoint.iterator(str).forall(Character.isLowerCase)) Some(Lowercase) - else if (Codepoint.iterator(str).forall(Character.isUpperCase)) Some(Uppercase) + if (Codepoint.iterator(str).forall(Character.isLowerCase)) Some(Case.lowercase) + else if (Codepoint.iterator(str).forall(Character.isUpperCase)) Some(Case.uppercase) else { val it = Codepoint.iterator(str) if (Character.isUpperCase(it.next()) && it.forall(Character.isLowerCase)) - Some(Capitalized) + Some(Case.capitalized) else None } } else None } + enum Case { case lowercase, uppercase, capitalized } + /* sequence of words */ diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/ML/ml_init.ML --- a/src/Pure/ML/ml_init.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/ML/ml_init.ML Mon Sep 11 22:59:34 2023 +0200 @@ -19,8 +19,6 @@ val error_depth = PolyML.error_depth; -open Thread; - datatype illegal = Interrupt; structure Basic_Exn: BASIC_EXN = Exn; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/ML/ml_pp.ML --- a/src/Pure/ML/ml_pp.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/ML/ml_pp.ML Mon Sep 11 22:59:34 2023 +0200 @@ -8,6 +8,11 @@ struct val _ = + ML_system_pp (fn _ => fn _ => fn t => + PolyML.PrettyString ("")); + +val _ = ML_system_pp (fn _ => fn _ => Pretty.to_polyml o Proof_Display.pp_context); val _ = diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/PIDE/command.scala --- a/src/Pure/PIDE/command.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/PIDE/command.scala Mon Sep 11 22:59:34 2023 +0200 @@ -147,13 +147,13 @@ else other.rep.iterator.foldLeft(this)(_ + _) def redirection_iterator: Iterator[Document_ID.Generic] = - for (Markup_Index(_, Symbol.Text_Chunk.Id(id)) <- rep.keysIterator) + for (case Markup_Index(_, Symbol.Text_Chunk.Id(id)) <- rep.keysIterator) yield id def redirect(other_id: Document_ID.Generic): Markups = { val rep1 = (for { - (Markup_Index(status, Symbol.Text_Chunk.Id(id)), markup) <- rep.iterator + case (Markup_Index(status, Symbol.Text_Chunk.Id(id)), markup) <- rep.iterator if other_id == id } yield (Markup_Index(status, Symbol.Text_Chunk.Default), markup)).toMap if (rep1.isEmpty) Markups.empty else new Markups(rep1) @@ -500,13 +500,13 @@ def blobs_ok: Boolean = blobs.forall(Exn.the_res.isDefinedAt) def blobs_names: List[Document.Node.Name] = - for (Exn.Res(blob) <- blobs) yield blob.name + for (case Exn.Res(blob) <- blobs) yield blob.name def blobs_undefined: List[Document.Node.Name] = - for (Exn.Res(blob) <- blobs if blob.content.isEmpty) yield blob.name + for (case Exn.Res(blob) <- blobs if blob.content.isEmpty) yield blob.name def blobs_defined: List[(Document.Node.Name, SHA1.Digest)] = - for (Exn.Res(blob) <- blobs; (digest, _) <- blob.content) yield (blob.name, digest) + for (case Exn.Res(blob) <- blobs; (digest, _) <- blob.content) yield (blob.name, digest) def blobs_changed(doc_blobs: Document.Blobs): Boolean = blobs.exists({ case Exn.Res(blob) => doc_blobs.changed(blob.name) case _ => false }) @@ -518,7 +518,7 @@ val chunks: Map[Symbol.Text_Chunk.Name, Symbol.Text_Chunk] = ((Symbol.Text_Chunk.Default -> chunk) :: - (for (Exn.Res(blob) <- blobs; (_, file) <- blob.content) + (for (case Exn.Res(blob) <- blobs; (_, file) <- blob.content) yield blob.chunk_file -> file)).toMap def length: Int = source.length diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/PIDE/document.scala --- a/src/Pure/PIDE/document.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/PIDE/document.scala Mon Sep 11 22:59:34 2023 +0200 @@ -785,7 +785,7 @@ case some => Some(some) } } - for (Text.Info(r, Some(x)) <- cumulate(range, None, elements, result1, status)) + for (case Text.Info(r, Some(x)) <- cumulate(range, None, elements, result1, status)) yield Text.Info(r, x) } } @@ -1262,7 +1262,7 @@ val pending_edits1 = (for { change <- history.undo_list.takeWhile(_ != stable) - (name, Node.Edits(es)) <- change.rev_edits + case (name, Node.Edits(es)) <- change.rev_edits } yield (name -> es)).foldLeft(pending_edits)(_ + _) new Snapshot(this, version, node_name, pending_edits1, snippet_command) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/PIDE/document_status.scala --- a/src/Pure/PIDE/document_status.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/PIDE/document_status.scala Mon Sep 11 22:59:34 2023 +0200 @@ -230,9 +230,7 @@ /* nodes status */ - object Overall_Node_Status extends Enumeration { - val ok, failed, pending = Value - } + enum Overall_Node_Status { case ok, failed, pending } object Nodes_Status { val empty: Nodes_Status = new Nodes_Status(Map.empty, Document.Nodes.empty) @@ -259,7 +257,7 @@ case None => false } - def overall_node_status(name: Document.Node.Name): Overall_Node_Status.Value = + def overall_node_status(name: Document.Node.Name): Overall_Node_Status = rep.get(name) match { case Some(st) if st.consolidated => if (st.ok) Overall_Node_Status.ok else Overall_Node_Status.failed diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/PIDE/query_operation.scala --- a/src/Pure/PIDE/query_operation.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/PIDE/query_operation.scala Mon Sep 11 22:59:34 2023 +0200 @@ -9,11 +9,7 @@ object Query_Operation { - object Status extends Enumeration { - val WAITING = Value("waiting") - val RUNNING = Value("running") - val FINISHED = Value("finished") - } + enum Status { case waiting, running, finished } object State { val empty: State = State() @@ -22,7 +18,7 @@ State(instance = Document_ID.make().toString, location = Some(command), query = query, - status = Status.WAITING) + status = Status.waiting) } sealed case class State( @@ -31,7 +27,7 @@ query: List[String] = Nil, update_pending: Boolean = false, output: List[XML.Tree] = Nil, - status: Status.Value = Status.FINISHED, + status: Status = Status.finished, exec_id: Document_ID.Exec = Document_ID.none) } @@ -39,7 +35,7 @@ editor: Editor[Editor_Context], editor_context: Editor_Context, operation_name: String, - consume_status: Query_Operation.Status.Value => Unit, + consume_status: Query_Operation.Status => Unit, consume_output: (Document.Snapshot, Command.Results, XML.Body) => Unit ) { private val print_function = operation_name + "_query" @@ -76,7 +72,7 @@ val command_results = snapshot.command_results(cmd) val results = (for { - (_, elem @ XML.Elem(Markup(Markup.RESULT, props), _)) <- command_results.iterator + case (_, elem @ XML.Elem(Markup(Markup.RESULT, props), _)) <- command_results.iterator if props.contains((Markup.INSTANCE, state0.instance)) } yield elem).toList val removed = !snapshot.get_node(cmd.node_name).commands.contains(cmd) @@ -116,7 +112,7 @@ val new_output = for { - XML.Elem(_, List(XML.Elem(markup, body))) <- results + case XML.Elem(_, List(XML.Elem(markup, body))) <- results if Markup.messages.contains(markup.name) body1 = resolve_sendback(body) } yield Protocol.make_message(body1, markup.name, props = markup.properties) @@ -124,21 +120,20 @@ /* status */ - def get_status(name: String, status: Query_Operation.Status.Value) - : Option[Query_Operation.Status.Value] = + def get_status(name: String, status: Query_Operation.Status): Option[Query_Operation.Status] = results.collectFirst({ case XML.Elem(_, List(elem: XML.Elem)) if elem.name == name => status }) val new_status = - if (removed) Query_Operation.Status.FINISHED + if (removed) Query_Operation.Status.finished else - get_status(Markup.FINISHED, Query_Operation.Status.FINISHED) orElse - get_status(Markup.RUNNING, Query_Operation.Status.RUNNING) getOrElse - Query_Operation.Status.WAITING + get_status(Markup.FINISHED, Query_Operation.Status.finished) orElse + get_status(Markup.RUNNING, Query_Operation.Status.running) getOrElse + Query_Operation.Status.waiting /* state update */ - if (new_status == Query_Operation.Status.RUNNING) + if (new_status == Query_Operation.Status.running) results.collectFirst( { case XML.Elem(Markup(_, Position.Id(id)), List(elem: XML.Elem)) @@ -157,7 +152,7 @@ if (state0.status != new_status) { current_state.change(_.copy(status = new_status)) consume_status(new_status) - if (new_status == Query_Operation.Status.FINISHED) + if (new_status == Query_Operation.Status.finished) remove_overlay() } } @@ -214,7 +209,7 @@ state.location match { case Some(command) if state.update_pending || - (state.status != Query_Operation.Status.FINISHED && + (state.status != Query_Operation.Status.finished && changed.commands.contains(command)) => editor.send_dispatcher { content_update() } case _ => @@ -230,6 +225,6 @@ remove_overlay() current_state.change(_ => Query_Operation.State.empty) consume_output(Document.Snapshot.init, Command.Results.empty, Nil) - consume_status(Query_Operation.Status.FINISHED) + consume_status(Query_Operation.Status.finished) } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/PIDE/rendering.scala --- a/src/Pure/PIDE/rendering.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/PIDE/rendering.scala Mon Sep 11 22:59:34 2023 +0200 @@ -405,7 +405,7 @@ Some(snapshot.convert(info.range)) else None) }) - for (Text.Info(range, Some(range1)) <- result) + for (case Text.Info(range, Some(range1)) <- result) yield Text.Info(range, range1) } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/ROOT.ML diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/ROOT.scala diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/components.scala --- a/src/Pure/System/components.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/components.scala Mon Sep 11 22:59:34 2023 +0200 @@ -35,7 +35,7 @@ /* platforms */ - private val family_platforms: Map[Platform.Family.Value, List[String]] = + private val family_platforms: Map[Platform.Family, List[String]] = Map( Platform.Family.linux_arm -> List("arm64-linux", "arm64_32-linux"), Platform.Family.linux -> List("x86_64-linux", "x86_64_32-linux"), @@ -47,7 +47,7 @@ private val platform_names: Set[String] = Set("x86-linux", "x86-cygwin") ++ family_platforms.iterator.flatMap(_._2) - def platform_purge(platforms: List[Platform.Family.Value]): String => Boolean = { + def platform_purge(platforms: List[Platform.Family]): String => Boolean = { val preserve = (for { family <- platforms.iterator @@ -91,7 +91,7 @@ def clean( component_dir: Path, - platforms: List[Platform.Family.Value] = Platform.Family.list, + platforms: List[Platform.Family] = Platform.Family.list, ssh: SSH.System = SSH.Local, progress: Progress = new Progress ): Unit = { @@ -108,7 +108,7 @@ def clean_base( base_dir: Path, - platforms: List[Platform.Family.Value] = Platform.Family.list, + platforms: List[Platform.Family] = Platform.Family.list, ssh: SSH.System = SSH.Local, progress: Progress = new Progress ): Unit = { @@ -124,7 +124,7 @@ name: String, target_dir: Option[Path] = None, copy_dir: Option[Path] = None, - clean_platforms: Option[List[Platform.Family.Value]] = None, + clean_platforms: Option[List[Platform.Family]] = None, clean_archives: Boolean = false, component_repository: String = Components.static_component_repository, ssh: SSH.System = SSH.Local, diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/executable.scala --- a/src/Pure/System/executable.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/executable.scala Mon Sep 11 22:59:34 2023 +0200 @@ -31,7 +31,7 @@ if (Platform.is_macos) { val Pattern = """^\s*(/.+)\s+\(.*\)$""".r for { - Pattern(lib) <- ldd_lines + case Pattern(lib) <- ldd_lines if !lib.startsWith("@executable_path/") && filter(lib_name(lib)) } yield lib } @@ -42,7 +42,7 @@ case None => "" case Some(path) => path.absolute.implode } - for { Pattern(lib) <- ldd_lines if filter(lib_name(lib)) } + for { case Pattern(lib) <- ldd_lines if filter(lib_name(lib)) } yield prefix + lib } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/isabelle_system.scala --- a/src/Pure/System/isabelle_system.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/isabelle_system.scala Mon Sep 11 22:59:34 2023 +0200 @@ -481,7 +481,7 @@ (entry, result) } for { - (entry, Some(res)) <- items + case (entry, Some(res)) <- items if !entry.isDirectory t <- Option(entry.getLastModifiedTime) } Files.setLastModifiedTime(res, t) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/message_channel.ML --- a/src/Pure/System/message_channel.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/message_channel.ML Mon Sep 11 22:59:34 2023 +0200 @@ -17,7 +17,7 @@ datatype message = Shutdown | Message of XML.body list; -datatype T = Message_Channel of {mbox: message Mailbox.T, thread: Thread.thread}; +datatype T = Message_Channel of {mbox: message Mailbox.T, thread: Isabelle_Thread.T}; fun shutdown (Message_Channel {mbox, thread}) = (Mailbox.send mbox Shutdown; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/options.scala --- a/src/Pure/System/options.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/options.scala Mon Sep 11 22:59:34 2023 +0200 @@ -117,7 +117,7 @@ case word :: rest if word == strip => rest case _ => words } - Word.implode(words1.map(Word.perhaps_capitalize)) + Word.implode(words1.map(Word.perhaps_capitalized)) } def title_jedit: String = title("jedit") diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/other_isabelle.scala --- a/src/Pure/System/other_isabelle.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/other_isabelle.scala Mon Sep 11 22:59:34 2023 +0200 @@ -89,7 +89,7 @@ def resolve_components( echo: Boolean = false, - clean_platforms: Option[List[Platform.Family.Value]] = None, + clean_platforms: Option[List[Platform.Family]] = None, clean_archives: Boolean = false, component_repository: String = Components.static_component_repository ): Unit = { @@ -152,7 +152,7 @@ other_settings: List[String] = init_components(), fresh: Boolean = false, echo: Boolean = false, - clean_platforms: Option[List[Platform.Family.Value]] = None, + clean_platforms: Option[List[Platform.Family]] = None, clean_archives: Boolean = false, component_repository: String = Components.static_component_repository ): Unit = { diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/platform.scala --- a/src/Pure/System/platform.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/platform.scala Mon Sep 11 22:59:34 2023 +0200 @@ -17,38 +17,42 @@ def is_arm: Boolean = cpu_arch.startsWith("arm") - def family: Family.Value = + def family: Family = if (is_linux && is_arm) Family.linux_arm else if (is_linux) Family.linux else if (is_macos) Family.macos else if (is_windows) Family.windows else error("Failed to determine current platform family") - object Family extends Enumeration { - val linux_arm, linux, macos, windows = Value - val list0: List[Value] = List(linux, windows, macos) - val list: List[Value] = List(linux, linux_arm, windows, macos) + object Family { + val list0: List[Family] = List(Family.linux, Family.windows, Family.macos) + val list: List[Family] = List(Family.linux, Family.linux_arm, Family.windows, Family.macos) - def unapply(name: String): Option[Value] = - try { Some(withName(name)) } - catch { case _: NoSuchElementException => None } + def unapply(name: String): Option[Family] = + try { Some(Family.valueOf(name)) } + catch { case _: IllegalArgumentException => None } - def parse(name: String): Value = + def parse(name: String): Family = unapply(name) getOrElse error("Bad platform family: " + quote(name)) - def standard(platform: Value): String = - if (platform == linux_arm) "arm64-linux" - else if (platform == linux) "x86_64-linux" - else if (platform == macos) "x86_64-darwin" - else if (platform == windows) "x86_64-cygwin" - else error("Bad platform family: " + quote(platform.toString)) + val standard: Family => String = + { + case Family.linux_arm => "arm64-linux" + case Family.linux => "x86_64-linux" + case Family.macos => "x86_64-darwin" + case Family.windows => "x86_64-cygwin" + } - def native(platform: Value): String = - if (platform == macos) "arm64-darwin" - else if (platform == windows) "x86_64-windows" - else standard(platform) + val native: Family => String = + { + case Family.macos => "arm64-darwin" + case Family.windows => "x86_64-windows" + case platform => standard(platform) + } } + enum Family { case linux_arm, linux, macos, windows } + /* platform identifiers */ diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/progress.scala --- a/src/Pure/System/progress.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/progress.scala Mon Sep 11 22:59:34 2023 +0200 @@ -18,9 +18,9 @@ sealed abstract class Output { def message: Message } - object Kind extends Enumeration { val writeln, warning, error_message = Value } + enum Kind { case writeln, warning, error_message } sealed case class Message( - kind: Kind.Value, + kind: Kind, text: String, verbose: Boolean = false ) extends Output { @@ -157,7 +157,7 @@ SortedMap.from[Long, Message], { res => val serial = res.long(Messages.serial) - val kind = Kind(res.int(Messages.kind)) + val kind = Kind.fromOrdinal(res.int(Messages.kind)) val text = res.string(Messages.text) val verbose = res.bool(Messages.verbose) serial -> Message(kind, text, verbose = verbose) @@ -173,7 +173,7 @@ for ((serial, message) <- messages) yield { (stmt: SQL.Statement) => stmt.long(1) = context stmt.long(2) = serial - stmt.int(3) = message.kind.id + stmt.int(3) = message.kind.ordinal stmt.string(4) = message.text stmt.bool(5) = message.verbose }) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/System/scala.scala --- a/src/Pure/System/scala.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/System/scala.scala Mon Sep 11 22:59:34 2023 +0200 @@ -102,11 +102,10 @@ object Compiler { object Message { - object Kind extends Enumeration { - val error, warning, info, other = Value - } + enum Kind { case error, warning, info, other } + private val Header = """^--.* (Error|Warning|Info): .*$""".r - val header_kind: String => Kind.Value = + val header_kind: String => Kind = { case "Error" => Kind.error case "Warning" => Kind.warning @@ -139,7 +138,7 @@ } } - sealed case class Message(kind: Message.Kind.Value, text: String) + sealed case class Message(kind: Message.Kind, text: String) { def is_error: Boolean = kind == Message.Kind.error override def toString: String = text @@ -275,9 +274,7 @@ /* invoke function */ - object Tag extends Enumeration { - val NULL, OK, ERROR, FAIL, INTERRUPT = Value - } + enum Tag { case NULL, OK, ERROR, FAIL, INTERRUPT } def function_thread(name: String): Boolean = functions.find(fun => fun.name == name) match { @@ -285,7 +282,7 @@ case None => false } - def function_body(session: Session, name: String, args: List[Bytes]): (Tag.Value, List[Bytes]) = + def function_body(session: Session, name: String, args: List[Bytes]): (Tag, List[Bytes]) = functions.find(fun => fun.name == name) match { case Some(fun) => Exn.capture { fun.invoke(session, args) } match { @@ -312,10 +309,11 @@ futures = Map.empty } - private def result(id: String, tag: Scala.Tag.Value, res: List[Bytes]): Unit = + private def result(id: String, tag: Scala.Tag, res: List[Bytes]): Unit = synchronized { if (futures.isDefinedAt(id)) { - session.protocol_command_raw("Scala.result", Bytes(id) :: Bytes(tag.id.toString) :: res) + session.protocol_command_raw( + "Scala.result", Bytes(id) :: Bytes(tag.ordinal.toString) :: res) futures -= id } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Thy/bibtex.scala --- a/src/Pure/Thy/bibtex.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Thy/bibtex.scala Mon Sep 11 22:59:34 2023 +0200 @@ -132,11 +132,11 @@ case (Error(msg, Value.Int(l)), _) => Some((true, (msg, get_line_pos(l)))) case (Warning_in_Chunk(msg, name), _) if chunk_pos.isDefinedAt(name) => - Some((false, (Word.capitalize(msg) + " in entry " + quote(name), chunk_pos(name)))) + Some((false, (Word.capitalized(msg) + " in entry " + quote(name), chunk_pos(name)))) case (Warning(msg), Warning_Line(Value.Int(l))) => - Some((false, (Word.capitalize(msg), get_line_pos(l)))) + Some((false, (Word.capitalized(msg), get_line_pos(l)))) case (Warning(msg), _) => - Some((false, (Word.capitalize(msg), Position.none))) + Some((false, (Word.capitalized(msg), Position.none))) case _ => None } ).partition(_._1) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Thy/export.scala --- a/src/Pure/Thy/export.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Thy/export.scala Mon Sep 11 22:59:34 2023 +0200 @@ -379,10 +379,10 @@ yield name -> store.try_open_database(name, server_mode = false) attempts.collectFirst({ case (name, None) => name }) match { case Some(bad) => - for ((_, Some(db)) <- attempts) db.close() + for (case (_, Some(db)) <- attempts) db.close() store.error_database(bad) case None => - for ((name, Some(db)) <- attempts) yield { + for (case (name, Some(db)) <- attempts) yield { new Session_Database(name, db) { override def close(): Unit = this.db.close() } } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Thy/export_theory.scala --- a/src/Pure/Thy/export_theory.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Thy/export_theory.scala Mon Sep 11 22:59:34 2023 +0200 @@ -239,14 +239,12 @@ /* approximative syntax */ - object Assoc extends Enumeration { - val NO_ASSOC, LEFT_ASSOC, RIGHT_ASSOC = Value - } + enum Assoc { case NO_ASSOC, LEFT_ASSOC, RIGHT_ASSOC } sealed abstract class Syntax case object No_Syntax extends Syntax case class Prefix(delim: String) extends Syntax - case class Infix(assoc: Assoc.Value, delim: String, pri: Int) extends Syntax + case class Infix(assoc: Assoc, delim: String, pri: Int) extends Syntax def decode_syntax: XML.Decode.T[Syntax] = XML.Decode.variant(List( @@ -255,7 +253,7 @@ { case (Nil, body) => import XML.Decode._ val (ass, delim, pri) = triple(int, string, int)(body) - Infix(Assoc(ass), delim, pri) })) + Infix(Assoc.fromOrdinal(ass), delim, pri) })) /* types */ diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Thy/html.scala --- a/src/Pure/Thy/html.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Thy/html.scala Mon Sep 11 22:59:34 2023 +0200 @@ -151,7 +151,7 @@ def check_control_blocks(body: XML.Body): Boolean = { var ok = true var open = List.empty[Symbol.Symbol] - for { XML.Text(text) <- body; sym <- Symbol.iterator(text) } { + for { case XML.Text(text) <- body; sym <- Symbol.iterator(text) } { if (is_control_block_begin(sym)) open ::= sym else if (is_control_block_end(sym)) { open match { @@ -355,15 +355,13 @@ /* GUI layout */ object Wrap_Panel { - object Alignment extends Enumeration { - val left, right, center = Value - } + enum Alignment { case left, right, center } def apply( contents: List[XML.Elem], name: String = "", action: String = "", - alignment: Alignment.Value = Alignment.right + alignment: Alignment = Alignment.right ): XML.Elem = { val body = Library.separate(XML.Text(" "), contents) GUI.form(List(div(body) + ("style" -> ("text-align: " + alignment))), diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Thy/latex.scala --- a/src/Pure/Thy/latex.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Thy/latex.scala Mon Sep 11 22:59:34 2023 +0200 @@ -93,9 +93,7 @@ /* tags */ object Tags { - object Op extends Enumeration { - val fold, drop, keep = Value - } + enum Op { case fold, drop, keep } val standard = "document,theory,proof,ML,visible,-invisible,important,unimportant" @@ -103,7 +101,7 @@ def apply(spec: String): Tags = new Tags(spec, - (explode(standard) ::: explode(spec)).foldLeft(TreeMap.empty[String, Op.Value]) { + (explode(standard) ::: explode(spec)).foldLeft(TreeMap.empty[String, Op]) { case (m, tag) => tag.toList match { case '/' :: cs => m + (cs.mkString -> Op.fold) @@ -116,10 +114,10 @@ val empty: Tags = apply("") } - class Tags private(spec: String, map: TreeMap[String, Tags.Op.Value]) { + class Tags private(spec: String, map: TreeMap[String, Tags.Op]) { override def toString: String = spec - def get(name: String): Option[Tags.Op.Value] = map.get(name) + def get(name: String): Option[Tags.Op] = map.get(name) def sty(comment_latex: Boolean): File.Content = { val path = Path.explode("isabelletags.sty") diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/build.scala --- a/src/Pure/Tools/build.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/build.scala Mon Sep 11 22:59:34 2023 +0200 @@ -753,7 +753,7 @@ val results = Command.Results.make( - for (elem @ XML.Elem(Markup(_, Markup.Serial(i)), _) <- read_xml(Export.MESSAGES)) + for (case elem@XML.Elem(Markup(_, Markup.Serial(i)), _) <- read_xml(Export.MESSAGES)) yield i -> elem) val command = diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/build_cluster.scala --- a/src/Pure/Tools/build_cluster.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/build_cluster.scala Mon Sep 11 22:59:34 2023 +0200 @@ -263,7 +263,7 @@ _sessions } else { - for (Exn.Res(session) <- attempts) session.close() + for (case Exn.Res(session) <- attempts) session.close() error("Failed to connect build cluster") } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/check_keywords.scala --- a/src/Pure/Tools/check_keywords.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/check_keywords.scala Mon Sep 11 22:59:34 2023 +0200 @@ -22,7 +22,7 @@ val result = parse_all(rep(item), Token.reader(Token.explode(keywords, input), start)) match { - case Success(res, _) => for (Some(x) <- res) yield x + case Success(res, _) => for (case Some(x) <- res) yield x case bad => error(bad.toString) } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/debugger.ML --- a/src/Pure/Tools/debugger.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/debugger.ML Mon Sep 11 22:59:34 2023 +0200 @@ -22,7 +22,7 @@ if msg = "" then () else Output.protocol_message - (Markup.debugger_output (Isabelle_Thread.get_name ())) + (Markup.debugger_output (Isabelle_Thread.print (Isabelle_Thread.self ()))) [[XML.Text (Markup.markup (kind, Markup.serial_properties (serial ())) msg)]]; val writeln_message = output_message Markup.writelnN; @@ -87,7 +87,8 @@ val is_debugging = not o null o get_debugging; fun with_debugging e = - Thread_Data.setmp debugging_var (SOME (PolyML.DebuggerInterface.debugState (Thread.self ()))) e (); + Thread_Data.setmp debugging_var + (SOME (PolyML.DebuggerInterface.debugState (Thread.Thread.self ()))) e (); fun the_debug_state thread_name index = (case get_debugging () of @@ -110,7 +111,7 @@ fun is_stepping () = let - val stack = PolyML.DebuggerInterface.debugState (Thread.self ()); + val stack = PolyML.DebuggerInterface.debugState (Thread.Thread.self ()); val Stepping (stepping, depth) = get_stepping (); in stepping andalso (depth < 0 orelse length stack <= depth) end; @@ -250,7 +251,7 @@ (SOME (fn (_, break) => if not (is_debugging ()) andalso (! break orelse is_break () orelse is_stepping ()) then - (case try Isabelle_Thread.get_name () of + (case try (Isabelle_Thread.print o Isabelle_Thread.self) () of SOME thread_name => debugger_loop thread_name | NONE => ()) else ())))); diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/dotnet_setup.scala --- a/src/Pure/Tools/dotnet_setup.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/dotnet_setup.scala Mon Sep 11 22:59:34 2023 +0200 @@ -11,7 +11,7 @@ /* platforms */ sealed case class Platform_Info( - family: Platform.Family.Value, + family: Platform.Family, name: String, os: String = "", arch: String = "x64", diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/dump.scala --- a/src/Pure/Tools/dump.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/dump.scala Mon Sep 11 22:59:34 2023 +0200 @@ -152,12 +152,6 @@ val session_graph = deps.sessions_structure.build_graph val all_sessions = session_graph.topological_order - val afp_sessions = - (for (name <- all_sessions if session_info(name).is_afp) yield name).toSet - - val afp_bulky_sessions = - (for (name <- all_sessions if session_info(name).is_afp_bulky) yield name).toList - val base_sessions = session_graph.all_preds_rev(List(logic).filter(session_graph.defined)) @@ -187,25 +181,12 @@ val main = make_session( session_graph.topological_order.filterNot(name => - afp_sessions.contains(name) || base_sessions.contains(name) || proof_sessions.contains(name))) val proofs = make_session(proof_sessions, session_logic = PURE, record_proofs = true) - val afp = - if (afp_sessions.isEmpty) Nil - else { - val (part1, part2) = { - val graph = session_graph.restrict(afp_sessions -- afp_bulky_sessions) - val force_partition1 = AFP.force_partition1.filter(graph.defined) - val force_part1 = graph.all_preds(graph.all_succs(force_partition1)).toSet - graph.keys.partition(a => force_part1(a) || graph.is_isolated(a)) - } - List(part1, part2, afp_bulky_sessions).flatMap(make_session(_)) - } - - proofs ::: base ::: main ::: afp + proofs ::: base ::: main } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/phabricator.scala --- a/src/Pure/Tools/phabricator.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/phabricator.scala Mon Sep 11 22:59:34 2023 +0200 @@ -841,7 +841,7 @@ /* repository information */ sealed case class Repository( - vcs: VCS.Value, + vcs: VCS, id: Long, phid: String, name: String, @@ -853,12 +853,11 @@ def is_hg: Boolean = vcs == VCS.hg } - object VCS extends Enumeration { - val hg, git, svn = Value - def read(s: String): Value = - try { withName(s) } - catch { case _: java.util.NoSuchElementException => error("Unknown vcs type " + quote(s)) } - } + enum VCS { case hg, git, svn } + + def read_vcs(s: String): VCS = + try { VCS.valueOf(s) } + catch { case _: IllegalArgumentException => error("Unknown vcs type " + quote(s)) } def edits(typ: String, value: JSON.T): List[JSON.Object.T] = List(JSON.Object("type" -> typ, "value" -> value)) @@ -999,7 +998,7 @@ importing <- JSON.bool(fields, "isImporting") } yield { - val vcs = API.VCS.read(vcs_name) + val vcs = API.read_vcs(vcs_name) val url_path = if (short_name.isEmpty) "/diffusion/" + id else "/source/" + short_name val ssh_url = @@ -1024,7 +1023,7 @@ short_name: String = "", // unique name description: String = "", public: Boolean = false, - vcs: API.VCS.Value = API.VCS.hg + vcs: API.VCS = API.VCS.hg ): API.Repository = { require(name.nonEmpty, "bad repository name") diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/prismjs.scala --- a/src/Pure/Tools/prismjs.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/prismjs.scala Mon Sep 11 22:59:34 2023 +0200 @@ -27,7 +27,7 @@ val components_json = JSON.parse(File.read(components_path)) JSON.value(components_json, "languages") match { case Some(JSON.Object(langs)) => - (for ((name, JSON.Object(info)) <- langs.iterator if name != "meta") yield { + (for (case (name, JSON.Object(info)) <- langs.iterator if name != "meta") yield { val alias = JSON.Value.List.unapply(info.getOrElse("alias", Nil), JSON.Value.String.unapply) .getOrElse(Nil) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/profiling_report.scala --- a/src/Pure/Tools/profiling_report.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/profiling_report.scala Mon Sep 11 22:59:34 2023 +0200 @@ -30,7 +30,7 @@ thy <- used_theories.iterator if theories.isEmpty || theories.contains(thy) snapshot <- Build.read_theory(session_context.theory(thy)).iterator - (Protocol.ML_Profiling(report), _) <- snapshot.messages.iterator + case (Protocol.ML_Profiling(report), _) <- snapshot.messages.iterator } yield if (clean_name) report.clean_name else report).toList for (report <- ML_Profiling.account(reports)) progress.echo(report.print) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/server.scala --- a/src/Pure/Tools/server.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/server.scala Mon Sep 11 22:59:34 2023 +0200 @@ -91,29 +91,29 @@ case _ => JSON.Object.empty } - object Reply extends Enumeration { - val OK, ERROR, FINISHED, FAILED, NOTE = Value - + object Reply { def message(msg: String, kind: String = ""): JSON.Object.T = JSON.Object(Markup.KIND -> proper_string(kind).getOrElse(Markup.WRITELN), "message" -> msg) def error_message(msg: String): JSON.Object.T = message(msg, kind = Markup.ERROR) - def unapply(msg: String): Option[(Reply.Value, Any)] = { + def unapply(msg: String): Option[(Reply, Any)] = { if (msg == "") None else { val (name, argument) = Argument.split(msg) for { reply <- - try { Some(withName(name)) } - catch { case _: NoSuchElementException => None } + try { Some(Reply.valueOf(name)) } + catch { case _: IllegalArgumentException => None } arg <- Argument.unapply(argument) } yield (reply, arg) } } } + enum Reply { case OK, ERROR, FINISHED, FAILED, NOTE } + /* handler: port, password, thread */ @@ -194,7 +194,7 @@ def write_byte_message(chunks: List[Bytes]): Unit = out_lock.synchronized { Byte_Message.write_message(out, chunks) } - def reply(r: Reply.Value, arg: Any): Unit = { + def reply(r: Reply, arg: Any): Unit = { val argument = Argument.print(arg) write_line_message(if (argument == "") r.toString else r.toString + " " + argument) } @@ -216,7 +216,7 @@ def command_list: List[String] = command_table.keys.toList.sorted - def reply(r: Reply.Value, arg: Any): Unit = connection.reply(r, arg) + def reply(r: Reply, arg: Any): Unit = connection.reply(r, arg) def notify(arg: Any): Unit = connection.notify(arg) def message(kind: String, msg: String, more: JSON.Object.Entry*): Unit = notify(Reply.message(msg, kind = kind) ++ more) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/simplifier_trace.scala --- a/src/Pure/Tools/simplifier_trace.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/simplifier_trace.scala Mon Sep 11 22:59:34 2023 +0200 @@ -208,7 +208,7 @@ def purge(queue: Vector[Long]): Unit = queue match { case s +: rest => - for (Item(Markup.SIMP_TRACE_STEP, data) <- results.get(s)) + for (case Item(Markup.SIMP_TRACE_STEP, data) <- results.get(s)) memory -= Index.of_data(data) val children = memory_children.getOrElse(s, Set.empty) memory_children -= s diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/spell_checker.scala --- a/src/Pure/Tools/spell_checker.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/spell_checker.scala Mon Sep 11 22:59:34 2023 +0200 @@ -129,7 +129,7 @@ val permanent_updates = if (dictionary.user_path.is_file) for { - Spell_Checker.Decl(word, include) <- split_lines(File.read(dictionary.user_path)) + case Spell_Checker.Decl(word, include) <- split_lines(File.read(dictionary.user_path)) } yield (word, Spell_Checker.Update(include, true)) else Nil @@ -201,7 +201,7 @@ def check(word: String): Boolean = word match { - case Word.Case(c) if c != Word.Lowercase => + case Word.Case(c) if c != Word.Case.lowercase => contains(word) || contains(Word.lowercase(word)) case _ => contains(word) @@ -231,7 +231,7 @@ } val result = word_case match { - case Some(c) if c != Word.Lowercase => + case Some(c) if c != Word.Case.lowercase => suggestions(word) orElse suggestions(Word.lowercase(word)) case _ => suggestions(word) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/Tools/task_statistics.scala --- a/src/Pure/Tools/task_statistics.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/Tools/task_statistics.scala Mon Sep 11 22:59:34 2023 +0200 @@ -29,7 +29,7 @@ def chart(bins: Int = 100): JFreeChart = { val values = new Array[Double](task_statistics.length) - for ((Run(x), i) <- task_statistics.iterator.zipWithIndex) + for (case (Run(x), i) <- task_statistics.iterator.zipWithIndex) values(i) = java.lang.Math.log10((x max 1).toDouble / 1000000) val data = new HistogramDataset diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Pure/unify.ML --- a/src/Pure/unify.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Pure/unify.ML Mon Sep 11 22:59:34 2023 +0200 @@ -15,7 +15,7 @@ val search_bound: int Config.T val trace_simp: bool Config.T val trace_types: bool Config.T - val hounifiers: Context.generic * Envir.env * ((term * term) list) -> + val hounifiers: (string * typ) list -> Context.generic * Envir.env * ((term * term) list) -> (Envir.env * (term * term) list) Seq.seq val unifiers: Context.generic * Envir.env * ((term * term) list) -> (Envir.env * (term * term) list) Seq.seq @@ -581,7 +581,8 @@ (*Unify the dpairs in the environment. Returns flex-flex disagreement pairs NOT IN normal form. SIMPL may raise exception CANTUNIFY. *) -fun hounifiers (context, env, tus : (term * term) list) : (Envir.env * (term * term) list) Seq.seq = +fun hounifiers binders (context, env, tus : (term * term) list) + : (Envir.env * (term * term) list) Seq.seq = let val trace_bound = Config.get_generic context trace_bound; val search_bound = Config.get_generic context search_bound; @@ -611,13 +612,13 @@ (if tdepth > trace_bound andalso Context_Position.is_visible_generic context then tracing "Failure node" else (); Seq.pull reseq)); - val dps = map (fn (t, u) => ([], t, u)) tus; + val dps = map (fn (t, u) => (binders, t, u)) tus; in add_unify 1 ((env, dps), Seq.empty) end; fun unifiers (params as (context, env, tus)) = Seq.cons (fold (Pattern.unify context) tus env, []) Seq.empty handle Pattern.Unif => Seq.empty - | Pattern.Pattern => hounifiers params; + | Pattern.Pattern => hounifiers [] params; (*For smash_flexflex1*) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Code/code_scala.ML --- a/src/Tools/Code/code_scala.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Code/code_scala.ML Mon Sep 11 22:59:34 2023 +0200 @@ -70,7 +70,7 @@ | print_tupled_typ tyvars (tys, ty) = concat [enum "," "(" ")" (map (print_typ tyvars NOBR) tys), str "=>", print_typ tyvars NOBR ty]; - fun constraint p1 p2 = Pretty.block [p1, str ":", Pretty.brk 1, p2]; + fun constraint p1 p2 = Pretty.block [p1, str " : ", p2]; fun print_var vars NONE = str "_" | print_var vars (SOME v) = (str o lookup_var vars) v; fun applify_dict tyvars (Dict (_, d)) = applify_plain_dict tyvars d diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Graphview/layout.scala --- a/src/Tools/Graphview/layout.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Graphview/layout.scala Mon Sep 11 22:59:34 2023 +0200 @@ -400,13 +400,13 @@ output_graph.get_node(Layout.Node(node)) def nodes_iterator: Iterator[Layout.Info] = - for ((_: Layout.Node, (info, _)) <- output_graph.iterator) yield info + for (case (_: Layout.Node, (info, _)) <- output_graph.iterator) yield info /* dummies */ def dummies_iterator: Iterator[Layout.Info] = - for ((_: Layout.Dummy, (info, _)) <- output_graph.iterator) yield info + for (case (_: Layout.Dummy, (info, _)) <- output_graph.iterator) yield info def dummies_iterator(edge: Graph_Display.Edge): Iterator[Layout.Info] = new Iterator[Layout.Info] { diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Graphview/model.scala --- a/src/Tools/Graphview/model.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Graphview/model.scala Mon Sep 11 22:59:34 2023 +0200 @@ -20,12 +20,12 @@ def apply(): List[Mutator.Info] = _mutators def apply(mutators: List[Mutator.Info]): Unit = { _mutators = mutators - events.event(Mutator_Event.New_List(mutators)) + events.event(Mutator_Event.Message.New_List(mutators)) } def add(mutator: Mutator.Info): Unit = { _mutators = _mutators ::: List(mutator) - events.event(Mutator_Event.Add(mutator)) + events.event(Mutator_Event.Message.Add(mutator)) } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Graphview/mutator_dialog.scala --- a/src/Tools/Graphview/mutator_dialog.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Graphview/mutator_dialog.scala Mon Sep 11 22:59:34 2023 +0200 @@ -37,8 +37,8 @@ container.events += { - case Mutator_Event.Add(m) => add_panel(new Mutator_Panel(m)) - case Mutator_Event.New_List(ms) => panels = get_panels(ms) + case Mutator_Event.Message.Add(m) => add_panel(new Mutator_Panel(m)) + case Mutator_Event.Message.New_List(ms) => panels = get_panels(ms) } override def open(): Unit = { diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Graphview/mutator_event.scala --- a/src/Tools/Graphview/mutator_event.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Graphview/mutator_event.scala Mon Sep 11 22:59:34 2023 +0200 @@ -12,11 +12,12 @@ object Mutator_Event { - sealed abstract class Message - case class Add(m: Mutator.Info) extends Message - case class New_List(m: List[Mutator.Info]) extends Message + enum Message { + case Add(m: Mutator.Info) extends Message + case New_List(m: List[Mutator.Info]) extends Message + } - type Receiver = PartialFunction[Message, Unit] + type Receiver = Message => Unit class Bus { private val receivers = Synchronized[List[Receiver]](Nil) @@ -25,4 +26,4 @@ def -= (r: Receiver): Unit = receivers.change(Library.remove(r)) def event(x: Message): Unit = receivers.value.reverse.foreach(r => r(x)) } -} \ No newline at end of file +} diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Metis/PortableIsabelle.sml --- a/src/Tools/Metis/PortableIsabelle.sml Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Metis/PortableIsabelle.sml Mon Sep 11 22:59:34 2023 +0200 @@ -13,7 +13,7 @@ fun pointerEqual (x : 'a, y : 'a) = pointer_eq (x, y) local - val lock = Mutex.mutex (); + val lock = Thread.Mutex.mutex (); in fun critical e () = Multithreading.synchronized "metis" lock e end; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/Metis/metis.ML --- a/src/Tools/Metis/metis.ML Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/Metis/metis.ML Mon Sep 11 22:59:34 2023 +0200 @@ -154,7 +154,7 @@ fun pointerEqual (x : 'a, y : 'a) = pointer_eq (x, y) local - val lock = Mutex.mutex (); + val lock = Thread.Mutex.mutex (); in fun critical e () = Multithreading.synchronized "metis" lock e end; diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/VSCode/src/component_vscodium.scala --- a/src/Tools/VSCode/src/component_vscodium.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/VSCode/src/component_vscodium.scala Mon Sep 11 22:59:34 2023 +0200 @@ -58,7 +58,7 @@ /* platform info */ sealed case class Platform_Info( - platform: Platform.Family.Value, + platform: Platform.Family, download_template: String, build_name: String, env: List[String] @@ -233,7 +233,7 @@ .text.replaceAll("=", "") } - private val platform_infos: Map[Platform.Family.Value, Platform_Info] = + private val platform_infos: Map[Platform.Family, Platform_Info] = Iterator( Platform_Info(Platform.Family.linux, "linux-x64-{VERSION}.tar.gz", "VSCode-linux-x64", List("OS_NAME=linux", "SKIP_LINUX_PACKAGES=True")), @@ -250,7 +250,7 @@ "SHOULD_BUILD_MSI_NOUP=no"))) .map(info => info.platform -> info).toMap - def the_platform_info(platform: Platform.Family.Value): Platform_Info = + def the_platform_info(platform: Platform.Family): Platform_Info = platform_infos.getOrElse(platform, error("No platform info for " + quote(platform.toString))) def linux_platform_info: Platform_Info = @@ -259,7 +259,7 @@ /* check system */ - def check_system(platforms: List[Platform.Family.Value]): Unit = { + def check_system(platforms: List[Platform.Family]): Unit = { if (Platform.family != Platform.Family.linux) error("Not a Linux/x86_64 system") Isabelle_System.require_command("git") @@ -301,11 +301,11 @@ /* build vscodium */ - def default_platforms: List[Platform.Family.Value] = Platform.Family.list + def default_platforms: List[Platform.Family] = Platform.Family.list def component_vscodium( target_dir: Path = Path.current, - platforms: List[Platform.Family.Value] = default_platforms, + platforms: List[Platform.Family] = default_platforms, progress: Progress = new Progress ): Unit = { check_system(platforms) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/jedit_base/plugin.props --- a/src/Tools/jEdit/jedit_base/plugin.props Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/jedit_base/plugin.props Mon Sep 11 22:59:34 2023 +0200 @@ -13,5 +13,5 @@ plugin.isabelle.jedit_base.Plugin.usePluginHome=false #dependencies -plugin.isabelle.jedit_base.Plugin.depend.0=jdk 11 +plugin.isabelle.jedit_base.Plugin.depend.0=jdk 17 plugin.isabelle.jedit_base.Plugin.depend.1=jedit 05.05.00.00 diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/jedit_main/plugin.props --- a/src/Tools/jEdit/jedit_main/plugin.props Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/jedit_main/plugin.props Mon Sep 11 22:59:34 2023 +0200 @@ -13,7 +13,7 @@ plugin.isabelle.jedit_main.Plugin.usePluginHome=false #dependencies -plugin.isabelle.jedit_main.Plugin.depend.0=jdk 11 +plugin.isabelle.jedit_main.Plugin.depend.0=jdk 17 plugin.isabelle.jedit_main.Plugin.depend.1=jedit 05.06.00.00 plugin.isabelle.jedit_main.Plugin.depend.2=plugin console.ConsolePlugin 5.1.4 plugin.isabelle.jedit_main.Plugin.depend.3=plugin errorlist.ErrorListPlugin 2.4.0 diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/document_dockable.scala --- a/src/Tools/jEdit/src/document_dockable.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/document_dockable.scala Mon Sep 11 22:59:34 2023 +0200 @@ -278,7 +278,7 @@ private val auto_build_button = new JEdit_Options.Bool_GUI(document_auto, "Auto") { - tooltip = Word.capitalize(document_auto.description) + tooltip = Word.capitalized(document_auto.description) override def clicked(state: Boolean): Unit = { super.clicked(state) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/document_model.scala --- a/src/Tools/jEdit/src/document_model.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/document_model.scala Mon Sep 11 22:59:34 2023 +0200 @@ -255,12 +255,12 @@ val open_nodes = (for ((_, model) <- st.buffer_models.iterator) yield model.node_name).toList val touched_nodes = model_edits.map(_._1) - val pending_nodes = for ((node_name, None) <- purged) yield node_name + val pending_nodes = for (case (node_name, None) <- purged) yield node_name (open_nodes ::: touched_nodes ::: pending_nodes).map((_, Position.none)) } val retain = PIDE.resources.dependencies(imports).theories.toSet - for ((node_name, Some(edits)) <- purged if !retain(node_name); edit <- edits) + for (case (node_name, Some(edits)) <- purged if !retain(node_name); edit <- edits) yield edit } else Nil diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/jedit_sessions.scala --- a/src/Tools/jEdit/src/jedit_sessions.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/jedit_sessions.scala Mon Sep 11 22:59:34 2023 +0200 @@ -91,7 +91,7 @@ extends GUI.Selector[String](batches: _*) with JEdit_Options.Entry { name = option_name tooltip = - if (standalone) Word.capitalize(options.value.description(option_name)) + if (standalone) Word.capitalized(options.value.description(option_name)) else options.value.check_name(option_name).print_default override val title: String = diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/query_dockable.scala --- a/src/Tools/jEdit/src/query_dockable.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/query_dockable.scala Mon Sep 11 22:59:34 2023 +0200 @@ -55,14 +55,14 @@ def consume_status( process_indicator: Process_Indicator, - status: Query_Operation.Status.Value + status: Query_Operation.Status ): Unit = { status match { - case Query_Operation.Status.WAITING => + case Query_Operation.Status.waiting => process_indicator.update("Waiting for evaluation of context ...", 5) - case Query_Operation.Status.RUNNING => + case Query_Operation.Status.running => process_indicator.update("Running find operation ...", 15) - case Query_Operation.Status.FINISHED => + case Query_Operation.Status.finished => process_indicator.update(null, 0) } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/sledgehammer_dockable.scala --- a/src/Tools/jEdit/src/sledgehammer_dockable.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/sledgehammer_dockable.scala Mon Sep 11 22:59:34 2023 +0200 @@ -34,13 +34,13 @@ private val process_indicator = new Process_Indicator - private def consume_status(status: Query_Operation.Status.Value): Unit = { + private def consume_status(status: Query_Operation.Status): Unit = { status match { - case Query_Operation.Status.WAITING => + case Query_Operation.Status.waiting => process_indicator.update("Waiting for evaluation of context ...", 5) - case Query_Operation.Status.RUNNING => + case Query_Operation.Status.running => process_indicator.update("Sledgehammering ...", 15) - case Query_Operation.Status.FINISHED => + case Query_Operation.Status.finished => process_indicator.update(null, 0) } } diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/symbols_dockable.scala --- a/src/Tools/jEdit/src/symbols_dockable.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/symbols_dockable.scala Mon Sep 11 22:59:34 2023 +0200 @@ -169,7 +169,7 @@ } for (page <- pages) - page.title = Word.implode(Word.explode('_', page.title).map(Word.perhaps_capitalize)) + page.title = Word.implode(Word.explode('_', page.title).map(Word.perhaps_capitalized)) } set_content(group_tabs) diff -r 0d2ea608d223 -r 5930c89d3bf2 src/Tools/jEdit/src/theories_status.scala --- a/src/Tools/jEdit/src/theories_status.scala Mon Sep 11 19:31:09 2023 +0200 +++ b/src/Tools/jEdit/src/theories_status.scala Mon Sep 11 22:59:34 2023 +0200 @@ -30,9 +30,7 @@ private def is_loaded_theory(name: Document.Node.Name): Boolean = PIDE.resources.session_base.loaded_theory(name) - private def overall_node_status( - name: Document.Node.Name - ): Document_Status.Overall_Node_Status.Value = { + private def overall_node_status(name: Document.Node.Name): Document_Status.Overall_Node_Status = { if (is_loaded_theory(name)) Document_Status.Overall_Node_Status.ok else nodes_status.overall_node_status(name) }